# 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
