48300 #include "rundecs.h"
48310     (*  COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER  *)
48320 (**)
48330 (**)
48340 PROCEDURE ERRORR(N :INTEGER); EXTERN;
48350 (**)
48360 (**)
48370 PROCEDURE SLCMN(STOWEDVAL: OBJECTP; INDEX, SLICDEX: INTEGER);
48380     BEGIN
48390     WITH STOWEDVAL^ DO CASE SORT OF
48400       MULT, REFSLN, REFR, RECR:
48410         WITH DESCVEC[SLICDEX] DO
48420           BEGIN
48430           IF INDEX<LI THEN ERRORR(RSL1ERROR);
48440           IF INDEX>UI THEN ERRORR(RSL2ERROR);
48450           END;
48460       UNDEF: ERRORR(RSLICE);
48470       NILL: ERRORR(RSLICENIL);
48480       END
48490     END;
48500 (**)
48510 (**)
48520 (*-01() (*-05()
48530 FUNCTION SLICE1(PRIMARY: OBJECTP; INDEX: BOUNDSRANGE): ASNAKED;
48540 (*PSLICE1*)
48550   VAR TEMP: NAKEGER;
48560     BEGIN
48570     WITH TEMP DO WITH NAK DO
48580       BEGIN
48590         STOWEDVAL := PRIMARY;
48600         WITH PRIMARY^ DO WITH DESCVEC[0] DO
48610           IF (INDEX<LI) OR (INDEX>UI) THEN SLCMN(STOWEDVAL, INDEX, 0)
48620           ELSE POSITION := DI*INDEX-LBADJ;
48630         SLICE1 := ASNAK;
48640       END;
48650     END;
48660 (**)
48670 (**)
48680 FUNCTION SLICE2(INDEX1, INDEX2: BOUNDSRANGE): ASNAKED;
48690 (*PSLICE2*)
48700   VAR TEMP: NAKEGER;
48710       OFFS: INTEGER;
48720     BEGIN
48730     WITH TEMP DO WITH NAK DO
48740       BEGIN
48750 (*+11() ASNAK := 0; ()+11*)
48760       STOWEDVAL := ASPTR(GETSTKTOP(SZADDR, 0));
48770       WITH STOWEDVAL^ DO
48780         BEGIN
48790         WITH DESCVEC[0] DO
48800           IF (INDEX2<LI) OR (INDEX2>UI) THEN SLCMN(STOWEDVAL, INDEX2, 0)
48810           ELSE OFFS := -LBADJ+DI*INDEX2;
48820         WITH DESCVEC[1] DO
48830           IF (INDEX1<LI) OR (INDEX1>UI) THEN SLCMN(STOWEDVAL, INDEX1, 1)
48840           ELSE POSITION := OFFS+DI*INDEX1
48850         END;
48860         SLICE2 := ASNAK;
48870         END;
48880     END;
48890 ()-05*) ()-01*)
48900 (**)
48910 (**)
48920 (*-02() BEGIN END ; ()-02*)
48930 (*+01()
48940 BEGIN (*OF MAIN PROGRAM*)
48950 END (*OF EVERYTHING*).
48960 ()+01*)