program modpatch;


imports        Perq_string from Perq_string;
imports        Fileutils from Fileutils;
imports        Filesystem from Filesystem;
imports        Code from Code;
imports        filetypes from filetypes;
        
        
label 10,11,20,30,40,90,99,100,101,900,905,910,912,915,920,925,930,935,940,942,
      945,950,960,990,999;
      
type dbleword=record msw,lsw:integer end;
     altrec=record
            oval,disp,blkno:integer;
            nval:array[0..17] of integer
            end;
            
var cfile,lfile:text;
    cline,cname,lname,mname,segname,fullname,tname,nostr,extname,savename:string;
    mic,ok,applyma:boolean;
    pno,segfileid,tmpid,saveid,blks,bits,ind:integer;
    alter:array[1..20] of altrec;
    segbuff:pdirblk;
    blkbuff:psegblock;
    cs:long;
    csdble:dbleword;
    che,newche,cl,i,tlen:integer;
    patches:packed array[0..80] of char;
    ch:char;
    pdata:ptrfsdataentry;
    
function lstoi(var str:string;var num:integer):boolean;

{ Converts hex or decimal string, str, up to terminating character into an
  integer in num. Returns rest of string in str.                           }
  
label 10;
var len,i,dig,base,start:integer;
begin
num:=0;
lstoi:=false;
len:=length(str);
if len=0 then exit(lstoi);
if (str[1]='X') then
  begin
  base:=16;
  start:=2;
  end else
  begin
  base:=10;
  start:=1;
  end;
for i:=start to len do
  begin
  case str[i] of
  ',',')':goto 10;
  '0'..'9':dig:=ord(str[i])-ord('0');
  'A'..'F':begin
           if base=10 then exit(lstoi);
           dig:=ord(str[i])-ord('A')+10;
           end;
  otherwise:exit(lstoi);
  end;
  num:=num*base+dig;
  end;
10:
if i+1>len then str:='' else str:=substr(str,i+1,len-i);
lstoi:=true;
end; {lstoi}

function hxtoi(var xstr:string;var xnum:integer):boolean;

{ Converts 1st 4 characters of hex string, xstr, into an integer in xnum.
  Returns remaining characters in xstr.                                   }                                           
var i,dig:integer;
begin
xnum:=0;
hxtoi:=false;
for i:=1 to 4 do
  begin
  case xstr[i] of
    '0'..'9':dig:=ord(xstr[i])-ord('0');
    'A'..'F':dig:=ord(xstr[i])-ord('A') + 10;
    otherwise:exit(hxtoi);
    end;
  xnum:=xnum*16 + dig;
  end;
hxtoi:=true;
if length(xstr)>4 then xstr:=substr(xstr,5,length(xstr)-4) else xstr:='';
end; { hxtoi }

function ma(alter:altrec):boolean;

{ Applies  1 alter line to seg file }

var i:integer;
begin
ma:=false;
WRITELN('reading block ',alter.blkno,' at displacement ',alter.disp);
fsblkread(tmpid,alter.blkno,segbuff);
if segbuff^.buffer[alter.disp]<>alter.oval then exit(ma);
for i:=1 to alter.nval[0] do segbuff^.buffer[alter.disp+i-1]:=alter.nval[i];
fsblkwrite(tmpid,alter.blkno,segbuff);
ma:=true;
writeln(lfile);
writeln(lfile,'Block ',alter.blkno:1,' at word displacement ',alter.disp:3);
writeln(lfile,'old value',alter.oval:6:-16,'  <hex>');
writeln(lfile,'         ',alter.oval:6:-10,'  <dec>');
write(lfile,'new value');
for i:=1 to alter.nval[0] do write(lfile,alter.nval[i]:6:-16);
writeln(lfile,'  <hex>');
write(lfile,'         ');
for i:=1 to alter.nval[0] do write(lfile,alter.nval[i]:6:-10);
writeln(lfile,'  <dec>');
end; { ma }

procedure help;
begin
write(chr(12));{to clear screen}
writeln('           program modpatch');
writeln;
writeln('This program allows you to alter the contents of .SEG (and .BIN ');
writeln('files.It will prompt you for the name of a commandfile (which should');writeln('contain sequences of commands as detailed below) and the name of');
writeln('a listfile.It will write details of the changes made to the list');
writeln('file.');
writeln;
writeln('COMMANDS');
writeln;
writeln('1.  m(modulename,patchno) for .SEG files ');
writeln;
writeln('   (m(modulename.BIN,) for .BIN files)');
writeln;
writeln('This specifies the module to be amended.Patchno is a no. between 1');
writeln('and 255 which is written to  the "version" field of');
writeln('block 0 of the file.If the patch has already been applied (i.e. the');
writeln('the number is already in the version field) then this will be reported');
writeln('and no action taken with this patch');
writeln;
writeln('The "version" field will contain the letters "pat" followed by the');
writeln('number of patches that have been applied and then the patchnos.'); 
writeln('Up to 36 patches can be applied to any .SEG module');
writeln;
writeln('2.  a(blockno,displacement(in words),x oldvalue,x newvalue)');
writeln;
writeln('Blockno and displacement are in decimal ,old and new values in hex.');
writeln('This  command will alter the specified word .More than one word can be');
writeln('altered by giving an appropriate new value.');
writeln('    e.g. a(2,100,xa020,xffffffff0000)');
writeln('Up to 16 words can be replaced in one command.');
writeln('Up to 20 alter commands can be specified in one sequence');
writeln;
writeln('3.  che(x checksum)');
writeln;
writeln('A 4-digit checksum should be supplied');
writeln;
writeln('A typical sequence would be :');
writeln;
writeln('m(test,1)');
writeln('a(2,50,xff21,x0022)');
writeln('a(4,3,x0011,xffffffff)');
writeln('che(x22c5)');
writeln;
writeln('More than one sequence of commands can be specified so a number of');
writeln('modules can be altered in one run.A back up copy of the file before  ');
writeln(' it was patched is kept in module.SEG$ (module.BIN$).');
writeln;
writeln('**NOTE** there is no equivalent to the "version" field for .BIN files');
writeln('so no record will be kept in the file of patches applied.');
writeln;
writeln;
end;{help}

{ modpatch }
begin
writeln;
writeln('          Module Patch Utility Version 1.0');
writeln;
writeln('             *****WARNING*****');
writeln;
writeln('This patcher will only keep the two most recent versions of your file');
writeln('Therefore it is advisable to make sure you have a copy of any release');
writeln('files before patching them');
writeln;
repeat
write('Do you want more information about this program before continuing?  y/n ');
readln(ch);
until ch in ['Y','y','N','n'];
if ch in ['Y','y'] then
begin
   help;
   repeat
   write('do you want to continue with this program?  y/n ');
   readln(ch);
   until ch in ['Y','y','N','n'];
   if ch in ['N','n']
   then
   exit(modpatch);
   writeln;
   writeln
end;
{ Get commandfile and listing file names }
writeln;
write('commandfilename:');
readln(cname);
write('listfilename:');
readln(lname);
reset(cfile,cname);

{ Initialise listing file }
rewrite(lfile,lname);
writeln(lfile,'          Module Patch Utility Version 1.0');

10:
if eof(cfile) then goto 900;
11:
{ Read mod amend line of command file }
writeln(lfile);
readln(cfile,cline);
if length(cline)=0 then goto 10;
che:=0;  applyma:=true;  cl:=0; mic:=false;
convupper(cline);
writeln(lfile,cline);
cs:=che;
for i:=1 to length(cline) do cs:=cs+ord(cline[i])*(i mod 5 + 1);
csdble:=recast(cs,dbleword);
che:=csdble.lsw;
if cline[1]<>'M' then goto 905;
if length(cline)<3 then goto 905;
if cline[2]<>'(' then goto 905;
ind:=pos(cline,',');
if ind=0 then goto 905;
mname:=substr(cline,3,ind-3);
extname:=substr(mname,length(mname) - 3,4);
if extname = '.BIN'
then
   {this is a microcode binary file so no version field
   to update}
   begin
   mic:=true;
   segname:=mname;
   mname:=substr(mname,1,length(mname)-4)
   end
else
   segname:=concat(mname,'.seg');
tname:=concat(mname,'.tmp');
fullname:=segname;
segfileid:=fssearch(fssyssearchlist,fullname,blks,bits);
if segfileid=0 then goto 910;

{ Check that fullname is a seg file }
{ new(pdata);
fsgetfsdata(segfileid,pdata);
if pdata^.filetype<>segfile then goto 912; }
if not mic then
begin
nostr:=substr(cline,ind+1,length(cline)-ind-1);
if length(nostr)>3 then goto 915;
ok:=lstoi(nostr,pno);
if not ok then goto 915;
if pno>255 then goto 915
end;

20:
{ Read first alter line of command file }
if eof(cfile) then goto 99;
readln(cfile,cline);
if length(cline)=0 then goto 20;
while (cline[1]<>'c') and (cline[1]<>'C') do
  begin
  cl:=cl+1;
  convupper(cline);
  writeln(lfile,cline);
  cs:=che;
  for i:=1 to length(cline) do cs:=cs+ord(cline[i])*(i mod 5 + 1);
  csdble:=recast(cs,dbleword);
  che:=csdble.lsw;
  if cline[1]<>'A' then goto 920;
  if length(cline)<3 then goto 920;
  nostr:=substr(cline,3,length(cline)-2);
  ok:=lstoi(nostr,i);
  if not ok then goto 925;
  if i>=blks then goto 925 else alter[cl].blkno:=i;
  ok:=lstoi(nostr,i);
  if not ok then goto 930;
  if i>255 then goto 930 else alter[cl].disp:=i;
  ok:=lstoi(nostr,alter[cl].oval);
  if not ok then goto 935;
  if nostr[1]<>'X' then goto 940;
  nostr:=substr(nostr,2,length(nostr)-2);
  tlen:=length(nostr);
  if tlen mod 4<>0 then goto 940;
  for i:=1 to tlen div 4 do
    begin
    ok:=hxtoi(nostr,alter[cl].nval[i]);
    if not ok then goto 940;
    end;
  alter[cl].nval[0]:=tlen div 4;
  if alter[cl].nval[0] + alter[cl].disp >256
  then goto 942;

  90:
  { Read next line of command file }
  if eof(cfile) then goto 99;
  readln(cfile,cline);
  if length(cline)=0 then goto 90;
  end;

{ Analyse checksum line }
convupper(cline);
writeln(lfile,cline);
ind:=pos(cline,'(');
if ind=0 then goto 945;
if cline[length(cline)]<>')' then goto 945;
csdble:=recast(cs,dbleword);
if ind+1<length(cline) then
  begin
  if cline[ind+1]<>'X' then goto 945;
  nostr:=substr(cline,ind+2,length(cline)-ind-2);
  if length(nostr)<>4 then goto 945;
  ok:=hxtoi(nostr,che);
  if not ok then goto 945;
  if che<>csdble.lsw then goto 950;
  end;
writeln(lfile,'Checksum is X',csdble.lsw:1:-16);
if not applyma then goto 99;
writeln(lfile);

30:
{ Check if temporary file exists }
tmpid:=fsinternallookup(tname,i,i);
if tmpid<>0 then
  begin
  tname:=concat(tname,'$');
  goto 30;
  end;

{ Copy segfile to temporary file }
WRITELN('copy segfile to temp. file ',tname);
tmpid:=fsenter(tname);
new(segbuff);
for i:=0 to blks-1 do
  begin
  fsblkread(segfileid,i,segbuff);
  fsblkwrite(tmpid,i,segbuff);
  end;

if not mic then
begin
{ Read block 0 of file }
fsblkread(tmpid,0,segbuff);
blkbuff:=recast(segbuff,psegblock);

{$R-}
for i:= 0 to 80 do patches[i]:=blkbuff^.version[i];
{$R+}


if (patches[41]='p') and (patches[42]='a') and (patches[43]='t')
then

  begin
  tlen:=ord(patches[44]);
  for i:=1 to tlen do if ord(patches[44+i])=pno then
  begin
  writeln(lfile,'patch no.',pno:4,' already applied to module ',fullname);
  40:
  WRITELN('deleteing temp. file ',tname);
  fsdelete(tname);
  goto 99
  end;
  if tlen=36
  then
   
  begin
  
  writeln(lfile,'Max. no of patches already applied');
  goto 40;
  
  end 
  
  end
  
  else
  
  begin
  
  {writeln('set up patch field');}
  tlen:=ord(patches[0]);
  for i:=tlen+1 to 40 do patches[i]:=' ';
  patches[0]:=chr(43);
  patches[41]:='p';patches[42]:='a'; patches[43]:='t';
  patches[44]:=chr(0);
  
  end;
  
    
  writeln(lfile,'Module ',fullname,' being updated with patch no.',pno:4);
  for i:=1 to cl do
    begin
    ok:=ma(alter[i]);
    if not ok then goto 960;
    end;
  fsblkread(tmpid,0,segbuff);
  blkbuff:=recast(segbuff,psegblock);
  tlen:=tlen+1;
  patches[44]:=chr(tlen);
  patches[44+tlen]:=chr(pno);
  
  {$R-}
  for i:=0 to 80 do blkbuff^.version[i]:=patches[i];
  {$R+}
 
   fsblkwrite(tmpid,0, segbuff)
  
end

else

begin

writeln(lfile,'Module ',fullname,' being updated');
for i:= 1 to cl do
   begin
   ok:=ma(alter[i]);
   if not ok then goto 960
   end;
end;
  fsclose(tmpid,blks,bits);
  savename:=concat(fullname,'$');
  saveid:=fsenter(savename);
  for i:=0 to blks - 1 do
  begin
  fsblkread(segfileid,i,segbuff);
  fsblkwrite(saveid,i,segbuff)
  end;
  fsclose(saveid,blks,bits);
WRITELN('saving file ',fullname,' in file ',savename);
writeln(lfile);
writeln(lfile,'renaming file ',fullname,' to file ',savename);
  fsdelete(fullname);
WRITELN('renaming tempfile to ',fullname);
writeln(lfile,'changes saved in file ',fullname);
  fsrename(tname,fullname);

99:
{ Repeat if not end of file }
if not eof(cfile) then goto 11;

101:
{ Finished }
close(lfile);
exit(modpatch);

900:
writeln(lfile,' ** ',cname,' empty'); goto 101;
905:
writeln(lfile,' ** Mod Amend line invalid'); applyma:=false; goto 20;
910:
writeln(lfile,' ** ',segname,' does not exist'); applyma:=false; goto 20;
912:
writeln(lfile,' ** ',fullname,' is not a SEG file'); applyma:=false; goto 20;
915:
writeln(lfile,' ** Patch number invalid'); applyma:=false; goto 20;
920:
writeln(lfile,' ** Alter line invalid'); applyma:=false; goto 90;
925:
writeln(lfile,' ** Block no. invalid'); applyma:=false; goto 90;
930:
writeln(lfile,' ** Displacement invalid'); applyma:=false; goto 90;
935:
writeln(lfile,' ** Old value invalid'); applyma:=false; goto 90;
940:
writeln(lfile,' ** New value invalid'); applyma:=false; goto 90;
942:
writeln(lfile,' ** new value too large for block');applyma:=false;goto 90;
945:
writeln(lfile,' ** Checksum line invalid'); goto 99;
950:
writeln(lfile,' ** Checksum invalid'); goto 99;
960:
writeln(lfile,' ** alter fails'); fsclose(tmpid,blks,bits);
WRITELN('deleteing file ',tname);
fsdelete(tname); goto 99;
990:
writeln(lfile,' ** Premature end of command file'); goto 101;

end. {modpatch }