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*)
 |