ack/lang/a68s/liba68s/cfstr.p

43 lines
1.7 KiB
OpenEdge ABL
Raw Permalink Normal View History

1988-10-04 13:41:01 +00:00
61000 #include "rundecs.h"
61010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
61020 (**)
61030 (**)
61040 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
61050 (**)
61060 (**)
61070 FUNCTION CFSTR(LEFT, RIGHT: OBJECTP; JOB :INTEGER): INTEGER;
61080 (*PLTCS-1, PLECS-1, PEQCS-1, PNECS-1, PGECS-1, PGTCS-1*)
61090 LABEL 9;
61100 VAR MINPTR, LSTRLENGTH, RSTRLENGTH: INTEGER;
61110 LPTR, RPTR: UNDRESSP;
61120 BEGIN
61130 LSTRLENGTH := LEFT^.STRLENGTH; RSTRLENGTH := RIGHT^.STRLENGTH;
61140 IF LSTRLENGTH < RSTRLENGTH THEN
61150 MINPTR := (LSTRLENGTH+CHARPERWORD-1) DIV CHARPERWORD * SZWORD
61160 ELSE
61170 MINPTR := (RSTRLENGTH+CHARPERWORD-1) DIV CHARPERWORD * SZWORD;
61180 LPTR := INCPTR(LEFT, STRINGCONST); RPTR := INCPTR(RIGHT, STRINGCONST);
61190 WHILE ORD(LPTR)<ORD(LEFT)+STRINGCONST+MINPTR DO
61200 BEGIN
61210 IF LPTR^.FIRSTWORD<>RPTR^.FIRSTWORD THEN
61220 BEGIN LSTRLENGTH := LPTR^.FIRSTWORD; RSTRLENGTH := RPTR^.FIRSTWORD; GOTO 9 END;
61230 LPTR := INCPTR(LPTR, SZWORD); RPTR := INCPTR(RPTR, SZWORD);
61240 END;
61250 9: CASE JOB OF
61260 0: CFSTR := -ORD(LSTRLENGTH<RSTRLENGTH);
61270 1: CFSTR := -ORD(LSTRLENGTH<=RSTRLENGTH);
61280 2: CFSTR := -ORD(LSTRLENGTH=RSTRLENGTH);
61290 3: CFSTR := -ORD(LSTRLENGTH<>RSTRLENGTH);
61300 4: CFSTR := -ORD(LSTRLENGTH>=RSTRLENGTH);
61310 5: CFSTR := -ORD(LSTRLENGTH>RSTRLENGTH);
61320 END;
61330 IF FPTST(LEFT^) THEN GARBAGE(LEFT); IF FPTST(RIGHT^) THEN GARBAGE(RIGHT)
61340 END;
61350 (**)
61360 (**)
61370 (*-02() BEGIN END ; ()-02*)
61380 (*+01()
61390 BEGIN (*OF MAIN PROGRAM*)
61400 END (*OF EVERYTHING*).
61410 ()+01*)