!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ! !COPYRIGHT (C) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754 !FILENAME: H2ARIT.BLI !DATE: 10 JANUARY 74 MGM/FLD/KR ! REVISION HISTORY : ! 12-30-77 ROUTINE GPTR IS MODIFIED TO CHECK P,S,X FIELDS ! IN OR OUTOFF RANGE. IT GIVES WARNING IF THE VALUES ARE ! OUTOFF RANGE AND LSS ZERO. ! ! 10-19-77 ROUTINE GMOD IS MODIFIED TO FIX A BUG RELATED TO MOD FUNCTION. ! MODFLAG IS A FLAG TO IDENTIFY THIS AND IS RESET IN DUMPREG. ! ! 5-9-77 COMPILER LOST TRACK OF REGISTERS WHEN ANDCAM OR IORM ! IS ONE OF THE INSTRUCTIONS.IT USES OLD VALUE. ! ROUTINE GSTO IS MODIFIED TO TAKE CARE OF THE PROBLEM. ! %3.41% GLOBAL BIND H2ARV=5; !MODULE VERSION NUMBER ! GENERAL DOCUMENTATION FOR ARITH.BLI ! ! THIS MODULE CONCERNS ITSELF WITH GENERATING CODE FOR ! THE BINARY AND UNARY OPERATORS. ONE CAN DIVIDE THE ACTIVITIES OF EACH ! OF THE OPERATOR ROUTINES INTO THREE CASES: ! (1) CONSTANT ARITHMETIC ! THE ARITHMETIC OPERATORS (AND LOGICAL TOO) ! WHEN PASSED COMPILE-TIME LITERAL LEXEMES DO THE ! OPERATION AND RETURN THE LITERAL LEXEME OF THE ! RESULT. ! ! (2) DELAYING (AND SPECIAL CASES) ! THE PREMIER EXAMPLE OF DELAYING IS EXEMPLIFIED BY ! THE ADD-SUBTRACT ROUTINE (GAS). HERE THE OPERATOR ! ROUTINES ALWAYS ATTEMPT TO AVOID PRODUCING CODE IF THEY ! CAN INDICATE THE RESULT OF THEIR EXECUTION IN THE LEXEME. ! E.G. GNEG AND GNOT SIMPLY SET THE NEG OR NOT BITS ! IN THE LEXEME WHEN POSSIBLE ! ! (3) ACTUALLY PRODUCE CODE ! ONCE THE OPERATOR DECIDES TO ACTUALLY PRODUCE ! CODE IT THEN INSPECTS ITS OPERANDS TO SEE IF EITHER ! FURNISHES AN ACCUMULATOR WHICH CAN BE USED TO PERFORM ! THE OPERATION. EXTERNAL MODFLAG; FORWARD EXCHANGE,FLOATB,GFADR; FORWARD GADD,GAND,GANL,GAS,GAT,GBREL,GDIV,GDIVMOD,GDOT,GEQL,GEQV; FORWARD GGEQ,GGTR,GLEQ,GLOG,GLSH,GLSS,GMOD,GMUL,GNEG,GNEQ,GNOT,GOR; FORWARD GPTR,GREL,GSUB,GXOR,LOG2,PASH,SMLFLP,SMLFLV; GLOBAL ROUTINE GPTR(Y,P,S,X,I)= !CALLED FOR EXPRESSIONS OF THE FORM Y. ! A) EVALUATES P,S,I,X IF LITERAL ! B) ATTEMPTS TO DELAY CODE BY BUILDING A LEXEME. SEE IF STATEMENT ! BEGINNING AT %[B]% BELOW. ! C) FAILING THIS IT WILL GENERATE CODE TO BUILD THE POINTER IN A ! REGISTER. BEGIN LOCAL R, ! ADDRESS OF REG. USED TO CALC POINTER (IF NEC.) P2, ! VALUE OF LITERAL P S2, ! VALUE OF LITERAL S X2, ! VALUE OF LITERAL X I2, ! VALUE OF LITERAL I SUMVAL; ! P2+S2+X2+I2 LOCAL TEMP; ! 12-30-77 TEMPORARY VARIABLE ! CHECK FOR 0>P>36 , 0>S>36 , 0>X>15 , 0>I>1 MACRO VALVALID(VAL1,VAL2)= ((VAL1 LSS 0) OR ((VAL1 AND #777777) GTR VAL2)) $; REGISTER R1; MACRO P1=R1<0,1>$, ! LITERAL P S1=R1<1,1>$, ! LITERAL S X1=R1<2,1>$, ! LITERAL X I1=R1<3,1>$; ! LITERAL I PCIVR(.Y,0); IF (.Y AND (NEGM OR NOTM OR COPM)) NEQ 0 THEN RETURN GPTR(GLAR(.Y),.P,.S,.X,.I); %3.10% R1_0; IF PTRTYPP(.Y) THEN Y_MLEXFRPTRTYP(.Y); PCIVR(.P,.S);PCIVR(.X,.I); P2_IF LITP(.P) THEN (P1_1; TEMP=LITV(.P); IF VALVALID(.TEMP,36) THEN WARNEM(.NSYM,#767); %12-30-77% .TEMP AND #77 ); %12-30-77% S2_IF LITP(.S) THEN (S1_1; % 12-30-77 THE FOLLOWING LINES ARE ADDED % TEMP=LITV(.S); IF VALVALID(.TEMP,36) THEN WARNEM(.NSYM,#767); .TEMP AND #77 ); X2_IF LITP(.X) THEN (X1_1; % 12-30-77 THE FOLLOWING LINES ARE ADDED % TEMP=LITV(.X); IF VALVALID(.TEMP,15) THEN WARNEM(.NSYM,#767); .TEMP AND #17 ); I2_IF LITP(.I) THEN (I1_1; % THE FOLLOWING LINES ARE ADDED ON 12-30-77 % TEMP=LITV(.I); IF VALVALID(.TEMP,1) THEN WARNEM(.NSYM,#767); .TEMP AND 1 ); BEGIN BIND DUMMY=0; %[B]% IF .P1 THEN IF .S1 THEN IF .X1 THEN IF .I1 THEN BEGIN !V2G- IF ALL PARAMETERS ARE CONSTANTS, WE SIMPLY GENERATE A LITERAL IF LITP(.Y) THEN !V2G- RETURN !V2G- LITLEXEME((LITV(.Y) AND RIGHTM) OR .P2^30 OR .S2^24 OR .I2^22 OR .X2^18); !V2G- IF .I2 NEQ 0 OR .X2 NEQ 0 THEN BEGIN IF .Y NEQ 0 THEN EXITBLOCK; IF .Y THEN IF STACKVARP(.Y) THEN EXITBLOCK; RETURN MPTRTYP(.P2^12 OR .S2^6 OR .I2^4 OR .X2,.Y) END; IF .Y NEQ 0 THEN IF (.P2^6 OR .S2) EQL 0 THEN EXITBLOCK; RETURN LEXNPSD(.Y,.P2,.S2,0) END; END; Y_GMA(.Y OR DOTM); SUMVAL_.P2+.S2+.X2+.I2; IF .Y EQL 0 THEN IF .SUMVAL EQL 0 THEN CODE(HRRZI,R_ACQUIRE(-1,1),.Y,1) ELSE CODE(MOVE,R_ACQUIRE(-1,1),COPTR(.P2,.S2,.Y OR .I2^22 OR .X2^18),1) ELSE BEGIN IF USABLEINDEXREG(.Y) AND .SUMVAL NEQ 0 THEN R_.Y ELSE CODE(HRRZI,R_ACQUIRE(-1,1),.Y,1); IF .SUMVAL NEQ 0 THEN CODE(HRLI,.R,.P2^12 OR .S2^6 OR .I2^4 OR .X2,1) END; IF NOT .P1 THEN CODEDPB(.P,30,6,.R); IF NOT .S1 THEN CODEDPB(.S,24,6,.R); IF NOT .I1 THEN CODEDPB(.I,22,1,.R); IF NOT .X1 THEN CODEDPB(.X,18,4,.R); LEXRA(.R) END; GLOBAL ROUTINE GDOT(Y)= ! CALLED TO EXECUTE THE DOT OPERATOR BEGIN LOCAL R; PCIVR(.Y,0); IF .Y NEQ 0 THEN RETURN (SESTOG_.SESTOG OR 2;GDOT(GLTR(.Y))); IF .Y THEN BEGIN CODE(LDB,R_ACQUIRE(-1,1),MEMORYA(.Y),0); SESTOG_.SESTOG OR 2; RETURN LEXRA(.R) END; IF .Y EQL 36 THEN RETURN GAT(.Y AND NOT(POSNSIZEM)); IF LITP(.Y) THEN BEGIN REGISTER P,S,I,X; Y_LITV(.Y); P_.Y<30,6>; S_.Y<24,6>; I_.Y<22,1>; X_.Y<18,4>; Y_.Y AND IXYM; IF .I THEN BEGIN SESTOG_.SESTOG OR 2; R_ACQUIRE(-1,1); IF (.P^6 OR .S) EQL 36 THEN CODE(MOVE,.R,.Y,1) ELSE CODE(LDB,.R,COPTR(.P,.S,.Y),1); RETURN LEXRA(.R) END; IF .X NEQ 0 THEN RETURN LEXNPSD(LITLEXEME(.Y AND RIGHTM) OR LEXRA(.X), .P,.S,1); !V2G- WE CAN'T USE REG 0 IN THE REG FIELD OF A LEXEME BECAUSE WE !V2G- CAN'T DELAY GETTING ITS CONTENTS BECAUSE IT CAN'T BE USED !V2G- LATER AS AN INDEX REGISTER. THEREFORE, WE TREAT !V2G- 0 AS A REGULAR MACHINE ADDRESS, NOT A GENERAL PURPOSE REGISTER. IF .Y LEQ 15 THEN IF .Y GTR 0 THEN IF .P EQL 0 THEN IF .S EQL 36 THEN !V2G- RETURN LEXRA(.Y); RETURN LEXNPSD(LITLEXEME(.Y),.P,.S,1) END; IF PTRTYPP(.Y) THEN BEGIN REGISTER ADDRESS,OPCODE,RGHTHALF,PS; IF NORELOCPTRYPP(.Y) THEN RETURN GDOT(LITLEXEME(VALPTRTYP(.Y))); PS_PSPTRTYP(.Y); IF NOT INDPTRTYPP(.Y) THEN IF .PS NEQ 0 THEN RETURN MLEXFRPTRTYP(.Y) OR DOTM; ADDRESS_ IF .PS EQL 36 THEN (OPCODE_MOVE; MADDRFRPTRTYP(.Y) OR INDIRM) ELSE IF (RGHTHALF_.PS EQL 18) OR .PS EQL #2222 THEN (OPCODE_CASE .RGHTHALF OF SET HLRZ; HRRZ TES; MADDRFRPTRTYP(.Y) OR INDIRM) ELSE (OPCODE_LDB; MCOPTRFRPTRTYP(.Y)); CODE(.OPCODE,R_ACQUIRE(-1,1),.ADDRESS,1); SESTOG_.SESTOG OR 2; RETURN LEXRA(.R) END; .Y OR DOTM END; GLOBAL ROUTINE GAT(X)= ! CALLED TO EXECUTE THE @ OPERATOR BEGIN PCIVR(.X,0); IF .X NEQ 0 THEN RETURN (SESTOG_.SESTOG OR 2;GAT(GLTR(.X))); IF .X THEN RETURN (SESTOG_.SESTOG OR 2;GAT(GLAR(.X))); IF LITP(.X) THEN BEGIN IF (X_LITV(.X) AND RIGHTM) LEQ 15 THEN IF .X GTR 0 THEN !V2G- SEE NOTE FOR V2G IN GDOT ABOVE. RETURN LEXRA(.X); RETURN LEXNPSD(LITLEXEME(.X),0,36,1) END; IF PTRTYPP(.X) THEN BEGIN IF NORELOCPTRTYPP(.X) THEN RETURN GAT(LITLEXEME(VALPTRTYP(.X) AND RIGHTM)); RETURN LEXNPSD(LSSTEFPTRTYP(.X),0,36,1) END; LEXNPSD(.X,0,36,1) END; GLOBAL ROUTINE GSLSH(Y)= ! CALLED TO EXECUTE THE \ OPERATOR BEGIN LOCAL REG,ADDRESS,V; REGISTER YSAV; YSAV_.Y; Y_.Y AND NOT (POSNSIZEM); IF NOT PTRTYPP(.YSAV) THEN IF ZERONAMP(.Y) THEN RETURN .Y OR (DOTM OR ZERO36); PCIVR(.Y,0); IF LITP(.Y) THEN BEGIN IF (V_LITV(.Y) AND IXYM) LEQ #17777777 THEN RETURN GDOT(LITLEXEME(36^24 OR .V)); ADDRESS_.V; END ELSE IF REGP(.Y) THEN ADDRESS_REGAR(.Y) ELSE IF PTRTYPP(.YSAV) THEN BEGIN IF NORELOCPTRTYPP(.Y) THEN RETURN GSLSH(LITLEXEME(VALPTRTYP(.Y) AND IXYM)); IF NOT INDPTRTYPP(.Y) THEN RETURN LEXNPSD(MLEXFRPTRTYP(.Y),0,36,1); ADDRESS_MADDRFRPTRTYP(.Y) END ELSE IF .Y EQL 0 OR (.Y AND (.YSAV EQL 36)) THEN ADDRESS_MEMORYA(.YSAV OR DOTM) ELSE RETURN BEGIN Y_ IF .YSAV THEN GLAR(.YSAV) ELSE .YSAV; IF REGP(.Y) THEN GSLSH(.Y) ELSE GSLSH(LEXRA(GPA(.Y AND NOT(POSNSIZEM)) AND RIGHTM)) END; SESTOG_.SESTOG OR 2; CODE(MOVE,REG_ACQUIRE(-1,1),.ADDRESS OR INDIRM,0); LEXRA(.REG) END; GLOBAL ROUTINE GSTO(X,Y)= %GENERATE CODE FOR X_Y. BECAUSE OF ITS SIZE THIS ROUTINE IS COMMENTED INLINE% BEGIN PCIVR(.X,.Y); IF .X NEQ 0 THEN RETURN GSTO(GLTR(.X),.Y); BEGIN %4.03% EXTERNAL TRYVREG; LOCAL VALUE, ! VALUE OF LITERAL Y XVALUE, ! VALUE OF LITERAL X OLDY, ! COPY OF INPUT VALUE OF Y NEGNOTMASK, ! MASK TO OR INTO LEXEME TO CODEN AND TO BE RET'D OPCODE, ! INST. GENERATED FOR STORE REG, ! REG USED IN STORE INST. ADDRESS,! ADDRESS USED IN STORE INST. RETLEX, ! LEXEME RETURNED REP. VALUE OF STORE PSFIELD,! .X INDIRMASK, ! POTENTIAL IND. BIT FROM PTRTYP CHOICE; ! TEMP TO HOLD INDEX INTO TABLE OF HALFWD INSTRS. REGISTER R; MACRO LITY=R<0,1>$, ! LITERAL Y LITX=R<1,1>$, ! LITERAL X NEGBIT=R<2,1>$, ! .Y NOTBIT=R<3,1>$, ! .Y RTUPDATE=R<4,1>$, ! BOOLEAN: SETCAB CLOBBERED REG RGHTHALF=R<5,1>$, ! BOOLEAN: RIGHT HALF OF HALFWD YLHALF=R<6,1>$; ! BOOLEAN: L.H. OF Y TO HALFWD REG IF (LITY_LITP(.Y)) THEN VALUE_LITV(.Y); OLDY_.Y; NEGBIT_.Y; NOTBIT_.Y; Y_.Y AND NOT (NEGM OR NOTM); NEGNOTMASK_0; RTUPDATE_0; INDIRMASK_0; IF PTRTYPP(.X) THEN BEGIN LOCAL PTR; PTR_VALPTRTYP(.X); IF .PTR<24,12> NEQ 36 THEN IF .PTR<24,12> NEQ 18 THEN IF .PTR<24,12> NEQ #2222 THEN IF .PTR<22,1> OR .PTR<24,12> EQL 0 THEN EXITBLOCK X_0; X_MLEXFRPTRTYP(.X); INDIRMASK_.PTR AND INDIRM END; OPCODE_ IF .LITY THEN IF .VALUE EQL 0 THEN SETZM ELSE IF .VALUE EQL -1 THEN SETOM ELSE MOVEM ELSE IF .NEGBIT THEN (NEGNOTMASK_NEGM; MOVNM) ELSE IF .NOTBIT THEN IF DCRP(.Y) THEN (NEGNOTMASK_NOTM; SETCAM) ELSE (RTUPDATE_1;SETCAB) ELSE MOVEM; RETLEX_.Y; !!! HANDLES ".(EXP)_" AND ".NAME_" IF .X THEN BEGIN IF (.X AND (POSNSIZEM)) NEQ ZERO36 THEN RETURN GSTO(GLTR(.X),.OLDY); CODE(DPB,REGAK(RETLEX_GLAR(.OLDY)),GMA(.X),5); RETURN(.RETLEX) END; IF (LITX_LITP(.X AND (LSSTEM OR RTEM))) THEN XVALUE_LITV(.X); PSFIELD_IF .LITX AND (.X EQL 0) THEN .XVALUE<24,12> ELSE .X; !!! HANDLES CASE WHERE LEFT SIDE IS REGISTER OR SUBFIELD OF REG IF (IF .LITX THEN (.XVALUE AND IXYM) LEQ 15) AND .PSFIELD NEQ 0 AND .INDIRMASK EQL 0 THEN BEGIN REG_.XVALUE; SETFUNBIT(.X); SESTOG_.SESTOG OR 1; !!! IF IT IS FULLWORD STORE THEN GLR(GLPR) WILL PROVIDE IF .PSFIELD EQL 0 OR .PSFIELD EQL 36 THEN RETURN (RETLEX_GLR(.OLDY,2,.REG); RMREFREG(.REG); .RETLEX); !!! HANDLE HALF WORD LOAD OF REGISTER IF (RGHTHALF_.PSFIELD EQL 18) OR .PSFIELD EQL #2222 THEN BEGIN OPCODE_ IF .LITY THEN BEGIN ADDRESS_.VALUE; IF .RGHTHALF THEN HRRI ELSE HRLI END ELSE IF ZERONAMP(.Y) THEN BEGIN ADDRESS_GMA(.Y OR DOTM); IF .RGHTHALF THEN HRRI ELSE HRLI END ELSE BEGIN YLHALF_0; ADDRESS_ !%3.16% IF READY(.OLDY) THEN !%3.16% GMA(RETLEX_.OLDY) ELSE IF (.OLDY EQL 18 OR (YLHALF_.OLDY EQL #2222)) AND READY((.OLDY AND NOT POSNSIZEM) OR ZERO36) THEN GMA(RETLEX_.OLDY) ELSE REGAK(RETLEX_GLTR(.OLDY)); CASE 2*.RGHTHALF+.YLHALF OF SET HRL; HLL; HRR; HLR TES END; CODEN(.OPCODE,.REG,.ADDRESS,2, LEXNPSD(.REG,.PSFIELD<6,6>,.PSFIELD<0,6>,1)); RETURN(.RETLEX) END; !!! HANDLES STORE OF CONSTANT INTO SUBF. USING TRO, TRZ, ETC IF .LITY THEN IF .PSFIELD<6,6> LEQ 35 THEN IF (.PSFIELD<6,6> + .PSFIELD<0,6>) LEQ 36 THEN BEGIN LOCAL BITMASK[2],PSMASK; ! BITMASK[0]=MASK OF BITS TO BE ZEROED ! BITMASK[1]=MASKOF BITS TO BE SET ("ONED") ! PSMASK=MASK OF SUBFIELD PSMASK_((1^.PSFIELD<0,6>)-1)^.PSFIELD<6,6>; BITMASK[1]_(.VALUE^.PSFIELD<6,6>) AND .PSMASK; BITMASK[0]_(NOT .BITMASK[1]) AND .PSMASK; INCR I FROM 0 TO 1 DO BEGIN OPCODE_ IF .BITMASK[.I] NEQ 0 THEN IF .BITMASK[.I] EQL 0 THEN BEGIN ADDRESS_.BITMASK[.I]; CASE .I OF SET TRZ;TRO TES END ELSE IF .BITMASK[.I] EQL 0 THEN BEGIN ADDRESS_.BITMASK[.I]; CASE .I OF SET TLZ;TLO TES END ELSE BEGIN ADDRESS_LITA(LITLEXEME(.BITMASK[.I])); CASE .I OF SET TDZ; TDO TES END ELSE EXITCOMP; CODEN(.OPCODE,.REG,.ADDRESS,2, LEXNPSD(.REG,.PSFIELD<6,6>,.PSFIELD<0,6>,1)) END; RETURN(.RETLEX) END; !!! HANDLES STORE OF NON-CONSTANT INTO SUBFIELD CODEN(DPB,REGAK(RETLEX_GLAR(.OLDY)),GPA(X_.X OR DOTM),2,.X); RETURN(.RETLEX) END; !!! FULLWORD STORE TO MEMORY IF .PSFIELD EQL 36 THEN BEGIN ADDRESS_(IF .LITX THEN .XVALUE AND IXYM ELSE GMA(X_.X OR DOTM)) OR .INDIRMASK; REG_IF .LITY AND (.OPCODE NEQ MOVEM) THEN 0 ELSE REGAK(RETLEX_GLAR(.Y)); IF .RTUPDATE THEN IF .ART[.REG] THEN CLEARONE(RT[.ART[.REG]]); CODEN(.OPCODE,.REG,.ADDRESS,2, (X_36; .X OR .NEGNOTMASK)); RETURN(.RETLEX OR .NEGNOTMASK) END; !!! HALFWORD STORE TO MEMORY IF (RGHTHALF_.PSFIELD EQL 18) OR .PSFIELD EQL #2222 THEN BEGIN OPCODE_ CASE CHOICE_ (IF .LITY THEN 4-2*(.VALUE EQL 0)-4*(.VALUE EQL 1^18-1) ELSE 4) +.RGHTHALF OF SET HRROS;HLLOS;HRRZS;HLLZS;HRLM;HRRM TES; REG_IF .CHOICE LEQ 3 THEN 0 ELSE REGAK(RETLEX_GLAR(.OLDY)); ADDRESS_(IF .LITX THEN .XVALUE AND IXYM ELSE GMA(X_.X OR DOTM)) OR .INDIRMASK; CODEN(.OPCODE,.REG,.ADDRESS,2,.X); RETURN(.RETLEX) END; BEGIN LOCAL PTPOS,PTSIZ,PTMASK,PTVAL; LABEL STOPT; PSFIELD_.X; PTPOS_.PSFIELD^(-6); PTSIZ_.PSFIELD AND #77; IF .LITY AND (.PTSIZ LEQ 18) AND (.PTPOS LEQ 35) AND (.PTPOS+.PTSIZ LEQ 36) THEN STOPT: BEGIN IF .PTPOS LSS 18 AND .PTPOS+.PTSIZ GTR 18 THEN LEAVE STOPT ELSE BEGIN PTMASK_1^.PTSIZ-1; IF ((.PTMASK AND .VALUE) NEQ .PTMASK AND (.PTMASK AND .VALUE) NEQ 0) OR .PTSIZ EQL 0 THEN LEAVE STOPT; PTVAL_.VALUE; VALUE_.PTMASK^.PTPOS; IF TRYVREG() THEN REG_.VREG ELSE IF (REG_.ART[18]) GEQ 16 THEN IF (REG_.ART[19]) GEQ 17 THEN LEAVE STOPT; %4.12% %4.12% %(***** CHECK TO MAKE SURE THE REG ISNT AN OPTIMIZED SUBEXPRESSION *****)% %4.12% %4.12% INCR I FROM RT[5] TO RT[31] DO %4.12% IF .(.I)<32,4> EQL .REG THEN LEAVE STOPT; %4.12% IF .VALUE EQL 0 THEN (OPCODE_SETZ; ADDRESS_0) ELSE IF .VALUE EQL -1 THEN (OPCODE_SETO; ADDRESS_0) ELSE IF SMNEGLITVP(.VALUE) THEN (OPCODE_MOVNI; ADDRESS_-.VALUE) ELSE IF SMPOSLITVP(.VALUE) THEN (OPCODE_MOVEI; ADDRESS_.VALUE) ELSE IF .VALUE EQL 0 THEN (OPCODE_HRLZI;ADDRESS_.VALUE) ELSE IF .VALUE EQL 1^18-1 THEN (OPCODE_HRLOI; ADDRESS_.VALUE) ELSE (OPCODE_MOVE; ADDRESS_LITA(.X)); CODEN(.OPCODE,.REG,.ADDRESS,0,0); OPCODE_IF (.PTMASK AND .PTVAL) EQL 0 THEN ANDCAM ELSE IORM; ADDRESS_(IF .LITX THEN .XVALUE AND IXYM ELSE GMA(X_.X OR DOTM)) OR .INDIRMASK; CODEN(.OPCODE,.REG,.ADDRESS,2,.X); %4-7-77% RETURN .OLDY END; END; END; !!! PARTIAL WORD STORE TO MEMORY CODEN(DPB,REGAK(RETLEX_GLAR(.OLDY)),GPA(X_.X OR DOTM),2,.X); .RETLEX END END; GLOBAL ROUTINE CODEDPB(L,P,S,Y)= ! (CODE DEPOSIT BYTE) ! GENERATE CODE TO DEPOSIT THE ! EXPRESSION L INTO Y WHERE P,S ARE CONSTANT. CODE(DPB,RAGLAR(.L),COPTR(.P,.S,.Y),0); ROUTINE GARLS(X,Y,F) = !GENERATE CODE FOR ASH WHEN .F EQL 0 !GENERATE CODE FOR ROT WHEN .F EQL 1 !GENERATE CODE FOR LSH WHEN .F EQL 2 OR !GENERATE CODE FOR X^Y ! SPECIAL CASES FOR X^Y: ! Y=0 --> X ! Y>35,Y<-35 --> 0 ! Y=18,Y=-18 --> HALF-WORD INST. ! BEGIN LOCAL OPCODE,ADDRESS; REGISTER L,V; PCIVR(.X,.Y); IF LITP(.Y) THEN BEGIN V_LITV(.Y); IF LITP(.X) THEN RETURN LITLEXEME( BEGIN MACHOP ASH = #240, ROT = #241, LSH = #242; L_LITV(.X); CASE .F OF SET ASH(L,.V); ROT(L,.V); LSH(L,.V) TES END ); IF .V EQL 0 THEN RETURN .X; IF .F EQL 2 THEN BEGIN IF .V GEQ 36 OR .V LEQ -36 THEN RETURN (DULEX(.X); ZERO); IF (L_.V EQL 18) OR .V EQL -18 THEN BEGIN OPCODE_CASE .L OF SET HLRZ; HRLZ TES; IF ZERONAMP(.X) THEN (OPCODE_.OPCODE+1; ADDRESS_GMA(.X OR DOTM)) ELSE ADDRESS_MEMORYA(.X); CODE(.OPCODE,Y_ACQUIRE(-1,1),.ADDRESS,1); RETURN LEXRA(.Y) END; END; CODE(ASH+.F,REGAK(X_GLTR(.X)),.V AND RIGHTM,1); RETURN .X END; CODE(ASH+.F,REGAK(X_GLTR(.X)),MADRIR(GLAR(.Y),0),1); .X END; GLOBAL ROUTINE GASH(X,Y) = GARLS(.X,.Y,0); GLOBAL ROUTINE GROT(X,Y) = GARLS(.X,.Y,1); GLOBAL ROUTINE GLSH(X,Y) = GARLS(.X,.Y,2); ROUTINE SHOULDEXCH(X,Y)= ! MAKES DECISION WHETHER THE LEXEMES X AND Y SHOULD BE INTERCHANGED BEGIN IF .RT[.X] EQL .OPTTOREGADDR THEN RETURN 0; IF .RT[.Y] EQL .OPTTOREGADDR THEN RETURN 1; IF .RT[.X] EQL .VREG THEN RETURN 0; .RT[.Y] EQL .VREG END; GLOBAL ROUTINE GMUL(X,Y)= !GENERATE CODE FOR EXPRESSION X*Y ! SPECIAL CASES: ! Y=0 --> 0 ! Y=1 --> X ! Y=-1 --> -X ! Y=POWER OF 2 --> ASH INST. BEGIN LOCAL TEMPX,TEMPY; PCIVR(.X,.Y); IF LITP(.X) THEN RETURN IF LITP(.Y) THEN LITLEXEME(LITV(.X)*LITV(.Y)) ELSE GMUL(.Y,.X); IF LITP(.Y) THEN BEGIN LOCAL L,V; IF .Y EQL ZERO THEN RETURN (DULEX(.X);ZERO); V_LITV(.Y); IF .Y EQL ONE THEN RETURN .X; IF .V EQL -1 THEN RETURN GNEG(.X); IF (L_LOG2(.V)) NEQ 0 THEN !Y IS A POWER OF 2 BEGIN IF .L LSS 0 THEN (X_GNEG(.X);L_-.L); RETURN PASH(.X,.L) END; IF SMNEGLITVP(.V) THEN RETURN GMUL(GNEG(.X),LITLEXEME(-.V)); IF SMPOSLITVP(.V) THEN RETURN (CODE(IMULI,REGAK(X_GOLTR(.X)),.V,1);.X); RETURN (CODE(IMUL,REGAK(X_GOLTR(.X)),LITA(.Y),1);.X) END; IF .X XOR .Y THEN RETURN GNEG(GMUL(.X AND NOT NEGM,.Y AND NOT NEGM)); IF ZERONAMP(.X) THEN RETURN (CODE(IMULI,REGAK(Y_GLTR(.Y)),GMA(.X OR DOTM),1);.Y); IF ZERONAMP(.Y) THEN RETURN GMUL(.Y,.X); X_.X AND NOT NEGM; Y_.Y AND NOT NEGM; REGSEARCH(X,Y); IF (TEMPX_TVRP(.X)) AND (TEMPY_TVRP(.Y)) THEN IF SHOULDEXCH(.Y,.Y) THEN EXCHANGE(X,Y); IF .TEMPX THEN RETURN (CODE(IMUL,REGAK(X_GLTR(.X)),MEMORYA(.Y),1);.X); IF .TEMPY THEN RETURN GMUL(.Y,.X); IF TVMP(.X) THEN BEGIN Y_GLAR(.Y); IF DCRP(.Y) THEN RETURN (CODE(IMULM,REGAK(.Y),X_GLTM(.X),0);.X); RETURN GMUL(.Y,.X) END; IF TVMP(.Y) THEN RETURN GMUL(.Y,.X); IF READY(.X) THEN RETURN GMUL(GLTR(.Y),.X); GMUL(GLTR(.X),.Y) END; GLOBAL ROUTINE LOG2(X)= %X MUST BE A CONSTANT. LOG2(X)=0 IF X IS NOT A POWER OF 2. OTHERWISE LOG2(X)=SGN(X)*CLOG2(ABS(X)).% BEGIN LOCAL LOG; IF (-.X AND .X) EQL ABS(.X) THEN BEGIN LOG_IF (.X AND NOT 1^35) NEQ 0 THEN 35-FIRSTONE(ABS(.X)); IF .X LSS 0 THEN LOG_-.LOG END ELSE LOG_0; .LOG END; ROUTINE PASH(X,Y)= %GENERATE CODE FOR ARITHMETIC SHIFT. Y IS AN 18 BIT CONSTANT% BEGIN CODE(ASH,REGAK(X_GLTR(.X)),.Y,1); .X END; ROUTINE GDIVMOD(X,Y,F)= !GENERATE CODE FOR .X&.Y WHERE & IS CASE .F OF SET /;MOD TES ! SPECIAL CASES: ! Y=0 --> ERROR ! Y=1 --> X,0 ! Y=-1 --> -X,0 ! Y= POWER OF 2 ASH INST., CAN'T OPTOMIZE SINCE MOD HAS SIGN OF DIVIDEND ! ASH INST IS NOT USED BECAUSE FOR X LSS 0 AND Y= POWER OF 2 ! GIVES INCORRECT VALUE. USE IDIV... 12/28/76 BEGIN LOCAL A,V,L,RTUPDATE; MACRO RESULT=CASE .F OF SET (RELREG(.A+1,1);.X); (CLEARONE(RT[.ART[.A]]); RELREG(.A,1);LEXRA(.A+1))TES$; PCIVR(.X,.Y); RTUPDATE_.F XOR 1; IF LITP(.Y) THEN BEGIN V_LITV(.Y); IF .V EQL 0 THEN RETURN (DULEX(.X); WARNEM(.NSYM,#201); LITLEXEME(1^35-1)); IF LITP(.X) THEN BEGIN X_LITV(.X); RETURN LITLEXEME(CASE .F OF SET .X/.V;.X MOD .V TES) END; IF .V EQL ONE THEN RETURN CASE .F OF SET .X; (DULEX(.X);ZERO) TES; IF .V EQL -1 THEN RETURN CASE .F OF SET GNEG(.X); (DULEX(.X);ZERO) TES; % 12/29/76 IF (L_LOG2(.V)) GTR 0 AND NOT .F THEN RETURN PASH(.X,(-.L) AND RIGHTM); IF (.L LSS 0) AND NOT .F THEN RETURN GNEG(PASH(.X,.L AND RIGHTM)); % IF SMPOSLITVP(.V) THEN CODE(IDIVI,A_REGAK(X_GLTR2(.X)),.V,.RTUPDATE) ELSE CODE(IDIV,A_REGAK(X_GLTR2(.X)),LITA(.Y),.RTUPDATE) END ELSE IF ZERONAMP(.Y) THEN CODE(IDIVI,A_REGAK(X_GLTR2(.X)),GMA(.Y OR DOTM),.RTUPDATE) ELSE IF DCRP(.X) AND TVMP(.Y) AND NOT .F THEN (CODE(IDIVM,REGAK(X_GLAR(.X)),Y_GLTM(.Y),0);RETURN .Y) ELSE CODE(IDIV,A_REGAK(X_GLTR2(.X)), MEMORYA(.Y),.RTUPDATE); RESULT END; GLOBAL ROUTINE GDIV(X,Y)=GDIVMOD(.X,.Y,0); GLOBAL ROUTINE GMOD(X,Y)= BEGIN MODFLAG = 1; GDIVMOD(.X,.Y,1) END; GLOBAL ROUTINE GADD(X,Y)=GAS(.X,.Y,0); GLOBAL ROUTINE GSUB(X,Y)=GAS(.X,.Y,1); GLOBAL ROUTINE GNEG(X)= ! CALLED TO EVALUATE UNARY MINUS. SPECIAL CASE: - NOT X --> X+1 BEGIN PCIVR(.X,0); IF LITP(.X) THEN LITLEXEME(-LITV(.X)) ELSE IF .X THEN GADD(GYES(.X),ONE) ELSE .X XOR NEGM END; ROUTINE GAS(X,Y,F)= !GENERATE CODE FOR X&Y WHERE & IS CASE F OF SET +;- TES. ! THIS IS UNDOUBTEDLY THE BEST (WORST?) CASE FOR SHOWING THE ! COMPLEXITY OF THE "POSTPONING" MECHANISMS. IT WOULD BE FAIR TO SAY ! THAT THIS ROUTINE IS BIASED TOWARDS OPTIMIZING STRUCTURE ACCESSING, ! I.E. ADDITION BY INDEXING. FOR EXAMPLE, WHEN PASSED THE OPERANDS ! FOR .A + 1, GAS LOADS .A INTO A REGISTER (SAY R) AND RETURNS A LEXEME ! OF THE FORM (.R+1) (I.E. RETF=R AND LSSTEF=1). THE IDEA HERE IS THAT ! IF THE EXPRESSION .A + 1 HAS APPEARED IN THE CONTEXT "(.A+1)<0,36>_EXP" ! THEN THE ADDITION WOULD BE ACCOMPLISHED BY INDEXING IN THE INSTRUCTION: ! "MOVEM EXP,1(R)." ! THE SET OF SPECIAL CASES IS COMMENTED ON THE RIGHT SIDE OF ! THE CODE. E.G. !(@R+N)+L IS TO BE INTERPRETED TO MEAN: ! X= LEXEME REP. REG + NAME ! Y= LITERAL L ! F= +. ! FOLLOWING THE SET OF SPECIAL CASES THE ROUTINE ATTEMPTS TO ! HANDLE THE EIGHT CASSES THAT ARISE FROM F AND THE POSSIBILITY OF ! UNARY MINUS ON X OR Y OR BOTH. ! (1) X+Y (2) X-Y ! (3) X+-Y (4) X--Y ! (5) -X+Y (6) -X--Y ! (7) -X+-Y (8) -X-Y ! THERE IS A CODING TRICK TO SAVE ON THE SIZE OF GAS. IN MANY ! CASES THE DECISION IS MADE TO RECUR ON GAS AFTER EXCHANGING X AND Y. ! THE TRICK CONSISTS OF EXITING THE INNER (LOGICALLY MAIN) BLOCK ! (VIA GASCOMMUTE) AND THERE RECALLING GAS (VIA COMMUTE). BEGIN !DUMMY BLOCK TO SAVE ON COMMUTATIVE CALLS MACRO COMMUTE=(GAS(IF .F THEN GNEG(.Y) ELSE .Y,.X AND NOT NEGM,.X))$; BEGIN MACRO GASCOMMUTE=EXITBLOCK$; ROUTINE RLITP(X)=((.X AND NOT RTESTEM) EQL 0 AND (.X AND RTEM) NEQ 0); MACRO RLEX(X)=(X AND RTEM)$; MACRO NAMELEX(X)=((X AND LSSTEM) OR ZERO36)$; MACRO SLEX(X)=(X AND (LSSTEM OR POSNSIZEM))$; ROUTINE RNAMP(X)= IF .X EQL 0 THEN IF (.X AND RTEM) NEQ 0 THEN NAMP((.X AND NOT RTEM) OR ZERO36); LOCAL YVALUE, ! VALUE OF LITERAL Y ABSY, ! GABS(.Y) ABSX; ! GABS(.X) BIND XREG=ABSX, ! SAVE STACK SPACE YREG=ABSY; REGISTER R; MACRO TEMPX=R<0,1>$, ! X IS A TEMP REG TEMPY=R<1,1>$; ! Y IS A TEMP REG REGISTER ADDPOSSIBLE; ! .F EQL SIGN(.Y) PCIVR(.X,.Y); ABSY_GABS(.Y); ABSX_GABS(.X); IF LITP(.Y) THEN !X-L BEGIN IF .F THEN RETURN GAS(.X,GNEG(.Y),0); !X+0 IF .Y EQL ZERO THEN RETURN .X; IF LITP(.X) THEN !L+L RETURN LITLEXEME(LITV(.X)+LITV(.Y)); IF RLITP(.ABSX) THEN !(@R+L)+L RETURN GAS(SLEX(.X),.Y,.X) OR (.X AND (NEGM OR RTEM)); IF NAMP(.X) THEN !N+L RETURN GANL(0,.X,.Y); IF RNAMP(.X) THEN !(@R+N)+L RETURN GANL(RLEX(.X),NAMELEX(.X),.Y); !X+L IF (IF ZERONAMP(.X) THEN BEGIN YVALUE_LITV(.Y); (.YVALUE AND RIGHTM) EQL 0 AND NOT STACKVARP(.X) END ELSE 0) THEN !X<0,0>+L RETURN MPTRTYP(.YVALUE,.X); RETURN GLTR(.X) OR .Y END; IF LITP(.X) THEN !L+Y GASCOMMUTE; IF ZERONAMP(.Y) THEN !X&Y<0,0> RETURN( CODE(CASE .F OF SET ADDI;SUBI TES, REGAK(X_GLTR(.X)), GMA(.Y OR DOTM),1); .X); IF ZERONAMP(.X) THEN GASCOMMUTE; !X<0,0>&Y ADDPOSSIBLE_.F EQL SIGN(.Y); IF NAMP(.ABSY) AND .ADDPOSSIBLE THEN BEGIN IF REGP(.X) THEN !@R+N RETURN .X OR (.ABSY AND LSSTEM); IF RLITP(.X) THEN !(@R+L)+N RETURN GANL(RLEX(.X),.ABSY,SLEX(.X)); !X+N RETURN GLTR(.X) OR (.ABSY AND LSSTEM) END; IF NAMP(.ABSX) THEN !N&Y GASCOMMUTE; IF RNAMP(.ABSX) THEN BEGIN IF (IF RLITP(.ABSY) THEN LITV(SLEX(.Y)) NEQ 0) AND .ADDPOSSIBLE THEN !(@R+N)+(@R'+L) BEGIN IF TVRP(RLEX(.X)) THEN (XREG_RLEX(.X);YREG_RLEX(.Y)) ELSE (XREG_RLEX(.Y);YREG_RLEX(.X)); RETURN GAS(GANL(.XREG,NAMELEX(.X),SLEX(.Y)),.YREG,0) XOR (.X AND NEGM) END; !(@R+N)&Y RETURN GAS(GAS(RLEX(.X),.Y,.F),(.X AND NOT RTEM) OR ZERO36,0); END; IF RNAMP(.ABSY) THEN !X&(@R+N) GASCOMMUTE; IF (IF RLITP(.ABSX) THEN LITV(SLEX(.ABSX)) NEQ 0) THEN !(@R+L)&Y BEGIN BIND X1=ABSX; X1_GAS(.X AND NOT LSSTEM,.Y,.F); IF .X AND .X1 THEN RETURN GNEG(GAS(SLEX(.X),GABS(.X1),0)); RETURN GAS(IF .X THEN GNEG(SLEX(.X)) ELSE SLEX(.X),GABS(.X1),.X1) END; IF (IF RLITP(.ABSY) THEN LITV(SLEX(.ABSY)) NEQ 0) THEN !X&(@R+L) GASCOMMUTE; IF TVMP(.Y) AND DCRP(.X) THEN !D&M (CODE(IF .ADDPOSSIBLE THEN ADDM ELSE SUBM, REGAK(X_GLAR(.X)),GMA(Y_GLTM(.ABSY)),0);RETURN .Y); IF TVMP(.X) THEN !M&Y GASCOMMUTE; REGSEARCH(X,Y); ABSX_GABS(.X); ABSY_GABS(.Y); IF (TEMPX_TVRP(.ABSX)) AND (TEMPY_TVRP(.ABSY)) THEN BEGIN IF SHOULDEXCH(.X,.Y) THEN GASCOMMUTE; IF SIGN(.X) THEN BEGIN IF .ADDPOSSIBLE AND .RT[.X] NEQ .VREG THEN !5,6 GASCOMMUTE; !7,8 RETURN GNEG(GAS(.ABSX,.ABSY,.ADDPOSSIBLE)); END; CODE(IF .ADDPOSSIBLE THEN ADD ELSE SUB, REGAK(X_GLTR(.X)),REGAR(GLTR(.ABSY)),1); !1-4 RETURN .X END; IF .TEMPX THEN BEGIN IF SIGN(.X) THEN !5-8 RETURN GNEG(GAS(.ABSX,.ABSY,.ADDPOSSIBLE)); CODE(IF .ADDPOSSIBLE THEN ADD ELSE SUB, REGAK(X_GLTR(.X)), !1-4 MEMORYA(.Y),1); RETURN .X END; IF .TEMPY THEN GASCOMMUTE; IF SIGN(.X) THEN BEGIN IF .ADDPOSSIBLE THEN !5-6 GASCOMMUTE; !7-8 X_GOLTR(.X); IF SIGN(.X) THEN RETURN GNEG(GAS(GABS(.X),.ABSY,0)); RETURN GAS(.X,.ABSY,1) END; !1-4 IF READY(.X) THEN BEGIN IF .ADDPOSSIBLE THEN RETURN GAS(GLTR(.ABSY),.X,0); IF READY(.ABSY) THEN RETURN GAS(GLTR(.X),.ABSY,1); RETURN GNEG(GAS(GLTR(.ABSY),.X,1)) END; RETURN GAS(GLTR(.X),.ABSY,.F XOR SIGN(.Y)) END; ! DUMMY END EXITED FOR COMMUTATIVE CALL COMMUTE END; GLOBAL ROUTINE FALR(R,X)= ! (FORCE-ADD-LITERAL-REGISTER) R IS THE ADDRESS OF A REGISTER AND L ! IS THE LEXEME OF A LITERAL TO BE ADDED TO THAT REGISTER BEGIN REGISTER VALUE,OPCODE,ADDRESS; VALUE_LITV(.X); IF .VALUE EQL 0 THEN RETURN .R; OPCODE_ IF .VALUE EQL 1 THEN (ADDRESS_0; AOJ) ELSE IF .VALUE EQL -1 THEN (ADDRESS_0; SOJ) ELSE IF SMPOSLITVP(.VALUE) THEN (ADDRESS_.VALUE; ADDI) ELSE IF SMNEGLITVP(.VALUE) THEN (ADDRESS_-.VALUE; SUBI) ELSE (ADDRESS_LITA(.X); ADD); CODE(.OPCODE,.R,.ADDRESS,1); .R END; ROUTINE GANL(R,X,Y)= ! (GENERATE-ADD-NAME-LITERAL) ! PARAMETERS: ! R LEXEME OF REGISTER (OR ZERO IF NONE) ! X LEXEME OF A NAME ! Y LITERAL LEXEME ! THIS ROUTINE ATTEMPTS TO GENERATE A NEW NAME FROM THE EXPRESSION ! X+Y. FAILING THIS IT GENERATES CODE TO ADD THE TWO. ! "NEW" NAMES COME IN TWO VARIETIES: ! (1) COMPILE TIME NEW NAMES: ! ALL THE CASES (SEE %[C]%) EXCEPT EXTERNALS. A NEW ENTRY IS ! CREATED ON THE GENSYMS LIST (SEE GENLOCAL IN H2REGIST) WITH THE SAME ! BLOCKLEVEL BUT OFFSET= OFFSET-OF-X + VALUE-OF-Y. ! (2) LOAD-TIME NEW NAMES: ! EXTERNALS AND EXPRESIONS ALREADY INVOLVING LOAD-TIME NEW NAMES. ! SYMBOL TABLE ENTRIES FOR THESE NEW NAMES ARE COMPOSED OF TWO-WORD CELLS ! SINGLY LINKED OFF A HASH TABLE (EXPHT). THE "NAME" OF AN EXTERNAL ! EXPRESSION (2ND WORD OF ENTRY) IS COMPOSED OF TWO HALVES: ! LEFTHALF= ST. INDEX OF EXTERNAL VARIABLE, RIGHTHALF=18-BIT VALUE OF Y. ! THE UNIQUENESS OF THIS NAME IS INSURED BY THE FACT THAT THE EXTERNAL-TYPE ! ENTRIES ARE NEVER PURGED FROM THE SYMBOL TABLE BECAUSE THE LOADER MUST ! CHAIN REFERENCES AND OUTPUT THE NAMES. BEGIN LOCAL TYPE,YVALUE,HASHVALUE; TYPE_.ST[.X,0]; YVALUE_(IF .TYPE NEQ EXTRNT THEN .ST[.X,1] ELSE 0); IF .YVALUE<17,1> EQL 1 THEN YVALUE_.YVALUE OR (#777777^18); ! SIGN-EXTEND YVALUE_LITV(.Y)+.YVALUE; %6(213) THE FOLLOWING LINE IS MODIFIED ON FEB-28-77 TO HANDLE X+1^17 AND GIVE ERROR FOR X+5^17 OR X+2^17 % %3.41% IF (ABS(.YVALUE) AND LEFTM) EQL 0 THEN IF (1^GLOBALT OR 1^OWNT OR 1^LOCALT OR 1^FORMALT OR 1^STFORMT %[C]% OR 1^PLITT OR 1^GPLITT OR 1^EXTRNT OR 1^EXPRT)^(-.TYPE) THEN BEGIN REGISTER LINK,STINDEX,NAME; MACRO EXPHASH(X)=((X) MOD EXPHTSIZE)$; YVALUE_.YVALUE; IF (1^EXTRNT OR 1^EXPRT)^(-.TYPE) THEN BEGIN NAME_(IF .TYPE EQL EXTRNT THEN .X ELSE .ST[.X,1])^18 OR .YVALUE; LINK_.EXPHT[HASHVALUE_EXPHASH(.NAME)]; !!NOW COMES THE SEARCH-LOOP OF EXPRT SYMBOL STINDEX_ WHILE .LINK NEQ 0 DO IF .ST[.LINK,1] EQL .NAME THEN EXITLOOP .LINK ELSE LINK_.ST[.LINK,0]; IF .STINDEX LSS 0 THEN BEGIN STINDEX_GETSPACE(1); LINK_.EXPHT[.HASHVALUE]; EXPHT[.HASHVALUE]_.STINDEX; ST[.STINDEX,0]_.LINK; ST[.STINDEX,0]_EXPRT; ST[.STINDEX,1]_.NAME END END ELSE BEGIN STINDEX_GETSPACE(1); ST[.STINDEX,0]_.ST[.X,0]; ST[.STINDEX,0]_.BLOCKLEVEL; ST[.STINDEX,0]_.GENSYMS; ST[.STINDEX,1]_.YVALUE; GENSYMS_.STINDEX END; STINDEX_.STINDEX OR LSM; RETURN(IF .R NEQ 0 THEN .R OR .STINDEX ELSE .STINDEX OR ZERO36) END; !!END OF BLOCK FOR OPTIMIZABLE EXPRESSIONS IF .R EQL 0 THEN RETURN GAS(GLTR(.X),.Y,0); IF TVRP(.R) THEN RETURN GAS(LEXRA(FALR(.RT[.R],.Y)),.X,0); GAS(.R,GAS(GLTR(.Y),.X,0),0) END; ROUTINE GREL(X,Y,R)= %GENERATE CODE FOR .X&.Y WHERE & IS CASE .R-1 OF SET LSS; EQL;LEQ;;GEQ;NEQ;GTR;TES% ! THE MANIPULATION OF VTARGET (SEE TRYVREG IN H2REGIST) HERE IS INTENDED ! TO DELAY THE USE OF VREG UNTIL GBREL IS CALLED SO THAT ! THE RESULT REG WILL BE VREG. E.G. .A LSS 0 WILL COMPILE TO: ! MOVEI $V,1 ! SKIPL R,A ! SETZ $V,0 ! INSTEAD OF ! MOVEI R,1 ! SKIPL $V,A ! SETZ R,0 BEGIN REGISTER SAVVTARGET; ! ENTRY VALUE OF VTARGET LOCAL REVREL; ! X ".R" Y <--> -X ".REVREL" -Y ! X ".R" Y <--> Y ".REVREL" X MACRO RESTOREVTARGET=VTARGET_.SAVVTARGET$; BEGIN MACRO COMMUTE=EXITBLOCK$; PCIVR(.X,.Y); SAVVTARGET_.VTARGET; VTARGET_-1; IF LITP(.X) AND LITP(.Y) THEN BEGIN X_LITV(.X); Y_LITV(.Y); RESTOREVTARGET; RETURN LITLEXEME(CASE .R-1 OF SET .X LSS .Y; .X EQL .Y; .X LEQ .Y;; .X GEQ .Y; .X NEQ .Y; .X GTR .Y TES) END; REVREL_(#16305270 AND (7^(3*.R)))^(-(3*.R)); IF LITP(.Y) THEN COMMUTE; IF .X AND .Y THEN RETURN (RESTOREVTARGET; GREL(GABS(.X),GABS(.Y),.REVREL)); IF .X THEN COMMUTE; IF LITP(.X) THEN BEGIN LOCAL V, ! VALUE OF LITERAL Y EQ, ! BOOLEAN: R --> EQL REG, ! LEXEME OF REGISTER TESTMASK, ! MASK TO USE IN TEST INST. ABSY; ! GABS(.Y) MACRO DPWREGP(L)= %3.7% (IF NOT LITP(.L AND (RTEM OR LSSTEM)) THEN EXITCOMP 0; %3.7% IF .L EQL 0 THEN EXITCOMP 0; %3.7% IF (LITV(.L) AND IXYM) GTR 15 THEN EXITCOMPOUND 0; IF (.L<30,6> + .L<24,6>) GEQ 36 THEN EXITCOMPOUND 0; IF .L EQL 0 THEN EXITCOMPOUND 0; %3.7% REG_GAT(.L AND LSSTEM); 1)$, ! DOTTED-PARTIAL-WORD-REGISTER PREDICATE FWINREG(L)=((REG_MATCH((L AND NOT(POSNSIZEM)) OR ZERO36,1)) NEQ ((L AND NOT(POSNSIZEM)) OR ZERO36))$; ! FULL-WORD-IN-REGISTER PREDICATE ! THESE MACROS (IF TRUE) ALLOW US TO BUILD INSTRUCTIONS OF THE ! FORM: TRNN R,MASK, FOR TESTS OF SUBFIELDS AGAINST ZERO. V_LITV(.X); REGSEARCH(Y,0); IF .V EQL 0 THEN IF .Y THEN IF FULLWORD(.Y) THEN IF READY(.Y) THEN BEGIN REG_LEXRA(ACQUIRE(-1,1)); ENTER(.REG,.Y); RETURN GBREL(.SAVVTARGET,SKIP+.REVREL,REGAR(.REG),GMA(.Y)) END; IF .V EQL 0 THEN BEGIN IF NOT (EQ_.R EQL 2) THEN IF NOT (.R EQL 6) THEN EXITCOMPOUND; %3.7% IF NOT DPWREGP(Y) THEN IF NOT FWINREG(.Y) THEN EXITCOMPOUND; TESTMASK_(1^.Y-1)^.Y; RETURN GBREL(.SAVVTARGET, IF .TESTMASK EQL 0 THEN CASE .EQ OF SET TRNN;TRNE TES ELSE IF .TESTMASK EQL 0 THEN (TESTMASK_.TESTMASK^(-18);CASE .EQ OF SET TLNN; TLNE TES) ELSE CASE .EQ OF SET TDNN;TDNE TES, REGAR(.REG), IF (.TESTMASK * .TESTMASK) NEQ 0 THEN LITA(LITLEXEME(.TESTMASK)) ELSE .TESTMASK) END; IF SMPOSLITVP(.V) THEN BEGIN IF .Y AND (NOT READY(ABSY_GABS(.Y)) OR REGP(.ABSY)) THEN RETURN GBREL(.SAVVTARGET,CAM+.R,REGAR(GLAR(.ABSY)),LITA(LITLEXEME(-.V))); RETURN GBREL(.SAVVTARGET,CAI+.REVREL,REGAR(GLAR(.Y)),.V) END; RETURN GBREL(.SAVVTARGET,CAM+.REVREL,REGAR(GLAR(.Y)),LITA(.X)) END; IF ZERONAMP(.Y) THEN RETURN GBREL(.SAVVTARGET,CAI+.R,REGAR(GLAR(.X)),GMA(.Y OR DOTM)); IF ZERONAMP(.X) THEN COMMUTE; REGSEARCH(X,Y); IF TVRP(.X) THEN RETURN GBREL(.SAVVTARGET,CAM+.R,REGAR(GLTR(.X)),MEMORYA(.Y)); IF TVRP(.Y) THEN COMMUTE; IF DCRP(.X) THEN RETURN GBREL(.SAVVTARGET,CAM+.R,REGAR(GLAR(.X)),MEMORYA(.Y)); IF DCRP(.Y) THEN COMMUTE; IF READY(.X) THEN RETURN GBREL(.SAVVTARGET,CAM+.REVREL,REGAR(GLAR(.Y)),GMA(.X)); RETURN GBREL(.SAVVTARGET,CAM+.R,REGAR(GLAR(.X)),MEMORYA(.Y)) END; ! COMMUTES EXIT THIS BLOCK RESTOREVTARGET; GREL(.Y,.X,.REVREL) END; ROUTINE GBREL(SAVVTARGET,F,A,M)= %GENERATE CODE FOR RELATIONAL EXPRESSION BY BRACKETING CAM OR CAI INSTRUCTION BETWEEN MOVEI T,1 AND SETZ T,0 WHERE T IS A TEMPORARY REGISTER WHICH WILL CONTAIN THE RESULT. THESE THREE INSTRUCTIONS ARE HUNG FROM A RELC HEADER IN PREPARATION FOR ROUTINE GCUJUMP. GBREL IS CALLED FROM GREL.% BEGIN REGISTER C,T; VTARGET_.SAVVTARGET; C_FOLLCPH(2,RELC,1); CT[.C,2]_T_GLTR(ONE); CT[.C,3]_CODE(.F,.A,.M,0); CODE(SETZ,REGAK(.T),0,1); FOLLCPH(0,CODEC,0); .T END; GLOBAL ROUTINE GLSS(X,Y)=GREL(.X,.Y,1); GLOBAL ROUTINE GEQL(X,Y)=GREL(.X,.Y,2); GLOBAL ROUTINE GLEQ(X,Y)=GREL(.X,.Y,3); GLOBAL ROUTINE GGEQ(X,Y)=GREL(.X,.Y,5); GLOBAL ROUTINE GNEQ(X,Y)=GREL(.X,.Y,6); GLOBAL ROUTINE GGTR(X,Y)=GREL(.X,.Y,7); GLOBAL ROUTINE GAND(X,Y)=GLOG(.X,.Y,0); GLOBAL ROUTINE GOR(X,Y)=GLOG(.X,.Y,1); GLOBAL ROUTINE GXOR(X,Y)=GLOG(.X,.Y,2); GLOBAL ROUTINE GEQV(X,Y)=GLOG(.X,.Y,3); GLOBAL ROUTINE GNOT(X)= ! CALLED TO EXECUTE UNARY NOT. ! SPECIAL CASE : NOT -X --> X-1 BEGIN PCIVR(.X,0); IF LITP(.X) THEN LITLEXEME(NOT LITV(.X)) ELSE IF SIGN(.X) THEN GSUB(GABS(.X),ONE) ELSE .X XOR NOTM END; STRUCTURE LOG[F,A,M]=(.LOG+.F)<9*(2*.M+.A),9>; BIND LOG LOGOP=PLIT(#440420410404, !ANDCB ANDCM ANDCA AND #470464454434, ! ORCB ORCM ORCA OR #430444444430, ! XOR EQV EQV XOR #444430430444); ! EQV XOR XOR EQV ! ANDI=AND + 1 ETC. ! ANDM=AND + 2 ETC. ROUTINE GLOG(X,Y,F)= !GENERATE CODE FOR LOGICAL EXPRESSION X&Y WHERE & IS !CASE F OF SET AND; OR; XOR; EQV TES ! ALWAYS ATTEMPT TO DO "NOTTING" OF ACC AND MEM VIA THE INSTRUCTION. ! SPECIAL CASES: ! Y=0 --> (0,X,X,NOT X) ! Y=-1 --> (X,-1,NOT X,X) ! Y=X --> (X,X,0,-1) ! Y=NOT X --> (0,-1,-1,0) BEGIN MACRO GLOGCOMMUTE=GLOG(.Y,.X,.F)$; LOCAL ACC, ! ADDRESS OF REGISTER COMPLEMENT, ! USE COMPLEMENT OF OPERAND YVALUE, ! VALUE OF LITERAL Y L, ! LEFT HALF OF YVALUE XYES, ! GYES(.X) YYES, ! GYES(.Y) TEMPX, ! TVRP(.X) TEMPY; ! TVRP(.Y) PCIVR(.X,.Y); XYES_GYES(.X); YYES_GYES(.Y); IF LITP(.Y) THEN BEGIN IF LITP(.X) THEN BEGIN X_LITV(.X);Y_LITV(.Y); RETURN LITLEXEME(CASE .F OF SET .X AND .Y;.X OR .Y; .X XOR .Y;.X EQV .Y TES) END; IF .Y EQL ZERO THEN RETURN CASE .F OF SET (DULEX(.X);ZERO);.X;.X;GNOT(.X) TES; IF (YVALUE_LITV(.Y)) EQL -1 THEN RETURN CASE .F OF SET .X;(DULEX(.X);LITLEXEME(-1));GNOT(.X);.X TES; IF (IF ZERONAMP(.X) THEN (CASE .F OF SET (.YVALUE EQL 0) OR (.YVALUE EQL RIGHTM); (.YVALUE AND RIGHTM) EQL 0 AND NOT STACKVARP(.X); 0; 0 TES) ELSE 0) THEN RETURN( IF .F EQL 0 THEN IF .YVALUE EQL 0 THEN (DULEX(.X);ZERO) ELSE .X ELSE MPTRTYP(.YVALUE,.X)); COMPLEMENT_NO(.X); ACC_REGAK(X_GLTR(.XYES)); L_.YVALUE^(-18); IF .L EQL 0 THEN CODE(.LOGOP[.F,.COMPLEMENT,0]+1,.ACC,.YVALUE,1) ELSE IF .L EQL RIGHTM THEN CODE(.LOGOP[.F,.COMPLEMENT,1]+1,.ACC,NOT .YVALUE,1) ELSE CODE(.LOGOP[.F,.COMPLEMENT,0],.ACC,LITA(.Y),1); RETURN .X END; IF LITP(.X) THEN RETURN GLOGCOMMUTE; IF ZERONAMP(.YYES) THEN RETURN (CODE(.LOGOP[.F,NO(.X),NO(.Y)]+1, REGAK(X_GLTR(.XYES)),GMA(.YYES OR DOTM),1);.X); IF ZERONAMP(.XYES) THEN RETURN GLOGCOMMUTE; IF ((.X EQV .Y) AND NOT NOTM) EQL (NOT NOTM) THEN RETURN CASE 2*.F OR NO(.X) NEQ NO(.Y) OF SET .X;(DULEX(.X);ZERO); .X;(DULEX(.X);LITLEXEME(-1)); (DULEX(.X);ZERO); (DULEX(.X);LITLEXEME(-1)); (DULEX(.X);LITLEXEME(-1));(DULEX(.X);ZERO) TES; REGSEARCH(X,Y); XYES_GYES(.X); YYES_GYES(.Y); TEMPX_TVRP(.XYES); TEMPY_TVRP(.YYES); IF .TEMPX AND .TEMPY THEN IF SHOULDEXCH(.X,.Y) THEN (EXCHANGE(X,Y); EXCHANGE(XYES,YYES)); IF .TEMPX THEN RETURN (CODE(.LOGOP[.F,NO(.X),NO(.Y)],REGAK(X_GLTR(.XYES)),MEMORYA(.YYES),1); .X); IF .TEMPY THEN RETURN GLOGCOMMUTE; IF TVMP(.X) AND DCRP(.YYES) THEN RETURN (CODE(.LOGOP[.F,NO(.Y),NO(.X)]+2,REGAR(GLAR(.YYES)),GMA(X_GLTM(.XYES)),0); .X); IF TVMP(.Y) AND DCRP(.YYES) THEN GLOGCOMMUTE; IF READY (.XYES) THEN RETURN GLOG(GLTR(.YYES) OR (.Y AND NOTM),.X,.F); GLOG(GLTR(.XYES) OR (.X AND NOTM),.Y,.F) END; %FLOATING POINT OPERATORS FOR THE BLISS COMPILER. MAINLY THE FAULT OF R.F. BRENDER (DEC). THE FOLLOWING OPERATIONS ARE IMPLEMENTED: BINARY: FADR - FLOATING ADD AND ROUND FSBR - FLOATING SUBTRACT AND ROUND FMLR - FLOATING MULTIPLY AND ROUND FDVR - FLOATING DIVIDE AND ROUND UNARY: FNEG - FLOATING NEGATION FLOAT - FLOAT AN INTEGER FIX - FIX A FLOATING VALUE % ROUTINE GFADFML (OP,X,Y) = %FLOATING ADDITION AND MULTIPLICATION % BEGIN LOCAL YP,XP; REGISTER T; T_.OP^(-1); XP_.X; YP_.Y; PCIVR(.XP,.YP); IF LITP(.XP) THEN IF LITP(.YP) THEN RETURN LITLEXEME(FLOATB(.OP,LITV(.XP),LITV(.YP))) ELSE EXCHANGE(XP,YP); %HERE XP IS NOT A CONSTANT% IF LITP(.YP) THEN IF .YP EQL ZERO THEN RETURN CASE2(.T,.XP,(DULEX(.XP);ZERO)) ELSE IF SMLFLP(.YP) THEN (CODE(CASE2(.T,FADRRI,FMLRRI),REGAK(XP_GLTR(.XP)), SMLFLV(.YP),1); RETURN .XP) ELSE (CODE(CASE2(.T,FADRR,FMLRR),REGAK(XP_GLTR(.XP)), LITA(.YP),1); RETURN .XP); %NEITHER XP NOR YP IS CONSTANT% REGSEARCH(XP,YP); IF TVRP(.YP) THEN IF NOT (TVRP(.XP) AND .RT[.XP] EQL .OPTTOREGADDR) THEN EXCHANGE(XP,YP); IF TVRP(.XP) THEN (CODE(CASE2(.T,FADRR,FMLRR),REGAK(XP_GLTR(.XP)), MEMORYA(.YP),1); RETURN .XP); IF TVMP(.YP) THEN EXCHANGE(XP,YP); IF TVMP(.XP) THEN (YP_GLAR(.YP); IF DCRP(.YP) THEN (CODE(CASE2(.T,FADRR,FMLRR),REGAK(.YP), GLTM(.X),0); RETURN .XP AND NOT NGNTM) ELSE GFADR(.YP,.XP)); %ALL THE REST% CODE(CASE2(.T,FADRR,FMLRR),REGAK(XP_GLTR(.XP)),MEMORYA(.YP),1); .XP END; GLOBAL ROUTINE GFADR(X,Y) = GFADFML(0,.X,.Y); GLOBAL ROUTINE GFMLR(X,Y) = GFADFML(2,.X,.Y); ROUTINE GFSBFDV (OP,X,Y) = %FLOATING SUBTRACT AND DIVIDE% BEGIN LOCAL T,XP,YP; T_.OP^(-1); XP_.X; YP_.Y; PCIVR(.XP,.YP); IF LITP(.XP) THEN IF LITP(.YP) THEN RETURN LITLEXEME(FLOATB(.OP,LITV(.XP),LITV(.YP))) ; ; IF LITP(.YP) THEN (CASE .T OF SET IF .YP EQL ZERO THEN RETURN .XP; BEGIN IF .YP EQL FLOATONE THEN RETURN .XP; IF .YP EQL ZERO THEN (WARNEM(.NSYM,#201); RETURN (DULEX(.XP);VERYBIG)) END TES ; IF SMLFLP(.YP) THEN (CODE(CASE2(.T,FSBRRI,FDVRRI),REGAK(XP_GLTR(.XP)), SMLFLV(.YP),1); RETURN .XP) ELSE (CODE(CASE2(.T,FSBRR,FDVRR),REGAK(XP_GLTR(.XP)), LITA(.YP),1); RETURN .XP) ); % ALL THE REST% CODE(CASE2(.T,FSBRR,FDVRR),REGAK(XP_GLTR(.XP)),MEMORYA(.YP),1); .XP END ; GLOBAL ROUTINE GFSBR (X,Y) = GFSBFDV(1,.X,.Y); GLOBAL ROUTINE GFDVR (X,Y) = GFSBFDV(3,.X,.Y); %SERVICE ROUTINES FOR THE ABOVE% ROUTINE EXCHANGE (A,B) = %A AND B ARE CALLED BY REFERENCE. THEIR VALUES ARE EXCHANGED% BEGIN LOCAL T; T_..A; .A_..B; .B_.T END; ROUTINE SMLFLP(X) = %ASSUMMING X IS A LITERAL, SEE IF IT CAN BE REPRESENTED IN BUT 18 BITS% (LITV(.X) AND 1^18-1) EQL 0 ; ROUTINE SMLFLV (X) = LITV(.X)^(-18); GLOBAL ROUTINE GFNEG (X) = %FLOATING NEGATION% GFSBR(ZERO,.X); GLOBAL ROUTINE GFIX (X) = % YES THIS IS DONE IN LINE! (MAYBE) SOMEDAY IT CAN BE MADE AN INTERNAL ROUTINE. % IF LITP(.X) THEN LITLEXEME(FIX LITV(.X)) ELSE BEGIN LOCAL A,Y; CODE(MOVM,Y_ACQUIRE(-1,2),A_MEMORYA(.X),1); CODE(MULI,.Y,#400,1); CODE(EXCH,.Y,.Y+1,1); CODE(ASH,.Y,(.Y+1)^18 OR (-#243 AND 1^18-1),1); CODE(SKIPGE,0,.A,1); CODE(MOVNS,0,.Y,1); RELREG(.Y+1,1); LEXRA(.Y) END; GLOBAL ROUTINE GFLOAT (X) = %FLOAT A FIXED NUMBER% IF LITP(.X) THEN LITLEXEME(FLOAT LITV(.X)) ELSE BEGIN LOCAL REG1,REG2; REG1_REGAK(X_GLTR2(.X)); REG2_.REG1+1; CODE(IDIVI,.REG1,#400000,0); CODE(SKIPE,0,.REG1,0); CODE(TLC,.REG1,#254000,0); CODE(TLC,.REG2,#233000,0); CODE(FAD,.REG1,.REG2,1); RELREG(.REG2,1); .X END; GLOBAL ROUTINE FLOATB (OP,P1,P2) = %NEEDED TO BOOTSTRAP THE FLOATING ROUTINES INTO THE BLISS COMPILER.% BEGIN REGISTER R; MACHOP FFADR=#144, FFSBR=#154, FFMLR=#164, FFDVR=#174; R_.P1; CASE .OP OF SET FFADR(R,P2); FFSBR(R,P2); FFMLR(R,P2); FFDVR(R,P2) TES !DO THE OPERATION ; .R END %OF THE ROUTINE% ; %% % ROUTINE GOTM CALLED TO GENERATE CODE FOR X_(NOT OR - OR EMPTY) .X OP Y. % %% GLOBAL ROUTINE GOTM(Y,X,RESINREG,OPLEX)= ! GOTM ATTEMPTS TO OPTIMIZE TO-MEMORY TYPE INSTRUCTIONS. CASES IT ! CANNOT OPTIMIZE SUCH AS X<3,4>_.X<3,4>+2, IT CALLS THE PROPER OPERATOR ! ROUTINE AND THE STORE ROUTINE. IN THE CASE WHERE X IS A REGISTER, RATHER ! THAN DUPLICATE MUCH OF THE OPTIMIZATIONS IN THE PARTICULAR OPERATOR ! ROUTINE IT CALLS THE OPERATOR ROUTINE ! WITH LEXEMS FOR .X AND .Y AFTER SETTING THE GLOBAL VARIABLE ! OPTTOREGADDR TO THE ADDRESS OF X. THE OPERATOR ROUTINES ARE ! GEARED TO LEAVING THE RESULT IN THIS REGISTER. BEGIN LOCAL GTINDEX,REGLEX; REGISTER R; MACRO LIT=R<0,1>$, ! LITERAL Y L0=R<1,1>$, ! Y=0 L1=R<2,1>$, ! Y=1 LM1=R<3,1>$, ! Y=-1 L18=R<4,1>$, ! Y=18 LM18=R<5,1>$, ! Y=-18 NEGL=R<6,1>$, ! .X NEGR=R<7,1>$, ! .Y NOTL=R<8,1>$, ! .X NOTR=R<9,1>$, ! .Y UNOP=R<10,1>$, ! UNARY OPERATOR FLOP=R<11,1>$, ! FL. PT. OPERATOR NONEGNOTL=R<12,1>$, ! .X=.X=0 NONEGNOTR=R<13,1>$, ! .Y=.Y=0 FL1=R<14,1>$, ! Y=1.0 FLM1=R<15,1>$, ! Y=-1.0 OPTOREG=R<16,1>$, ! X IS A REGISTER LEFTSIDEREG=R<17,1>$; ! ADDR. OF REG X MACRO REG(X)=REGP(X AND NOT NGNTM)$; PCIVR(.X,.Y); R_0; GTINDEX_.RESINREG; RESINREG_0; IF .GTINDEX NEQ 0 THEN GT[.GTINDEX,0]_MAXER(.GT[.GTINDEX,0]-1,0); DULEX(.X); IF FULLWORD(.X) OR REG(.X) THEN BEGIN LOCAL LITVAL, ! VALUE OF LITERAL Y OPPTR, ! ADDRESS OF OPERATOR ROUTINE ACCUM, ! ACCUMULATOR FOR INST. OPCODE; ! FUNSTION FOR INSTRUCTION REGISTER RES; ! RESULT TO BE LEFT IN REGISTER FORWARD NOOP, ZEROP, ONESOP, CODEIT, GLOGIC, CODECY; ROUTINE NOOP(LEX)= ! CALLED TO COMPLEMENT OR NEGATE X IF NECESSARY IF .NONEGNOTL THEN .LEX ELSE (NONEGNOTL_1; IF .OPTOREG THEN GLPR(.LEX,.RT[.LEX]) ELSE CODECY(.LEX,(IF .NOTL THEN SETCMM+.RES ELSE MOVNS))); ROUTINE ZEROP(LEX)= ! CALLED TO STORE ZERO INTO X (NONEGNOTL_1; IF .OPTOREG THEN RETURN(GLPR(ZERO,.RT[.LEX]); ZERO); LEX_CODECY(.LEX,SETZM+.RES); IF .RES THEN DUN(.LEX); ZERO); ROUTINE ONESOP(LEX)= ! CALLED TO STORE -1 INTO X (NONEGNOTL_1; IF .OPTOREG THEN RETURN(R_LITLEXEME(-1); GLPR(.R,.RT[.LEX]); .R); LEX_CODECY(.LEX,SETOM+.RES); IF .RES THEN DUN(.LEX); LITLEXEME(-1)); ROUTINE CODEIT(NEWY, X, OPC)= ! CALLED TO ACTUALLY PRODUCE CODE BEGIN LOCAL ACCUM, ADDRESS; X_.X AND NOT NGNTM; IF .OPTOREG THEN BEGIN ACCUM_.RT[.X]; RES_1; OPC_.OPC-2; ADDRESS_MEMORYA(.NEWY) END ELSE BEGIN ACCUM_REGAK(GLAR(.NEWY)); RES_(.RES OR .CODEPROP); IF (.ART[.ACCUM] LSS 16 OR .RT[.ART[.ACCUM]] GTR 1) THEN RES_0; OPC_.OPC+.RES; ADDRESS_MEMORYA(.X) END; CODEN(.OPC,.ACCUM,.ADDRESS,6+.RES,.X); IF .RES THEN LEXRA(.ACCUM) ELSE .X END; ROUTINE GLOGIC(CODE,X,Y)= ! CALLED TO PRODUCE CODE FOR AND, OR, ETC. (CODEPROP_0; IF .OPTOREG THEN EXCHANGE(NOTR,NOTL); CODEIT(GYES(.Y), .X, .LOGOP[.CODE, .NOTR, .NOTL]+2)); ROUTINE CODECY(X,OPC)= ! CALLED FOR CASES WITH CONSTANT Y BEGIN LOCAL ACCUM,SAVRES; IF NOT .NONEGNOTL THEN (SAVRES_.RES; RES_0; NOOP(.X); RES_.SAVRES); ACCUM_IF .RES THEN ACQUIRE(-1,1); CODEN(.OPC,.ACCUM,MEMORYA(X_.X AND NOT (NEGM OR NOTM)), 6+.RES, .X); IF .ACCUM NEQ 0 THEN LEXRA(.ACCUM) ELSE .X END; RES_.RESINREG; LEFTSIDEREG_OPTOREG_REG(.X); OPPTR_(DISPAD(.OPLEX))<0,0>; IF .X THEN NEGL_1 ELSE IF .X THEN NOTL_1 ELSE NONEGNOTL_1; IF NOT (UNOP_.OPLEX) THEN IF LITP(.Y) THEN (LITVAL_LITV(.Y); LIT_1; IF .LITVAL EQL 0 THEN L0_1 ELSE IF .LITVAL EQL 1 THEN L1_1 ELSE IF .LITVAL EQL 1.0 THEN FL1_1 ELSE IF .LITVAL EQL -1 THEN LM1_1 ELSE IF .LITVAL EQL -1.0 THEN FLM1_1 ELSE IF .LITVAL EQL 18 THEN L18_1 ELSE IF .LITVAL EQL -18 THEN LM18_1 ) ELSE IF .Y THEN NEGR_1 ELSE IF .Y THEN NOTR_1 ELSE NONEGNOTR_1; IF NOT .LEFTSIDEREG THEN X_36 ELSE IF .X THEN ERROR(.NDEL,#777); IF NOT .UNOP THEN % SHIFTS % IF .OPPTR EQL GLSH<0,0> THEN (IF NOT .LIT THEN EXITBLOCK; IF .L0 THEN RETURN NOOP(.X); IF .LITVAL GEQ 36 THEN RETURN ZEROP(.X); IF .LITVAL LEQ -36 THEN RETURN ZEROP(.X); IF NOT (.L18 OR .LM18) THEN EXITBLOCK; RETURN CODECY(.X,IF .L18 THEN HRLZS ELSE HLRZS)) ELSE % MULTIPLY % IF .OPPTR EQL GMUL<0,0> OR (FLOP_.OPPTR EQL GFMLR<0,0>) THEN (IF .L0 THEN RETURN ZEROP(.X); IF .FLOP THEN IF .FL1 THEN RETURN NOOP(.X); IF NOT .FLOP THEN IF .L1 THEN RETURN NOOP(.X); IF .FLOP AND .FLM1 OR NOT .FLOP AND .LM1 THEN RETURN GOTM(0,.X,.RESINREG,GNEG OR HUNARYM); IF .NOTL THEN EXITBLOCK; IF .OPTOREG THEN IF .LIT THEN EXITBLOCK; CODEPROP_0; Y_0; IF .NEGL XOR .NEGR THEN Y_GNEG(.Y); RETURN CODEIT(.Y,.X, IF .FLOP THEN FMPRM ELSE IMULM)) ELSE % DIVIDE % IF .OPPTR EQL GDIV<0,0> OR (FLOP_.OPPTR EQL GFDVR<0,0>) THEN (IF .L0 THEN EXITBLOCK; IF .FLOP THEN IF .FL1 THEN RETURN NOOP(.X); IF NOT .FLOP THEN IF .L1 THEN RETURN NOOP(.X); IF .FLOP AND .FLM1 OR NOT .FLOP AND .LM1 THEN RETURN GOTM(0,.X,.RESINREG,GNEG OR HUNARYM) ELSE EXITBLOCK) ELSE % MOD % IF .OPPTR EQL GMOD<0,0> THEN (IF .L0 THEN EXITBLOCK; IF .L1 OR .LM1 THEN RETURN ZEROP(.X) ELSE EXITBLOCK) ELSE % LOGIC OPERATORS % IF .OPPTR EQL GAND<0,0> THEN (IF .L0 THEN RETURN ZEROP(.X); IF .LM1 THEN RETURN NOOP(.X); IF .NEGL THEN EXITBLOCK; IF .OPTOREG AND .LIT THEN EXITBLOCK; RETURN GLOGIC(0,.X,.Y)) ELSE IF .OPPTR EQL GOR<0,0> THEN (IF .L0 THEN RETURN NOOP(.X); IF .LM1 THEN RETURN ONESOP(.X); IF .NEGL THEN EXITBLOCK; IF .OPTOREG AND .LIT THEN EXITBLOCK; RETURN GLOGIC(1,.X,.Y)) ELSE IF .OPPTR EQL GXOR<0,0> OR (FLOP_(.OPPTR EQL GEQV<0,0>)) THEN (IF NOT .FLOP THEN IF .L0 THEN RETURN NOOP(.X); IF .FLOP THEN IF .LM1 THEN RETURN NOOP(.X); IF NOT .FLOP AND .LM1 OR .FLOP AND .L0 THEN RETURN GOTM(0,.X,.RESINREG,GNOT OR HUNARYM); IF .NEGL THEN EXITBLOCK; IF .OPTOREG AND .LIT THEN EXITBLOCK; RETURN GLOGIC(2+.FLOP,.X,.Y)) ELSE % ADD % IF .OPPTR EQL GADD<0,0> OR (FLOP_.OPPTR EQL GFADR<0,0>) THEN (IF .L0 THEN RETURN NOOP(.X); IF .NOTL THEN EXITBLOCK; IF .NEGL THEN IF .OPTOREG THEN (NOOP(.X); X_.X AND NOT NGNTM) ELSE (CODEPROP_0; RETURN CODEIT(.Y,.X, IF .FLOP THEN FSBRM ELSE SUBM)); IF .OPTOREG AND .LIT THEN (OPTOREG_.FLOP; EXITBLOCK); IF NOT .FLOP THEN IF .L1 OR .LM1 THEN RETURN CODECY(.X, IF .L1 THEN AOS ELSE SOS); CODEPROP_0; OPCODE_ IF .OPTOREG AND .NEGR THEN (Y_0; IF .FLOP THEN FSBRR+2 ELSE SUB+2) ELSE IF .FLOP THEN FADRM ELSE ADDM; RETURN CODEIT(.Y,.X,.OPCODE)) ELSE % SUB % IF .OPPTR EQL GSUB<0,0> OR (FLOP_.OPPTR EQL GFSBR<0,0>) THEN (IF .L0 THEN RETURN NOOP(.X); IF .NOTL THEN EXITBLOCK; IF .NEGL THEN IF .OPTOREG THEN (NOOP(.X); X_.X AND NOT NGNTM) ELSE (CODEPROP_0; RETURN CODEIT(GNEG(.Y),.X,IF .FLOP THEN FSBRM ELSE SUBM)); IF .OPTOREG AND .LIT THEN (OPTOREG_.FLOP; EXITBLOCK); IF NOT .FLOP THEN IF .L1 OR .LM1 THEN RETURN CODECY(.X,IF .L1 THEN SOS ELSE AOS); CODEPROP_0; OPCODE_ IF .OPTOREG AND .NEGR THEN (Y_0; IF .FLOP THEN FADRR+2 ELSE ADD+2) ELSE IF .OPTOREG THEN IF .FLOP THEN FSBRR+2 ELSE SUB+2 ELSE (Y_GNEG(.Y); IF .FLOP THEN FADRM ELSE ADDM); RETURN CODEIT(.Y,.X,.OPCODE)) ELSE EXITBLOCK % ALL OTHER BINARIES LEAVE FROM HERE % ELSE % UNARY OPERATORS % IF .OPPTR EQL GNEG<0,0> OR (FLOP_.OPPTR EQL GFNEG<0,0>) THEN (NONEGNOTL_1; IF .NEGL THEN RETURN NOOP(.X AND NOT NEGM); IF .NOTL AND .FLOP THEN EXITBLOCK; RETURN CODECY(.X,IF .NOTL THEN AOS ELSE MOVNS)) ELSE IF .OPPTR EQL GNOT<0,0> THEN (NONEGNOTL_1; IF .NOTL THEN RETURN NOOP(.X AND NOT NOTM); RETURN CODECY(.X,IF .NEGL THEN SOS ELSE (SETCMM+.RESINREG))); END; % EXITBLOCKS ABOVE COME HERE % IF .OPTOREG THEN ! NOW WE TRY TO OPTIMIZE REG_.REG OP EXP BEGIN REGLEX_.X AND (NGNTM OR RTEM); OPTTOREGADDR_.RT[.REGLEX]; REGLEX_GLPR(IF .UNOP THEN (@OPLEX)(.REGLEX) ELSE (@OPLEX)(.REGLEX,.Y),.OPTTOREGADDR); OPTTOREGADDR_-1; GTUPDATE(0,.REGLEX); RETURN .REGLEX END; ! SORRY CHARLIE! NO LUCK IF .X THEN INCRUSEN(.X); GSTO(IF .LEFTSIDEREG THEN .RT[.X] OR ZERO36 ELSE .X AND NOT (NEGM OR NOTM OR COPM), IF .OPLEX THEN (@OPLEX)(.X) ELSE (@OPLEX)(.X,.Y)) END; !END OF H2ARIT.BLI