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*)