; ; ;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 . ; ;PARSE: ::=FOR := DO ; ; WHERE ::=/ ; , ; AND ::=/ ; STEPUNTIL/ ; UNTIL/ ; WHILE ; ;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 IS ALLOWED ; IF B THEN FOR I := 1,2,3 DO S ELSE S; ; ^ ; ;SEMANTIC ERRORS: ; NOT ; 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_(RA-1); ;LASTLINK_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,_-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; 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; 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 ;.. IS EITHER , , OR . ;..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 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_LOP; HRLZI T,1;$ LSH T,(LOP);$ IORM T,HANDLE;$ REVER; CLOSE(LOP); ;LOP_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 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'; HRLZI T,_-22!$ACC;$ ELSE ;T_'MOVEM PREFACC,SYM'; HRLZI T,_-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,_-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_0; ;LOP_SYM; MOVE LOP,SYM;$ MOVE T,LEXEX;$ TLZ T,$LEXSA;$ MOVEM T,LLEXEX;$ MOVE T,COMPNAME;$ MOVEM T,LCOMPNAME;$ REVER; ;HANDLE_LOP; 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_LOP; 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 HLRZ T,FRETURN;$ CAMN T,CAX;$ GOTO FALSE;$ THEN KILLAX; FI; ;FRETURN_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 HRRZ T,FBLEXSAVE;$ JUMPE T,FALSE;$ THEN ;TC[FBLEXSAVE]_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_RA-1; HRRZ T,RA;$ SUBI T,1;$ ;LASTLINK_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,_-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+1; ;HANDLE_INDEX; ;HANDLE_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_'JSP AX,.-.'; HRLZI T,_-22;$ ;T_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=VAR AND SYM=ARITHMETIC AND SYM 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_CAX; ;LASTLINK_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=LOCATION OF JRST TO NEXT ELEMENT ;.. AND LASTLINK=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,_-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,_-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,_-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