ack/lang/a68s/liba68s/selectr.p

43 lines
1.3 KiB
OpenEdge ABL
Raw Permalink Normal View History

1988-10-04 13:41:01 +00:00
46400 #include "rundecs.h"
46410 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
46420 (**)
46430 (**)
46440 FUNCTION COPYDESC(ORIGINAL: OBJECTP; NEWSORT: STRUCTYPE): OBJECTP; EXTERN;
46450 FUNCTION GETMULT(NEWMULT: OBJECTP): OBJECTP; EXTERN;
46460 FUNCTION GETSLN(NEWREFSLN:OBJECTP): OBJECTP; EXTERN;
46470 (**)
46480 (**)
46490 FUNCTION SELECTR(AROWED: OBJECTP; TEMPLATE: DPOINT; ROFFSET: INTEGER): OBJECTP;
46500 (*PSELECTROW*)
46510 VAR ADESC: OBJECTP;
46520 BEGIN
46530 WITH AROWED^ DO
46540 IF SORT=MULT THEN
46550 BEGIN
46560 ADESC := COPYDESC(AROWED, MULT);
46570 ADESC^.PVALUE := AROWED;
46580 SELECTR := GETMULT(ADESC);
46590 END
46600 ELSE
46610 BEGIN
46620 ADESC := COPYDESC(AROWED, REFSLN);
46630 ADESC^.PVALUE := AROWED;
46640 SELECTR := GETSLN(ADESC);
46650 END;
46660 WITH ADESC^ DO
46670 BEGIN
46680 MDBLOCK := TEMPLATE;
46690 IF ORD(TEMPLATE)=0 (*DRESSED*) THEN SIZE := 1
46700 ELSE IF ORD(TEMPLATE)<=MAXSIZE (*UNDRESSED*) THEN SIZE := ORD(TEMPLATE)
46710 ELSE (*STRUCT*) SIZE := TEMPLATE^[0];
46720 LBADJ := LBADJ-ROFFSET;
46730 END
46740 END;
46750 (**)
46760 (**)
46770 (*-02() BEGIN END ; ()-02*)
46780 (*+01()
46790 BEGIN (*OF MAIN PROGRAM*)
46800 END (*OF EVERYTHING*).
46810 ()+01*)