Trailing-Edge
-
PDP-10 Archives
-
bb-m836c-bm_tops20_v6_1_tools
-
tools/blis10/ar2n.bli
There are 18 other files named ar2n.bli in the archive. Click here to see a list.
!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<P,S,X,I>.
! 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<RTEF> NEQ 0 THEN EXITBLOCK;
IF .Y<LSF> THEN IF STACKVARP(.Y<STEF>) THEN EXITBLOCK;
RETURN MPTRTYP(.P2^12 OR .S2^6 OR .I2^4 OR .X2,.Y)
END;
IF .Y<RTEF> 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<INDXF> 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<INDXF>
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<NGNTF> NEQ 0 THEN
RETURN (SESTOG_.SESTOG OR 2;GDOT(GLTR(.Y)));
IF .Y<COPF> THEN
BEGIN
CODE(LDB,R_ACQUIRE(-1,1),MEMORYA(.Y),0);
SESTOG_.SESTOG OR 2;
RETURN LEXRA(.R)
END;
IF .Y<POSNSIZEF> 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<STEF>) THEN
RETURN GDOT(LITLEXEME(VALPTRTYP(.Y<STEF>)));
PS_PSPTRTYP(.Y<STEF>);
IF NOT INDPTRTYPP(.Y<STEF>) 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<NGNTF> NEQ 0 THEN
RETURN (SESTOG_.SESTOG OR 2;GAT(GLTR(.X)));
IF .X<COPF> 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<STEF>) THEN
RETURN GAT(LITLEXEME(VALPTRTYP(.X<STEF>) AND RIGHTM));
RETURN LEXNPSD(LSSTEFPTRTYP(.X<STEF>),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<STEF>) THEN
RETURN GSLSH(LITLEXEME(VALPTRTYP(.Y<STEF>) AND IXYM));
IF NOT INDPTRTYPP(.Y<STEF>) THEN
RETURN LEXNPSD(MLEXFRPTRTYP(.Y<STEF>),0,36,1);
ADDRESS_MADDRFRPTRTYP(.Y)
END ELSE
IF .Y<RTEF> EQL 0 OR (.Y<COPF> AND (.YSAV<POSNSIZEF> EQL 36)) THEN
ADDRESS_MEMORYA(.YSAV OR DOTM)
ELSE
RETURN
BEGIN
Y_
IF .YSAV<COPF> 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<NGNTF> 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<POSNSIZEF>
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<NEGF>
NOTBIT=R<3,1>$, ! .Y<NOTF>
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<NEGF>;
NOTBIT_.Y<NOTF>;
Y_.Y AND NOT (NEGM OR NOTM);
NEGNOTMASK_0;
RTUPDATE_0;
INDIRMASK_0;
IF PTRTYPP(.X) THEN
BEGIN LOCAL PTR;
PTR_VALPTRTYP(.X<STEF>);
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<POSNSIZEF>_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<COPF> 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<POSNSIZEF> EQL 0) THEN .XVALUE<24,12> ELSE .X<POSNSIZEF>;
!!! 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<RIGHTF>;
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<RIGHTF>;
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<POSNSIZEF> EQL 18 OR
(YLHALF_.OLDY<POSNSIZEF> 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]<LEFTF> EQL 0 THEN
BEGIN
ADDRESS_.BITMASK[.I];
CASE .I OF SET TRZ;TRO TES
END ELSE
IF .BITMASK[.I]<RIGHTF> EQL 0 THEN
BEGIN
ADDRESS_.BITMASK[.I]<LEFTF>;
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]<DTF> THEN CLEARONE(RT[.ART[.REG]<RTEF>]);
CODEN(.OPCODE,.REG,.ADDRESS,2,
(X<POSNSIZEF>_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<RIGHTF> EQL 0)-4*(.VALUE<RIGHTF> 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<POSNSIZEF>;
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]<FCHAINF>) GEQ 16
THEN
IF (REG_.ART[19]<FCHAINF>) 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<RIGHTF> EQL 0 THEN (OPCODE_HRLZI;ADDRESS_.VALUE<LEFTF>) ELSE
IF .VALUE<RIGHTF> EQL 1^18-1 THEN (OPCODE_HRLOI; ADDRESS_.VALUE<LEFTF>)
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<P,S> 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<RTEF>]<ARTEF> EQL .OPTTOREGADDR THEN RETURN 0;
IF .RT[.Y<RTEF>]<ARTEF> EQL .OPTTOREGADDR THEN RETURN 1;
IF .RT[.X<RTEF>]<ARTEF> EQL .VREG THEN RETURN 0;
.RT[.Y<RTEF>]<ARTEF> 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<NEGF> XOR .Y<NEGF> 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]<RTEF>]);
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<NOTF> 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<NEGF>))$;
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<POSNSIZEF> 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<NEGF>) 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<STEF>)
END
ELSE 0) THEN
!X<0,0>+L
RETURN MPTRTYP(.YVALUE<LEFTF>,.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<NEGF> AND .X1<NEGF> THEN
RETURN GNEG(GAS(SLEX(.X),GABS(.X1),0));
RETURN GAS(IF .X<NEGF> THEN GNEG(SLEX(.X)) ELSE SLEX(.X),GABS(.X1),.X1<NEGF>)
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<RTEF>]<ARTEF> 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<LSSTEF>);
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<LSSTEF>); 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<STEF>,0]<TYPEF>;
YVALUE_(IF .TYPE NEQ EXTRNT THEN .ST[.X<STEF>,1]<OFFSETF> 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<RIGHTF>;
IF (1^EXTRNT OR 1^EXPRT)^(-.TYPE) THEN
BEGIN
NAME_(IF .TYPE EQL EXTRNT THEN .X<STEF>
ELSE .ST[.X<STEF>,1]<LEFTF>)^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]<LINKF>;
IF .STINDEX LSS 0 THEN
BEGIN
STINDEX_GETSPACE(1);
LINK_.EXPHT[.HASHVALUE];
EXPHT[.HASHVALUE]_.STINDEX;
ST[.STINDEX,0]_.LINK;
ST[.STINDEX,0]<TYPEF>_EXPRT;
ST[.STINDEX,1]_.NAME
END
END
ELSE
BEGIN
STINDEX_GETSPACE(1);
ST[.STINDEX,0]_.ST[.X<STEF>,0];
ST[.STINDEX,0]<BLF>_.BLOCKLEVEL;
ST[.STINDEX,0]<LINKF>_.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<RTEF>]<ARTEF>,.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<NEGF> AND .Y<NEGF> THEN
RETURN (RESTOREVTARGET; GREL(GABS(.X),GABS(.Y),.REVREL));
IF .X<NEGF> 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<COPF> EQL 0 THEN EXITCOMP 0;
%3.7% IF (LITV(.L<RIGHTF>) AND IXYM) GTR 15 THEN EXITCOMPOUND 0;
IF (.L<30,6> + .L<24,6>) GEQ 36 THEN EXITCOMPOUND 0;
IF .L<POSNSIZEF> 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<COPF> THEN IF FULLWORD(.Y) THEN IF READY(.Y) THEN
BEGIN
REG_LEXRA(ACQUIRE(-1,1)); ENTER(.REG<RTEF>,.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<SIZEF>-1)^.Y<POSNF>;
RETURN GBREL(.SAVVTARGET,
IF .TESTMASK<LEFTF> EQL 0 THEN
CASE .EQ OF SET TRNN;TRNE TES ELSE
IF .TESTMASK<RIGHTF> 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<LEFTF> * .TESTMASK<RIGHTF>) NEQ 0 THEN
LITA(LITLEXEME(.TESTMASK))
ELSE .TESTMASK)
END;
IF SMPOSLITVP(.V) THEN
BEGIN
IF .Y<NEGF> 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<RIGHTF> EQL 0) OR (.YVALUE<RIGHTF> EQL RIGHTM);
(.YVALUE AND RIGHTM) EQL 0 AND NOT STACKVARP(.X<STEF>);
0;
0 TES) ELSE 0) THEN
RETURN(
IF .F EQL 0 THEN
IF .YVALUE<RIGHTF> EQL 0 THEN (DULEX(.X);ZERO)
ELSE .X
ELSE MPTRTYP(.YVALUE<LEFTF>,.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<RTEF>]<ARTEF> 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<NEGF>
NEGR=R<7,1>$, ! .Y<NEGF>
NOTL=R<8,1>$, ! .X<NOTF>
NOTR=R<9,1>$, ! .Y<NOTF>
UNOP=R<10,1>$, ! UNARY OPERATOR
FLOP=R<11,1>$, ! FL. PT. OPERATOR
NONEGNOTL=R<12,1>$, ! .X<NEGF>=.X<NOTF>=0
NONEGNOTR=R<13,1>$, ! .Y<NEGF>=.Y<NOTF>=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<LEFTF>;
RESINREG<LEFTF>_0;
IF .GTINDEX NEQ 0 THEN
GT[.GTINDEX,0]<OCCF>_MAXER(.GT[.GTINDEX,0]<OCCF>-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<RTEF>]<ARTEF>) 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<RTEF>]<ARTEF>); ZERO);
LEX_CODECY(.LEX,SETZM+.RES);
IF .RES THEN DUN(.LEX<RTEF>); ZERO);
ROUTINE ONESOP(LEX)=
! CALLED TO STORE -1 INTO X
(NONEGNOTL_1;
IF .OPTOREG THEN
RETURN(R_LITLEXEME(-1);
GLPR(.R,.RT[.LEX<RTEF>]<ARTEF>);
.R);
LEX_CODECY(.LEX,SETOM+.RES);
IF .RES THEN DUN(.LEX<RTEF>); 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<RTEF>]<ARTEF>;
RES_1;
OPC_.OPC-2;
ADDRESS_MEMORYA(.NEWY)
END
ELSE
BEGIN
ACCUM_REGAK(GLAR(.NEWY));
RES_(.RES OR .CODEPROP);
IF (.ART[.ACCUM]<RTEF> LSS 16
OR .RT[.ART[.ACCUM]<RTEF>]<USEF> 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<ADDRESSF>))<0,0>;
IF .X<NEGF> THEN NEGL_1 ELSE IF .X<NOTF> THEN NOTL_1
ELSE NONEGNOTL_1;
IF NOT (UNOP_.OPLEX<HUNARY>) 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<NEGF> THEN NEGR_1 ELSE
IF .Y<NOTF> THEN NOTR_1 ELSE NONEGNOTR_1;
IF NOT .LEFTSIDEREG THEN X<POSNSIZEF>_36 ELSE
IF .X<DTF> 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<NEGF>_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<NEGF>_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<NEGF>_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<RTEF>]<ARTEF>;
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<DTF> THEN INCRUSEN(.X<RTEF>);
GSTO(IF .LEFTSIDEREG THEN .RT[.X<RTEF>]<ARTEF> OR ZERO36
ELSE .X AND NOT (NEGM OR NOTM OR COPM),
IF .OPLEX<HUNARY>
THEN (@OPLEX)(.X)
ELSE (@OPLEX)(.X,.Y))
END;
!END OF H2ARIT.BLI