CP/M/CPM_CDROM.iso/cpm/utils/asmutl/pload10.lbr/PLOAD10.PQS/PLOAD10.PAS

Pascal/Delphi Source File | 1986-05-06 | 7.9 KB | 332 lines

{
  Program name : PLOAD10.PAS
  Author       : James Whorton
  Date written : June 22, 1985
  Environment  : CP/M 2.2, Turbo Pascal 2.0

  ########################################################################
  #  This software is Copyright (C) 1985 by James Whorton. All Rights    #
  #  Reserved. Permission is granted to distribute and use this software #
  #  under the following conditions:                                     #
  #                                                                      #
  #   1. Distribution and use must be non-profit. No profit from this    #
  #      software is allowed without the express written permission      #
  #      of the author.                                                  #
  #   2. Any modifications to the code must be cleared with the author   #
  #      before a new release is made.                                   #
  #   3. All copyright notices must be maintained in their present state,#
  #      including display of said notices.                              #
  ########################################################################

  See PLOAD10.MAN for information.
}

program pload10;

{$V-     Turn off parameter length checking }

const

 {
  The following equate should be set to the maximum size of binary (.COM)
  file that you will need to generate. The limit for this version is 30K.
  Future revisions will alow greater sizes. COMSIZE is the # of K. As released,
  this loader will allow creation of a 20K binary file.
 }

 comsize       = 20;           {Binary max. size}

 signon        = 'PLOAD vers. 1.0  Copyright (C) 1985 by James Whorton';
 in_ext        = '.HEX';       {Default input file extension}
 out_ext       = '.COM';       {Default output file extension}
 def_base      = $100;         {Default ORG location}
 cr            = #$0D;         {CR}
 hexset        = '0123456789ABCDEF';  {Hex representation string}

type

 str15         = string[15];
 str80         = string[80];

var

 in_file       : text;
 out_file      : file;
 endf          : boolean;
 in_fn,
 out_fn        : str15;
 ch            : char;
 i,j,k,l,
 bytes,
 fil_ptr,
 last_wrt,
 org_adr,
 end_adr,
 loaded        : integer;
 out_buffer    : array[1..$7800] of byte;
 cmdline       : string[30] absolute $80;
 wrkstr        : str80;



{
 Function    : HexOf
 Description : Returns a hexidecimal respresentation of the integer passed
               to the function.
}

function HexOf(var dec:integer) : str80;


 function nibble(a:byte) : char;  {convert nibble 'a' into ascii and return a char}
 var  b        :byte;
 begin
   b := a;
   b := b + 48;
   if b > 57 then b := b + 7;
   nibble:=chr(b);
 end; { hexbyte }

 function hexbyte(z:byte) : str80;  {convert byte 'z' into two ascii hex digits}
                          { and return }
 var    a,b   :byte;
 begin
  a:=z;
  b:=a and 240;  { mask off msb }
  b:=b shr 4;
  a:=a and 15;   { mask off lsb }
  hexbyte:=nibble(b)+nibble(a);
 end;

begin
 hexof:=hexbyte(hi(dec)) + hexbyte(lo(dec)) + 'H';
end;

{
 Procedure   : Abort
 Description : Aborts the program, displays error message if avail.
}

procedure Abort(ermsg:str80);
begin
 writeln;
 if length(ermsg)>0 then
  writeln('  -->> Error : ',ermsg,' <<--',^G);
 halt;
end;


{
 Procedure   : Usage
 Description : Display program usage if no parameters given.
}

procedure Usage;
begin
 writeln;
 writeln('Usage:');
 writeln;
 writeln('  PLOAD infile.ext outfile.ext');
 writeln;
 writeln('  File extensions are optional. If excluded, input file extension will');
 writeln('  default to .HEX and output file extension will default to .COM.');
 writeln('  If the output filename is not specified, it will default to the input');
 writeln('  filename.');
 writeln;
 halt;
end;


{
 Procedure   : GetParam
 Description : Fetches a parameter from the specified string.
}

procedure GetParam(var l,s:str80);
begin
 s:='';
 while (length(l)>0) and (l[1]=' ') do
   delete (l,1,1);
 while (length(l)>0) and (l[1]<>' ') do
   begin
    s:=s+l[1];
    delete(l,1,1);
   end;
end;


{
 Function    : Get_Next
 Description : Fetches the next character from the input file.
               Sets ENDF to TRUE on end of file.
}

function Get_Next : char;
var ch : char;
begin
 read(in_file,ch);
 if eof(in_file) then
  endf:=true;
 get_next:=ch;
end;


{
 Procedure   : Skip
 Description : Skip n chars in the input file.
}

procedure Skip(n:integer);
var i:integer;
begin
 for i:=1 to n do
  ch:=get_next;
end;


{
 Function    : MakeByte
 Description : Converts an n char string hexidecimal representation into an
               integer value.
}

function MakeByte(wrkstr:str80) : integer;
var i,
    acc,
    mult,
    ps    : integer;
begin
 acc:=0;
 ps:=1;
 mult:=1;
 if length(wrkstr)>1 then
  for i:=1 to length(wrkstr)-1 do
   mult:=mult*16;
 repeat
  acc:=acc+(pos(wrkstr[ps],hexset)-1) * mult;
  ps:=ps+1;
  if mult=1 then
   mult:=0
  else
   mult:=mult div 16;
 until mult=0;
 makebyte:=acc;
end;


{
 Procedure   : Fix_Addr
 Description : This short procedure checks the beggining and ending addresses
                against the current line address and adjusts as needed.
}

procedure Fix_Addr;
var i : integer;
begin
 if org_adr=0 then
  org_adr:=j;
 i:=j+(bytes-1);
 if end_adr<i then
  end_adr:=i;
end;


{
 Procedure   : Proc_Line
 Description : This procedure processes a single line of the .HEX file.
}

procedure Proc_Line;
begin
 wrkstr:=get_next+get_next;
 bytes:=makebyte(wrkstr);
 if bytes>0 then
  begin
   wrkstr:='';
   for i:=1 to 4 do
    wrkstr:=wrkstr+get_next;
   j:=makebyte(wrkstr);
   fix_addr;
   fil_ptr:=(j-org_adr)+1;
   skip(2);
   for i:=1 to bytes do
    begin
     wrkstr:=get_next+get_next;
     l:=makebyte(wrkstr);
     if fil_ptr>(comsize*1024) then
      abort('output buffer overflow');
     out_buffer[fil_ptr]:=l;
     loaded:=loaded+1;
     if last_wrt<fil_ptr then
      last_wrt:=fil_ptr;
     fil_ptr:=fil_ptr+1;
    end;
  end;
end;


{ Main code starts here. }

begin

 writeln(signon);
 if comsize>30 then
  abort('maximum binary file size set too high. Must be 1-30.');
 endf:=false;                        { Set up variables }
 fil_ptr:=1;
 last_wrt:=0;
 org_adr:=0;
 end_adr:=0;
 loaded:=0;
 for i:=1 to (comsize*1024) do              { Zero out buffer }
  out_buffer[i]:=0;
 getparam(cmdline,in_fn);            { Fetch input filename }
 if length(in_fn)=0 then
  usage;                             { No filename given, show usage }
 getparam(cmdline,out_fn);           { Fetch second filename }
 if length(out_fn)=0 then            { If second filename not supplied, set to }
  out_fn:=in_fn;                     { first }
 if pos('.',in_fn)=0 then            { Add extensions if not supplied }
  in_fn:=in_fn+in_ext;
 if pos('.',out_fn)=0 then
  out_fn:=out_fn+out_ext;

 assign(in_file,in_fn);
 {$I-}
 reset(in_file);
 {$I+}
 if IOResult<>0 then
  abort('input file not found');     { No input file }

 while not endf do
  begin
   ch:=get_next;
   if ch=':' then
    proc_line;
  end;

 fil_ptr:=last_wrt+1;
 i:=(fil_ptr div 128);
 j:=(fil_ptr mod 128);
 if j<>0 then
  for k:=0 to j-1 do
   out_buffer[fil_ptr+k]:=26;
 if j<>0 then i:=i+1;
 writeln;                            { Report stats }
 writeln('Start address   : ',hexof(org_adr));
 writeln('End address     : ',hexof(end_adr));
 writeln('Records written : ',hexof(i));
 writeln('Bytes loaded    : ',hexof(loaded));

 assign(out_file,out_fn);
 {$I-}
 rewrite(out_file);
 {$I+}
 if IOResult<>0 then
  abort('cannot open output file');  { Output file error }
 blockwrite(out_file,out_buffer,i);
 close(out_file);

end.