home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MADTRB15.ZIP / SHRINK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-07-31  |  9.5 KB  |  217 lines
  1. Type
  2.    Str             = String[128];
  3.  
  4. Procedure Shrink; Forward
  5.  
  6. Function Shell(es,ds,dx,bx : Integer) : Integer; Forward;
  7.  
  8. Function Load(pgm_name,parm : Str) : Integer; Forward;
  9.  
  10. Function Dos(pgm_name,parm : Str) : Integer; Forward;
  11.  
  12. {
  13.  These functions and procedures allow one to "shrink" the size of one's
  14.  Turbo Pascal program so that you can later invoke the DOS load function.
  15.  Function Shell is primarily intended to be called internally by the
  16.  Load function.  ES:BX point to the parameter block as defined in the
  17.  Dos manual, and DS:DX point to the ASCIIZ string containing the program
  18.  name.  It returns either a positive integer containing the program's
  19.  return code as obtained from Dos function $4D, or a negative integer,
  20.  with the low order byte being the Dos return code on why the program
  21.  couldn't be loaded.  Function Load is passed the program name and
  22.  the parameter to be passed to the program, each specified as a Turbo
  23.  string.  The program name is converted in to an ASCIIZ string and the
  24.  parameter string is appended with a CR and a Blank at the start.  The
  25.  Dos Parse function is also invoked to parse the parameter string into
  26.  FCB1 and FCB2.  The addresses of the current environment, the command
  27.  line and the FCB's are filled into the parameter block and Shell is
  28.  invoked.  The integer return code is the same as passed back from
  29.  Shell.  Function Dos is similar to Load, except that a secondary
  30.  command processor is invoked.  The current environment is searced
  31.  for the name specified in COMSPEC and is used as the program name.
  32.  The command string is made up of a "/C ", the Dos command, and
  33.  the parameter string to pass to the Dos command.  Function Load
  34.  is invoked to do the rest.  The integer return code is the same as
  35.  passed back from the shell command, however assuming Command.Com was
  36.  loaded successfully, the return code will always be 0, no matter how
  37.  the actual command performed.  Procedure Shrink will shrink the Turbo
  38.  appplication down to $1000 pages (64K bytes).  It must be invoked before
  39.  calling any of the other routines.  The $1000 page figure may have to be
  40.  tinkered with.  When compiling your Turbo program, it must be compiled to
  41.  a COM file, with the Maximum Stack/Heap Option set such that the Stack +
  42.  Code + Data < 64K (or what ever figure you reserve for your program).
  43.  Initially I tried using the formula
  44.       Pages to reserve := (Dseg - Cseg) + Memavail + 1;
  45.  but, consistently got errors with it, so I took the more conservative
  46.  approach.
  47. }
  48.  
  49. {;                                                                         }
  50. {; Copyright (c) 1984 David R. Brandman                                    }
  51. {; All Rights Reserved                                                     }
  52. {;                                                                         }
  53. {; Permission is granted to freely distribute this code, but not for       }
  54. {; profit and provided that the following address and disclaimer are       }
  55. {; included.                                                               }
  56. {;                                                                         }
  57. {; Portions of this program may be used freely, in other works, provided   }
  58. {; that credit to the author and this work appear with the portions used.  }
  59. {;                                                                         }
  60. {; The author's address:                                                   }
  61. {;                                                                         }
  62. {; David R. Brandman                                                       }
  63. {; 805 Rotherham Drive                                                     }
  64. {; Manchester, Mo.  63011                                                  }
  65. {; (314) 527-8667                                                          }
  66. {;                                                                         }
  67. {; Disclaimer:                                                             }
  68. {;                                                                         }
  69. {; This program is provided "as-is" without warranty of any kind, either   }
  70. {; expressed or implied, including, but not limited to the implied         }
  71. {; warranties of merchantability and fitness for a particular purpose.     }
  72. {;                                                                         }
  73.  
  74. function shell;
  75.  
  76.                   {Perform DOS Exec function ($4B)}
  77. begin
  78.    inline(
  79.       $1E/                  {PUSH DS}
  80.       $8B/$5E/$04/          {MOV BX,[BP+4]}
  81.       $8B/$56/$06/          {MOV DX,[BP+6]}
  82.       $8E/$46/$0A/          {MOV ES,[BP+10]}
  83.       $8E/$5E/$08/          {MOV DS,[BP+8]}
  84.       $2E/$8C/$16/$FC/$00/  {MOV CS:0FCH,SS}
  85.       $2E/$89/$26/$FE/$00/  {MOV CS:0FEH,SP}
  86.       $B8/$00/$4B/          {MOV AX,4B00H}
  87.       $CD/$21/              {INT 21H}
  88.       $2E/$8E/$16/$FC/$00/  {MOV SS,CS:0FCH}
  89.       $2E/$8B/$26/$FE/$00/  {MOV SP,CS:0FEH}
  90.       $72/$08/              {JC BAD}
  91.       $B4/$4D/              {MOV AH,4DH}
  92.       $CD/$21/              {INT 21}
  93.       $B4/$00/              {MOV AH,0}
  94.       $73/$03/              {JNC EXIT}
  95.       $80/$CC/$80/    {BAD:  OR AH,80H}
  96.       $1F             {EXIT: POP DS}
  97.    )
  98. end;
  99.  
  100. procedure shrink;
  101.  
  102.             {Reserve 64K of memory for Turbo application}
  103.  
  104. var
  105.    regs : record  ax,bx,cx,dx,bp,si,di,ds,es,flags : integer; end;
  106.  
  107. begin
  108.    regs.es := cseg;          {reserve memory beginning at CSEG}
  109.    regs.bx := $1000;         {reserve $1000 pages (64K bytes) }
  110.    regs.ax := $4A00;         {Dos function $4A                }
  111.    msdos(regs);              {let Dos do the work             }
  112.    if ((regs.flags and 1) = 1) then  {check the return condition }
  113.       writeln('Shrink failed. RC(',regs.ax and $FF,')');
  114. end;
  115.  
  116. function load;
  117.  
  118.           {Setup to load Pgm_Name with parameter Parm
  119.            Returns  >= 0  Return code from application
  120.                     <  0  Dos error code
  121.                             code and $7FFFF is Dos Error Code }
  122.  
  123. type
  124.    parameter_block = record
  125.                         environment  : integer;
  126.                         cmd_line_ofs : integer;
  127.                         cmd_line_seg : integer;
  128.                         fcb1_ofs     : integer;
  129.                         fcb1_seg     : integer;
  130.                         fcb2_ofs     : integer;
  131.                         fcb2_seg     : integer;
  132.                      end;
  133.    regpack         = record
  134.                         ax,bx,cx,dx,bp,si,di,ds,es,flags : integer;
  135.                      end;
  136.  
  137. var
  138.    bx,dx,ds,es : integer;
  139.    fcb1,fcb2   : string[16];
  140.    param       : parameter_block;
  141.    command_string : str;
  142.    regs        : regpack;
  143.  
  144. begin
  145.    fcb1 := #0 + '           ' + #0 + #0 + #0 + #0; {Initialize two FCB's}
  146.    fcb2 := fcb1;
  147.    regs.es := seg(fcb1); regs.di := ofs(fcb1) + 1; {Parse command line into }
  148.    regs.ds := seg(parm); regs.si := ofs(parm) + 1; {the FCB's }
  149.    regs.ax := $2901;
  150.    msdos(regs);
  151.    regs.di := ofs(fcb2) + 1;
  152.    regs.ax := $2901;
  153.    msdos(regs);
  154.    pgm_name := pgm_name + #00;         {program name must be an ASCIIZ string}
  155.    command_string := chr(ord(parm[0]) + 1) + ' ' + parm + #$0D; {command Line}
  156.    ds := seg(pgm_name); dx := ofs(pgm_name) + 1;   {ds:dx points to program }
  157.    param.environment := memw[cseg:$2C];
  158.    param.cmd_line_seg := seg(command_string);   {put address of command line}
  159.    param.cmd_line_ofs := ofs(command_string) + 1;  {into the parameter block}
  160.    param.fcb1_seg := seg(fcb1); param.fcb1_ofs := ofs(fcb1) + 1; {ditto for }
  161.    param.fcb2_seg := seg(fcb2); param.fcb2_ofs := ofs(fcb2) + 1; {fcb's }
  162.    es := seg(param); bx := ofs(param);    {es:bx points to parameter block }
  163.    load := shell(es,ds,dx,bx);            {load the program }
  164. end;
  165.  
  166. function dos;
  167.  
  168.        {Setup to invoke COMMAND.COM, passing it Pgm_Name and Parm
  169.         Returns   = 0  Normal Return from Command.com
  170.                   < 0  Error loading COMMAND.COM
  171.                          code and $7FFF is DOS error code }
  172.  
  173. type
  174.    environment     = array[1..500] of char;
  175.    env_ptr         = ^environment;
  176.  
  177. const
  178.    comspec : string[7] = 'OMSPEC=';
  179.  
  180. var
  181.    env         : env_ptr;
  182.    env_seg,
  183.    loc,nloc    : integer;
  184.    found       : boolean;
  185.    parm_string,
  186.    dos_string  : str;
  187.  
  188. begin
  189.    env_seg := memw[cseg:$2C];      {The following sequence of code }
  190.    env := ptr(env_seg,0);          {finds the "COMSPEC=" in the }
  191.    loc := -1;                      {current environment and extracts }
  192.    repeat                          {from the enivronment the current }
  193.       repeat                       {command processor.  This code is }
  194.          loc := loc + 1;           {kind of yukkie, because the Turbo }
  195.       until env^[loc] = 'C';       {POS function requires a string and }
  196.       found := true;               {the environment is not in string }
  197.       nloc := loc + 1;             {format }
  198.       while (found) do begin
  199.          if env^[nloc] = comspec[nloc-loc] then nloc := nloc + 1
  200.          else found := false;
  201.       end;
  202.       if ((nloc - loc) = 8) then found := true
  203.       else begin
  204.          while (env^[nloc] <> #00) do
  205.             nloc := nloc + 1;
  206.          loc := nloc;
  207.       end;
  208.    until found;
  209.    dos_string := '';
  210.    while (env^[nloc] <> #00) do begin
  211.       dos_string := dos_string + env^[nloc];
  212.       nloc := nloc + 1;
  213.    end;                           {we've found and extracted the COMSPEC }
  214.    parm_string := '/C ' + pgm_name + ' ' + parm;  {Dos parameter string }
  215.    dos := load(dos_string,parm_string);    {load and run dos/program }
  216. end;
  217.