# vcg_module --- code generator module handler # module --- read and process data and procedure definitions subroutine module call clear_str call clear_link call clear_obj call initialize_labels call put_module_header call generate_entries call generate_static_stuff call generate_procedures call put_module_trailer return end # generate_entries --- generate ENT declarations for global symbols subroutine generate_entries include VCG_COMMON character extname (MAXLINE) integer object_id, namelen, i, op integer get DB call print (ERROUT, "generate_entries:*n"s) Infile = Stream_1 # switch to the ENT stream # Assume MODULE_OP has already been eaten up by top-level loop while (get (op) == SEQ_OP) { call get (object_id) call get (namelen) for (i = 1; i <= namelen; i += 1) call get (extname (i)) extname (i) = EOS call mapstr (extname, UPPER) call put_ent (extname, object_id) } call put_start_data if (op ~= 0 && op ~= NULL_OP) call warning ("missing SEQ between ENT ops in stream 1*n"p) return end # generate_static_stuff --- read and generate static data decls/defns subroutine generate_static_stuff include VCG_COMMON integer op integer get ipointer code ipointer load ipointer gen_generic tpointer decl_or_defn regset regs DB call print (ERROUT, "generate_static_stuff:*n"s) Infile = Stream_2 # switch to static decls/defns stream if (get (op) ~= MODULE_OP) call panic ("missing MODULE in static data stream*n"p) call put_instr (gen_generic (LINK_INS)) while (get (op) == SEQ_OP) { call clear_tree call get_tree (decl_or_defn) call clear_instr code = load (decl_or_defn, regs) # a temporary kluge call put_instr (code) } call put_instr (gen_generic (PROC_INS)) if (op ~= 0 && op ~= NULL_OP) call warning ("missing SEQ between static data decls/defns*n"p) return end # generate_procedures --- generate code for all procedure defns in module subroutine generate_procedures include VCG_COMMON integer op integer get tpointer proc ipointer code ipointer generate_proc DB call print (ERROUT, "generate_procedures:*n"s) Infile = Stream_3 if (get (op) ~= MODULE_OP) call panic ("missing MODULE in procedure definition stream*n"p) while (get (op) == SEQ_OP) { call clear_tree call get_tree (proc) call clear_instr code = generate_proc (proc) call optimize (code) call put_instr (code) } if (op ~= 0 && op ~= NULL_OP) call warning ("missing SEQ between procedure definitions*n"p) return end # generate_proc --- generate code for a procedure definition ipointer function generate_proc (tree) tpointer tree include VCG_COMMON integer ad (ADDR_DESC_SIZE), argn, tad (ADDR_DESC_SIZE), vname (MAXLINE), i, j integer ctov unsigned argdisp, junk, startlab unsigned rsv_stack, stack_size, mklabel, rsv_link ipointer lc, ca ipointer gen_ent, gen_ecb, gen_generic, gen_mr, load, seq, gen_label, void, gen_copy, setup_frame_owner, gen_data regset regs DB call print (ERROUT, "generate_proc:*n"s) call clear_stack # prepare for new locale Break_sp = 1 Continue_sp = 1 # generate a PROC pseudo-op and a start label for the procedure's code startlab = mklabel (1) lc = seq (gen_generic (PROC_INS), gen_label (startlab)) if (Tmem (tree + 2) > 0) lc = seq (lc, gen_generic (ARGT_INS)) # generate code to associate this stack frame with an ECB: lc = seq (lc, setup_frame_owner (Tmem (tree + 1))) argdisp = 0 # handle argument transfer and value copying, if there are any args if (Tmem (tree + 2) > 0) { # First, allocate 3 words for each argument, to make room for # APs generated by the microcode. Note these are guaranteed # to be in contiguous increasing memory addresses. argdisp = rsv_stack (3) # for the first arg for (argn = 2; argn <= Tmem (tree + 2); argn += 1) junk = rsv_stack (3) # for arg i - 1 # Next, examine each argument. If it has a REFERENCE disposition # (ie, it's a pointer), simply build an address descriptor for # it and associate that ad with the argument's object id. # If it has a VALUE disposition, get the value, deallocate the # AP, store the value back in the next free stack location, # and associate the new address with the argument's object id. AD_BASE (ad) = SB_REG AD_RESOLVED (ad) = YES ca = Tmem (tree + 4) # current argument pointer argn = 0 # ordinal of current arg while (ca ~= 0) { # repeat until end of arg list AD_MODE (ad) = DIRECT_AM AD_OFFSET (ad) = argdisp + argn * 3 if (Tmem (ca + 3) == VALUE_DISP) { AD_MODE (ad) = INDIRECT_AM select (Tmem (ca + 4)) # argument size when (1) { # INTs, UNSs, and 1-word stowed operands lc = seq (lc, gen_mr (LDA_INS, ad)) call free_stack (argdisp + argn * 3) AD_MODE (ad) = DIRECT_AM AD_OFFSET (ad) = rsv_stack (1) lc = seq (lc, gen_mr (STA_INS, ad)) } when (2) { # long INT, long UNS, float, and 2-word stowed lc = seq (lc, gen_mr (LDL_INS, ad)) call free_stack (argdisp + argn * 3) AD_MODE (ad) = DIRECT_AM AD_OFFSET (ad) = rsv_stack (2) lc = seq (lc, gen_mr (STL_INS, ad)) } when (4) { # long float and 4-word stowed lc = seq (lc, gen_mr (DFLD_INS, ad)) call free_stack (argdisp + argn * 3) AD_MODE (ad) = DIRECT_AM AD_OFFSET (ad) = rsv_stack (4) lc = seq (lc, gen_mr (DFST_INS, ad)) } else { # other stowed pass-by-value operands AD_MODE (tad) = DIRECT_AM AD_BASE (tad) = SB_REG AD_OFFSET (tad) = rsv_stack (Tmem (ca + 4)) lc = seq (lc, gen_copy (ad, tad, Tmem (ca + 4))) AD_MODE (ad) = DIRECT_AM AD_OFFSET (ad) = AD_OFFSET (tad) } } call enter_obj (Tmem (ca + 1), ad) argn += 1 ca = Tmem (ca + 5) } # while } # end of argument processing (if (Tmem (tree + 2) > 0)...) # Generate code for the procedure body, including a free return: lc = seq (lc, void (Tmem (tree + 5), regs)) lc = seq (lc, gen_generic (PRTN_INS)) # Generate the entry control block for the procedure. generate_proc = seq (lc, gen_generic (LINK_INS), gen_ecb (Tmem (tree + 1), startlab, argdisp, Tmem (tree + 2), stack_size (junk))) junk = rsv_link (16) # mark the space used # stuff the ecb obj id and its address into the obj table # so later PCL's can use it AD_MODE (ad) = DIRECT_AM AD_BASE (ad) = LB_REG AD_OFFSET (ad) = junk AD_RESOLVED (ad) = YES call enter_obj (Tmem (tree + 1), ad) # Output the procedure name after the ECB, for debugging. i = Tmem (tree + 3) j = ctov (Smem, i, vname, MAXLINE) i = j + 2 spchar (vname, i, 0) # make sure the padding byte is zero j = 1 + (j + 1) / 2 # the number of words in the PL/I varying string for (i = 1; i <= j; i += 1) { generate_proc = seq (generate_proc, gen_data (vname (i))) junk = rsv_link (1) } # To save space, delete the associations between procedure arguments # and their address descriptors: for (ca = Tmem (tree + 4); ca ~= 0; ca = Tmem (ca + 5)) call delete_obj (Tmem (ca + 1)) return end