# otg_mem2 --- otg memory management routines for literal & label storage # hacked directly from the vcg memory management routines # # This has been split into 2 parts because so many symbols # cause 'rp' to barf on insufficient dynamic memory (it only # has 32K of dynamic space). Any extra routines should be # placed in a seperate file. include OTG_DEFS define(DB,#) define (ENT_COMMON,"otg_ent_com.r.i") define (locate_ent,ent$01) # resolve_ent --- get the next entry point name and its obj id # # If there is an entry point name left in the table # return YES, the name, and its id number # Automatically deletes the name. integer function resolve_ent (name, base, offset) integer name (ARB), base, offset include ENT_COMMON integer ptr, i, j, obj_id, lookup_lab, ad (ADDR_DESC_SIZE) DB call print (ERROUT, "resolve_ent:*n"p) ptr = Emem (1) DB call print (ERROUT, " ptr = *i*n"s, ptr) if (ptr ~= 0) { # found one, now copy it over for ({i = 1; j = ptr + 1};i <= PMA_NAME_LEN; {i += 1; j += 1}) name (i) = Emem (j) DB call print (ERROUT, " ENT *s*n"p, name) obj_id = Emem (ptr + 1 + PMA_NAME_LEN) if (lookup_lab (obj_id, ad) == NO) call panic ("resolve_ent: obj *i not found*n"p, obj_id) base = AD_BASE (ad) offset = AD_OFFSET (ad) Emem (1) = Emem (ptr) # chop it off the list return (YES) } DB call print (ERROUT, " not found*n"s) return (NO) end undefine (ENT_COMMON) undefine (lookup_ent) define (LAB_HASH_TAB_SIZE,43) # must be prime define (LAB_COMMON,"otg_lab_com.r.i") define (locate_lab,lab$01) # routine is local to module # label (object) memory management routines # # The object node looks look like this: # _____________ ________________ # | hash slot | ==> | ===> | pointer to next node # ------------- +--------------+ # | obj_id | # +--------------+ # | AD_MODE | # | AD_BASE | # | AD_OFFSET | address descriptor # | AD_RESOLVED | # | | # ---------------- # # clear_lab --- initialize label/address-descriptor storage subroutine clear_lab include LAB_COMMON integer i for (i = 1; i <= LAB_HASH_TAB_SIZE; i += 1) Lbmem (i) = 0 Lbfree = 0 Lbnext = LAB_HASH_TAB_SIZE + 1 return end # enter_lab --- associate label id and address descriptor subroutine enter_lab (lab, ad) integer lab, ad (ADDR_DESC_SIZE) include LAB_COMMON integer loc, pred integer i integer locate_lab DB call print (ERROUT, "enter_lab: lab id = *i*n"p, lab) if (locate_lab (lab, loc, pred) == NO) { if (Lbfree ~= 0) { # pull a node off the free list loc = Lbfree Lbfree = Lbmem (Lbfree) } else { # allocate more space in Lbmem if (Lbnext + 2 + ADDR_DESC_SIZE > MAX_LAB_MEMORY) call panic ("enter_lab: out of space*nincrease MAX_LAB_MEMORY in vcg_def.i*n"p) loc = Lbnext Lbnext += 2 + ADDR_DESC_SIZE } Lbmem (loc) = 0 # set link-to-next-label field Lbmem (loc + 1) = lab # set label id field Lbmem (pred) = loc # link in the new node } # copy address descriptor for ({loc += 2; i = 1}; i <= ADDR_DESC_SIZE; {i += 1; loc += 1}) Lbmem (loc) = ad (i) return end # locate_lab --- find place for label in appropriate hash list integer function locate_lab (lab, loc, pred) integer lab integer loc, pred include LAB_COMMON DB call print (ERROUT, "locate_lab: lab id = *i*n"p, lab) pred = mod (iabs (lab), LAB_HASH_TAB_SIZE) + 1 loc = Lbmem (pred) while (loc ~= 0 && Lbmem (loc + 1) ~= lab) { pred = loc loc = Lbmem (loc) } DB call print (ERROUT, " locate_lab returns"p) if (loc == 0) { DB call print (ERROUT, " NO*n"p) return (NO) } else { DB call print (ERROUT, " YES*n"p) return (YES) } end # lookup_lab --- get address descriptor associated with label, if possible integer function lookup_lab (lab, ad) integer lab, ad (ADDR_DESC_SIZE) include LAB_COMMON integer i integer locate_lab integer loc, pred DB call print (ERROUT, "lookup_lab: lab id = *i*n"p, lab) if (locate_lab (lab, loc, pred) == NO) return (NO) else { DB call print (ERROUT, " label found*n"p) for ({loc += 2; i = 1}; i <= ADDR_DESC_SIZE; {i += 1; loc += 1}) ad (i) = Lbmem (loc) DB call print (ERROUT, " address copied*n"p) return (YES) } end # delete_lab --- remove association between label and address descriptor subroutine delete_lab (lab) integer lab include LAB_COMMON integer locate_lab integer loc, pred DB call print (ERROUT, "delete_lab: lab id = *i*n"p, lab) if (locate_lab (lab, loc, pred) == YES) { Lbmem (pred) = Lbmem (loc) # unlink node from hash chain Lbmem (loc) = Lbfree # link onto freelist Lbfree = loc } return end # get_label_addr --- get address info for a label subroutine get_label_addr (l_desc, addr, fwd_ref, oneword) integer l_desc (ADDR_DESC_SIZE), addr (ADDR_DESC_SIZE), oneword bool fwd_ref, missin include OTG_COMMON integer lad (ADDR_DESC_SIZE), l_base, label_id, fwd_offset fwd_ref = FALSE if (missin (oneword) || oneword == NO) fwd_offset = 1 else fwd_offset = 0 # pointer to address that needs to be fixed up l_base = AD_BASE (l_desc) if (l_base == SB_REG || l_base == XB_REG) # for now call panic ("get_label_addr: bad base reg.*n"p) label_id = AD_LABEL (l_desc) DB call print (ERROUT, "get_label_addr: L*,-10i_*n"s, label_id) # target label is not defined yet (forward reference) if (lookup_lab (label_id, lad) == NO) { DB call print (ERROUT, " new label*n"s) AD_MODE (lad) = DIRECT_AM AD_BASE (lad) = l_base AD_OFFSET (lad) = PB_here + fwd_offset # references always made from PB%; this is back-ptr to 1st ref # from next in chain if any # don't need refs from LB% (eg., IP's to labels) # since they are illegal right now (see otg_misc) AD_RESOLVED (lad) = NO AD_OFFSET (addr) = 0 # end of fwd-ref chain fwd_ref = TRUE call enter_lab (label_id, lad) } # target label has been defined, but not resolved # current instr. is next in a chain of fwd refs to target else if (AD_RESOLVED (lad) == NO) { DB call print (ERROUT, " old label, fwd. ref*n"s) call delete_lab (label_id) AD_OFFSET (addr) = AD_OFFSET (lad) # link into backwards chain AD_OFFSET (lad) = PB_here + fwd_offset # references always made from PB%; this is back-ptr to prev ref fwd_ref = TRUE call enter_lab (label_id, lad) } # label has already been defined so we just use its address else { DB call print (ERROUT, " label defined*n"s) AD_OFFSET (addr) = AD_OFFSET (lad) } AD_BASE (addr) = AD_BASE (lad) AD_MODE (addr) = AD_MODE (lad) DB call print (ERROUT, " label address fetched*n"s) return end undefine (LAB_COMMON) undefine (LAB_HASH_TAB_SIZE) undefine (locate_lab) undefine (DB)