ack/lang/a68s/liba68s/slicen.p

38 lines
1.1 KiB
OpenEdge ABL
Raw Normal View History

1988-10-04 13:41:01 +00:00
49000 #include "rundecs.h"
49010 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
49020 (**)
49030 (**)
49040 PROCEDURE SLCMN(STOWEDVAL: OBJECTP; INDEX, SLICDEX: INTEGER); EXTERN;
49050 (**)
49060 (**)
49070 FUNCTION SLICEN(INDEX: BOUNDSRANGE; NOROWS: INTEGER): ASNAKED;
49080 (*PSLICEN*)
49090 VAR TEMP: NAKEGER;
49100 OFFS, I: INTEGER;
49110 BEGIN
49120 WITH TEMP DO WITH NAK DO
49130 BEGIN
49140 (*+11() ASNAK := 0; ()+11*)
49150 STOWEDVAL := ASPTR(GETSTKTOP(SZADDR, (NOROWS-1)*SZINT));
49160 WITH STOWEDVAL^ DO
49170 BEGIN
49180 OFFS := -LBADJ;
49190 FOR I := 0 TO NOROWS-1 DO WITH DESCVEC[I] DO
49200 BEGIN
49210 IF (INDEX<LI) OR (INDEX>UI) THEN SLCMN(STOWEDVAL, INDEX, I)
49220 ELSE OFFS := OFFS+DI*INDEX;
49230 INDEX := GETSTKTOP(SZINT, I*SZINT);
49240 END
49250 END;
49260 POSITION := OFFS;
49270 SLICEN := ASNAK;
49280 END;
49290 END;
49300 (**)
49310 (**)
49320 (*-02() BEGIN END ; ()-02*)
49330 (*+01()
49340 BEGIN (*OF MAIN PROGRAM*)
49350 END (*OF EVERYTHING*).
49360 ()+01*)