Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPTOOL5.ZIP/TPEXEC.INC

Text File | 1987-03-28 | 4.8 KB | 185 lines

const tpexec_tag: string[90]
   = #0'@(#)CURRENT_FILE LAST_UPDATE Execute DOS commands 1.0'#0;
#log Execute DOS commands 1.0

(*
 * exec.inc - execute dos command line from turbo pascal
 *
 * note:  compile with max-heap < $1000 to leave room for
 *        the subprogram!
 *
 *)

const
   null =              #00;
   cr =                #13;

type
   longstring =        string [64];

   fcb =               array [1..37] of char;

var
   reg:                regpack;
   fcb1,
   fcb2:               fcb;
   filespec,
   dta,
   psp80:              longstring;
   flagreg,
   exitstat,
   memreq:             integer;

   parm_blk:           record
         environ:            integer;
         clp,
         f1,
         f2:                 ^longstring;
   end;



function exec (comname:      longstring;
               params:       longstring): boolean;
                           {-execute a .COM or .EXE file using the
                            standard command processor.  return
                            TRUE if any errorlevels other than 0}


procedure shrinkmem (memreq:             integer);
                           {-free memory above this program for use by
                             the DOS command}

var
   membyte:            real;

begin
   memreq := memavail + seg (heapptr^)- cseg + 800;
   parm_blk.environ := memw [cseg : $2C];
   parm_blk.clp := ptr (dseg, ofs (psp80 [1]));
   parm_blk.f1 := ptr (dseg, ofs (fcb1 [1]));
   parm_blk.f2 := ptr (dseg, ofs (fcb2 [1]));

   membyte := 16.0 * Int (memreq);
   if membyte > 128000.0 then
   begin
      writeln(whoami,':  Program requires ', membyte : 6 : 0, ' bytes');
      writeln('The Max-Heap option was probably not set when ',whoami);
      writeln('was last compiled.');
      halt(1);
   end;

   reg.es := cseg;
   reg.bx := memreq;
   reg.ax := $4A00;
   msdos(reg);                {use DOS SETBLOCK function}


   if (reg.flags and 1)= 1 then
   begin
      writeln(whoami,':  Memory allocation error');
      halt(1);
   end;
end;                       {shrinkmem}



procedure initfcb (var x:              fcb);
                           {-initialize a file control block}

var
   i:                  integer;

begin
   x[1]:= null;               {drive ID}

   for i := 2 to 12 do
      x[i]:= '?';             {filename and extension as wildcards}

   for i := 13 to 37 do
      x[i]:= null;
end;                       {init}



procedure callexec;        {-preserve registers and use DOS EXEC function}

begin
   inline                     {save the registers which will be wiped
                                out}

   ($9C/                    {pushf}
    $2E/$89/$2E/$80/$00 /   {MOV cs:80H,BP}
    $2E/$89/$26/$82/$00 /   {MOV cs:82H,SP}
    $2E/$8C/$1E/$84/$00 /   {MOV cs:84H,DS}
    $2E/$8C/$16/$86/$00 /   {MOV cs:86H,SS}
    $1E/$07/                {mov ES,DS}
    $BA/filespec/           {mov dx,offset(filespec[0])}
    $42/                    {inc dx (to point to filespec[1])}
    $BB/parm_blk/           {mov bx,offset(parm_block)}
    $B8/$00/$4B/            {mov ax,4B00H}
    $FB/                    {sti}
    $cd/$21/                {int 21 - call EXEC}
    $FA/                    {cli: avoid interrupts while restoring stack}
    $2E/$8B/$2E/$80/$00 /   {MOV BP,cs:80H}
    $2E/$8B/$26/$82/$00 /   {MOV SP,cs:82H}
    $2E/$8E/$1E/$84/$00 /   {MOV DS,cs:84H}
    $2E/$8E/$16/$86/$00 /   {MOV SS,cs:86H}
    $FB/                    {sti}
    $9C/                    {pushf}
    $58/                    {pop ax}
    $A3/flagreg/            {mov [flagreg],ax}
    $B8/$00/$4D/            {mov ax,4D00H}
    $cd/$21/                {int 21 - call WAIT (return exit code)}
    $A3/exitstat/           {mov [exitstat],ax}
    $2E/$8B/$2E/$80/$00 /   {MOV BP,cs:80H}
    $9D);                   {popf}


   writeln;

   if odd (flagreg) then
   begin
      exec := true;
      writeln(whoami,':  Could not execute ',comname);
   end
   else

   if exitstat <> 0 then
   begin
      exec := true;
      writeln(whoami,':  Abnormal program exit (code=',exitstat,')');
   end

   else
      exec := false;    {normal termination}


end;                       {callexec}




begin                         {exec}

   shrinkmem(memreq);         {release memory above this program (each time)}

   initfcb(fcb1);
   initfcb(fcb2);
   psp80 := params;
   psp80 := chr (length (psp80))+ psp80 + cr + null;
                              {pass length in first byte}

   filespec := comname + null;
                              {path and name of command processor}

   flush(output);

   callexec;                  {execute program and set 'exec' return value}

   flush(output);

end;                       {exec}