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