ack/lang/a68s/liba68s/strsubtrim.p

54 lines
1.8 KiB
OpenEdge ABL
Raw Permalink Normal View History

1988-10-04 13:41:01 +00:00
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*)