52 lines
1.8 KiB
OpenEdge ABL
52 lines
1.8 KiB
OpenEdge ABL
20000 #include "rundecs.h"
|
|
20010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
20020 (**)
|
|
20030 (**)
|
|
20040 PROCEDURE PCINCR (STRUCTPTR: UNDRESSP; TEMPLATE: DPOINT; INCREMENT: INTEGER); EXTERN ;
|
|
20050 PROCEDURE GARBAGE(ANOBJECT:OBJECTP); EXTERN;
|
|
20060 (**)
|
|
20070 (**)
|
|
20080 FUNCTION COLLTP(TEMP:NAKEGER; UNIT: OBJECTP; TEMPLATE: DPOINT; OFFSET: OFFSETRANGE): ASNAKED;
|
|
20090 (*PCOLLTOTAL+3*)
|
|
20100 VAR OBJECT, STRUCTPTR: OBJECTP;
|
|
20110 COUNT: INTEGER;
|
|
20120 BEGIN WITH TEMP DO WITH NAK DO
|
|
20130 BEGIN
|
|
20140 OBJECT := INCPTR(POINTER, OFFSET);
|
|
20150 STRUCTPTR := UNIT;
|
|
20160 IF ORD(TEMPLATE)<=MAXSIZE THEN (*NOT STRUCT*)
|
|
20170 MOVELEFT(STRUCTPTR, OBJECT, ORD(TEMPLATE))
|
|
20180 ELSE (*STRUCT*)
|
|
20190 BEGIN
|
|
20200 PCINCR(INCPTR(STRUCTPTR, STRUCTCONST), TEMPLATE, +INCRF);
|
|
20210 MOVELEFT(INCPTR(STRUCTPTR, STRUCTCONST), OBJECT, TEMPLATE^[0]);
|
|
20220 IF FPTST(STRUCTPTR^) THEN GARBAGE(STRUCTPTR);
|
|
20230 END;
|
|
20240 COLLTP := ASNAK;
|
|
20250 END
|
|
20260 END;
|
|
20270 (**)
|
|
20280 (**)
|
|
20290 FUNCTION COLLNP(TEMP: NAKEGER; NAKUNIT: NAKEGER; TEMPLATE: DPOINT; OFFSET: OFFSETRANGE): ASNAKED;
|
|
20300 (*PCOLLNAKED+3*)
|
|
20310 VAR OBJECT: UNDRESSP;
|
|
20320 COUNT: INTEGER;
|
|
20330 BEGIN WITH TEMP DO WITH NAK DO
|
|
20340 BEGIN
|
|
20350 OBJECT := INCPTR(POINTER, OFFSET);
|
|
20360 WITH NAKUNIT.NAK DO
|
|
20370 BEGIN
|
|
20380 PCINCR(POINTER, TEMPLATE, +INCRF);
|
|
20390 MOVELEFT(POINTER, OBJECT, TEMPLATE^[0]);
|
|
20400 IF FPTST(STOWEDVAL^) THEN GARBAGE(STOWEDVAL);
|
|
20410 END;
|
|
20420 COLLNP := ASNAK;
|
|
20430 END
|
|
20440 END;
|
|
20450 (**)
|
|
20460 (**)
|
|
20470 (*-02() BEGIN END ; ()-02*)
|
|
20480 (*+01()
|
|
20490 BEGIN (*OF MAIN PROGRAM*)
|
|
20500 END (*OF EVERYTHING*).
|
|
20510 ()+01*)
|