42 lines
		
	
	
	
		
			1.7 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			42 lines
		
	
	
	
		
			1.7 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
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*)
 |