101 lines
2.8 KiB
OpenEdge ABL
101 lines
2.8 KiB
OpenEdge ABL
61500 #include "rundecs.h"
|
|
61510 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
61520 (**)
|
|
61530 (**)
|
|
61540 PROCEDURE GARBAGE (ANOBJECT: OBJECTP); EXTERN ;
|
|
61550 FUNCTION CRSTRING(LENGTH: OFFSETRANGE): OBJECTP; EXTERN;
|
|
61560 PROCEDURE ERRORR(N :INTEGER); EXTERN ;
|
|
61570 (**)
|
|
61580 (**)
|
|
61590 FUNCTION MULCI(CH: CHAR; N: INTEGER): OBJECTP;
|
|
61600 (*PMULCI*)
|
|
61610 VAR POINT: OBJECTP;
|
|
61620 I: INTEGER;
|
|
61630 BEGIN
|
|
61640 POINT := CRSTRING(N);
|
|
61650 WITH POINT^ DO
|
|
61660 FOR I := 1 TO N DO
|
|
61670 CHARVEC[I] := CH;
|
|
61680 MULCI := POINT;
|
|
61690 END;
|
|
61700 (**)
|
|
61710 (**)
|
|
61720 FUNCTION MULSI(S: OBJECTP; N: INTEGER): OBJECTP;
|
|
61730 (*PMULCI-1*)
|
|
61740 VAR POINT: OBJECTP;
|
|
61750 I, J: INTEGER;
|
|
61760 C: CHAR;
|
|
61770 BEGIN
|
|
61780 WITH S^ DO
|
|
61790 BEGIN
|
|
61800 POINT := CRSTRING(STRLENGTH*N);
|
|
61810 FOR I := 0 TO N-1 DO
|
|
61820 FOR J := 1 TO STRLENGTH DO
|
|
61830 BEGIN C := CHARVEC[J]; POINT^.CHARVEC[I*STRLENGTH+J] := C END
|
|
61840 END;
|
|
61850 IF FPTST(S^) THEN GARBAGE(S);
|
|
61860 MULSI := POINT;
|
|
61870 END;
|
|
61880 (**)
|
|
61890 (**)
|
|
61900 FUNCTION MULIC(N: INTEGER; CH: CHAR): OBJECTP;
|
|
61910 (*PMULIC*)
|
|
61920 VAR POINT :OBJECTP;
|
|
61930 I :INTEGER;
|
|
61940 BEGIN
|
|
61950 POINT := CRSTRING(N);
|
|
61960 WITH POINT^ DO
|
|
61970 FOR I := 1 TO N DO
|
|
61980 CHARVEC[I] := CH;
|
|
61990 MULIC := POINT;
|
|
62000 END;
|
|
62010 (**)
|
|
62020 (**)
|
|
62030 FUNCTION MULIS(N: INTEGER; S: OBJECTP): OBJECTP;
|
|
62040 (*PMULIC-1*)
|
|
62050 VAR POINT: OBJECTP;
|
|
62060 I, J: INTEGER;
|
|
62070 C: CHAR;
|
|
62080 BEGIN
|
|
62090 WITH S^ DO
|
|
62100 BEGIN
|
|
62110 POINT := CRSTRING(STRLENGTH*N);
|
|
62120 FOR I := 0 TO N-1 DO
|
|
62130 FOR J := 1 TO STRLENGTH DO
|
|
62140 BEGIN C := CHARVEC[J]; POINT^.CHARVEC[I*STRLENGTH+J] := C END
|
|
62150 END;
|
|
62160 IF FPTST(S^) THEN GARBAGE(S);
|
|
62170 MULIS := POINT;
|
|
62180 END;
|
|
62190 (**)
|
|
62200 (**)
|
|
62210 FUNCTION MULABSI(LEFT: OBJECTP; N: INTEGER): OBJECTP;
|
|
62220 (*PTIMESABS*)
|
|
62230 VAR PIL: OBJECTP;
|
|
62240 BEGIN
|
|
62250 WITH LEFT^ DO
|
|
62260 CASE SORT OF
|
|
62270 REFN:
|
|
62280 BEGIN
|
|
62290 WITH PVALUE^ DO FDEC;
|
|
62300 PVALUE := MULSI(PVALUE, N);
|
|
62310 WITH PVALUE^ DO FINC
|
|
62320 END;
|
|
62330 CREF:
|
|
62340 BEGIN PIL := IPTR^.FIRSTPTR;
|
|
62350 WITH PIL^ DO FDEC;
|
|
62360 PIL := MULSI(PIL, N); IPTR^.FIRSTPTR := PIL;
|
|
62370 WITH PIL^ DO FINC
|
|
62380 END;
|
|
62390 UNDEF: ERRORR(RASSIG);
|
|
62400 NILL: ERRORR(RASSIGNIL);
|
|
62410 END;
|
|
62420 MULABSI := LEFT;
|
|
62430 END;
|
|
62440 (**)
|
|
62450 (**)
|
|
62460 (*-02() BEGIN END ; ()-02*)
|
|
62470 (*+01()
|
|
62480 BEGIN (*OF MAIN PROGRAM*)
|
|
62490 END (*OF EVERYTHING*).
|
|
62500 ()+01*)
|