Google
 

Trailing-Edge - PDP-10 Archives - AP-D608C-SB - 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;$
				MOVEM	T,LLEXEX;$
				MOVE	T,COMPNAME;$
				MOVEM	T,LCOMPNAME;$
		REVER;
		;HANDLE<REG USED>_LOP<RESULT>;
				HRLZI	T,1;$
				LSH	T,(LOP);$
				IORM	T,HANDLE;$
		CLOSE(LOP);
		    ENDD;
		FI;
	      ENDD;
	    ELSE
	      BEGIN
		;..THE CONTROL VARIABLE CAN HAVE SIDE EFFECTS.
		;..(EG. FORMAL BY NAME OR SUBSCRIPTED VARIABLE
		;..  WITH INDEX CAUSING SIDE EFFECTS).;


		;..CONTROL VARIABLE LEXEME TO SYM.;
		;SYM_VSAVE;
				MOVE	SYM,VSYMSAVE;$
				MOVEM	VLEXSAVE,LEXEX;$
				MOVE	T,VCOMPSAVE;$$
				MOVEM	T,COMPNAME;$$
		;..OUTPUT JRST AROUND INCREMENT TO TEST.;
		;..NO NEED TO WORRY ABOUT RESULT REGISTER
		;..  OF INITIALIZATION SINCE CONTROL VARIABLE
		;..  ADDRESS MUST BE RECOMPUTED ANYWAY.;
		SPLIT(FRETURN);
		;..NOW TO COMPILE CODE FOR INCREMENT (V_V+B).
		;..REMEMBER WE HAVE ONLY ONE PORTION FOR CONTROL VARIABLE.
		;..IT CONTAINS THE CODE TO GET THE LEFT-HAND-VALUE OF THE CONTROL VARIABLE.
		;..OUTPUT THIS PORTION NOW.;
		;FINDEX_INDEX;
				MOVE	T,INDEX;$
				MOVEM	T,FINDEX;$
		KILLAX;
		MOB;
		;INDEX_FINDEX;
				MOVE	T,FINDEX;$
				MOVEM	T,INDEX;$
		;HANDLE_'770000.INDEX';
				HRLI	T,770000;$
				MOVEM	T,HANDLE;$
		IF VRHS = FON
				MOVE	T,VRHSSYM;$
				T.FON(T);$
		  THEN
		    BEGIN
		      ;..THE CONTROL VARIABLE IS A FORMAL.
		      ;..THE PORTION WE HAVE FOR IT WAS CREATED
		      ;..  BY EVAL AS A LEFT-HAND-VALUE CALL ON
		      ;..  ON THE FORMAL LOCATION.
		      ;..BUT WHAT WE NOW NEED IS A PORTION FOR
		      ;..  THE RIGHT-HAND-VALUE SO WE CAN COMPILE
		      ;..  CODE FOR INCREMENT:  V+B.

		      ;..TO DO THIS WE RESTORE SYM WITH ORIGINAL
		      ;..  LEXEME FOR FORMAL IDENTIFIER AND REDO
		      ;..  THE EVAL.  THIS TIME, SINCE OP NE "_",
		      ;..  EVAL WILL GIVE US CODE FOR THE RIGHT-HAND-VALUE.
		      ;SYM_VRHS;
				MOVE	SYM,VRHSSYM;$
				MOVE	T,VRHSLEX;$
				MOVEM	T,LEXEX;$
				MOVE	T,VRHSCOMP;$
				MOVEM	T,COMPNAME;$
		      EVAL;
		      ;LOP_SYM;
				SYMSAVE;$
		    ENDD;
		FI;


		;..NOW COMPILE CODE FOR V+B.;
		;SYM_FBSAVE;
				MOVE	SYM,FBSYMSAVE;$
				MOVE	T,FBLEXSAVE;$
				MOVEM	T,LEXEX;$
				MOVE	T,FBCOMPSAVE;$
				MOVEM	T,COMPNAME;$
		CGBINARY;
		;..NOW WE MUST COMPILE THE ASSIGNMENT V_ [V+B].
		;..REMEMBER THAT THE PORTION TO COMPUTE THE LEFT-HAND-VALUE
		;..  OF CONTROL VARIABLE HAS ALREADY GONE OUT.
		;..SO WE NOW MAKE EMPTY PORTION REFLECTING THAT
		;..  PORTION THAT HAS ALREADY GONE OUT.;
		;LOP_VSAVE;
				MOVE	LOP,VSYMSAVE;$
				MOVEM	VLEXSAVE,LLEXEX;$
				MOVE	T,VCOMPSAVE;$$
				MOVEM	T,LCOMPNAME;$$
		REVER;
		;HANDLE<REG USED>_LOP<RESULT>;
				HRLZI	T,1;$
				LSH	T,(LOP);$
				IORM	T,HANDLE;$
		CLOSE(LOP);
		;..NOW COMPILE THE ASSIGNMENT.;
		CGASS;
		;..NOW TO SET LOP AS LEXEME FOR THE
		;..  CONTROL VARIABLE (V) TO BE USED
		;..  IN THE TEST (V-C).;
		IF VRHS = FON
				MOVE	T,VRHSSYM;$
				T.FON(T);$
		  THEN
		    BEGIN
		      ;..THE CONTROL VARIABLE IS FORMAL BY NAME.
		      ;..ONCE AGAIN, WE MUST CREATE A NEW PORTION
		      ;..  FOR THE RIGHT-HAND-VALUE (TO BE USED
		      ;..  IN THE TEST (V-C).
		      ;LOP_SYM;
				SYMSAVE;
		      ;SYM_VRHS;
				MOVE	SYM,VRHSSYM;$
				MOVE	T,VRHSLEX;$
				MOVEM	T,LEXEX;$
				MOVE	T,VRHSCOMP;$
				MOVEM	T,COMPNAME;$
		      EVAL;
		      ;EXCH(SYM,LOP);
				EXCH	SYM,LOP;$
				MOVE	T,LEXEX;$
				EXCH	T,LLEXEX;$
				MOVEM	T,LEXEX;$
				MOVE	T,COMPNAME;$
				EXCH	T,LCOMPNAME;$
				MOVEM	T,COMPNAME;$
		    ENDD;
		  ELSE
		    ;..CONTROL VARIABLE (V) IS NOT A FORMAL.;
		    ;LOP_VSAVE;
				MOVE	LOP,VSYMSAVE;$
				MOVEM	VLEXSAVE,LLEXEX;$
				MOVE	T,VCOMPSAVE;$$
				MOVEM	T,LCOMPNAME;$$
		FI;
	      ENDD;
	  FI;
	;..AT THIS POINT:
	;..  LOP CONTAINS A LEXEME FOR CONTROL VARIABLE (TO BE USED IN TEST).
	;..  SYM CONTAINS PORTION FOR INCREMENT (WHATEVER PART HAS NOT
	;..  YET GONE OUT).

	;..NOW OUTPUT REMAINING INCREMENT CODE.
	  UNSTACK;
	  KILLAX;
	  ;FINDEX_INDEX;
				MOVE	T,INDEX;$
				MOVEM	T,FINDEX;$
	  LACSAVE(FLACSAVE);
	  MOB;
	  ;..FIXUP JRST AROUND INCREMENT.
	  ;..IF NON-LOCAL DISPLAY NOT THE SAME AS FROM INITIALIZATION
	  ;..  THEN CAUSE IT TO BE RELOADED.;
	  IF CAX NE FRETURN<LHS>
				HLRZ	T,FRETURN;$
				CAMN	T,CAX;$
				GOTO	FALSE;$
	    THEN
		KILLAX;
	  FI;
	  ;FRETURN<LHS>_0;
	  ;T_FRETURN;
				HRRZS	T,FRETURN;$
	  EDIT(052); ALWAYS GENERATE A JUMP, SO ALWAYS FIX IT UP
	  FIXREL;..(FRETURN)
	  ;..SET FRETURN TO POINT TO THE INCREMENT (NECESSARILY
	  ;..  ONE PAST THE JRST AROUND INCREMENT).
	  INCR(FRETURN);
	  VRESTORE;
	  LACRESTORE(FLACSAVE);
	  ;..IF INCREMENT (B) HAS CODE ASSOCIATED WITH IT
	  ;..  THE PORTION POINTER MUST BE RESTORED (SINCE
	  ;..  BY NOW THAT CODE HAS BEEN MERGED WITH OTHER
	  ;..  CODE IN THE EXPRESSION V_V+B.);
	  IF FBSYMSAVE<CODE GENERATED>
				HRRZ	T,FBLEXSAVE;$
				JUMPE	T,FALSE;$
	    THEN
	      ;TC[FBLEXSAVE<HANDLE>]_BPPSAVE;
				MOVE	T1,BPPSAVE;$
				MOVEM	T1,(T);$
	  FI;
	  ;INDEX_FINDEX;
				MOVE	T,FINDEX;$
				MOVEM	T,INDEX;$
	  ;HANDLE_'770000.INDEX';
				HRLI	T,770000;$
				MOVEM	T,HANDLE;$
	  ;..NOW COMPILE AND OUTPUT CODE FOR 
	  ;..  THE TEST: "(V-C)*SIGN(B)>0"  .;
	  ;SYM_FCSAVE;
				MOVE	SYM,FCSYMSAVE;$
				MOVE	T,FCLEXSAVE;$
				MOVEM	T,LEXEX;$
				MOVE	T,FCCOMPSAVE;$
				MOVEM	T,COMPNAME;$

	CGFTEST;
	MOB;
	VRESTORE;
	;LASTLINK<RHS>_RA-1;
				HRRZ	T,RA;$
				SUBI	T,1;$
	;LASTLINK<LHS>_CAX;
				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 THE INCREMENT.;
		BODY;
		;T_'JRST'.FRETURN;
				HRLZI	T,<JRST 0>_-22;$
				HRR	T,FRETURN;$
		MREL;
	    ENDD;
	FI;
     ENDD;
   ELSE
     SEMERR(110,$VAR!$I!$SIM!$DECL,ARITH EXPRESSION);
 FI;
ENDD;
SUBTTL UTILITIES VRESTORE , VGETS , BODY ,SEFFECT.
PROCEDURE VRESTORE;
BEGIN
 IF CODE GENERATED FOR LEFT-HAND SIDE
				HRRZI	T,(VLEXSAVE);$
				JUMPE	T,FALSE;$
   THEN
     BEGIN
	;..RESTORE PORTION POINTER,INDEX, AND HANDLE;
	;INDEX_VLEXSAVE<HANDLE>+1;
	;HANDLE<RHS>_INDEX;
	;HANDLE<LHS>_770000;
	;TC[INDEX-1]_VPSAVE;
				ADDI	T,1;$
				MOVEM	T,INDEX;$
				HRLI	T,770000;$
				MOVEM	T,HANDLE;$
				MOVE	T1,VPSAVE;$
				MOVEM	T1,-1(T);$
     ENDD;
 FI;
ENDD;
PROCEDURE VGETS;
BEGIN
 EVAL;
 IF SYM = ARITH EXPRESSION
				T.AE;$
   THEN
     BEGIN
	;LEFTOP_VSAVE;
				MOVE	LOP,VSYMSAVE;$
				MOVEM	VLEXSAVE,LLEXEX;$
				MOVE	T,VCOMPSAVE;$$
				MOVEM	T,LCOMPNAME;$$
	CGASS;
	UNSTACK;
	LACSAVE(FLACSAVE);
	MOB;
	LACRESTORE(FLACSAVE);
	VRESTORE;
     ENDD;
   ELSE
     SEMERR(111,$VAR!$I!$SIM!$DECL,ARITHMETIC EXPRESSION);
 FI;
ENDD;
PROCEDURE BODY;
BEGIN
;..PLACE INSTRUCTION FOR PASSING CONTROL TO THE FOR-BODY.
;..IF MORE THAN ONE LIST-ELEMENT IS PRESENT, THEN GET TO
;..	BODY WITH JSP AX,BODY. 
;..	BODY WILL SAVE AX IN ITS LOCAL VARIABLE IN STACK
;..	BODY WILL THEN RETURN WITH JRSTF @ITS LOCAL.
;..IF ONLY ONE LIST ELEMENT, THEN FALL THRU TO BODY.
;..A BACKCHAIN OF REFERENCES TO THE BODY IS KEPT (LIST HEAD IN FORCHAIN).
;..AFTER RETURN FROM THE BODY, NON-LOCAL DISPLAY (AX) IS UNDEFINED .;
 ;T<LHS>_'JSP AX,.-.';
				HRLZI	T,<JSP AX,.-.>_-22;$
;T<RHS>_FORCHAIN;
				HRR	T,FORCHAIN;$
;FORCHAIN_RA;
				MOVE	T1,RA;$
				MOVEM	T1,FORCHAIN;$
MREL;

KILLAX;
ENDD;
PROCEDURE SEFFECT;
BEGIN
 ;..ROUTINE TO DETERMINE IF THE EXPRESSION WHOSE LEXEME IS IN SYM
 ;..  CAN HAVE ANY SIDE EFFECT ON THE ADDRESS OF THE CONTROL VARIABLE.;
 IF CONTROL VARIABLE HAS CODE GENERATED AND SYM IS P-TYPE AND HAS ACCESS TO V
				T.COGE(VSYMSAVE);$
				SKIPL	T,LEXEX;$
				GOTO	FALSE;$
				TLZ	T,-1-$LEXBL;$
				ADD	T,VLEXSAVE;$
				JUMPL	T,TRUE;$
				MOVE	T,VCOMPSAVE;$
				TDNN	T,COMPNAME;$
				GOTO	FALSE;$
   THEN
    SETT(SIDEFFECT);
 FI;
ENDD;
SUBTTL ROUTINE SFOR.
 SFOR1:
 MRK.1;	OUTPUT CODE MARKER
 IF SYM NE PHI
				JUMPE	SYM,FALSE;$
   THEN
     FAIL(8,SOFT,SYM,SYMBOL NOT PERMITTED HERE)
   FI;
 ;ST8_STOPS;
 ;STOPS_STOPS OR COMMA OR DO;
				SETSTOPS(ST8,.COM+.DO);$
 RUND;
 ;..PARSE AND COMPILE THE CONTROL VARIABLE (V).;
 IF DEL = LBRA
				CAME	DEL,ZLBRA;$
				GOTO	FALSE;$
   THEN
     ;CALL SBRACK;
				SBRACK;$
				NOOP	.SSEL;$
 FI;
 IF DEL NE '_' 
				CAMN	DEL,ZASS;$
				GOTO	FALSE;$
   THEN
     BEGIN
       IF DEL = DOT
				CAME	DEL,ZDOT;$
				GOTO	FALSE;$
	 THEN
	   FAIL(46,HARD,DEL,BYTE SELECTOR NOT LEGAL CONTROL VARIABLE);
	 ELSE
	   FAIL(47,HARD,DEL,ASSIGN. SYMBOL NOT FOUND);
       FI;
     ENDD
   ELSE
     SFALSE(ERRL);
 FI;
 CODE GFOR1;
;----
 IF SYM<KIND>=VAR AND SYM<TYPE>=ARITHMETIC AND SYM<DECL>
				TLNN	SYM,$KIND!$ARC;$
				TLNN	SYM,$DECL;$
				GOTO	FALSE;$
   THEN
     BEGIN
	;VRHS_SYM;
				MOVEM	SYM,VRHSSYM;$
				MOVE	T,LEXEX;$
				MOVEM	T,VRHSLEX;$
				MOVE	T,COMPNAME;$
				MOVEM	T,VRHSCOMP;$
	EVAL;
     ENDD;
   ELSE
     SEMERR(112,$VAR!$I!$SIM!$DECL,ARITHMETIC LEFT-HAND VALUE);
    ;VRHS_SYM;
				MOVEM	SYM,VRHSSYM;$
 FI;
 ;VSAVE_SYM;
				MOVE	VSYMSAVE,SYM;$
				MOVE	VLEXSAVE,LEXEX;$
				MOVE	T,COMPNAME;$$
				MOVEM	T,VCOMPSAVE;$$
 ;VPSAVE_TC[INDEX-1];
				MOVE	T,INDEX;$
				MOVE	T,-1(T);$
				MOVEM	T,VPSAVE;$
 LACSAVE(VLACSAVE);
 ZERO(FORCHAIN);
 ;LASTLINK<LHS>_CAX;
 ;LASTLINK<RHS>_0;
				HRLZ	T,CAX;$
				MOVEM	T,LASTLINK;$
;-------
 ENDCODE;
 LOOP
   BEGIN
   	RUND;
	;STOPS_STOPS OR [STEP UNTIL WHILE];
				ADDSTOPS(.STEP!.UNTIL!.WHILE);$
	ESEL;
	CODE GFOR2;
;	----
	;..RESOLVE THE LINKAGE FROM THE PREVIOUS FOR-LIST-ELEMENT.
	;..IF PREVIOUS ELEMENT MERELY FALLS THROUGH TO THE NEXT,
	;.. OR IF THIS IS THE FIRST ELEMENT, THEN LASTLINK EQUALS 0.
	;..OTHERWISE, LASTLINK<RHS>=LOCATION OF JRST TO  NEXT ELEMENT
	;.. AND       LASTLINK<LHS>=VALUE OF NON-LOCAL DISPLAY (AX) AT THAT POINT.
	JOIN(LASTLINK);
;	-------
	ENDCODE;
	IF DEL ELEMENT [STEP UNTIL WHILE]
				DELEL(.STEP!.UNTIL!.WHILE);$
	   THEN
		BEGIN
		 ;STOPS_STOPS - [STEP UNTIL WHILE];
				$HALVE(.STEP!.UNTIL!.WHILE);$
				TLZ	STOPS,LH;$
		 FSELECT;
		ENDD
	   ELSE
		CODE GFOR3;
;		----
		;..SIMPLE LIST ELEMENT;

		;..ASSIGN VALUE TO CONTROL VARIABLE;
		VGETS;

		;..GOTO FOR-BODY OR FALL THROUGH;
		 IF FORCHAIN = 0 AND DEL = DO
				SKIPE	FORCHAIN;$
				GOTO	FALSE;$
				DELEL(.DO);$
		   THEN
		     ;..ONLY ONE LIST ELEMENT;
		     ZERO(FRETURN);
		   ELSE
		     BEGIN
			;..MORE THAN ONE ELEMENT;
			BODY;
			ZERO(LASTLINK);
			IF DEL = DO
				DELEL(.DO);$
			  THEN
			    SPLIT(LASTLINK)
			FI;
		     ENDD;
		 FI;
;		-------
		ENDCODE;
	FI;
	LACRESTORE(VLACSAVE);
	SFALSE(ERRL);
   ENDD
 AS DEL = COMMA;
				DELEL(.COM);$
 SA;
 ;STOPS_ST8;
				RESTOPS(ST8);$
 IF DEL NE 'DO' 
				DELNEL(.DO);$
   THEN
     FAIL(48,HARD,DEL,DO WAS NOT FOUND)
   ELSE
     BEGIN
	LACINIT;

EDIT(125) ;  MAKE BODY OF FOR STATEMENT A BLOCK

	BENTRY;  [E125]
	RUND2;
	CODE GFOR4;
;	----
	IF FORCHAIN NE 0
				SKIPN	T,FORCHAIN;$
				GOTO	FALSE;$
	 THEN
	  BEGIN
	   ;..RESOLVE BACKCHAIN OF JSP'S TO FOR BODY;
	   FIXREL;..(T);
	   ;..SAVE RETURN LOCATION IN LOCAL VARIABLE IN STACK;
	   ;T_'MOVEM AX,FSDISP(DL)';
				HRLZI	T,<MOVEM AX,.-.(DL)>_-22;$
				HRR	T,FSDISP;$
	   MABS;
	   INCR(FSDISP);
	  ENDD;
	FI;
	KILLAX;
	;..EMPTY TEMPCODE BUFFER;
	;INDEX_TCBASE;
	;HANDLE_770000,TCBASE;
				MOVE	T,TCBASE;$
				MOVEM	T,INDEX;$
				HRLI	T,770000;$
				MOVEM	T,HANDLE;$
;	-------
	ENDCODE;
	MRK.2;	PLACE 'DO' MARKER
	SSEL;
	CODE GFOR5;
;	----
	;..COMPLETE CODE FOR THE FOR-BODY;
	GSTAT;

	;..PLACE INSTRUCTION TO RETURN TO FOR-LIST-ELEMENT;
	IF FORCHAIN = 0
				SKIPE	FORCHAIN;$
				GOTO	FALSE;$
	 THEN
	   BEGIN
	   IF FRETURN NE 0
				SKIPN	FRETURN;$
				GOTO	FALSE;$
	     THEN
	       BEGIN
		;T_'JRST'.FRETURN;
				HRRZ	T,FRETURN
				HRLI	T,<JRST 0>_-22;$
		MREL;
	       ENDD;
	   FI;
	   ENDD;
	 ELSE
	  BEGIN
	    ;..RETURN THROUGH LOCAL VARIABLE IN STACK;
	    ;MXDISP_MAX(MXDISP,FSDISP);
				MOVE	T,FSDISP;$
				CAMLE	T,MXDISP;$
				MOVEM	T,MXDISP;$
	    ;T_FSDISP_FSDISP-1;
				SOS	T,FSDISP;$
	    ;T_'JRST @FSDISP(DL)';
				HRLI	T,<JRST @.-.(DL)>_-22;$
	    MABS;
	   ENDD;
	FI;

	;..RESOLVE THE JRST AROUND FOR-BODY;
	;..RESTORE THE NON-LOCAL DISPLAY (AX) TO VALUE AT LAST ELEMENT;
	JOIN(LASTLINK);
	BEXIT; [E125]
	MRK.3;	PLACE 'OD' MARKER
;	-------
	ENDCODE;
	SFALSE(ERRL);
     ENDD
 FI;
 IF DEL = 'ELSE' AND OLDEL = 'STHEN'
				DELEL(.ELSE);$
				MOVE	T,OLDEL;$
				TEL(OTHEN);$
   THEN
     FAIL(81,HARD,DEL,FOR STATEMENT IS NOT UNCONDITIONAL STATEMET)
 FI;
 CODE GFOR6;
;----
 STATEMENT;
;-------
 ENDCODE;
ENDD;
ENDD; OF MODULE MFOR

LIT
END