54 lines
1.8 KiB
OpenEdge ABL
54 lines
1.8 KiB
OpenEdge ABL
49400 #include "rundecs.h"
|
|
49410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
49420 (**)
|
|
49430 (**)
|
|
49440 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
|
|
49450 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN;
|
|
49460 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
|
|
49470 (**)
|
|
49480 (**)
|
|
49490 FUNCTION STRSUB(OBJECT: OBJECTP; INDEX: BOUNDSRANGE): CHAR;
|
|
49500 (*PSTRINGSLICE*)
|
|
49510 BEGIN
|
|
49520 WITH OBJECT^ DO
|
|
49530 BEGIN
|
|
49540 IF INDEX<1 THEN ERRORR(RSL1ERROR)
|
|
49550 ELSE IF INDEX>STRLENGTH THEN ERRORR(RSL2ERROR)
|
|
49560 ELSE STRSUB := CHARVEC[INDEX];
|
|
49570 END;
|
|
49580 IF FPTST(OBJECT^) THEN GARBAGE(OBJECT);
|
|
49590 END;
|
|
49600 (**)
|
|
49610 (**)
|
|
49620 FUNCTION STRTRIM(INDEX: BOUNDSRANGE; TRTYPE: INTEGER): OBJECTP;
|
|
49630 (*PSTRINGSLICE+1*)
|
|
49640 VAR OLD, NEW :OBJECTP;
|
|
49650 LI, UI: BOUNDSRANGE;
|
|
49660 I :INTEGER;
|
|
49670 BEGIN
|
|
49680 CASE TRTYPE OF
|
|
49690 0,8: BEGIN OLD := ASPTR(INDEX); LI := 1; UI := OLD^.STRLENGTH END;
|
|
49700 2: BEGIN OLD := ASPTR(GETSTKTOP(SZADDR, 0)); LI := 1; UI := INDEX END;
|
|
49710 4: BEGIN OLD := ASPTR(GETSTKTOP(SZADDR, 0)); LI := INDEX; UI := OLD^.STRLENGTH END;
|
|
49720 6: BEGIN OLD := ASPTR(GETSTKTOP(SZADDR, SZINT)); LI := GETSTKTOP(SZINT, 0); UI := INDEX END;
|
|
49730 END;
|
|
49740 IF LI<1 THEN ERRORR(RSL1ERROR)
|
|
49750 ELSE IF UI>OLD^.STRLENGTH THEN ERRORR(RSL2ERROR)
|
|
49760 ELSE
|
|
49770 BEGIN
|
|
49780 LI := LI-1;
|
|
49790 NEW := CRSTRING(UI-LI);
|
|
49800 FOR I := LI+1 TO UI DO
|
|
49810 NEW^.CHARVEC[I-LI] := OLD^.CHARVEC[I];
|
|
49820 IF FPTST(OLD^) THEN GARBAGE(OLD);
|
|
49830 STRTRIM := NEW;
|
|
49840 END;
|
|
49850 END;
|
|
49860 (**)
|
|
49870 (**)
|
|
49880 (*-02() BEGIN END ; ()-02*)
|
|
49890 (*+01()
|
|
49900 BEGIN (*OF MAIN PROGRAM*)
|
|
49910 END (*OF EVERYTHING*).
|
|
49920 ()+01*)
|