! File: TNBIND.BLI ! Module TNBIND = Begin ! ! ! TNBIND MODULE ! ---------------- ! ! THIS MODULE ASSIGN SYMBOLIC 'TEMPORARY NAMES' TO HOLD THE ! RESULTS OF EXPRESSIONS - THEN BINDS THESE NAMES TO REGISTERS ! AND/OR MEMORY LOCATIONS. THE MODULE CONSISTS OF THREE ! DISTINCT SEQUENTIALLY EXECUTED PHASES: TN-ASSIGNMENT, RANKING, ! AND PACKING. ! ! ASSIGNMENT: IN THIS PHASE A TREE-WALK (IN EXECUTION ORDER) ! IS MADE. A SEPARATE ROUTINE IS CALLED FOR EACH TYPE OF ! NODE (+,*,IF, ETC.). GENERALLY THE FUNCTIONS OF THESE ROUTINES ! ARE TO: ! 1) ASSIGN TEMP-NAMES AND/OR LABELS IN SUCH A WAY ! THAT ,IF POSSIBLE, THE SAME NAME ! IS USED FOR THE ENTIRE EVALUATION OF AN EXPRESSION. ! AN ATTEMPT IS MADE TO 'TARGET' THE VALUES OF SOME ! (SEVERAL) EXPRESSIONS TO THE SAME NAME. ! 2) COMPUTE THE RELATIVE 'IMPORTANCE' OF A PARTICULAR ! TEMP-NAME BY EXAMINING THE WAY AND NUMBER OF ! TIMES IT IS USED. ! 3) DETERMINE THE 'LIFE' OF A TEMP NAME -- THAT IS, THE ! SPAN OF PROGRAM OVER WHICH THE NAME MUST OCCUPY ! A SINGLE LOCATION. ! ! RANKING: USING THE 'IMPORTANCE' MEASURE COMPUTED IN THE FIRST ! PHASE, THE RANKING PHASE ORDERS THE TEMP-NAMES SO THAT THE ! PACKING PHASE MAY ALLOCATE THE MOST IMPORTANT FIRST. ! THIS INSURES THAT THE MOST IMPORTANT TEMP-NAMES WILL BE BOUND ! TO THE MOST DESIRABLE LOCATIONS -- GENERALLY REGISTERS. ! ! PACKING: THE FINAL PHASE PROCESSES TEMP-NAMES IN THE ORDER ! DEFINED BY THE RANKING PHASE. USING THE 'LIFE-SPAN' INFORMATION ! THIS PHASE ATTEMPTS TO 'FIT' OR 'PACK' THE TEMP-NAMES INTO ! THE VARIOUS POSSIBLE LOCATIONS. ROUGHLY, THE ORDER OF PREFERENCE ! FOR VARIOUS LOCATIONS IS: ! ! 1) AN 'OPEN' REGISTER -- THIS IS A REGISTER WHICH HAS ALREADY ! BEEN USED (AND THUS ITS CONTENTS NEED NOT BE SAVED). ! 2) AN 'OPEN LOCAL' -- AT LEAST IF THE COST OF USING ! A LOCAL FOR THIS TEMP IS LESS THAN OPENING A NEW ! REGISTER. ! 3) A 'CLOSED REGISTER' ! 4) AN 'OPEN LOCAL' ! 5) A 'CLOSED LOCAL'. ! ! ! THIS BRIEF DESCRIPTION HARDLY DOES JUSTICE TO THE ALGORITHMS, ! BUT IT SHOULD GIVE AN OVERVIEW OF WHATS GOING ON. DETAILS ! WILL BE FOUND BELOW. ALSO, NOTE THE OUTLINE OF THE ORGANIZATION ! OF THE CODE GIVEN BELOW! ! Require 'Bliss'; External Routine FIXRHOLIST : Novalue; Literal SZ_ULST = 4, ! SIZE OF USUAL LIST VECTOR VREGNUM = 0, ! NUMBER OF THE VALUE REGISTER MAGIC3 = 3, ! CAN "IF" RESULT REG BE USED AS TARGET? MAGIC2 = 5; ! IS TOS OK FOR TARGET? ! copied from RESHUF.BLI Literal SRCHDEPTH = 4, SRCHWIDTH = 3; ! fields of the DTDSTK, FONSTK, and LOOPLFSTK stacks (see TNBIND). ! ! notes: ! these are variable length stack implemented using item ! lists and so word zero is the itm_rlink/itm_llink field. ! the top of the stack is referenced using STACK[itm_rlink]. ! the stack is expanded with the macro PUSHLS and contracted ! using the macro POPLS. ! ! these stacks all use the same macros for pushing and ! popping and so their sizes must match. Macro stk_fon_lo = 1, 0,32,1 %, stk_fon_hi = 1,32,32,1 %, stk_dtd_lo = 1, 0,32,1 %, stk_dtd_hi = 1,32,32,1 %, stk_exit_fon = 1, 0,32,1 %, stk_exit_lon = 1,32,32,1 %; ! tempname list: ! ! SRLST specific register list. holds TN's which must go ! into a specific register. e.g.: the result of a function ! call goes into the specific register R0. also used ! for linkages which require parameters in specific ! registers and in REGISTER declarations for specific ! registers. ! ! ARLST arbitrary register list. holds TN's which must go ! into a register of which the compiler may decide ! which. used for REGISTER variables not bound to ! any specific register. ! ! ULST usual list. holds TN's, sorted by a combination ! of complexity and lon span, which would like to ! go into a register if possible but are willing to ! accept a stack location. exception is 'register-or-forget' ! tempnames which want a register but will not accept ! a stack location. the usual list is capable of ! getting long and so is divided into four lists. ! ! SLLST static local list. hold's TN's which may not be ! placed in a register. variables which have their ! address taken are placed here. Own SRLST : LSTHDR, ARLST : LSTHDR, ULST : Vector[SZ_ULST], SLLST : LSTHDR, stk_fon : LSTHDR, stk_dtd : LSTHDR, stk_loop_lf : LSTHDR, stk_loop : Ref ITEM, stk_call : Ref ITEM, PREFLST : Ref TNREPR, ESTIM : Integer, MAXKOST : Integer, MAXFONSPAN : Integer; ! OUTLINE OF THE TNBIND MODULE !------------------------------ ! ! I. - GENERAL UTILITIES FOR TNBIND ! A. - FOR MANIPULATING STACKS OF LISTS ! B. - FOR ACCESSING TN REPRESENTATIVES ! C. - FOR PERFORMING AN ACTION ON A LIST OF TN'S ! D. - ROUTINES FROM THE LOWSEGMENT ! E. - MISCELLANEOUS ! II. - TEMP NAME AND LABEL ASSIGNMENT ! A. - UTILITIES ! B. - SPECIFIC ROUTINES ! C. - DRIVER FOR TEMP NAME/LABEL ASSIGNMENT ! III. - RANKING TEMP NAMES ! A. - UTILITIES ! B. - SORTING OF TEMP NAMES ! C. - DRIVER FOR RANKING ! IV. - PACKING ! A. - UTILITIES ! 1. - PREFERENCES ! 2. - FITTING ! ! 3. - OPENING ! ! B. - REGISTERS ! FOR THESE FIVE, SEE TRY.BLI ! C. - STATIC TEMPS ! ! D. - DYNAMIC TEMPS ! ! E. - DRIVER FOR PACKING ! F. - MARKING OF TNS AFTER PACKING ! V. - DRIVER FOR TNBIND MODULE ! I. - GENERAL UTILITIES FOR TNBIND ! ------------------------------------------------ ! A. - FOR MANIPULATING STACKS OF LISTS ! ------------------------------------------------ ! ! THE FOLLOWING STRUCTURES/MACROS/AND ROUTINES DEFINE ! A SYSTEM OF STACKS OF LISTS -- THAT IS, EACH STACK ! ELEMENT IS THE HEADER OF A DOUBLY LINKED CIRCULAR ! LIST. THESE STACKS ARE USED, IN GENERAL, WHERE SEVERAL ! PIECES OF INFORMATION MUST BE RECORDED AT A SINGLE ! LEVEL OF (OBJECT PROGRAM) CONTROL. THE TYPICAL ENTRIES ! ARE 'TN-REPRESENTATIVES' -- TWO WORD CELLS WHICH ! POINT TO A TN CELL. ! ! ! note: ! the indices for these stacks start at -1 rather than 0. ! this allows the top element of the stack to be referenced ! using only '[stk_idx]' rather than '[stk_idx]-1'. ! ! used for STEMPS, DETEMPS, stk_call, stk_loop Macro INITSTK(STK) = Begin STK = GETSPACE(STKSIZE+2); STK[stk_idx] = -1; STK[stk_max] = -1 End %; ! B. - FOR ACCESSING TN REPRESENTATIVES ! ------------------------------------------------ ! ! ! THIS SECTION DEFINES ACCESSING OF 'TN-REPRESENTATIVES'. ! IN THE PROCESS OF TNBINDING IT IS NECESSARY TO ! INCLUDE THE TN'S ON SEVERAL LISTS SIMULTANEOUSLY. ! RATHER THAN ALLOW SPACE IN THE TN-CELL FOR ALL POSSIBLE ! SUCH LINKINGS, A 'REPRESENTATIVE' OF THE TN-CELL IS ! PLACED ON THE APPROPRIATE LISTS. THE STRUCTURE OF ! TN-REPS IS DEFINED SO THAT FIELDS IN THE TNCELL MAY ! BE ACCESSED ,BY NAME, INDIRECTLY. ! ! ! macro to deallocate a TNREP structure Macro RELTNREP(A) = RELEASESPACE((A),SZ_TNREP) %; ! E. - MISCELLANEOUS ! ------------------------------------------------ Forward Routine TLA, WANTPREF : Novalue; Macro FILLTX = (If .TX Eqla 0 Then TX = GETTN()) %, ISRELOP(NODE) = ONEOF(.NODE[gt_code], OP_GTR,OP_LEQ,OP_LSS,OP_GEQ,OP_EQL,OP_NEQ, OP_GTRU,OP_LEQU,OP_LSSU,OP_GEQU,OP_EQLU,OP_NEQU, OP_BIT) %, LASTOPERAND = gt_argv(.NODE[gt_argc]-1) %, REQ_RESULT = (.NODE[rw_real_flow] Neq RFNONE) %, REQ_FLOW = (.NODE[rw_real_flow] Eql RFFLOW) %, TNNEEDED = .NODE[rw_real] %; ! F. STRUCTURE/MACROS/ROUTINES FOR LIST-IMPLEMENTED STACKS ! ------------------------------------------------ ! ! notes: ! these macros implement a variable length stack. ! it seems that if there were a reasonable maximum ! for its depth that it could be implemented must ! more efficiently. ! ! used by stk_fon, stk_loop_lf, and stk_dtd Macro PUSHLS(STK,ZVAL1,ZVAL2) = Begin Local ZQ : Ref ITEM; ZQ = GETSPACE(SZ_PLSTSTK); ZQ[itm_llink] = .ZQ; ZQ[itm_rlink] = .ZQ; LINK(.ZQ,STK); ZQ[stk_fon_hi] = ZVAL1; ZQ[stk_fon_lo] = ZVAL2 End %, POPLS(STK) = RELEASESPACE(DELINK(.STK[itm_rlink]),SZ_PLSTSTK) %, INITLS(STK) = NULLLST(STK) %; ! II. - TEMP NAME AND LABEL ASSIGNMENT ! ------------------------------------------------ ! ! THIS SECTION CONTAINS THE CODE TO DO PHASE 1: ASSIGNMENT ! OF TEMP NAMES AND LABELS. SEE BELOW FOR DETAILS. ! ! ! A. - UTILITIES ! ------------------------------------------------ ! COST COMPUTATIONS: THESE UTILITIES DEFINE THE COST OF ! USING A PARTICULAR TEMP NAME. TWO COSTS ARE COMPUTED: ! 1) A 'MAX' COST -- WHICH RESULTS IF THE TEMP WERE ! ASSIGNED TO A MEMORY LOCATION, AND 2) A 'MIN' COST ! -- WHICH RESULTS IF A REGISTER IS USED. IN BOTH CASES ! THE COST IS A FUNCTION OF THE OPERATOR, TYPE OF USE, AND CURRENT LOOPDEPTH. ! ! notes: ! costs represent the number of memory accesses needed ! to reference an operand. the auto-decrement modes ! are included since their values are known but they ! are never seen (only final generates auto-decrement). ! the same goes for auto-increment modes except that ! the PC variation is actually used. Bind KOPND = Uplit Byte ( 0, ! R 1, ! @R 1, ! (R)+ 2, ! @(R)+ 1, ! -(R) 2, ! @-(R) 2, ! n(R) 3 ! @n(R) ) : Vector[,Byte]; Bind KOPNDX = Uplit Byte ( 1, ! R 2, ! @R 7, ! (R)+ 9, ! @(R)+ 7, ! -(R) 9, ! @-(R) 7, ! n(R) 8 ! @n(R) ) : Vector[,Byte]; ! ! FUNCTION: ! INCREMENT THE MIN AND MAX USE COMPLEXITY FIELDS OF THE TEMP NAME ! POINTED TO BY 'NODE' (A GT NODE OR SYMBOL TABLE ENTRY) BY 'MN' & 'MX' ! RESPECTIVELY. ALSO UPDATE 'MAXKOST' IF ANY LARGER ONE COMES THRU. ! Routine UPDATE(NODE : Ref GT,MN,MX) : Novalue = Begin Local TN : Ref GT, Z : Ref GT; ! want either a symbol, node, or tempname If .NODE[gt_type] Eql T_LITERAL Then Return; ! get the associated tempname TN = .NODE[gt_reg]; If .TN Lssu 8 Then Return; ! only tempnames which are not literals may be updated If .TN[gt_type] Neq T_TEMPNAME Then Return; If .TN[tn_v_lit] Then Return; ! if this tempname is bound to another tempname then update what it's ! bound to. Z = .TN[gt_reg]; If .Z Gequ 8 Then ! TAKING ACCOUNT OF BINDSTORE Begin If .Z[gt_type] Eql T_TEMPNAME Then UPDATE(.TN,.MN,.MX) Else UPDATE(.Z,.MN,.MX) End Else ! otherwise this is a tempname not bound to another, so update it Begin TN[tn_min_complexity] = .TN[tn_min_complexity] + .MN*(.LOOPDEPTH+1); TN[tn_max_complexity] = .TN[tn_max_complexity] + .MX*(.LOOPDEPTH+1) End End; ! FUNCTION: ! COST OF ACCESSING NODE 'N' IF IT'S IN A REGISTER. ! ! notes: ! for literals, cost is that of auto-increment Macro K(N) = Begin If .N[gt_type] Eql T_LITERAL Then 1 Else .KOPND[.N[gt_mode]] End %; ! ! FUNCTION: ! COST OF ACCESSING NODE 'N' IF IT'S IN MEMORY. ! ! notes: ! for literals, cost is that of auto-increment Macro KX(N) = Begin If .N[gt_type] Eql T_LITERAL Then 1 Else .KOPNDX[.N[gt_mode]] End %; ! common form of cost updating Routine UPDATE2(NODE : Ref GT,N : Integer) : Novalue = Begin UPDATE(.NODE,.N * K(NODE),.N * KX(NODE) ) End; ! ! FUNCTION: ! COMPUTE THE APPROXIMATE NUMBER OF ACCESSES TO A WORD REQUIRED ! TO SHIFT A FIELD OF SIZE 'SIZE' A DISTANCE OF 'DIST' BITS. ! Routine SHIFTKOST(DIST : Integer,SIZE : Integer) = Begin DIST = Abs(.DIST); ! if the top four bits, cost is number of rotates left plus ! an extra rotate out of carry (e.g. 16-.dist + 1) If .DIST Gtr 12 Then DIST = 17-.DIST; ! for a high byte access, cost is that of a low byte access ! plus the cost of a SWAB (e.g. .dist-8 + 1) If .DIST Gtr 7 Then DIST = .DIST-7; ! single bit access is independent of the distance If .SIZE Eql 1 Then DIST = 2; Return .DIST End; ! FUNCTION: ! COMPUTE THE NUMBER OF ACCESSES TO A WORD REQUIRED TO MAKE IT ! DESTROYABLE AND/OR SHIFT THE REQUIRED FIELD TO THE RIGHT END ! OF THE WORD. ! Routine KOSTOFTEMP(NODE : Ref GT) = Begin Local Z : Integer; ! only expressions are destroyable If .NODE[gt_type] Neq T_NODE Then Z = 0 ! if not destroyable then cost is a move to a new register Else If Not .NODE[rw_destroyable] Then Z = 1 ! if destroyable and a full word then no moves needed Else If .NODE[gt_len] Eql 16 Then Z = 0 Else ! if destroyable but a bad size then the cost is that of ! a shift plus the cost of a mask (1) Z = 1 + SHIFTKOST(-.NODE[gt_pos],.NODE[gt_len]); Return .Z End; ! FUNCTION: ! COMPUTE THE NUMBER OF ACCESSES TO 'NODE2' REQUIRED ! TO GENERATE A MOVE FROM 'NODE1' TO 'NODE2'. ! Routine KKMOV(NODE1 : Ref GT,NODE2 : Ref GT) = Begin ! Q: what does it mean to move to a literal? to an absolute address ! perhaps (e.g. 512 = .X)? If .NODE2[gt_type] Eql T_LITERAL Then Return 1 ! if not an expression then it must be some form of literal. ! ! Q: what if NODE2 is a field? it seems to assume either it is ! not a field or that the value stored is nice (e.g. zero or ! all ones). in either case it may be so rare it doesn't matter. Else If .NODE1[gt_type] Neq T_NODE Then Return 1 Else ! otherwise the result is: ! +1 if to a different tempname ! +n if shifts are involved where 'n' is the shift cost ! +1 if masking is needed Return (.NODE1[gt_reg] Neqa .NODE2[gt_reg]) + SHIFTKOST(.NODE2[gt_pos]-.NODE1[gt_pos],.NODE1[gt_len]) + (.NODE2[gt_len] Neq 16) End; ! FUNCTION: ! DRIVER FOR COST UPDATING FOR TYPICAL UNARY OPERATOR NODES. Routine KUNOP(NODE : Ref GT,UOP : Ref GT,KOP : Integer) : Novalue = Begin Local KMOV : Integer; ! a unary operation is normally a move to the destination and then ! an operate. KMOV = KKMOV(.UOP,.NODE); ! the cost of the source is one access if it had to be moved If .KMOV Neq 0 Then UPDATE2(.UOP,1); ! the cost of the destination is the cost of moving, shifting, and ! masking plus the cost of the operation itself UPDATE2(.NODE,.KMOV + .KOP) End; ! ! FUNCTION: ! DRIVER FOR COST UPDATING FOR TYPICAL BINARY OPERATOR NODES. ! Routine KBINOP(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT,KOP : Integer) : Novalue = Begin Local KMOV : Integer; ! place the operands in the correct target path order If .NODE[gt_v_tpath] Then Begin KMOV = .LOP; LOP = .ROP; ROP = .KMOV End; ! get the cost of moving one operand to the target and update the ! source if a move will actually be required KMOV = KKMOV(.LOP,.NODE); If .KMOV Neq 0 Then UPDATE2(.LOP,1); ! update the second operand by the cost of the operation. ! ! Q: no shift or masking cost? why not use KOSTOFTEMP? UPDATE2(.ROP,.KOP); ! the cost of the target is the cost of moving, shifting, masking ! plus the cost of the operation itself UPDATE2(.NODE,.KMOV + .KOP) End; ! ! FUNCTION: ! DRIVER FOR COST UPDATING FOR +,- NODES. ! Routine KASOP(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT) : Novalue = Begin Local Z : Ref GT, N : Integer; ! Q: taking account of distributed multiply? If .NODE[rw_immediate] And .NODE[gt_mode] Gtr GENREG+DEFERRED Then NODE[gt_mode] = GENREG; ! place the operands in the correct target path order If .NODE[gt_v_tpath] Then Begin Z = .LOP; LOP = .ROP; ROP = .Z End; ! add/sub nodes may generate several instructions. count the number ! of instruction that would be performed. N = SUMBITS(.NODE[RCBITS]); ! if a move is required, add it the cost of the move less one because ! [rc_mov_target] was added in the SUMBITS above. If .NODE[rc_mov_target] Then N = .N - 1 + KKMOV(.LOP,.NODE); ! now update the target If .N Gtr 0 Then UPDATE2(.NODE,.N); ! update the left operand if it is not the same as node If .NODE[rc_mov_target] And .LOP[gt_type] Eql T_NODE And .NODE[gt_reg] Neqa .LOP[gt_reg] Then UPDATE2(.LOP,1); ! update the right operand if it is actually operated upon If .NODE[rc_operate] Then UPDATE2(.ROP,KOSTOFTEMP(.ROP)+1) End; ! ! FUNCTION: ! DRIVER FOR COST UPDATING FOR A ^ NODE. ! ! notes: ! the cost determinations in this routine are tightly ! coupled to the actual code generated by GSHIFTROT ! in code.bli Routine KSHFTOP(NODE : Ref GT,LOP : Ref GT,NUM : Integer) : Novalue = Begin Local KMIN : Integer, KMAX : Integer, KMOV : Integer; KMIN = 0; KMAX = 0; ! if it looks like a SWAB is needed If .NUM Geq 8 Then Begin KMIN = 1; KMAX = 1; NUM = .NUM - 8 End; ! a shift of seven generates SWAB, RORB, ROR, mask (see GSHIFTROT in code.bli) If .NUM Eql 7 Then KMIN = KMAX = .KMAX + 4 Else ! otherwise count the number of shifts needed. for right shifts, ! GSHIFTROT may code a tiny loop and so adjust for its cost. Begin KMIN = KMAX = .KMAX + Abs(.NUM); If .NUM Leq -8 Then KMAX = .KMIN + 5 End; ! TAKING ACCT. OF DISTRIB. MULTIPY. If .NODE[rw_immediate] And .NODE[gt_mode] Gtr GENREG+DEFERRED Then NODE[gt_mode] = GENREG; ! get the cost of moving the source to the target and update the ! source if a move is really required KMOV = KKMOV(.LOP,.NODE); If .KMOV Neq 0 Then UPDATE2(.LOP,1); ! update the target now. UPDATE(.NODE,(.KMOV+.KMIN)*K(NODE),(.KMOV+.KMAX)*KX(NODE)) End; ! ! FUNCTION: ! DRIVER FOR COST UPDATING FOR RELATIONAL OPERATOR NODES. ! Routine KRELOP(NODE : Ref GT,LOP : Ref GT,ROP : Ref GT) : Novalue = Begin ! single access to both operands. ! ! Q: should it not be KOSTOFTEMP? UPDATE2(.LOP,1); UPDATE2(.ROP,1); ! if code is to be generated, include cost of a CLR and INC of ! the target (see GREL) If .NODE[rw_real] Then UPDATE2(.NODE,2) End; ! ! FUNCTION: ! COMPUTE NUMBER OF ACCESSES TO THE TEMP OF A LOAD NODE. ! ! notes: ! cost = ! +1 for the load ! +1 if it needs to be negated ! +1 if it needs to be complemented ! +2 if an address calculation is required ! ! this assumes that there is no load-negate or load-complemented ! instruction. Macro LOADANALYSIS = ( 1 + .NODE[rc_negate] + .NODE[rc_complement] + 2 * .NODE[rw_immediate]) %; ! ! FUNCTION: ! DRIVER FOR COST UPDATING FOR ANY CONTROL NODE WHICH HAS ! A DEFAULT VALUE RETURNED, E.G. -1 FOR A LOOP, ETC. ! ! notes: ! the cost of a control is the cost of loading up ! the default value. Macro CTRLKOST = UPDATE2(.NODE,1) %; ! ! FUNCTION: ! DRIVER FOR COST UPDATING FOR INCR/DECR NODES. ! Routine IDKOST(NODE : Ref GT) : Novalue = Begin Local O1 : Ref GT, O3 : Ref GT, O4 : Ref GT; O1 = .NODE[gt_arg1]; ! variable O3 = .NODE[gt_arg3]; ! TO part O4 = .NODE[gt_arg4]; ! BY part LOOPDEPTH = .LOOPDEPTH+1; ! two accesses to the variable (test and increment) UPDATE2(.O1,2); ! one each to the TO and BY parts UPDATE2(.O3,1); UPDATE2(.O4,1); LOOPDEPTH = .LOOPDEPTH-1; ! calculate the cost of moving the FROM part to the variable KUNOP(.O1,.NODE[gt_arg2],0) ! FROM part End; ! ! FUNCTION: ! MAIN COST CONTROL ROUTINE. CALLED BY TLA FOR COST UPDATING OF ! THE CURRENT NODE. SWITCHES TO THE NODE-SPECIFIC COST UPDATING ! ROUTINES. ! Routine KOST(NODE : Ref GT) : Novalue = Begin Local LOP : Ref GT, ROP : Ref GT, O2 : Ref GT; Literal KLABEL = 2, ! EST. AVG. NUMBER OF LEAVES TO ANY LABEL MUSTBEREG = 20; ! no costs if nothing being generated here If Not .NODE[gt_v_mustgencode] Then Return; ! for control operators... If .NODE[gt_code] Gtr MAXOPERATOR Then Begin Selectone .NODE[gt_code] Of Set [OP_WHILE,OP_UNTIL,OP_DO_WHILE,OP_DO_UNTIL]: CTRLKOST; [OP_STORE]: Begin ! get the operands in target path order If .NODE[gt_v_tpath] Then Begin LOP = .NODE[gt_arg2]; ROP = .NODE[gt_arg1] End Else Begin LOP = .NODE[gt_arg1]; ROP = .NODE[gt_arg2] End; ! if the result is wanted then calculate the cost of moving the ! source to the target and the target to the destination ! otherwise just calculate the cost of moving the source to ! the destination If REQ_RESULT Then Begin KUNOP(.NODE,.ROP,0); KUNOP(.LOP,.NODE,0) End Else KUNOP(.LOP,.ROP,0) End; [OP_IF]: Begin ! calculate the cost of the condition UPDATE2(.NODE[gt_arg2],1); ! if the result is needed, calculate the cost of the THEN and ELSE parts ! moving to the target If REQ_RESULT Then Begin KUNOP(.NODE,.NODE[gt_arg3],0); KUNOP(.NODE,.NODE[gt_arg4],0) End End; [OP_CASE]: Begin ! calculate the cost of the case selector. a ridiculous number ! is used (20) as the cost because GCASE will generate several ! accesses to it. UPDATE2(.NODE[gt_arg2],MUSTBEREG); ! if the result is needed, calculate the cost of moving each case ! to the target. If REQ_RESULT Then Incr I From 2 To .NODE[gt_argc]-2 Do KUNOP(.NODE,.NODE[gt_argv(.I)],0) End; [OP_SELECT]: Begin Macro OPND(I) = NODE[gt_argv(I)] %, LAST(I) = NODE[gt_argv(.NODE[gt_argc]-I)] %; Local FO : Integer, LAS2 : Ref GT, L : Ref GT; ! calculate the cost of moving a -1 into the result If REQ_RESULT And Not .NODE[rc_otherwise] Then CTRLKOST; ! get the index of the OTHERWISE case. if there is an OTHERWISE ! then a tempname is kept to record whether any of the cases have ! been used. and the cost update here is for initializing that ! tempname. L = .LAST(1); FO = .L[gt_disp]; If .FO Neq 0 Then Begin LAS2 = .LAST(2); UPDATE2(.LAS2,1) End; ! loop for each select case LOP = .OPND(0); Incr I From 1 To .NODE[gt_argc]-4 By 2 Do Begin ! before the first otherwise, an INC is generated for each case If .I Leq .FO Then UPDATE2(.LAS2,1); ! calculate the cost of comparing the selector against this case ROP = .OPND(.I); If .ROP Neqa .sym_always And .ROP Neqa .sym_otherwise Then Begin UPDATE2(.LOP,1); UPDATE2(.ROP,1) End; ! update the cost of moving this selection to the target If REQ_RESULT Then KUNOP(.NODE,.OPND(.I+1),0) End End; [OP_INCR,OP_DECR]: IDKOST(.NODE); [OP_FPARM]: ! cost of stacking a call parameter KUNOP(.NODE,.NODE[gt_arg1],LOADANALYSIS); [OP_LABEL]: ! the cost of a labelled block is the estimated number of LEAVEs ! in it plus the cost of moving the block value itself into ! the target. ! ! Q: it seems that the actual number of LEAVEs could ! be saved in the node and so an exact count rather than an ! estimate could be used. could it not? ! ! A: due to LEX and FLO being part of the same phase and the ! constant folding for IF and CASE statements discarding nodes, ! the accounting might get hairy. separate LEX and FLO and ! it might be feasible. If REQ_RESULT Then KUNOP(.NODE,.NODE[gt_arg1], If .Block[.NODE[gt_arg2],st_lab_left] Then KLABEL Else 1) Tes End Else ! cost of operator nodes... Begin ! no cost if the result of the operator is not needed If Not REQ_RESULT Then Return; ! get the operands LOP = .NODE[gt_arg1]; If .NODE[gt_argc] Geq 2 Then ROP = .NODE[gt_arg2]; If ISRELOP(NODE) Then KRELOP(.NODE,.LOP,.ROP) Else Selectone .NODE[gt_code] Of Set [OP_ADD,OP_SUB]: KASOP(.NODE,.LOP,.ROP); [OP_SWAB]: KUNOP(.NODE,.LOP,1); [OP_LOAD_NODE]: KUNOP(.NODE,.LOP,LOADANALYSIS); [OP_AND,OP_OR]: ! cost = 2 for AND because of need to use COM and BIC. not ! sure for OR but it may have to do with state of complemented ! operands. KBINOP(.NODE,.LOP,.ROP,2); [OP_MAX,OP_MIN]: ! cost = 2 because of two potential moves to the target KBINOP(.NODE,.LOP,.ROP,2); [OP_XOR,OP_EQV]: ! code for XOR and EQV is normally the four instructions COM, BIC, BIC, BIS KBINOP(.NODE,.LOP,.ROP,4); [OP_SHIFT]: KSHFTOP(.NODE,.LOP,.ROP[gt_disp_16]); [OP_ROT]: Begin Local X; X = .ROP[gt_disp_16]; X = Abs(.X); If .X Gtr 8 Then X = 17 - .X; KUNOP(.NODE,.LOP,.X) End Tes End End; ! THE FOLLOWING ROUTINES,ETC., ARE CONCERNED ! WITH DETERMINING THE LIFE 'SPAN' OF A TEMP NAME. ! THE 'SPAN' IS DEFINED IN TERMS OF TWO QUANTITIES, ! THE 'LON' AND 'FON'. (SEE THE TNBIND DOCUMENTATION ! FOR THE DEFINITION AND USE OF THESE). ! ! THE PROCESS OF DETERMINING THE 'SPAN' IS ACCOMPLISHED ! BY A SINGLE ROUTINE 'SPAN' AND A NUMBER OF NODE-SPECIFIC ! DRIVERS FOR SPAN. FOR EXAMPLE, ALL BINARY OPERATORS ! INVOKE THE ROUTINE 'SPANBINARY' WHICH, IN TURN, ! MAKES SEVERAL CALLS ON SPAN. Macro NEXTLON = (LON = .LON+1) %, NEXTFON = (FON = .FON+1) %, SAVE_STACK_DEPTH= PUSHLS(stk_dtd,-1,.DTEMPS[stk_idx]) %, POP_STACK_DEPTH = POPLS(stk_dtd) %; ! ! FUNCTION: ! USED AFTER EACH BRANCH OF A FORK. KEEPS TRACK (IN stk_dtd_hi) OF THE ! LOWEST LEVEL TO WHICH ANY BRANCH RAISED DTEMPS[CURD] (THE ! DYNAMIC TEMPS STACK DEPTH). ALSO RESETS THE DYTEMP STACK TO ! WHATEVER IT WAS BEFORE THE BRANCH. ! Macro RESET_STACK_DEPTH = Begin Local P : Ref ITEM; P = .stk_dtd[itm_rlink]; If .DTEMPS[stk_idx] Lss .P[stk_dtd_hi] Then P[stk_dtd_hi] = .DTEMPS[stk_idx]; CLOSEDYTEMPS(.P[stk_dtd_lo]) End %; ! ! FUNCTION: ! USED AFTER AN ENTIRE FORK. CUTS BACK THE DYTEMPS STACK ! TO THE MINIMUM HEIGHT, KEPT TRACK OF AS NOTED ABOVE. ! Macro MINIMIZE_STACK_DEPTH = Begin Local P : Ref ITEM; P = .stk_dtd[itm_rlink]; If .DTEMPS[stk_idx] Lss .P[stk_dtd_hi] Then P[stk_dtd_hi] = .DTEMPS[stk_idx]; CLOSEDYTEMPS(.P[stk_dtd_hi]) End %; ! used by TL_INLINE, TL_DOT, TL_CALL, TL_LEAVE, TL_RETURN, TL_FAKECSE, ! TL_ENABLE, TL_COMMON Macro SET_DONT_CARE_DEPTH = NODE[gt_dtdelete] = DTDONTCARE %, ! create a new FON stack entry with [stk_fon_hi] = [stk_fon_lo] = .FON SAVFON = PUSHLS(stk_fon,.FON,.FON) %, ! starts a new branch by noting whether the last branch was the ! highwater point and resets back to the original FON RESET_FON = Begin Local P : Ref ITEM; P = .stk_fon[itm_rlink]; If .FON Gtru .P[stk_fon_hi] Then P[stk_fon_hi] = .FON; FON = .P[stk_fon_lo] End %, ! at the end of the last branch, set FON to the highest FON in all ! the branches. MAXIMIZE_FON = Begin Local P : Ref ITEM; P = .stk_fon[itm_rlink]; If .P[stk_fon_hi] Gtru .FON Then FON = .P[stk_fon_hi]; POPLS(stk_fon) End %; Macro UPDATELONFON = (NODE[gt_lon] = NEXTLON; NODE[gt_fon] = NEXTFON) %, ASSIGNLABELS = If .NODE[rw_flow] Then Begin NODE[gt_lab_t] = .LAB_T; NODE[gt_lab_f] = .LAB_F; If .LAB_T Neqa 0 Then LAB_T[gt_v_lab_req] = TRUE; If .LAB_F Neqa 0 Then LAB_F[gt_v_lab_req] = TRUE End %; ! ! FUNCTION: ! MAKES SURE THAT CODE WILL BE GENERATED TO CLEAN UP THE STACK ! DOWN TO LEVEL 'NUM', AFTER CODING OF 'NODE'. ! ! called by TL_CALL Routine KILLPDTEMPS(NODE : Ref GT,NUM : Integer) : Novalue = Begin If .NODE[gt_type] Eql T_NODE Then Begin CLOSEDYTEMPS(.NUM); NODE[gt_dtdelete] = (.NUM+1)*2 End End; ! ! FUNCTION: EXIT ROUTINE FOR KILLDYTEMPS AND KILLFORKDYTEMPS ! MAKES SURE APPROPRIATE SUBNODES PUT OUT STACK CLEANUP ! CODE IF NECESSARY (I.E. IF THEY ARE LIKELY TO CAUSE ! BRANCHES TO LABELS PAST THE NODE'S STACK CLEANUP CODE) ! Routine KCLEANUP(ROUT,NODE : Ref GT) : Novalue = Begin ! compound statements are transparent If .NODE[gt_code] Eql OP_COMPOUND Then Begin Bliss(.ROUT,.NODE[LASTOPERAND]); Return End; ! if it doesn't generate any branching... If Not REQ_FLOW Then Begin ! Q: I don't understand this. if it's now flow (e.g. its real) then ! it seems it cannot branch out. so why? ! ! A: DELAY converted expressions like '(.X And 4) Eql 4' to a bit test ! operation. the '.X And 4' doesn't look like a flow result but ! it really is. If Not ISRELOP(NODE) Then Return; If .Block[.NODE[gt_arg1],gt_code] Neq OP_BIT And .Block[.NODE[gt_arg2],gt_code] Neq OP_BIT Then Return End; ! fixup an IF statement ! ! Q: (why not combine with CASE code below?) If .NODE[gt_code] Eql OP_IF Then Begin Bliss(.ROUT,.NODE[gt_arg3]); Bliss(.ROUT,.NODE[gt_arg4]); Return End; ! fixup a CASE statement If .NODE[gt_code] Eql OP_CASE Then Begin Incr I From 2 To .NODE[gt_argc]-2 Do Bliss(.ROUT,.NODE[gt_argv(.I)]); Return End; ! AT THIS POINT, NODE MUST BE AND, OR, OR NOT ! ! Q: and how about XOR and EQV and the relational operators? Bliss(.ROUT,.NODE[gt_arg1]); If .NODE[gt_argc] Eql 2 Then Bliss(.ROUT,.NODE[gt_arg2]) End; ! ! FUNCTION: ! USED ON EACH BRANCH OF A FORK AFTER MINIMIZE_STACK_DEPTH. MAKES ! SURE THAT CODE TO CLEAN UP THE STACK IS GENERATED AFTER EACH BRANCH. ! ! called by ND_IF for THEN and ELSE part and by ND_CASE for each case ! ! notes: ! the stack is only cleaned up to the lowest stack depth of all ! the forks (in [stk_dtd_hi]). Routine KILLFORKDYTEMPS(NODE : Ref GT) : Novalue = Begin Local P : Ref ITEM; If .NODE[gt_type] Eql T_NODE Then Begin P = .stk_dtd[itm_rlink]; NODE[gt_dtdelete] = (.P[stk_dtd_hi]+1)*2; KCLEANUP(KILLFORKDYTEMPS,.NODE) End End; ! called by TL_CALL, ND_AND, ND_OR, FLOOP, ND_IDLOOP, ND_SELECT ! ! notes: ! similar to KILLFORKDYTEMPS except that no stack temps are ! allowed to lay around. Routine KILLDYTEMPS(NODE : Ref GT) : Novalue = Begin Local P : Ref ITEM, N : Integer; If .NODE[gt_type] Eql T_NODE Then Begin P = .stk_dtd[itm_rlink]; N = .P[stk_dtd_lo]; CLOSEDYTEMPS(.N); NODE[gt_dtdelete] = (.N+1)*2; KCLEANUP(KILLDYTEMPS,.NODE) End End; ! called by ND_ADD, ND_OR, ND_IF, ND_CASE, ND_SELECT, TL_LABEL ! ! notes: ! after the evaluation of a node, any stack temporaries ! created are now invalid except for those of formal ! parameters. this routine marks any open temporaries ! as no longer in use. see MUSTBETOP in TRY.BLI. Routine SETNOTFPARM : Novalue = Begin Local A : Integer, R : Ref ITEM; A = .DTEMPS[stk_idx]+1; If .A Leq .DTEMPS[stk_max] Then Begin R = DTEMPS[stk_item(.A)]; REOPEN(.R,.LON,.FON); CLOSELIST(.R,.LON) End End; Macro TNSPAN(XTN) = Begin If .XTN Gtru 8 Then Begin XTN[tn_lon_lu] = .LON; XTN[tn_fon_lu] = .FON End End %, INITTNSPAN(XTN) = Begin If .XTN Gtru 8 Then Begin XTN[tn_fon_fu] = XTN[tn_fon_lu] = .FON; XTN[tn_lon_fu] = XTN[tn_lon_lu] = .LON End End %; Routine SPAN(NODE : Ref GT,INC : Integer) : Novalue = Begin Local TN : Ref GT, N : Integer; ! if a symbol, only things which may be placed in a register may ! be spanned. If .NODE[gt_type] Eql T_VARIABLE Then NODE = .NODE[gt_disp]; If .NODE[gt_type] Eql T_SYMBOL Then Begin If Not ONEOF(.NODE[st_code],S_REGISTER,S_LOCAL,S_FORMAL) Then Return End ! literals are not spanned Else If .NODE[gt_type] Neq T_NODE Then Return ! compound statements are transparent Else If .NODE[gt_code] Eql OP_COMPOUND Then SPAN(.NODE[LASTOPERAND],.INC); ! get the tempname associated with this symbol/node. if there ! is none or it is a literal then no need to span it. TN = .NODE[gt_reg]; If .TN Lssu 8 Then Return; If .TN[tn_v_lit] Then Return; ! note first LON usage If .TN[tn_lon_fu] Gtr .LON Then TN[tn_lon_fu] = .LON; ! note last LON usage If .TN[tn_lon_lu] Lss .LON Then TN[tn_lon_lu] = .LON - .INC; ! note first FON usage If .TN[tn_fon_fu] Gtr .FON Then TN[tn_fon_fu] = .FON; ! note last FON usage If .TN[tn_fon_lu] Lss .FON Then TN[tn_fon_lu] = .FON - .INC; ! compute and note the loop depth N = .TN[tn_depth]; If .NODE[gt_type] Eql T_NODE And .N Gtr .NODE[gt_depth] Then N = .NODE[gt_depth]; ! if inside a loop, create a note of it so it will be trimmed by ! XITLOOP later on. If .N Lss .LOOPDEPTH Then LINK(TNREP(.TN),stk_loop[stk_item(.N)]); ! for memory and reg-or-forget TN's, also span what they are bound to Selectone .TN[tn_request] Of Set [BIND_MEMORY]: NODE = .TN[gt_reg]; [BIND_REG_OR_FORGET]: NODE = .TN[gt_disp]; [Otherwise]: Return Tes; ! tempnames do not have a [gt_type] so we must use [gt_type] instead Selectone .NODE[gt_type] Of Set [T_TEMPNAME]: 0; ! Q: how can a tempname reference a node? [T_NODE,T_VARIABLE,T_SYMBOL]: SPAN(.NODE,.INC) Tes End; Routine SPAN_BINARY(NODE : Ref GT) : Novalue = Begin Local TN : Ref GT; ! span the node itself SPAN(.NODE,0); ! span the non-target path next. it had previously been spanned ! but is spanned again because its life extends to here where node ! is evaluated. If .NODE[gt_v_tpath] Then (TN = .NODE[gt_arg2]; SPAN(.NODE[gt_arg1],0)) Else (TN = .NODE[gt_arg1]; SPAN(.NODE[gt_arg2],0)); ! now span the target path. ! ! Q: why be concerned if TN is a literal? SPAN will reject it ! immediately and thus the increment value does not matter. ! ! Q: why are operations on single bits shaded one and nothing else? If .TN[gt_type] Eql T_LITERAL Or .TN[gt_len] Neq 1 Then SPAN(.TN,1) Else SPAN(.TN,0) End; Routine SPAN_AND_OR(NODE : Ref GT) : Novalue = Begin ! no need to span if no real result If Not REQ_FLOW Then SPAN_BINARY(.NODE) End; Routine SPAN_REL(NODE : Ref GT) : Novalue = Begin SPAN(.NODE,0); ! span the arguments to extend their lives. their lives are not ! shaded back one due to node's tempname being initialized before ! the actual compare takes place. e.g.: ! ! A = (.B Eql .C) ! ! might look like: ! ! CLR A ! CMP B,C ! BNE 1$ ! INC A ! 1$: ! ! this is for real values and not for flow. if it were for flow then ! node would not have a tempname. ! SPAN(.NODE[gt_arg1],0); SPAN(.NODE[gt_arg2],0) End; Routine SPAN_STORE(NODE : Ref GT) : Novalue = Begin Local L : Ref GT, N : Integer; ! span the node SPAN(.NODE,0); ! span the target path If .NODE[gt_v_tpath] Then (L = .NODE[gt_arg1]; SPAN(.NODE[gt_arg2],0)) Else (L = .NODE[gt_arg2]; SPAN(.NODE[gt_arg1],0)); ! compute the shading for the non-target. ! ! Q: why single bit operations? If Not REQ_RESULT Then N = 0 Else If .L[gt_type] Neq T_NODE Then N = 1 Else If .L[gt_code] Leq MAXOPERATOR Then N = (.L[gt_len] Neq 1) Else N = 0; ! span the non-target path SPAN(.L,.N) End; Routine SPAN_UNARY(NODE : Ref GT) : Novalue = Begin ! span the node and span the argument. the argument had previously ! been spanned when it was TLA'd but is spanned again to extend ! it life to just before the start of the life of node. SPAN(.NODE,0); SPAN(.NODE[gt_arg1],1) End; ! called for MFPI and friends, and TL_DOT Routine SPAN_UXNARY(NODE : Ref GT) : Novalue = Begin SPAN(.NODE,0); ! Q: while is the shading zero? SPAN(.NODE[gt_arg1],0) End; ! spanner for CASE, IF, SELECT, WHILE-DO, DO-WHILE, ENABLE, COMPOUND, ! call-param, and call-store ! ! note: no spanning of arguments Routine SPAN_UX(NODE : Ref GT) : Novalue = Begin SPAN(.NODE,0) End; Routine SPAN_LOADNODE(NODE : Ref GT) : Novalue = Begin Local OP : Ref GT; SPAN(.NODE,0); OP = .NODE[gt_arg1]; If .OP[gt_type] Eql T_VARIABLE Then SPAN(.OP,0) Else If .OP[gt_type] Neq T_LITERAL And .OP[gt_len] Eql 1 Then SPAN(.OP,0) End; Routine SPAN_INCR_DECR(NODE : Ref GT) : Novalue = Begin SPAN(.NODE,0); ! these had previously been spanned but we span them again because ! when they were first spanned, it was in a limited context and ! not in the context of the entire loop. ! the initial value is not spanned because its context is not the ! whole loop. SPAN(.NODE[gt_arg1],1); ! control variable SPAN(.NODE[gt_arg3],1); ! FROM part SPAN(.NODE[gt_arg4],1) ! TO part End; ! called at the start of a loop to save the current state and ! setup for a loop. Routine ENTLOOP : Novalue = Begin SAVE_STACK_DEPTH; PUSHSTK(stk_loop); NEXTLON; NEXTFON; PUSHLS(stk_loop_lf,.LON,.FON); LOOPDEPTH = .LOOPDEPTH+1 End; ! called at the end of a loop Routine XITLOOP : Novalue = Begin Local L : Integer, P : Ref TNREPR, R : Ref ITEM, TR : Ref TNREPR, T : Ref GT; RESET_STACK_DEPTH; R = .stk_loop_lf[itm_rlink]; P = stk_loop[stk_item(.stk_loop[stk_idx])]; ! limit the LON/FON of all tempnames in this loop to the bounds of ! the loop TR = .P; Until (TR = .TR[itm_rlink]) Eqla .P Do Begin T = .TR[tnr_ptr]; If .T[tn_lon_fu] Gtr .R[stk_exit_lon] Then T[tn_lon_fu] = .R[stk_exit_lon]; If .T[tn_lon_lu] Lssu .LON Then T[tn_lon_lu] = .LON; If .T[tn_fon_fu] Gtr .R[stk_exit_fon] Then T[tn_fon_fu] = .R[stk_exit_fon]; If .T[tn_fon_lu] Lss .FON Then T[tn_fon_lu] = .FON End; ! restore the previous context LOOPDEPTH = .LOOPDEPTH-1; POPSTK(stk_loop); POPLS(stk_loop_lf) End; ! ! FUNCTION: ! 'NODE' IS A CSE. ASSIGN THE SAME TN TO ! ALL THE OCCURRENCES OF THE CSE. ! ! called from TLLIST, TL_DOT, and TL_COMMON Routine BINDUSES(NODE : Ref GT) : Novalue = Begin Local PNODE : Ref GT, T : Ref GT; PNODE = .NODE[gt_csparent]; PNODE[gt_v_bound] = TRUE; ! SAVES SOME TROUBLE FOR BOGUS NODES T = .NODE[gt_reg]; If .T Lssu 8 Then Return; If .T[tn_request] Eqla BIND_NONE Then T[tn_request] = BIND_DECLARE; ! TREAT CSE'S LIKE DECLARED TN'S Do Begin ! only assign if the result is wanted If .PNODE[rw_real_flow] Neq RFNONE Then PNODE[gt_reg] = .T; ! if not delayed then this is a bogus node. delay clobbered the bogus ! bit and 'delayed' serves as the new bogus bit. ! only bogus nodes with their mustgencode bit turned off are not bound. If Not (.PNODE[gt_v_delayed] And .PNODE[gt_v_mustgencode]) Then PNODE[gt_v_bound] = TRUE End Until (PNODE = .PNODE[gt_csthread]) Eqla 0 End; ! B. - SPECIFIC ROUTINES ! ------------------------------------------------ ! ! ! THIS SECTION CONTAINS THE NODE-SPECIFIC TN ASSIGNMENT ! ROUTINES. THE FLOW WITHIN THESE ROUTINES IS A BIT ! INVOLUTED - A BIT OF EXPLANATION IS PROBABLY IN ORDER: ! ! 1) ASSIGNMENT IS DONE IN AN EXECUTION-ORDER TREE WALK. ! EACH ROUTINE TENDS TO DO A BIT OF WORK AT A NODE THEN ! CALL OTHER BINDERS TO WORK ON ITS SUBNODES, AND FINALLY ! DOES A BIT MORE AT ITS OWN NODE BEFORE RETURNING. ! ! 2) SINCE EACH TYPE OF NODE HAS A ROUTINE TO HANDLE ! IT, THE ROUTINE 'TLA' ACTS AS A SWITCH TO CALL THE ! APPROPRIATE ONE. THAT IS, EACH NODE CALLS 'TLA' ON ITS ! SUBNODES, AND TLA PROMPTLY SWITCHES OFF TO THE ! SPECIFIC ROUTINE. ! ! 3) SINCE MANY OF THE ACTIONS OF BINDING ARE COMMON TO ! EACH OF THE SPECIFIC ROUTINES, A SINGLE ROUTINE, ! 'TLCOMMON', HANDLES THESE IN MOST CASES. IN THESE ! CASES, TLCOMMON CALLS ANOTHER ROUTINE TO PERFORM THE ! NODE-SPECIFIC ACTIONS. TLCOMMON ALSO CALLS THE SPAN ROUTINE ! WHICH IS APPROPRIATE FOR THE SPECIFIC NODE. ! Forward Routine TL_COMMON; ! called by LOOPTLLIST, BINDLST through PULSELIST, ! TL_DOT, TL_FAKECSE, and TL_COMMON ! ! note: OLDFIXLIST turns off the MUSTGENCODE bit for ! alpha and omega list entries. this turns it ! back on temporarily for tempname assignment ! purposes. Routine TLLIST(NODE : Ref GT,P) : Novalue = Begin Local L : Boolean; L = .NODE[gt_v_mustgencode]; NODE[gt_v_mustgencode] = TRUE; TLA(.NODE,0,0,0); BINDUSES(.NODE); NODE[gt_v_mustgencode] = .L End; ! called by LPBINDLST through PULSELIST Routine LOOPTLLIST(NODE : Ref GT,P) : Novalue = Begin Local TN : Ref GT; TLLIST(.NODE,.P); ! note the most outer loop this TN is in TN = .NODE[gt_reg]; If .TN Gequ 8 And .TN[tn_depth] Gtr .LOOPDEPTH Then TN[tn_depth] = .LOOPDEPTH; End; ! called by ND_IF and ND_CASE for both the Alpha and Omega lists. Routine BINDLST(N : Ref GT) : Novalue = Begin PULSELIST(TLLIST,.N[que_head],.N[que_code],0); FIXLIST(.N[que_head]) End; ! called by FLOOP and ND_IDLOOP for both the Chi And Rho ! lists of loops. Routine LPBINDLST(N : Ref GT) : Novalue = Begin PULSELIST(LOOPTLLIST,.N[que_head],.N[que_code],0); If .N[que_code] Eql T_RHO Then FIXRHOLIST(.N[que_head]) End; ! called by TLA routines when 'NODE' is found to be a CSE use Routine TLUSE(NODE : Ref GT) : Novalue = Begin Local PAR : Ref GT; ! Q: how can the parent of a CSE use not be bound? ! ! A: one way is if the parent is a bogus node. see BINDUSES above. PAR = .NODE[gt_csparent]; If Not .PAR[gt_v_bound] Then Begin If Not .PAR[gt_v_delayed] Then ! PAR IS A BOGUS NODE UNBOGUS(PAR); If .PAR Neqa .NODE Then TLLIST(.PAR,0) End End; Routine TL_INLINE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin ! actually, an in-line may change the stack depth but we have no ! way of knowning SET_DONT_CARE_DEPTH; Return 0 End; ! node-specific routine for most binary operators. ! ! NOTE: this code is exactly the same algorithm as on page 76 ! of "The Design of an Optimizing Compiler" Routine ND_BINARY(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local LOP : Ref GT, ROP : Ref GT, OP1 : Ref GT, TEMP : Ref GT; ! pickup the target path LOP = 0; ROP = 0; If .NODE[gt_v_tpath] Then (ROP = .TX; OP1 = .NODE[gt_arg2]) Else (LOP = .TX; OP1 = .NODE[gt_arg1]); ! TLA the LHS, passing the target path if the LHS is the target path LOP = TLA(.NODE[gt_arg1],.LOP,0,0); ! ditto for the RHS ROP = TLA(.NODE[gt_arg2],.ROP,0,0); ! set LOP to the target path result If .NODE[gt_v_tpath] Then LOP = .ROP; ! return if a result is not desired. ! ! Q: why not return 0 if no result is wanted? If Not REQ_RESULT Then Return .LOP; TEMP = 0; If .TX Eqla 0 Then If .OP1[rw_destroyable] Then TX = .LOP Else TEMP = .LOP; ! if a result tempname is required then make sure we have one and ! equivalence our result with it. If TNNEEDED Then Begin FILLTX; WANTPREF(.TX,.TEMP) End; Return .TX End; ! called for NEG, NOT, LABEL, MFTI and friends. Routine ND_UNARY(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin ! Q: why is there no calls to FILLTX and WANTPREF? is it possible ! that DELAY guaranteed that the result of this TLA call will be ! destroyable? Return TLA(.NODE[gt_arg1],.TX,.LAB_T,.LAB_F) End; Routine ISBIT(NODE : Ref GT) = Begin If .NODE[gt_type] Eql T_NODE And .NODE[gt_code] Eql OP_BIT Then Return (TNNEEDED)^1 + 1; Return 0 End; ! notes: ! this code seems to be going to pains to handle the DELAY ! transformations of single bit compares. the problem seems ! to be the paranoia about the possibility of side-effects ! within constant expressions within DELAY. Routine ND_REL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local LOP : Ref GT, ROP : Ref GT, LB1_T : Ref GT, LB1_F : Ref GT, LB2_T : Ref GT, LB2_F : Ref GT, BITLEFT : Boolean, BITRIGHT : Boolean; ! note whether the left and right operands are single bit compares BITLEFT = ISBIT(.NODE[gt_arg1]); BITRIGHT = ISBIT(.NODE[gt_arg2]); ! make sure we have a tempname if a tempname is needed here or for ! either operand If TNNEEDED Or .BITLEFT<1,1> Or .BITRIGHT<1,1> Then FILLTX Else TX = 0; LOP = 0; ROP = 0; LB1_T = 0; LB1_F = 0; LB2_T = 0; LB2_F = 0; If .BITLEFT Then Begin LOP = .TX; LB1_T = .LAB_T; LB1_F = .LAB_F End Else If .BITRIGHT Then Begin ROP = .TX; LB2_T = .LAB_T; LB2_F = .LAB_F End; LOP = TLA(.NODE[gt_arg1],.LOP,.LB1_T,.LB1_F); ROP = TLA(.NODE[gt_arg2],.ROP,.LB2_T,.LB2_F); If .BITLEFT Then WANTPREF(.TX,.LOP) Else If .BITRIGHT Then WANTPREF(.TX,.ROP); Return .TX End; ! function store - store the result of a routine call ! ! note: this routine is also used for formal parameters also. ! ! TLA routines for call-store and call-param Routine ND_FSTO(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local UOP : Ref GT; ! TLA the call itself UOP = TLA(.NODE[gt_arg1],0,0,0); ! if the result of the call is wanted then create a TN for it ! and preference the result to it If REQ_RESULT Then Begin FILLTX; WANTPREF(.TX,.UOP) End; Return .TX End; ! Q: why is SWAB different than the other unary operators? ! the unary operators appears to assume that NODE[gt_arg1] ! is destroyable. Routine ND_SWAB(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local P : Ref GT, UOP : Ref GT; ! TLA the operand UOP = TLA(.NODE[gt_arg1],.TX,0,0); ! if a result is wanted then if the operand is destroyable then ! use that otherwise create a new TN and preference the operand ! to it If REQ_RESULT Then Begin P = .NODE[gt_arg1]; If .P[rw_destroyable] Then TX = .UOP Else Begin FILLTX; WANTPREF(.TX,.UOP) End End; Return .TX End; ! NOTE: there are no references to this routine! Routine ND_FPAR(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local UOP : Ref GT, PARM : Ref GT; ! get the parameter and TLA it PARM = .NODE[gt_arg1]; UOP = TLA(.PARM,0,0,0); ! determine whether the calculation of a parameter should be on ! the stack or whether it should be in a register and then placed ! on the stack. the rule is: ! ! if the top-of-stack is ok for target ! -and- ! a TN was generated (and why shouldn't it?) ! -and- ! the result of the TLA is nothing special (e.g. a register) ! -and- ! the parameter is a destroyable node ! ! Q: when may [tn_request] be zero? ! ! A: PROCPARMS in DECLAR.BLI may create one for a PARM_REGISTER. ! also, FILLTX and calls to GETTN by TLA routines will also ! create them. If .NODE[gt_cs_compl] Leq MAGIC2 And .UOP Gtru 8 Then If .UOP[tn_request] Eqla 0 And .PARM[gt_type] Eql T_NODE Then If .PARM[rw_destroyable] And .PARM[gt_mode] Eql GENREG Then Return .UOP; TX = GETTN(); WANTPREF(.TX,.UOP); Return .TX End; Routine ND_LOADNODE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local Q : Ref GT, UOP : Ref GT, OP1 : Ref GT; ! TLA the one argument OP1 = .NODE[gt_arg1]; UOP = TLA(.OP1,0,0,0); ! Q: is this right? ! ! A: DELAY performed a sorta Alpha motion on named CSE's, moving the ! first loadnode down to the lowest common fork/loop level. in ! doing so it did not update the depth of the node and so we do ! it here. Q = .NODE[gt_reg]; If .q Gequ 8 And .Q[tn_code] Eql BOUND_NCSE Then Q[tn_depth] = .LOOPDEPTH; ! finn in TX if a result (which is usually always) wanted. ! ! Q: what is so special about OP1 being a symbol? If REQ_RESULT Then Begin FILLTX; If .OP1[gt_type] Neq T_VARIABLE Then WANTPREF(.TX,.UOP) End; Return .TX End; Routine ND_ADDSUB(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local LOP : Ref GT, ROP : Ref GT, OP1 : Ref GT, TN : Ref GT, TEMP : Ref GT; ! just like the binary case... LOP = 0; ROP = 0; If .NODE[gt_v_tpath] Then (ROP = .TX;OP1 = .NODE[gt_arg2]) Else (LOP = .TX;OP1 = .NODE[gt_arg1]); LOP = TLA(.NODE[gt_arg1],.LOP,0,0); ROP = TLA(.NODE[gt_arg2],.ROP,0,0); ! get the target path tempname If .NODE[gt_v_tpath] Then LOP = .ROP; If Not REQ_RESULT Then Return .LOP; TN = 0; TEMP = 0; ! if the target path is destroyable then use the target path as ! the destination otherwise save it If .OP1[rw_destroyable] Then TN = .LOP Else TEMP = .LOP; ! if we have a tempname then use it If .TN Gequ 8 Then TX = .TN ! we don't have one. if we really need one... Else If TNNEEDED Then Begin ! note: OP1[rw_destroyable] is FALSE here. this test appears to see ! if it is somehow really destroyable. ! ! Q: what is this really saying? If Not (.NODE[rc_mov_target] And Not .NODE[gt_v_old_rcmt]) Then If Not .NODE[rc_mov_offset] Then TX = .TEMP; FILLTX; WANTPREF(.TX,.TEMP) End; Return .TX End; Routine TL_DOT(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin ! note: this code is much the same as TL_COMMON ! ! Q: can [gt_v_bound] be set on a DOT node already? ! ! Q: can the [gt_reg] field of NODE be already set? ! ! Q: can NODE be a CSE creation? If ISCSEUSE(NODE) Then TLUSE(.NODE) Else Begin TX = TLA(.NODE[gt_arg1],.TX,.LAB_T,.LAB_F); If .NODE[gt_reg] Eqla 0 Then NODE[gt_reg] = .TX; If ISCSECREATION(NODE) Then BINDUSES(.NODE) End; SET_DONT_CARE_DEPTH; UPDATELONFON; NODE[gt_v_bound] = TRUE; ASSIGNLABELS; SPAN_UXNARY(.NODE); Return .NODE[gt_reg] End; ! bind tempname 'ROP' to lexeme 'LOP' ! ! called by TRYSIMPLESTORE and TL_CALL (when calling HALT) Routine BINDSTORE(LOP : Ref GT,ROP : Ref GT) : Novalue = Begin Local SVLON : Integer, SVFON : Integer; If .ROP Lssu 8 Then Return; If .ROP[tn_request] Neqa 0 Then Return; ROP[tn_request] = BIND_MEMORY; If .LOP[gt_type] Eql T_LITERAL Then Begin ROP[tn_v_lit] = TRUE; ROP[tn_literal] = .LOP; ROP[tn_code] = BOUND_NONE; Return End; ROP[gt_reg] = .LOP; UPDATE(.LOP,.ROP[tn_min_complexity]/(.LOOPDEPTH+1), .ROP[tn_max_complexity]/(.LOOPDEPTH+1)); SVLON = .LON; SVFON = .FON; LON = .ROP[tn_lon_fu]; FON = .ROP[tn_fon_fu]; SPAN(.LOP,0); LON = .SVLON; FON = .SVFON End; ! called by FINDLEFT and SIMPLESTORE Routine FINDLEX(LEX : Ref GT,TREE : Ref GT) = Begin Local R : Ref GT; ! macro which changes a node bound to a name-CSE to the name itself Macro FINDNCSE(NODE) = Begin R = .NODE[gt_reg]; If .R Lssu 8 Then Return FALSE; If .R[tn_code] Neq BOUND_NCSE Then Return FALSE; NODE = .R[gt_disp]; If .NODE[gt_type] Eql T_NODE Then Return FALSE End %; ! if a node then it had better be bound to a name-CSE and if so, ! get the name bound to. If .LEX[gt_type] Eql T_NODE Then FINDNCSE(LEX); If .TREE Eqla .LEX Then Return TRUE; If .TREE[gt_type] Neq T_NODE Then Return FALSE; ! if the tree is a symbol reference. If .TREE[gt_code] Eql OP_FAKE_CSE Then Begin FINDNCSE(TREE); Return FINDLEX(.LEX,.TREE) End; ! go down the tree Incr I From 0 To .TREE[gt_argc]-1 Do If FINDLEX(.LEX,.TREE[gt_argv(.I)]) Then Return TRUE; Return FALSE End; Routine FINDLEFT(LN : Ref GT,RN : Ref GT) = Begin Local X : Integer, Y : Integer; If .RN[gt_type] Neq T_NODE Then Return 0; ! check for X = .X ! ! Q: what if LN is a loadnode and RN[gt_arg1] is a fake-cse? ! it seems you need something similar to FINDNCSE above. If .RN[gt_code] Eql OP_DOT Then Return (.RN[gt_arg1] Eqla .LN); If Not ONEOF(.RN[gt_code],OP_ADD,OP_SUB,OP_AND,OP_OR,OP_SWAB, OP_SHIFT,OP_ROT,OP_MAX,OP_MIN,OP_EQV,OP_XOR) Then Return 0; If .RN[gt_v_tpath] Then (X = .RN[gt_arg2];Y = .RN[gt_arg1]) Else (Y = .RN[gt_arg2];X = .RN[gt_arg1]); ! if a binary operator (which just leaves out SWAB) and the LHS is in ! the non-target path If .RN[gt_argc] Eql 2 Then If FINDLEX(.LN,.Y) Then Return 0; ! see if the LHS is in the target path Y = FINDLEFT(.LN,.X); If .Y Neq 0 Then Return .Y+1 ! why not 2? Else Return 0 End; Routine ISNEGNOT(LN : Ref GT,RN : Ref GT) = Begin Local LRN : Ref GT, LLRN : Ref GT; ! check for X = -.X -or- X = Not .X If .RN[gt_type] Neq T_NODE Then Return FALSE; If .RN[gt_code] Neq OP_NEG And .RN[gt_code] Neq OP_NOT Then Return FALSE; LRN = .RN[gt_arg1]; If .LRN[gt_type] Neq T_NODE Then Return FALSE; If .LRN[gt_code] Neq OP_DOT Then Return FALSE; LLRN = .LRN[gt_arg1]; If EQLPOSSIZE(.LN,.LLRN) Then Return TRUE; Return FALSE End; ! ! A "SIMPLE" STORE IS, BY DEFINITION, ONE WHICH DOES NOT ! NEED A SPECIAL TEMPORARY FOR THE RHS. ! ! VALUE RETURNED: ! -1 :: WE HAVE A STORE OF THE FORM ! (EXPR1) = .(EXPR1) OP (EXPR2), ! OR (EXPR1) = NOT .(EXPR1) ! OR (EXPR1) = - .(EXPR2); ! THE 'RCMTF' BIT OF THE 'OP' (OR 'NOT' OR '-') NODE ! SHOULD BE TURNED OFF. ! 1 :: WE HAVE SOME OTHER KIND OF SIMPLE STORE, E.G. ! VAR1 = .VAR2 + 3; ! THE 'RCMTF' BIT OF THE 'OP' NODE SHOULD BE LEFT AS IS. ! 0 :: THE STORE WE ARE DEALING WITH IS NOT SIMPLE. ! Routine SIMPLESTORE(LN : Ref GT,RN : Ref GT) = Begin Macro ADDORSUB=ONEOF(.RN[gt_code],OP_ADD,OP_SUB) %, ANDORIOR=ONEOF(.RN[gt_code],OP_AND,OP_OR) %, SPECIALCASES= Not ONEOF(.RN[gt_code],OP_LOAD_NODE,OP_XOR,OP_EQV, OP_GTR,OP_LEQ,OP_LSS,OP_GEQ,OP_EQL,OP_NEQ, OP_GTRU,OP_LEQU,OP_LSSU,OP_GEQU,OP_EQLU,OP_NEQU) %; Local LRN : Ref GT, LLRN : Ref GT, RRN : Ref GT; Literal SIMPLEVAL = 3; ! routine to test whether an operand is potentially simple Routine SIMPLOP(NODE : Ref GT) = Begin ! note: OP_LOAD_NODE is an operator. ! ! Q: why is not OP_COMPOUND considered? ! ! Q: OP_FAKE_CSE is also used to envelope bind expressions. it seems ! that something nasty can be hidden underneath it. If .NODE[gt_code] Leq MAXOPERATOR Or .NODE[gt_code] Eql OP_FAKE_CSE Then Return TRUE Else If .NODE[gt_code] Eql OP_STORE Then Return SIMPLOP(If .NODE[gt_v_tpath] Then .NODE[gt_arg1] Else .NODE[gt_arg2]) Else Return FALSE End; Routine ISPSOK(LN : Ref GT,RN : Ref GT) = Begin Local SSP; ! truth table: ! ! ~LRN ~RRN CODE result ! N N and 0 ! N Y or 0 ! N N or 1 ! N Y and 1 ! Y N and 2 ! Y Y or 2 ! Y N or 3 ! Y Y and 3 Macro ISBISORBIC= Begin If ANDORIOR Then Begin Local RRN : Ref GT, LRN : Ref GT; If .RN[gt_v_tpath] Then (LRN = .RN[gt_arg2]; RRN = .RN[gt_arg1]) Else (LRN = .RN[gt_arg1]; RRN = .RN[gt_arg2]); (.RRN[rw_complemented] Eqv (.RN[gt_code] Eql OP_AND)) + .LRN[rw_complemented]*2 End Else 0 End %; Macro ISINCORDEC= Begin If ADDORSUB And Abs(.RN[gt_disp_16]) Eql 1 Then (.RN[rc_add_offset] Or .RN[rc_sub_offset]) Else FALSE End %; Macro ISCOMORNEG= (.RN[gt_code] Eql OP_LOAD_NODE And (.RN[rc_complement] Or .RN[rc_negate])) %; ! start of ISPSOK ! all operations allowed on <0,16> SSP = .LN[rw_ptr_state]; If .SSP Leq PF016 Then ! none, <0,16> Return TRUE ! there are no byte instructions for ADD and SUB but check if it looks like ! it might turn into an INC/DEC instruction later on in FINAL. Else If .SSP Leq PF08 Then ! <0,8> Begin If ISINCORDEC Then Return TRUE ! negates and complement nodes disappeared and were replace by load nodes. Else If ISCOMORNEG Then Return TRUE Else ! there are byte versions of the BIC and BIS instructions Return ISBISORBIC End Else ! BIS and BIC are ok when working on bit-fields except when the field ! needs to be complemented. Return (ISBISORBIC Eql 1) End; Label bbb; Local X : Integer; ! start of simple store If .RN[gt_type] Neq T_NODE Then Return 0; ! the LHS is ok if it is a pointer and the operation is ok with ! that pointer size or it is a simple operator. If .LN[gt_type] Eql T_NODE Then Begin ! the LHS is not a full word. see if the operator on the RHS may ! work with non-full words. If .LN[gt_code] Eql OP_POINTER Then Begin If Not ISPSOK(.LN,.RN) Then Return 0 End ! allow only simple operators on the LHS Else If Not SIMPLOP(.LN) Then Return 0 End; If .LN[gt_type] Eql T_VARIABLE Then Begin ! check volatile locations. for now, only the PC is volatile. ! seems like a place to check the VOLATILE attribute of symbols. ! ! seems crazy to have the PC on the LHS anyway but I guess it's a ! way to generate a jump. If .LN[gt_disp] Eqla .PCREG Then Return 0; ! see if the RHS operator can work on an operand the size of the LHS If Not ISPSOK(.LN,.RN) Then Return 0; ! see if the LHS is contained in the RHS target path. ! ! note: SIMPLEVAL is a literal 3 and so the expression on the RHS ! of the Leq below may only take on the values 4 and 2. ! FINDLEFT only returns the values 0,1, and 2. thus, the ! return is always taken. X = FINDLEFT(.LN,.RN); If .X Neq 0 Then If .X Leq (SIMPLEVAL+1)/(1+(.Block[.LN[gt_disp],gt_mode] Neq GENREG)) Then Return -1 End; If .RN[gt_code] Eql OP_LOAD_NODE Then Begin If .RN[gt_occ] Eql 1 Then ! the complexity may only be zero if RN was created by XLOADNODE and ! it was a load of a literal or a symbol. If .RN[gt_cs_compl] Eql 0 Then Return 1 ! check for X = -.X and X = Not .X Else If ISNEGNOT(.LN,.RN[gt_arg1]) Then Return -1 Else Return 0 End; ! result of a function call If .RN[gt_code] Eql OP_FSTORE Then Return 1; If .RN[gt_code] Leq MAXOPERATOR Then Begin If .RN[gt_code] Eql OP_DOT Then Return 0; If .RN[gt_code] Eql OP_SWAB Then Return 1; If .RN[gt_argc] Eql 2 Then bbb: Begin ! get the target and non-target paths If .RN[gt_v_tpath] Then (LRN = .RN[gt_arg2]; RRN = .RN[gt_arg1]) Else (LRN = .RN[gt_arg1]; RRN = .RN[gt_arg2]); If .RN[gt_reg] Eqla .LRN[gt_reg] And .RN[gt_cs_compl] Gtr SIMPLEVAL Then Leave bbb; If FINDLEX(.LN,.LRN) Then If SPECIALCASES Then Leave bbb Else Return 0; If .LN[rw_ptr_state] Gtr PF016 Then Leave bbb; If .LRN[gt_type] Eql T_NODE And .LRN[gt_code] Eql OP_FSTORE Then Return 0; Return 1 - FINDLEX(.LN,.RRN) End End; If ONEOF(.RN[gt_code],OP_IF,OP_CASE,OP_SELECT,OP_LABEL) Then Return 1; If .RN[gt_code] Gtr MAXOPERATOR Then Return 0; ! get the target path LRN = (If .RN[gt_v_tpath] Then .RN[gt_arg2] Else .RN[gt_arg1]); ! target path must be dot of LHS If .LRN[gt_type] Neq T_NODE Or .LRN[gt_code] Neq OP_DOT Then Return 0; ! disallow cases like 'X = .X Eql 5' for which no single instruction ! exists. (need to modify special cases for machines which do have ! things like an XOR instruction). If Not SPECIALCASES Then Return 0; ! check for X = .X op Y LLRN = .LRN[gt_arg1]; If .LLRN Eqla .LN Then Return -1; ! un-adorn any pointers and try comparing again If Not EQLPOSSIZE(.LLRN,.LN) Then Return 0; ! fool CODE into believing the LHS has been coded. LRN[gt_v_coded] = TRUE; LRN[gt_mode] = GENREG; LRN[gt_reg] = .RN[gt_reg]; Return -1 End; ! called by ND_STORE Routine TRYSIMPLESTORE(NODE : Ref GT,LN : Ref GT,RN : Ref GT) : Novalue = Begin Local OP : Integer, SMPL : Integer; ! only consider where the RHS is a node If .RN[gt_type] Neq T_NODE Then Return; ! compound statements are transparent OP = .RN[gt_code]; If .OP Eql OP_COMPOUND Then Begin TRYSIMPLESTORE(.NODE,.LN,.RN[gt_argv(.RN[gt_argc]-1)]); Return End; ! weed out operators we are not concerned with If .OP Gtr MAXOPERATOR Then If Not ONEOF(.OP,OP_LABEL,OP_IF,OP_CASE,OP_SELECT) Then Return; ! SIMPLESTORE returns: ! ! 0 ! 1 ! -1 SMPL = SIMPLESTORE(.LN,.RN); If Not .SMPL Then Return; BINDSTORE(.LN,.RN[gt_reg]); If .SMPL Lss 0 Then RN[rc_mov_target] = FALSE; Selectone .RN[gt_code] Of Set [OP_IF]: Begin TRYSIMPLESTORE(.NODE,.LN,.RN[gt_arg3]); ! then TRYSIMPLESTORE(.NODE,.LN,.RN[gt_arg4]) ! else End; [OP_CASE]: Incr I From 2 To .RN[gt_argc]-2 Do TRYSIMPLESTORE(.NODE,.LN,.RN[gt_argv(.I)]); [OP_SELECT]: Incr I From 2 To .RN[gt_argc]-3 By 2 Do TRYSIMPLESTORE(.NODE,.LN,.RN[gt_argv(.I)]) Tes End; Routine ND_STORE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local LOP : Ref GT, ROP : Ref GT, TEMP : Ref GT; If .NODE[gt_v_tpath] Then (LOP = .NODE[gt_arg2]; ROP = .NODE[gt_arg1]) Else (LOP = .NODE[gt_arg1]; ROP = .NODE[gt_arg2]); ! Q: what is special about gt_v_copied? ! ! A: gt_v_copied is set by COPYRESULT in DELAY and COPYRESULT is called ! by DESTORE only when storing a literal. I guess this avoids ! placing a literal in a register if possible. If .TX Lssu 8 Then Begin If REQ_RESULT And Not .NODE[gt_v_copied] Then NODE[gt_reg] = TX = GETTN() End Else Begin ! if our given target is the same as the RHS... ! ! Q: how is this done? If .TX[tn_request] Eql BIND_MEMORY And .TX[gt_reg] Eqla .ROP Then TX = 0 End; If Not REQ_RESULT Then TX = 0; If .NODE[gt_v_tpath] Then Begin TEMP = TLA(.ROP,.TX,0,0); TLA(.LOP,0,0,0) End Else Begin TLA(.LOP,0,0,0); TEMP = TLA(.ROP,.TX,0,0) End; WANTPREF(.NODE[gt_reg],.TEMP); ! if the value of this store is not needed then see if it is a ! simple store. If .TX Eqla 0 Then TRYSIMPLESTORE(.NODE,.LOP,.ROP); Return .TX End; Routine SPAN_PARMS : Novalue = Begin Local P : Ref TNREPR, TR : Ref TNREPR, T : Ref GT; Decr I From .stk_call[stk_idx] To 0 Do Begin P = stk_call[stk_item(.I)]; TR = .P; Until (TR = .TR[itm_rlink]) Eqla .P Do Begin T = .TR[itm_rlink]; If .T[tn_lon_lu] Lssu .LON Then T[tn_lon_lu] = .LON; If .T[tn_fon_lu] Lssu .FON Then T[tn_fon_lu] = .FON End End End; Routine TL_CALL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local LNAME : Ref ST, SUBNODE : Ref GT, TN : Ref GT, LNKGD : Ref GT, OLON : Integer, OFON : Integer, N : Integer, PARMNO : Integer, PT : Integer, PL : Integer, FSP : Boolean, S : Ref GT, Z : Ref GT; Label aaa; ! 1ST, BIND THE ROUTINE NAME TLA(.NODE[gt_arg2],0,0,0); ! get the linkage name and linkage descriptor LNAME = .NODE[gt_arg1]; LNKGD = .LNAME[st_lnk_desc]; PARMNO = 0; FSP = TRUE; ! if there are arguments... If .NODE[gt_argc] Gtr 2 Then Begin PUSHSTK(stk_call); ! loop for each parameter Incr I From 2 To .NODE[gt_argc]-1 Do Begin ! get the next parmeter descriptor PARMNO = .PARMNO + 1; If .PARMNO Gtr .LNKGD[parm_size] Then PT = PARM_STACK Else Begin PT = .LNKGD[parm_type(.PARMNO)]; PL = .LNKGD[parm_loc(.PARMNO)] End; SUBNODE = .NODE[gt_argv(.I)]; OLON = .LON+1; OFON = .FON+1; TN = TLA(.SUBNODE,0,0,0); SPAN(.SUBNODE,0); ! note the call LINK(TNREP(.SUBNODE[gt_reg]), stk_call[stk_item(.stk_call[stk_idx])]); SPAN_PARMS(); Case .PT From LO_PARM_TYPE To HI_PARM_TYPE Of Set [PARM_STACK]: aaa: Begin Local D : Integer; ! if the first stack parameter... If .FSP Then Begin FSP = FALSE; D = .Block[.stk_dtd[itm_rlink],stk_dtd_lo]; N = .DTEMPS[stk_idx]; SAVE_STACK_DEPTH; If .DTEMPS[stk_idx] Neq .D Or .NODE[gt_argc] Eql 3 Or .NODE[gt_argc] Eql 5 Then If TRYSPDYTEMP(.TN,.N) Then Begin TN[tn_request] = BIND_MEMORY; Leave aaa End End; N = .N + 1; If Not TRYSPDYTEMP(.TN,.N) Then OPENDYTEMP(.TN,.OLON,.OFON); Block[.stk_dtd[itm_rlink],stk_dtd_lo] = .N; TN[tn_request] = BIND_MEMORY End; [PARM_REGISTER]: Begin Local SUBSUB : Ref GT; SUBSUB = .SUBNODE[gt_arg1]; If .SUBSUB[gt_type] Eql T_NODE And .SUBSUB[gt_reg] Gequ 8 Then TN[tn_permit] = .SUBSUB[gt_reg]; TN[tn_request] = BIND_REGISTER; TN[gt_reg] = .PL End Tes; ! if there are any stack parameters then we must make sure there are ! no excess push-down temporaries lying around. ! if the stack is already at the right level or we are on the last ! parameter then make sure the stack is exactly what it should be. ! otherwise, allow it to grow at most one more. this allows the ! next parameter to be stacked using '@SP' rather than '-(SP)'. If Not .FSP Then KILLPDTEMPS(.SUBNODE, (If .DTEMPS[stk_idx] Eql .N Or .I Eql .NODE[gt_argc]-1 Then .N Else .N+1)) End; POPSTK(stk_call) End; SET_DONT_CARE_DEPTH; If Not .FSP Then POP_STACK_DEPTH; If .DTEMPS[stk_idx] Geq (STKSIZE-.MAXPARMS) Then KILLDYTEMPS(.NODE); ! GET A NEW TN FOR THE VALUE OF THE CALL AND MAKE IT THE VALUE REGISTER If .LNAME[st_lnk_type] Neq LNK_INTERRUPT Then Begin NODE[gt_reg] = TN = Z = GETTN(); S = .NODE[gt_arg2]; If .S Eqla .LXHALT Then BINDSTORE(MakeLit(%o'177570'),.TN) Else Begin TN[tn_request] = BIND_REGISTER; TN[gt_reg] = VREGNUM End End Else TN = Z = 0; UPDATELONFON; NODE[gt_v_bound] = TRUE; ASSIGNLABELS; SPAN(.NODE,0); SPAN(.NODE[gt_arg2],1); Return .Z End; ! create a tempname representing register R0. ! ! called by TL_ROUTINE, ND_SIGNAL, and TL_ENABLE Routine LOADR0 = Begin Local TX : Ref GT; TX = GETTN(); TX[tn_code] = BOUND_REGISTER; TX[tn_request] = BIND_REGISTER; TX[gt_reg] = VREGNUM; TX[tn_bind_list] = REGS[VREGNUM]; If EMPTY(REGS[VREGNUM]) Then OPENREG(VREGNUM); Return .TX End; Routine TL_ROUTINE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local RNAME : Ref ST, LNAME : Ref ST, LDESC : Ref ST, TN : Ref GT, L : Ref LSTHDR, I : Ref ITEM, J : Integer, P : Ref ST; ! get the routine, linkage, and the linkage descriptor RNAME = .NODE[gt_arg2]; LNAME = .RNAME[st_var_linkage]; LDESC = .LNAME[st_lnk_desc]; ! put our node in a place where TL_RETURN can find it RNAME[st_retlab] = .NODE; ! if not an enable block, have all registers initially closed and ! only open those registers which are parameters specified in the ! linkage. ! if this is an enable block, all registers will be opened. ! ! opening a register causes that register to be saved on procedure entry. If Not .flg_enable Then Begin Decr I From 5 To 0 Do NULLLST(REGS[.I]); Incr I From 1 To .LDESC[parm_size] Do If .LDESC[parm_type(.I)] Eql PARM_REGISTER Then OPENREG(.LDESC[parm_loc(.I)]); End; ! loop over all formal parameters bound to a register and bind them. ! this list of registers may be smaller than the list above because ! not all registers need to be used from a linkage. ! ! Q: is this due to flexibility in the BLISS language? If Not EMPTY(.RNAME[st_var_reg_list]) Then Begin I = L = .RNAME[st_var_reg_list]; Until (I = .I[itm_rlink]) Eqla .L Do Begin J = .I[itm_ldata(1)]; P = .I[itm_rdata(1)]; TX = GETTN(); TX[tn_bind_list] = REGS[.J]; TX[tn_request] = BIND_MEMORY; TX[gt_reg] = .J; WANTPREF(.TX,.P[gt_reg]); UPDATE(.P,1,2) End End; ! all but interrupt routines return a value in R0. should later ! be changed to check the attribute 'NOVALUE' instead. If .LNAME[st_lnk_type] Neq LNK_INTERRUPT Then TN = LOADR0() Else TN = 0; ! TLA the routine body TX = TLA(.NODE[gt_arg1],0,0,0); ! separate the body from the epilog and span the routine UPDATELONFON; SPAN_UNARY(.NODE); ! we prefer any result be placed in R0 WANTPREF(.TX,.TN); NODE[gt_reg] = .TN; Return .TN End; Routine ND_AND(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local LOP : Ref GT, ROP : Ref GT, OP1 : Ref GT, L_T : Ref GT, L_F : Ref GT, TEMP : Ref GT, P : Ref ITEM; ! assume the normal case whereby if the LHS is TRUE then we go to ! the RHS and if FALSE we go to the supplied false label. L_T = .NODE[gt_arg2]; L_F = .LAB_F; ! but if the RHS is a literal then set to always succeed or fail ! depending on its value. If .L_T[gt_type] Eql T_LITERAL Then If .L_T[gt_disp] Then L_T = .LAB_T Else L_T = .LAB_F; ! evaluate the LHS, passing TX if the LHS is the target path LOP = 0; ROP = 0; If .NODE[gt_v_tpath] Then (ROP = .TX; OP1 = .NODE[gt_arg2]) Else (LOP = .TX; OP1 = .NODE[gt_arg1]); LOP = TLA(.NODE[gt_arg1],.LOP,.L_T,.L_F); ! if a short-circuited evaluation then note the stack level If REQ_FLOW Then SAVE_STACK_DEPTH; ! evaluate the RHS, passing TX if the RHS is the target path ROP = TLA(.NODE[gt_arg2],.ROP,.LAB_T,.LAB_F); ! set LOP to the non-target path If .NODE[gt_v_tpath] Then LOP = .ROP; ! if a short-circuit evaluation then see if both side resulted ! in the same stack depth. and if not, fix things up. If REQ_FLOW Then Begin P = .stk_dtd[itm_rlink]; If .DTEMPS[stk_idx] Neq .P[stk_dtd_lo] Then Begin KILLDYTEMPS(.NODE[gt_arg2]); SETNOTFPARM() End; ! pop the dynamic temp stack and return 0. short-circuit evaluation ! produces no value. POP_STACK_DEPTH; Return 0 End; ! return if no result wanted. ! ! Q: why not return 0 if no result is wanted? If Not REQ_RESULT Then Return .LOP; ! if we were not given a target path then if the result of ! the evaluation is destroyable then use that otherwise set ! to place our result on the preference list. TEMP = 0; If .TX Eqla 0 Then If .OP1[rw_destroyable] Then TX = .LOP Else TEMP = .LOP; FILLTX; WANTPREF(.TX,.TEMP); Return .TX End; ! note: the code here is very similar to that of ND_AND Routine ND_OR(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local LOP : Ref GT, ROP : Ref GT, OP1 : Ref GT, L_T : Ref GT, L_F : Ref GT, P : Ref ITEM, TEMP : Ref GT; L_T = .LAB_T; L_F = .NODE[gt_arg2]; If .L_F[gt_type] Eql T_LITERAL Then If .L_F[gt_disp] Then L_F = .LAB_T Else L_F = .LAB_F; LOP = 0; ROP = 0; If .NODE[gt_v_tpath] Then (ROP = .TX; OP1 = .NODE[gt_arg2]) Else (LOP = .TX; OP1 = .NODE[gt_arg1]); LOP = TLA(.NODE[gt_arg1],.LOP,.L_T,.L_F); If REQ_FLOW Then SAVE_STACK_DEPTH; ROP = TLA(.NODE[gt_arg2],.ROP,.LAB_T,.LAB_F); If .NODE[gt_v_tpath] Then LOP = .ROP; If REQ_FLOW Then Begin P = .stk_dtd[itm_rlink]; If .DTEMPS[stk_idx] Neq .P[stk_dtd_lo] Then Begin KILLDYTEMPS(.NODE[gt_arg2]); SETNOTFPARM() End; POP_STACK_DEPTH; Return 0 End; If Not REQ_RESULT Then Return .LOP; TEMP = 0; If .TX Eqla 0 Then If .OP1[rw_destroyable] Then TX = .LOP Else TEMP = .LOP; FILLTX; WANTPREF(.TX,.TEMP); Return .TX End; Routine TL_NOT(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin ! NOT is like any other operator except we switch the labels Return TL_COMMON(.NODE,.TX,.LAB_F,.LAB_T) End; Routine ND_COMP(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin ! TLA all but the last operand Incr I From 0 To .NODE[gt_argc]-2 Do TLA(.NODE[gt_argv(.I)],0,0,0); ! TLA the last operand TX = TLA(.NODE[LASTOPERAND],.TX,.LAB_T,.LAB_F); ! if a result is wanted then return it otherwise chuck it and return 0 If REQ_RESULT Then Return .TX Else Return 0 End; Routine ND_IF(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local DTUNEVEN : Boolean, TT3 : Boolean, TT4 : Boolean, P : Ref ITEM, TTHEN : Ref GT, TELSE : Ref GT; ! pulse and fix the alpha list BINDLST(.NODE[gt_arg1]); ! TLA the IF condition TLA(.NODE[gt_arg2],0,.NODE[gt_arg3],.NODE[gt_arg4]); ! save FON because it will be reset to the same value for both the ! THEN and ELSE parts. SAVFON; ! save the stack level because the THEN and ELSE parts may produce ! different stack levels. SAVE_STACK_DEPTH; ! make sure we have a tempname if a result is wanted. ! ! Q: why is 'TX' not set to zero if a result is not wanted? other TL ! routines zero it. If REQ_RESULT Then FILLTX; ! get the THEN and ELSE nodes and note their complexity TTHEN = .NODE[gt_arg3]; TELSE = .NODE[gt_arg4]; TT3 = (.TTHEN[gt_cs_compl] Leq MAGIC3); TT4 = (.TELSE[gt_cs_compl] Leq MAGIC3); ! TLA the THEN part. if both the THEN and ELSE parts look like ! they will generate very little code then try to place the result ! in the IF's tempname. TTHEN = TLA(.TTHEN,If .TT3 And .TT4 Then .TX Else 0,.LAB_T,.LAB_F); ! reset the FON and the stack level for the THEN branch. RESET_FON; RESET_STACK_DEPTH; ! TLA the ELSE part. if the ELSE part looks small then try to place ! its result in the IF's tempname. TELSE = TLA(.TELSE,If .TT4 Then .TX Else 0,.LAB_T,.LAB_F); ! note the higher of the two FON's MAXIMIZE_FON; ! note whether the stack depths came out uneven. P = .stk_dtd[itm_rlink]; DTUNEVEN = (.DTEMPS[stk_idx] Neq .P[stk_dtd_hi]); ! even out the stack depths MINIMIZE_STACK_DEPTH; ! if the stack depths cam out uneven then wipe out those uneven ! stack temporaries. If .DTUNEVEN Then Begin KILLFORKDYTEMPS(.NODE[gt_arg3]); KILLFORKDYTEMPS(.NODE[gt_arg4]); SETNOTFPARM() End; ! clean up the stack depth POP_STACK_DEPTH; ! if a result was wanted then place the results in the same ! preference class. If REQ_RESULT Then Begin WANTPREF(.TX,.TTHEN); WANTPREF(.TX,.TELSE) End; ! pulse and fix the omega list BINDLST(.NODE[gt_arg5]); Return .TX End; Routine ND_CASE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local T : Ref GT, RES : Integer, DTUNEVEN : Boolean, P : Ref ITEM, SUBNODE : Ref GT; ! pulse and fix the alpha list BINDLST(.NODE[gt_arg1]); ! TLA the case selector TLA(.NODE[gt_arg2],0,0,0); ! if a result is wanted then make sure we have a tempname for it If REQ_RESULT Then FILLTX Else TX = 0; ! save the FON and stack depth for each branch. SAVFON; SAVE_STACK_DEPTH; ! loop, processing each case entry DTUNEVEN = FALSE; Incr I From 2 To .NODE[gt_argc]-2 Do Begin ! get the entry and TLA it SUBNODE = .NODE[gt_argv(.I)]; T = TLA(.SUBNODE,0,.LAB_T,.LAB_F); ! preference it if a result is wanted If REQ_RESULT Then WANTPREF(.T,.TX); ! note whether the stack depth changed P = .stk_dtd[itm_rlink]; If .I Geq 3 And .DTEMPS[stk_idx] Neq .P[stk_dtd_hi] Then DTUNEVEN = TRUE; ! on the last entry, compute the minumum stack depth otherwise ! just reset the stack depth. If .I Neq .NODE[gt_argc]-2 Then RESET_STACK_DEPTH Else MINIMIZE_STACK_DEPTH; RESET_FON End; ! if all the stack depths were not the same then we have to go ! about killing excess stack temporaries. If .DTUNEVEN Then Begin Incr I From 2 To .NODE[gt_argc]-2 Do KILLFORKDYTEMPS(.NODE[gt_argv(.I)]); SETNOTFPARM() End; POP_STACK_DEPTH; MAXIMIZE_FON; ! pulse and bind the omega list BINDLST(.NODE[gt_argv(.NODE[gt_argc]-1)]); Return .TX End; ! TLA FOR WHILE-DO, UNTIL-DO, DO-WHILE, AND DO-UNTIL CASES 0 THROUGH 3 OF TYPE Routine FLOOP(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT,TYPE) = Begin Local L1_T : Ref GT, L1_F : Ref GT, L2_T : Ref GT, L2_F : Ref GT, OP4 : Ref GT; ! pulse and fix the Chi and Rho lists LPBINDLST(.NODE[gt_arg1]); LPBINDLST(.NODE[gt_arg2]); ! compute the branch targets L1_T = 0; L1_F = 0; L2_T = 0; L2_F = 0; Case .TYPE From 0 To 3 Of Set [0]: ! while-do Begin L1_T = .NODE[gt_arg4]; L1_F = .NODE[gt_arg5] End; [1]: ! until-do Begin L1_T = .NODE[gt_arg5]; L1_F = .NODE[gt_arg4] End; [2]: ! do-while Begin L2_T = .NODE[gt_arg3]; L2_F = .NODE[gt_arg5] End; [3]: ! do-until Begin L2_T = .NODE[gt_arg5]; L2_F = .NODE[gt_arg3] End Tes; ! save the current dynamic temp depth, lon/fon, and start a ! new loop level. ENTLOOP(); ! TLA the WHILE condition or the DO body TLA(.NODE[gt_arg3],0,.L1_T,.L1_F); ! if ! a WHILE/UNTIL-DO loop (e.g. will produce a branch) ! -or- ! a DO-WHILE/UNTIL loop with no real condition ! -or- ! that condition produces short-circuited code OP4 = .NODE[gt_arg4]; If .TYPE Leq 1 Or .OP4[gt_type] Neq T_NODE Or .OP4[rw_real_flow] Eql RFFLOW Or ISRELOP(OP4) Then ! then we need to reset the stack Begin RESET_STACK_DEPTH; KILLDYTEMPS(.NODE[gt_arg3]) End; ! TLA the WHILE body or the DO condition TLA(.OP4,0,.L2_T,.L2_F); ! reset the stack and limit the span of all tempnames within the span XITLOOP(); KILLDYTEMPS(.OP4); ! note: KILLDYTEMPS will set the [gt_dtdelete] field but that will be ! clobbered later by TL_COMMON KILLDYTEMPS(.NODE); POP_STACK_DEPTH; ! sorta bogus because nothing is bound to this TN If TNNEEDED Then FILLTX; Return .TX End; Routine ND_WHILE_DO(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Return FLOOP(.NODE,.TX,.LAB_T,.LAB_F,0) End; Routine ND_UNTIL_DO(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Return FLOOP(.NODE,.TX,.LAB_T,.LAB_F,1) End; Routine ND_DO_WHILE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Return FLOOP(.NODE,.TX,.LAB_T,.LAB_F,2) End; Routine ND_DO_UNTIL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Return FLOOP(.NODE,.TX,.LAB_T,.LAB_F,3) End; Routine ND_IDLOOP(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local L : Ref GT, CV : Ref GT, UOP : Ref GT; ! TLA the initialial value L = TLA(.NODE[gt_arg2],0,0,0); ! TLA the FROM and TO parts TLA(.NODE[gt_arg3],0,0,0); TLA(.NODE[gt_arg4],0,0,0); ! pulse and fix the Chi and Rho lists LPBINDLST(.NODE[gt_arg5]); LPBINDLST(.NODE[gt_arg6]); ! span the initialize value SPAN(.NODE[gt_arg2],0); ! separate the initial value from the control variable so ! preferencing will work. NEXTLON; NEXTFON; ! get and span the control variable at this, its first reference CV = .NODE[gt_arg1]; SPAN(.CV,0); ! prefer that any initial value calculation be put into ! the control variable WANTPREF(.L,.CV[gt_reg]); ! save the current dynamic stack temp level and the lon/fon and ! setup for a new loop level. ENTLOOP(); ! TLA the loop body TLA(.NODE[gt_arg7],0,0,0); XITLOOP(); ! generate any stack adjustments KILLDYTEMPS(.NODE[gt_arg7]); POP_STACK_DEPTH; ! if a result is wanted, make sure there is a TN. ! ! Q: what is bound to this tempname? If TNNEEDED Then FILLTX; Return .TX End; Routine TL_LABEL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local TN : Ref GT; ! if a result is wanted then make sure we have a tempname. if no ! result is wanted then chuck any tempname we may have been given. If REQ_RESULT Then Begin If .TX Lssu 8 Then TX = GETTN() End Else TX = 0; ! put it in a place where TL_LEAVE can pick it up. NODE[gt_reg] = .TX; ! TLA the statement behind the label TN = TL_COMMON(.NODE,0,.LAB_T,.LAB_F); ! if a result is wanted then place the result in the same preference class WANTPREF(.TN,.TX); ! note where the stack needs to be cleaned up NODE[gt_dtdelete] = (.DTEMPS[stk_idx]+1)*2; SETNOTFPARM(); Return .TX End; Routine TL_LEAVE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local S : Ref GT; ! point to the label node S = .Block[.NODE[gt_arg2],st_lab_node]; ! TLA the block TX = TLA(.NODE[gt_arg1],0,.LAB_T,.LAB_F); ! we prefer the result of this leave to be placed in the same ! location as the label result WANTPREF(.S[gt_reg],.TX); ! note the stack depth for any needed adjustments SET_DONT_CARE_DEPTH; Return .TX End; Routine TL_RETURN(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local S : Ref GT; ! Q: a return is just like a leave of a routine so why is it different? ! should not LON/FON be updated above and NODE[gt_reg] be zeroed ! out also? S = .Block[.NODE[gt_arg2],st_retlab]; TX = TLA(.NODE[gt_arg1],0,.LAB_T,.LAB_F); WANTPREF(.S[gt_reg],.TX); SET_DONT_CARE_DEPTH; UPDATELONFON; NODE[gt_reg] = 0; Return 0 End; ! notes: ! fake-CSE's are really CSE usages of loadnodes ! ! as such, the gt_v_bound field should be filled in ! when the loadnode is processed. Routine TL_FAKECSE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin TLUSE(.NODE); SET_DONT_CARE_DEPTH; UPDATELONFON; ASSIGNLABELS; SPAN(.NODE,0); Return .NODE[gt_reg] End; Routine ND_SELECT(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local OTHEREND : Integer, DTUNEVEN : Boolean, SAVDTC : Integer, L : Ref GT, OP : Ref GT, OTHERTN : Ref GT; DTUNEVEN = FALSE; ! make sure we have a tempname if a result is wanted. if no result ! is wanted then chuck any tempname we may have been given. If REQ_RESULT Then FILLTX Else TX = 0; ! initialize the LON's and FON's for TX. ! ! Q: why does it start its life here and not after the TLA of the selector? INITTNSPAN(TX); ! get the index of the OTHERWISE clause L = .NODE[LASTOPERAND]; OTHEREND = .L[gt_disp]; ! if there is an OTHERWISE clause then we need a tempname to hold ! the generated otherwise flag If .OTHEREND Eql 0 Then OTHERTN = 0 Else Begin OTHERTN = GETTN(); NODE[gt_argv(.NODE[gt_argc]-2)] = .OTHERTN End; ! TLA the selector TLA(.NODE[gt_arg1],0,0,0); ! otherwise flag starts it life here INITTNSPAN(OTHERTN); ! loop for each select case Incr I From 1 To .NODE[gt_argc]-3 Do Begin L = .NODE[gt_argv(.I)]; ! if processing the LHS... If .I Then Begin ! TLA and span it unless the LHS was OTHERWISE or ALWAYS If .L Neqa .sym_always And .L Neqa .sym_otherwise Then Begin TLA(.L,0,0,0); SPAN(.NODE[gt_arg1],0) End End ! if processing the RHS... Else Begin ! note the stack level of the first entry If .I Eql 2 Then SAVDTC = .DTEMPS[stk_idx]; SAVE_STACK_DEPTH; ! TLA the entry TLA(.L,.TX,0,0,0); ! note whether all entries produce the same number of stack temporaries If .DTEMPS[stk_idx] Neq .SAVDTC Then DTUNEVEN = TRUE; ! cleanup any created stack tempories RESET_STACK_DEPTH; KILLDYTEMPS(.L); POP_STACK_DEPTH End; ! if there is an OTHERWISE clause then note that the otherwise flag ! will be updated at this point. If .I Leq .OTHEREND Then TNSPAN(OTHERTN) End; If .DTUNEVEN Then SETNOTFPARM() Else ! all entries produce the same stack level. this means we can ! change all entries to "dont' care" as far as stack adjustment goes ! and do the stack adjustment at the end of the whole select ! statement. Incr I From 2 To .NODE[gt_argc]-3 By 2 Do Begin OP = .NODE[gt_argv(.I)]; If .OP[gt_type] Eql T_NODE Then OP[gt_dtdelete] = DTDONTCARE End; Return .TX End; Routine TL_ENABLE(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin NODE[gt_v_bound] = TRUE; ! upon executing an enable block, R0 is set to the signal code ! by the run-time library. we note that here. NODE[gt_reg] = LOADR0(); SET_DONT_CARE_DEPTH; UPDATELONFON; ! for most nodes, the arguments are TLA'd first. here, we span first. ! ! Q: why? ! ! A: what is being spanned is R0. below an ENABLE node is a SELECT ! node with R0 as its selector. the life of R0 is only as long as ! the selector and thus must not be spanned after the SELECT node. ! the question is why the LOADR0 wasn't done as part of the SELECT ! and not here. then we wouldn't need this non-sense. maybe the ! UPDATELONFON above has something to do with it. SPAN_UX(.NODE); TLA(.NODE[gt_arg1],0,0,0); Return .NODE[gt_reg] End; Routine ND_SIGNAL(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local TL : Ref GT; ! TLA the signal argument TL = TLA(.NODE[gt_arg1],0,0,0); ! the signal code is loaded into R0 and then $SIGNL is called. TX = NODE[gt_reg] = LOADR0(); ! signal does not return and so the result is ignored TX[tn_request] = BIND_IGNORE; WANTPREF(.TL,.TX); Return .TX End; ! C. - DRIVER FOR TEMP NAME/LABEL ASSIGNMENT ! ------------------------------------------------ ! ! ! THIS PLIT IS USED TO SWITCH TO SPECIFIC ROUTINES TO DO ! TLA PROCESSING FOR A NODE, NODE-SPECIFIC PROCESSING FOR ! NODES WHICH USE TL_COMMON AS THEIR TLA ROUTINE, AND ! SPANNING FOR NODES WHICH USE TL_COMMON. ! ! Literal TLAR = 0, !INDEX FOR NODE'S TLA ROUTINE NODER = 1, !INDEX FOR "COMMON" NODE'S NODE-SPECIFIC ROUTINE SPANR = 2; !INDEX FOR "COMMON" NODE'S SPAN ROUTINE Bind TLPLIT = Uplit Long ( TL_COMMON, ND_ADDSUB, SPAN_BINARY, ! + TL_COMMON, ND_SWAB, SPAN_UNARY, ! SWAB TL_COMMON, ND_BINARY, SPAN_BINARY, ! / TL_DOT, 0, 0, ! . TL_COMMON, ND_ADDSUB, SPAN_BINARY, ! - (BINARY) TL_COMMON, ND_BINARY, SPAN_BINARY, ! MOD TL_COMMON, ND_BINARY, SPAN_BINARY, ! * TL_COMMON, ND_UNARY, SPAN_UNARY, ! - (UNARY) TL_COMMON, ND_LOADNODE, SPAN_LOADNODE, ! LOADNODE TL_COMMON, ND_BINARY, SPAN_BINARY, ! ^ TL_COMMON, ND_REL, SPAN_REL, ! BIT TL_COMMON, ND_REL, SPAN_REL, ! GTR TL_COMMON, ND_REL, SPAN_REL, ! LEQ TL_COMMON, ND_REL, SPAN_REL, ! LSS TL_COMMON, ND_REL, SPAN_REL, ! GEQ TL_COMMON, ND_REL, SPAN_REL, ! EQL TL_COMMON, ND_REL, SPAN_REL, ! NEQ TL_NOT, ND_UNARY, SPAN_UNARY, ! NOT TL_COMMON, ND_BINARY, SPAN_BINARY, ! EQV TL_COMMON, ND_AND, SPAN_AND_OR, ! AND TL_COMMON, ND_OR, SPAN_AND_OR, ! OR TL_COMMON, ND_BINARY, SPAN_BINARY, ! XOR TL_COMMON, ND_REL, SPAN_REL, ! GTRU TL_COMMON, ND_REL, SPAN_REL, ! LEQU TL_COMMON, ND_REL, SPAN_REL, ! LSSU TL_COMMON, ND_REL, SPAN_REL, ! GEQU TL_COMMON, ND_REL, SPAN_REL, ! EQLU TL_COMMON, ND_REL, SPAN_REL, ! NEQU TL_COMMON, ND_BINARY, SPAN_BINARY, ! ROT TL_COMMON, ND_BINARY, SPAN_BINARY, ! MAX TL_COMMON, ND_BINARY, SPAN_BINARY, ! MIN TL_COMMON, PUNT, SPAN_UNARY, ! CARRY TL_COMMON, PUNT, SPAN_UNARY, ! OVERFLOW TL_COMMON, ND_STORE, SPAN_STORE, ! = 0, 0, 0, ! ERROR OPERATOR TL_COMMON, ND_CASE, SPAN_UX, ! CASE TL_COMMON, ND_FSTO, SPAN_UX, ! CALL-PARM TL_COMMON, ND_FSTO, SPAN_UX, ! CALL-STORE TL_COMMON, ND_WHILE_DO, SPAN_UX, ! WHILE-DO TL_COMMON, ND_UNTIL_DO, SPAN_UX, ! UNTIL-DO TL_ROUTINE, 0, 0, ! ROUTINE DEFN TL_COMMON, ND_COMP, SPAN_UX, ! COMPOUND TL_COMMON, ND_IDLOOP, SPAN_INCR_DECR, ! INCR TL_COMMON, ND_IDLOOP, SPAN_INCR_DECR, ! DECR TL_COMMON, ND_IF, SPAN_UX, ! IF TL_COMMON, ND_DO_WHILE, SPAN_UX, ! D0-WHILE TL_COMMON, ND_DO_UNTIL, SPAN_UX, ! DO-UNTIL 0, 0, 0, ! CREATE 0, 0, 0, ! EXCHJ TL_COMMON, ND_SELECT, SPAN_UX, ! SELECT 0, 0, 0, ! EXITLOOP TL_LABEL, ND_UNARY, SPAN_UNARY, ! LABEL PLACEMENT 0, 0, 0, ! MODULE 0, 0, 0, ! PLIT TL_CALL, 0, 0, ! CALL TL_DOT, 0, 0, ! POINTER 0, 0, 0, ! [ TL_LEAVE, 0, 0, ! LEAVE TL_RETURN, 0, 0, ! RETURN TL_FAKECSE, 0, 0, ! FAKE_CSE TL_INLINE, 0, 0, ! INLINE TL_ENABLE, 0, 0, ! ENABLE TL_COMMON, ND_SIGNAL, SPAN_UNARY, ! SIGNAL TL_COMMON, ND_UNARY, SPAN_UXNARY, ! MFPI, ETC. 0, 0, 0, 0, 0, 0 ) : Vector[,Long]; ! ! THIS IS THE COMMON ROUTINE WHICH PERFORMS TN ASSIGNMENT ! FOR MOST BINARY (ARITHMETIC) OPERATORS. ! Routine TL_COMMON(NODE : Ref GT,TX : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin Local TN : Ref GT, LOP : Ref GT, ROP : Ref GT, TEMP : Ref GT; If ISCSEUSE(NODE) Then TLUSE(.NODE) ! this is not a CSE use and its tempname has not been bound yet. Else If Not .NODE[gt_v_bound] Then Begin NODE[gt_v_bound] = TRUE; ! get the existing TN and set to 0 if not an address ! ! Q: how can it ever get in the range of 1-7? TN = .NODE[gt_reg]; If .TN Lssa 8 Then TN = 0; ! use caller specified if there is none and we don't require our own TN If .TN Eqla 0 And Not ISCSECREATION(NODE) Then TN = .TX; ! call the node specific TLA routine TN = Bliss(.TLPLIT[.NODE[gt_code]*3+NODER],.NODE,.TN,.LAB_T,.LAB_F); ! set the TN for this node If .NODE[gt_reg] Eqla 0 Then NODE[gt_reg] = .TN; ! and bind that TN to all uses if this is a CSE If ISCSECREATION(NODE) Then BINDUSES(.NODE) End; ! nodes are assigned a "don't care" stack depth. it is parent nodes ! which care about the stack depth of their children and generally ! only when they do flow of control. SET_DONT_CARE_DEPTH; UPDATELONFON; ASSIGNLABELS; ! call the node specific SPAN routine Bliss(.TLPLIT[.NODE[gt_code]*3+SPANR],.NODE); Return .NODE[gt_reg] End; ! THIS ROUTINE IS THE COMMON DRIVER THROUGH WHICH ALL ! TEMP-LABEL-ASSIGNMENT ROUTINES ARE CALLED. ! Routine TLA(NODE : Ref GT,TN : Ref GT,LAB_T : Ref GT,LAB_F : Ref GT) = Begin ! only symbols and nodes are TLA'd If .NODE[gt_type] Eql T_LITERAL Then Return 0; ! only symbols of type LOCAL, REGISTER, and formal parameter ! have a tempname. return this. If .NODE[gt_type] Eql T_VARIABLE And ONEOF(.NODE[st_code],S_LOCAL,S_REGISTER,S_FORMAL) Then If .Block[.NODE[gt_disp],gt_reg] Gequ 8 Then Return .NODE[gt_reg]; If .NODE[gt_type] Neq T_NODE Then Return 0; ! call the TLA routine specific to this node TN = Bliss(.TLPLIT[.NODE[gt_code]*3+TLAR],.NODE,.TN,.LAB_T,.LAB_F); ! perform cost calculations for this node KOST(.NODE); ! was gt_gthread in a former life NODE[gt_label] = 0; Return .TN End; ! II.(A) ESTIMATING NUMBER OF TEMPS NEEDED ! ----------------------------------------- ! ! ! THIS CODE DOES A LINEAR SCAN OVER THE (UNRANKED) TEMP NAMES AND ! ATTEMPS TO GET A ROUGH ESTIMATE OF THE NUMBER OF ACTUAL TEMP ! LOCATIONS THAT WILL BE REQUIRED. ! ! Notes: ! the estimate is made by finding the maximum number of ! overlapping TN's. this number is approximately the ! number of registers needed at that time. this ! algorithm relies upon TN's being created in an ! in-out order. Routine ESTIMATE = Begin Local MD : Integer, MDS : Integer, FU : Integer, LU : Integer, R : Ref TNREPR, T : Ref GT; Label aaa; MD = 0; MDS = 0; LU = 0; FU = %x'7fffffff'; ! examine all the tempnames R = TNCHAIN; While (R = .R[itm_llink]) Neqa TNCHAIN Do aaa: Begin T = .R[tnr_ptr]; ! if a point tempname then ignore it. If .T[tn_lon_fu] Geq .T[tn_lon_lu] Then Leave aaa; ! if a potential register If ONEOF(.T[tn_request],BIND_MEMORY,BIND_STATIC,BIND_IGNORE) Then Leave aaa; ! if the span of this tempname is outside the current span then ! note the highest tempname nesting depth and start a new depth If .t[tn_lon_lu] Lss .FU Or .t[tn_fon_fu] Gtr .LU Then Begin If .MD Gtr .MDS Then MDS = .MD; MD = 1; FU = .T[tn_lon_fu]; LU = .T[tn_lon_lu] End Else Begin ! there is an overlap of some sort between this tempname's span ! and the current span. bump the nesting level and adjust the ! new span If .T[tn_lon_fu] Gtr .FU Then FU = .T[tn_lon_fu]; If .T[tn_lon_lu] Lss .LU Then LU = .T[tn_lon_lu]; MD = .MD + 1 End End; Return Max(.MD,.MDS) End; ! III. - RANKING TEMP NAMES ! ------------------------------------------------ ! ! ! THE ACTION OF RANKING IS STRAIGHT-FORWARD AND SHOULD ! PRESENT NO PROBLEMS. NOTE, HOWEVER: ! ! 1) RANKING IS BASED ON THE 'MAX' COST -- THIS IS DONE ! SO THAT THE WORST CASE COST IS MINIMIZED. ! ! 2) CERTAIN TN'S MUST BE IN A REGISTER, OR IN A SPECIFIC ! REGISTER, IN A LOCAL, ETC. THESE TN'S ARE SEGREGATED ! ONTO SEPERATE LISTS AT THIS POINT. IN THE PACKING ! ALGORITHM THESE TN'S ARE TREATED FIRST IN ORDER ! TO INSURE THAT THEIR NEEDS ARE SATISFIED. ! ! ! B. - SORTING OF TEMP NAMES ! ------------------------------------------------ Routine LOG2(N : Integer) = Begin Incr I From 0 To 63 Do If 1^.I Geq .N Then Return .I; Return 64 End; Routine TNSORTENTER(TN : Ref Block) : Novalue = Begin Local T : Ref Block, TR : Ref TNREPR, L : Ref LSTHDR; ! place the TN on the usual list in sorted order. L = ULST[.TN[tn_max_complexity] * SZ_ULST / .MAXKOST]; TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; If .T[tn_max_complexity] Lss .TN[tn_max_complexity] Then Exitloop End; LINK(TNREP(.TN),.TR[itm_llink]) End; ! place a TN on a static local list Routine LONORDER(TN : Ref Block,L : Ref LSTHDR) : Novalue = Begin Local T : Ref Block, TR : Ref TNREPR, TF : Ref TNREPR; TF = TNREP(.TN); ! only consider the first branch of a choice. TN's on other branches go to ! the end of the list. this is to avoid these TN's from competing with ! the TN's on the first branch and so reduces the number of static locals ! created. If .TN[tn_lon_fu] Nequ .TN[tn_fon_fu] Then Begin LINK(.TF,.L[itm_llink]); Return End; TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; If .T[tn_lon_fu] Eqlu .T[tn_fon_fu] Then If .T[tn_lon_fu] Gtru .TN[tn_lon_fu] Then Exitloop End; LINK(.TF,.TR[itm_llink]) End; ! C. - DRIVER FOR RANKING ! ------------------------------------------------ ! ! notes: ! the old code calculated MAXFONSPAN and MAXKOST on the fly. ! the problem with this was that the upper limit on tempname ! complexity was placed at MAXFONSPAN * MAXKOST for which it ! is rare that any tempname's complexity even approaches that ! number. this causes most (if not all) entries in ULST to ! fall into the first slot and the rest to be sparse. Routine TRANK : Novalue = Begin Local N : Integer, TR : Ref TNREPR, T : Ref Block; Macro FS = (.MAXFONSPAN-LOG2(.T[tn_fon_lu]-.T[tn_fon_fu])) %; ! initialize NULLLST(SRLST); NULLLST(ARLST); NULLLST(SLLST); Decr I From SZ_ULST-1 To 0 Do NULLLST(ULST[.I]); ! perform a scan of all the tempnames which will be sorted ! using TNSORTENTER and calculate the maximum fon span. MAXFONSPAN = 0; TR = TNCHAIN; Until (TR = .TR[itm_rlink]) Eqla TNCHAIN Do Begin T = .TR[tnr_ptr]; If .T[tn_lon_fu] Lequ .T[tn_lon_lu] And ONEOF(.T[tn_request],BIND_NONE,BIND_DECLARE, BIND_REG_OR_FORGET) Then Begin N = .T[tn_fon_lu] - .T[tn_fon_fu]; If .N Gtr .MAXFONSPAN Then MAXFONSPAN = .N End End; ! take the log of the maximum FON span. the FON span is multiplied by ! the register use complexity to come up with a cost estimate. to avoid ! generating large numbers, the log of the FON is used in the calculation ! and this also reduces the cost value of the FON span vs. the register ! use complexity. MAXFONSPAN = LOG2(.MAXFONSPAN) + 1; ! a second loop over the tempnames is then made to calculate ! the maximum complexity. MAXKOST = 0; TR = TNCHAIN; Until (TR = .TR[itm_rlink]) Eqla TNCHAIN Do Begin T = .TR[tnr_ptr]; If .T[tn_lon_fu] Lequ .T[tn_lon_lu] And ONEOF(.T[tn_request],BIND_NONE,BIND_DECLARE, BIND_REG_OR_FORGET) Then Begin T[tn_min_complexity] = .T[tn_max_complexity] - .T[tn_min_complexity]; N = .T[tn_min_complexity] * FS; T[tn_max_complexity] = .N; If .N Gtr .MAXKOST Then MAXKOST = .N End; End; ! this guarantees that the indices into ULST will be 0..3 MAXKOST = .MAXKOST + 1; ! loop, ranking each tempname TR = TNCHAIN; Until (TR = .TR[itm_rlink]) Eqla TNCHAIN Do Begin T = .TR[tnr_ptr]; If .T[tn_lon_fu] Lequ .T[tn_lon_lu] Then Case .T[tn_request] From LO_REQD_TYPE To HI_REQD_TYPE Of Set [ BIND_NONE ]: TNSORTENTER(.T); [ BIND_MEMORY ]: 0; [ BIND_STATIC ]: LONORDER(.T,SLLST); [ BIND_ANY_REGISTER ]: LINK(TNREP(.T),ARLST); [ BIND_REGISTER ]: LINK(TNREP(.T),SRLST); [ BIND_IGNORE ]: 0; [ BIND_DECLARE ]: TNSORTENTER(.T); [ BIND_REG_OR_FORGET ]: TNSORTENTER(.T) Tes End End; ! IV. - PACKING ! ------------------------------------------------ ! ! ! THIS, THE LAST PHASE, TAKES THE ORDERED LIST OF TN'S ! AND ATTEMPTS A 'BEST-FIT' PACKING INTO THE AVAILABLE ! REGISTERS, LOCALS, ETC. THE UTILITIES DEFINE VARIOUS ! PRIMITIVES. THE MAIN WORK, AND THE IMPLEMENTATION ! OF THE PACKING POLICY, IS CONTAINED IN THE ROUTINE 'TPACK'. ! ! ! A. - UTILITIES ! ------------------------------------------------ ! 1. - PREFERENCES ! ! IN A FEW CASES WE 'PREFER' THAT TWO TEMP NAMES ! BE PACKED INTO THE SAME LOCATION. THIS SECTION ! PROVIDES THE MECHANISM FOR DOING THIS. THE 'TL' ! ROUTINES ARE CHARGED WITH THE RESPONSIBILITY ! OF NOTING THAT SUCH BINDING IS DESIRABLE. ! ! PUT A PREFREP ON THE PREFCHAIN ! ! note: ! preference chains are lists of tempnames which would ! like to be stored in the same location. There is no ! single head for these chains but rather each tn_pref ! field acts like the head for each TN. ! all these TNREP's are chained together onto a single ! list headed by 'PREFLST'. this list is later scanned ! down and all the TNREP's released. I would think that ! you could scan all the TN's on 'TNCHAIN' and release ! all non-null 'tn_pref' fields. Routine PREFLINK(T : Ref GT) = Begin Local TR : Ref TNREPR; TR = TNREP(.T); T[tn_pref] = .TR; TR[tnr_pref] = .PREFLST; PREFLST = .TR; Return .TR End; ! place tempnames 'T' and 'TW' in the same preference class Routine WANTPREF(T : Ref GT,TW : Ref GT) : Novalue = Begin Local P : Ref TNREPR, P1 : Ref TNREPR; ! if either is NULL then return If .TW Lssu 8 Then Return; If .T Lssu 8 Then Return; ! can't bind to itself If .T Eqla .TW Then Return; ! allocate preference list heads for each P = .TW[tn_pref]; If .P Eqla 0 Then P = PREFLINK(.TW); P1 = .T[tn_pref]; If .P1 Eqla 0 Then P1 = PREFLINK(.T); ! note: LINK has the behavior of merging lists together rather than ! just inserting an element into a list. LINK(.P,.P1) End; ! called when TPACK finds a tempname with a preference. Routine TRYPREF(TN : Ref GT) = Begin Macro OK = Begin TN[gt_reg] = .T; TN[tn_request] = BIND_MEMORY; TN[tn_code] = BOUND_PREFERENCE; SUCCESS End %; Local OPENED : Boolean, TRIED : Boolean, REG : Ref TNREPR, TEMP : Integer, T : Ref Block, L : Ref TNREPR, TR : Ref TNREPR, C : Vector[SRCHWIDTH], CNT : Integer; ! scan the preference list, trying to put this TN in the same register. ! this loop only considers TN's which are already bound to a register. ! note: 'L' is the TNREP for 'TN's preference. the loop examines all ! but this TNREP to avoid binding to itself. L = .TN[tn_pref]; TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; REG = .T[tn_bind_list]; ! if it is a register then see if the TN will fit in it. if not then ! temporarily make the TN the specific register desired and then try to ! reshuffle the registers to make it fit. If ISREGLST(.REG) Then Begin If TRYFIT(.TN,.REG) Then OK; If Not .swit_quick Then Begin TEMP = .T[tn_request]; T[tn_request] = BIND_REGISTER; CNT = COUNTCONFLICTS(.TN,.REG,C); If .CNT Leq SRCHWIDTH Then If TRYALT(.TN,.CNT,.REG,C,SRCHDEPTH) Then Begin T[tn_request] = .TEMP; OK End; T[tn_request] = .TEMP End End End; ! we could not move the preference into a specific register. If .swit_quick Then FAIL; ! scan the preference list again. this time, try opening an empty register ! to make room to move conflicts. otherwise it is the same as the last loop. OPENED = FALSE; TRIED = .RESERVED; TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; REG = .T[tn_bind_list]; If ISREGLST(.REG) Then If Not .TRIED<(.REG-REGS)/8,1> Then Begin TRIED<(.REG-REGS)/8,1,0> = TRUE; TEMP = .T[tn_request]; T[tn_request] = BIND_REGISTER; CNT = COUNTCONFLICTS(.TN,.REG,C); If .CNT Leq SRCHWIDTH Then Begin If Not .OPENED Then Incr I From 0 To 5 Do If EMPTY(REGS[.I]) Then Begin OPENREG(.I); OPENED = TRUE; Exitloop End; If Not .OPENED Then Begin T[tn_request] = .TEMP; Exitloop End; If TRYALT(.TN,.CNT,.REG,C,SRCHDEPTH) Then Begin T[tn_request] = .TEMP; OK End End; T[tn_request] = .TEMP End End; ! from here on, we consider moving the tempname into a memory location. ! return if 'register-or-forget-it' If .TN[tn_request] Eql BIND_REG_OR_FORGET Then FAIL; ! if the difference between placing the TN in a register and placing it in ! memory is '6' then let TPACK try to find a difference location to store ! the variable, hopefully in a register. If .TN[tn_min_complexity] Gtr 6 Then FAIL; ! scan the preference list again. this time, try to place it on ! the top of stack. TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; If MUSTBETOP(.TN,.T[tn_bind_list]) Then If TRYFIT(.TN,.T[tn_bind_list]) Then OK End; ! scan the preference list one last time. this time, try to place ! the TN on anyone's bind list. TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; If .T[tn_bind_list] Neqa 0 Then If TRYFIT(.TN,.T[tn_bind_list]) Then OK End; FAIL End; ! NOW LOOK AT TRY.BLI FOR THE REST OF THE "PACKING" ROUTINES ! E. - DRIVER FOR PACKING ! ------------------------------------------------ ! ! THE FOLLOWING ROUTINE, 'TPACK', DEFINES THE POLICY ! BY WHICH TEMP NAMES ARE BOUND TO LOCATIONS. THAT POLICY ! IS: ! ! 1) BIND THOSE TN'S WHICH MUST BE IN A SPECIFIC REGISTER. ! 2) BIND THOSE TN'S THAT MUST BE IN SOME REGISTER. ! 3) BIND THOSE TN'S THAT MUST BE IN SOME LOCAL. ! 4) BIND THE REMAINDER OF THE TN'S - IN ORDER OF THEIR IMPORTANCE -. ! ! WITHIN 4) THE ALGORITHM IS: ! ! 4A) TRY TO USE THE TN'S 'PREFERENCE', IF ANY. ! 4B) TRY AN OPEN REGISTER. ! 4C) IF THE DIFFERENCE BETWEEN THE TN'S MAX AND MIN COSTS ! IS SUFFICIENTLY SMALL, THEN TRY AN OPEN LOCAL. ! 4D) TRY A CLOSED REGISTER. ! 4E) IF THE DIFFERENCE BETWEEN THE TN'S MAX AND MIN COSTS ! PREVENTED THE ATTEMPT IN 4C), THEN TRY THE ! OPEN LOCALS NOW. ! 4F) USE A CLOSED LOCAL ( THIS WILL ALWAYS WORK AS ! A LAST RESORT). ! ! NOTE THAT THE TN-REP LISTS ARE RELEASED AS WE GO ! THROUGH ALL THIS. ! ! Routine TPACK : Novalue = Begin Local T : Ref GT, TR : Ref TNREPR, P : Ref TNREPR, L : Ref TNREPR, TEMP : Ref TNREPR; Label aaa; INITSTK(STEMPS); ! pack the specific registers TR = SRLST; Until (TR = .TR[itm_rlink]) Eqla SRLST Do Begin T = .TR[tnr_ptr]; TRYSPREG(.T,.T[gt_reg]) End; ! pack the arbitrary registers TR = ARLST; Until (TR = .TR[itm_rlink]) Eqla ARLST Do Begin T = .TR[tnr_ptr]; ! try first an open register If Not TRYOPREG(.T) Then ! try next to reshuffle the registers If .swit_quick Or Not TRS(.T,SRCHDEPTH) Then ! try next a closed register If Not TRYCLREG(.T) Then ! if everything fails then given an error and arbitrarily use R5 Begin WARNEM (0,B11$_NOT_ENOUGH); T[tn_bind_list] = REGS[5]; T[tn_code] = BOUND_REGISTER; T[gt_reg] = 5 End End; ! estimate the number of registers needed If .ESTIM Gtr 1 Then Begin ! only 6 registers available If .ESTIM Gtr 6 Then ESTIM = 6; ! try to make do with less If .ESTIM Gtr 2 Then ESTIM = .ESTIM-1; !!! following code missing in bliss-32 version and is wrong !!! anyway. DTEMPS does not have a stk_max field. !!! If .DTEMPS[stk_max] Geq 0 Then ! ??? STEMPS? stk_dtd? !!! ESTIM = .ESTIM-1; !!! end of missing code ! open all the reserved registers and count the already open registers Decr I From 5 To 0 Do Begin If .RESERVED<.I,1,0> Then OPENREG(.I) Else If ISOPEN(REGS[.I]) Then ESTIM = .ESTIM-1 End; ! if any more registers estimated as being needed then open them If .ESTIM Gtr 0 Then Incr I From 0 To 5 Do If EMPTY(REGS[.I]) Then If (ESTIM = .ESTIM-1) Geq 0 Then OPENREG(.I) Else Exitloop End; ! pack the other temp names. note: ordered by complexity/FON span Decr I From SZ_ULST-1 To 0 Do Begin L = ULST[.I]; TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do aaa: Begin T = .TR[tnr_ptr]; ! if this tempname has a preference, try to place it on its preference list If .T[tn_pref] Neqa 0 Then If TRYPREF(.T) Then Begin Leave aaa End; ! see if it will fit in an open register If TRYOPREG(.T) Then Leave aaa; ! try reshuffling registers to make it fit If Not .swit_quick Then If TRS(.T,SRCHDEPTH) Then Leave aaa; ! see if we can open a new register If TRYCLREG(.T) Then Leave aaa; ! if register or forget, restore it to its original memory address If .T[tn_request] Eql BIND_REG_OR_FORGET Then Begin T[tn_request] = BIND_MEMORY; T[gt_reg] = .T[gt_disp]; T[gt_disp] = 0 End ! otherwise try making it a dynamic temp Else If Not TRYDYTEMPS(.T) Then ! and if that failed, make it a simpe static local LONORDER(.T,SLLST) End; End; ! pack the static locals TR = SLLST; Until (TR = .TR[itm_rlink]) Eqla SLLST Do Begin T = .TR[tnr_ptr]; ! try an existing open static. if that failed, create a new static If Not TRYOPSTEMPS(.T) Then TRYCLSTEMPS(.T) End End; ! F. - MARKING OF TNS AFTER PACKING Routine TMARK : Novalue = Begin Local L : Ref TNREPR, TR : Ref TNREPR, T : Ref GT; ! mark all TN's on the register lists and bound to a register as bound to ! a register and set the register number unless bound to a preference. ! those with a bind preference use the register in the preference. Decr I From 5 To 0 Do Begin L = REGS[.I]; TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; If .T[tn_code] Neq BOUND_PREFERENCE Then Begin T[tn_code] = BOUND_REGISTER; T[gt_reg] = .I End End End; ! change all static tempnames to stack references. for bind preference, ! [gt_reg] points to the TN bound to. STATICSIZE = (.STEMPS[stk_max]+1)*2; Decr I From .STEMPS[stk_max] To 0 Do Begin L = STEMPS[stk_item(.I)]; TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; If .T[tn_code] Neq BOUND_PREFERENCE Then Begin T[tn_code] = BOUND_LOCAL; T[gt_reg] = SP; T[gt_mode] = INDEXED; T[gt_disp] = -(.MAXLOCALS+(.I+1)*2) End End End; ! change all dynamic temporary to stack temporaries but of type push ! (unless a type already is set). ! bind-to-preference TN's are not considered. Decr I From .DTEMPS[stk_max] To 0 Do Begin L = DTEMPS[stk_item(.I)]; TR = .L; Until (TR = .TR[itm_rlink]) Eqla .L Do Begin T = .TR[tnr_ptr]; If .T[tn_code] Neq BOUND_PREFERENCE Then Begin If .T[tn_code] Eql BOUND_NONE Then T[tn_code] = BOUND_PUSH; T[gt_reg] = SP; T[gt_mode] = INDEXED; T[gt_disp] = -(.MAXLOCALS+.STATICSIZE+(.I+1)*2) End End End End; ! mark all symbols which are bound to a register Routine MARKSYMBOLS : Novalue = Begin Local S : Ref ST, Q : Ref ST, REG : Integer, NODE : Ref GT; Label aaa; ! loop for each symbol S = .PURGED; Until .S Eqla 0 Do aaa: Begin Q = .S; S = .S[st_next]; ! only REGISTER, LOCAL, and possibly BIND symbols may be bound to ! a register. Selectone .Q[st_code] Of Set [S_REGISTER,S_LOCAL]: NODE = .Q; [S_BIND]: Begin NODE = .Q[st_bind_data]; If .NODE[gt_type] Neq T_NODE Then Leave aaa End; [Otherwise]: Leave aaa Tes; ! locate the register bound to and if SP, note the stack offset ! of the variable Until (REG = .NODE[gt_reg]) Lequ 7 Do NODE = .REG; If .REG Eql SP Then Q[gt_disp] = .NODE[gt_disp]; Q[st_var_reg_index] = .REG End End; ! V. - DRIVER FOR TNBIND MODULE ! create TN's for all the pre-defined registers Routine INITPDTNS : Novalue = Begin Local L : Ref GT; Macro MAKEREG(NAME,REGNUM,IGNORE) = Begin L = NAME[gt_reg] = GETTN(); L[gt_reg] = REGNUM; L[tn_request] = IGNORE; L[tn_code] = BOUND_REGISTER; End %; MAKEREG(PCREG,PC,BIND_IGNORE); MAKEREG(SPREG,SP,BIND_IGNORE); MAKEREG(VVREG,VR,BIND_IGNORE); MAKEREG(RR0, 0, BIND_REGISTER); MAKEREG(RR1, 1, BIND_REGISTER); MAKEREG(RR2, 2, BIND_REGISTER); MAKEREG(RR3, 3, BIND_REGISTER); MAKEREG(RR4, 4, BIND_REGISTER); MAKEREG(RR5, 5, BIND_REGISTER) End; Global Routine TNBIND(NODE : Ref GT) : Novalue = Begin Local P : Ref TNREPR, Q : Ref TNREPR; External Routine PrintTnrepList : Novalue, PrintTree : Novalue; ! create TN's for all the pre-defined registers INITPDTNS(); ! initialize all the lists and stacks PREFLST = 0; INITSTK(DTEMPS); INITSTK(stk_loop); INITLS(stk_loop_lf); INITSTK(stk_call); INITLS(stk_fon); INITLS(stk_dtd); ! if this is not a routine (e.g. the module body) or there are ! any ENABLE declarations then open all registers for use. If .NODE[gt_type] Neq T_NODE Or .NODE[gt_code] Neq OP_ROUTINE Or .flg_enable Then Decr I From 5 To 0 Do Begin NULLLST(REGS[.I]); OPENREG(.I) End; ! initialize the LON/FON and cost information LON = 1; FON = 1; SAVE_STACK_DEPTH; ! TLA the expression TLA(.NODE,0,0,0); POP_STACK_DEPTH; ! release some of the stacks RELEASESPACE(.stk_loop,STKSIZE); RELEASESPACE(.stk_call,STKSIZE); ! get a rough estimate of the number of registers needed ESTIM = ESTIMATE(); ! sort out all the tempnames TRANK(); ! bind all the tempnames to register/memory locations TPACK(); ! now mark all tempnames as to type and request TMARK(); ! mark the symbols as well for the debugger If .swit_debug Then MARKSYMBOLS(); ! for debugging purposes... If .swit_dump_tnbind Then Begin Print(AZ('\n\n==== after tnbind ===\n\n')); PrintTree(.NODE,2); Print(AZ('\n--- SRLST\n')); PrintTnrepList(SRLST); Print(AZ('\n--- ARLST\n')); PrintTnrepList(ARLST); Print(AZ('\n--- SLLST\n')); PrintTnrepList(SLLST); Incr i From 0 To SZ_ULST-1 Do Begin Print(AZ('\n--- ULST[%d]\n'),.i); PrintTnrepList(ULST[.I]) End End; ! release all the TN's created now. RELTNREPLST(SRLST); RELTNREPLST(ARLST); RELTNREPLST(SLLST); Decr I From SZ_ULST-1 To 0 Do RELTNREPLST(ULST[.I]); P = .PREFLST; While .P Neqa 0 Do Begin Q = .P[tnr_pref]; RELTNREP(.P); P = .Q End End; End Eludom