! File: DELAY.BLI ! ! This work was supported by the Advanced Research ! Projects Agency of the Office of the Secretary of ! Defense (F44620-73-C-0074) and is monitored by the ! Air Force Office of Scientific Research. ! Module DELAY= Begin ! DELAY MODULE ! ------------ ! ! SEPT. 1972 ! WULF, WEINSTOCK, WILE, JOHN SSON ! LATER ADDITIONS: ! LEVERETT, KNUEVEN ! ! ! THIS MODULE DOES WHATEVER LOCAL OPTIMIZATION IS POSSIBLE BEFORE ! TEMPORARY NAME BINDING. IT ACCEPTS A TREE FROM THE SYNTAX/FLOWAN ! MODULES AND PASSES IT ON TO THE TNBIND MODULE. ! ! SOME OF ITS FUNCTIONS ARE: ! ! 1. TO INITIALIZE AREAS FOR TNBIND AND CODE. FOR EXAMPLE IT MAKES ! SURE THE "CODED" AND "BOUND" BITS ARE ZEROED. IT ALSO ! RELEASES LISTS USED FOR CODE MOTION OPTIMIZATION BY FLOWAN SO ! THAT SPACE IN A GT NODE CAN BE REUSED. ! ! 2. TO CALCULATE COMPLEXITIES AND DECIDE TARGETING FOR CODE AND ! TNBIND. THUS IT CALCULATES A CODESIZE COMPLEXITY AND ! A REGISTER USE COMPLEXITY. ! ! 3. TO USE THE MOST EFFICIENT ADDRESSING POSSIBLE TO EFFECT A ! SAVINGS IN OPERATIONS PERFORMED. THUS IF A IS A REGISTER, ! Z = .(.A+2); WILL GENERATE MOV 2(A),Z, AND Z = ..(.A+2); ! WILL GENERATE MOV @2(A),Z; ! IT IS DELAY WHO DETERMINES IF THIS IS POSSIBLE (THE CODE ! IS GENERATED IN "CODE"). ! ! 4. TO ELIMINATE UNNECESSARY OPERATIONS. FOR EXAMPLE: ! A = .A AND 0 BECOMES ! A = 0; ! NOTE: THE TREE REMAINS THE SAME, THE "AND" NODE IS SET UP ! TO INDICATE ITS RESULT IS ZERO. ! ! 5. TO CONVERT TO ROUTINE CALLS, THOSE BLISS OPERATIONS THAT ! ARE NOT DEFINED ON A PDP-11 SUCH AS MULTIPLY AND DIVIDE. ! THIS IS DONE ONLY IN THE CASE WHERE THE OPERATION IS NEEDED ! (SEE #4). ! ! ! THE MODULE IS ENTERED BY A CALL ON ROUTINE DELAY. THE PARAMETER ! PASSED IS CALLED A REQUEST WORD (SEE THE REQUEST WORD FIELD DEFINITIONS ! IN THE BODY OF THE MODULE BELOW). ! ! INFORMATION INCLUDED IS: ! ! A. THE ADDRESS OF THE NODE TO BE DELAYED. ! ! B. THE WAY IN WHICH THE RESULT WILL BE USED. (IF ITS A CSE-PARENT ! IT MUST END UP IN A TEMP. IF ITS ON THE LEFT OF A STORE, ! WE ARE USING IT AS AN ADDRESS, ON THE RIGHT AS AN OPERAND). ! ! C. WHAT KIND OF VALUE DO WE NEED. (IF ITS THE "DO" PART OF A ! LOOP, NO VALUE IS NEEDED. IF ITS THE BOOLEAN OF AN "IF" WE NEED ! CONTROL FLOW ONLY. IF ITS THE RIGHT SIDE OF A STORE WE NEED A ! REAL VALUE). ! ! D. MUST THE RESULT BE POSITIVE, OR ARE WE PREPARED TO HANDLE THE ! NEG BIT. ! ! E. MUST THE RESULT BE UNCOMPLEMENTED, OR ARE WE PREPARED TO HANDLE THE ! NOT BIT. ! ! ! THE ROUTINE DELAY PASSES THIS INFORMATION TO THE APPROPRIATE DELAYER ! WITH THE POSSIBLE EXCEPTION OF THE INFORMATION DESCRIBED IN "B" ABOVE. ! THIS INFORMATION IT HANDLES ITSELF UNLESS IT SPECIFIED OPERAND. ! ! EACH OF THE DELAYERS DOES WHAT IT CAN WITH A NODE (INCLUDING ! CALLING DELAY ON EACH OF ITS SUB-NODES) AND RETURNS A RESULT WORD. ! (SEE FIELD INFORMATION IN "DTC.BEG"). ! ! INFORMATION IN THE RESULT WORD INCLUDES: ! ! A. IS THE RESULT A REAL VALUE OR CONTROL FLOW. ! ! B. IS IT A LITERAL. ! ! C. IF ITS A LITERAL, IS ITS VALUE ONE OF THE INTERESTING ! LITERAL CASES. ! ! D. WHAT KIND OF POSITION AND SIZE FIELD IS ASSOCIATED WITH ! THE NODE. ! ! E. SHOULD THE RESULT BE INTERPRETED AS AN IMMEDIATE VALUE. ! ! F. DOES THE NODE INVOLVE A DESTROYABLE TEMPRORARY. ! ! G. IS THE INFORMATION IN THE NODE REALLY THE NEGATIVE ! (COMPLEMENT) OF THE REAL RESULT. ! ! ! AFTER A DELAYER CALLS DELAY ON ITS SUB-NODES, IT CAN WORK WITH THE ! RESULTS BEFORE RETURNING. IF IT DETERMINES A CONDITION THAT IT IS ! UNABLE TO HANDLE, IT CAN CALL THE ROUTINE "LOADNODE" TO FORCE ! WHAT IT HAS INTO A REGISTER. THIS HAS THE RESULT OF GUARANTEEING ! THE PERFORMANCE OF ALL OUTSTANDING NEGATES OR ! COMPLEMENTS ON THE NODE. ! ! WHEN THE FIRST CALL ON DELAY IS RETURNED FROM, NO FURTHER CLEANUP IS ! NECESSARY BEFORE CALLING TNBIND. Require 'Bliss'; ! ! THE "rq_fields" CONTROL THE DELAYING DESIRED FOR A NODE. THE ! DELAY ROUTINE PARAMETER "NODESW" IS MAPPED WITH THE LEXEME ! STRUCTURE TO GO WITH THESE FIELDS. ! ! A. TO TEST THE CURRENT NODE FOR A PARTICULAR CONTROL REQUEST, ! USE THE CONSTANT WITH THE SUFFIX "R" (FOR REQUESTED); E. G. ! FOR OPERAND, USE REQ_OPERAND. ! ! B. TO SET THE REQUESTED CONTROL FIELDS (ON THE WAY DOWN), USE ! THE CONSTANT SUFFIXED BY "K", ADDED TO THE LEXEME; E. G. ! LDELAY(FLD_K_OPERAND+FLD_K_VAL_REAL+FLD_K_NEG_YES+FLD_K_NOT_NO). ! External FLSTK : Ref ITEM; Macro rq_fields = 48,16 %, rq_fld_mode = 57,2 %, ! CODE VALUE CONTROL rq_fld_type = 55,2 %, ! CODE VALUE TYPE (FLOW, REAL, NONE) rq_fld_neg = 53,2 %, ! NEG POS rq_fld_not = 51,2 %, ! NOT CONTROL rq_fld_op_mem = 49,2 %, ! OP-TO-MEM, CHOICE OF TARGET PATH rq_fld_want_lit = 48,1 %; ! FOR RESULT OF STORE NODE ! rq_fld_mode VALUES FIELDK(57,REF_ARBITRARY,0); ! PASSED BY +,- NODES TO BOTH OPNDS FIELDK(57,REF_OPERAND, 1); ! PASSED BY MOST NODES FIELDK(57,REF_ADDRESS, 2); ! PASSED BY DOT, POINTER, & STORE NODES ! (TO THEIR LEFT OPNDS) FIELDK(57,REF_TEMP, 3); ! PASSED TO LIST NODES IF CSE'S Literal rq_q_mode = 57; ! rq_fld_type VALUES FIELDK(55,VAL_REAL, 0); FIELDK(55,VAL_FLOW, 1); FIELDK(55,VAL_NONE, 3); Literal rq_q_type = 55; ! rq_fld_neg VALUES FIELDK(53,NEG_NONE, 0); FIELDK(53,NEG_YES, 1); FIELDK(53,NEG_MAYBE,2); FIELDK(53,NEG_NO, 3); ! rq_fld_not VALUES FIELDK(51,NOT_NONE, 0); FIELDK(51,NOT_YES, 1); FIELDK(51,NOT_MAYBE,2); FIELDK(51,NOT_NO, 3); ! NOPTM VALUES FIELDK(49,SWP_NONE, 0); FIELDK(49,SWP_NO, 1); FIELDK(49,SWP_YES, 2); ! WLIT VALUES FIELDK(48,WANTLIT,1); Literal rq_q_wantlit = 48; Literal rq_q_fields = 48; ! REQUEST MACROS Macro XREQ(VNAME) = (.NODE<%Name(FLD_Q_,VNAME),2> Eql VNAME) %, X1REQ(VNAME) = (.NODE<%Name(FLD_Q_,VNAME),1> Eql VNAME) %, REQ_REF_ARBITRARY= XREQ(REF_ARBITRARY) %, REQ_REF_ADDRESS = XREQ(REF_ADDRESS) %, REQ_REF_OPERAND = XREQ(REF_OPERAND) %, REQ_REF_TEMP = XREQ(REF_TEMP) %, REQ_VAL_FLOW = XREQ(VAL_FLOW) %, REQ_VAL_NONE = XREQ(VAL_NONE) %, REQ_VAL_REAL = XREQ(VAL_REAL) %, REQ_SWP_NONE = XREQ(SWP_NONE) %, REQ_SWP_NO = XREQ(SWP_NO) %, REQ_SWP_YES = XREQ(SWP_YES) %, REQ_NEG_YES = XREQ(NEG_YES) %, REQ_NEG_NO = XREQ(NEG_NO) %, REQ_NEG_MAYBE = XREQ(NEG_MAYBE) %, REQ_NEG_NONE = XREQ(NEG_NONE) %, REQ_NOT_YES = XREQ(NOT_YES) %, REQ_NOT_NO = XREQ(NOT_NO) %, REQ_NOT_MAYBE = XREQ(NOT_MAYBE) %, REQ_NOT_NONE = XREQ(NOT_NONE) %, REQ_WANTLIT = X1REQ(WANTLIT) %; ! MACROS TO SET THE RESULT WORD (STATE) IN THE CURRENT NODE Macro SET_REAL_FLOW(V)= NODE[rw_real_flow] = V %; ! MACROS TO TEST A RESULT WORD Macro ISLIT(XOP) = (.XOP And .XOP) %; ! MACROS TO COPY FIELDS FROM NODES AND RESULTS Macro CKFIELDS(OP) = .OP^RESULTPOS %; ! MACROS TO SET GT ENTRIES Macro M(V) = NODE[gt_mode] = V %, O(V) = NODE[gt_disp] = V %, P(POS,SIZ) = (NODE[gt_pos] = POS; NODE[gt_len] = SIZ) %, R(REG) = NODE[gt_reg] = REG %; ! ! THESE MACROS SIMPLIFY THE PROCESS OF DELAYING OPERANDS OF THE ! CURRENT NODE. 'KFLD' IS THE SET OF 'REQUEST WORD' FIELD VALUES ! WHICH ARE PASSED DOWN TO THE SUBNODE AT HAND. ! LDELAY DELAYS THE LEFT SUBNODE, PUTS RESULT WORD IN 'LOP' ! RDELAY DELAYS THE RIGHT SUBNODE, PUTS RESULT WORD IN 'ROP' ! UDELAY DELAYS THE ONLY SUBNODE, PUTS RESULT WORD IN 'UOP'. ! THE INTERFACE BETWEEN THESE THREE AND THE ACTUAL ROUTINE, 'DELAY', ! IS PROVIDED BY MACRO 'DLY'. NOTICE THAT IF THE RESULT WORD AFTER ! 'DELAY' INDICATES (BY ITS 'SLF' BIT) THAT ALTHOUGH A GT-NODE WAS ! DELAYED ITS RESULT WAS A LITERAL VALUE, DLY RETRIEVES THAT LITERAL ! AND PUTS IT IN THE DESIGNATED LOCAL (E.G. 'LOP'). ! AS AN EXAMPLE OF DLY EXPANSION, CONSIDER: ! DLY(LOP,NODE[gt_arg1],FLD_K_VAL_REAL+...) ! WHICH EXPANDS TO: ! (LOP = NODE[gt_arg1] = DELAY(FLD_K_VAL_REAL+...+.NODE[gt_arg1]); ! IF .LOP AND .LOP EQL GTTYP THEN ! LOP = CKFIELDS(LOP)+LEXOUT(LITTYP,.LOP[OFFSETF])) ! Macro LDELAY(KFLD) = DLY(LOP,NODE[gt_arg1],KFLD) %, RDELAY(KFLD) = DLY(ROP,NODE[gt_arg2],KFLD) %, UDELAY(KFLD) = DLY(UOP,NODE[gt_arg1],KFLD) %, DLY(PROG,NOD,CONT)= Begin PROG = .NOD; PROG = NOD = DELAY(CONT+.PROG); If .PROG And .PROG Eql T_NODE Then PROG = CKFIELDS(PROG)+ LEXOUT(T_LITERAL,.PROG[gt_disp_16]) End %; ! MACROS TO MODIFY GT ENTRIES IN "CANONICAL" WAYS. Macro ADDORSUB(NODE)=ONEOF(.GT[NODE,gt_code],OP_ADD,OP_SUB) %; ! ! FUNCTION: ! VALID ONLY FOR A LEXEME WHOSE 'SLF' BIT IS ON; GET THE ! LITERAL VALUE WHICH 'LEX' REPRESENTS. ! Macro CLITVALUE(LEX)= Begin If .LEX Eql T_LITERAL Then .LEX Else .LEX[gt_disp_16] End %; ! ! FUNCTION: ! THIS MACRO, CALLED BY ALMOST ALL THE NODE-SPECIFIC DELAYERS, ! SETS VARIOUS FIELDS IN THE NODE TO 'DEFAULT' VALUES BEFORE ! THE DELAYER STARTS TO DO ITS THING TO THOSE FIELDS. ALSO ! SEE ABOVE, 'MACROS TO SET GT ENTRIES'. ! Macro DEFAULTFIELDVALUES= Begin M(GENREG); P(0,16); R(0); O(0); SETRES(FLD_K_RFREAL+FLD_K_PFNONE); NODE[gt_ru_compl] = 0; NODE[gt_cs_compl] = 0; NODE[CXBITS] = 0; NODE[rc_operate] = TRUE End %; ! ! FUNCTION: ! MAKE SURE THAT VARIOUS OPERANDS OF CONTROL NODES (IF NODES, ! LOOP NODES) ARE GT-NODES, BECAUSE ONLY A GT-NODE HAS AN ASSOCIATED ! 'LABELF' FIELD AND A 'NODE LABEL' AS USED IN CODE GENERATION. ! Macro FIXCOND(WOP)= Begin Local XOP : Ref GT; XOP = .WOP; If .XOP Neq T_NODE Then Begin Local T : Ref GT; T = .XOP; XOP = WOP = LOADNODE(.XOP); If REQ_VAL_FLOW Then Begin COPYRESULT(.XOP,.T); WOP = STATEMAKE(.WOP); XOP[rc_mov_target] = FALSE; XOP[rw_real_flow] = RFFLOW End Else If REQ_VAL_NONE Then XOP[rw_real_flow] = RFNONE Else XOP[rw_real_flow] = RFREAL; XOP[gt_v_mustgencode] = TRUE End; .XOP End %; ! ! FUNCTION: ! CHANGE THE CURRENT REQUEST WORD TO GET A 'TEMP' rq_fld_mode REQUEST, WITH ! ASSOCIATED rq_fld_type, rq_fld_neg, AND rq_fld_not VALUES. ! Macro FORCETEMP = NODE = .NODE +FLD_K_REF_TEMP +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO %; ! ! FUNCTION: ! DELAYS THE LITERAL VALUE OF THE CURRENT NODE (IN ITS ! 'OFFSETF' FIELD) AND SETS ITS STATEWORD INFO ACCORDINGLY. ! Macro LITRESULT=SETRES(DELAY( LITLEXEME(.NODE[gt_disp_16]) +FLD_K_REF_ARBITRARY +FLD_K_VAL_REAL +FLD_K_NOT_NO +FLD_K_NEG_NO)) %; ! ! FUNCTION: ! DETERMINE (FOR +,- NODE) WHETHER BOTH OF THESE ARE TRUE: ! (1) ONE OF ITS OPERANDS ('XOP') IS LITERAL +-2 ! (2) THE SIGN OF THAT OPERAND IS OPPOSITE THE SIGN OF THE ! OTHER OPERAND. ! Macro MINUS2(POSORNEG,XOP)= Begin Local X : Integer; X = CLITVALUE(XOP); If POSORNEG Then X = -.X; .X Eql -2 End %; Macro NEGATEOFFSET=O(-.NODE[gt_disp_16]) %; Macro NORESULTCHECK=(If REQ_VAL_NONE Then FLD_K_VAL_NONE Else FLD_K_VAL_REAL) %; Macro NORESULTSET= Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE); NODE[gt_cs_compl] = CALCCSCOMPL(.NODE) End %; ! ! FUNCTION: ! THIS MACRO IS CALLED BY MANY NODE-SPECIFIC DELAYERS JUST AFTER ! 'DEFAULTFIELDVALUES'. THE IDEA IS THAT IF THE rq_fld_type REQUEST IS ! FOR 'VAL_NONE', E.G. THE CURRENT NODE IS THE 'DO' PART OF A ! WHILE-DO NODE, MOST OF THE ACTIONS OF THAT DELAYER ARE SKIPPED: ! A FEW NECESSARY FIELDS ARE FILLED, THEN 'RETURN' IS EXECUTED. ! Macro NORESULTRET= If REQ_VAL_NONE Then Begin NORESULTSET; Return STATEMAKE(.NODE) End %; Macro OFFNEG(XOP)=(Bind X = XOP; X = 0) %; Macro OFFNOT(XOP)=(Bind X = XOP; X = 0) %; Macro ONEUSE(N)=(.GT[.GT[.N,gt_csparent],gt_occ] Eql 1) %; Macro OTHEROP(NODEX1,NODEX2)=(.NODE[gt_code] Xor (NODEX1 Xor NODEX2)) %; ! ! FUNCTION: ! DETERMINE IF X IS A POWER OF 2 OR NOT. ! NOTE THAT X IS PRESUMED TO BE POSITIVE OR ZERO. ! Macro POF2(X)=((X And (-X)) Eql X) %; Macro SETCONTROL=NODE[gt_v_ctl_or_cse] = TRUE %; ! ! SETTLE CONFLICT ! ! FUNCTION: RESOLVE A CONFLICT BETWEEN A NEG OR NOT ! REQUEST FROM THE ANCESTOR NODE, AND THE ! CURRENT NODE'S NEG OR NOT CONDITION, ! BY CALLING LOADNODE IF NECESSARY. ! Macro SETLCONF(REQST,STATEBIT,RESULT) = Begin If (REQST) And (STATEBIT) Then LOADNODE(RESULT) Else (RESULT) End %; ! ! FUNCTION: ! STORE THE RESULT-WORD-FIELDS OF WORD 'N' IN THE ! STATEWORD OF THE CURRENT NODE. ! Macro SETRES(N) = (NODE[NRWORDF] = (N)^(-RESULTPOS)) %; ! ! FUNCTION: ! THE EQUIVALENT OF 'SETRESULT' GIVEN A LITERAL LEXEME ! Macro SETRESULTLIT(V)= Begin O(V); R(PC); M(ABSOLUTE); P(0,16); LITRESULT End %; ! ! FUNCTION: ! INTERCHANGE THE LEFT-RIGHT RELATIONSHIP OF THE TWO OPERANDS ! OF THE CURRENT (BINARY OPERATOR) NODE. SWAPS THE LEXEMES ! IN THE GT-NODE AND THE LOCAL RESULT WORDS 'LOP' AND 'ROP'; ! ALSO FLIPS THE TPATH BIT. ! Macro SWAPOP=(SWAP(LOP,ROP); SWAP(NODE[gt_arg1],NODE[gt_arg2]); XTPATH) %; Macro XTPATH=(NODE[gt_v_tpath] = .NODE[gt_v_tpath] Xor 1) %; ! ! FUNCTION: ! PREDICATES TO DETERMINE IF 'NODE' WAS A CSE OR CSE PARENT THAT ! WAS UNDONE (BY ROUTINE UNDOCSE). THEY ARE NOT FOOLPROOF (THEY ! WOULD BE TRIPPED UP BY BOGUS-NODE SITUATIONS), BUT IN THE ! CONTEXTS IN WHICH THEY ARE CALLED (SEE PCSEDOT AND UNDOCSE), ! THIS IS NOT A PROBLEM. ! Macro UNDONE(NODE)=(.NODE[gt_csparent] Neq .NODE And ONEUSE(NODE)) %, UNDONEPARENT(NODE)=(.NODE[gt_csthread] Neq 0 And .GT[.NODE[gt_csthread],gt_v_mustgencode]) %; ! DADD TYPES--MAY BE USEFUL FOR MULTIPLY AND SHIFT. SEE ! ADDCLASS ROUTINE BELOW. Literal ADD_L = 0, ! LITERAL ADD_NR = 1, ! RELOCATABLE NAME ADD_T = 2, ! .TEMP OR .X ADD_TL = 3, ! .TEMP + LITERAL ADD_NT = 4, ! LOCAL OR OWN AND PIC NAMES ADD_TNR = 5; ! .TEMP + RELOCATABLE NAME Forward Routine ADDAN, ADDCLASS, CALCCSCOMPL, CKDISTMULT, COMPLICATED, COPYAROUND : Novalue, COPYRESULT : Novalue, DADD, DANDOR, DCALL, DCASE, DCOMP, DDO, DDOT, DELAY, DEFERIT, DEQVXOR, DFTYPE, DBUILTIN, DIF, DINCR, DLABEL, DLEAVE, DLIT, DMAXMIN, DDIVMOD, DMUL, DNEG, DNOT, DFAKECSE, DLOADNODE, DPOINTER, DREL, DROTSHIFT, DROUT, DSELECT, DSTORE, DSWAB, DSYM, DWU, EQLPOSSIZE, ISOPTOMEM, XLOADNODE, LOADNODE, MAKEROUTINE, NEGLIT, OPCOMPL, PCSEDOT, PULSEDELAY : Novalue, SELECTEVALORDER, STATEMAKE, UNDOCSE, UNLINKCSE : Novalue; ! attempt to add/subtract two lexemes Routine ADDAN(LAN : Ref GT,RAN : Ref GT) = Begin Local N : Integer; If .RAN Eql T_LITERAL Then Begin If .RAN Then RAN = LITLEXEME(-.RAN); ! L+L If .LAN Eql T_LITERAL Then Begin N = .LAN; Return LITLEXEME(.RAN + (If .LAN Then -.N Else .N)) End; ! X+0 If .RAN Eql 0 Then Return .LAN; ! N+L OR -N+L ! -N+L => -(N-L) If .LAN Then Return FLD_K_KNEG+ADDAN(.LAN,FLD_K_KNEG+.RAN); ! not allowed to do address calculations with stack variables ! which may potentially be placed in a register. the user should ! give it a structure size other than 2 to work. If .LAN[gt_type] Eql S_LOCAL And .LAN[gt_reg] Gequ 8 Then WARNEM(0,WALOCERR); Return CREATESWO(.LAN,.RAN) End; ! X+N, X-N ! L+N => N+L If .LAN Eql T_LITERAL Then Return ADDAN(.RAN,.LAN); ! N+N, N-N, -N+N, -N-N If .LAN Eql .RAN Then Return 0; ! N-N, -N+N If .LAN Then SWAP(LAN,RAN); ! N-N ! this check should someday examine the base psect of the symbols If BASESYM(.LAN) Neq BASESYM(.RAN) Then Return 0; Return LITLEXEME(.LAN[gt_disp_16]-.RAN[gt_disp_16]) End; Routine ADDCLASS(NODE : Ref GT) = ! Begin ! literal => ADD_L If .NODE Eql T_LITERAL Then Return ADD_L; ! symbol => nasty T or N If .NODE Eql T_SYMBOL Then Return (If .NODE[gt_mode] Eql INDEXED Then ADD_NT Else ADD_NR); If .NODE Neq T_NODE Then PUNT(ERINVLEXT); ! address or R => T If Not .NODE[rw_immediate] Or .NODE[gt_mode] Eql GENREG Then Return ADD_T; If .NODE[gt_mode] Neq INDEXED Then PUNT(ERINVMODE); ! if nasty T If .NODE[gt_reg] Neq 0 Then Return ADD_NT; ! if T + N If .NODE[gt_v_symoff] Then Return ADD_TNR; ! if T + L Return ADD_TL End; ! ! FUNCTION: ! COMPUTE A MEASURE OF THE 'CODE SIZE COMPLEXITY' ! OF THE CURRENT NODE. ! SPECIFICS: ! COMPUTE A COMPLEXITY FOR THE OPERATOR ITSELF, ! THEN ADD IN THE CSCOMPL'S OF ALL THE OPERANDS. ! Routine CALCCSCOMPL(NODE : Ref ST) = Begin Local UOP : Ref GT, CSIZE : Integer; CSIZE = OPCOMPL(.NODE);; Incr I From 0 To .NODE[gt_argc]-1 Do Begin UOP = .NODE[gt_argv(.I)]; If .UOP Eql T_NODE Then CSIZE = .CSIZE+.UOP[gt_cs_compl] End; Return .CSIZE End; ! test whether a given node is suitable for distributed multiply. ! called by DMUL, DDIVMOD and DSHIFTROT. Routine CKDISTMULT(NODE : Ref GT,COMMUTES) = Begin Local LOP : Ref GT, ROP : Ref GT; ! only if requested by delayer of ADD/SUB If Not REQ_REF_ARBITRARY Then Return FALSE; ! get the operands and try to move literals to the RHS LOP = .NODE[gt_arg1]; ROP = .NODE[gt_arg2]; If .COMMUTES And .LOP Eql T_LITERAL And .ROP Eql T_NODE Then SWAPOP; ! looks distributed if of the form X+L If .LOP Neq T_NODE Or .ROP Neq T_LITERAL Then Return FALSE; Return TRUE End; Routine COMPLICATED(NODE : Ref GT,SAFE : Ref GT,LEFT_SIDE : Boolean) = Begin Local UOP : Ref GT; Bind COMPPLIT = Uplit Byte ( 0, ! R 1, ! @R 2, ! (R)+ - only for R = PC 3, ! @(R)+ - only for R = PC 10, ! -(R) - can't happen anyhow 10, ! @-(R) - can't happen anyhow 3, ! n(R) 4 ! @n(R) ) : Vector[,Byte]; Macro ISNOTCOMPLICATED= If .NODE Eql T_LITERAL Then If .NODE Eql 0 Then 0 Else 2 Else .COMPPLIT[.NODE[gt_mode]] %, MAYBECOMPLICATED= If .NODE[gt_code] Leq MAXOPERATOR And .NODE[rw_ptr_state] Leq PF016 Then .COMPPLIT[.NODE[gt_mode]] Else ISCOMPLICATED %; Literal ISCOMPLICATED=10; ! anything to do with bit fields is complicated If .NODE Gtr PF016 Then Return ISCOMPLICATED; ! a literal on the LHS is complicated. may usually mean a device port If .NODE Eql T_LITERAL And .LEFT_SIDE Then Return ISCOMPLICATED; ! literal and symbol addresses are not If .NODE Neq T_NODE Then Return ISNOTCOMPLICATED; ! if a name-cse then return whether the name is complicated UOP = .NODE[gt_reg]; If .NODE[gt_code] Eql OP_FAKE_CSE Or .NODE[gt_code] Eql OP_LOAD_NODE Then If .UOP Gequ 8 And .UOP[tn_type] Eql BNDNCSE Then Return COMPLICATED( LEXOUT(T_SYMBOL,.UOP[gt_disp]),.SAFE,.LEFT_SIDE); ! if not a '.' node then it just depends on the mode and whether ! it is an operator or bit-field If .NODE[gt_code] Neq OP_DOT Then Return MAYBECOMPLICATED; ! if the '.' of a literal or symbol then it's not complicated UOP = .NODE[gt_arg1]; If .UOP Neq T_NODE Then Return ISNOTCOMPLICATED; ! '.' on left side or not '..' on RHS is based only on mode, operator If .LEFT_SIDE Or .UOP[gt_code] Neq OP_DOT Then Return MAYBECOMPLICATED; ! if '..' of an expression or '..' of the LHS (e.g. X = ..X) then ! it's complicated UOP = .UOP[gt_arg1]; If .UOP Eql T_NODE Or .UOP Eql .SAFE Then Return ISCOMPLICATED; ! we have '..' of a literal or a symbol Return ISNOTCOMPLICATED End; Routine COPYAROUND(NODE : Ref GT,DNODE : Ref GT) : Novalue = Begin Local I : Ref GT; If .NODE[gt_v_delayed] Then Return; DNODE[gt_v_delayed] = TRUE; NODE[gt_v_delayed] = TRUE; If ISCSECREATION(NODE) Then Begin NODE[gt_v_ctl_or_cse] = TRUE; NODE[rw_destroyable] = FALSE; NODE = .NODE[gt_csparent]; I = .NODE[gt_csthread]; Until .I Eqla 0 Do Begin If Not .I[gt_v_mustgencode] Then Begin I[gt_state] = 0; I[DELAYBITS] = 0; COPYRESULT(.I,.DNODE[NRWORDF]^RESULTPOS+.DNODE); I[gt_v_ctl_or_cse] = FALSE; I[gt_v_delayed] = TRUE End; I[gt_v_add_copied] = .DNODE[gt_v_add_copied]; I = .I[gt_csthread] End End End; ! ! FUNCTION: SEE MACRO 'SETRESULT' ! Routine COPYRESULT(XNODE : Ref GT,XOP : Ref GT) : Novalue = Begin Local SWRD : Integer, NODE : Ref GT; NODE = .XNODE; If .XOP Then Begin SETRESULTLIT(.XOP); Return End; If .XOP Eql T_SYMBOL Then Begin NODE[gt_disp] = .XOP; NODE[gt_v_symoff] = TRUE End Else If .XOP[gt_mode] Neq GENREG+DEFERRED Then Begin NODE[gt_disp] = .XOP[gt_disp]; NODE[gt_v_symoff] = .XOP[gt_v_symoff] End; If .XOP Eql T_SYMBOL Then SWRD = .XOP Else SWRD = .XOP[gt_state]; SWRD = .NODE[rw_complemented] Xor .SWRD; SWRD = .NODE[rw_negated] Xor .SWRD; SWRD = .NODE[rw_real_flow]; SWRD = .SWRD And .NODE[rw_destroyable]; NODE[gt_state] = .SWRD; NODE[gt_v_copied] = TRUE; If .XOP Eql T_SYMBOL Then Begin NODE[gt_ru_compl] = 0; NODE[gt_cs_compl] = 0 End Else Begin NODE[gt_ru_compl] = .XOP[gt_ru_compl]; NODE[gt_cs_compl] = .XOP[gt_cs_compl] End; NODE[gt_v_ctl_or_cse] = .XOP[gt_v_ctl_or_cse] Or ISCSECREATION(NODE); P(.XOP[gt_pos],.XOP[gt_len]); R(.XOP[gt_reg]); M(.XOP[gt_mode]) End; ! DECLARATIONS AND SUPPORT ROUTINES FOR GENERATING ! LOADS FOR NAMES USED AS CSE'S. Macro NOGETFAKE = INENABLE = .INENABLE+1 %, OKGETFAKE = INENABLE = .INENABLE-1 %, NOGETLOAD = GETLCNT = .GETLCNT+1 %, OKGETLOAD = GETLCNT = .GETLCNT-1 %; ! ! CREATE AN NCSE USE. ! ! notes: ! an NCSE is a tempname which holds the address of a symbol. ! if enough registers are available (as determined by TNBIND) ! then this address is kept in a register which can save ! words. This routine creates a reference to the OP_LOAD ! node created by an earlier GETLOAD call. ! ! called by FINDNCSE in NCSE.BLI Global Routine GETFAKE(N : Ref GT) = Begin Local NODE : Ref GT; NODE = FASTLEXOUT(T_NODE,GETSPACE(SZ_NODE)); MOVECORE(.N,.NODE,SZ_NODE); NODE[gt_code] = OP_FAKE_CSE; NODE[gt_argc] = 0; NODE[gt_csparent] = .N; NODE[gt_csthread] = .N[gt_csthread]; N[gt_csthread] = .NODE; N[gt_occ] = .N[gt_occ]+1; Return STATEMAKE(.NODE) End; ! ! CREATE AN NCSE PARENT. ALSO, GIVE IT A TEMP NAME ! AND MARK THE TN 'REGISTER OR FORGET IT'. ! ! notes: ! this routine is called by GETNCSE on the first reference ! to a symbol deemed to be NCSE candidate. Given a ! symbol lexeme, it wraps it in an OP_LOAD node and ! attaches an NCSE tempname to it. Global Routine GETLOAD(N : Ref GT,L) = Begin Local NODE : Ref GT, T : Ref GT; NODE = XLOADNODE(.N Or FLD_K_IMM); NODE[gt_cs_compl] = 1; T = NODE[gt_reg] = GETTN(); T[tn_request] = RFREQDB; T[tn_type] = BNDNCSE; T[gt_disp] = .N; NODE[gt_mode] = INDEXED; NODE[gt_v_ctl_or_cse] = TRUE; NODE[rw_destroyable] = FALSE; NODE[gt_len] = .N[gt_len]; NODE[gt_depth] = -1; NODE[rc_mov_target] = TRUE; Return STATEMAKE(.NODE) End; ! delayer for ADD and SUB Routine DADD(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, LAN : Ref GT, RAN : Ref GT, WCSE : Integer, CODET : Integer, LTYPE : Integer, RTYPE : Integer, CXB : Integer, SUBTRACT : Boolean, SUM : Ref GT; Label aaa; Bind CAP = Uplit Byte ( ! A B 0, 4, 12, 2, 8,14,12,10, ! 0 0 0, 4, 6, 2, 0, 4,12, 2, ! 0 1 0, 14, 6, 2, 8,14,12,10, ! 1 0 0, 4, 6, 2, 0,14, 6, 2, ! 1 1 0, 4, 12, 2, 8,14,12,10, ! 2 0 0, 4, 6, 2, 0, 4,12, 2, ! 2 1 0, 4, 12, 5, 8, 9,12,13, ! 3 0 0, 4, 1, 5, 0, 4,12, 5 ! 3 1 ) : Vector[,Byte]; ! a = node ! b = lop ! c = rop and REQ_SWP_NO ! d = lop ! e = rop Macro cx_neg = 0,1 %, cx_negated = 1,1 %, cx_sub = 2,1 %, cx_swap = 3,1 %, C5(A,B,C,D,E) = ((A)^4 + (B)^3 + (C)^2 + (D)^1 + (E)) %, SWAPALL= Begin SWAP(LOP,ROP); SWAP(LTYPE,RTYPE); SWAP(NODE[gt_arg1],NODE[gt_arg2]) End %, ! TRUE if LOP is not indexable either because: ! ! it can't possibly be a register ! ! it's not <0,16> ! ! it's not destroyable and we either want address arithmetic ! or it needs its own tempname. TNOTINDEX= Begin If .LOP[gt_mode] Neq GENREG Or .LOP Gtr PF016 Then TRUE Else Not .LOP And (REQ_REF_OPERAND Or REQ_REF_TEMP) End %; ! if there are many uses of this node then force it to be a tempname If ISLARGECSE(NODE) Then Begin FORCETEMP; WCSE = -1 End Else If Not REQ_REF_OPERAND Then WCSE = 1 Else WCSE = 0; ! if one operand of the current node is a gt-node while the other ! is not (e.g. a literal or symbol) then make sure that if the ! gt-node operand is a cse that its cse-chain will not be undone. If .WCSE Gtr 0 And Not .NODE[gt_v_dont_unlink] Then Begin LOP = .NODE[gt_arg1]; ROP = .NODE[gt_arg2]; ! LOP is a node and ROP is not If .LOP Eql T_NODE Then Begin If .ROP Neq T_NODE Then Begin UOP = .LOP[gt_csparent]; UOP[gt_v_dont_unlink] = .UOP[gt_code] Leq MAXOPERATOR End End ! ROP is a node and LOP is not Else If .ROP Eql T_NODE Then Begin UOP = .ROP[gt_csparent]; UOP[gt_v_dont_unlink] = .UOP[gt_code] Leq MAXOPERATOR End End; ! temporarily change subtracts to adds If .NODE[gt_code] Eql OP_SUB Then Begin NODE[gt_code] = OP_ADD; SUBTRACT = TRUE End Else SUBTRACT = FALSE; ! delay the operands. prefer the left side negative if the caller ! wants it negative otherwise we don't care. prefer the right side ! negative if the caller wants the result negative and it looks like ! a reverse subtract would work. CODET = NORESULTCHECK; LDELAY(.CODET +FLD_K_NOT_NO +FLD_K_REF_ARBITRARY +(If REQ_NEG_YES Then FLD_K_NEG_YES Else FLD_K_NEG_NONE)); RDELAY(.CODET +FLD_K_NOT_NO +FLD_K_REF_ARBITRARY +(If REQ_NEG_YES And Not .LOP Then FLD_K_NEG_YES Else FLD_K_NEG_NONE)); NORESULTRET; ! L - R => L + (-R) ROP = .ROP Xor .SUBTRACT; LTYPE = ADDCLASS(.LOP); RTYPE = ADDCLASS(.ROP); ! COMPLEX OPERAND ON THE LEFT--ALWAYS THE TARGET ! if both are tempnames then secondary key is addressing mode If .LTYPE Lss .RTYPE Or (.LTYPE Eql .RTYPE And .LTYPE Eql ADD_T And .LOP[gt_mode] Neq GENREG And .ROP[gt_mode] Eql GENREG) Then Begin SWAPALL; NODE = ( If REQ_SWP_NO Then SWP_YES Else If REQ_SWP_YES Then SWP_NO Else SWP_NONE) End; If ONEOF(.LTYPE,ADD_NT,ADD_TNR) And ONEOF(.RTYPE,ADD_NT,ADD_TNR,ADD_NR) Then Begin NODE[gt_arg1] = LOP = XLOADNODE(.LOP); LTYPE = ADD_T; ! if ADD_NT or ADD_TNR If .RTYPE Geq ADD_NT Then SWAPALL End; ! get the literal associated with the left and right types Case .LTYPE From 0 To 5 Of Set [ADD_L]: LAN = .LOP; [ADD_NR]: LAN = .LOP; [ADD_T]: LAN = ZERO; [ADD_TL]: LAN = LITLEXEME(.LOP[gt_disp_16]); [ADD_NT]: LAN = .LOP; [ADD_TNR]: LAN = LEXOUT(T_SYMBOL,.LOP[gt_disp]) Tes; Case .RTYPE From 0 To 5 Of Set [ADD_L]: RAN = .ROP; [ADD_NR]: RAN = .ROP; [ADD_T]: RAN = ZERO; [ADD_TL]: RAN = LITLEXEME(.ROP[gt_disp_16]); [ADD_NT]: RAN = .ROP; [ADD_TNR]: RAN = LEXOUT(T_SYMBOL,.ROP[gt_disp]) Tes; ! note whether the values are negated. LAN = .LOP; RAN = .ROP; ! try to sum together the constant parts SUM = ADDAN(.LAN,.RAN); If .SUM Eql 0 Then UOP = .ROP Else UOP = .SUM; NODE[gt_disp] = .UOP; NODE[gt_v_symoff] = (.UOP Eql T_SYMBOL); If .NODE[gt_v_symoff] And .UOP[gt_mode] Eql INDEXED Then Begin NODE[gt_mode] = INDEXED; R(.UOP[gt_reg]) End; ! this code makes it easier for final to find auto-increment ! operations by special casing the form 'T +/- 2' If .LTYPE Eql ADD_T And .RTYPE Eql ADD_L Then If MINUS2((.LOP Xor .ROP),ROP) Then If Not TNOTINDEX Then If .LOP Then Begin WCSE = 0; FORCETEMP End; If .RTYPE Leq ADD_NR Then aaa: Begin If .WCSE Gtr 0 Then Begin UNDOCSE(.NODE); If .LOP Eql T_NODE Then LOP = .LOP[rw_destroyable] End; ! delay cases NODE[CXBITS] = 0; ! X + 0 => X If ISLIT(ROP) And .ROP Eql 0 Then Begin COPYRESULT(.NODE,.LOP); NODE[rw_immediate] = 0; NODE[gt_v_add_copied] = TRUE; Leave aaa End; If .RTYPE Eql ADD_L Then Case .LTYPE From 0 To 5 Of Set [ADD_L]: ! L +- L Begin M(ABSOLUTE); LITRESULT End; [ADD_NR]: ! +-NR + L ! if -(N - L) commit the changes If .SUM And REQ_NEG_NO Then Begin NODE[rc_mov_offset] = TRUE; NODE[rc_negate] = TRUE End Else Begin M(ABSOLUTE); SETRES(.SUM) End; [ADD_T]: ! +-.T + L Begin M(INDEXED); If TNOTINDEX Then NODE[rc_mov_target] = TRUE; ! if of the form '-.T + L' If .LOP Then Begin ! if the caller cannot tolerate negated results If Not REQ_NEG_NO Then Begin NODE[rw_negated] = TRUE; NEGATEOFFSET End ! if a value was asked for, generate: MOV #L,Rm \ SUB T,Rm' Else If REQ_REF_OPERAND And Not REQ_SWP_NO Then Begin NODE[rc_operate] = TRUE; M(GENREG); XTPATH; NODE[rc_mov_offset] = TRUE; NODE[gt_code] = OP_SUB End Else Begin NODE[rc_mov_target] = TRUE; NODE[rc_negate] = TRUE End End End; [ADD_TL]: ! +-(.T+L) + L Begin M(INDEXED); ! if of the form: -.T + L then either generate code or ! change to -(.T - L) If .LOP Then If REQ_NEG_NO Then (NODE[rc_mov_target] = TRUE; NODE[rc_negate] = TRUE) Else (NODE[rw_negated] = TRUE; NEGATEOFFSET) End; [ADD_NT]: ! +-NT + L Begin M(INDEXED); If .SUM Then If REQ_NEG_NO Then Begin M(GENREG); NODE[rc_mov_target] = TRUE; NODE[rc_negate] = TRUE; NODE[rc_sub_offset] = TRUE End Else Begin NODE[rc_mov_target] = TRUE; NODE[rw_negated] = TRUE; NEGATEOFFSET End End; [ADD_TNR]: ! +-(.T+NR) + L Begin M(INDEXED); If .SUM Then If REQ_NEG_NO Then Begin NODE[rc_mov_target] = TRUE; NODE[rc_negate] = TRUE; NODE[rc_sub_offset] = TRUE; M(GENREG) End Else NODE[rw_negated] = TRUE End Tes Else ! .RTYPE Eql ADD_L Begin M(INDEXED); If Not .ROP Then Case .LTYPE From 1 To 3 Of Set [ADD_NR]: ! +-NR + NR Begin NODE[rc_mov_target] = TRUE; If .LOP Then NODE[rc_negate] = TRUE End; [ADD_T]: ! +-.T + NR Begin If TNOTINDEX Then NODE[rc_mov_target] = TRUE; If .LOP Then Begin NODE[rc_mov_target] = TRUE; If REQ_REF_OPERAND And Not REQ_SWP_NO Then Begin NODE[rc_operate] = TRUE; M(GENREG); XTPATH; NODE[gt_code] = OP_SUB End Else NODE[rc_negate] = TRUE End End; [ADD_TL]: ! +-(.T+L) + NR If .LOP Then Begin NODE[rc_mov_target] = TRUE; NODE[rc_negate] = TRUE End Tes Else ! Not .ROP Begin Case .LTYPE From 1 To 3 Of Set [ADD_NR]: ! +-NR - NR Begin If .SUM Neq 0 Then SETRESULTLIT(.SUM) Else Begin NODE[rc_mov_target] = TRUE; If REQ_NEG_NO Or REQ_REF_OPERAND Then Begin If .LOP Then NODE[rc_negate] = TRUE; NODE[rc_sub_offset] = TRUE; M(GENREG) End Else Begin If Not .LOP Then NODE[rc_negate] = TRUE; NODE[rw_negated] = TRUE End End End; [ADD_T]: ! +-.T - NR Begin If TNOTINDEX Then NODE[rc_mov_target] = TRUE; If REQ_NEG_NO Or REQ_REF_OPERAND Then Begin NODE[rc_mov_target] = TRUE; If .LOP Then NODE[rc_negate] = TRUE; NODE[rc_sub_offset] = TRUE; M(GENREG) End Else Begin If Not .LOP Then Begin NODE[rc_mov_target] = TRUE; NODE[rc_negate] = TRUE End; NODE[rw_negated] = TRUE End End; [ADD_TL]: ! +-(.T+L) - NR Begin If REQ_NEG_NO Or REQ_REF_OPERAND Then Begin NODE[rc_mov_target] = TRUE; If .LOP Then NODE[rc_negate] = TRUE; NODE[rc_sub_offset] = TRUE; M(GENREG) End Else Begin If Not .LOP Then Begin NODE[rc_mov_target] = TRUE; NODE[rc_negate] = TRUE End; NODE[rw_negated] = TRUE End End; Tes End End End Else ! code cases Begin CXB = .CAP[C5(.NODE, .LOP, .ROP And Not REQ_SWP_NO, .LOP, .ROP)]; If .CXB Then NODE[gt_code] = OP_SUB; If .CXB Then NODE[rc_negate] = TRUE; If .CXB Then Begin SWAPALL; If REQ_SWP_YES Then NODE = SWP_NO End; If .CXB Then NODE[rw_negated] = TRUE; NODE[rc_mov_target] = TRUE; If .NODE[rw_negated] Then Begin If Not .SUM Then If .NODE[gt_v_symoff] Then NODE[rc_sub_offset] = TRUE Else NEGATEOFFSET End Else If .SUM Then NODE[rc_sub_offset] = TRUE; If Not .NODE[rc_sub_offset] And .NODE[gt_disp_16] Neq 0 Then M(INDEXED) End; If Not .NODE[gt_v_add_copied] Then Begin If .NODE[gt_mode] Eql INDEXED Then If .NODE[gt_disp_16] Eql 0 Then M(GENREG) Else If REQ_REF_TEMP Or REQ_REF_OPERAND Then Begin NODE[rc_add_offset] = TRUE; M(GENREG) End; If .NODE[gt_mode] Eql ABSOLUTE And REQ_REF_TEMP Then Begin NODE[rc_mov_offset] = TRUE; M(GENREG) End End; If SELECTEVALORDER(.NODE) Then SWAPOP; If REQ_SWP_YES And .NODE[gt_code] Neq OP_SUB Then XTPATH; ! set LOP to the target path If .NODE[gt_v_tpath] Then LOP = .ROP; ! no need to copy to the target if LOP is destroyable If .LOP And .LOP Then NODE[rc_mov_target] = FALSE; NODE[rw_destroyable] = (.NODE[gt_mode] Eql GENREG Or .NODE[gt_mode] Eql INDEXED) And Not ISCSE(NODE) And (.NODE[rc_mov_target] Or .LOP); If Not .NODE[rw_destroyable] Then If .NODE[rc_add_offset] Or .NODE[rc_sub_offset] Then NODE[rc_mov_target] = TRUE; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delayer for AND and OR Routine DANDOR(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT; Routine DAND(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT)= Begin Local X : Integer, Y : Integer; Y = 1^.LOP[gt_len]-1; X = .ROP And .Y; ! if for flow If Not REQ_VAL_REAL Then Begin ! X and FALSE => FALSE If Not .X Then SETRESULTLIT(0) ! X and TRUE => TRUE Else COPYRESULT(.NODE,.LOP); Return TRUE End ! X and 0 => 0 Else If .X Eql 0 Then Begin SETRESULTLIT(0); Return TRUE End ! X and -1 => X (accounting for bit fields) Else If .X Eql .Y Then Begin COPYRESULT(.NODE,.LOP); Return TRUE End Else Return FALSE End; Routine DOR(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT) = Begin Local X : Integer, Y : Integer; X = .ROP; Y = 1^.LOP[gt_len]-1; ! if for flow... If Not REQ_VAL_REAL Then Begin ! X or FALSE => X If Not .X Then COPYRESULT(.NODE,.LOP) ! X or TRUE => TRUE Else SETRESULTLIT(1); Return TRUE End ! X or -1 => -1 (accounting for bit fields) Else If .X Eql (.X Or .Y) Then Begin SETRESULTLIT(.X); Return TRUE End ! X or 0 => X Else If .X Eql 0 Then Begin COPYRESULT(.NODE,.LOP); Return TRUE End Else Return FALSE End; Local CODET : Integer, AOT : Boolean, SWAPPED : Boolean; ! force large CSE usages to a tempname If ISLARGECSE(NODE) Then FORCETEMP ! otherwise remove from its parent under bizarre circumstances ! (e.g. using result of AND/OR as an address) Else If Not REQ_REF_OPERAND Then UNDOCSE(.NODE); CODET = .NODE^rq_q_type; AOT = (.NODE[gt_code] Eql OP_OR); ! delay the left operand LDELAY(.CODET +FLD_K_NOT_NONE +FLD_K_NEG_NO +FLD_K_REF_OPERAND); ! if short-circuit evaluation possible, don't allow loading of NCSE's If REQ_VAL_FLOW Or REQ_VAL_NONE Then NOGETLOAD; ! now delay the right operand RDELAY(.CODET +FLD_K_NOT_NONE +FLD_K_NEG_NO +FLD_K_REF_OPERAND); ! undo NOGETLOAD above If REQ_VAL_FLOW Or REQ_VAL_NONE Then OKGETLOAD; ! set the defaults and force a flow result if no result is wanted. ! this allows for bizarre code such as '.X Eql 1 And (Y = 2)' ! which only the twisted mind of a Bourne shell programmer ! might do. If Not REQ_VAL_REAL Then SET_REAL_FLOW(RFFLOW); ! return if nothing wanted. it can't happen due to above!! NORESULTRET; NODE[rc_mov_target] = TRUE; ! move literal to RHS SWAPPED = FALSE; If ISLIT(LOP) And Not ISLIT(ROP) Then Begin SWAPPED = TRUE; SWAPOP End; Case .LOP + .ROP From 0 To 2 Of Set [0]: ! X AND X 0; [1]: ! X AND L Begin If .LOP[gt_code] Eql .NODE[gt_code] And Not .LOP[gt_v_copied] Then ! CHANGE, E.G., "EXPR AND 3 AND 4" TO "EXPR AND 7". (although this ! example is not right) Begin Local X : Integer, Y : Integer, LEX : Ref GT; LEX = .LOP[gt_arg2]; If ISLIT(LEX) Then Begin X = CLITVALUE(ROP); Y = CLITVALUE(LEX); Y = (If .AOT Then .X Or .Y Else .X And .Y); COPYRESULT(.LOP,.LOP[gt_arg1]); LOP[rw_real_flow] = RFNONE; LOP = NODE[gt_arg1] = STATEMAKE(.LOP); X = .CODET+FLD_K_NOT_NONE+FLD_K_NEG_NO+FLD_K_REF_OPERAND; LEX = DELAY(.X+LITLEXEME(.Y)); ROP = .NODE[gt_arg2]; If .ROP Eql T_NODE Then Begin ROP[gt_disp] = .Y; ROP[NRWORDF] = .LEX; ROP[rw_real_flow] = RFNONE End Else NODE[gt_arg2] = .LEX; ROP = .LEX End End; If Bliss(If .AOT Then DOR Else DAND,.NODE,.LOP,.ROP) Then Begin SET_REAL_FLOW(RFNONE); NODE[gt_v_tpath] = FALSE; Return SETLCONF(REQ_NOT_NO,.NODE[rw_complemented],STATEMAKE(.NODE)) End End; [2]: ! L AND L Begin SETRESULTLIT((If .AOT Then .LOP Or .ROP Else .LOP And .ROP)); SET_REAL_FLOW(RFNONE); NODE[gt_v_tpath] = FALSE; Return STATEMAKE(.NODE) End Tes; ! if a flow result then make sure ROP is a node so that it will have ! a label If REQ_VAL_FLOW And Not ISLIT(LOP) And ISLIT(ROP) Then ROP = NODE[gt_arg2] = XLOADNODE(.ROP); ! restore the order if previously swapped If .SWAPPED Then SWAPOP; ! now determine the real order to use which is sorta dangerous ! if short-circuit evaluation is depended upon by the user. If SELECTEVALORDER(.NODE) Then SWAPOP; If REQ_SWP_NONE Then NODE[gt_v_tpath] = FALSE Else If REQ_SWP_YES Then XTPATH; ! for AND, try to adjust the target path to get COM\BIC sequence ! to work better. If Not .AOT And REQ_SWP_NONE And (.LOP Xor .ROP) Then NODE[gt_v_tpath] = Not .ROP; NODE[rw_destroyable] = Not ISCSE(NODE); Return SETLCONF(REQ_NOT_NO,.NODE[rw_complemented],STATEMAKE(.NODE)) End; ! delay a routine call Routine DCALL(NODE : Ref ST) = Begin Local UOP : Ref GT, ROP : Ref GT, LNKG : Ref ST; ! delay the LHS LNKG = .NODE[gt_arg1]; Case .LNKG[st_lnk_type] From LO_LNK_TYPE To HI_LNK_TYPE Of Set [Inrange]: RDELAY( FLD_K_REF_ADDRESS +FLD_K_VAL_REAL +FLD_K_NOT_NO +FLD_K_NEG_NO); [LNK_SPECIAL]: 0; [LNK_IHYDRA]: RDELAY( FLD_K_REF_OPERAND +FLD_K_VAL_REAL +FLD_K_NOT_NO +FLD_K_NEG_NO); [LNK_HYDRA]: ! I know nothing about hydra and can only guess hydra wipes out or ! short-circuits things. Begin NOGETLOAD; NOGETFAKE; RDELAY( FLD_K_REF_ADDRESS +FLD_K_VAL_REAL +FLD_K_NOT_NO +FLD_K_NEG_NO); OKGETLOAD; OKGETFAKE End Tes; ! delay all the arguments Incr I From 2 To .NODE[gt_argc]-1 Do DLY(UOP,NODE[gt_argv(.I)], FLD_K_VAL_REAL +FLD_K_NOT_NO +FLD_K_NEG_NO +FLD_K_REF_OPERAND); SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else Begin NODE[rw_destroyable] = TRUE; NODE[gt_ru_compl] = 16 End; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delay a CASE node Routine DCASE(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, SAVFLS : Ref ITEM, FLSTK1 : Ref ITEM, CODET : Integer, CODEN : Integer; Macro ALPHAPART = gt_arg1 %, OMEGAPART = gt_argv(.NODE[gt_argc]-1) %, CHOICEPART = gt_arg2 %; CODET = .NODE^rq_q_type; If Not EMPTY(.NODE[OMEGAPART]) Then CODET = NORESULTCHECK; ! if the value is not wanted (e.g. for flow) then we don't care ! if it was complemented. If .CODET Neq FLD_K_VAL_REAL Then CODEN = FLD_K_NOT_NONE Else CODEN = FLD_K_NOT_NO; PULSELIST(PULSEDELAY,.NODE[ALPHAPART],0); ! why is the omega part pulsed here??? it needs a NOGETLOAD because ! we don't want a load in the wrong place. ! ! the omega part is pulsed here because the omega list entries are ! still where they were originally and are not allowed to generate ! any code in their spots. pulsing it here effectively makes them ! CSE uses and so they generate no code. NOGETLOAD; PULSELIST(PULSEDELAY,.NODE[OMEGAPART],0); OKGETLOAD; ! delay the case selector DLY(UOP,NODE[CHOICEPART], FLD_K_REF_OPERAND +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO); ! load the choice part because it will be destroyed. The only ! reason it's not destroyable is because it is a CSE. If Not .UOP Then UOP = NODE[CHOICEPART] = XLOADNODE(.UOP); ! save the old fake-load stack and start a new accumulation of fake-load ! entries. SAVFLS = .FLSTK; FLSTK = MAKHDR(FLSREMOVE,FLSENTER); FLSTK1 = MAKHDR(FLSREMOVE,FLSENTER); ! delay all the cases Incr I From 2 To .NODE[gt_argc]-2 Do Begin DLY(UOP,NODE[gt_argv(.I)], FLD_K_REF_OPERAND +.CODET +.CODEN +FLD_K_NEG_NO); ! merge the fake-loads encountered together. any multiple instances ! will have the CSE parent placed on the alpha list MERGE(.FLSTK1,.FLSTK,.NODE[ALPHAPART]) End; OLDFIXLIST(.NODE[ALPHAPART]); OLDFIXLIST(.NODE[OMEGAPART]); ! fake-load entries may still be placed on the alpha list later on ! so note which alpha list each will go on. MARKLSTNAMES(.FLSTK1,.NODE[ALPHAPART]); ! merge the fake-loads found here with all previous fake-loads MERGE(.SAVFLS,.FLSTK1,0); ! discard the fake-load lists created here now. RELITEM(.FLSTK, SZ_LSTHDR); RELITEM(.FLSTK1,SZ_LSTHDR); FLSTK = .SAVFLS; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else Begin If .CODET Neq FLD_K_VAL_REAL Then SET_REAL_FLOW(RFFLOW); NODE[rw_destroyable] = TRUE End; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delayer for compound node Routine DCOMP(NODE : Ref ST) = Begin Local UOP : Ref GT; Macro COMPVAL=NODE[gt_argv(.NODE[gt_argc]-1)] %; ! delay all the arguments but the last Incr I To .NODE[gt_argc]-2 Do DLY(UOP,NODE[gt_argv(.I)], FLD_K_NOT_NO +FLD_K_NEG_NO +FLD_K_VAL_NONE +FLD_K_REF_ARBITRARY); ! delay the last operand DLY(UOP,NODE[gt_argv(.NODE[gt_argc]-1)],.NODE^rq_q_fields); ! beats me, unless this guarantees the symbol does not go out of scope. If .UOP Eql T_SYMBOL Then UOP = COMPVAL = XLOADNODE(.UOP); If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else Begin COPYRESULT(.NODE,.UOP); SETCONTROL; NODE[rw_destroyable] = .UOP End; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delay a DO node Routine DDO(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, SAVFLS : Ref ITEM; Macro CHIPART = gt_arg2 %, RHOPART = gt_arg1 %; ! pulse the Rho and Chi parts RHOPULSE(PULSEDELAY,.NODE[RHOPART],FLD_K_REF_TEMP); PULSELIST(PULSEDELAY,.NODE[CHIPART],0); ! save the old fake-load list and start a new one for the loop body ! and loop condition SAVFLS = .FLSTK; FLSTK = MAKHDR(FLSREMOVE,FLSENTER); ! delay the loop body DLY(LOP,NODE[gt_arg3], FLD_K_REF_ARBITRARY +FLD_K_VAL_NONE +FLD_K_NEG_NO +FLD_K_NOT_NO); ! make sure the body is a node so that it has a label LOP = .NODE[gt_arg3]; If .LOP Neq T_NODE Then Begin LOP = NODE[gt_arg3] = LOADNODE(.LOP); LOP[rw_real_flow] = RFNONE; LOP[gt_v_mustgencode] = TRUE End; ! delay the loop condition DLY(ROP,NODE[gt_arg4], FLD_K_REF_OPERAND +FLD_K_VAL_FLOW +FLD_K_NEG_NONE +FLD_K_NOT_NONE); ! note to move fake-load entries onto this Chi list if there are later ! references to them. MARKLSTNAMES(.FLSTK,.NODE[CHIPART]); ! merge the fake-loads found here with all previous MERGE(.SAVFLS,.FLSTK,0); RELITEM(.FLSTK,SZ_LSTHDR); FLSTK = .SAVFLS; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else NODE[rw_destroyable] = TRUE; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delay a '.' node Routine DDOT(NODE : Ref ST) = Begin Local TN : Ref GT, ROP : Ref GT, UOP : Ref GT, PNODE : Ref GT; NODE = PCSEDOT(.NODE); UDELAY( NORESULTCHECK+ FLD_K_REF_ADDRESS+ FLD_K_NEG_NO+ FLD_K_NOT_NO); ! if node is of the form .(A + #N) and 'A' is GENREG ! then mark all CSE uses as cheap defers and so don't need ! to be placed in a tempname If .UOP Eql T_NODE Then If .UOP[gt_mode] Eql INDEXED And .UOP[gt_reg] Eql 0 Then If .GT[.GT[.UOP[gt_csparent],gt_arg1],gt_mode] Eql GENREG Then Begin PNODE = .NODE; Do PNODE[gt_v_chpdfr] = TRUE While (PNODE = .PNODE[gt_csthread]) Neqa 0 End; NODE[rc_operate] = FALSE; ! DOT NEVER GENERATES CODE NORESULTRET; COPYRESULT(.NODE,.UOP); NODE[rw_literal] = FALSE; NODE[rw_immediate] = FALSE; NODE[gt_v_ctl_or_cse] = .NODE[gt_v_ctl_or_cse] Or ISCSECREATION(NODE); NODE[rw_destroyable] = (If .UOP Gtr PF016 Then 0 Else .UOP And Not ISCSE(NODE)); NODE[gt_cs_compl] = (If ISCSEUSE(NODE) Then 0 Else If .UOP Eql T_NODE Then .UOP[gt_cs_compl] Else OPCOMPL(.NODE)); If REQ_REF_TEMP Then Begin NODE = LOADNODE(.NODE); ! if '.' of a storage variable or a BIND to a storage variable... ROP = .UOP; If .ROP Eql T_NODE Then Begin ROP = .ROP[gt_csparent]; If .ROP[gt_code] Eql OP_LOAD_NODE Then ROP = .ROP[gt_arg1] End; If .UOP Eql T_SYMBOL And ISSTVAR(UOP) Then ! then place the variable is a tempname with a 'register or forget' request. Begin TN = NODE[gt_reg] = GETTN(); TN[tn_request] = RFREQDB; TN[gt_disp] = .UOP End End; Return STATEMAKE(.NODE) End; Bind OPDPLIT = Uplit Long ( DADD, ! ADD DSWAB, ! SWAB DDIVMOD, ! DIV DDOT, ! DOT DADD, ! SUB DDIVMOD, ! MOD DMUL, ! MUL DNEG, ! NEG DLOADNODE, ! PLUS DROTSHIFT, ! SHIFT 0, ! BIT DREL, ! GTR DREL, ! LEQ DREL, ! LSS DREL, ! GEQ DREL, ! EQL DREL, ! NEQ DNOT, ! NOT DEQVXOR, ! EQV DANDOR, ! AND DANDOR, ! OR DEQVXOR, ! XOR DREL, ! GTRU DREL, ! LEQU DREL, ! LSSU DREL, ! GEQU DREL, ! EQLU DREL, ! NEQU DROTSHIFT, ! ROT DMAXMIN, ! MAX DMAXMIN, ! MIN PUNT, ! CARRY PUNT, ! OVERFLOW DSTORE, ! STORE 0, ! ERROR DCASE, ! CASE DFTYPE, ! FAKE-PARM DBUILTIN, ! FAKE-STORE DWU, ! WHILE-DO DWU, ! UNTIL-DO DROUT, ! DECLARE-ROUTINE DCOMP, ! COMPOUND DINCR, ! INCR DINCR, ! DECR DIF, ! IF DDO, ! DO-WHILE DDO, ! DO-UNTIL 0, ! CREATE 0, ! EXCHJ DSELECT, ! SELECT DLEAVE, ! EXITLOOP DLABEL, ! LABEL 0, ! MODULE 0, ! PLIT DCALL, ! PARAMETER-LIST DPOINTER, ! POINTER 0, ! SQUARE-BRACKET DLEAVE, ! LEAVE DLEAVE, ! RETURN DFAKECSE, ! NULL DFAKECSE, ! INLINE DBUILTIN, ! ENABLE DBUILTIN, ! SIGNAL DBUILTIN ! MFPI,ETC. ) : Vector[,Long]; ! ! FUNCTION: ! MAIN COMMON ROUTINE THROUGH WHICH ALL DELAYING IS DONE. ! PERFORMS FUNCTIONS COMMON TO DELAYING OF ALL TYPES OF NODES, ! AND PROVIDES FOR CENTRAL DISPATCHING TO ALL OF THE NODE- ! SPECIFIC DELAYERS. A NODE-SPECIFIC DELAYER IN TURN CALLS ! THIS ROUTINE TO DELAY SUBNODES AND GET THE RESULT WORDS. ! THE WHOLE RECURSIVE DELAYING PROCESS IS KICKED OFF BY ! ROUTINE 'DELAYDRIVER' WHICH CALLS DELAY ON THE TOP NODE ! OF THE GRAPH TABLE TREE. ! Global Routine DELAY(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, DNODE : Ref GT, SAVNODE : Ref GT, DTYPE : Integer, D : Integer, NODX : Integer; ! delay of a literal If .NODE Eql T_LITERAL Then Return DLIT(.NODE); ! delay of a symbol If .NODE Eql T_SYMBOL Then Begin DNODE = DSYM(.NODE); ! if an NCSE then guarantee that any load occurs If .DNODE Eql T_NODE And REQ_VAL_FLOW Then DNODE[rw_real_flow] = RFBOTH; Return .DNODE End; If .NODE Neq T_NODE Then PUNT(ERINVLEXT); ! ! IF A NODE HAS ALREADY BEEN DELAYED AT THIS POINT, ! THEN IT'S A CSE USE OF SOME SORT. DEPENDING ON THE ! REQUEST WORD FIELD VALUES, CERTAIN DECISIONS THAT ! WERE MADE FOR ITS PARENT NODE AND PASSED AROUND ! TO THE USES (BY ROUTINE 'COPYAROUND') MAY HAVE TO ! BE "TAKEN BACK" FOR THIS PARTICULAR USE. ! DNODE = .NODE; If .NODE[gt_v_delayed] Then Begin DNODE = STATEMAKE(.NODE); ! if the caller wants the result in a temporary and its not ! then place it in one If REQ_REF_TEMP And .NODE[gt_mode] Neq GENREG Then DNODE = XLOADNODE(.DNODE); ! if the caller wants the result to be an address then convert ! any R-value to an L-value If REQ_REF_ADDRESS Then DNODE = DEFERIT(.DNODE) ! if +/- and not no-op'ed then it is a value and not an ! address. if no-op'ed then COPYRESULT set the value. ! note that +/- is the only thing really delayed and ! everything else is an immediate anyway. Else If ADDORSUB(.NODE[gt_csparent]) And Not .DNODE[gt_v_add_copied] Then DNODE[rw_immediate] = TRUE; ! if the caller wants the value and +/- delayer left it in a mixed ! state then generate a load to straighten it out If REQ_REF_OPERAND And Not ONEOF(ADDCLASS(.DNODE),ADD_L,ADD_T) Then DNODE = XLOADNODE(.DNODE); ! turn of flow and real as requested If REQ_VAL_FLOW Then SET_REAL_FLOW(.NODE[rw_real_flow] Or RFFLOW) Else If REQ_VAL_REAL Then SET_REAL_FLOW(.NODE[rw_real_flow] Or RFREAL); Return .DNODE[NRWORDF]^RESULTPOS+LEXOUT(T_NODE,.DNODE) End; ! if the subnode of a list node then save the original node and delay ! the parent (again). If ISCSEUSE(NODE) Then Begin SAVNODE = .NODE; NODE = .NODE[gt_csparent]; If .NODE[gt_v_bogus] Then UNBOGUS(NODE) End Else ! if a cse creation of a single usage SAVNODE = 0; ! adjust the type request according to the operator. for operators ! other than '.' and '<>', force the type to arbitrary. NODX = .NODE[gt_code]; DTYPE = .NODE; Case .DTYPE From 0 To 3 Of Set [0,1]: ! arbitrary, operand 0; [2]: ! address If .NODX Neq OP_DOT And .NODX Neq OP_POINTER Then NODE = REF_ARBITRARY; [3]: ! temp If .NODX Neq OP_DOT And .NODX Neq OP_POINTER Then NODE = REF_ARBITRARY Else ! force DNODE to *not* be loaded below for '.' and '<>' DTYPE = -1 Tes; ! release any flow structure and clear delay bits RELFLOW(.NODE); D=.NODE[gt_v_dont_unlink]; NODE[DELAYBITS] = 0; NODE[gt_v_dont_unlink] = D; DEFAULTFIELDVALUES; ! call the delay routine DNODE = Bliss(.OPDPLIT[.NODX],.NODE); ! only +/- nodes are *really* delayed and delaying is really ! for address calculations. if not an address request and ! a COPYRESULT was not done on the +/- node then it is an ! immediate value rather than an address. if COPYRESULT ! was called, it already set rw_immediate as appropriate. If .DTYPE Neq REF_ADDRESS And (.NODX Eql OP_ADD Or .NODX Eql OP_SUB) And Not .NODE[gt_v_add_copied] Then DNODE[rw_immediate] = TRUE; ! if a request for a temporary, place the temporary in its own spot ! (except for '.' and '<>' as noted above). If .DTYPE Eql REF_TEMP Then DNODE = LOADNODE(.DNODE); ! copy any result around (copy propogation?) to CSE usages COPYAROUND(.NODE,.DNODE); ! if an L-value is required, convert any R-value as necessary If .DTYPE Eql REF_ADDRESS Then DNODE = DEFERIT(.DNODE); ! if a cse creation or a single usage If .SAVNODE Eql 0 Then SAVNODE = .DNODE Else ! if a cse usage Begin ! inherit CSE parent's real_flow SAVNODE[rw_real_flow] = .NODE[rw_real_flow]; NODE = .SAVNODE; NODX = -1 End; If REQ_VAL_FLOW Then SET_REAL_FLOW(.NODE[rw_real_flow] Or RFFLOW); ! if a CSE usage and we have been unlinked then re-delay this node If .NODX Lss 0 And ONEUSE(NODE) Then Return DELAY(.SAVNODE); Return (.DNODE[NRWORDF]^RESULTPOS+LEXOUT(T_NODE,.SAVNODE)) End; ! convert an R-value to an L-value Routine DEFERIT(NODE : Ref ST) = Begin Local UOP : Ref GT; ! if already a pointer then an implied defer already exists. (pointers ! may only exist on the LHS of '=' and the RHS of '.' where pointers ! are wanted). If .NODE[gt_code] Eql OP_POINTER Then Return .NODE; ! if not directly usable as a pointer, load it into a register ! and use '@R' If .NODE Gtr PF016 Then Begin NODE = LOADNODE(.NODE); M(GENREG+DEFERRED); Return .NODE End; UOP = .NODE[gt_csparent]; ! for +/-, address arithmetic is usually assumed in DADD and ! turned off in DELAY if an address is not desired. this ! turns it back on. If (.UOP[gt_code] Eql OP_ADD Or .UOP[gt_code] Eql OP_SUB) And .NODE[gt_mode] Eql INDEXED Then If Not .NODE[gt_v_add_copied] Then Begin NODE[rw_immediate] = FALSE; Return .NODE End Else ! if add_copied then that means the addition was of the form ! 'X+0' which was converted to just 'X' via COPYRESULT. ! if this was not of the form '.S+0' then do nothing. Begin UOP = .NODE[gt_arg1]; If .UOP Eql T_NODE And .UOP[gt_code] Eql OP_DOT Then Begin UOP = .UOP[gt_arg1]; If .UOP Neq T_SYMBOL Then Return .NODE End Else Return .NODE End; Case .NODE[gt_mode] From 0 To 7 Of Set ! R => @R [GENREG]: M(GENREG+DEFERRED); ! @R => @0(R) [GENREG+DEFERRED]: M(INDEXED+DEFERRED); ! (R)+ => @(R)+ ! ! note: 'R' may only be PC at this point. [AUTOINCR]: M(AUTOINCR+DEFERRED); [AUTOINCR+DEFERRED]: ! what if it is add_copied? If Not .NODE[gt_v_add_copied] Then ! @#n => @n If Not .swit_pic Then M(INDEXED+DEFERRED) Else ! @#n => MOV @#n,Rm \ @Rm Begin NODE = LOADNODE(.NODE); M(GENREG+DEFERRED) End; ! only final generates these. something's wrong if we see them here. [AUTODECR,AUTODECR+DEFERRED]: PUNT(490); ! n(R) => @n(R) [INDEXED]: M(INDEXED+DEFERRED); ! @n(R) => MOV @n(R),R2 \ @R2 [INDEXED+DEFERRED]: Begin NODE = LOADNODE(.NODE); M(GENREG+DEFERRED) End Tes; Return .NODE End; ! delayer of EQV and XOR Routine DEQVXOR(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT; ! delay the operands LDELAY(NORESULTCHECK+FLD_K_REF_OPERAND+FLD_K_NEG_NO+FLD_K_NOT_NONE); RDELAY(NORESULTCHECK+FLD_K_REF_OPERAND+FLD_K_NEG_NO+FLD_K_NOT_NONE); ! if a real value is not wanted then make sure flow is turned ! on so short-circuit evaluation is used. If Not REQ_VAL_REAL Then SET_REAL_FLOW(RFFLOW); NORESULTRET; NODE[rc_mov_target] = TRUE; ! select the evaluation order (what about short-circuiting?) If SELECTEVALORDER(.NODE) Then SWAPOP; NODE[gt_v_tpath] = FALSE; ! cases: ! X Eqv Not Y => X Xor Y ! X Xor Not Y => X Eqv Y ! Not X Eqv Y => X Xor Y ! Not X Xor Y => X Eqv Y ! Not X Eqv Not Y => X Eqv Y ! Not X Xor Not Y => X Xor Y If .LOP Xor .ROP Then NODE[gt_code] = OTHEROP(OP_EQV,OP_XOR); OFFNOT(NODE[gt_arg1]); OFFNOT(NODE[gt_arg2]); ! process the special cases Case .LOP+.ROP From 0 To 2 Of Set [0]: ! A A 0; [1]: ! A L Begin Local X,Y; ! cases: ! X Xor 0 => X ! X Xor -1 => Not X ! X Xor FALSE => X ! X Xor TRUE => Not X ! X Eqv 0 => Not X ! X Eqv -1 => X ! X Eqv FALSE => Not X ! X Eqv TRUE => X X = Y = 0; If REQ_VAL_FLOW Then Begin Y = 1; X = (.ROP Eqv (.NODE[gt_code] Eql OP_XOR)) End Else If Y = (.ROP Eql 0) Then X = .NODE[gt_code] Eql OP_EQV Else If Y = (.ROP Eql -1) Then X = .NODE[gt_code] Eql OP_XOR; If .Y Then Begin SET_REAL_FLOW(RFNONE); COPYRESULT(.NODE,.LOP); If .X Then NODE[rw_complemented] = TRUE; Return SETLCONF(REQ_NOT_NO,.NODE[rw_complemented],STATEMAKE(.NODE)) End End; [2]: ! L L Begin SET_REAL_FLOW(RFNONE); SETRESULTLIT((If .NODE[gt_code] Eql OP_EQV Then .LOP Eqv .ROP Else .LOP Xor .ROP)); Return STATEMAKE(.NODE) End Tes; ! cases: ! Not (X Xor Y) => X Eqv Y ! Not (X Eqv Y) => X Xor Y If REQ_NOT_YES Then Begin NODE[rw_complemented] = TRUE; NODE[gt_code] = OTHEROP(OP_EQV,OP_XOR) End; NODE[rw_destroyable] = Not ISCSE(NODE); Return STATEMAKE(.NODE) End; Routine DBUILTIN(NODE : Ref ST) = Begin Local UOP : Ref GT; Selectone .NODE[gt_code] Of Set [OP_ENABLE]: Begin NOGETLOAD; NOGETFAKE; UDELAY(NORESULTCHECK+FLD_K_REF_OPERAND+FLD_K_NOT_NO+FLD_K_NEG_NO); OKGETLOAD; OKGETFAKE End; [OP_SIGNAL]: UDELAY(FLD_K_VAL_REAL+FLD_K_REF_OPERAND+FLD_K_NOT_NO+FLD_K_NEG_NO); [OP_MOVP]: UDELAY(FLD_K_VAL_REAL+FLD_K_REF_ADDRESS+FLD_K_NOT_NO+FLD_K_NEG_NO); [Otherwise]: UDELAY(NORESULTCHECK+FLD_K_REF_OPERAND+FLD_K_NOT_NO+FLD_K_NEG_NO); Tes; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else Begin NODE[rw_destroyable] = TRUE; NODE[gt_ru_compl] = 16 End; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; Routine DFTYPE(NODE : Ref ST) = Begin Local UOP : Ref GT; UDELAY(FLD_K_VAL_REAL+FLD_K_REF_OPERAND+FLD_K_NOT_NO+FLD_K_NEG_NO); SETCONTROL; NODE[rw_destroyable] = TRUE; NODE[gt_ru_compl] = 16; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delay an IF node Routine DIF(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, SAVFLS : Ref ITEM, FLSTK1 : Ref ITEM, CODET : Integer, CODEN : Integer; Macro OMEGAPART = gt_arg5 %, ALPHAPART = gt_arg1 %; ! pulse the alpha and omega parts. why is the omega part done ! here and not after everything else? because the CSE uses are ! in the THEN and ELSE parts and the CSE parents are in the ! omega list. the parents must be delayed before the uses. ! the NOGETLOAD is done here because the pulse of the omega ! list is really in the wrong spot. ! ! why not simply turn off the gencode bits in the omega entries ! and then pulse it later? PULSELIST(PULSEDELAY,.NODE[ALPHAPART],0); NOGETLOAD; PULSELIST(PULSEDELAY,.NODE[OMEGAPART],0); OKGETLOAD; ! delay the if condition DLY(UOP,NODE[gt_arg2], FLD_K_REF_OPERAND +FLD_K_VAL_FLOW +FLD_K_NEG_NONE +FLD_K_NOT_NONE); ! save the old fake-load list and start one for the THEN part SAVFLS = .FLSTK; FLSTK = MAKHDR(FLSREMOVE,FLSENTER); ! omega lists complicate things a bit. if there is an omega list then ! if a flow result is wanted then a boolean real result is computed, ! the omega list is coded, and then the boolean result is tested. CODET = .NODE^rq_q_type; If Not EMPTY(.NODE[OMEGAPART]) Then CODET = NORESULTCHECK; ! if used for flow or discarded then we don't care whether the ! result is complemented or not. If .CODET Neq FLD_K_VAL_REAL Then CODEN = FLD_K_NOT_NONE Else CODEN = FLD_K_NOT_NO; ! delay the THEN part DLY(LOP,NODE[gt_arg3], FLD_K_REF_OPERAND +.CODET +FLD_K_NEG_NO +.CODEN); ! save the THEN part fake-lost list and start one for the ELSE part FLSTK1 = .FLSTK; FLSTK = MAKHDR(FLSREMOVE,FLSENTER); ! delay the ELSE part DLY(ROP,NODE[gt_arg4], FLD_K_REF_OPERAND +.CODET +FLD_K_NEG_NO +.CODEN); ! make sure the THEN and ELSE parts are nodes so that they have labels LOP = FIXCOND(NODE[gt_arg3]); ROP = FIXCOND(NODE[gt_arg4]); ! turn off MUSTGENCODE bits on all alpha and omega entries OLDFIXLIST(.NODE[ALPHAPART]); OLDFIXLIST(.NODE[OMEGAPART]); ! merge the fake-loads found on the THEN and ELSE parts and move ! common ones to the alpha list MERGE(.FLSTK1,.FLSTK,.NODE[ALPHAPART]); ! fake-load entries may still be placed on the alpha list later on ! so note the list they go on. this noted list may change as more ! outer alpha lists are found. MARKLSTNAMES(.FLSTK1,.NODE[ALPHAPART]); ! add all the fake-loads found in this IF to all previous ones. MERGE(.SAVFLS,.FLSTK1,0); RELITEM(.FLSTK,SZ_LSTHDR); RELITEM(.FLSTK1,SZ_LSTHDR); FLSTK = .SAVFLS; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else Begin If .CODET Neq FLD_K_VAL_REAL Then SET_REAL_FLOW(RFFLOW); NODE[rw_destroyable] = TRUE End; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delay an INCR/DECR node Routine DINCR(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, SAVFLS : Ref ITEM; Macro RHOPART = gt_arg5 %, CHIPART = gt_arg6 %; ! delay the initial value RDELAY(FLD_K_REF_OPERAND+FLD_K_VAL_REAL+FLD_K_NOT_NO+FLD_K_NEG_NO); ! delay the TO and BY parts. Note: the rq_fld_type field ! was set in flowan because it knew whether the TO and BY ! parts were invalidated by the loop body. DLY(UOP,NODE[gt_arg3], (.NODE[gt_arg3] And FLD_K_REF_TEMP) +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO); DLY(UOP,NODE[gt_arg4], (.NODE[gt_arg4] And FLD_K_REF_TEMP) +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO); ! pulse the Rho and Chi parts RHOPULSE(PULSEDELAY,.NODE[RHOPART],FLD_K_REF_TEMP); PULSELIST(PULSEDELAY,.NODE[CHIPART],0); ! save the old fake-load list and start a new one for the loop body ! and loop condition SAVFLS = .FLSTK; FLSTK = MAKHDR(FLSREMOVE,FLSENTER); ! delay the loop body DLY(UOP,NODE[gt_arg7], FLD_K_REF_ARBITRARY +FLD_K_VAL_NONE +FLD_K_NEG_NO +FLD_K_NOT_NO); ! make sure the loop body is a node so that it has a label field UOP = .NODE[gt_arg7]; If .UOP Neq T_NODE Then Begin UOP = NODE[gt_arg7] = LOADNODE(.UOP); UOP[rw_real_flow] = RFNONE; UOP[gt_v_mustgencode] = TRUE End; ! note the alpha list that fake-load entries are to move to if ! a later reference is made to them MARKLSTNAMES(.FLSTK,.NODE[CHIPART]); ! merge all fake-loads found here to all the previous MERGE(.SAVFLS,.FLSTK,0); RELITEM(.FLSTK,SZ_LSTHDR); FLSTK = .SAVFLS; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else NODE[rw_destroyable] = TRUE; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delayer of a label node Routine DLABEL(NODE : Ref ST) = Begin Local CODET : Integer, LOP : Ref GT, ROP : Ref GT; LOP = .NODE[gt_arg1]; ROP = .NODE[gt_arg2]; ! NCSE's have not been stopped yet by a leave to this label ROP[st_lab_stop_ncse] = FALSE; ! a note to leave nodes whether the result of this label is wanted If REQ_VAL_NONE Then ROP[st_lab_alive] = FALSE Else ROP[st_lab_alive] = TRUE; ! delay the label body If REQ_REF_ADDRESS And .LOP Eql T_NODE Then CODET = FLD_K_REF_ARBITRARY Else CODET = .NODE ^ rq_q_mode; LDELAY(.CODET +NORESULTCHECK +FLD_K_NEG_NO +FLD_K_NOT_NO); ! MAYBE WANT TO DELAY THE LABEL NODE TOO!!! ! undo the 'NOGETLOAD' done at the first leave to this label If .ROP[st_lab_stop_ncse] Then OKGETLOAD; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else Begin ! if never left then the label is just the body If Not .ROP[st_lab_left] Then COPYRESULT(.NODE,.LOP); NODE[rw_destroyable] = TRUE End; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delay a LEAVE node Routine DLEAVE(NODE : Ref ST) = Begin Local ROP : Ref GT, UOP : Ref GT, CODET : Integer; ! get the label symbol and disallow calls to 'GETLOAD' because ! of short-circuited code. ROP = .NODE[gt_arg2]; NOGETLOAD; If .NODE[gt_code] Eql OP_EXIT And Not .ROP[st_lab_alive] Then CODET = FLD_K_VAL_NONE Else CODET = FLD_K_VAL_REAL; ! delay the LEAVE expression UDELAY(.CODET +FLD_K_NOT_NO +FLD_K_NEG_NO +FLD_K_REF_OPERAND); ! if this is the first leave and it is a leave (as opposed to a return) ! then note that the NOGETLOAD above is staying otherwise undo the ! NOGETLOAD above. If .NODE[gt_code] Eql OP_EXIT And Not .ROP[st_lab_stop_ncse] Then ROP[st_lab_stop_ncse] = TRUE Else OKGETLOAD; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else NODE[rw_destroyable] = TRUE; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delay a literal Routine DLIT(NODE : Ref ST) = Begin NODE = (If Not REQ_REF_ADDRESS Then FLD_K_IMM Else 0) +FLD_K_RFREAL +FLD_K_PFNONE +FLD_K_LIT +.NODE; ! if the caller wants it in a tempname then give it If REQ_REF_TEMP Then NODE = XLOADNODE(.NODE); Return .NODE End; Routine DMAXMIN(NODE : Ref ST) = Begin Local CODEN : Integer, LOP : Ref GT, ROP : Ref GT, UOP : Ref GT; ! delay the operands LDELAY(NORESULTCHECK +FLD_K_REF_OPERAND +FLD_K_NEG_NONE +FLD_K_NOT_NO); If .LOP Then CODEN = FLD_K_NEG_YES Else CODEN = FLD_K_NEG_NONE; RDELAY(NORESULTCHECK +.CODEN +FLD_K_REF_OPERAND +FLD_K_NOT_NO); NORESULTRET; ! select the evaluation order If SELECTEVALORDER(.NODE) Then SWAPOP; If REQ_SWP_NONE Then NODE[gt_v_tpath] = FALSE Else If REQ_SWP_YES Then XTPATH; NODE[rw_destroyable] = Not ISCSE(NODE); ! process any special cases Case .LOP+.ROP From 0 To 2 Of Set [0]: 0; ! [1]: Begin ! ! cases: ! Max(X,-32768) => X ! Min(X,-32768) => -32768 ! Max(X,32767) => 32767 ! Min(X,32767) => X If .ROP Eql -32768 Then !(MOST NEGATIVE 16-BIT NUMBER) If .NODE[gt_code] Eql OP_MAX Then Begin COPYRESULT(.NODE,.LOP); SET_REAL_FLOW(RFNONE); Return SETLCONF(REQ_NEG_NO,.NODE[rw_negated],STATEMAKE(.NODE)) End Else Begin SETRESULTLIT(-32768); SET_REAL_FLOW(RFNONE); Return STATEMAKE(.NODE) End; If .ROP Eql 32767 Then !(MOST POSITIVE 16-BIT NUMBER) If .NODE[gt_code] Eql OP_MIN Then Begin COPYRESULT(.NODE,.LOP); SET_REAL_FLOW(RFNONE); Return SETLCONF(REQ_NEG_NO,.NODE[rw_negated],STATEMAKE(.NODE)) End Else Begin SETRESULTLIT(32767); SET_REAL_FLOW(RFNONE); Return STATEMAKE(.NODE) End; ! Max(Min(X,L),M) and M >= L => M ! Min(Max(X,L),M) And M <= L => M If .LOP[gt_code] Eql OTHEROP(OP_MAX,OP_MIN) Then Begin Local X : Integer, Y : Integer, LEX : Ref GT; LEX = .LOP[gt_arg2]; If ISLIT(LEX) Then Begin X = .ROP; Y = CLITVALUE(LEX); If( If .NODE[gt_code] Eql OP_MAX Then .X Geq .Y Else .Y Geq .X) Then Begin SETRESULTLIT(.X); LOP[rw_real_flow] = RFNONE; SET_REAL_FLOW(RFNONE); Return STATEMAKE(.NODE) End End End End; [2]: Begin ! Local X : Integer, Y : Integer; X = .LOP; Y = .ROP; If .NODE[gt_code] Eql OP_MAX Then X = Max(.X,.Y) Else X = Min(.X,.Y); SETRESULTLIT(.X); SET_REAL_FLOW(RFNONE); Return STATEMAKE(.NODE) End Tes; ! cases: ! Max(-X,-Y) => Min(X,Y) ! Min(-X,-Y) => Max(X,Y) Case .LOP + .ROP From 0 To 2 Of Set [0]: 0; [1]: If .LOP Then LOP = NODE[gt_arg1] = LOADNODE(.LOP) Else ROP = NODE[gt_arg2] = LOADNODE(.ROP); [2]: Begin OFFNEG(NODE[gt_arg1]); OFFNEG(NODE[gt_arg2]); NODE[gt_code] = OTHEROP(OP_MAX,OP_MIN); NODE[rw_negated] = TRUE End Tes; NODE[rw_destroyable] = Not ISCSE(NODE); Return SETLCONF(REQ_NEG_NO,.NODE[rw_negated],STATEMAKE(.NODE)) End; ! routine to test whether a MUL/DIV may be converted to a shift Routine CONVSHIFT(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT,C,POSORNEG)= Begin Local X : Integer, Y : Integer; ! check for a power of 2 Y = Abs(.ROP); If (.Y And -.Y) Neq .Y Then Return 0; ! compute the shift count X = FIRSTONE(.Y) * .POSORNEG; Y = .ROP; ! if a distributed multiply, set the result and note the new ! distributed constant. If .C Then Begin COPYRESULT(.NODE,.LOP); NODE[gt_disp] = .NODE[gt_disp_16] ^ .X End; ! change to a shift and set the new RHS ! note: this isn't right because something like: ! '.X * (((Y = 3) And 0) + 4)' will lose the side effect. ! should use something like a variation of SETRESULTLIT. NODE[gt_code] = OP_SHIFT; ROP = NODE[gt_arg2] = DELAY( FLD_K_REF_ARBITRARY +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO +LITLEXEME(.X)); ! crude measure of complexity which seems wrong. should be ! Mod 8 of absolute value. NODE[gt_cs_compl] = .LOP[gt_cs_compl]+(.ROP Mod 8); ! cannot pass through negated bit if a right shift If .X Lss 0 And .LOP Then LOP = NODE[gt_arg1] = XLOADNODE(.LOP); NODE[rw_negated] = (.LOP Xor (.Y Lss 0)); Return SETLCONF(REQ_NEG_NO,.NODE[rw_negated],STATEMAKE(.NODE)) End; ! delayer of DIV/MOD nodes Routine DDIVMOD(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, X : Integer, Y : Integer, TOG : Ref GT; ! delay the operands LDELAY(NORESULTCHECK +FLD_K_NOT_NO +FLD_K_REF_OPERAND +(If REQ_NEG_YES Then FLD_K_NEG_YES Else FLD_K_NEG_MAYBE)); ! delay the RHS. if the caller wants negative and the LHS ! didn't satisfy the negation then see if the RHS can be ! forced negative. RDELAY(NORESULTCHECK +FLD_K_NOT_NO +FLD_K_REF_OPERAND +(If REQ_NEG_YES Xor .LOP Then FLD_K_NEG_YES Else FLD_K_NEG_MAYBE)); NORESULTRET; ! evaluate literals last. ok for DIV and MOD because gt_v_tpath is set If ISLIT(LOP) And Not ISLIT(ROP) Then SWAPOP; NODE[rw_destroyable] = Not ISCSE(NODE); Case .LOP + .ROP From 0 To 2 Of Set [0]: ! ANYTHING ANYTHING 0; [1]: ! ANYTHING L ! cases: ! 0 Div X => 0 ! 0 Mod X => 0 ! X Div 0 => -error- ! X Mod 0 => -error- ! X Div 1 => X ! X Mod 1 => 0 ! X Div -1 => -X ! X Div 1^N => X ^ -N ! why not? ! X Mod 1^N => X And 1^N-1 Begin If .ROP Eql 0 Then If .NODE[gt_v_tpath] Then Begin SETRESULTLIT(0); SET_REAL_FLOW(RFNONE); Return STATEMAKE(.NODE) End Else WARNEM(0,DIVERR); If Abs(.ROP) Eql 1 And Not .NODE[gt_v_tpath] Then Begin If .ROP Lss 0 Then NODE[rw_negated] = Not .NODE[rw_negated]; If .NODE[gt_code] Eql OP_DIV Then COPYRESULT(.NODE,.LOP) Else SETRESULTLIT(0); SET_REAL_FLOW(RFNONE); Return SETLCONF(REQ_NEG_NO,.NODE[rw_negated],STATEMAKE(.NODE)) End; If Not .NODE[gt_v_tpath] And .NODE[gt_code] Eql OP_DIV Then Begin TOG = CONVSHIFT(.NODE,.LOP,.ROP,FALSE,-1); If .TOG Neqa 0 Then Return .TOG End End; [2]: ! L L; Begin X = .LOP; Y = .ROP; If .NODE[gt_code] Eql OP_DIV Then X = .X / .Y Else X = .X Mod .Y; SETRESULTLIT(.X); SET_REAL_FLOW(RFNONE); Return STATEMAKE(.NODE) End Tes; SETCONTROL; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); ! generate a call to a run-time library routine to do the ! mul/div/mod because it is assumed that there is no hardware ! support for it. ! how does node get negated after the call? that what the ! XLOADNODE is for after all. If (.LOP Xor .ROP) And REQ_NEG_NO Then Begin NODE = MAKEROUTINE(.NODE); Return XLOADNODE(.NODE) End Else Return MAKEROUTINE(.NODE) End; ! delayer of MUL nodes Routine DMUL(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, C : Boolean, TOG : Ref GT; ! see if it looks like a distributed multiply C = CKDISTMULT(.NODE,TRUE); ! delay the operands ! note: this doesn't seem right. CKDISTMULT will say it looks ! distributed if it's of the form X*N or N*X. this LDELAY ! is assuming that it's of the form X*N ! if the caller wants a negative value then see if the LHS ! can be forced negative. LDELAY(NORESULTCHECK +FLD_K_NOT_NO +(If .C Then FLD_K_REF_ARBITRARY Else FLD_K_REF_OPERAND) +(If REQ_NEG_YES Then FLD_K_NEG_YES Else FLD_K_NEG_MAYBE)); ! delay the RHS. if the caller wants negative and the LHS ! didn't satisfy the negation then see if the RHS can be ! forced negative. RDELAY(NORESULTCHECK +FLD_K_NOT_NO +FLD_K_REF_OPERAND +(If REQ_NEG_YES Xor .LOP Then FLD_K_NEG_YES Else FLD_K_NEG_MAYBE)); ! may only distribute expressions of the form '.T+L' If .C And ADDCLASS(.LOP) Neq ADD_TL Then C = FALSE; NORESULTRET; ! evaluate literals last. ok for DIV and MOD because gt_v_tpath is set If ISLIT(LOP) And Not ISLIT(ROP) Then SWAPOP; NODE[rw_destroyable] = Not ISCSE(NODE); Case .LOP + .ROP From 0 To 2 Of Set [0]: ! ANYTHING ANYTHING 0; [1]: ! ANYTHING L ! cases: ! X * 0 => 0 ! X * 1 => X ! X * -1 => -X ! X * 1^N => X ^ N Begin NODE[gt_v_tpath] = FALSE; If .ROP Eql 0 Then Begin SETRESULTLIT(0); SET_REAL_FLOW(RFNONE); Return STATEMAKE(.NODE) End; If Abs(.ROP) Eql 1 Then Begin If .ROP Lss 0 Then NODE[rw_negated] = Not .NODE[rw_negated]; COPYRESULT(.NODE,.LOP); SET_REAL_FLOW(RFNONE); Return SETLCONF(REQ_NEG_NO,.NODE[rw_negated],STATEMAKE(.NODE)) End; TOG = CONVSHIFT(.NODE,.LOP,.ROP,.C,1); If .TOG Neqa 0 Then Return .TOG; ! handle distributed multiply If .C Then NODE[gt_disp] = .LOP[gt_disp_16] * .ROP End; [2]: ! L L; Begin SETRESULTLIT(.LOP * .ROP); SET_REAL_FLOW(RFNONE); Return STATEMAKE(.NODE) End Tes; SETCONTROL; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); ! generate a call to a run-time library routine to do the ! mul/div/mod because it is assumed that there is no hardware ! support for it. ! how does node get negated after the call? that what the ! XLOADNODE is for after all. If (.LOP Xor .ROP) And REQ_NEG_NO Then Begin NODE = MAKEROUTINE(.NODE); Return XLOADNODE(.NODE) End Else Return MAKEROUTINE(.NODE) End; Routine DNEG(NODE : Ref ST) = Begin Local UOP : Ref GT; ! delay the operand UDELAY(NORESULTCHECK +FLD_K_REF_OPERAND +FLD_K_NOT_NO +(If REQ_NEG_YES Then FLD_K_NEG_MAYBE Else FLD_K_NEG_YES)); If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE); NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); End Else Begin ! result is the operand but negated COPYRESULT(.NODE,.UOP); NODE[rw_destroyable] = Not ISCSE(NODE) And .UOP; NODE[rw_negated] = Not .NODE[rw_negated]; ! if the caller cannot tolerate negated values then negate it now. If REQ_NEG_NO And .NODE[rw_negated] Then Node = LOADNODE(STATEMAKE(.NODE)) End; Return STATEMAKE(.NODE) End; ! delayer of NOT operator Routine DNOT(NODE : Ref ST) = Begin Local UOP : Ref GT; UDELAY(.NODE^rq_q_type +FLD_K_REF_OPERAND +FLD_K_NEG_NO +(If REQ_NOT_MAYBE Then FLD_K_NOT_YES Else FLD_K_NOT_MAYBE)); If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE); NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); End Else Begin If Not REQ_VAL_REAL Then SET_REAL_FLOW(RFFLOW); ! just like DNEG but complement instead of negate COPYRESULT(.NODE,.UOP); NODE[rw_destroyable] = Not ISCSE(NODE) And .UOP; NODE[rw_complemented] = Not .NODE[rw_complemented]; If REQ_NOT_NO And .NODE[rc_complement] Then NODE = LOADNODE(STATEMAKE(.NODE)) End; Return STATEMAKE(.NODE) End; Routine DFAKECSE(NODE : Ref ST) = Begin SETCONTROL; Return STATEMAKE(.NODE) End; Routine DLOADNODE(NODE : Ref ST) = Begin Local UOP : Ref GT; UDELAY(.NODE^rq_q_fields); If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE); NODE[gt_cs_compl] = CALCCSCOMPL(.NODE) End Else Begin COPYRESULT(.NODE,.UOP); NODE[gt_ru_compl] = .UOP[gt_ru_compl]; NODE[gt_cs_compl] = .UOP[gt_cs_compl] End; Return STATEMAKE(.NODE) End; ! delay '<>' operator Routine DPOINTER(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, L : Ref GT, DFLG : Boolean, POSIT : Integer, SIZ : Integer; DFLG = FALSE; NODE = PCSEDOT(.NODE); UDELAY(NORESULTCHECK +.NODE^rq_q_mode +FLD_K_NEG_NO +FLD_K_NOT_NO); NORESULTRET; L = .NODE[gt_arg2]; POSIT = .L; L = .NODE[gt_arg3]; SIZ = .L; ! X<0,16> => X If .POSIT Eql 0 And .SIZ Eql 16 Then Begin COPYRESULT(.NODE,.UOP); P(0,16); Return STATEMAKE(.NODE) End; ! X when not used as RHS of '.' or LHS of '=' => X If Not REQ_REF_ADDRESS Then Begin COPYRESULT(.NODE,.UOP); NODE[rw_immediate] = FALSE; P(0,16); Return STATEMAKE(.NODE) End; ! something like '.(.S)<8,8>' needs to be loaded and deferenced. If .POSIT Eql 8 And .SIZ Eql 8 And .UOP Neq T_LITERAL Then If .UOP[gt_mode] Eql INDEXED+DEFERRED Then Begin UOP[gt_mode] = INDEXED; UOP = NODE[gt_arg1] = XLOADNODE(.UOP); DFLG = TRUE End; NODE[rc_operate] = FALSE; COPYRESULT(.NODE,.UOP); If .DFLG Then M(GENREG+DEFERRED); P(.POSIT,.SIZ); NODE[rw_literal] = FALSE; ! A POINTER IS NEVER A LITERAL! NODE[rw_immediate] = FALSE; NODE[rw_destroyable] = Not ISCSE(NODE) And .UOP; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; Routine DREL(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, CODET : Integer; Label aaa; Macro SIGNEDREL = (.NODE[gt_code] Lss OP_GTRU) %, CONVERSEREL=(If SIGNEDREL Then .CRELPLIT[.NODE[gt_code]-OP_GTR] Else .CRELPLIT[.NODE[gt_code]-OP_GTRU]+OP_GTRU-OP_GTR) %; Bind CRELPLIT = Uplit Byte (OP_LSS,OP_GEQ,OP_GTR,OP_LEQ,OP_EQL,OP_NEQ ) : Vector[,Byte]; ! relational operators are not candidates for CSE's if flow code ! is generated. FLOWAN seems to make sure that the dont_unlink ! bit is never set for relational operators so this UNDOCSE will ! work. If Not REQ_VAL_REAL Then UNDOCSE(.NODE); CODET = NORESULTCHECK; LDELAY(.CODET +FLD_K_NOT_NO +FLD_K_NEG_NONE +FLD_K_REF_OPERAND); RDELAY(.CODET +FLD_K_NOT_NO +FLD_K_NEG_NONE +FLD_K_REF_OPERAND); If Not REQ_VAL_REAL Then SET_REAL_FLOW(RFFLOW); NORESULTRET; NODE[rw_destroyable] = Not ISCSE(NODE); Case .LOP+.ROP From 0 To 2 Of Set [0]: ! EXP EXP ! cases: ! -X rel -Y => X rel' Y If .LOP And .ROP Then Begin OFFNEG(NODE[gt_arg2]); OFFNEG(NODE[gt_arg1]); NODE[gt_code] = CONVERSEREL; End ! otherwise pay the price for using FLD_K_NEG_NONE above Else If .LOP Then LOP = NODE[gt_arg1] = XLOADNODE(.LOP) Else If .ROP Then ROP = NODE[gt_arg2] = XLOADNODE(.ROP); [1]: ! EXP L aaa: Begin Local L : Ref GT, EXP : Ref GT; If ISLIT(LOP) Then (L = .LOP; EXP = .ROP) Else (L = .ROP; EXP = .LOP); ! cases: ! (X And 1^N) Eql 0 => Bit(X,N) ! (X And 1^N) Neq 0 => Not Bit(X,N) ! (X And 1^N) Eql 1^N => Not Bit(X,N) ! (X And 1^N) Neq 1^N => Bit(X,N) If ONEOF(.NODE[gt_code],OP_NEQ,OP_EQL) And .EXP Eql T_NODE And .EXP[gt_code] Eql OP_AND And Not ISCSE(EXP) And Not .EXP[gt_v_copied] Then Begin Bind EXPL=EXP[gt_arg1] : Ref GT, EXPR=EXP[gt_arg2] : Ref GT; If Not (.EXPL Or .EXPR) Then Begin L = .L; If .L Eql 0 Or (POF2(.L) And (If ISLIT(EXPL) Then CLITVALUE(EXPL) Eql .L Else If ISLIT(EXPR) Then CLITVALUE(EXPR) Eql .L Else 0)) Then Begin EXP[gt_code] = OP_BIT; COPYRESULT(.NODE,.EXP); EXP[rw_complemented] = (.L Neq 0) Xor (.NODE[gt_code] Eql OP_NEQ); EXP[rw_real_flow] = .NODE[rw_real_flow]; SET_REAL_FLOW(RFNONE); Leave aaa End End End; ! cases: ! -X Rel N => X rel' -N If .EXP Then Begin If ISLIT(LOP) Then Begin NODE[gt_arg1] = NEGLIT(.NODE[gt_arg1]); OFFNEG(NODE[gt_arg2]) End Else Begin NODE[gt_arg2] = NEGLIT(.NODE[gt_arg2]); OFFNEG(NODE[gt_arg1]) End; NODE[gt_code] = CONVERSEREL End End; [2]: ! L L Begin Local X : Integer, Y : Integer; X = .LOP; Y = .ROP; SETRESULTLIT((Case .NODE[gt_code] From OP_GTR To OP_NEQU Of Set [Inrange] : 0; [OP_GTR]: .X Gtr .Y; [OP_LEQ]: .X Leq .Y; [OP_LSS]: .X Lss .Y; [OP_GEQ]: .X Geq .Y; [OP_EQL]: .X Eql .Y; [OP_NEQ]: .X Neq .Y; [OP_GTRU]: .X Gtru .Y; [OP_LEQU]: .X Lequ .Y; [OP_LSSU]: .X Lssu .Y; [OP_GEQU]: .X Gequ .Y; [OP_EQLU]: .X Eqlu .Y; [OP_NEQU]: .X Nequ .Y Tes)); SET_REAL_FLOW(RFNONE); End Tes; If SELECTEVALORDER(.NODE) Then SWAPOP; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delayer of '^' and 'rot' Routine DROTSHIFT(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, L : Ref GT, C : Boolean, D : Integer, E : Integer; L = .NODE[gt_arg2]; ! check for a possible distributed multiply C = FALSE; If .NODE[gt_code] Eql OP_SHIFT And .L Gtr 0 Then C = CKDISTMULT(.NODE,FALSE); ! delay the operands LDELAY(NORESULTCHECK +FLD_K_NOT_NO +FLD_K_NEG_NO +(If .C Then FLD_K_REF_ARBITRARY Else FLD_K_REF_OPERAND)); RDELAY(NORESULTCHECK +FLD_K_NOT_NO +FLD_K_NEG_NO +FLD_K_REF_OPERAND); ! distributed if of the form '.T+L' If .C And ADDCLASS(.LOP) Neq ADD_TL Then C = FALSE; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else Begin NODE[rw_destroyable] = Not ISCSE(NODE); ! have to use a call to the run-time library for variable shifts If Not ISLIT(ROP) Then Begin NODE[rw_destroyable] = TRUE; NODE = MAKEROUTINE(.NODE) End Else Begin ! case: ! X ^ 0 => X ! Rot(X,0)=> X D = .ROP; If .D Eql 0 Then Begin COPYRESULT(.NODE,.LOP); SET_REAL_FLOW(RFNONE) End; ! if distributed multiply then adjust the distributed constant If .C Then Begin COPYRESULT(.NODE,.LOP); NODE[gt_disp] = .NODE[gt_disp_16] ^ .D End End End; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delayer for a routine body Routine DROUT(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, L : Integer, LR : Ref ST; ! get the linkage type LR = .NODE[gt_arg2]; LR = .LR[st_var_linkage]; ! should later go by a NOVALUE attribute If .LR[st_lnk_type] Eql LNK_INTERRUPT Then L = FLD_K_VAL_NONE Else L = FLD_K_VAL_REAL; ! delay the body LDELAY(.L +FLD_K_NOT_NO +FLD_K_NEG_NO +FLD_K_REF_OPERAND); SETCONTROL; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); If ISLIT(LOP) Then SETRESULTLIT(.LOP) Else COPYRESULT(.NODE,.LOP); Return STATEMAKE(.NODE) End; ! delay a SELECT node Routine DSELECT(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT; Macro LASTOPERAND = gt_argv(.NODE[gt_argc]-1) %; ! delay the selector UOP = .NODE[gt_arg1]; DLY(UOP,NODE[gt_arg1], (If .UOP Neq T_LITERAL Then FLD_K_REF_TEMP Else FLD_K_REF_OPERAND) +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO); ! the operand will be used over and over again so make sure ! it is not destroyable If .UOP Eql T_NODE Then Begin UOP[rw_destroyable] = FALSE; UOP = .NODE[gt_arg1]; UOP = FALSE; NODE[gt_arg1] = .UOP; End; ! loop, delaying each argument Incr I From 1 To .NODE[gt_argc]-3 Do Begin UOP = .NODE[gt_argv(.I)]; If .UOP Neq T_SELECT Then Begin ! I guess the theory of moving fake-loads out of SELECT statements ! is not too firm so we cop out and disallow them altogether. If Not .I Then NOGETLOAD; DLY(UOP,NODE[gt_argv(.I)], (If .I Then FLD_K_VAL_REAL Else NORESULTCHECK) +FLD_K_NEG_NO +FLD_K_NOT_NO +FLD_K_REF_OPERAND); ! see above If Not .I Then OKGETLOAD End Else ! note whether there is an otherwise/always case and note the ! index of the first OTHERWISE Begin NODE[rc_otherwise] = TRUE; If .UOP Eql LEXOTHERWISE And .NODE[LASTOPERAND] Eql ZERO Then NODE[LASTOPERAND] = LITLEXEME(.I) End End; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else NODE[rw_destroyable] = TRUE; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! delay a store operator Routine DSTORE(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, LHS : Integer, RHS : Integer, TNC : Ref GT, X : Ref GT, NEWMODE : Integer, WLITT : Integer, CODET : Integer; Macro FIXRESULT(XOP)= Begin If .XOP Eql T_LITERAL Then COPYRESULT(.NODE,.XOP) Else Begin TNC = NODE[gt_reg] = GETTN(); TNC[tn_request] = MEMREQDB; TNC[gt_reg] = .XOP End; SET_REAL_FLOW(RFNONE) End %; ! see if of the form 'X = .X op Y' or 'X = Y op .X' X = ISOPTOMEM(.NODE[gt_arg1],.NODE[gt_arg2]); ! if of one of the forms exactly then unlink from its ! CSE chain because we are changing it to 'X op= Y' If .X Neq 0 Then Begin UNLINKCSE(.X); ! 'X' is now the swap request flag X = 0 End; LDELAY(FLD_K_REF_ADDRESS +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO); ! we want a literal if our caller wants a literal or ! the LHS is of the form X where is not ! one of the nice pairs (<0,16>, <0,8>, or <8,8>) WLITT = REQ_WANTLIT Or ONEOF(.LOP,PFE1,PFOTHER); ! want something real CODET = (If REQ_REF_TEMP Then FLD_K_REF_TEMP Else FLD_K_REF_OPERAND); RDELAY(.CODET +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO +.X +.WLITT^rq_q_wantlit); ! if the result of the store is not wanted If REQ_VAL_NONE Then NORESULTSET ! the result of the store is desired. Else If .ROP Neq T_SYMBOL And Not REQ_REF_TEMP Then Begin If REQ_WANTLIT And ISLIT(ROP) Then FIXRESULT(ROP) Else Begin ! determine how complicated each operand is. LHS = COMPLICATED(.LOP,0, TRUE); RHS = COMPLICATED(.ROP,.LOP,FALSE); ! if the LHS is less complicated and either: ! ! - the RHS is very complicated ! -or- ! - If .LHS Lss 10 And .LHS Leq .RHS And (.RHS Geq 10 Or Not REQ_REF_ADDRESS Or .LOP Eql T_LITERAL Or .LOP[gt_mode] Neq INDEXED+DEFERRED) Then ! if a value is desired... If Not REQ_REF_ADDRESS Then Begin FIXRESULT(LOP); If .LOP Eql T_LITERAL Then NODE = FALSE End Else If .LOP Eql T_LITERAL Then Begin FIXRESULT(LOP); M(GENREG) End Else Begin If .LOP[gt_mode] Neq INDEXED+DEFERRED Then FIXRESULT(LOP); M(GENREG+DEFERRED) End Else If .RHS Lss 10 Then FIXRESULT(ROP) End End; If .LOP Eql T_SYMBOL Or SELECTEVALORDER(.NODE) Then SWAPOP; Return STATEMAKE(.NODE) End; Routine DSWAB(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT; UDELAY( NORESULTCHECK +FLD_K_REF_OPERAND +FLD_K_NEG_NO +FLD_K_NOT_NO); If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else Begin NODE[rw_destroyable] = Not ISCSE(NODE); NODE[gt_ru_compl] = .UOP[gt_ru_compl] End; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; Routine DSYM(NODE : Ref ST) = Begin Local X : Ref GT, LPFK : Integer; Macro SYMSTATE = .NODE+FLD_K_RFREAL+.LPFK %; ! shouldn't get things like macros, linkages, labels, etc. If Not ISADDR(NODE) Then PUNT(ERSYMOR); ! variables only come in bytes and words LPFK = (If .NODE[gt_len] Eql 8 And REQ_REF_ADDRESS Then FLD_K_PF08 Else FLD_K_PFNONE); ! if the LHS of a store or the RHS of a '.'... If REQ_REF_ADDRESS Then Begin X = FINDNCSE(.NODE); If .X Eqla 0 Then X = SYMSTATE; Return .X End; ! if asked for some reason to be placed in a tempname If REQ_REF_TEMP Then Return XLOADNODE(SYMSTATE+FLD_K_IMM); ! if a stack variable then we need to do address arithmetic If .NODE[gt_mode] Eql INDEXED Then Return LOADNODE(SYMSTATE+FLD_K_IMM); If .NODE[gt_type] Eql S_LOCAL Or REQ_VAL_FLOW Then Return XLOADNODE(SYMSTATE+FLD_K_IMM); Return SYMSTATE+FLD_K_IMM End; Routine DWU(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, SAVFLS : Ref ITEM; Macro RHOPART = gt_arg1 %, CHIPART = gt_arg2 %; ! pulse the Chi and Rho lists RHOPULSE(PULSEDELAY,.NODE[RHOPART],FLD_K_REF_TEMP); PULSELIST(PULSEDELAY,.NODE[CHIPART],0); ! save the old fake-load list and start a new one for the loop body/condition SAVFLS = .FLSTK; FLSTK = MAKHDR(FLSREMOVE,FLSENTER); ! delay the loop condition and body DLY(LOP,NODE[gt_arg3], FLD_K_REF_OPERAND +FLD_K_VAL_FLOW +FLD_K_NEG_NONE +FLD_K_NOT_NONE); DLY(ROP,NODE[gt_arg4], FLD_K_REF_ARBITRARY +FLD_K_VAL_NONE +FLD_K_NEG_NO +FLD_K_NOT_NO); ! make sure the body of the loop is a node to guarantee ! there is a label field ROP = .NODE[gt_arg4]; If .ROP Neq T_NODE Then Begin ROP = NODE[gt_arg4] = LOADNODE(.ROP); ROP[rw_real_flow] = RFNONE; ROP[gt_v_mustgencode] = TRUE End; ! note the Chi list to move fake-loads to if a later reference is ! found to them MARKLSTNAMES(.FLSTK,.NODE[CHIPART]); ! merge the fake-loads found here with all the previous ones MERGE(.SAVFLS,.FLSTK,0); RELITEM(.FLSTK,SZ_LSTHDR); FLSTK = .SAVFLS; SETCONTROL; If REQ_VAL_NONE Then Begin SETRES( FLD_K_RFNONE+ FLD_K_PFNONE+ FLD_K_LIT); NODE[CXBITS] = 0; M(ABSOLUTE) End Else NODE[rw_destroyable] = TRUE; NODE[gt_cs_compl] = CALCCSCOMPL(.NODE); Return STATEMAKE(.NODE) End; ! ! THIS ROUTINE IS CRUCIAL TO SIMPLE-STORE DISCOVERY (SEE 'SIMPLESTORE' ! IN TNBIND, 'ISOPTOMEM' IN DELAY), AND TO THAT PORTION OF POSITION-SIZE ! TARGETING WHICH STEMS FROM SIMPLE-STORE DISCOVERY (I.E., RECOGNITION ! AND CORRECT CODE GENERATION FOR EXPRESSIONS LIKE ! E1 = .E1 OP E2 ! FOR CERTAIN SPECIAL CASES OF THE OPERATOR 'OP', COUPLED WITH SPECIAL ! CASES OF P1 AND S1; SEE 'ISPSOK' IN TNBIND). ! ! FUNCTION: A PREDICATE. ! IMAGINE FOR A MOMENT THAT "POINTER" NODES (E) COULD BE COMMON ! SUB-EXPRESSIONS OF EACH OTHER. THEN THIS ROUTINE WOULD RETURN 1 IF ! ITS ARGUMENTS WERE (1) IDENTICAL LEXEMES, OR (2) ON THE SAME CSE ! CHAIN. (THERE IS ONE HITCH: IF A IS A BYTE VARIABLE, A<0,8> IS ! CONSIDERED IDENTICAL TO A; THIS IS BECAUSE ADDRESSING OF THE TWO IS ! IDENTICAL.) AS IT IS, EQLPOSSIZE HAS TO DO SOME EXTRA PROCESSING ! OF POINTER NODES, CHECKING WHETHER THEIR 'E' SUBNODES ARE IDENTICAL ! LEXEMES (OR ON THE SAME CSE CHAIN). ! ! CALLED FROM: ISOPSUB (DELAY), ISNEGNOT (TNBIND), SIMPLESTORE (TNBIND) ! Global Routine EQLPOSSIZE(NODE1 : Ref GT,NODE2 : Ref GT) = Begin Local POS1 : Integer, POS2 : Integer, SIZE1 : Integer, SIZE2 : Integer, L : Ref GT; If .NODE1 Eql .NODE2 Then Return TRUE; Case .NODE1 From T_LITERAL To T_NODE Of Set [ T_LITERAL ]: Begin POS1 = 0; SIZE1 = 16 End; [ T_SYMBOL ]: Begin POS1 = .NODE1[gt_pos]; SIZE1 = .NODE1[gt_len] End; [ T_NODE ]: Begin If .NODE1[gt_code] Eql OP_POINTER Then Begin L = .NODE1[gt_arg2]; POS1 = .L; L = .NODE1[gt_arg3]; SIZE1 = .L; NODE1 = .NODE1[gt_arg1]; If .NODE1 Eql T_NODE Then NODE1 = .NODE1[gt_csparent] End Else Begin POS1 = 0; SIZE1 = 16; NODE1 = .NODE1[gt_csparent] End End Tes; Case .NODE2 From T_LITERAL To T_NODE Of Set [ T_LITERAL ]: Begin POS2 = 0; SIZE2 = 16 End; [ T_SYMBOL ]: Begin POS2 = .NODE2[gt_pos]; SIZE2 = .NODE2[gt_len] End; [ T_NODE ]: Begin If .NODE2[gt_code] Eql OP_POINTER Then Begin L = .NODE2[gt_arg2]; POS2 = .L; L = .NODE2[gt_arg2]; SIZE2 = .L; NODE2 = .NODE2[gt_arg1]; If .NODE2 Eql T_NODE Then NODE2 = .NODE2[gt_csparent] End Else Begin POS2 = 0; SIZE2 = 16; NODE2 = .NODE2[gt_csparent] End End; Tes; If .POS1 Neq .POS2 Or .SIZE1 Neq .SIZE2 Then Return FALSE; Return .NODE1 Eql .NODE2 End; Routine ISOPTOMEM(LHS : Ref ST,RHS : Ref ST) = Begin Local X : Ref GT; Macro MAYCRAVESWAP= ONEOF(.RHS[gt_code],OP_ADD,OP_SUB, OP_AND,OP_OR, OP_MAX,OP_MIN) %; ! examines the LHS of a store and one of the operands ! of the operator on the RHS Routine ISOPSUB(LH : Ref GT,RH : Ref GT) = Begin Local Z : Ref GT; ! only consider '.' operator on RHS If .RH Neq T_NODE Or .RH[gt_code] Neq OP_DOT Then Return 0; ! check for an exact match with the LHS Z = .RH[gt_arg1]; If .Z Eql .LH Then Return .RH; ! if they do not represent the same location and size If Not EQLPOSSIZE(.Z,.LH) Then Return 0; ! they are the same. we will be changing 'X = .X op Y' to 'X op= Y' ! so make sure the CSE chain is not broken to avoid side effects ! (e.g. 'X' had a store in it). If .Z Eql T_NODE Then GT[.Z[gt_csparent],gt_v_dont_unlink] = TRUE; Return -1 End; ! only consider operators on RHS If .RHS Neq T_NODE Then Return FLD_K_SWP_NONE; If .RHS[gt_code] Gtr MAXOPERATOR Then Return FLD_K_SWP_NONE; ! see if of the form 'X = .X op Y' and if so, return it, telling ! it not to swap. X = ISOPSUB(.LHS,.RHS[gt_arg1]); If .X Gtr 0 Then Return FLD_K_SWP_NO+.X; ! almost an exact match. '<>' operator possibly made it look ! slightly different. If .X Eql -1 Then Return FLD_K_SWP_NO; ! if not communative (but why is sub included?) If Not MAYCRAVESWAP Then Return FLD_K_SWP_NONE; ! try again, this time for the form: 'X = Y op .X' X = ISOPSUB(.LHS,.RHS[gt_arg2]); ! if an exact match, this time tell it to swap If .X Gtr 0 Then Return FLD_K_SWP_YES+.X; If .X Eql -1 Then Return FLD_K_SWP_YES; Return FLD_K_SWP_NONE End; Routine XLOADNODE(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT; Literal ALLOWNEG = FALSE, ALLOWCOMP = FALSE; UOP = .NODE; NODE = GETSPACE(SZ_NODE+1); NODE[gt_occ] = 1; NODE[gt_type] = S_NODE; NODE[gt_csparent] = .NODE; NODE[gt_csthread] = 0; NODE[gt_state] = 0; NODE[gt_code] = OP_LOAD_NODE; NODE[gt_argc] = 1; NODE[gt_arg1] = .UOP; DEFAULTFIELDVALUES; NODE[rc_operate] = FALSE; ! DEFAILTFIELDVALUES turned this on NODE[gt_v_mustgencode] = TRUE; ! if not an address and an indexed node then note that ! an offset must be added in If .UOP And .UOP Eql T_NODE And .UOP[gt_mode] Eql INDEXED Then Begin NODE[rc_add_offset] = TRUE; NODE[gt_disp] = .UOP[gt_disp]; NODE[gt_v_symoff] = .UOP[gt_v_symoff]; UOP[gt_v_old_rcmt] = Not .UOP[rc_mov_target]; UOP[rc_mov_target] = TRUE End; ! if a load-negative instruction exists If ALLOWNEG Then NODE[rw_negated] = .UOP Else If .UOP Then Begin NODE[rc_negate] = TRUE; If .NODE[rc_add_offset] Then Begin NODE[rc_add_offset] = FALSE; NODE[rc_sub_offset] = TRUE End End; If ALLOWCOMP Then NODE[rw_complemented] = .UOP Else If .UOP Then NODE[rc_complement] = TRUE; NODE[rc_mov_target] = TRUE; If Not .UOP And .UOP Eql T_NODE Then Begin NODE[gt_ru_compl] = .UOP[gt_ru_compl]; NODE[gt_cs_compl] = .UOP[gt_cs_compl] End; M(GENREG); NODE[rw_destroyable] = TRUE; Return STATEMAKE(.NODE) End; Routine LOADNODE(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, SIZE : Integer; Literal ALLOWNEG = FALSE, ALLOWCOMP = FALSE; If .NODE Then Return XLOADNODE(.NODE); If .NODE[gt_type] Neq S_NODE Then Return XLOADNODE(.NODE); If .NODE[gt_argc] Eql 0 Then Return XLOADNODE(.NODE); SIZE = SZ_NODE+.NODE[gt_argc]; UOP = LEXOUT(T_NODE,GETSPACE(.SIZE)); MOVECORE(.NODE,.UOP,.SIZE); UOP[gt_csthread] = 0; UOP[gt_csparent] = .UOP; UOP[gt_occ] = 1; NODE[gt_arg1] = UOP = .UOP+(.NODE[NRWORDF]^RESULTPOS); NODE[gt_state] = 0; ! partial free of a node!!! If .NODE[gt_argc] Gtr 1 Then RELEASESPACE(NODE[gt_arg2],.NODE[gt_argc]-1); NODE[gt_code] = OP_LOAD_NODE; NODE[gt_argc] = 1; DEFAULTFIELDVALUES; NODE[rc_operate] = FALSE; !DEFAULTFIELD TURNS ON AS GENCODE BIT NODE[gt_v_mustgencode] = TRUE; ! must add in the offset if not an address If .UOP And .UOP[gt_mode] Eql INDEXED Then Begin UOP[rc_add_offset] = TRUE; UOP[rc_mov_target] = TRUE End; If ALLOWNEG Then NODE[rw_negated] = .UOP Else If .UOP Then Begin NODE[rc_negate] = TRUE; If .NODE[rc_add_offset] Then Begin NODE[rc_add_offset] = FALSE; NODE[rc_sub_offset] = TRUE End End; If ALLOWCOMP Then NODE[rw_complemented] = .UOP Else If .UOP Then NODE[rc_complement] = TRUE; NODE[rc_mov_target] = TRUE; ! MAY BE TURNED OF BY SIMPLESTORE NODE[gt_ru_compl] = .UOP[gt_ru_compl]; NODE[gt_cs_compl] = .UOP[gt_cs_compl]; M(GENREG); R(0); NODE[rw_destroyable] = Not ISCSE(NODE); Return STATEMAKE(.NODE) End; ! convert an operator into a run-time library function call. this ! is used to handle those operators for which there is no direct ! hardware support. ! ! note: all the run-time routines here are for binary operators ! and thus all take two arguments. Routine MAKEROUTINE(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, RNODE : Ref GT, FNODE : Ref GT, Z : Vector[2], Q : Ref GT; RNODE = GETSPACE(SZ_NODE+.NODE[gt_argc]+2); MOVECORE(.NODE,.RNODE,SZ_NODE); RNODE[gt_argc] = .RNODE[gt_argc]+2; RNODE[gt_code] = OP_CALL; RNODE[gt_arg1] = .sym_bliss; RNODE[gt_csparent] = .RNODE; RNODE[gt_v_mustgencode] = TRUE; RNODE[gt_occ] = 1; ! determine the run-time routine to call UOP = RNODE[gt_arg2] = ( Selectone .NODE[gt_code] Of Set [OP_MUL]: .LEXMUL; [OP_DIV]: .LEXDIV; [OP_MOD]: .LEXMOD; [OP_ROT]: .LEXROT; [OP_SHIFT]: .LEXSHIFT Tes); UOP[st_v_listed_external] = TRUE; If .NODE[gt_v_tpath] Then (Z[0] = .NODE[gt_arg2];Z[1] = .NODE[gt_arg1]) Else (Z[0] = .NODE[gt_arg1];Z[1] = .NODE[gt_arg2]); ! build function parameter wrappers for each parameter. ! note: NODE is bound to FNODE in order to use the ! SETCONTROL and DEFAULTFIELDVALUES macros. Incr I From 2 To 3 Do Begin Bind NODE=FNODE : Ref GT; FNODE = GETSPACE(SZ_NODE+1); FNODE[gt_v_flow] = FALSE; FNODE[gt_argc] = 1; FNODE[gt_code] = OP_FPARM; FNODE[gt_type] = S_NODE; FNODE[gt_v_mustgencode] = TRUE; FNODE[gt_occ] = 1; FNODE[gt_disp] = 0; FNODE[gt_reg] = 0; FNODE[gt_fparent] = .FNODE; FNODE[gt_csparent] = .FNODE; FNODE[gt_arg1] = .Z[.I-2]; SETCONTROL; DEFAULTFIELDVALUES; NODE[rw_destroyable] = TRUE; RNODE[gt_argv(.I)] = STATEMAKE(.NODE) End; NODE[gt_arg1] = LEXOUT(T_NODE,.RNODE); ! partial free of a node! RELEASESPACE(NODE[gt_arg2],.NODE[gt_argc]-1); NODE[gt_v_flow] = FALSE; RNODE[gt_v_flow] = FALSE; NODE[gt_argc] = 1; NODE[gt_code] = OP_FSTORE; SETCONTROL; DEFAULTFIELDVALUES; NODE[rw_destroyable] = TRUE; NODE[gt_cs_compl] = 0; Return STATEMAKE(.NODE) End; Routine NEGLIT(NODE : Ref GT) = Begin Local X : Ref GT; X = DELAY(FLD_K_VAL_REAL +FLD_K_REF_ARBITRARY +FLD_K_NOT_NO +FLD_K_NEG_NO +LITLEXEME(-CLITVALUE(NODE))); ! how can it not be a literal? DLIT only does a XLOADNODE if we ! requested a FLD_K_REF_TEMP If .NODE Eql T_LITERAL Then Return .X Else Begin SETRES(.X); Return .NODE[gt_state] End End; ! TRUE IF NOT <0,16> OR <0,8> IN A PTR NODE ! ! called by PCSEDOT Routine ODDFIELD(NODE : Ref ST)= Begin Local POS : Ref GT, S : Ref GT; POS = .NODE[gt_arg2]; S = .NODE[gt_arg3]; If .POS Neq 0 Or (.S And 7) Neq 0 Then Return TRUE; Return FALSE End; ! ! COMPUTE A CRUDE MEASURE OF THE CODE SIZE OF A NODE. ! ! this measure is the number of instructions needed Routine OPCOMPL(NODE : Ref GT) = Begin Local N : Integer; Selectone .NODE[gt_code] Of Set [OP_SHIFT]: Begin NODE = .NODE[gt_arg2]; If Not ISLIT(NODE) Then Return 8; N = Abs(CLITVALUE(NODE)); If .N Geq 8 Then Return 16 - .N Else Return .N End; [OP_POINTER]: If .NODE[gt_pos] Eql 0 Then Return 1 Else If .NODE[gt_pos] Eql 8 Then Return 2 Else Return 8; [OP_ADD]: Return SUMBITS(.NODE[RCBITS]); [Otherwise]: Return 1; Tes End; ! called by: DDOT, DPOINTER Routine PCSEDOT(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, UOP : Ref GT, T : Integer; ! UOP is the RHS of a '.' or the LHS of a '<>' UOP = .NODE[gt_arg1]; ! if a simple reference to a variable which itself may be placed ! in a register then do not allow node to become a tempname. ! it would only needlessly compete for scarse registers. If REQ_REF_TEMP Then Begin If .UOP Eql T_SYMBOL And .UOP[gt_mode] Eql GENREG Then NODE = REF_OPERAND End; If Not ISCSE(NODE) Then Return .NODE; If REQ_REF_TEMP Then Return .NODE; ! assume we will be forcing to a temporary T = 0; If .UOP Eql T_NODE Then Begin ! if it is a CSE then try to undo its CSE chain If ISCSE(UOP) Then T = 1 ! try to undo ! if it was a CSE at one time then undo it if its a cheap defer. ! that is, if the level of indirection does not need to be loaded ! but can be referenced via '@' Else If UNDONE(UOP) Then Begin If .UOP[gt_code] Eql OP_DOT And .UOP[gt_v_chpdfr] Then T = 2 ! undocse End Else Selectone .UOP[gt_code] Of Set [OP_DOT]: T = 1; ! try to undo [OP_ADD,OP_SUB]: If .GT[.NODE[gt_csparent],gt_occ] Leq 3 Then T = 1 ! try to undo Else T = 3; ! delay UOP into a temp [OP_POINTER]: If Not ODDFIELD(.UOP) Then T = 1; ! try to undo [Otherwise]: T = 3 ! delay UOP into a temp Tes End ! for symbols, note that access to it is cheap and place the value ! in a register if it's not a tempname candidate and if there are ! are large number of accesses to it. Else If .UOP Eql T_SYMBOL Then Begin NODE[gt_v_chpdfr] = TRUE; If .UOP[gt_mode] Eql GENREG Or Not ISLARGECSE(NODE) Then T = 2 ! undocse End ! for literals, place the literal into a register only ! if a large number of accesses are made to it. Else If .UOP Eql T_LITERAL Then Begin If Not ISLARGECSE(NODE) Then T = 2 ! undocse End; Case .T From 0 To 3 Of Set [0]: FORCETEMP; [1]: If Not UNDOCSE(.NODE) Then FORCETEMP; [2]: UNDOCSE(.NODE); [3]: Begin If Not UNDOCSE(.NODE) Then FORCETEMP Else Begin UOP[gt_v_dont_unlink] = TRUE; UDELAY( NORESULTCHECK+ FLD_K_REF_TEMP+ FLD_K_NOT_NO+ FLD_K_NEG_NO) End End Tes; Return .NODE End; ! CONT = FLD_K_REF_TEMP if called from RHOPULSE else 0 Routine PULSEDELAY(NODE : Ref GT,CONT : Integer) : Novalue = Begin Local FLG : Integer, SAVE : Integer; SAVE = .NODE[gt_v_mustgencode]; NODE[gt_v_mustgencode] = TRUE; NODE[gt_v_dont_unlink] = TRUE; If ONEUSE(NODE) Then FLG = FLD_K_REF_ARBITRARY Else FLG = FLD_K_REF_TEMP; DELAY(.NODE+((.FLG +FLD_K_VAL_REAL +FLD_K_NEG_NO +FLD_K_NOT_NO) Or .CONT)); NODE[gt_v_mustgencode] = .SAVE; NODE[rw_destroyable] = FALSE End; Routine SELECTEVALORDER(NODE : Ref ST) = Begin Local LOP : Ref GT, ROP : Ref GT, LRUC : Integer, RRUC : Integer, MUC : Integer, LCSC : Integer, RCSC : Integer; Literal INCREMENT = 16, BANDWIDTH = INCREMENT/2; Macro EQUIV(M1,M2)=(Abs (M1-M2) Leq BANDWIDTH) %, RUTERMC(X)=(If .X Neq T_NODE Then 0 Else .X[gt_ru_compl]) %, CCTERMC(X)=(If .X Neq T_NODE Then 0 Else .X[gt_v_ctl_or_cse]) %, CSTERMC(X)=(If .X Neq T_NODE Then 0 Else .X[gt_cs_compl]) %; LOP = .NODE[gt_arg1]; ROP = .NODE[gt_arg2]; ! IF CSE OR CONTROL, OR CONTAINS CSE OR CONTROL--NO COMPLEXITY ! AND NO SWITCH EVAL ORDER. ! if either operand is a CSE or this is a CSE creation then ! don't change things. NODE[gt_v_ctl_or_cse] = CCTERMC(LOP) Or CCTERMC(ROP) Or ISCSECREATION(NODE); If .NODE[gt_v_ctl_or_cse] Then Begin NODE[gt_cs_compl] = 0; NODE[gt_ru_compl] = 0; Return .LOP Neq T_NODE End; ! DETERMINE REGISTER USE COMPLEXITY LRUC = RUTERMC(LOP); RRUC = RUTERMC(ROP); MUC = Max(.LRUC,.RRUC); ! modified Sethi/Aho algorithm with a couple of changes: ! ! 1. for a CSE use, the register use drops as the ! occurence goes up to approximate the last ! use of a CSE. ! 2. the register use count can be nasty and so ! an approximation of equality is used. NODE[gt_ru_compl] = ( If ISCSEUSE(NODE) Then INCREMENT/(.NODE[gt_occ]-1) Else If EQUIV(.LRUC,.RRUC) Then .MUC+INCREMENT Else .MUC); ! DETERMINE FLOW USE COMPLEXITY ! note: CSE uses don't generate any code LCSC = CSTERMC(LOP); RCSC = CSTERMC(ROP); NODE[gt_cs_compl] = ( If ISCSEUSE(NODE) Then 0 Else .LCSC + .RCSC + OPCOMPL(.NODE)); ! DETERMINE WHETHER TO SWITCH OR NOT ! move literals to RHS If ISLIT(LOP) And Not ISLIT(ROP) Then Return TRUE; If ISLIT(ROP) Then Return FALSE; ! if a flow request then evaluate the lesser code first ! otherwise evaluate the lesser registers first If REQ_VAL_FLOW Then Return .RCSC Lss .LCSC Else Return .RRUC Gtr .LRUC End; ! ! FUNCTION: ! SET UP THE POSITION/SIZE INFORMATION IN THE CURRENT NODE'S ! STATEWORD, AND THEN BUILD THE RESULT WORD FOR THIS (DELAYED) ! NODE. ! VALUE: ! THE RESULT WORD FOR THIS NODE. ! Routine STATEMAKE(NODE : Ref GT) = Begin Local SIZ : Integer, POSIT : Integer; SIZ = .NODE[gt_len]; POSIT = .NODE[gt_pos]; NODE[rw_ptr_state] = ( If .SIZ Eql 1 Then PFE1 Else If .POSIT Eql 0 Then If .SIZ Eql 8 Then PF08 Else If .SIZ Eql 16 Then PF016 Else PFOTHER Else If .POSIT Eql 8 And .SIZ Eql 8 Then PF88 Else PFOTHER); Return .NODE[NRWORDF]^RESULTPOS+LEXOUT(T_NODE,.NODE) End; ! ! FUNCTION: ! COMPLETELY UNDO THE CSE CHAIN THAT 'NODE' IS PART OF. TURNS ON ! 'MUSTGENCODE' BITS ALL DOWN THE CHAIN, BUT DOESN'T BOTHER THE ! 'CSTHREAD' AND 'CSPARENT' FIELDS. CHAINS HEADED BY BOGUS NODES, ! OR ANY CHAINS CONTAINING FAKE CSE'S, NCSE'S, OR ALPHA OR OMEGA ! LIST NODES, OR ANY OTHER NODES WHOSE 'DONTUNLINK' BITS HAVE BEEN ! SET, ARE NOT TOUCHED, I.E. LEFT INTACT. ! ! called by: DADD, DANDOR, DREL, PCSEDOT Routine UNDOCSE(NODE : Ref GT) = Begin Local PNODE : Ref GT, PN : Ref GT; ! nothing to do for single use CSE's If ONEUSE(NODE) Then Return TRUE; ! don't unlink if the parent says not to PN = PNODE = .NODE[gt_csparent]; If .PN[gt_v_dont_unlink] Then Return FALSE; ! don't unlink if any of our siblings say not to either While (PNODE = .PNODE[gt_csthread]) Neqa 0 Do If .PNODE[gt_code] Eql OP_FAKE_CSE Or .PNODE[gt_v_dont_unlink] Then Begin PN[gt_v_dont_unlink] = TRUE; Return FALSE End; PN[gt_occ] = 1; PNODE = .PN; While (PNODE = .PNODE[gt_csthread]) Neqa 0 Do Begin PNODE[gt_v_mustgencode] = TRUE; PNODE[gt_v_chpdfr] = .PN[gt_v_chpdfr] End; ! adjust the occurence counts of all children PNODE = .PN; Decr I From .PNODE[gt_argc]-1 To 0 Do Begin PN = .PNODE[gt_argv(.I)]; If .PN Eql T_NODE Then Begin PN = .PN[gt_csparent]; If Not UNDONEPARENT(PN) Then If (PN[gt_occ] = .PN[gt_occ]+1) Eql 2 Then If .PN[gt_v_delayed] Then Begin PN[gt_v_delayed] = FALSE; COPYAROUND(.PN,.PN) End End End; Return TRUE End; ! ! FUNCTION: ! TAKES A NODE OUT OF A CSE CHAIN, IF IT IS IN ONE, WHILE LEAVING ! THE REST OF THE CHAIN INTACT. ACTUALLY CHANGES 'CSTHREAD' AND ! 'CSPARENT' FIELDS. WILL NOT TOUCH A NODE WHICH IS ON AN ALPHA ! OR OMEGA LIST, IS A BOGUS NODE, OR IS THE CSPARENT OF THE CHAIN ! ITSELF, OR FOR ANY OTHER REASON HAS ITS 'DONTUNLINK' BIT SET. ! ! called by DSTORE when it recognizes an op-to-mem operation Routine UNLINKCSE(NODE : Ref ST) : Novalue = Begin Local L : Ref ST; NODE = .NODE; If .NODE[gt_v_dont_unlink] Then Return; L = .NODE[gt_csparent]; If .L Eqla .NODE Then Return; While .L[gt_csthread] Neqa 0 Do Begin If .L[gt_csthread] Eqla .NODE Then Begin L[gt_csthread] = .NODE[gt_csthread]; L = .NODE[gt_csparent]; If .L[gt_occ] Gtr 1 Then L[gt_occ] = .L[gt_occ]-1; NODE[gt_csparent] = .NODE; NODE[gt_csthread] = 0; NODE[gt_v_mustgencode] = TRUE; NODE[gt_occ] = 1; NODE[gt_v_delayed] = FALSE; Return End; L = .L[gt_csthread] End End; ! ! FUNCTION: ! (1) SETS UP THE HEADER FOR THE MAIN NCSE LIST. ! (2) INVOKES DELAYING ON THE TOP NODE OF THE GRAPH TABLE TREE. ! (3) RUNS DOWN THE NCSE LIST PUTTING EACH NCSE PARENT ON THE ! ALPHA OR CHI LIST POINTED TO BY ITS LST2 FIELD. ! Global Routine DELAYDRIVER(LEX : Ref GT) : Novalue = Begin Local I : Ref ITEM, J : Ref ITEM, K : Ref ITEM; GETLCNT = 0; INENABLE = 0; ! release any old fake-load list and start a new one If .FLSTK Neqa 0 Then RELLST(.FLSTK); FLSTK = MAKHDR(FLSREMOVE,FLSENTER); ! delay the operand DELAY( FLD_K_REF_ARBITRARY+ FLD_K_VAL_NONE+ FLD_K_NEG_NO+ FLD_K_NOT_NO+ .LEX); ! loop for each item on the fake-load stack. ! ! note: ! GETLOAD's are are recognized as CSE's eligible for ! Alpha motion by DELAY rather than FLOWAN. this is ! because FLOAWN does not have all the information ! it needs to determine which names are potential ! NCSE's. ! ! maybe some day when FLOWAN is made a separate ! phase from LEXSYN then maybe FLOWAN can do this. ! ! to avoid moving fake-load entries to and from ! Alpha lists, the ultimate list for an entry is ! saved in the entry itself and is placed on ! the appropriate list here. ! ! fake-load entries are moved to the lowest common ! fork level. the way this is achieved is by placing them ! just before the start of a fork which is the Alpha list ! for IF and CASE statements and the Chi list for loops. I = .FLSTK; Until (I = .I[itm_rlink]) Eqla .FLSTK Do Begin J = .I[itm_ncse_lst2]; If .J Neqa 0 Then Begin If .J[hdr_remove] Eql CHIREMOVE Then ! create a new CHI element K = MAKITEM(.I[itm_ncse_data]) ! chi Else ! note: this is the creation of a single item intersection list K = MAKITEM(1,.I[itm_ncse_data]); ! alpha LINK(.K,.J[itm_llink]) End End End; End Eludom