; ; ;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 CODE GENERATION ROUTINES PART 2 ; WRITTEN BY H. VAN ZOEREN, C.M.U. ; EDITED BY R. M. DE MORGAN and Andrew J. Skinner HISEG SEARCH ALGPRM,ALGMAC ; SEARCH PARAMETER FILES MODULE MFUN; $PLEVEL=2; BEGIN EXPROC CGBIN EXPROC CLOSE EXPROC EMITCODE EXPROC ERRLEX EXPROC FAIL EXPROC GLOAD EXPROC IPLUNK EXPROC LOAD EXPROC MERGEPORTIONS EXPROC PLUNK EXPROC REOPEN EXPROC REVORDER EXPROC TOCT1 EXPROC TOCT2 EXPROC UNSTACK INTERN CTILR,CTLRI,CTLRR INTERN POWC1,POWC2,POWC3 EXTERN PRASE,ZABS,ZBOOL,ZENTIER,ZINT,ZSIGN EXTERN OPABS,OPENT1,OPENT2,OPENT3,OPJSPX,OPMVMS,OPUMIN EXTERN OPPSJP,OPSGN1,OPSGN2,OPSGN3,OPSETO EXTERN OPADDB,OPAOS,OPSOS,OPMVSM EXTERN OPJMPE,OPJMPG,OPJRST,OPMVLP EXTERN OPCONC,OPCONV,OPMOVE,OPABS1,OPLNEG EXTERN OPENT4,OPENT5 SUBTTL COMPILE-TIME TYPE-CONVERSION ROUTINES ;*CTIR INTEGER TO REAL ; CTILR INTEGER TO LONG REAL ;*CTRI REAL TO INTEGER ;*CTRLR REAL TO LONG REAL ; CTLRI LONG REAL TO INTEGER ; CTLRR LONG REAL TO REAL ; ON ENTRY, THE ARGUMENT IS IN A0 OR A0,A1 ; THE LINK IS ON THE STACK ; ON EXIT, THE RESULT IS IN A0 OR A0,A1 CTLRI: DFAD A0,[ EXP 0.5,0.0] HLRZ A2,A0 LSH A2,-11 ANDI A2,000377 ; EXTRACT HIGH ORDER EXPONENT TLZ A0,377000 ; AND CLEAR IT OUT JUMPGE A0,.+3 ; NUMBER POSITIVE? TRC A2,000377 ; NO -- COMPLEMENT EXTRACTED EXPONENT TLO A0,377000 ; AND SET ALL ONES SUBI A2,243 ; ADJUST EXPONENT JUMPG A2,.+3 ; TOO BIG - OVERFLOW EDIT(006); CORRECT SHIFT ASHC A0,10(A2) ; [E006] SHIFT MANTISSA TO INTEGER POPJ SP, FAIL(128,SOFT,SYM,INTEGER TOO LARGE) JUMPL A0,CTLRI5 ; NEG ? HRLOI A0,377777 ; SET LARGEST POSITIVE NUMBER POPJ SP, CTLRI5: MOVSI A0,(400000,,0) ; LARGEST NEGATIVE POPJ SP, CTILR: ASHC A0,-^D35 ; SHIFT SIGNIFICANCE TO A1 TLC A0,276000 ; JUGGLE THE EXPONENT DFAD A0,[ EXP 0.0,0.0] ; NORMALIZE POPJ SP, ; AND RETURN CTLRR: JUMPGE A0,.+3 ; ARGUMENT POSITIVE? DMOVN A0,A0 ; NO - NEGATE IT CTLRRD: TLZA A1,400000 ; AND CLEAR BIT 0 FLAG CTLRRC: TLO A1,400000 ; YES - SET BIT 0 FLAG TLNN A1,200000 ; ROUNDING REQUIRED? JRST CTLRRA ; NO CAMN A0,[ XWD 377777,777777] ; YES - HIGH WORD TOO LARGE? JRST CTLRRA ; YES - FORGET IT ADDI A0,1 ; NO TLO A0,400 ; CARRY CTLRRA: JUMPL A1,.+2 ; EXIT IF POSITIVE MOVN A0,A0 ; OTHERWISE NEGATE POPJ SP, SUBTTL POWC1 -- INTEGER TO INTEGER EXPONENTIATION ROUTINE ; ON ENTRY: ; THE BASE IS IN A0 ; THE EXPONENT IS IN A2 ; THE LINK IS ON THE STACK ; ON EXIT, THE RESULT (INTEGER OR REAL) IS IN A0 POWC1: JUMPN A0,POWC11 ; BASE = 0? JUMPLE A2,POWCER ; YES. ERROR IF EXPONENT <= 0 POWC10: POPJ SP, ; RESULT = 0 FOR ZERO BASE AND POS. EXP. POWC11: JUMPL A2,POWC13 ; NEG. EXP. YIELDS REAL RECIPROCAL MOVE A1,A0 ; COPY BASE MOVEI A0,1 ; PREPARE FOR MULTIPLICATION JUMPE A2,POWC10 ; IF EXP. = 0 THEN I^0 = 1 POWC12: TRZE A2,000001 ; BIT SET IN EXPONENT? IMUL A0,A1 ; YES -- MULTIPLY JUMPE A2,POWC25 ; EXIT IF FINISHED IMUL A1,A1 ; OTHERWISE SQUARE MULTIPLIER LSH A2,-1 ; SHIFT BIT OUT OF EXPONENT JRST POWC12 ; AND CARRY ON POWC13: FLTR A0,A0 ; CONVERT INTEGER BASE TO REAL JRST POWC22 ; COMPUTE REAL POWER SUBTTL POWC2 -- REAL TO INTEGER EXPONENTIATION ROUTINE ; ON ENTRY: ; THE BASE IS IN A0 ; THE EXPONENT IS IN A2 ; THE LINK IS ON THE STACK ; ON EXIT, THE RESULT IS IN A0 POWC2: JUMPE A0,POWC24 ; BASE = 0? JUMPN A2,POWC21 ; NO. EXPONENT = 0? MOVSI A0,(1.0) ; YES. R^0 = 1.0 POWC20: POPJ SP, ; EXIT POWC21: CAIG A2,0 ; EXPONENT POSITIVE? POWC22: TDZA A3,A3 ; NO. CLEAR POSITIVE FLAG AND SKIP MOVEI A3,1 ; YES. SET POSITIVE FLAG MOVM A2,A2 ; GET MAGNITUDE OF EXPONENT MOVE A1,A0 ; COPY BASE MOVSI A0,(1.0) ; PREPARE FOR "*" (OR "/") POWC23: TRZE A2,000001 ; BIT SET IN EXPONENT? XCT [ FDVR A0,A1 FMPR A0,A1](A3) ; YES -- MULTIPLY/DIVIDE JUMPE A2,POWC25 ; EXIT IF FINISHED FMPR A1,A1 ; OTHERWISE SQUARE MULTIPLIER LSH A2,-1 ; SHIFT BIT OUT OF EXPONENT JRST POWC23 ; AND CARRY ON POWC24: JUMPG A2,POWC20 ; BASE = 0 -- EXIT IF EXPONENT > 0 POWCER: FAIL(76,FRIED,SYM,OVERFLOW OR UNDEFINED RESULT FOR "CONSTANT ^ CONSTANT"); POPJ SP, ; ERROR EXIT POWC25: JFOVO POWCER ; ERROR IF OVERFLOW FLAG ON POPJ SP, ; NORMAL EXIT SUBTTL POWC3 -- LONG REAL TO INTEGER EXPONENTIATION ROUTINE ; ON ENTRY: ; THE BASE IS IN (A0,A1) ; THE EXPONENT IS IN A2 ; THE LINK IS ON THE STACK ; ON EXIT, THE RESULT (TYPE LONG REAL) IS IN A0,A1 POWC3: JUMPN A0,.+3 ; BASE = 0? JUMPLE A2,POWCER ; YES - ERROR IF EXP LEQ 0 POPJ SP, MOVE A3,A0 ; NO -- COPY BASE MOVE A4,A1 MOVSI A0,(1.0) ; INITIALIZE RESULT TO 1.0&&0 MOVEI A1,0 JUMPN A2,POWC31 ; EXPONENT = 0? POPJ SP,0 ; YES -- RESULT = 1.0&&0 POWC31: PUSH SP,A6 ; SAVE REGISTERS PUSH SP,A7 MOVM A7,A2 ; COPY MAGNITUDE OF EXPONENT JUMPG A2,POWC32 ; EXPONENT POSITIVE? TDZA A6,A6 ; NO -- CLEAR POSITIVE FLAG POWC32: MOVEI A6,1 ; YES -- SET POSITIVE FLAG POWL1: TRZE A7,1 ; STRICTLY KI XCT [ DFDV A0,A3 ; IF BIT SET IN EXPT, THEN DIVIDE/MULTIPLY DFMP A0,A3](A6) JUMPE A7,POWLEX ; ELSE EXIT IF FINISHED DFMP A3,A3 ; OTHERWISE SQUARE MULTIPLIER LSH A7,-1 ; SHIFT BIT OUT OF EXPT JRST POWL1 ; AND CONTINUE POWLEX: POP SP,A7 ; RESTORE REGISTERS POP SP,A6 JFOVO POWCER ; ERROR RETURN IF OVERFLOW FLAG ON POPJ SP,0 ; NORMAL RETURN SUBTTL CODE GENERATION ROUTINES * CGFUN * PROCEDURE CGFUN ;..GENERATE CODE FOR CALLS ON STANDARD FUNCTIONS; ; ON ENTRY, FUNCTION LEXEME IS IN LOP; ; ARGUMENT LEXEME IS IN SYM; ; FOR LIBRARY FUNCTIONS, ARGUMENT WILL BE CONVERTED ; TO PROPER TYPE AND LOADED INTO A0. ; IN-LINE CODE WILL BE GENERATED FOR: ; INT ; BOOL ; ABS ; SIGN ; ENTIER ; RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM; BEGIN IF SYM IS AN ERROR LEXEME JUMPGE SYM,FALSE THEN;..SET ERROR LEXEME AND LEAVE; ERRLEX; ELSE;..NO ERRORS YET ..... GO ON; BEGIN ;..SET REV OFF; MOVNI REV,SYM IF LOP IS A LIBRARY FUNCTION HRRZ T,LOP CAIGE T,PRASE GOTO FALSE THEN;..WE MUST CALL A SUBROUTINE; BEGIN IF SYM NEQ ARITHMETIC TN.ARITH(SYM); THEN FAIL(77,FRIED,SYM,NON-ARITHMETIC ARGUMENT FOR STANDARD LIBRARY FUNCTION); ELSE;..ARGUMENT IS ARITHMETIC; BEGIN IF LOP = REAL AND SYM NEQ REAL TLNN LOP,$TYPE-$R TN.R (SYM); THEN;..ARGUMENT MUST BE CONVERTED TO REAL; ;CONVERT(REAL,SYM); MOVEI T,$R CONVERT; ELSE;..LOP HAD BETTER BE LONG REAL; BEGIN ; [E044] IF LOP = LONG REAL AND SYM NEQ LONG REAL TLNN LOP,$TYPE-$LR TN.LR (SYM); THEN;..ARGUMENT MUST BE CONVERTED TO LONG REAL; ;CONVERT(LONG REAL,SYM); MOVEI T,$LR CONVERT; FI; EDIT(044); Dont force constants to D.P. unnecessarily ;.SYM IS LONG REAL - CHECK IF GENUINE ; [E044] IF SYM = PSEUDO-LONG CONSTANT ; [E044] TLNN SYM,$TYPE-$LR ; [E044] T.CONST (SYM) ; [E044] TLNE SYM,$CT-$IMM ; [E044] TLNN SYM,$DEC ; [E044] GOTO FALSE ; [E044] F.LOCN (T2,SYM) ; [E044] ADD T2,CONTAB ; [E044] SKIPL T4,3(T2) ; [E044] GOTO FALSE ; [E044] THEN;.MAKE IT A GENUINE LONG REAL CONSTANT; [E044] MOVE T3,2(T2) ; [E044] TLZ T4,(1B0) ; [E044] TOCT (2,SYM) ; [E044] FI; ; [E044] ENDD; ; [E044] FI IF SYM IS A POINTER T.PTR (SYM); THEN;..PUT ITS VALUE INTO A0; ;GO TO NEXT "THEN"; GOTO LCGFN1 FI IF VALUE OF SYM NOT IN A0 TN.AC0 (SYM); THEN;..ARGUMENT FOR A LIBRARY FUNCTION MUST BE IN A0; LCGFN1: LOAD(SYM,A0); FI REOPEN(SYM); ;..GENERATE CALL ON LIBRARY FUNCTION; IF LOP = LONG REAL T.LR(LOP); THEN MOVSI T,7777 ELSE MOVSI T,77 FI IORM T,HANDLE ;PLUNK(PUSHJ,SP,LOP); MOVE T,OPPSJP PLUNKI (LOP); ;LEX(SYM) _ (EXPR,SAME,STATEMENT,ACC); TLZ SYM,$KIND!$STATUS!$AM TLO SYM,$EXP!$STMT!$ACC CLOSE(SYM); ENDD FI ENDD ELSE;..NOT A LIBRARY FUNCTION - MUST BE IN-LINE; IF LOP = "INT" CAIE T,ZINT GOTO FALSE THEN;..BOOLEAN-TO-INTEGER TRANSFER FUNCTION -- NO CODE GENERATED; BEGIN IF SYM NEQ BOOLEAN TN.B (SYM); THEN FAIL(78,FRIED,SYM,NON-BOOLEAN ARGUMENT FOR "INT" FUNCTION); ELSE;..ARGUMENT IS BOOLEAN. MAKE IT AN INTEGER EXPR; BEGIN IF SYM IS A POINTER T.PTR (SYM); THEN;..LOAD VALUE INTO SAME ACC USED BY PTR; F.LOCN (T2,SYM); LOAD(SYM,@T2); ELSE;..NOT A POINTER; IF SYM IS SINGLE T.SINGLE(SYM); THEN;..MAKE IT A PORTION IN AN ACC; LOAD(SYM,ANYAC); FI FI ;LEX(SYM) _ (SAME,INTEGER,STATEMENT,SAME); TLZ SYM,$TYPE!$STATUS TLO SYM,$I!$STMT ENDD FI ENDD ELSE;..FUNCTION IS NOT "INT"; IF LOP = "BOOL" CAIE T,ZBOOL GOTO FALSE THEN;..INTEGER-TO-BOOLEAN TRANSFER FUNCTION -- NO CODE GENERATED; BEGIN IF SYM NEQ INTEGER TN.I (SYM); THEN FAIL(79,FRIED,SYM,NON-INTEGER ARGUMENT FOR "BOOL" FUNCTION); ELSE;..ARGUMENT IS INTEGER. MAKE IT A BOOLEAN EXPR; BEGIN IF SYM IS A POINTER T.PTR (SYM); THEN;..LOAD VALUE INTO SAME ACC USED BY PTR; F.LOCN (T2,SYM); LOAD(SYM,@T2); ELSE;..NOT A POINTER; IF SYM IS SINGLE T.SINGLE(SYM); THEN;..MAKE IT A PORTION IN AN ACC; LOAD(SYM,ANYAC); FI FI ;LEX(SYM) _ (SAME,BOOLEAN,STATEMENT,SAME); TLZ SYM,$TYPE!$STATUS TLO SYM,$B!$STMT ENDD FI ENDD ELSE;..FUNCTION IS NOT "INT" OR "BOOL"; IF SYM NEQ ARITHMETIC TN.ARITH(SYM); THEN FAIL(80,FRIED,SYM,NON-ARITHMETIC ARGUMENT FOR BUILT-IN FUNCTION); ELSE;..ARGUMENT IS ARITHMETIC; EDIT(044); Dont force constants to D.P. unnecessarily BEGIN; ; [E044] IF SYM = PSEUDO-LONG REAL CONSTANT ; [E044] TLNN SYM,$TYPE-$LR ; [E044] T.CONST (SYM) ; [E044] TLNE SYM,$CT-$IMM ; [E044] TLNN SYM,$DEC ; [E044] GOTO FALSE ; [E044] F.LOCN (T2,SYM) ; [E044] ADD T2,CONTAB ; [E044] SKIPL T4,3(T2) ; [E044] GOTO FALSE ; [E044] THEN;..CONVERT IT TO A REAL ; [E044] MOVE T3,A0 ; [E044] MOVE A0,2(T2) ; [E044] MOVE A1,3(T2) ; [E044] TLZ A1,(1B0) ; [E044] PUSHJ SP,CTLRR ; [E044] EXCH T3,A0 ; [E044] TLZ SYM,$TYPE TLO SYM,$R STOCON; ; [E044] HRRZ T,LOP ; [E044] FI; ; [E044] IF LOP = "ABS" CAIE T,ZABS GOTO FALSE THEN;..ABSOLUTE VALUE FUNCTION; BEGIN ;..RESULT WILL HAVE SAME TYPE AS ARGUMENT ; (TECHNICALLY NOT CORRECT ALGOL 60); IF SYM = LONG REAL T.LR (SYM); THEN;..WE MUST LOAD THE VALUE AND TEST IT; BEGIN IF SYM IS A POINTER T.PTR (SYM); THEN;..LOAD VALUE INTO SAME ACC USED BY PTR; F.LOCN (T2,SYM); LOAD(SYM,@T2); ELSE;..NOT A POINTER; IF SYM IS SINGLE T.SINGLE(SYM); THEN;..MAKE A PORTION TO LOAD SYM IN AN ACC; LOAD(SYM,ANYAC); FI FI REOPEN(SYM); ;..EMIT IN-LINE CODE TO TEST SIGN AND NEGATE NEG. VALUE; ;..SKIP THE NEGATION FOR POSITIVE VALUES; ;PLUNK(JUMPGE,SYM,.+2); MOVE T,OPABS1 F.LOCN (T1,SYM); PLUNK; ;..NEGATE THE NEGATIVE VALUE; ;PLUNK(LONG NEGATE,SYM,SYM+1); MOVE T,OPLNEG F.LOCN (T1,SYM); MOVE T2,SYM TLZ T2,777777-$AM ADD T,T2 PLUNK; CLOSE(SYM); ENDD ELSE;..SYM IS INTEGER OR REAL; IF SYM IS AN EXPR OR A POINTER IN ACC T.ACC (SYM); THEN;..WE ALREADY HAVE A PORTION FOR SYM; BEGIN ;..APPEND CODE TO GET MAGNITUDE OF SYM; REOPEN(SYM); ;PLUNK(MABS,SYM,SYM); MOVE T,OPABS F.LOCN (T1,SYM); PLUNK (SYM); CLOSE(SYM); ENDD ELSE;..NO PORTION YET. LOAD MAGNITUDE OF SINGLE ARGUMENT; ;LOADM(SYM,ANYAC); MOVEI T1,ANYAC HLL T1,OPMVMS PUSHJ SP,.LOAD FI FI ;LEX(SYM) _ (EXPR,SAME,STATEMENT,ACC); TLZ SYM,$KIND!$STATUS!$AM TLO SYM,$EXP!$STMT!$ACC ENDD ELSE;..FUNCTION IS NOT "INT" OR "BOOL" OR "ABS"; IF LOP = "SIGN" CAIE T,ZSIGN GOTO FALSE THEN;..SIGN FUNCTION; BEGIN IF SYM IS A POINTER T.PTR (SYM); THEN;..LOAD VALUE INTO SAME ACC USED BY POINTER; F.LOCN (T2,SYM); LOAD(SYM,@T2); ELSE;..NOT A POINTER; IF SYM IS SINGLE T.SINGLE(SYM); THEN;..MAKE A PORTION TO LOAD SYM INTO AN ACC; LOAD(SYM,ANYAC); FI FI REOPEN(SYM); ;..EMIT IN-LINE CODE TO COMPUTE "SIGN" FUNCTION; ;..IF ARGUMENT = 0 THEN SIGN(ARG) = 0; ;PLUNK(JUMPE,SYM,.+3); MOVE T,OPSGN1 F.LOCN (T1,SYM); PLUNK; ;..SHIFT OUT ALL BUT SIGN BITS (YIELDS 0 OR -1); ;PLUNK(ASH,SYM,-43); MOVE T,OPSGN2 F.LOCN (T1,SYM); PLUNK; ;..SET LOW-ORDER BIT TO 1 (YIELDS 1 OR -1); ;PLUNK(TRO,SYM,1); MOVE T,OPSGN3 F.LOCN (T1,SYM); PLUNK; ;LEX(SYM) _ (EXPR,INTEGER,STATEMENT,ACC); TLZ SYM,$KIND!$TYPE!$STATUS!$AM TLO SYM,$EXP!$I!$STMT!$ACC CLOSE(SYM); ENDD ELSE;..FUNCTION IS NOT "INT" OR "BOOL" OR "ABS" OR "SIGN"; IF LOP = "ENTIER" CAIE T,ZENTIER GOTO FALSE THEN;..LARGEST-INTEGER FUNCTION; BEGIN IF SYM = INTEGER T.I (SYM); THEN ;CONVERT(REAL,SYM); MOVEI T,$R CONVERT; FI IF SYM = LONG REAL T.LR (SYM); THEN;..LONG REAL ENTIER. CALL SUBROUTINE; BEGIN IF SYM IS A POINTER T.PTR (SYM); THEN;..MUST GET ITS VALUE; ;GO TO NEXT "THEN"; GOTO LCGFN2 FI IF VALUE OF SYM NOT IN A0 TN.AC0 (SYM); THEN;..LOAD IT INTO A0; LCGFN2: LOAD(SYM,A0); FI REOPEN(SYM); ;..GENERATE INST. TO CALL LONG REAL ENTIER SR; ;PLUNK(JSP,AX,ENTIEL); MOVE T,OPJSPX PLUNKI; ;LEX(SYM) _ (EXPR,INTEGER,STATEMENT,ACC); TLZ SYM,$KIND!$TYPE!$STATUS!$AM TLO SYM,$EXP!$I!$STMT!$ACC CLOSE(SYM); ENDD ELSE;..ARGUMENT IS REAL. EMIT IN-LINE REAL ENTIER; BEGIN ;..GIVE SYM SPECIAL TYPE SO LOAD WILL USE 2 ACS; TLZ SYM,$TYPE TLO SYM,$IDI IF SYM IS A POINTER T.PTR (SYM); THEN;..MUST GET VALUE OF PTR INTO AN AC; ;..LOAD INTO SAME AC USED FOR PTR; F.LOCN (T2,SYM); LOAD (SYM,@T2); ELSE;..NOT A POINTER; BEGIN IF SYM IS SINGLE OR IN LAST AC TLNN SYM,$SINGLE GOTO TRUE F.LOCN (T,SYM); CAIE T,A13 GOTO FALSE THEN;..MUST MOVE SYM TO A FREE AC PAIR; LOAD(SYM,ANYAC); FI ENDD FI IF LAST GENERATED INST. WAS "MOVEI" MOVE T,INDEX HLRZ T2,-2(T) ANDI T2,777000 CAIE T2,_-22 GOTO FALSE THEN;..SYM WAS AN IMMEDIATE REAL CONSTANT; ;.. BUT "LOAD" THOUGHT IT WAS INTEGER; ;..CHANGE INSTRUCTION TO "HRLZI"; MOVE T2,-2(T) TLZ T2,777000 TLO T2,_-22 MOVEM T2,-2(T) FI REOPEN(SYM); ;..EMIT IN-LINE CODE TO COMPUTE "ENTIER"; EDIT(031); CAN'T USE FIX OR FIXR, SO DO IT THE HARD WAY ;......SPLIT OFF EXPONENT; ;EMITCODE(MULI,SYM,400,2); MOVE T,OPENT1 F.LOCN (T1,SYM); HRLI T1,2 EMITCODE; ;..COMPLEMENT EXPONENT FOR NEGATIVE ARGUMENT; ;PLUNK(TSC,SYM,SYM); MOVE T,OPENT2 F.LOCN (T1,SYM); PLUNK (SYM); ;EXCHANGE EXPONENT AND FRACTION; ;PLUNK(EXCH,SYM+1,SYM); HRLZI T,_-22 F.LOCN (T1,SYM); ADDI T1,1 PLUNK (SYM); ;..SHIFT ARGUMENT TO ZERO EXPONENT; ;PLUNK(ASH,SYM,-243(SYM+1)); MOVE T,OPENT3 F.LOCN (T1,SYM); PLUNK; ;LEX(SYM)_(EXPR,INTEGER,STATEMENT,SYM); TLZ SYM,$KIND!$TYPE!$STATUS!$AM TLO SYM,$EXP!$I!$STMT!$ACC CLOSE(SYM); ENDD FI ENDD ;..ELSE NOT ENTIER; FI;..IF LOP = ENTIER FI;..IF LOP = SIGN FI;..IF LOP = ABS ENDD; FI;..IF SYM NEQ ARITHMETIC FI;..IF LOP = BOOL FI;.. IF LOP = INT FI;..IF LOP IS A LIBRARY FUNCTION ENDD; FI;..IF SYM IS AN ERROR LEXEME ENDD ; CGFUN SUBTTL CODE GENERATION ROUTINES * CGDOT * PROCEDURE CGDOT ;..GENERATE CODE TO LOAD OPERANDS FOR "DOT" OPERATOR; ; ON ENTRY, LEXEME FOR STRING POINTER IS IN LOP; ; LEXEME FOR INDEX IS IN SYM; ; CODE WILL BE GENERATED TO PUT STRING POINTER INTO A2 ; AND INDEX INTO A1; ; RESULT IS A SINGLE CLOSED PORTION WHOSE LEXEME IS IN SYM; BEGIN IF LOP IS AN ERROR LEXEME JUMPGE LOP,FALSE THEN;..SET RESULT LEXEME AND LEAVE; ERRLEX; ELSE;..NO ERRORS YET ..... GO ON; BEGIN ;..SET REV OFF; MOVNI REV,SYM IF SYM = SINGLE T.SINGLE(SYM); THEN;..NO PORTION YET FOR SYM; REOPEN(LOP); ELSE;..BOTH LOP AND SYM ARE PORTIONS -- JOIN THEM; BEGIN REVER; MERGEPORTIONS; COMBLEX; ENDD FI IF SYM IN AC2 TLNN SYM,$AMAC TRNN SYM,2 JRST FALSE TRNE SYM,-3 JRST FALSE THEN BEGIN;..PUSH IT HRLZI T,() PLUNKI(SYM) ;..SYM _ SP TLZ SYM,$AM TLO SYM,$SP ;..SYM _ 0 TRZ SYM,-1 ;..SYM _ SYM + 1 HRLZI T,1 ADDM T,LEXEX IF LOP IS ON STACK T.STK (LOP) THEN;..ADJUST STACK OFFSET SUBI LOP,1 FI; ENDD; FI; IF LOP NOT IN AC2 TLNE LOP,$AMAC GOTO TRUE HRRZ T,LOP EDIT(225) ;DELETE IN PROC. CGDOT IN ALGFUN [JBS 4/11/80] ; N.B. IF LOP IS IN AC0, ADDRESS IS IN AC2; CAIN T,A2 GOTO FALSE THEN;..PUT IT INTO AC2; BEGIN ;..FUDGE MODE TO MOVE POINTER ITSELF (NOT @PTR); IF LOP IS ON THE STACK T.STK (LOP); THEN;..FUDGE AS STACKED EXPRESSION; TLZ LOP,$AM TLO LOP,$SP ELSE;..FUDGE AS EXPRESSION IN ACC; TLZ LOP,$AM TLO LOP,$ACC FI ;PLUNK(MOVE,AC2,LOP); MOVE T,OPMOVE MOVEI T1,A2 PLUNK (LOP); ENDD FI IF SYM NOT IN AC1 TLNE SYM,$AMAC GOTO TRUE HRRZ T,SYM CAIN T,A1 GOTO FALSE THEN;..PUT IT INTO AC1; MOVE T,OPMVSM MOVEI T1,A1 GLOAD; FI ;LEX(SYM) _ (VAR,STRING,REGULAR,PTR,AC2); TLZ SYM,$KIND!$TYPE!$STATUS!$AM TLO SYM,$VAR!$S!$REG!$PTR HRRI SYM,A2 CLOSE(SYM); ENDD FI ENDD ; CGDOT SUBTTL CODE GENERATION ROUTINES * CGFTEST * PROCEDURE CGFTEST ;..GENERATE CODE FOR THE "STEP-UNTIL" TEST IN A "FOR" STATEMENT ; ON ENTRY, LEXEME FOR CONTROLLED VARIABLE IS IN LOP; ; LEXEME FOR FINAL VALUE IS IN SYM; ; LEXEME FOR INCREMENT IS IN FBSYMSAVE; ; IF INCREMENT = CONSTANT, ITS SIGN WILL NOT BE ; TESTED AT RUN TIME. ; IF INCREMENT NEQ CONSTANT, THE GENERAL ALGOL TEST ; SEQUENCE WILL BE GENERATED; ; RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM; BEGIN IF LOP IS AN ERROR LEXEME JUMPGE LOP,FALSE THEN;..SET ERROR LEXEME AND LEAVE; ERRLEX; ELSE;..LOP IS OK; IF INCREMENT IS AN ERROR LEXEME MOVE T,FBSYMSAVE JUMPGE T,FALSE THEN;..SET ERROR LEXEME AND LEAVE; ERRLEX; ELSE;..NO ERRORS YET ..... GO ON; BEGIN ;..SET REV OFF; MOVNI REV,SYM ;..PUT INCREMENT LEXEME INTO A REGISTER; MOVE T2,FBSYMSAVE IF INCREMENT IS CONSTANT T.CONST (T2); THEN;..CONSTANT INCREMENT. NO NEED TO TEST IT ON EACH CYCLE; BEGIN ;..PUT VALUE OF INCREMENT IN T3; IF INCREMENT = IMMEDIATE CONSTANT T.IMM (T2); THEN;..IMMEDIATE CONSTANT; BEGIN IF INCREMENT = INTEGER T.I (T2); THEN;..IMMEDIATE INTEGER CONSTANT; ;..RH(T3) _ INCREMENT; HRRZ T3,T2 ELSE;..IMMEDIATE REAL CONSTANT; ;..LH(T3) _ INCREMENT; HRLZ T3,T2 FI ENDD ELSE;..NON-IMMEDIATE CONSTANT; BEGIN ;T1 _ INCREMENT + CONSTANT TABLE BASE; F.LOCN (T1,T2); ADD T1,CONTAB IF INCREMENT = LONG REAL T.LR (T2); THEN;..GET FIRST WORD OF LONG REAL CONSTANT; MOVE T3,2(T1) ELSE;..GET REAL OR INTEGER CONSTANT; MOVE T3,1(T1) FI ENDD FI ;..VALUE OF CONSTANT IS NOW IN T3. TEST ITS SIGN; EDIT(046); Do the correct thing for a zero increment IF CONSTANT GEQ 0 JUMPL T3,FALSE ; [E046] THEN;..CONSTANT >= 0. NORMAL TEST ; [E046] MOVE T,ZLEQ ELSE;..CONSTANT < 0. REVERSE THE TEST ; [E046] MOVE T,ZGTE FI MOVEM T,OP ;..GENERATE CODE FOR THE RELATION. IF THE INCREMENT ;.. IS GREATER THAN 0, THE TEST WILL BE: ;.. IF CONT.VAR. > FINAL VAL. THEN GO TO ELM.-EXH.; ;.. OTHERWISE THE TEST WILL BE ;.. IF CONT.VAR. < FINAL VAL. THEN GO TO ELM.-EXH.; CGBIN; ;..NOW BACK UP THE STACK POINTER; UNSTACK; ;..NOW PUT IN THE JUMP TO "ELEMENT-EXHAUSTED"; REOPEN(SYM); IF THE LAST GENERATED INSTRUCTION = "SETO" MOVE T,INDEX HLLZ T1,-1(T) TLZ T1,000777 CAME T1,OPSETO GOTO FALSE THEN;..NOTHING WAS STACKED. NO NEED TO GENERATE "TRUE" OR "FALSE"; BEGIN ;..REPLACE THE "TDZA" AND "SETO" BY A "JRST"; ;INDEX _ INDEX - 2; SUBI T,2 MOVEM T,INDEX ;PLUNK(JRST,0,0); MOVE T,OPJRST PLUNKI; ENDD ELSE;..CAN'T BACK UP - "UNSTACK" PUT IN AN INSTRUCTION; ;..APPEND A JUMPE; ;PLUNK(JUMPE,SYM,0); HLLZ T,-2(T) TLZ T,777000 TDO T,OPJMPE F.LOCN (T1,SYM); PLUNKI; FI ENDD ELSE;..INCREMENT IS NOT CONSTANT. MUST GENERATE THE GENERAL TEST; BEGIN ;..TEST WILL BE ;.. IF (CONTR. VAR. - FINAL VALUE)*SIGN(INCREMENT) > 0 ;.. THEN GO TO ELEMENT-EXHAUSTED; ;.. ;..GENERATE CODE FOR (CONTR. VAR. - FINAL VALUE); MOVE T,ZMINUS MOVEM T,OP CGBIN; ;..LOP _ LEXEME AND LEXEX FOR (CONT. VAR. - FINAL VALUE); MOVE LOP,SYM MOVE T,LEXEX MOVEM T,LLEXEX MOVE T,LEXEX+1 MOVEM T,LLEXEX+1 ;..SYM _ LEXEME AND LEXEX FOR INCREMENT; MOVE SYM,FBSYMSAVE MOVE T,FBLEXSAVE MOVEM T,LEXEX MOVE T,FBCOMPSAVE MOVEM T,LEXEX+1 ;..GENERATE CODE FOR MULTIPLICATION BY SIGN OF INCREMENT; ;..SET OP THOROUGHLY NON-REVERSIBLE; MOVEI T,0 MOVEM T,OP SETUP ;PLANT HRLZI T,() PLUNKI(SYM) IF LOP IS LONG.REAL; T.LR (LOP) THEN;..PLANT(LMOVN,LOP); MOVE T,OPLNEG ELSE;..PLANT(MOVN,LOP); MOVE T,OPUMIN FI; F.LOCN (T1,LOP) PLUNK(LOP) CLOSE(SYM); COMBLEX; ;..MAKE SURE THE STACK POINTER IS RESET; UNSTACK; ;..NOW APPEND THE TEST WHICH JUMPS TO "ELEMENT-EXHAUSTED"; REOPEN(SYM); ;PLUNK(JUMPG,LOP,0); MOVE T1,INDEX HLLZ T,-1(T1) TLZ T,000037 CAMN T,[SUB SP,0] HLLZ T,-2(T1) TLZ T,777037 TDO T,OPJMPG F.LOCN (T1,LOP); PLUNK; ENDD FI CLOSE(SYM); ENDD FI FI ENDD ; CGFTEST SUBTTL CODE GENERATION ROUTINES * CGINCR * PROCEDURE CGINCR ;..GENERATE EFFICIENT CODE FOR INCREMENTING A CONTROLLED VARIABLE; ; ON ENTRY, LEXEME FOR CONTROLLED VARIABLE IS IN LOP; ; LEXEME FOR INCREMENT IS IN SYM; ; NUMBER OF PREFERRED ACC IS IN PREFACC; ; IF INCREMENT = 1 THEN CODE IS "AOS" ; ELSE IF INCREMENT = -1 THEN CODE IS "SOS" ; ELSE IF INCREMENT = 0 THEN CODE IS "MOVE" ; ELSE CODE IS "ADDB"; ; CLOSED PORTION FOR ASSIGNMENT OF INCREMENTED VALUE ; IS GENERATED AND ITS RESULT LEXEME IS PUT IN SYM; BEGIN IF LOP IS AN ERROR LEXEME JUMPGE LOP,FALSE THEN;..SET ERROR LEXEME AND LEAVE; ERRLEX; ELSE;..LOP IS OK; IF INCREMENT IS AN ERROR LEXEME JUMPGE SYM,FALSE THEN;..SET ERROR LEXEME AND LEAVE; ERRLEX; ELSE;..NO ERRORS YET ..... GO ON; BEGIN ;..SET REV OFF; MOVNI REV,SYM EDIT(046); Don't generate an "ADDB" for a zero increment ! IF SYM IS A CONSTANT WITH VALUE ZERO ; [E046] T.CONST (SYM) ; [E046] F.LOCN (T,SYM) ; [E046] TLNN SYM,$AM-$IMM ; [E046] JRST .+3 ; [E046] ADD T,CONTAB ; [E046] MOVE T,1(T) ; [E046] JUMPN T,FALSE ; [E046] THEN;..NO NEED TO GENERATE AN ADDB ; [E046] MOVE T4,OPMOVE ; [E046] GOTO LCGIN0 ; [E046] FI; ; [E046] IF LOP = INTEGER T.I (LOP); THEN;..LOP AND SYM ARE BOTH OF TYPE INTEGER; BEGIN IF VALUE OF INCREMENT = 1 F.LOCN (T,SYM); CAIN T,1 TLNE SYM,$AM-$IMM GOTO FALSE THEN;..INCREMENT = 1. DO THE INCREMENT WITH AN "AOS"; ;OPN _ "AOS"; MOVE T4,OPAOS ELSE;..INCREMENT IS NOT 1; IF VALUE OF INCREMENT = -1 TLNN SYM,$AM-$CT TLNN SYM,$CT-$IMM GOTO FALSE F.LOCN (T2,SYM); ADD T2,CONTAB MOVN T,1(T2) CAIE T,1 GOTO FALSE THEN;..INCREMENT = -1. DO THE INCREMENT WITH A "SOS"; ;OPN _ "SOS"; MOVE T4,OPSOS ELSE;..INCREMENT IS NOT 1; ;..GO TO CODE WHICH LOADS INCREMENT INTO AN ACC; GOTO LCGIN1 FI FI LCGIN0: ; [E046] LABEL ADDED FOR ZERO CONSTANTS IF LOP IS NOT SINGLE TN.SINGLE(LOP); THEN;..WE ALREADY HAVE A PORTION FOR LOP; REOPEN(LOP); FI IF PREFACC = 0 SKIPE 0,PREFACC GOTO FALSE THEN;..CAN'T AOS OR SOS INTO AC0. CHANGE IT TO AC1 ; [E046] UNLESS OPCODE = MOVE, WHEN AC0 IS O.K. TLNE T4,174000 ; [E046] AOS 0,PREFACC FI ;EMITCODE(OPN,PREFACC,LOP); MOVE T,T4 MOVE T1,PREFACC HRLI T1,1 EMITCODE(LOP); ;LEX(SYM) _ (EXPR,SAME,SIMPLE,PREFACC); TLZ SYM,$KIND!$STATUS!$AM TLO SYM,$EXP!$SIM!$ACC HRR SYM,PREFACC ENDD ELSE;..LOP MUST BE REAL; BEGIN IF SYM = INTEGER T.I (SYM); THEN;..CONVERT SYM TO REAL; ;CONVERT(REAL,SYM); MOVEI T,$R CONVERT; FI LCGIN1: IF SYM IS A POINTER T.PTR (SYM); THEN;..MUST LOAD ITS VALUE; ;GO TO NEXT "THEN"; GOTO LCGIN2 FI IF SYM = SINGLE T.SINGLE(SYM); THEN;..INCREMENT IS NOT YET IN AN ACC. LOAD IT; LCGIN2: ;..LOAD INCREMENT INTO PREFERRED REGISTER (GIVEN BY PREFACC); MOVE T2,PREFACC LOAD(SYM,@T2); ELSE;..VALUE OF INCREMENT IS ALREADY IN AN ACC; IF SYM = LOP F.LOCN (T,SYM); F.LOCN (T1,LOP); CAMN T,T1 TLNE LOP,$AMAC GOTO FALSE THEN;..ACC CONFLICT. RELOAD INCREMENT INTO PREFERRED ACC; GOTO LCGIN2 FI FI IF LOP = SINGLE T.SINGLE(LOP); THEN;..NO PORTION NEEDED FOR LOP; REOPEN(SYM); ELSE;..BOTH LOP AND SYM ARE PORTIONS; MERGEPORTIONS; FI ;..GENERATE AN ADD-TO-BOTH; F.TRANK (T,SYM); MOVE T,OPADDB(T) F.LOCN (T1,SYM); PLUNK (LOP); ;LEX(SYM) _ (EXPR,SAME,SIMPLE,ACC); TLZ SYM,$KIND!$STATUS!$AM TLO SYM,$EXP!$SIM!$ACC ENDD FI CLOSE(SYM); COMBASSIGN; ENDD FI FI ENDD ; CGINCR SUBTTL CODE GENERATION ROUTINES * CHECKARITH * PROCEDURE CHECKARITH; ;..FORCE BINARY OPERANDS TO HAVE MATCHING ARITHMETIC TYPES; ; ERROR FLAG (T) IS SET IF TYPES ARE NOT ARITHMETIC ; (INTEGER OR REAL OR LONG REAL); ; ON ENTRY, OPERAND LEXEMES ARE IN LOP AND SYM. ; IF TYPES OF OPERANDS ARE NOT ALIKE, CODE IS GENERATED TO ; CONVERT ONE OPERAND TO THE TYPE OF THE OTHER ; (IN THE ORDER INTEGER => REAL => LONG REAL). ; OPERAND PORTIONS ARE LEFT CLOSED WITH LEXEMES ; IN LOP AND SYM. BEGIN IF SYM IS INT OR REAL OR LONG REAL ; AND LOP IS INT OR REAL OR LONG REAL; TLNE SYM,$IRLR T.IRLR (LOP); THEN;..OPERANDS HAVE TYPES WHICH CAN BE MATCHED; BEGIN IF SYM NEQ LOP F.TYPE (T,SYM); F.TYPE (T1,LOP); CAMN T,T1 GOTO FALSE THEN;..TYPES DO NOT MATCH -- GENERATE CODE TO MATCH THEM; BEGIN IF SYM LSS LOP CAML T,T1 GOTO FALSE THEN ;..CONVERT SYM TO THE TYPE OF LOP; PUSHJ SP,TCHECK ; [E044] ELSE ;..CONVERT LOP TO THE TYPE OF SYM; ;..MUST REVERSE LEXEMES AND LEXEXES BECAUSE CONVERT WORKS ON SYM; EXCH LOP,SYM MOVNI REV,SYM+LOP(REV) PUSHJ SP,TCHECK ; [E044] EXCH SYM,LOP MOVNI REV,SYM+LOP(REV) FI; ENDD; FI; EDIT(044);Don't force constants to D.P. unnecessarily ; TYPES MATCH - CHECK FOR PSEUDO-LONG REAL ; [E044] IF TYPE = LONG REAL ; [E044] T.LR (SYM) ; [E044] THEN; ; [E044] BEGIN; ; [E044] IF SYM = PSEUDO-LONG REAL CONSTANT & LOP # CONSTANT TLNE LOP,$CONST ; [E044] T.CONST (SYM) ; [E044] TLNE SYM,$CT-$IMM ; [E044] TLNN SYM,$DEC ; [E044] GOTO FALSE ; [E044] F.LOCN (T2,SYM) ; [E044] ADD T2,CONTAB ; [E044] SKIPL T4,3(T2) ; [E044] GOTO FALSE ; [E044] THEN;..CONVERT SYM TO A GENUINE LONG REAL CONSTANT MOVE T3,2(T2) ; [E044] TLZ T4,(1B0) ; [E044] TOCT (2,SYM) ; [E044] ELSE; ; [E044] BEGIN; ; [E044] IF LOP = PSEUDO-LONG REAL CONSTANT & SYM # CONSTANT TLNE SYM,$CONST ; [E044] T.CONST (LOP) ; [E044] TLNE LOP,$CT-$IMM ; [E044] TLNN LOP,$DEC ; [E044] GOTO FALSE ; [E044] F.LOCN (T2,LOP) ; [E044] ADD T2,CONTAB ; [E044] SKIPL T4,3(T2) ; [E044] GOTO FALSE ; [E044] THEN;..CONVERT LOP TO A GENUINE LONG REAL CONSTANT MOVE T3,2(T2) ; [E044] TLZ T4,(1B0) ; [E044] TOCT (2,LOP) ; [E044] FI; ; [E044] ENDD; ; [E044] FI; ; [E044] ENDD; ; [E044] FI; ; [E044] ;T_FALSE ; TURN ERROR FLAG OFF SETZ T,0 ENDD; ELSE;..TYPES CANNOT BE MATCHED; ;T_TRUE ; SET ERROR FLAG ON SETO T,0 FI; ENDD ; CHECKARITH TCHECK: Edit(044) ;New routine to match type of SYM to LOP BEGIN; ; [E044] IF LOP = PSEUDO-LONG CONSTANT & SYM # CONSTANT ; [E044] TLNN LOP,<$TYPE-$LR>!$CONST; TLNN SYM,$CONST ; [E044] GOTO FALSE ; [E044] TLNE LOP,$CT-$IMM ; [E044] TLNN LOP,$DEC ; [E044] GOTO FALSE ; [E044] F.LOCN (T2,LOP) ; [E044] ADD T2,CONTAB ; [E044] SKIPL A1,3(T2) ; [E044] GOTO FALSE ; [E044] THEN; FIRST WE MUST TRUNCATE LOP TO A REAL ; [E044] MOVE T3,A0 ; [E044] MOVE A0,2(T2) ; [E044] TLZ A1,(1B0) ; [E044] PUSHJ SP,CTLRR ; [E044] EXCH T3,A0 ; [E044] TLZ LOP,$TYPE ; [E044] TLO LOP,$R ; [E044] EXCH LOP,SYM ; [E044] PUSHJ SP,.STOCON ; [E044] EXCH LOP,SYM ; [E044] ; IF SYM # REAL, SKIP INTO THE "ELSE" CLAUSE ; [E044] TLNN SYM,$TYPE-$R ; [E044] ELSE; WE NEED TO CONVERT SYM TO THE TYPE OF LOP ; [E044] HLRZ T,LOP ; [E044] ANDI T,$TYPE ; [E044] PUSHJ SP,.CONVERT ; [E044] FI; ; [E044] POPJ SP, ; [E044] ENDD; TCHECK ; [E044] SUBTTL CODE GENERATION ROUTINES * COMBASSIGN * PROCEDURE COMBASSIGN; ;..GENERATE THE NEW LEXEX RESULTING FROM AN ASSIGNMENT; ; NEW LEXEX COMES FROM THOSE FOR SYM AND LOP. ; COMPUTES EXTYPE, BLOCK LEVEL, STACK ADDRESS, AND ; COMPOSITE NAME FOR THE ASSIGNMENT EXPRESSION. ; RESULT LEXEX IS ALWAYS THAT BELONGING TO SYM; BEGIN IF LEXEX(SYM) GEQ 0 F.BL (T1,SYM); JUMPL T1,FALSE THEN;..SYM HAS EXTYPE "V". SET IT TO "P" AND SET C.N. _ 0; BEGIN ;SYM _ -1 (I.E., EXTYPE _ "P"); HRLZI T2,777000 S.BL (T2); ;SYM _ 0; SETZ T2,0 S.CN (T2); ENDD FI ;SYM _ SYM OR LOP; F.CN (T2,LOP); F.CN (T1,SYM); OR T2,T1 S.CN (T2); ;..BLOCK LEVEL _ MIN(BLOCK LEVELS); .... (SETS EXTYPE ALSO); IF LOP LSS SYM F.BL (T3,LOP); F.BL (T2,SYM); CAML T3,T2 GOTO FALSE THEN ;SYM _ LOP; S.BL (T3); FI ;..STACK ADDRESS _ SUM OF STACK ADDRESSES; ;T2 _ LOP + SYM; F.SA (T2,LOP); F.SA (T1,SYM); ADD T2,T1 IF STACK ADDRESS GEQ 2^9 (512) TLNN T2,$LEXBL GOTO FALSE THEN;..STACK OVERFLOW ERROR; FAIL(66,FRIED,SYM,STACK-ADDRESS OVERFLOW); ELSE;..SYM _ T2; S.SA (T2); FI ENDD ; COMBASSIGN SUBTTL CODE GENERATION ROUTINES * COMBLEX * PROCEDURE COMBLEX ;..GENERATE THE NEW LEXEX RESULTING FROM A BINARY OPERATION; ; NEW LEXEX COMES FROM THOSE FOR SYM AND LOP. ; COMPUTES EXTYPE, BLOCK LEVEL, STACK ADDRESS, AND ; COMPOSITE NAME FOR THE RESULT EXPRESSION. ; RESULT LEXEX IS ALWAYS THAT BELONGING TO SYM; BEGIN IF EXTYPE(LOP) = EXTYPE(SYM) F.BL (T3,LOP); F.BL (T2,SYM); MOVE T,T2 XOR T,T3 JUMPL T,FALSE THEN;..EXTYPES MATCH (BOTH "P" OR BOTH "V"); ;SYM _ LOP OR SYM; F.CN (T1,LOP); F.CN (T,SYM); OR T,T1 S.CN (T); ELSE;..EXTYPES DO NOT MATCH. RESULT GETS C.N. OF TYPE "P" LEXEME; IF LOP LSS 0 JUMPGE T3,FALSE THEN;..LOP HAS EXTYPE "P". GRAB ITS C. NAME FOR THE RESULT; ;SYM _ LOP; F.CN (T,LOP); S.CN (T); ;..ELSE SYM HAS EXTYPE "P" AND ITS C.N. IS THAT OF THE RESULT; FI FI ;..BLOCK LEVEL _ MIN(BLOCK LEVELS); .... (SETS EXTYPE ALSO); IF LOP LSS SYM CAML T3,T2 GOTO FALSE THEN ;SYM _ LOP; S.BL (T3); FI ;..STACK ADDRESS _ SUM OF STACK ADDRESSES; ;T2 _ LOP + SYM; F.SA (T2,LOP); F.SA (T1,SYM); ADD T2,T1 IF STACK ADDRESS GEQ 2^9 (512) TLNN T2,$LEXBL GOTO FALSE THEN;..STACK OVERFLOW ERROR; FAIL(66,FRIED,SYM,STACK-ADDRESS OVERFLOW); ELSE;..SYM _ T2; S.SA (T2); FI ENDD ; COMBLEX SUBTTL CODE GENERATION ROUTINES * CONVERT * PROCEDURE CONVERT ;..GENERATES CODE TO CONVERT AN OPERAND TO A GIVEN TYPE; ; ON ENTRY, OPERAND LEXEME IS IN SYM; ; DESIRED TYPE IS IN T; ; IF OPERAND IS A CONSTANT, A NEW CONSTANT WILL BE GENERATED ; (AND NO CODE WILL BE PRODUCED). ; RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM; BEGIN OWN RESTYPE; ;..TEMP FOR THE DESIRED TYPE BITS; ;RESTYPE _ T; MOVEM T,RESTYPE IF SYM = CONSTANT T.CONST (SYM); THEN;..OPERAND IS A CONSTANT. WE CAN DO THE CONVERSION RIGHT NOW; BEGIN ;..SAVE A0 (GBREG); MOVE T3,A0 IF SYM = IMMEDIATE T.IMM (SYM); THEN;..IMMEDIATE CONSTANT. PUT VALUE INTO A0; BEGIN IF SYM = INTEGER T.I (SYM); THEN ;RH(A0) _ SYM; HRRZ A0,SYM ELSE;..IMMEDIATE REAL CONSTANT; ;LH(A0) _ SYM; HRLZ A0,SYM FI ENDD ELSE;..NON-IMMEDIATE CONSTANT; BEGIN ;T2 _ SYM + CONSTANT TABLE BASE; F.LOCN (T2,SYM); ADD T2,CONTAB IF SYM = LONG REAL T.LR (SYM); THEN;..LONG CONSTANT; ;..PUT CONSTANT INTO A0 AND A1; ;.. * * * NOTE THAT A1 IS THE SAME REGISTER AS T; DMOVE A0,2(T2) TLZ A1,(1B0) ; [E044] ELSE;..SHORT CONSTANT; ;..PUT CONSTANT INTO A0; MOVE A0,1(T2) FI ENDD FI ;..EXECUTE APPROPRIATE CONVERSION ROUTINE (RESULT GOES TO A0 (AND A1)); ;.. * * * NOTE THAT A2 (T1) MAY BE CLOBBERED HERE; MOVE T2,RESTYPE LSH T2,-14 F.TRANK (T1,SYM); LSH T1,2 OR T2,T1 XCT OPCONC-1(T2) ;LEX(SYM) _ (SAME,RESTYPE,SAME,SAME); TLZ SYM,$TYPE TSO SYM,RESTYPE ;..WE NOW HAVE A NEW OPERAND. IT MUST BE PUT IN THE CONSTANT TABLE; ;..MOVE HIGH ORDER WORD OF CONSTANT TO T3 AND RESTORE A0; EXCH T3,A0 IF SYM = LONG REAL T.LR (SYM); THEN;..LONG REAL CONSTANT; BEGIN ;..MOVE LOW ORDER WORD OF CONSTANT TO T4; MOVE T4,A1 TLO T4,(1B0) ; [E044] ;..PUT IN CONSTANT TABLE (T3,T4); TOCT(2,SYM); ENDD ELSE;..SHORT CONSTANT; STOCON; FI ENDD ELSE;..OPERAND IS NOT A CONSTANT; BEGIN ;..OPERAND MUST BE IN AC0 (AND 1) FOR THE CONVERSION ROUTINES; IF SYM IS A POINTER T.PTR (SYM); THEN;..LOAD ITS VALUE INTO AC0; GOTO LCONV1 FI IF VALUE OF SYM NOT IN AC0 TN.AC0 (SYM); THEN;..PUT IT IN; LCONV1: ;..GENERATE CODE TO MOVE OPERAND TO AC0 (AND 1); LOAD(SYM,A0); FI REOPEN(SYM); ;..GENERATE CALL ON CONVERSION SUBROUTINE; ;PLUNKI(CONVERTOP); MOVE T1,RESTYPE LSH T1,-14 F.TRANK (T,SYM); LSH T,2 OR T,T1 MOVE T,OPCONV-1(T) PLUNKI; ;..BOOK A1 IN HANDLE HRLZI T,2 IORM T,HANDLE ;LEX(SYM) _ (EXPR,RESTYPE,SIMPLE,AC0); TLZ SYM,$KIND!$TYPE!$STATUS!$AM TSO SYM,RESTYPE TLO SYM,$EXP!$SIM!$ACC HRRI SYM,0 CLOSE(SYM); ENDD FI ENDD ; CONVERT SUBTTL CODE GENERATION ROUTINES * MARRY * PROCEDURE MARRY ;..MAKE A SINGLE OPEN PORTION FOR TWO BINARY OPERANDS, ; REVERSING THE ORDER IF POSSIBLE; ; ON ENTRY, LEXEMES FOR THE OPERANDS ARE IN LOP AND SYM; ; UNLESS THE OPERATION = "^", MARRY WILL MAKE SURE THAT ; THE RESULT PORTION INCLUDES CODE TO LOAD ; THE "LEFT" OPERAND INTO AN AC; BEGIN IF SYM = SINGLE T.SINGLE(SYM); THEN;..SYM IS NOT A PORTION; BEGIN IF LOP NEQ SINGLE TN.SINGLE(LOP); THEN;..LOP IS A PORTION AND SYM IS NOT; REOPEN(LOP); ELSE;..BOTH LOP AND SYM ARE SINGLE; BEGIN IF OP NEQ "^" TN.OPER (ZPOW); THEN;..MAKE A PORTION TO PUT A VALUE IN AN ACC; BEGIN IF LOP = ONE-WORD CONSTANT AND OP IS REVERSIBLE TLNN LOP,$VAR1 T.CONST (LOP); TRNN T,$ODROP GOTO FALSE THEN;..REVERSE THE ORDER SO VARIABLE IS LOADED FIRST; BEGIN ;..EXCHANGE THE LEXEMES; EXCH LOP,SYM ;..SET REV ON; MOVNI REV,LOP ENDD FI LOAD(LOP,ANYAC); REOPEN(LOP); ENDD ;..ELSE NO PORTIONS ARE NECESSARY FOR POWERS; FI ENDD FI ENDD ELSE;..SYM IS A PORTION; BEGIN REVORDER; IF LOP = SINGLE T.SINGLE(LOP); THEN;..AFTER REORDERING, LOP IS STILL NOT A PORTION. ;..MAKE IT ONE AND MERGE WITH SYM; BEGIN LOAD(LOP,ANYAC); MERGEPORTIONS; ENDD ELSE;..LOP IS A PORTION AFTER REORDERING; IF SYM = SINGLE T.SINGLE(SYM); THEN;..THERE IS ONLY ONE PORTION; REOPEN(LOP); ELSE;..TWO PORTIONS; BEGIN IF LOP IS A POINTER T.PTR (LOP); THEN;..WE MAY HAVE TO EVALUATE LOP BEFORE MERGING; BEGIN IF REVERSAL NOT ALLOWED OR LOP IS A ONE WORD OPERAND JUMPN T3,TRUE ;..(T3 IS A SWITCH WHICH IS SET BY REVORDER); T.ONE (LOP); THEN;..EVALUATE LOP NOW; ;..LOAD VALUE OF LOP INTO SAME ACC USED BY POINTER; F.LOCN (T2,LOP); LOAD(LOP,@T2); FI ENDD FI MERGEPORTIONS; ENDD FI FI ENDD FI ENDD ; MARRY SUBTTL CODE GENERATION ROUTINES * SETUP * PROCEDURE SETUP ;..SET UP THE OPERANDS FOR A BINARY OPERATION BY ; MAKING A SINGLE OPEN PORTION, REORDERED IF POSSIBLE, ; WITH THE VALUE OF THE (REORDERED) LEFT OPD (LOP) IN AN AC; ; ON ENTRY, OPERAND LEXEMES ARE IN LOP AND SYM; ; SETUP MAY CHANGE THE OPERATOR IF THE OPERATION ; IS REVERSIBLE, (E.G., "<" => ">", LFDV => RLFDV). BEGIN ;..FIRST MAKE A SINGLE OPEN PORTION FOR THE OPERANDS; MARRY; IF REV T.REV; THEN;..PORTIONS WERE REVERSED BY MARRY; BEGIN ;..EXCHANGE THE LEXEMES AGAIN; EXCH LOP,SYM ;..SET REV OFF; MOVNI REV,SYM ENDD FI IF LOP NOT AN EXPRESSION IN ACC TN.ACC (LOP); THEN;..VALUE OF LOP IS NOT NOW IN AN AC; BEGIN IF VALUE OF SYM IN AN ACC TLNE SYM,$AM-$ACC GOTO FALSE THEN;..WE MAY BE ABLE TO DO AN OPERATOR REVERSAL; BEGIN IF OP IS NOT REVERSIBLE MOVE T,OP TRNE T,$ODROP GOTO FALSE THEN;..OP IS NOT USUALLY REVERSIBLE; BEGIN IF SYM = LONG REAL T.LR (SYM); THEN;..OPERANDS ARE LONG REAL; BEGIN IF OP = SLASH T.OPER (ZSLASH); THEN;..WE CAN CALL A REVERSE DIVIDE SR; GOTO LSETU1 FI IF OP = "-" T.OPER (ZMINUS); THEN;..WE CAN CALL A REVERSE SUBTRACT SR; GOTO LSETU1 FI ENDD FI ;..NO CHANCE OF OPERATOR REVERSAL. LOAD VALUE OF LOP INTO AN AC; GOTO LSETU2 ENDD ELSE;..OP IS REVERSIBLE; BEGIN LSETU3: IF OP IS NOT COMMUTATIVE MOVE T,OP TRNE T,$ODCOP GOTO FALSE THEN;..MAKE OP INTO ITS REVERSE; LSETU1: ;..OP _ REVERSE(OP); MOVE T,OP ADDI T,2_^D8 MOVEM T,OP ;..ELSE COMMUTATIVE OP IS ITS OWN REVERSE; FI ;..REVERSE THE OPERANDS BY EXCHANGING LEXEMES AND LEXEXES; MOVE T,LEXEX EXCH T,LEXEX+2 MOVEM T,LEXEX MOVE T,LEXEX+1 EXCH T,LEXEX+3 MOVEM T,LEXEX+1 EXCH LOP,SYM ENDD FI ENDD ELSE;..NEITHER SYM NOR LOP HAS A LOADED VALUE; BEGIN IF LOP = SINGLE AND SYM = POINTER AND OP IS REVERSIBLE T.PTR (SYM); MOVE T,OP TRNE T,$ODROP TLNE LOP,$SINGLE GOTO FALSE THEN;..WE SHOULD LOAD THE VALUE OF SYM NOW; BEGIN ;..LOAD VALUE OF SYM INTO SAME ACC, LEAVING PORTION OPEN; MOVE T,OPMVSM F.LOCN (T1,SYM); GLOAD; ;..GO BACK TO REVERSE THE LEXEMES; GOTO LSETU3 ENDD FI LSETU2: ;..PUT THE VALUE OF LOP IN AN AC; IF LOP IS A POINTER T.PTR (LOP); THEN;..USE SAME ACC FOR VALUE AS FOR POINTER; F.LOCN (T1,LOP); ELSE;..USE NEXT FREE ACC; MOVEI T1,ANYAC FI IF OP = "DIV" OR "REM" MOVE T,OP CAMN T,ZDIV GOTO TRUE CAME T,ZREM GOTO FALSE THEN;..GIVE LOP SPECIAL TYPE SO LOAD WILL USE 2 AC'S; TLZ LOP,$TYPE TLO LOP,$IDI FI ;..LOAD THE VALUE, LEAVING THE PORTION OPEN; MOVE T,OPMVLP GLOAD; ENDD FI ENDD; FI ENDD ; SETUP SUBTTL CODE GENERATION ROUTINES * STOCON * PROCEDURE STOCON ;..FIX UP LEXEME AND CONSTANT TABLE (IF NECESSARY) ; FOR A NEWLY GENERATED ONE WORD CONSTANT; ; ON ENTRY, VALUE OF CONSTANT IS IN T3; ; PARTIAL LEXEME FOR CONSTANT IS IN SYM; ; IF CONSTANT CAN BE IMMEDIATE, IT WILL BE STORED IN THE LEXEME; ; IF NOT IT WILL BE PUT INTO THE CONSTANT TABLE; ; COMPLETED LEXEME WILL BE PUT INTO SYM; BEGIN IF LEFT HALF OF CONSTANT = 0 AND SYM NEQ REAL TLNN T3,777777 TN.R (SYM); THEN;..WE HAVE A BOOLEAN OR INTEGER IMMEDIATE CONSTANT; ;LEX(SYM) _ (IMMED,SAME,SIMPLE,RH(T3)); TLZ SYM,$STATUS!$AM TLO SYM,$SIM!$IMM HRR SYM,T3 ELSE;..IT MAY BE REAL IMMEDIATE; IF RIGHT HALF OF CONSTANT = 0 AND SYM = REAL TRNN T3,777777 T.R (SYM); THEN;..WE HAVE A REAL IMMEDIATE CONSTANT; ;LEX(SYM) _ (IMMED,SAME,SIMPLE,LH(T3)); TLZ SYM,$STATUS!$AM TLO SYM,$SIM!$IMM HLR SYM,T3 ELSE;..CONSTANT CANNOT BE IMMEDIATE; ;..PUT CONSTANT IN TABLE; TOCT(1,SYM); FI FI ENDD ; STOCON ENDD; END OF MODULE MFUN LIT END