37 lines
1.1 KiB
OpenEdge ABL
37 lines
1.1 KiB
OpenEdge ABL
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*)
|