/* VRUNIT.PLP, SEGSRC, KJC, 01/23/81
/* PLP routine to set up display pointer for user program and kick it off.
/* Copyright (c) 1981, Prime Computer, Inc., Natick, MA 01760
/**************************************************************************/

vrunit: procedure options(nocopy);

  declare mkonu$ entry(char(*) var, entry) options(shortcall(18));
  declare signl$ entry(char(*) var, ptr, bin, ptr, bin, bit(4));
  declare stack_ovf entry external;
  declare stack_ovf$ character(10) varying static initial('STACK_OVF$');
  declare main entry variable static;
  declare main_with_arg entry(bin) variable static;
  declare x_reg fixed binary(31);
  declare i fixed binary(15);
  declare 1 stack based,
            2 main bit( 1),
            2 mbz  bit(15);
  declare 1 itime static external,
            2 date        character(6),
            2 time(6)     fixed binary(15),
            2 seg_file_rev fixed binary(15),
            2 segpnt       fixed binary(15),
            2 unsatcnt     fixed binary(15),
            2 islot        fixed binary(15),
            2 obase        fixed binary(15),
            2 uiiword      bit(16),
            2 low1         fixed binary(15),
            2 high1        fixed binary(15),
            2 stacklc      fixed binary(15),
            2 old_loadpt   fixed binary(15),
            2 procsg       fixed binary(15),
            2 proclc       fixed binary(15),
            2 amod         bit(16),
            2 old_loapnt   fixed binary(15),
            2 stackx       fixed binary(12),
            2 stackr       fixed binary(12),
            2 extras(5)    fixed binary(15);
  declare 1 isave static external,
            2 ecb_addr   pointer,
            2 stack_addr pointer,
            2 l_reg      fixed binary(31),
            2 x_reg      fixed binary(15),
            2 keys       bit(16),
            2 symbol_table_size fixed binary(31);
  declare 1 stack$ static external,
            2 ext pointer,
            2 ovf pointer;
  declare bin fixed binary(15) based;
  declare bits bit(16) based;
  declare 1 entry_variable based,
            2 pointer pointer,
            2 disp_ptr fixed binary(31);
  declare 1 ecb based,
            2 pb pointer,
            2 stack_size fixed binary(15),
            2 stack_root fixed binary(12),
            2 arg_disp   fixed binary(15),
            2 num_of_args fixed binary(15),
            2 lb pointer,
            2 keys       fixed binary(15);

%Replace X$  by 7;                /* Regfile address for X   register */

  do i = '70'B3 to '77'B3;
    ptr('4000'B3, i)->bin = 0;    /* zero out all interrupt vectors */
   end;


  ext = baserel(stack_addr, 2);   /* address of Stack Header Extension Pointer */

  if itime.stackx ^= 0
    then do;
      ovf = ptr(itime.stackx, 4);
      call mkonu$(stack_ovf$, stack_ovf);
     end;
    else;

  baseptr(stack_addr) -> pointer = stack_addr; /* set up free pointer */

  ecb_addr -> stack_root = segno(stack_addr);     /* munge stack root in Main ECB */

  do i = 2 to 10;
    baserel(stack_addr, i) -> bin = 0;    /* zero out words near stack root */
   end;

  stackptr() -> stack.main = '1'B;        /* set the main program flag in the stack header */
                                          /* this is so a user will not back up
                                             in his stack past SEG */

  x_reg = isave.x_reg;            /* do bin(15) -> bin(31) conversion for STLR */
  regfile(X$) = x_reg;            /* Save X register for program start */

  if ecb_addr -> ecb.num_of_args = 0
    then do;
      addr(main) -> pointer = isave.ecb_addr;  /* put starting address in MAIN */
      addr(main) -> disp_ptr = isave.l_reg;    /* Put L register into display pointer */
      call main;                               /* start program */
     end;
    else do;
      addr(main_with_arg) -> pointer = isave.ecb_addr; /* put starting address in MAIN */
      addr(main_with_arg) -> disp_ptr = isave.l_reg;   /* Put L register into display pointer */
      call main_with_arg(0);
     end;

  stackptr() -> bits = '0'B;              /* Clear the flag, we are done */

  return;

 end /* vrunit */;