67 lines
2 KiB
OpenEdge ABL
67 lines
2 KiB
OpenEdge ABL
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*)
|