Google
 

Trailing-Edge - PDP-10 Archives - AP-5471B-BM - sources/algfor.mac
There are 8 other files named algfor.mac in the archive. Click here to see a list.
;
;
;
;
;
;
;	COPYRIGHT (C) 1975,1976,1977,1978
;	DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;	THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
;	SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION
;	OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY OTHER
;	COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE
;	TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
;	AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
;	SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
;
;	THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
;	NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
;	EQUIPMENT CORPORATION.
;
;	DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;	SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
;
;SUBTTL FOR STATEMENT MODULE

; COPYRIGHT 1971,1972,1973,1974 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

; WRITTEN BY T. TEITELBAUM, L. SNYDER, C.M.U.
; EDITED BY R. M. DE MORGAN.

	HISEG

	SEARCH ALGPRM,ALGMAC	; SEARCH PARAMETER FILES
MODULE MFOR;
BEGIN
$PLEVEL=1;
 EXTERN STABLE,ETABLE,LTABLE,FTABLE,DCBYTE,PRIOBYTE,DESCBYTE;
EXPROC FAIL,BENTRY,BEXIT,RUND,SBRACK,RUND2,RUND5,ERREAD,ERR;
EXPROC CGASS,CGBINARY,CGFTEST,CGINCR,EVAL,GBOOL,GSTAT,MJRST0;
EXPROC MPS,MREL,UNSTACK,CLOSE,MABS,MOB,RAFIX,SEMERR;
EXPROC	MRK.1,MRK.2,MRK.3;
FAKE FORMCT,PNAME,FSDISP,MXDISP,ST11,RELBLOCK,PARAM1;
SUBTTL ROUTINE FOR <UNLABELLED FOR STATEMENT>.
;
;PARSE:		<UNLABELLED FOR STATEMENT>::=FOR <VARIABLE> := <FOR LIST> DO <STATEMENT>
;
;			WHERE <FOR LIST>::=<FOR LIST ELEMENT>/
;					  <FOR LIST>,<FOR LIST ELEMENT>
;			AND <FOR LIST ELEMENT>::=<ARITH-EXP>/
;						<ARITH-EXP>STEP<ARITH-EXP>UNTIL<ARITH-EXP>/
;						<ARITH-EXP>UNTIL<ARITH-EXP>/
;						<ARITH-EXP>WHILE<BOOLEAN EXPRESSION>
;
;SYNTAX ERRORS:
;		FOR NOT PRECEDED BY A DELIMITER
;			BEGIN X FOR I := 1, 2, 3 DO S END
;			      ^
;
;		COLON-EQUAL NOT FOUND IN FOR STATEMENT
;			FOR I = 1, 2, 3 DO S
;			      ^
;
;		PENDING STOPPER ENCOUNTERED BEFORE DO
;			FOR I := 1; 2; 3 DO S
;				  ^
;
;		FOR STATEMENT OCCURS WHERE ONLY <UNCONDITIONAL STATEMENT> IS ALLOWED
;			IF B THEN FOR I := 1,2,3 DO S ELSE S;
;							 ^
;
;SEMANTIC ERRORS:
;		NOT <STATEMENT>
;			FOR I := 1,2,3 DO A[I];
;					     ^
PROCEDURE SFOR
BEGIN
 NEWLOP;
 REGISTER LOP,VSYMSAVE,VLEXSAVE;
;..IF THE "LOCALS IN MEMORY" VERSION IS USED, A SMALL SAVINGS CAN BE
;..REALIZED BY INCREASING RMAX,DECLARING VCOMPSAVE AS A LOCAL REGISTER
;..AND MODIFING THE APPROPRIATE INSTRUCTIONS (THOSE ENDING IN ;$$)
 LOCAL ST8,FORCHAIN,LASTLINK,FRETURN,VPSAVE,VLACSAVE,VCOMPSAVE;
 FORMAL OLDEL;
 OWN FINDEX,FCSYMSAVE,FCLEXSAVE,FCCOMPSAVE,BPPSAVE;
 OWN FLACSAVE,VRHSSYM,VRHSLEX,VRHSCOMP,SIDEFFECT;
 GOTO SFOR1;
SUBTTL ROUTINE FOR THE LIST-ELEMENT: " ,A STEP B UNTIL C, "
;..THE CODE PRODUCED FOR THIS LIST-ELEMENT
;..  FOLLOWS THE OUTLINE:
;..		V_A;
;..		GOTO BETA;
;..	ALPHA:	V_V+B;
;..	 BETA:	IF (V-C)*SIGN(B)>0 THEN GOTO GAMMA;
;..		...BODY...
;..		GOTO ALPHA;
;..	GAMMA:	...

;..HOWEVER, EFFORT IS MADE TO TAKE ADVANTAGE OF CASES WHERE
;..  EXPRESSIONS ARE CONSTANT OR CAN HAVE NO SIDE EFFECTS.
;..FOR EXAMPLE:
;..	FOR V_0 STEP 1 UNTIL 100 DO ...
;..		SETZB	13,V
;..		JRST	BETA
;..	ALPHA:	AOS	13,V
;..	 BETA:	CAILE	13,144
;..		JRST	GAMMA
;..		...BODY...
;..		JRST	ALPHA
;..	GAMMA:	...

;..BUT WHEN SIDE EFFECTS MAY OCCUR, WE MUST ALLOW FOR THE
;..  FULL GENERALITY OF ALGOL.
;..FOR EXAMPLE, LET F BE AN INTEGER FORMAL BY NAME:
;..	FOR F_F STEP F UNTIL F DO ...
;..		XCT	1,F[0]	;GET ADDRESS OF CONTROL VARIABLE
;..		PUSH	17,2	;  AND PUSH IT ONTO STACK.
;..		XCT	F[0]	;GET INITIALIZATION VALUE
;..		MOVE	2,(17)	;  AND STORE IT INTO
;..		XCT	F[1]	;  THE CONTROL VARIABLE.
;..		SUB	17,[XWD 1,1]	;RESTORE STACK POINTER.
;..		JRST	BETA	;JUMP AROUND INCREMENT.
;..	ALPHA:	XCT	1,F[0]	;GET ADDRESS OF CONTROL VARIABLE
;..		PUSH	17,2	;  AND PUSH IT ONTO STACK.
;..		XCT	F[0]	;GET CURRENT VALUE OF CONTROL VARIABLE
;..		PUSH	17,0	;  AND PUSH IT ONTO STACK.
;..		XCT	F[0]	;GET CURRENT VALUE OF INCREMENT,
;..		ADD	0,(17)	;   ADD TO CONTROL VARIABLE,
;..		MOVE	2,-1(17);  AND STORE.
;..		XCT	F[1]
;..		SUB	17,[XWD 2,2]	;RESTORE STACK POINTER
;..	 BETA:	XCT	F[0]	;GET CURRENT VALUE OF CONTROL VARIABLE
;..		PUSH	17,0	;  AND PUSH ONTO STACK.
;..		XCT	F[0]	;GET CURRENT VALUE OF FINAL VALUE
;..		MOVE	13,(17) ;  AND SUBTRACT FROM
;..		SUB	13,0	;  CONTROL VARIABLE.
;..		PUSH	17,13	;PUSH DIFFERENCE ONTO STACK.
;..		XCT	F[0]	;GET CURRENT VALUE OF INCREMENT.
;..		IMUL	0,(17)	;NOW WE HAVE "(V-C)*B".
;..		SUB	17,[XWD 2,2]	;RESTORE STACK POINTER.
;..		JUMPG	0,GAMMA ;GOTO ELEMENT EXHAUSTED IF >0.
;..		...BODY...
;..		JRST	ALPHA	;LOOP BACK TO INCREMENT.
;..	GAMMA:	...
PROCEDURE SSTEP;
BEGIN
 LOCAL ST14;
 ;..ON ENTRY, THE INITIAL VALUE (A) HAS BEEN ALREADY PARSED
 ;..  AND COMPILED AND RESIDES IN SYM.;

 ;..NOW COMPILE THE ASSIGNMENT OF THIS INITIAL VALUE TO
 ;..  THE CONTROL VARIABLE (V_A).;
 CODE GSTP1;
;----
 GSTP1;
;-------
 ENDCODE;
 SFALSE(ERRL);
 ;..PARSE AND COMPILE THE STEP-EXPRESSION (B).;
 ;ST14_STOPS;
 ;STOPS_STOPS OR 'UNTIL';
				SETSTOPS(ST14,.UNTIL);$
 RUND;
 ESEL;
 ;STOPS_ST14;
				RESTOPS(ST14);$
 IF DEL = 'UNTIL'
				DELEL(.UNTIL);$
   THEN
     BEGIN
	;..SAVE THE STEP-EXPRESSION LEXEME (B).;
	CODE GSTP2;
;	----
	GSTP2;
;	-------
	ENDCODE;
	SFALSE(ERRL);
	;..PARSE AND COMPILE THE UNTIL-EXPRESSION (C).;
	RUND;
	ESEL;
	;..NOW COMPLETE THE CODE FOR THIS LIST-ELEMENT.;
	CODE GSTP3;
;	----
	GSTP3;
;	-------
	ENDCODE;
	SFALSE(ERRL);
     ENDD
   ELSE
     IF NOT ERRL
				TNGB(ERRL);$
       THEN
	 FAIL(45,HARD,DEL,UNTIL EXPRESSION NOT FOUND);
     FI
 FI;
ENDD;
SUBTTL ROUTINE FOR LIST ELEMENT: " ,A UNTIL C, "
PROCEDURE SUNTIL;
BEGIN
 ;..ON ENTRY, THE INITIAL VALUE (A) HAS ALREADY BEEN COMPILED
 ;..  AND ITS LEXEME IS IN SYM.;

 CODE GUNT1;
;----
   ;..NOW COMPILE THE ASSIGNMENT OF THIS INITIAL VALUE (V_A).;
   GSTP1;
   ;..FAKE THE STEP-EXPRESSION AS LEXEME FOR CONSTANT=1 AND SAVE AS B.;
   ;SYM_1;
				HRRZI	SYM,1;$
				HRLI	SYM,$EXP!$I!$SIM!$DECL!$IMM;$
				ZERO(LEXEX);$
				ZERO(COMPNAME);
   GSTP2;
;-------
 ENDCODE;
 SFALSE(ERRL);
 ;..PARSE AND COMPILE UNTIL-EXPRESSION.;
 RUND;
 ESEL;
 ;..NOW COMPLETE THE CODE FOR THIS LIST-ELEMENT.;
 CODE GUNT2;
;----
 GSTP3;
;-------
 ENDCODE;
 SFALSE(ERRL);
ENDD;
SUBTTL ROUTINE FOR LIST-ELEMENT: " ,A WHILE BE, "
PROCEDURE SFWHIL;
BEGIN
 ;..ON ENTRY, THE ARITHMETIC EXPRESSION (A) HAS ALREADY BEEN
 ;..  COMPILED AND ITS LEXEME IS IN SYM.;

 ;..NOW COMPILE CODE FOR THE ASSIGNMENT (V_A).;
 CODE GFWH1;
;----
 ;FRETURN_RA;
				MOVE	T,RA;$
				MOVEM	T,FRETURN;$
 KILLAX;
 VGETS;
 LACINIT;
;-------
 ENDCODE;
 SFALSE(ERRL);
 ;..PARSE AND COMPILE THE BOOLEAN EXPRESSION.;
 RUND;
 ESEL;
 CODE GFWH2;
;----
 ;..COMPILE CODE FOR "IF NOT BE THEN GOTO ELEMENT EXHAUSTED.;
 GBOOL;
 MOB;
 ;LASTLINK<RHS>_(RA-1);
 ;LASTLINK<LHS>_CAX;
				MOVE	T,RA;$
				SUBI	T,1;$
				HRL	T,CAX;$
				MOVEM	T,LASTLINK;$
 IF FORCHAIN NE 0 OR DEL NE DO
				SKIPE	FORCHAIN;$
				GOTO	TRUE;$
				DELNEL(.DO);$
   THEN
     BEGIN
	;..FOR HAS MULTIPLE LIST-ELEMENTS, SO
	;..  PLACE CALL ON BODY AND THE RETURN
	;..  JUMP BACK TO ARITHMETIC EXPRESSION (A).;
	BODY;
	;T_'JRST'.FRETURN;
				HRRZ	T,FRETURN;$
				HRLI	T,<JRST 0>_-22;$
	MREL;
     ENDD;
 FI;
;-------
 ENDCODE;
 SFALSE(ERRL)
ENDD;
SUBTTL CODE GENERATORS FOR THE STEP-ELEMENT.
PROCEDURE GSTP1;
BEGIN
 ;..DETERMINE IF INITIAL VALUE (A) CAN HAVE SIDE EFFECT ON
 ;..  THE ADDRESS OF CONTROL VARIABLE (V).;
 SETF(SIDEFFECT);
 SEFFECT;

 ;..COMPILE AND OUTPUT CODE FOR INITIALIZATION ASSIGNMENT (V_A).;
 VGETS;

 ;..SAVE RESULT REGISTER OF THIS ASSIGNMENT AS THE PREFERED
 ;..  RESULT REGISTER OF THE INCREMENT.;
 ;PREFACC_SYM<RESULT>;
				HRRZM	SYM,PREFACC;$
ENDD;
PROCEDURE GSTP2;
BEGIN
 EVAL;
 IF SYM NE ARITH EXPRESSION
				TLNN	SYM,$ARR!$ARC;$
				TLNN	SYM,$DECL;$
				GOTO	TRUE;$
				GOTO	FALSE;$
   THEN
     SEMERR(109,$VAR!$I!$SIM!$DECL,ARITHMETIC EXPRESSION);
 FI;
 ;FBSAVE_SYM;
				MOVEM	SYM,FBSYMSAVE;$
				MOVE	T,LEXEX;$
				MOVEM	T,FBLEXSAVE;$
				MOVE	T,COMPNAME;$
				MOVEM	T,FBCOMPSAVE;$
 ;BPPSAVE_TC[INDEX-1];
				MOVE	T,INDEX;$
				MOVE	T,-1(T);$
				MOVEM	T,BPPSAVE;$
ENDD;
PROCEDURE GSTP3;
BEGIN
 ;..SYM CONTAINS THE UNTIL EXPRESSION.;
 EVAL;
if any thunks caused by step or until
				skipn	t,thunk;$
				goto	false;$
   then
     ;..restore ax to what it was before jrst;
     ;..cax_thunk<lhs>;
				hlrzm	t,cax;$
     ;..fix up jrst over the thunks;
     fixrel;
     zero(thunk);
 fi;
 IF SYM = ARITH EXPRESSION
				T.AE;$
   THEN
     BEGIN
	;..SAVE UNTIL EXPRESSION LEXEME.;
	;FCSAVE_SYM;
				MOVEM	SYM,FCSYMSAVE;$
				MOVE	T,LEXEX;$
				MOVEM	T,FCLEXSAVE;$
				MOVE	T,COMPNAME;$
				MOVEM	T,FCCOMPSAVE;$
	;FINDEX_INDEX;
				MOVE	T,INDEX;$
				MOVEM	T,FINDEX;$
	;OP_'BINARY PLUS LEXEME';
				MOVE	T,ZPLUS;$
				MOVEM	T,OP;$
	;..STEP EXPRESSION LEXEME TO SYM.;
	;SYM_FBSAVE;
				MOVE	SYM,FBSYMSAVE;$
				MOVE	T,FBLEXSAVE;$
				MOVEM	T,LEXEX;$
				MOVE	T,FBCOMPSAVE;$
				MOVEM	T,COMPNAME;$
	;..CONTROL VARIABLE LEXEME TO LOP.;
	;LOP_VSAVE;
				MOVE	LOP,VSYMSAVE;$
				MOVEM	VLEXSAVE,LLEXEX;$
				MOVE	T,VCOMPSAVE;$$
				MOVEM	T,LCOMPNAME;$$

	  IF V IS VTYPE
				JUMPL	VLEXSAVE,FALSE;$
	    THEN
	      BEGIN
		;..CONTROL VARIABLE HAS NO SIDE EFFECTS.;

		;..DETERMINE IF THE INCREMENT EXPRESSION (B)
		;..  CAN HAVE SIDE EFFECTS ON THE ADDRESS OF
		;..  THE CONTROL VARIABLE (V).;
		SEFFECT;

		IF OPTIMIZING CASE
				TLNE	LOP,60000;$
				GOTO	FALSE;$
				TLNE	SYM,60000;$
				GOTO	FALSE;$
				TLNN	SYM,$TYPE-$I;$
				GOTO	TRUE;$
				T.R(LOP);$
		  THEN
		    ;..<V,B> IS EITHER <INT,INT>, <REAL,REAL>, OR <REAL,INT>.

		    ;..INCREMENT CAN BE DONE WITH EITHER
		    ;..AOS, SOS, ADDB, OR FADDB.;
		    CGINCR;
		  ELSE
		    BEGIN
		    ;..INCREMENT MUST BE COMPILED AS THOUGH "V_V+B".;
		    IF LOP<CODE GEN>
				T.COGE(LOP);$
		      THEN
		      BEGIN
			;..CONTROL VARIABLE HAS CODE GENERATED ALREADY.
			;..(IE. SUBSCRIPTED ARRAY VARIABLE).
			;..CREATE EMPTY PORTION REFLECTING RESULT REGISTER
			;..  AND REGISTERS USED OF THE CONTROL VARIABLE PORTION.;
			;..MAKE THIS PORTION P-TYPE TO PREVENT REVERSAL.;
			;HANDLE<REG USED>_LOP<RESULT>;
				HRLZI	T,1;$
				LSH	T,(LOP);$
				IORM	T,HANDLE;$
			REVER;
			CLOSE(LOP);
			;LOP<SA>_0;
				MOVE	T,LLEXEX;$
				TLZ	T,$LEXSA;$
			;LOP_P-TYPE;
				TLO	T,400000;$
				MOVEM	T,LLEXEX;$
		      ENDD;
		    FI;
		    ;..NOW COMPILE CODE FOR V+B.;
		    CGBINARY;
		    ;..CONTROL VARIABLE LEXEME TO LOP.;
		    ;..FORCE TO P-TYPE TO PREVENT REVERSAL.;
		    ;LOP_VSAVE;
				MOVE	LOP,VSYMSAVE;$
				MOVEM	VLEXSAVE,T;$
				MOVE	T1,VCOMPSAVE;$$
				MOVEM	T1,LCOMPNAME;$$
		    ;LOP_P-TYPE;
				TLO	T,400000;$
				MOVEM	T,LLEXEX$
		    ;..NOW COMPILE CODE FOR THE ASSIGNMENT  V_ [V+B].;
		    CGASS;
		  ENDD;
		FI;
		;..NOW TO SET LOP AS LEXEME FOR CONTROL VARIABLE (V)
		;..  TO BE USED IN THE TEST (V-C).;
		IF A OR B CAN CHANGE THE ADDRESS OF V = SUBSCRIPTED VARIABLE
				SKIPN	SIDEFFECT;$
				GOTO	FALSE;$
		  THEN
		    BEGIN
		      ;..CONTROL VARIABLE MUST BE RELOADED FOR TEST (V-C).;

		      ;..OUTPUT JRST FROM INITIALIZATION
		      ;..  AROUND INCREMENT TO TEST.;
		      SPLIT(FRETURN);

		      ;LOP_VSAVE;
				MOVE	LOP,VSYMSAVE;$
				MOVEM	VLEXSAVE,LLEXEX;$
				MOVE	T,VCOMPSAVE;$$
				MOVEM	T,LCOMPNAME;$$
		    ENDD
		  ELSE
		    BEGIN
		    ;..THE VALUE OF THE CONTROL VARIABLE SITTING
		    ;..  IN A REGISTER AFTER THE INCREMENT CAN
		    ;..  BE USED FOR THE TEST (V-C).;
		    IF SYM<RESULT> NE PREFACC
				MOVEI	T,(SYM);$
				CAMN	T,PREFACC;$
				GOTO	FALSE;$
		  THEN
		    ;..THE RESULT REGISTER OF THE INCREMENT
		    ;..  IS NOT THE SAME AS THE RESULT REGISTER
		    ;..  OF THE CONTROL VARIABLE INITIALIZATION.
		    ;..THEREFORE, COMPILE CODE TO MOVE INITIAL
		    ;..  VALUE TO REGISTER OF INCREMENT SO THAT
		    ;..  TEST CODE CAN BE SHARED.
		    ;..THE INITIALIZATION CODE HAS ALREADY BEEN
		    ;..  OUTPUT SO THIS MOVE MAY GO STRAIGHT OUT.;

		    IF SYM ELEM [LONGREAL COMPLEX]
				T.TWO;$
		      THEN
			;T_'DMOVEM PREFACC,SYM<RESULT>';
				HRLZI	T,<LMOVEM 0>_-22!$ACC;$
		      ELSE
			;T_'MOVEM PREFACC,SYM<RESULT>';
				HRLZI	T,<MOVEM 0>_-22!$ACC;$
		      FI;
				HRLZ	T1,PREFACC;$
				LSH	T1,5;$
				IOR	T,T1;$
				HRR	T,SYM;$
		    MPS;
		FI;


		;..SET UP AS IF FOR SPLIT(FRETURN)
				HRRZ	T,RA;$
				HRL	T,CAX;$
				MOVEM	T,FRETURN;$
		EDIT(052);Can't "SKIP" over increment by "AOSA", as if the controlled
			 ;variable requires a different context to be set up, the
			 ;increment will take more than one instruction !
		;..IF PREFACC=A1 THEN THE INITIAL VALUE WAS A FORMAL,
		;..SO COERCE VALUE INTO A1.
				MOVEI	T,A1		; [E052]
				CAME	A1,PREFACC	; [E052]
				JRST	.+4		; [E052]
				MOVSI	T,(MOVE A1,A0)	; [E052]
				PUSHJ	SP,.MABS	; [E052]
				AOS	FRETURN		; [E052]
		;NOW ISSUE JUMP OVER INCREMENT.
				HRLZI	T,<JRST	0>_-22;$
				PUSHJ	SP,.MABS;$
		;..CREATE EMPTY PORTION IN LOP REFLECTING
		;..  THE RESULT REGISTER OF THE INCREMENT.;
		;..SINCE THIS REGISTER CONTAINS THE LATEST
		;..  VALUE OF THE CONTROL VARIABLE, IT IS USED
		;..  IN THE TEST (V-C) RATHER THEN REFETCHING FROM STORAGE.;
		;..THIS IS LEGAL SINCE WE KNOW THAT THE CONTROL
		;..  VARIABLE CAN HAVE NO SIDE EFFECTS.;
		;LOP<SA>_0;
		;LOP_SYM;
				MOVE	LOP,SYM;$
				MOVE	T,LEXEX;$
				TLZ	T,$LEXSA;$
				MOV