ack/lang/a68s/liba68s/standass.p
1988-10-04 13:41:01 +00:00

113 lines
3.7 KiB
OpenEdge ABL

89300 #include "rundecs.h"
89310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
89320 (**)
89330 PROCEDURE TESTCC(TARGET:OBJECTP); EXTERN;
89340 (**)
89350 (**)
89360 PROCEDURE ASSWRSTR(COV,PUTSTRING:OBJECTP;LB,UB:INTEGER; VAR FYLE :FYL);
89370 VAR PTR: UNDRESSP;
89380 I,CP,OFS,WIDTH:INTEGER;
89390 BEGIN WITH COV^ DO
89400 BEGIN
89410 CP:=CPOSELS;
89420 OFS:=OFFSETDI;
89430 IF FPTWO(ASSREF^.ANCESTOR^) THEN
89440 TESTCC(ASSREF);
89450 PTR := INCPTR(ASSREF^.ANCESTOR^.PVALUE, CP);
89460 IF LB<0 THEN
89470 BEGIN PTR^.FIRSTWORD:=UB; CP:=CP+OFS; WIDTH:=1 END
89480 ELSE BEGIN WIDTH:=UB-LB+1;
89490 WITH PUTSTRING^ DO
89500 FOR I := LB TO UB DO
89510 BEGIN PTR^.FIRSTWORD:=ORD(CHARVEC[I]);
89520 PTR := INCPTR(PTR, OFS);
89530 CP:=CP+OFS
89540 END;
89550 END;
89560 COFCPOS:=COFCPOS+WIDTH;
89570 CPOSELS:=CP;
89580 IF COFCPOS>CHARBOUND THEN
89590 STATUS:=STATUS+[LINEOVERFLOW];
89600 END;
89610 END;
89620 (**)
89630 (**)
89640 PROCEDURE ASSRDSTR(
89650 PCOV: OBJECTP; VAR CHARS: GETBUFTYPE; T (*+01(), T1()+01*): TERMSET; VAR I: INTEGER; VAR FYLE: FYL
89660 );
89670 VAR PTR: UNDRESSP;
89680 CH: CHAR;
89690 (*LINEOK*)
89700 BEGIN
89710 WITH PCOV^ DO
89720 BEGIN
89730 PTR := INCPTR(ASSREF^.ANCESTOR^.PVALUE, CPOSELS);
89740 IF I<0 THEN
89750 BEGIN I := PTR^.FIRSTWORD; CPOSELS := CPOSELS+OFFSETDI; COFCPOS := COFCPOS+1 END
89760 ELSE
89770 BEGIN
89780 CH := CHR(PTR^.FIRSTWORD);
89790 WHILE (COFCPOS<=CHARBOUND) AND NOT(CH IN T)
89800 (*+01() AND ((ORD(CH)<=59) OR NOT(CHR(ORD(CH)-59) IN T1)) ()+01*) DO
89810 BEGIN
89820 CHARS[I] := CH; I := I+1;
89830 CPOSELS := CPOSELS+OFFSETDI;
89840 PTR := INCPTR(PTR, OFFSETDI);
89850 CH := CHR(PTR^.FIRSTWORD);
89860 COFCPOS := COFCPOS+1;
89870 END
89880 END;
89890 IF COFCPOS>CHARBOUND THEN
89900 STATUS := STATUS+[LINEOVERFLOW];
89910 END
89920 END;
89930 (**)
89940 (**)
89950 PROCEDURE ASSNEWLINE(COV: OBJECTP; VAR FYLE: FYL);
89960 BEGIN WITH COV^ DO
89970 BEGIN
89980 LOFCPOS := 2; COFCPOS := 1;
89990 STATUS := STATUS+[PAGEOVERFLOW,LINEOVERFLOW];
90000 END
90010 END;
90020 (**)
90030 (**)
90040 PROCEDURE ASSNEWPAGE(COV: OBJECTP; VAR FYLE: FYL);
90050 BEGIN WITH COV^ DO
90060 BEGIN
90070 POFCPOS := 2; LOFCPOS := 1; COFCPOS := 1;
90080 IF READMOOD IN STATUS THEN STATUS := STATUS+[LFE,PAGEOVERFLOW,LINEOVERFLOW]
90090 ELSE STATUS := STATUS+[PFE,PAGEOVERFLOW,LINEOVERFLOW];
90100 END
90110 END;
90120 (**)
90130 (**)
90140 PROCEDURE ASSRESET(COV: OBJECTP; VAR FYLE: FYL);
90150 BEGIN WITH COV^.ASSREF^ DO
90160 COV^.CPOSELS := DESCVEC[0].DI-LBADJ;
90170 END;
90180 (**)
90190 (**)
90200 PROCEDURE ASSSET(COV: OBJECTP; P, L, C: INTEGER; VAR FYLE: FYL);
90210 BEGIN WITH COV^ DO
90220 BEGIN
90230 COFCPOS := C; LOFCPOS := L; POFCPOS := P;
90240 STATUS := STATUS-[LFE,PFE,PAGEOVERFLOW,LINEOVERFLOW];
90250 IF POFCPOS>PAGEBOUND THEN ASSNEWPAGE(COV, FYLE)
90260 ELSE IF LOFCPOS>LINEBOUND THEN ASSNEWLINE(COV, FYLE)
90270 ELSE IF COFCPOS>CHARBOUND THEN STATUS := STATUS+[LINEOVERFLOW]
90280 ELSE WITH ASSREF^ DO
90290 COV^.CPOSELS := C*DESCVEC[0].DI-LBADJ;
90300 END
90310 END;
90320 (**)
90330 (**)
90340 (*-02()
90350 BEGIN (*OF A68*)
90360 END; (*OF A68*)
90370 ()-02*)
90380 (*+01()
90390 BEGIN (*OF MAIN PROGRAM*)
90400 END (*OF EVERYTHING*).
90410 ()+01*)