ack/lang/a68s/liba68s/collp.p

53 lines
1.8 KiB
OpenEdge ABL
Raw Permalink Normal View History

1988-10-04 13:41:01 +00:00
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*)