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