30000 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *) 30010 (**) 30020 (**) 30030 (*+04() 30040 MODULE A68SIN; 30050 PROCEDURE DUMP; 30060 PRIVATE 30070 IMPORTS A68COM FROM A68DEC; 30080 ()+04*) 30090 (*+83() PROCEDURE INITIALIZE; FORWARD; ()+83*) 30100 (*+85() PROCEDURE STANDARDPRELUDE; FORWARD; ()+85*) 30110 (*+82() PROCEDURE PARSEPARSER; FORWARD; ()+82*) 30120 (*+85() PROCEDURE INITSEMANTICS; FORWARD; ()+85*) 30130 (*+01() PROCEDURE INITBEGIN; FORWARD; ()+01*) 30140 (*+86() PROCEDURE INITCODES; FORWARD; ()+86*) 30150 PROCEDURE SIN; 30160 BEGIN 30170 (*+83() INITIALIZE; ()+83*) 30180 (*+82() PARSEPARSER; ()+82*) 30190 (*+85() STANDARDPRELUDE; ()+85*) 30200 (*+85() INITSEMANTICS; ()+85*) 30210 (*+01() INITBEGIN; ()+01*) 30220 (*+86() INITCODES; ()+86*) 30230 END; 30240 (**) 30250 (**) 30260 (**) 30270 (**) 30280 (*+01() 30290 FUNCTION PFL: INTEGER; 30300 (*OBTAIN FIELD LENGTH FROM GLOBAL P.FL*) 30310 EXTERN; 30320 (**) 30330 (**) 30340 FUNCTION PFREE: PINTEGER; 30350 (*OBTAIN ADDRESS OF GLOBAL P.FREE*) 30360 EXTERN; 30370 (**) 30380 (**) 30390 (*$T-+) 30400 PROCEDURE DUMP(VAR START: INTEGER); 30410 (*DUMPS STACK AND HEAP ONTO FILE DUMPF. 30420 START IS FIRST VARIABLE ON STACK TO BE DUMPED*) 30430 CONST TWO30=10000000000B; 30440 FREEINIT=40000000000000000000B; (*INITIAL VALUE OF P.FREE*) 30450 VAR F1: FILE OF INTEGER; 30460 STACKSTART, STACKLENGTH, HEAPSTART, HEAPLENGTH: INTEGER; 30470 FRIG: RECORD CASE INTEGER OF 30480 1:(INT: INTEGER); 2:(POINT: PINTEGER) END; 30490 D: DUMPOBJ; 30500 MASKM,MASKL: INTEGER; 30510 I: INTEGER; 30520 BEGIN 30530 FRIG.INT := GETB(5)+3; STACKSTART := FRIG.POINT^; 30540 STACKLENGTH := GETB(5)-STACKSTART; 30550 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO 30560 BEGIN FRIG.INT := I; FRIG.POINT^ := 40000000000000000000B END; (*CLEAR STACK*) 30570 FOR I := GETB(6) TO PFL-1 DO 30580 BEGIN FRIG.INT := I; FRIG.POINT^ := 0 END; (*CLEAR SPACE BETWEEN STACK AND HEAPTOP*) 30590 SIN; 30600 HEAPSTART := GETB(4); HEAPLENGTH := PFL-HEAPSTART; 30610 FRIG.POINT := PFREE; START := FRIG.POINT^; (*STORE P.FREE ON STACK FOR DUMPING*) 30620 WRITELN(' STACK SIZE =', STACKLENGTH); WRITELN(' HEAP SIZE =', HEAPLENGTH); 30630 REWRITE(F1); 30640 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO 30650 BEGIN FRIG.INT := I; WRITE(F1, FRIG.POINT^) END; 30660 FOR I := HEAPSTART TO HEAPSTART+HEAPLENGTH-1 DO 30670 BEGIN FRIG.INT := I; WRITE(F1, FRIG.POINT^) END; 30680 WRITELN(' F1 WRITTEN'); 30690 (**) 30700 (*NOW CLEAR THE HEAP AND REINITIALIZE IT ONE WORD DOWN*) 30710 SETB(4, PFL-1); FRIG.POINT := PFREE; FRIG.POINT^ := FREEINIT; 30720 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO 30730 BEGIN FRIG.INT := I; FRIG.POINT^ := 40000000000000000000B END; 30740 FOR I := GETB(6) TO PFL-1 DO 30750 BEGIN FRIG.INT := I; FRIG.POINT^ := 0 END; 30760 SIN; 30770 FRIG.POINT := PFREE; START := FRIG.POINT^; 30780 RESET(F1); REWRITE(A68INIT); 30790 D.INT := STACKLENGTH; D.MASK := HEAPLENGTH; WRITE(A68INIT, D.INT, D.MASK); 30800 FOR I := STACKSTART TO STACKSTART+STACKLENGTH-1 DO 30810 BEGIN 30820 READ(F1, D.INT); 30830 FRIG.INT := I; D.MASK := D.INT-FRIG.POINT^; 30840 (*D.MASK CONTAINS A 1 AT THE LS END OF EACH ^ FIELD OF D.INT*) 30850 (*NOW WE HAVE TO MULTIPLE D.MASK BY HEAPSTART*) 30860 MASKM := D.MASK DIV TWO30; MASKL := D.MASK-MASKM*TWO30; 30870 MASKM := MASKM*HEAPSTART; MASKL := MASKL*HEAPSTART; 30880 D.INT := D.INT-MASKM*TWO30-MASKL; 30890 WRITE(A68INIT, D.INT, D.MASK) 30900 END; 30910 FOR I := HEAPSTART TO HEAPSTART+HEAPLENGTH-1 DO 30920 BEGIN 30930 READ(F1, D.INT); 30940 FRIG.INT := I-1; D.MASK := D.INT-FRIG.POINT^; 30950 MASKM := D.MASK DIV TWO30; MASKL := D.MASK-MASKM*TWO30; 30960 MASKM := MASKM*HEAPSTART; MASKL := MASKL*HEAPSTART; 30970 D.INT := D.INT-MASKM*TWO30-MASKL; 30980 WRITE(A68INIT, D.INT, D.MASK) 30990 END; 31000 WRITELN(' A68INIT WRITTEN'); 31010 (**) 31020 (*FINALLY, CLEAR THE HEAP AGAIN*) 31030 SETB(4, PFL); FRIG.POINT := PFREE; FRIG.POINT^ := FREEINIT 31040 END; 31050 ()+01*) 31060 (**) 31070 (**) 31080 (*-11() 31090 PROCEDURE STASHLEX(A1: ALFA); 31100 VAR I: INTEGER; 31110 BEGIN 31120 WITH CURRENTLEX DO 31130 BEGIN S10 := A1; 31140 I := 10; REPEAT I := I+1 ; STRNG[I] := ' ' UNTIL I MOD CHARPERWORD = 0; 31150 WHILE STRNG[I]=' ' DO I := I-1; 31160 LXCOUNT := (I+CHARPERWORD-1) DIV CHARPERWORD; 31170 END 31180 END; 31190 (**) 31200 (**) 31210 PROCEDURE STASHLLEX(A1, A2: ALFA); 31220 VAR I: INTEGER; 31230 BEGIN 31240 WITH CURRENTLEX DO 31250 BEGIN S10 := A1; 31251 FOR I := 11 TO 20 DO STRNG[I] := A2[I-10]; 31260 I := 20; REPEAT I := I+1; STRNG[I] := ' ' UNTIL I MOD CHARPERWORD = 0; 31270 WHILE STRNG[I]=' ' DO I := I-1; 31280 LXCOUNT := (I+CHARPERWORD-1) DIV CHARPERWORD; 31290 END 31300 END; 31310 ()-11*) 31320 (**) 31330 (**) 31340 (*-01() (*-03() (*-04() 31350 FUNCTION GETADDRESS(VAR VARIABLE:INTEGER): ADDRINT; EXTERN; 31360 (**) 31370 PROCEDURE RESTORE(VAR START,FINISH: INTEGER); 31380 VAR STACKSTART,STACKEND,GLOBALLENGTH,HEAPLENGTH, 31390 HEAPSTART(*+19(),LENGTH,POINTER()+19*): ADDRINT; 31395 I:INTEGER; 31400 P: PINTEGER; 31410 FRIG: RECORD CASE SEVERAL OF 31420 1: (INT: ADDRINT); 31421 2: (POINT: PINTEGER); 31422 3: (PLEXP: PLEX); 31423 (*+19() 4: (APOINT: ^ADDRINT); ()+19*) 31424 (*-19()4,()-19*)5,6,7,8,9,10: () 31430 END; 31440 D: RECORD INT,MASK: INTEGER END; 31450 BEGIN 31459 (*+05() 31460 OPENLOADFILE(A68INIT, 4, FALSE); 31461 ()+05*) 31470 STACKSTART := GETADDRESS(START); 31480 IF NOT EOF(A68INIT) THEN 31490 BEGIN 31500 READ(A68INIT,GLOBALLENGTH,HEAPLENGTH); 31510 ENEW(FRIG.PLEXP, HEAPLENGTH); 31520 HEAPSTART := FRIG.INT; 31530 FRIG.INT := STACKSTART; 31535 (*-19() 31540 FOR I := 1 TO GLOBALLENGTH DIV SZWORD DO 31550 BEGIN 31560 READ(A68INIT,D.INT,D.MASK); 31570 IF D.MASK=SZREAL THEN (*D.INT IS A POINTER OFFSET FROM HEAPSTART*) 31580 D.INT := D.INT+HEAPSTART; 31590 FRIG.POINT^ := D.INT; 31600 FRIG.INT := FRIG.INT+SZWORD; 31610 END; 31620 FRIG.INT := HEAPSTART; 31630 FOR I := 1 TO HEAPLENGTH DIV SZWORD DO 31640 BEGIN 31642 READ(A68INIT,D.INT,D.MASK); 31644 IF D.MASK=SZREAL THEN 31646 D.INT := D.INT+HEAPSTART; 31648 FRIG.POINT^ := D.INT; 31650 FRIG.INT := FRIG.INT+SZWORD 31652 END 31654 ()-19*) 31659 (*+19() 31660 LENGTH:=GLOBALLENGTH DIV SZWORD; 31662 I:=1; 31664 WHILE I<=LENGTH DO 31666 BEGIN 31668 READ(A68INIT,D.MASK); 31670 IF D.MASK=SZADDR+SZWORD THEN (*IT IS A POINTER*) 31672 BEGIN 31674 READ(A68INIT,POINTER); 31676 POINTER:=POINTER+HEAPSTART; 31678 FRIG.APOINT^:=POINTER; 31680 FRIG.INT:=FRIG.INT+SZWORD+SZWORD; (*POINTER IS 2 WORDS *) 31682 I:=I+2 31684 END 31686 ELSE 31688 BEGIN 31690 READ(A68INIT,D.INT); 31691 FRIG.POINT^:=D.INT; 31692 FRIG.INT:=FRIG.INT+SZWORD; 31693 I:=I+1 31694 END 31695 END; 31696 LENGTH:=HEAPLENGTH DIV SZWORD; 31697 FRIG.INT:=HEAPSTART; 31698 I:=1; 31699 WHILE I<=LENGTH DO 31700 BEGIN 31701 READ(A68INIT,D.MASK); 31702 IF D.MASK=SZADDR+SZWORD THEN (*IT IS A POINTER*) 31703 BEGIN 31704 READ(A68INIT,POINTER); 31705 POINTER:=POINTER+HEAPSTART; 31706 FRIG.APOINT^:=POINTER; 31707 FRIG.INT:=FRIG.INT+SZWORD+SZWORD; (*POINTER IS 2 WORDS *) 31708 I:=I+2 31709 END 31710 ELSE 31711 BEGIN 31712 READ(A68INIT,D.INT); 31713 FRIG.POINT^:=D.INT; 31714 FRIG.INT:=FRIG.INT+SZWORD; 31715 I:=I+1 31716 END 31717 END 31718 ()+19*) 31719 END 31720 END; 31730 PROCEDURE DUMP(VAR START,FINISH: INTEGER); 31740 VAR STACKSTART,STACKEND,GLOBALLENGTH, 31750 HEAPLENGTH,HEAPSTART: ADDRINT; 31755 I:INTEGER; 31760 P: PINTEGER; 31770 FRIG: RECORD CASE SEVERAL OF 31780 1: (INT:ADDRINT); 2: (POINT:PINTEGER); 31790 3: (PLEXP: PLEX); 4,5,6,7,8,9,10: () 31800 END; 31810 D: RECORD INT,MASK: INTEGER END; 31830 (**) 31840 BEGIN (* DUMP *) 31850 REWRITE(LSTFILE);WRITELN(LSTFILE,' START DUMP'); 31860 (*+05() 31870 OPENLOADFILE(DUMPF, 5, TRUE); 31871 ()+05*) 31880 IF EOF(LGO) THEN ENEW(FRIG.PLEXP,SZREAL) 31890 ELSE ENEW(FRIG.PLEXP,2*SZREAL); 31900 NEW(FRIG.POINT); (*-02() DISPOSE(FRIG.POINT); ()-02*) 31910 HEAPSTART := FRIG.INT; 31920 RESTORE(START,FINISH); 31930 SIN; 31935 (*-02() 31940 NEW(FRIG.POINT); DISPOSE(FRIG.POINT); 31941 ()-02*) 31943 (*+02() 31945 ENEW(FRIG.POINT,100); (* TO MAKE SURE IT GOES AT THE END *) 31947 ()+02*) 31950 HEAPLENGTH := FRIG.INT-HEAPSTART; 31960 STACKSTART := GETADDRESS(START); 31970 STACKEND := GETADDRESS(FINISH); 31980 GLOBALLENGTH := STACKEND-STACKSTART; 31990 WRITE(DUMPF,GLOBALLENGTH,HEAPLENGTH,HEAPSTART); 32000 FRIG.INT := STACKSTART; 32010 FOR I := 1 TO ABS(GLOBALLENGTH) DIV SZWORD DO 32020 BEGIN 32030 WRITE(DUMPF,FRIG.POINT^); 32040 FRIG.INT := FRIG.INT+SZWORD*(ORD(GLOBALLENGTH>0)*2-1); 32050 END; 32060 FRIG.INT := HEAPSTART; 32070 FOR I := 1 TO ABS(HEAPLENGTH) DIV SZWORD DO 32080 BEGIN 32090 WRITE(DUMPF,FRIG.POINT^); 32100 FRIG.INT := FRIG.INT+SZWORD*(ORD(HEAPLENGTH>0)*2-1); 32110 END; 32120 WRITELN(LSTFILE,' DUMPF WRITTEN'); 32130 (**) 32140 WRITELN(LSTFILE,' GLOBAL LENGTH',GLOBALLENGTH,' HEAP LENGTH',HEAPLENGTH); 32150 END; 32160 ()-04*) ()-03*) ()-01*) 32170 (*-01() (*-02() (*-05() 32180 PROCEDURE DUMP(VAR START, FINISH: INTEGER); 32190 BEGIN SIN END; 32200 ()-05*) ()-02*) ()-01*)