Trailing-Edge
-
PDP-10 Archives
-
AP-5471B-BM
-
sources/algcod.mac
There are 8 other files named algcod.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 CODE GENERATION ROUTINES PART 1
; COPYRIGHT 1971,1972,1973,1974 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
; 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 MCOD;
$PLEVEL=2;
BEGIN
EXPROC CHECKARITH
EXPROC CLOSE
EXPROC COMBASSIGN
EXPROC COMBLEX
EXPROC CONVERT
EXPROC EMITCODE
EXPROC ERRLEX
EXPROC FAIL
EXPROC GLOAD
EXPROC IPLUNK
EXPROC LOAD
EXPROC MARRY
EXPROC MERGEPORTIONS
EXPROC PLUNK
EXPROC REOPEN
EXPROC REVORDER
EXPROC SETUP
EXPROC STOCON
EXPROC TOCT1
EXPROC TOCT2
EXTERN CTILR,CTLRI,CTLRR ;COMPILE-TIME CONVERSION SR'S;
EXTERN POWC1,POWC2,POWC3 ;COMPILE-TIME POWER SR'S;
INTERN OPUMIN,OPABS,OPENT1,OPENT2,OPENT3,OPJSPX,OPMVMS ; OPS USED IN CGFUN
INTERN OPPSJP,OPSGN1,OPSGN2,OPSGN3,OPSETO
INTERN OPADDB,OPAOS,OPSOS,OPMVSM
INTERN OPJMPE,OPJMPG,OPJRST,OPMVLP
INTERN OPCONC,OPCONV,OPMOVE,OPABS1,OPLNEG
INTERN OPENT4,OPENT5,KIOPS
; * * * * TABLE OF INSTRUCTIONS (ACTUAL AND PSEUDO)
; TO BE GENERATED IN CGEN AND CGFUN
OPCODE:
OPPOW: POWR1 0,$R !7 ; 3 BY 4 TABLE OF "^" SUBROUTINES
POWR4 0,$R !0 ;
POWR5 0,$LR!0 ;
OPTDZA: TDZA ; USED IN RELATIONS
POWR2 0,$R !7 ;
POWR4 0,$R !1 ;
POWR5 0,$LR!1 ;
OPSETO: SETO ; USED IN RELATIONS
POWR3 0,$LR!7 ;
POWR5 0,$LR!2 ;
POWR5 0,$LR!3 ;
OPTIMES:IMUL ; INTEGER "*"
FMPR ; REAL "*"
LFMP ; LONG REAL "*" (PSEUDO OPN)
DFMP A0,A3
OPDIV: IDIV ; INTEGER "DIV"
OPSLASH:NOOP
OPREM: FDVR ; REAL "/"
LFDV ; LONG REAL "/" (PSEUDO OPN)
DFDV A0,A3
RLFDV ; REVERSED LONG REAL "/" (PSEUDO OPN)
OPUMIN: MOVN ; INTEGER NEGATE
OPUPLUS:MOVN ; REAL NEGATE
OPLNEG: LMOVN 0,0 ; LONG REAL NEGATE PSEUDO-OP
OPPLUS: ADD ; INTEGER "+"
FADR ; REAL "+"
LFAD ; LONG REAL "+" (PSEUDO OPN)
DFAD A0,A3 ; LFADC
OPMINUS:SUB ; INTEGER "-"
OPFSBR: FSBR ; REAL "-"
OPLFSB: LFSB ; LONG REAL "-" (PSEUDO OPN)
DFSB A0,A3
RLFSB ; REVERSED LONG REAL "-" (PSEUDO OPN)
OPLSS: CAML ; INTEGER OR REAL "<"
CAIL ; LONG REAL "<"
OPGTR: CAMG ; ">" (AND REVERSED "<")
CAIG
OPRGTR: CAML ; REVERSED ">"
CAIL
OPLEQ: CAMLE ; INTEGER OR REAL "<="
CAILE ; LONG REAL "<="
OPGTE: CAMGE ; ">=" (AND REVERSED "<=")
CAIGE
OPRGTE: CAMLE ; REVERSED ">="
CAILE
OPEQ: CAME ; INTEGER OR REAL "="
CAIE ; LONG REAL "="
OPNE: CAMN ; INTEGER OR REAL "#"
CAIN ; LONG REAL "#"
OPNOT: SETCM ; BOOLEAN "NOT"
OPAND: AND ; BOOLEAN "AND"
OPOR: OR ; BOOLEAN "OR"
OPIMP: ORCA ; BOOLEAN "IMP"
OPEQV: EQV ; BOOLEAN "EQV"
OPRIMP: ORCM ; REVERSED "IMP"
OPASS: MOVEM ; INTEGER ":="
MOVEM ; REAL ":="
LMOVEM ; LONG REAL ":=" (PSEUDO OPN)
LMOVEM ; STRING ":=" (PSEUDO OPN)
OPTCSF: TCSF ; FORMAL ":=" (PSEUDO OPN)
OPCONV: CIR ; 3 BY 4 TABLE OF CONVERSION CALLS
CIL ;
OPPUSH: PUSH ; USED IN "^"CALL
CRI ;
OPMVI1: MOVEI 1,0 ; USED IN "^" CALL
CRL ;
OPLPSH: LPUSH ; LONG REAL PUSH PSEUDO (USED IN "^" CALL)
CLI ;
CLR ;
OPJSPX: ELI ; LONG ENTIER
OPMOVE: MOVE ; INTEGER MOVE
MOVE ; REAL MOVE
LMOVE ; LONG REAL MOVE (PSEUDO OPN)
OPCONC: FLTR A0,A0 ; 3 BY 4 TABLE OF COMPILE-TIME
PUSHJ SP,CTILR ; CONVERSIONS FOR CONSTANTS
OPPSJP: PUSHJ SP,0 ; USED TO CALL LIBRARY FUNCTIONS
FIXR A0,A0 ;
OPABS: MOVM ; IN-LINE "ABS"
SETZ A1, ;
OPMVMS: MOVM 0,(SYM) ; CONSTANT TO LOAD ABS(SYM)
PUSHJ SP,CTLRI ;
PUSHJ SP,CTLRR ;
OPABS1: ;..AND IN .CGFTEST (ALGFUN)
EXP <JUMPGE 0,2>!$RA_22 ;USED IN IN-LINE LONG "ABS"
OPPOWC: PUSHJ SP,POWC1 ; COMPILE-TIME INTEGER "^" INTEGER
PUSHJ SP,POWC2 ; COMPILE-TIME REAL "^" INTEGER
PUSHJ SP,POWC3 ; COMPILE-TIME LONG REAL "^" INTEGER
OPMVLP: MOVE 0,(LOP) ; CONSTANT FOR GLOAD OF LOP
OPMVSM: MOVE 0,(SYM) ; CONSTANT FOR GLOAD OF SYM
OPENT1: MULI 0,400 ; IN-LINE REAL "ENTIER"
OPENT2: TSC
OPENT3: EXP <ASH 0,-243>!$NEXT_22
OPSGN1: EXP <JUMPE 0,3>!$RA_22 ; IN-LINE "SIGN"
OPSGN2: ASH 0,-43
OPSGN3: IORI 0,1
OPADDB: ADDB ; USED IN "FOR" INCREMENT
FADRB
OPAOS: AOS
OPSOS: SOS
OPJMPE: JUMPE ; USED IN "FOR" TEST
OPJMPG: JUMPG
OPJRST: JRST
OPBYT3: EXP <DPB 0,0>!$ACC_22
OPSTRA: TCADDF STRASS ; CALL ON STRING ASSIGNMENT
OPCMPR: TCADDF COMPAR ; CALL ON STRING COMPARE SR
OPSTZB: SETZB 0,(LOP) ; ASSIGN A ZERO
OPSTOB: SETOB 0,(LOP) ; ASSIGN ALL ONES
OPASHL: ASH 0,21 ; MULTIPLY BY POWER OF 2
OPASHR: ASH 0,-21 ; DIVIDE BY POWER OF 2
OPENT4: FSBRI 0,(0.5) ; IN LINE ENTIER FOR KI10
OPENT5: FIXR 0,0
; REAL KI10 OPERATORS
KIOPS: DMOVE ; 700
DPUSH
DMOVEM
TCTHEN
TCELSE
TCFI
TCTO
TCOT
DMOVN ; 710
TCTYDES
DMOVNM
TCSF
DMOVEM
715
DFAD
DFSB
DFMP ; 720
DFDV
SUBTTL CODE GENERATION ROUTINES * CGASS *
PROCEDURE CGASS
;..GENERATE CODE TO PERFORM AN ASSIGNMENT;
; ON ENTRY, LEXEME FOR RIGHT HAND SIDE IS IN SYM
; LEXEME FOR LEFT PART IS IN LOP
; IF TYPES ARE ARITHMETIC AND DO NOT MATCH, SYM WILL BE
; CONVERTED TO THE TYPE OF LOP.
; SPECIAL CASES FOR NON-FORMAL ASSIGNMENTS:
; LOP _ 0 ("SETZB" GENERATED)
; LOP _ -1 ("SETOB" GENERATED)
; RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;
BEGIN
OWN CGATMP; ;..TEMPORARY TO HOLD LOP FOR FORMALS;
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;$
;..INITIALIZE OP TO "_" (NEEDED IN REVORDER);
MOVE T,ZASS;$
MOVEM T,OP;$
IF LOP<TYPE> NEQ SYM<TYPE>
F.TYPE (T3,LOP);
F.TYPE (T4,SYM);
CAMN T3,T4;$
GOTO FALSE;$
THEN;..TYPES DO NOT MATCH;
BEGIN
IF LOP<TYPE> = ARITH AND SYM<TYPE> = ARITH
TLNN LOP,$ARC;$
T.ARITH (SYM);
THEN;..UNMATCHED ARITHMETIC TYPES;
;..CONVERT SYM TO THE TYPE OF LOP;
MOVE T,T3;$
CONVERT;
ELSE;..TYPES ARE NOT BOTH ARITHMETIC;
IF LOP<TYPE>=STRING!REGULAR
T.S (LOP);
T.REG (LOP);
THEN;..BYTE ASSIGNMENT;
BEGIN
IF SYM<TYPE> = ARITHMETIC
T.ARITH (SYM);
THEN;..BYTE IS ARITHMETIC;
BEGIN
IF SYM<TYPE> NEQ INTEGER
TN.I (SYM);
THEN;..BYTE OPERAND MUST BE CONVERTED TO INTEGER;
;..CONVERT SYM TO INTEGER TYPE;
MOVEI T,$I;$
CONVERT;
FI
ENDD
ELSE;..ERROR -- MISMATCHED TYPES;
;GO TO WRITE FAIL MESSAGE AND DIE;
GOTO LCGAS3;$
FI
ENDD
ELSE;..TYPES CANNOT BE MATCHED;
BEGIN
LCGAS3:
FAIL(65,FRIED,SYM,UNMATCHED TYPE CLASSES FOR AN ASSIGNMENT);
;GO TO LAST "ENDD";
GOTO LCGAS1;$
ENDD
FI
FI
ENDD
ELSE
IF LOP<TYPE!STATUS>=STRING!REGULAR
T.S (LOP);
T.REG (LOP);
THEN
;..STRING ASSIGNED TO A BYTE POINTER, GO TO WRITE
;..FAIL MESSAGE AND DIE;
GOTO LCGAS3;$
FI
FI;
EDIT(044); Dont force constants to D.P. unnecessarily
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 SYM TO A GENUINE LONG REAL CONSTANT ; [E044]
MOVE T3,2(T2) ; [E044]
TLZ T4,(1B0) ; [E044]
TOCT (2,SYM) ; [E044]
FI ; [E044]
IF LOP = FORMAL BY NAME
T.FON (LOP);
THEN;..ASSIGNMENT TO A FORMAL;
BEGIN
;..THE THUNK FOR STORING INTO A FORMAL NEEDS THE RIGHT-HAND
; VALUE IN A0 AND THE FORMAL IN A2;
IF SYM IS A POINTER
T.PTR (SYM);
THEN;..PUT ITS VALUE INTO AC0;
GOTO LCGAS2;$
FI
IF VALUE OF SYM NOT IN AC0
TN.AC0 (SYM);
THEN;..PUT IT IN;
LCGAS2:
LOAD(SYM,A0);
FI
;..SAVE LOP (LEXEME FOR FORMAL SYMBOL);
MOVEM LOP,CGATMP;$
;..FOOL MERGEPORTIONS. TELL IT THAT LOP IS AN INT. EXP. (IN A2);
TLZ LOP,$KIND!$TYPE!$STATUS!$AM;$
TLO LOP,$EXP!$I!$SIM!$ACC;$
HRRI LOP,A2;$
MERGEPORTIONS;
IF LOP IS IN THE STACK OR LOP<RHS>#A2
TLNN LOP,$STACK;$
GOTO TRUE;$
MOVEI LOP,(LOP);$
CAIN LOP,A2;$
GOTO FALSE;$
THEN;..MERGEPORTIONS DID IT BECAUSE OF ACC CONFLICT;
;..GET LOP BACK INTO A2 (NO CONFLICT POSSIBLE NOW);
;PLUNK(MOVE,A2,LOP);
MOVE T,OPMOVE;$
MOVEI T1,A2;$
PLUNK (LOP);
FI
;..RESTORE ORIGINAL LOP LEXEME;
MOVE LOP,CGATMP;$
;..EXECUTE THUNK (F[1]);
;PLUNK(TCSF,LOP);
;..TCSF IS A PSEUDO TO GENERATE THE XCT TO STORE INTO A FORMAL;
MOVE T,OPTCSF;$
PLUNKI (LOP);
ENDD
ELSE;..NON-FORMAL ASSIGNMENT;
BEGIN
IF SYM IS A POINTER
T.PTR (SYM);
THEN;..LOAD VALUE OF SYM INTO SAME ACC USED BY PTR;
F.LOCN (T2,SYM);
LOAD(SYM,@T2);
ELSE;..SYM IS NOT A POINTER;
IF SYM = SINGLE
T.SINGLE(SYM);
THEN;..THE VALUE OF SYM IS NOT YET IN AN ACC;
BEGIN
IF LOP<TYPE> NEQ STRING
TLNN LOP,$TYPE-$S;$
GOTO FALSE;$
THEN;..CHECK FOR SPECIAL CASES (SYM = 0 OR -1);
BEGIN
IF SYM = IMMEDIATE AND SYM<VALUE> = 0
TRNN SYM,777777;$
T.IMM (SYM);
THEN;..STORE A ZERO;
BEGIN
;..GENERATE SETZB TO STORE ZERO IN LOP AND INTO A FREE ACC;
MOVE T1,OPSTZB;$
;..GO AND GENERATE THE STORE INSTRUCTION;
GOTO LCGAS5;$
ENDD
FI
IF SYM IS A ONE WORD CONSTANT = -1 (ALL ONES)
TLNE SYM,$CT-$IMM;$
TLNE SYM,$VAR1!$CONST;$
GOTO FALSE;$
F.LOCN (T,SYM);
ADD T,CONTAB;$
SETCM T,1(T);$
JUMPN T,FALSE;$
THEN;..STORE ALL ONES;
BEGIN
;..GENERATE SETOB TO STORE ONES IN LOP AND AN ACC;
MOVE T1,OPSTOB;$
LCGAS5:
;..EMIT SETB COMMAND;
HRRI T1,ANYAC;$
PUSHJ SP,.LOAD;$
;LEX(SYM) _ (EXPR,SAME,SIMPLE,LOP<LOCN>);
TLZ SYM,$KIND!$STATUS!$AM;$
TLO SYM,$EXP!$SIM!$ACC;$
HRR SYM,LOP;$
REOPEN(LOP);
;..GO OUT TO COMBINE LEXEMES;
GOTO LCGAS4;$
ENDD
FI
ENDD
FI
;..GET THE VALUE OF SYM INTO A FREE ACC;
LOAD(SYM,ANYAC);
ENDD
FI
FI
IF LOP = BYTE POINTER
HLRZ T,LOP;$
CAIE T,$VAR!$S!$REG!$DECL!$PTR;$
GOTO FALSE;$
THEN;..SET SWITCH ON;
SETOM 0,CGATMP;$
ELSE;..SET SWITCH OFF;
SETZM 0,CGATMP;$
FI
IF LOP = SINGLE
T.SINGLE(LOP);
THEN;..NO PORTION NECESSARY FOR LOP;
REOPEN(SYM);
ELSE;..BOTH LOP AND SYM ARE PORTIONS;
BEGIN
REVORDER;
MERGEPORTIONS;
IF REV
T.REV;
THEN;..PORTIONS WERE REVERSED;
BEGIN
;..RE-EXCHANGE LEXEMES;
EXCH LOP,SYM;$
;..SET REV OFF;
MOVNI REV,SYM;$
ENDD
FI
IF SYM IS IN THE STACK
T.STK (SYM);
THEN;..VALUE WAS PUSHED DUE TO ACC CONFLICT;
;..PUT IT BACK IN AN ACC;
MOVE T,OPMVSM;$
MOVEI T1,ANYAC;$
GLOAD;
ELSE;..MAYBE LOP WAS PUSHED;
IF LOP IS IN THE STACK
T.STK (LOP);
THEN;..PTR WAS PUSHED DUE TO ACC CONFLICT. OK UNLESS 2 WORD OPD;
BEGIN
IF LOP<TYPE> = LONG REAL OR STRING
T.TWO (LOP);
THEN;..WE MUST RETRIEVE THE POINTER FROM THE STACK;
BEGIN
;..PUT IT BACK IN AN ACC (CAN PUT IT ANYWHERE BUT IN
;.. ACC'S USED FOR RESULT OF SYM);
IF SYM<LOCN> GEQ A3
F.LOCN (T1,SYM);
CAIGE T1,A3;$
GOTO FALSE;$
THEN;..USE ACC JUST BEFORE SYM;
SUBI T1,1;$
ELSE;..CAN'T USE FIRST ACCS. USE LAST ACC;
MOVEI T1,A13;$
FI
;..SAVE THE ACC NUMBER OF THE RESULT;
MOVE T4,T1;$
;..FUDGE MODE TO MOVE POINTER ITSELF (NOT @PTR);
TLZ LOP,$AM;$
TLO LOP,$SP;$
;..NOW EMIT THE INSTRUCTION;
MOVE T,OPMOVE;$
PLUNK (LOP);
;LEX(LOP) _ (SAME,SAME,SAME,POINTER);
TLZ LOP,$AM;$
TLO LOP,$PTR;$
HRR LOP,T4;$
ENDD
;..ELSE LOP IS NOT A 2 WORD OPERAND;
FI
ENDD
;..ELSE LOP WAS NOT STACKED;
FI
FI
ENDD
FI
;..ALL IS READY AND WE CAN PERFORM THE ASSIGNMENT;
IF LOP IS A BYTE POINTER
SKIPN 0,CGATMP;$
GOTO FALSE;$
THEN;..GENERATE CODE FOR BYTE ASSIGNMENT;
BEGIN
;PLUNK(DPB,SYM,LOP);
MOVE T,OPBYT3;$
F.LOCN (T1,SYM);
HRR T,LOP;$
PLUNK;
;LEX(SYM) _ (EXPR,INTEGER,SIMPLE,ACC);
TLZ SYM,$KIND!$TYPE!$STATUS!$AM;$
TLO SYM,$EXP!$I!$SIM!$ACC;$
ENDD
ELSE;..DO A NORMAL MOVE TO MEMORY;
IF SYM<TYPE> = STRING
T.S (SYM);$
THEN;..PLANT CALL TO STRASS
BEGIN
MOVE T,OPLPSH;$
MOVEI T1,SP;$
; PUSH SYM
PLUNK(SYM);$
EDIT(032) ; ALLOW FOR THE CASE OF LOP IN AC 0 OR 1
IF LOP IN AC 0 OR 1 ; [E032]
HRLEI T,-1(LOP) ; [E032]
TLNN LOP,$AMAC ; [E032]
JUMPLE T,TRUE ; [E032]
GOTO FALSE ; [E032]
THEN ; [E032]
; WE HAVE NOW PUSHED SYM FROM SOME ACCS ONTO THE STACK. WE WILL NOT
;USE THESE ACCS ANY MORE, AS WE ARE ABOUT TO ELABORATE THE RESULT OF
;STRASS (WHICH WILL BE IN AC 0 & 1) INTO SYM. THEREFORE WE CAN USE ONE
;OF THE ACCS THAT SYM WAS IN WITHOUT ANY FEAR OF LATER ACC CONFLICT !!.
MOVSI T,(<MOVE>) ; [E032]
HRRI T,(LOP) ; [E032]
HRRI LOP,1(SYM) ; [E032]
F.LOCN(T1,LOP) ; [E032]
PLUNK; [E032]
FI ; [E032]
; PUSH LOP
MOVE T,OPLPSH;$
MOVEI T1,SP;$
PLUNK(LOP);$
MOVE T,OPSTRA;$
PLUNKI;
;..SYM<LEX> _ (EXPR,SIM,AC0)
TLZ SYM,$KIND!$STATUS!$AM;$
TLO SYM,$EXP!$SIM!$ACC;$
TRZ SYM,777777;$
ENDD;
FI;
;PLUNK(ASSIGN,LOP,SYM);
F.TRANK (T,SYM);
MOVE T,OPASS(T);$
F.LOCN (T1,SYM);
PLUNK (LOP);
FI
ENDD;
FI
LCGAS4:
CLOSE(SYM);
;..COMBINE LEXEXES AND COMPOSITE NAMES;
COMBASSIGN;
ENDD
FI
LCGAS1:
ENDD ; CGASS
SUBTTL CODE GENERATION ROUTINES * CGBIN *
PROCEDURE CGBIN
;..GENERATE CODE TO PERFORM A BINARY OPERATION;
; ON ENTRY, OPERATION LEXEME IS IN OP;
; OPERAND LEXEMES ARE IN LOP AND SYM;
; IF BOTH OPERANDS ARE CONSTANTS, THE OPERATION IS USUALLY
; DONE AT COMPILE TIME, A NEW CONSTANT IS GENERATED,
; AND NO CODE IS PRODUCED.
; OPERANDS WILL BE REVERSED IF POSSIBLE, AND OPERATIONS
; MAY ALSO BE REVERSED (E.G., "<" BECOMES ">").
; ARITHMETIC TYPES WILL BE MATCHED BY CONVERTING ONE
; OPERAND TO THE TYPE OF THE OTHER
; (IN THE ORDERING INTEGER => REAL => LONG REAL).
; SPECIAL CASES FOR BINARY OPERATIONS:
; LOP ^ 2 (GENERATES "MULTIPLY LOP,LOP")
; LOP DIV (2^N) (GENERATES "ASH -N")
; LOP * (2^N) (GENERATES "ASH N")
; LOP + (-CONST) (CHANGED TO (LOP - CONST))
; RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;
BEGIN
LOCAL LACSAV;
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 OP IS ARITHMETIC
F.DISC (T);
CAILE T,OPMINUS-OPCODE;$
GOTO FALSE;$
THEN;..ARITHMETIC OPERATION;
BEGIN
IF LOP<TYPE> = ARITH AND SYM<TYPE> = ARITH
TLNN LOP,$ARC;$
T.ARITH (SYM);
THEN;..OPERANDS ARE ARITHMETIC;
BEGIN
IF OP = "REM" OR "DIV"
MOVE T,OP;$
CAMN T,ZREM;$
GOTO TRUE;$
CAME T,ZDIV;$
GOTO FALSE;$
THEN;..MUST DO AN INTEGER DIVIDE;
BEGIN
IF LOP<TYPE> = INTEGER AND SYM<TYPE> = INTEGER
TLNN LOP,$TYPE-$I;$
T.I (SYM);
THEN;..OPERANDS ARE INTEGERS;
BEGIN
IF NOT TREATCONST
TREATCONST;
JUMPN T,FALSE;$
THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
BEGIN
;..GIVE LOP SPECIAL TYPE SO LOAD WILL USE 2 AC'S;
TLZ LOP,$TYPE;$
TLO LOP,$IDI;$
IF VALUE OF LOP IN LAST AC <AC13> OR NOT IN AC
TLNE LOP,$AM-$ACC;$
GOTO TRUE;$
F.LOCN (T,LOP);
CAIE T,A13;$
GOTO FALSE;$
THEN;..MUST MOVE LOP TO AN AC PAIR;
BEGIN
LOAD(LOP,ANYAC);
ENDD
FI
SETUP;
;..RESET TYPE TO INTEGER;
TLZ LOP,$TYPE;$
TLO LOP,$I;$
;EMITCODE(IDIV,LOP,SYM,2);
MOVE T,OPDIV;$
F.LOCN (T1,LOP);
HRLI T1,2;$
EMITCODE(SYM);
;LEX(SYM) _ (EXPR,INTEGER,SIMPLE,LOP);
TLZ SYM,$KIND!$TYPE!$STATUS!$AM;$
TLO SYM,$EXP!$I!$SIM!$ACC;$
HRR SYM,LOP;$
IF OP = "REM"
T.OPER (ZREM);
THEN;..RESULT WILL BE IN AC+1;
;SYM<LOCN> _ SYM<LOCN> + 1;
HRRZ T,SYM;$
ADDI T,1;$
HRR SYM,T;$
FI
CLOSE(SYM);
COMBLEX;
ENDD
FI
ENDD
ELSE;..OPERANDS ARE NOT INTEGERS;
FAIL(67,FRIED,SYM,NON-INTEGER OPERAND FOR "REM" OR "DIV");
FI
ENDD
ELSE;..OP NEQ "REM" AND OP NEQ "DIV";
IF OP = "^"
T.OPER (ZPOW);
THEN;..POWER OPERATION;
BEGIN
IF NOT TREATCONST
TREATCONST;
JUMPN T,FALSE;$
THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
BEGIN
IF SYM = IMMEDIATE AND SYM<VALUE> = 2
F.LOCN (T,SYM);
CAIN T,2;$
T.IMM (SYM);
THEN;..WE CAN USE MULTIPLY INSTEAD OF POWER;
;..( LOP ^ 2 = LOP * LOP );
BEGIN
IF LOP IS A POINTER
T.PTR (LOP);
THEN;..LOAD VALUE INTO SAME ACC USED BY PTR;
F.LOCN (T2,LOP);
LOAD(LOP,@T2);
ELSE;..NOT A POINTER;
IF LOP IS SINGLE
T.SINGLE(LOP);
THEN;..MAKE A PORTION TO LOAD LOP INTO AN ACC;
LOAD(LOP,ANYAC);
FI
FI
REOPEN(LOP);
;..GENERATE (MULTIPLY,LOP,LOP);
;SYM _ LOP;
MOVE SYM,LOP;$
;OP _ "*";
MOVE T,ZTIMES;$
MOVEM T,OP;$
;GO AND EMIT THE "*" OPERATION;
GOTO LCGBI3;$
ENDD
FI
;..COMBINE PORTIONS;
MARRY;
IF REV
T.REV;
THEN;..PORTIONS WERE REVERSED;
BEGIN
;..EXCHANGE THE LEXEMES AGAIN;
EXCH LOP,SYM;$
;..SET REV OFF;
MOVNI REV,SYM;$
ENDD
FI
;..WE MUST NOW STACK BOTH OPERANDS FOR THE POWER SR;
EDIT(044);Don't force all constants to D.P.
IF SYM<TYPE> = LONG REAL ; [E044]
T.LR (SYM) ; [E044]
THEN; ; [E044]
BEGIN; ; [E044]
IF SYM = PSEUDO-LONG CONSTANT ; [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 A1,3(T2) ; [E044]
GOTO FALSE ; [E044]
THEN; ; [E044]
BEGIN; ; [E044]
IF LOP # GENUINE LONG REAL ; [E044]
TLNE LOP,$TYPE-$LR ; [E044]
GOTO TRUE ; [E044]
T.CONST (LOP) ; [E044]
TLNE LOP,$CT-$IMM ; [E044]
TLNN LOP,$DEC ; [E044]
GOTO FALSE ; [E044]
F.LOCN (T1,LOP) ; [E044]
ADD T1,CONTAB ; [E044]
SKIPL 3(T1) ; [E044]
GOTO FALSE ; [E044]
THEN;SYM SHOULD BE REAL ; [E044]
MOVE T3,A0 ; [E044]
MOVE A0,2(T2) ; [E044]
TLZ A1,(1B0) ; [E044]
PUSHJ SP,CTLRR ; [E044]
EXCH T3,A0 ; [E044]
TOCT (1,SYM) ; [E044]
TLZ SYM,$TYPE ; [E044]
TLO SYM,$R ; [E044]
GOTO LCPOW1 ; [E044]
ELSE;SYM SHOULD BE LONG ; [E044]
MOVE T3,2(T2) ; [E044]
MOVE T4,3(T2) ; [E044]
TLZ T4,(1B0) ; [E044]
TOCT (2,SYM) ; [E044]
FI; ; [E044]
ENDD; ; [E044]
ELSE; SYM IS GENUINE LONG REAL ; [E044]
IF LOP = PSEUDO-LONG REAL ; [E044]
TLNN LOP,$TYPE-$LR ; [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;MAKE LOP GENUINE LONG ; [E044]
MOVE T3,2(T2) ; [E044]
TLZ T4,(1B0) ; [E044]
TOCT (2,LOP) ; [E044]
FI; ; [E044]
FI; ; [E044]
ENDD; ; [E044]
ELSE;SYM IS NOT LONG REAL ; [E044]
LCPOW1: ; [E044]
IF LOP = PSEUDO-LONG REAL ; [E044]
TLNN LOP,$TYPE-$LR ; [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 A1,3(T2) ; [E044]
GOTO FALSE ; [E044]
THEN;CONVERT LOP TO REAL ; [E044]
MOVE T3,A0 ; [E044]
MOVE A0,2(T2) ; [E044]
TLZ A1,(1B0) ; [E044]
PUSHJ SP,CTLRR ; [E044]
EXCH T3,A0 ; [E044]
TOCT (1,LOP) ; [E044]
TLZ LOP,$TYPE ; [E044]
TLO LOP,$R ; [E044]
FI; ; [E044]
FI; ; [E044]
EDIT(110); Check for variables already on the stack
IF SYM IS IN THE STACK ; [E110]
T.STK (SYM) ; [E110]
THEN; PUT IT BACK IN AN ACC ; [E110]
MOVE T,OPMVSM ; [E110]
MOVEI T1,ANYAC ; [E110]
GLOAD; ; [E110]
FI; ; [E110]
IF LOP<TYPE> = LONG REAL
T.LR (LOP);
THEN
;OPN IS LPUSH;
MOVE T,OPLPSH;$
ELSE;..SHORT OPERAND;
BEGIN
IF LOP IS IMMEDIATE
T.IMM (LOP);
THEN;..PUT CONSTANT IN TABLE SO IT CAN BE PUSHED;
BEGIN
IF LOP<TYPE> = INTEGER
T.I (LOP);
THEN;..IMMED. CONST. GOES TO RIGHT HALF OF T3;
HRRZ T3,LOP;$
ELSE;..IMMED. CONST. GOES TO LEFT HALF OF T3;
HRLZ T3,LOP;$
FI
;..PUT CONSTANT INTO TABLE;
TOCT(1,LOP);
ENDD
FI
;..OPN IS "PUSH";
MOVE T,OPPUSH;$
ENDD
FI
;..PUSH LOP;
;PLUNK(OPN,SP,LOP);
MOVEI T1,SP;$
PLUNK (LOP);
IF SYM<TYPE> = LONG REAL
T.LR (SYM);
THEN
;OPN IS LPUSH;
MOVE T,OPLPSH;$
ELSE;..SHORT OPERAND;
BEGIN
IF SYM IS IMMEDIATE
T.IMM (SYM);
THEN;..PUT CONSTANT IN TABLE SO IT CAN BE PUSHED;
BEGIN
IF SYM<TYPE> = INTEGER
T.I (SYM);
THEN;..IMMED. CONST. GOES TO RIGHT HALF OF T3;
HRRZ T3,SYM;$
ELSE;..REAL IMM. CONST. GOES TO LEFT OF T3;
HRLZ T3,SYM;$
FI
;..PUT CONSTANT INTO TABLE;
TOCT(1,SYM);
ENDD
FI
;..OPN IS "PUSH";
MOVE T,OPPUSH;$
ENDD
FI
;..PUSH SYM;
;PLUNK(OPN,SP,SYM);
MOVEI T1,SP;$
PLUNK (SYM);
;..GET POWER INFORMATION WORD;
F.TRANK (T3,LOP);
LSH T3,2;$
F.TRANK (T,SYM);
OR T3,T;$
MOVE T3,OPPOW(T3);$
IF SYM<TYPE> NEQ INTEGER
TN.I (SYM);
THEN;..PUT CODE VALUE IN AC1;
BEGIN
;PLUNK(MOVEI,AC1,POWER CODE);
MOVE T,T3;$
ANDI T,3;$
HLL T,OPMVI1;$
PLUNKI;
;..BOOK AC1 USED;
MOVSI T,2;$
IORM T,HANDLE;$
ENDD
ELSE;..EXPONENT IS AN INTEGER;
BEGIN
IF LOP<TYPE> = INTEGER
T.I (LOP);
THEN;..INTEGER ^ INTEGER. RESULT MAY BE INT. OR REAL;
BEGIN
IF SYM = CONSTANT GEQ ZERO
T.CONST (SYM);
F.LOCN (T,SYM);
ADD T,CONTAB;$
SKIPGE 0,1(T);$
GOTO FALSE;$
THEN;..CODE _ 0 AND RESULT WILL BE INTEGER;
BEGIN
;POWER CODE _ 0;
MOVEI T,0;$
;RESULT.TYPE _ INTEGER;
TRZ T3,$TYPE;$
TRO T3,$I;$
ENDD
ELSE;..CODE _ 1 AND RESULT WILL BE REAL;
;POWER CODE _ 1;
MOVEI T,1;$
FI
;..PUT CODE VALUE IN AC1;
;PLUNK(MOVEI,AC1,POWER CODE);
HLL T,OPMVI1;$
PLUNKI;
;..BOOK AC0-AC5 USED;
MOVSI T,77;$
IORM T,HANDLE;$
ENDD
FI
ENDD
FI
;..CALL POWER SUBROUTINE;
;PLUNK(POWER NAME);
HLLZ T,T3;$
PLUNKI;
IF RESULT.TYPE = LONG REAL
ANDI T3,$TYPE;$
CAIE T3,$LR;$
GOTO FALSE;$
THEN;..BOOK AC0-AC13 USED;
MOVSI T,7777;$
ELSE;..BOOK AC0-4 USED;
MOVSI T,37;$
FI
IORM T,HANDLE;$
;LEX(SYM) _ (EXPR,RESULT.TYPE,SIMPLE,AC0);
TLZ SYM,$KIND!$TYPE!$STATUS!$AM;$
TLO SYM,$EXP!$SIM!$ACC;$
TSO SYM,T3;$
HRRI SYM,0;$
CLOSE(SYM);
COMBLEX;
ENDD
;..ELSE BOTH OPDS WERE CONSTS AND A NEW CONST WAS GENERATED;
FI
ENDD
ELSE;..OP NEQ "^" OR "REM" OR "DIV";
BEGIN
IF OP = SLASH AND LOP = INTEGER AND SYM = INTEGER
T.OPER (ZSLASH);
TLNN LOP,$TYPE-$I;$
T.I (SYM);
THEN;..SLASH OPERATION REQUIRES REAL OPERANDS;
;CONVERT(REAL,SYM);
MOVEI T,$R;$
CONVERT;
FI
IF NOT CHECKARITH
CHECKARITH;
JUMPN T,FALSE;$
THEN;..OPERANDS NOW HAVE MATCHING ARITHMETIC TYPES;
BEGIN
IF NOT TREATCONST
TREATCONST;
JUMPN T,FALSE;$
THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
BEGIN
SETUP;
IF OP = "*" AND SYM = IMMED. INT. = 2^N (0 LEQ N LSS 18)
MOVE T,OP;$
CAMN T,ZTIMES;$
TLNE SYM,$AM-$IMM+$TYPE-$I;$
GOTO FALSE;$
HRLZ T,SYM;$
JFFO T,.+2;$
GOTO FALSE;$
LSH T,1(T1);$
JUMPN T,FALSE;$
THEN;..WE CAN SHIFT RATHER THAN MULTIPLY;
BEGIN
;PLUNK(ASH,LOP,N);
MOVE T,OPASHL;$
SUB T,T1;$
F.LOCN (T1,LOP);
PLUNK;
;GO AND SET UP THE LEXEME;
GOTO LCGBI4;$
ENDD
FI
IF OP = "+" AND SYM = NEGATED IMM. INT. CONSTANT
T.OPER (ZPLUS);
TLNN SYM,$CONST+$TYPE-$I;$
TLNN SYM,$CT-$IMM;$
GOTO FALSE;$
F.LOCN (T,SYM);
ADD T,CONTAB;$
MOVN T1,1(T);$
JUMPL T1,FALSE;$
CAILE T1,-1;$
GOTO FALSE;$
THEN;..CHANGE "A + (- CONSTANT)" TO "A - CONSTANT";
BEGIN
;OP _ "-";
MOVE T,ZMINUS;$
MOVEM T,OP;$
;LEX(SYM) _ (IMMED.,SAME,SAME,-(VALUE(SYM)));
TLZ SYM,$AM;$
TLO SYM,$IMM;$
HRR SYM,T1;$
ENDD
FI
LCGBI3:
;..GENERATE THE INSTRUCTION TO PERFORM "OP";
;EMITCODE(OPN,LOP,SYM,LENGTH);
F.TRANK (T,SYM);
F.DISC (T1);
ADD T,T1;$
MOVE T,OPCODE(T);$
F.LOCN (T1,LOP);
IF LOP IS LONG REAL
T.LR (LOP);
THEN
BEGIN
HLRZ T1,T
LSH T1,-11
TRZ T1,700
CAIGE T1,22
MOVE T,KIOPS(T1)
; LENGTH _ 2;
HRLI T1,2
ENDD
ELSE
; LENGTH _ 1 (TYPE # LONG REAL)
HRLI T1,1;$
FI
EDIT(026); DONT DESTROY LENGTH CODE CAREFULLY SET UP IN L.H. OF T1
HRR T1,LOP ; [E026]
EMITCODE(SYM);
LCGBI4:
;LEX(SYM) _ (EXPR,SAME,SIMPLE,LOP);
TLZ SYM,$KIND!$STATUS!$AM;$
TLO SYM,$EXP!$SIM!$ACC;$
HRR SYM,LOP;$
CLOSE(SYM);
COMBLEX;
ENDD
;..ELSE BOTH OPDS WERE CONSTS AND A NEW CONST WAS GENERATED;
FI
ENDD
ELSE;..TYPE OF AN OPERAND IS NOT INTEGER, REAL, OR LONG REAL;
FAIL(68,FRIED,SYM,COMPLEX OPERAND FOR ARITH OPERATOR);
FI
ENDD
FI
FI
ENDD
ELSE;..AN OPERAND IS NOT ARITHMETIC;
FAIL(69,FRIED,SYM,NON-ARITH OPERAND FOR ARITH OPERATOR);
FI
ENDD
ELSE;..OP IS NOT ARITHMETIC;
IF OP = RELATIONAL
T.RELATION(T);
THEN;..WE HAVE A RELATION;
BEGIN
IF NOT CHECKARITH
CHECKARITH;
JUMPN T,FALSE;$
THEN;..OPERANDS NOW HAVE MATCHING ARITHMETIC TYPES;
BEGIN
IF NOT TREATCONST
TREATCONST;
JUMPN T,FALSE;$
THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
BEGIN
SETUP;
IF SYM<TYPE> = LONG REAL
T.LR (SYM);
THEN;..OPERANDS ARE BOTH LONG REAL;
BEGIN
;..SUBTRACT SYM FROM LOP;
;EMITCODE(LFSB,LOP,SYM,3);
MOVE T,OPLFSB;$
F.LOCN (T1,LOP);
HRLI T1,3;$
EMITCODE(SYM);
;..TEST RESULT VS. ZERO;
;PLUNK(OPN+1,LOP,ZERO);
F.DISC (T);
MOVE T,OPCODE+1(T);$
F.LOCN (T1,LOP);
PLUNK;
ENDD
ELSE;..OPERANDS ARE INTEGER OR REAL;
;..COMPARE THE OPERANDS;
IF SYM<AM> = IMMEDIATE
T.IMM (SYM);
THEN;..IMMEDIATE CONSTANT;
BEGIN
IF SYM<TYPE> = REAL
T.R (SYM);
THEN;..REAL IMMEDIATE CONSTANT;
BEGIN
;..SUBTRACT SYM FROM LOP;
;EMITCODE(FSBR,LOP,SYM,1);
MOVE T,OPFSBR;$
F.LOCN (T1,LOP);
HRLI T1,1;$
EMITCODE(SYM);
;..TEST RESULT VS. ZERO;
;PLUNK(OPN+1,LOP,0);
F.DISC (T);
MOVE T,OPCODE+1(T);$
F.LOCN (T1,LOP);
PLUNK;
ENDD
ELSE;..INTEGER IMMEDIATE CONSTANT;
;EMITCODE(OPN+1,LOP,SYM,1);
F.DISC (T);
MOVE T,OPCODE+1(T);$
F.LOCN (T1,LOP);
HRLI T1,1;$
EMITCODE(SYM);
FI
ENDD
ELSE;..NON-IMMEDIATE OPERAND;
;EMITCODE(OPN,LOP,SYM,1);
F.DISC (T);
MOVE T,OPCODE(T);$
F.LOCN (T1,LOP);
HRLI T1,1;$
EMITCODE(SYM);
FI
FI
LCGBI2:
;..RESULT MUST BE "TRUE" OR "FALSE". GENERATE IT;
;PLUNK(TDZA,LOP,LOP);
MOVE T,OPTDZA;$
F.LOCN (T1,LOP);
PLUNK (LOP);
;PLUNK(SETO,LOP,0);
MOVE T,OPSETO;$
F.LOCN (T1,LOP);
PLUNK;
;LEX(SYM) _ (EXPR,BOOLEAN,SIMPLE,LOP);
TLZ SYM,$KIND!$TYPE!$STATUS!$AM;$
TLO SYM,$EXP!$B!$SIM!$ACC;$
HRR SYM,LOP;$
CLOSE(SYM);
COMBLEX;
ENDD
;..ELSE BOTH OPDS WERE CONSTS AND A NEW CONST WAS GENERATED;
FI
ENDD
ELSE;..A RELATIONAL OPERAND IS NOT INTEGER OR REAL OR LONG REAL;
IF LOP<TYPE> = STRING AND SYM<TYPE> = STRING
TLNN LOP,$TYPE-$S;$
T.S (SYM);
THEN;..RELATION BETWEEN STRINGS;
BEGIN
;..PUT OPERANDS IN A0-1 AND A2-3 FOR THE COMPARE SR;
IF VALUE OF LOP IS NOT IN AC0
TN.AC0 (LOP);
THEN;..MUST PUT IT INTO AC0 AND AC1;
LOAD(LOP,A0);
FI
IF VALUE OF SYM IS NOT IN AC2
TLNE SYM,$AM-$ACC;$
GOTO TRUE;$
F.LOCN (T,SYM);
CAIN T,A2;$
GOTO FALSE;$
THEN;..MUST PUT IT INTO AC2 AND AC3;
;..FUDGE LAC=A4 TO MAKE LOAD WORK;
MOVEI T,A4;$
EXCH T,LAC;$
MOVEM T,LACSAV;$
LOAD(SYM,A2);
;..RESTORE LAC;
MOVE T,LACSAV;$
MOVEM T,LAC;$
FI
MERGEPORTIONS;
IF LOP NOT IN AC0
TN.AC0 (LOP);
THEN;..IT WAS MOVED DUE TO ACC CONFLICT. PUT IT BACK IN AC0;
MOVE T,OPMVLP;$
MOVEI T1,A0;$
GLOAD;
FI
;..GENERATE CALL ON COMPARE SUBROUTINE;
MOVE T,OPCMPR;$
PLUNKI;
;..RESULT IS -1, 0, OR +1 IN REGISTER AC0;
HRRI LOP,A0;$
;..GENERATE THE INST. TO TEST RESULT OF COMPAR VS. ZERO;
;EMITCODE(OPN+1,AC0,0,1);
F.DISC (T);
MOVE T,OPCODE+1(T);$
HRLZI T1,1;$
EMITCODE;
;..NOW GO GENERATE THE BOOLEAN RESULT;
GOTO LCGBI2;$
ENDD
ELSE;..TYPES CANNOT BE CORRECT;
FAIL(70,HARD,NSYM,NON-ARITH OPERAND FOR RELATIONAL OPERATOR);
FI
FI
ENDD
ELSE;..OP IS NOT ARITHMETIC OR RELATIONAL. IT MUST BE BOOLEAN;
BEGIN
IF LOP<TYPE> = BOOLEAN AND SYM<TYPE> = BOOLEAN
TLNN LOP,$TYPE-$B;$
T.B (SYM);
THEN;..OPERANDS ARE BOTH BOOLEAN;
BEGIN
IF NOT TREATCONST
TREATCONST;
JUMPN T,FALSE;$
THEN;..OPERANDS ARE NOT BOTH CONSTANTS;
BEGIN
SETUP;
;..GENERATE THE INSTRUCTION TO PERFORM "OP";
;EMITCODE(OPN,LOP,SYM,1);
F.DISC (T);
MOVE T,OPCODE(T);$
F.LOCN (T1,LOP);
HRLI T1,1;$
EMITCODE(SYM);
;LEX(SYM) _ (EXPR,SAME,SIMPLE,LOP);
TLZ SYM,$KIND!$STATUS!$AM;$
TLO SYM,$EXP!$SIM!$ACC;$
HRR SYM,LOP;$
CLOSE(SYM);
COMBLEX;
ENDD
;..ELSE BOTH OPDS WERE CONSTS AND A NEW CONST WAS GENERATED;
FI
ENDD
ELSE;..AN OPERAND IS NOT BOOLEAN;
FAIL(71,FRIED,SYM,NON-BOOLEAN OPERAND FOR BOOLEAN OPERATOR);
FI
ENDD
FI
FI
ENDD
FI
ENDD ; CGBIN
SUBTTL CODE GENERATION ROUTINES * CGUNA *
PROCEDURE CGUNA
;..PROCESS UNARY OPERATORS;
; GENERATE CODE TO PERFORM UNARY "+", "-", AND "NOT".
; ON ENTRY, OPERATION LEXEME IS IN OP;
; OPERAND IS IN SYM;
; RESULT IS A CLOSED PORTION WHOSE LEXEME IS IN SYM;
BEGIN
;..SET REV OFF;
MOVNI REV,SYM;$
IF OP = "NOT"
T.OPER (ZNOT);
THEN;..LOGICAL COMPLEMENT;
BEGIN
IF SYM<TYPE> NEQ BOOLEAN
TN.B (SYM);
THEN
FAIL(72,FRIED,SYM,NON-BOOLEAN OPERAND FOR "NOT");
ELSE;..OPERAND IS BOOLEAN;
BEGIN
IF NOT TRUNACONST
TRUNACONST;
JUMPN T,FALSE;$
THEN;..OPERAND IS NOT CONSTANT;
BEGIN
IF SYM IS AN EXPR OR A POINTER IN AN ACC
T.ACC (SYM);
THEN;..OPERAND OR ITS POINTER IS ALREADY IN AN AC;
BEGIN
REOPEN(SYM);
;..COMPLEMENT THE OPERAND;
;PLUNK(NOT,SYM,SYM);
MOVE T,OPNOT;$
F.LOCN (T1,SYM);
PLUNK (SYM);
;LEX(SYM) _ (EXPR,SAME,SIMPLE,ACC);
TLZ SYM,$KIND!$STATUS!$AM;$
TLO SYM,$EXP!$SIM!$ACC;$
CLOSE(SYM);
ENDD
ELSE;..OPERAND IS NOT IN AN AC. LOAD ITS COMPLEMENT;
LOADC(SYM,ANYAC);
FI
ENDD
;..ELSE OPERAND WAS CONSTANT AND A NEW CONST WAS GENERATED;
FI
ENDD
FI
ENDD
ELSE;..OP NEQ "NOT". IT MUST BE "+" OR "-";
BEGIN
IF SYM<TYPE> NEQ ARITH
TN.ARITH(SYM);
THEN
FAIL(73,FRIED,SYM,NON-ARITH OPERAND FOR UNARY "+" OR "-");
ELSE;..OPERAND IS ARITHMETIC;
BEGIN
IF OP = UNARY "-"
T.OPER (ZUMINUS);
THEN;..OP = NEGATE;
BEGIN
IF NOT TRUNACONST
TRUNACONST;
JUMPN T,FALSE;$
THEN;..OPERAND IS NOT CONSTANT;
BEGIN
IF SYM IS A LONG REAL POINTER IN AN ACC
TLNN SYM,$AMAC+$TYPE-$LR;$
TLNN SYM,$INDC;$
GOTO FALSE;$
THEN;..VALUE OF OPERAND NOT IN ACC. LOAD ITS NEGATIVE;
GOTO LCGUN1;$
FI
IF SYM IS AN EXPR IN ACC
T.ACC (SYM);
THEN;..OPERAND OR ITS POINTER IS ALREADY IN AN ACC;
BEGIN
REOPEN(SYM);
;..NEGATE THE OPERAND;
;PLUNK(MOVN,SYM,SYM) OR PLUNK(DFN,SYM,SYM+1);
F.TRANK (T,SYM);
MOVE T,OPUMIN(T);
F.LOCN (T1,SYM);
MOVE T2,SYM;$
TLZ T2,777777-$AM;$
ADD T,T2;$
PLUNK;
;LEX(SYM) _ (EXPR,SAME,SIMPLE,ACC);
TLZ SYM,$KIND!$STATUS!$AM;$
TLO SYM,$EXP!$SIM!$ACC;$
CLOSE(SYM);
ENDD
ELSE;..OPERAND IS NOT IN AN AC. LOAD ITS NEGATIVE;
LCGUN1:
LOADN(SYM,ANYAC);
FI
ENDD
;..ELSE OPD WAS CONST AND NEGATED CONST WAS GENERATED;
FI
ENDD
;..ELSE OPERATION IS UNARY "+". NO ACTION NEEDED;
FI
ENDD
FI
ENDD
FI
ENDD ; CGUNA
SUBTTL CODE GENERATION ROUTINES * TREATCONST *
PROCEDURE TREATCONST
;..PERFORM BINARY OP AT COMPILE-TIME WHEN BOTH OPDS ARE CONSTANTS.
; IF AT LEAST ONE OPERAND IS NON-CONSTANT,
; FLAG (T) IS SET TO "FALSE" (ALL ZEROS);
; IF BOTH ARE CONSTANT, NEW CONSTANT IS PRODUCED
; AND FLAG IS SET TO "TRUE" (ALL ONES).
; ON ENTRY, OPERAND LEXEMES ARE IN LOP AND SYM,
; OPERATION LEXEME IS IN OP.
; IF OPERATION = "^", NEW CONSTANT IS PRODUCED ONLY IF
; EXPONENT IS AN INTEGER.
; RESULT LEXEME GOES TO SYM.
; NEW CONSTANT IS PUT INTO LEXEME IF IT IS IMMEDIATE,
; OTHERWISE IT IS PUT INTO THE CONSTANT TABLE.
BEGIN
OWN TA0,DPFLAG; TA0 = TEMPORARY TO HOLD A0 (GBREG) ; [E044]
;DPFLAG SET IF EXPLICIT DOUBLE PRECISION; [E044]
IF LOP = CONSTANT AND SYM = CONSTANT
TLNN LOP,$CONST;$
T.CONST (SYM);
THEN;..WE MUST PRODUCE A NEW CONSTANT;
BEGIN
;..MAKE SURE OVERFLOW FLAGS ARE OFF;
JFCL 11,LTC2;$
LTC2:
IF OP NEQ "^"
TN.OPER (ZPOW);
THEN;..OP IS NOT POWER AND TYPES OF LOP AND SYM MATCH;
BEGIN
IF SYM<TYPE> NEQ LONG REAL
TN.LR (SYM);
THEN;..TYPES OF LOP AND SYM ARE NOT LONG REAL;
BEGIN
;T2 _ LOP<LOCN>;
F.LOCN (T2,LOP);
;..PUT VALUE OF LOP INTO T3;
IF LOP = IMMEDIATE
T.IMM (LOP);
THEN;..IMMEDIATE LEFT OPERAND;
IF SYM<TYPE> = REAL
T