sources/pass1/names/exec.pas

   1 module execprog[];\r
   2 (*CBC B.Ciesielski *)\r
   3 (* PASCAL routines for EXEC standard function *)\r
   4 \r
   5 var\r
   6     pspdd    : word;\r
   7     defdsdd  : word;\r
   8     envdd    : word;\r
   9     cesxqq [external] : word;               ! ES register from Pascal\r
  10     addr_ptr          : ads of word;\r
  11     ax,bx,cx,dx,si,di : word;        ! General Registers\r
  12     ds,es             : word;        ! Segment Registers\r
  13     errcode           : word;        ! Error code returned from DOS\r
  14 \r
  15 procedure dos(var ax,bx,cx,dx,si,di,ds,es,errcode : word); external;\r
  16 \r
  17 procedure initdd(var ax,bx,cx,dx,si,di,ds,es : word);\r
  18 {INITDD Initialize registers for call to DOS.}\r
  19   begin {initdd}\r
  20     ds := defdsdd;                          ! Program Data Segment\r
  21     es := ds;\r
  22     si := 0;\r
  23     di := 0;\r
  24     ax := 0;\r
  25     bx := 0;\r
  26     cx := 0;\r
  27     dx := 0\r
  28   end;  {initdd}\r
  29 \r
  30 procedure asciizdd(const lstr : lstring; var astr : string);\r
  31 {ASCIIZDD  This procedure converts a lstring variable to a ASCIIZ string.\r
  32  An asciiz string is terminated by a byte of zeroes.}\r
  33   var\r
  34     len,alen : byte;\r
  35   begin {asciizdd}\r
  36     len  := lstr.len;\r
  37     alen := wrd(upper(astr));\r
  38     if (len >= alen) then\r
  39        len := alen - 1;\r
  40     movel(adr lstr[1],adr astr[1],len);\r
  41     astr[len + 1] := chr(0)\r
  42   end;  {asciizdd}\r
  43 \r
  44 procedure initsup;\r
  45 (* initialize system pointers *)\r
  46   begin\r
  47     pspdd      := cesxqq;                   ! Program segment prefix\r
  48     addr_ptr   := ads cesxqq;\r
  49     defdsdd    := addr_ptr.s;               ! Default data segment\r
  50     addr_ptr.s := pspdd;                    ! Program environment address\r
  51     addr_ptr.r := #2c;                      ! is at offset #2c in PSP.\r
  52     envdd      := addr_ptr^\r
  53   end; {initsup}\r
  54 \r
  55 procedure setblkmm(blkseg,blksize : word;  var block,ercode : word);\r
  56 {SETBLKMM  Modifies Allocated Blocks.  The memory block pointed to by\r
  57  blkseg is modified to the size (in paragraphs) of blksize.  The\r
  58  block increases or decreases in size to that specified in blksize.\r
  59  If the block cannot grow to blksize, the largest possible expansion\r
  60  is made, and new block size is returned in block.  The values for\r
  61  the returned error code are:\r
  62 \r
  63               0 - Successful reallocation.  The new block size\r
  64                   (in paragraphs) is in block.\r
  65               1 - Memory control blocks destroyed\r
  66               2 - Insufficient memory on a grow request.  The\r
  67                   new block size is in block.\r
  68               3 - The pointer in blkseg points to a block which\r
  69                   has not been allocated.\r
  70             >99 - Unidentified error.                                   }\r
  71 \r
  72   begin {setblkmm}\r
  73 \r
  74     initdd(ax,bx,cx,dx,si,di,ds,es);        ! Initialize registers\r
  75     ax := byword(#4a,0);                    ! DOS Function 4ah\r
  76     es := blkseg;\r
  77     bx := blksize;\r
  78 \r
  79     dos(ax,bx,cx,dx,si,di,ds,es,errcode);\r
  80 \r
  81     block := bx;\r
  82     case errcode of\r
  83       0 : ercode := 0;\r
  84       7 : begin                             ! Destroyed control blocks\r
  85             block  := 0;\r
  86             ercode := 1\r
  87           end;\r
  88       8 : ercode := 2;                      ! Not enough memory\r
  89       9 : begin\r
  90             block  := 0;                    ! Illegal block request\r
  91             ercode := 3\r
  92           end\r
  93       otherwise\r
  94             block  := 0;\r
  95             ercode := 100 + errcode\r
  96     end  {case}\r
  97 \r
  98   end;  {setblkmm}\r
  99 \r
 100 procedure shrinkmm(var ercode : word);\r
 101 {SHRINKMM  Release all memory not needed by the executing program.  This\r
 102  procedure makes a call to SETBLKMM to release all memory which has\r
 103  been allocated, but which is not needed.  DOS normally allocates all\r
 104  memory to a program, so memory must be released before other calls to\r
 105  ALLOCMM are made.  The required memory is calculated as the code size\r
 106  plus the data space.  The code size is essentially the default data\r
 107  segment minus the program segment prefix.  The data space is the mini-\r
 108  mum of #1000 paragraphs (64K bytes) or the remainder of memory.  The\r
 109  value of the error code returned is that returned by SETBLKMM.}\r
 110 \r
 111   var\r
 112     topmem_ptr : ads of word;               ! Pointer to word containing\r
 113     topmem     : word;                      ! top of memory.\r
 114     data_seg   : word;                      ! data segment start\r
 115     code_size  : word;\r
 116     data_space : word;\r
 117     blksize    : word;                      ! Total block size needed\r
 118 \r
 119   begin {shrinkmm}\r
 120 \r
 121     topmem_ptr.s := pspdd;\r
 122     topmem_ptr.r := 2;                      ! At offset 2 in PSP\r
 123     topmem       := topmem_ptr^;\r
 124     data_seg     := defdsdd;                ! Default data segment\r
 125     if (data_seg < pspdd) then              ! data_seg can be "negative"\r
 126        data_seg := topmem - (pspdd - data_seg);\r
 127     code_size    := data_seg - pspdd;\r
 128     data_space   := topmem - data_seg;\r
 129     if (data_space < #1000) then\r
 130        blksize   := code_size + data_space\r
 131     else\r
 132        blksize   := code_size + #1000;\r
 133 \r
 134     setblkmm(pspdd,blksize,blksize,ercode)\r
 135 \r
 136   end;  {shrinkmm}\r
 137 \r
 138 procedure execmm  (const proc_name, cmd_line : lstring;\r
 139                                                    var ercode : word) [public];\r
 140 {EXECMM  Load and execute a program.  This procedure loads and executes\r
 141  another program.  The program path name is given in proc_name; the\r
 142  command line is given in cmd_line.  The specified program will be\r
 143  loaded and executed as if invoked from DOS with the given command\r
 144  line.  The spawned program returns control to the calling procedure\r
 145  when execution ends, either normally or using a Ctrl/Break sequence.\r
 146  The values of the returned error code are:\r
 147 \r
 148               0 - Successful execution and return.\r
 149        (*)    1 - Memory control blocks destroyed when trying\r
 150                   to reserve memory.\r
 151        (*)    2 - Insufficient memory when trying to reserve\r
 152                   memory.\r
 153        (*)    3 - Illegal block change request when trying to\r
 154                   reserve memory.\r
 155               4 - Executable file not found.\r
 156               5 - Access denied.  The file does not allow read\r
 157                   access.\r
 158               6 - Insufficient memory to load the new procedure.\r
 159        (*)    7 - Invalid environment created in the called\r
 160                   program.\r
 161        (*)    8 - Invalid format in the environment.\r
 162               9 - Invalid Path Name.  Probably illegal characters\r
 163                   are present in the proc_name parameter.\r
 164             >99 - Unidentified error\r
 165 \r
 166             Errors marked with (*) are internal errors and should not\r
 167             normally occur.  Errors 1 - 3 indicate problems with the\r
 168             SHRINKMM procedure, and errors 7 & 8 are internal errors\r
 169             within EXECMM (the construction of the parameter block).}\r
 170 \r
 171   type\r
 172     parm_block = record                ! Parameter block\r
 173                    env_sadd : word;    ! Segment address of environment\r
 174                    cmd_addr : adsmem;  ! Address of command line\r
 175                    fb1_addr : adsmem;  ! Address of first FCB\r
 176                    fb2_addr : adsmem   ! Address of second FCB\r
 177                  end;\r
 178   var\r
 179     procz      : string(255);          ! ASCIIZ procedure name\r
 180     block_val  : parm_block;           ! Constructed parameter block\r
 181 \r
 182   begin {execmm}\r
 183     initsup;\r
 184     shrinkmm(ercode);                  ! Release available memory\r
 185 \r
 186     if (ercode = 0) then               ! Now load the program\r
 187        begin\r
 188          with block_val do\r
 189            begin\r
 190              env_sadd   := envdd;      ! Copy parent's environment\r
 191              cmd_addr   := ads cmd_line[0];\r
 192              fb1_addr.s := pspdd;\r
 193              fb1_addr.r := #5c;\r
 194              fb2_addr.s := pspdd;\r
 195              fb2_addr.r := #6c\r
 196            end;\r
 197          initdd(ax,bx,cx,dx,si,di,ds,es);\r
 198          ax  := byword(#4b,0);         ! DOS function 4bh\r
 199          bx  := wrd(adr block_val);\r
 200          cx  := 0;\r
 201          asciizdd(proc_name,procz);\r
 202          dx  := wrd(adr procz);        ! Path name as an asciiz string\r
 203 \r
 204          dos(ax,bx,cx,dx,si,di,ds,es,errcode);\r
 205 \r
 206          case errcode of\r
 207            0 : ercode := 0;\r
 208            1 : ercode := 9;            ! Invalid path name\r
 209            2 : ercode := 4;            ! File not found\r
 210            5 : ercode := 5;            ! Access denied\r
 211            8 : ercode := 6;            ! Insufficient memory\r
 212           10 : ercode := 7;            ! Invalid environoment\r
 213           11 : ercode := 8;            ! Invalid format\r
 214            otherwise\r
 215                ercode := 100 + errcode\r
 216          end  {case}\r
 217 \r
 218        end\r
 219 \r
 220   end;  {execmm}\r
 221 \r
 222 end.\r