Trailing-Edge
-
PDP-10 Archives
-
ALGOL-20_1-29-82
-
algol-sources/algfor.mac
There are 8 other files named algfor.mac in the archive. Click here to see a list.
;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND 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. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;SUBTTL FOR STATEMENT MODULE
; 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