(*$C-*)
program tp;

{This program reads and writes magtapes in the format used by Unix's TP}

include 's:<pascal>pascmd.pas';
const
	{These are internal codes corresponding to each legal command.}
  restore=1;
  directory=2;
  done=3;
  help=4;
  readcom=5;
  writecom=6;
  savecom=7;
  clearcom=8;
  rewindcom=9;
  loadbootcom=10;
  maxcom=10;
type
  states=(null,directoryread,buildingdirectory,tapewritten);
	{Format of a TP tape:
	   Bootstrap block - see BOOTBLOCK below
	   Directories for 496 files, 496 entries in format of DIRBLOCK,
		Blocked into 512 byte physical records.
	   Data, as many 512 byte records as needed.  Each file's data
		starts a new record.}
  byte=0..377B;byte2=0..177777B;byte3=0..77777777B;byte4=0..37777777777B;
	{Dirblock is a record describing the directory entry for one file.
	 Note that all 2-byte quantities, including 2-byte portions of
	 larger quantities, are swapped.  I.e. the low-order and high-
	 order bytes are interchanged.  The one exception is the path
	 name (file name).  This is because of the representation used
	 by the PDP-11 for bytes within words.  We do the swapping
	 immediately upon reading in the directory, or just before
	 writing it.  So within this program things will normally be
	 stored in the form meaningful to the 20.  Mode is the one
	 exception.  Since it isn't used in the 20, but is set to a
	 magic quantity on output, that magic quantity is properly
	 chosen so it doesn't need to be reversed.}
  dirblock=packed record case Boolean of
  true:(
    path:packed array[1:32]of byte;  {File name, with possible directories}
    mode:byte2;			     {ignored, set to 666B on output}
    uid:byte;			     {ignored, set to 0 on output}
    gid:byte;			     {ignored, set to 0 on output}
    dum1:byte;
    size:byte3;			     {file size in bytes}
    time:byte4;			     {creation date-time, Unix format}
    addr:byte2;		    	     {tape address of file start, block #}
    dum2:byte2;
    dum3:packed array[1:12]of byte;
    dum4:byte2;
    checksum:byte2);		     {checksum of this directory entry}
  false:(bytes:packed array[1:64]of byte)
  end;
  datablock=packed array[0:511]of byte;
  block=record case Boolean of
    true: (dir:array[1:8]of dirblock);
    false: (data:datablock);
    end;
  tops20name=packed array[1:168] of char;  {longest possible T20 filename}
var tape:file of block;		{This is the tape}
    nulldir:dirblock;		{This entry will stay empty.  It is used
				 to clear directory entries as needed.}
    nullbuffer:datablock;	{This will stay empty.  It is used to clear
				 whole tape blocks as needed.}
    bootblock:datablock;	{This will get a copy of the bootstrap
				 block which is put out at the beginning
				 of all TP tapes.  It is loaded by reading
				 from a real TP tape using the temporary
				 command LOAD during initialization}
    haveboot:Boolean;		{indicates BOOTBLOCK is loaded}
    dir:array[1:496]of dirblock; {directory of the whole tape}
    tops20dir:array[1:496]of tops20name;
		{An array of tops-20 file names.  Correspond 1:1 to
			files in the array DIR.  Set up by the SAVE
			command.  These are the Tops-20 files that
			will be saved.  The corresponding entry in
			DIR is the UNIX file description.}
    command,curblock,i,j,cptr,clen,plen:integer;
{NB:  I is a global variable, indicating the current file being used}
{  CPTR, CLEN, and PLEN are global variables used in wildcarding.  See
	the routine MATCH}
    lastsaved:integer;  {During BUILDINGDIRECTORY, this is the last
			  entry in TOPS20DIR and DIR that is in use.}
    star:packed array[1:1]of char; {Initialized to '*' - must be a string}
    cbuf:packed array[1:45]of char; {UNIX file names are put here for
					wildcard matching.  See MATCH.}
    c,m,s:char;
    dvchr:packed record case Boolean of {Temporary used by DVCHR jsys}
	true:(word:integer);
	false:(dum:0..777B;dvtyp:0..777B);
	end;
    comtable:table;    {Table of commands for COMND package}
    state:states;  {What we are currently doing.  Used to make sure
		    commands given are valid, and to see if any
		    initialization is needed.}

procedure analys(var f:file);extern; {In runtime library - print error msg}

function t20daytime(unixdt:integer):integer;
{This converts the day and time from Unix-format internal daytime}
	{86400 is seconds in a day}
   const secperday=86400;
	{unixdt is Unix format, i.e. seconds since 1970.  Integer}
	{days is Tops-20 format, i.e. days since 1858. Fixed point
	 fraction with LH days and RH fraction}
   var days:packed record case Boolean of
	true: (word:integer);
	false: (LH:0..777777B;RH:0..777777B)
	end;
  begin
  days.LH := unixdt mod secperday;  {separate out seconds}
  days.RH := 0;
  days.word := days.word div secperday; {and convert to fraction of day}
  days.LH := unixdt div secperday;  {now fill in days}
  days.LH := days.LH + 117213B;  {add offset for 1970 from 1858}
  t20daytime := days.word
  end;

procedure writedaytime(unixdt:integer);
	{Write out a date-time, given input in UNIX format, on TTY}
    var daytime:integer;
  begin

     {The following is what I would have used, except in compilers before
      edit 133, 101B is stored on the stack, and calling T20daytime kills it:
	jsys(220B;101B,t20daytime(unixdt),0);}

  daytime := t20daytime(unixdt);
  jsys(220B{odtim};101B,daytime,0); {write to terminal}
  end;

function unixdaytime(daytime:integer):integer;
	{Convert from tops-20 date-time to UNIX}
  const secperday=86400;
  var days:packed record case Boolean of
	true: (word:integer);
        false: (LH:0..777777B;RH:0..777777B)
	end;
      unix:integer;
  begin
  days.word := daytime;
  days.LH := days.LH - 117213B;  {convert to 1970 base from 1858 base}
  unix := days.LH * secperday;  {seconds from full days}
  days.word := days.RH *secperday;  {seconds from fractions}
  unix := unix + days.LH;
  unixdaytime := unix
  end;

       {CHECKCHECK checks a directory checksum.  It must be called
	before the directory has had words swapped to put them in
	20 internal format, or after it has been swapped back
	before being written out.}
procedure checkcheck(d:dirblock);
	var i,j:integer;
  begin
  with d do
    begin
    j := 0;
    for i := 1 to 32 do
      j := j + bytes[2*i]*400B+ bytes[2*i-1];
    if j mod 200000B <> 0
      then begin
      write(tty,'% Bad checksum for file ');
      for i := 1 to 32 do
        write(tty,chr(d.path[i]));
      writeln(tty)
      end
    end
  end;

function match(spt,mpt:integer):Boolean;
{This carries out the wildcarding.  spt is a pointer into the name I in
 the directory.  mpt is a pointer into cbuf, the user's file spec.
 The algorithm is a standard recursive pattern match, with backup.}
  var ch:char;
begin
if (spt > plen) and (mpt > clen) 
  then match := true
else if (spt > plen) or (mpt > clen)
  then match := false
else case cbuf[mpt] of
  '*': if mpt = clen
	 then match := true
       else if match (spt, mpt+1)
	 then match := true
       else match := match(spt+1,mpt);
  '%': match := match(spt+1,mpt+1);
  others: begin
	  ch := chr(dir[i].path[spt]);
	  if (ch >= 'A') and (ch <= 'Z')
	    then ch := chr(ord(ch) + 40B);
	  if ch = cbuf[mpt]
	    then match := match(spt+1,mpt+1)
	    else match := false
	  end
  end;
end;

function fileok:Boolean;
 {This routine simply finds the length of the current file name and
  calls match to do see if it matches the current file spec.  Note
  that it is designed to allow a simple filespec to match file names
  that include directory specification.  E.g. FOO would match
  ./hedrick/foo.  HEDRICK/FOO would also match it.  This is done by
  trying a separate match of the whole filespec and of every part
  beginning immediately after a slash.}
begin
  plen := 32;
  for j := 1 to 32 do
    if dir[i].path[j] = 0
      then begin plen := j-1; goto 1 end;
1:
  fileok := false; {assume no match}
  for j := plen-1 downto 1 do
    if chr(dir[i].path[j]) = '/'
      then if match(j+1,1)
	then begin fileok := true; goto 9 end;
  fileok := match(1,1);
9:
end;

procedure getspec;
 {Read a Unix file spec.  Convert to lower case (for Unix)}
begin
cmhlp('Unix file spec');
cmdef(star);
clen := cmtxt(cbuf);
for cptr := 1 to clen do
  begin
  c := cbuf[cptr];
  if (c >= 'A') and (c <= 'Z')
    then cbuf[cptr] := chr(ord(c)+ 40B)
  end
end;

procedure direct;
 {This simply prints the names of all files that match the file spec}
begin
cmnoi('OF FILES');
getspec;
cmcfm;
if state=null
  then writeln(tty,'? No directory read or created')
  else for i := 1 to 496 do
         with dir[i] do
   	   if size <> 0
     	     then if fileok
       		then begin
       		for j := 1 to 32 do
         	  if path[j] = 0
		    then write(tty,' ')
           	    else write(tty,chr(path[j]));
       		write(tty,dir[i].size,'   ');
		writedaytime(dir[i].time);
       		writeln(tty)
       		end
end;

procedure getfile(filen:integer);
var spec:packed array[0:31]of char;
    st,en:integer;
    ch:char;
 {This routine is the workhorse of DORESTORE.  It restores a file I.  The
  main complication is the Unix file spec's.  We take the thing after
  the last /.  If that is not a legal tops-20 file name, we then ask
  the user for a better one.}
begin
for j := 1 to 32 do
  write(tty,chr(dir[i].path[j]));
st := 1; en := 32;
for j := 1 to 32 do
  if dir[i].path[j] = ord('/')
    then st := j+1
  else if dir[i].path[j] = 0
    then begin en := j-1; goto 1; end;
1:
for j := st to en do
  spec[j-st] := chr(dir[i].path[j]);
spec[en-st+1] := chr(0);
write(tty,' => ');
rewrite(output,spec,0,0,0,10B);
while not eof(output) do
  begin
  analys(output);
  write(tty,' ??  File: ');
  rewrite(output,'':@,0,0,0,10B);
  end;
jsys(30B{jfns};101B,0:output,221110000001B);
if curblock > dir[i].addr then
  begin
  writeln(tty);
  writeln(tty,'?  Already past that file');
  dismiss(output);
  goto 6
  end;
while curblock < dir[i].addr do
  begin
  get(tape);
  curblock := curblock + 1
  end;
for j := 0 to dir[i].size-1 do
  begin
  if (j mod 512) = 0
    then get(tape);
  ch := chr(tape^.data[j mod 512]);
  if ch = chr(12B)
    then writeln
    else write(chr(tape^.data[j mod 512]))
  end;
writeln(tty,'  [OK]');
close(output);
{change creation and last write to time from tape}
j := t20daytime(dir[i].time);
jsys(64B{chfdb};400013B:output,-1,j);
jsys(64B{chfdb};14B:output,-1,j);
curblock := curblock + (dir[i].size+511) div 512;
6:
end;

procedure dorestore;
 {This routine restores a group of files}
begin
cmnoi('FILES');
getspec;
cmcfm;
if state <> directoryread
  then writeln(tty,'? Please give the READ command first')
  else for i := 1 to 496 do
         with dir[i] do
           if size <> 0
             then if fileok
	            then getfile(i)
end;

procedure swap(var d:dirblock;i:integer);
	{This swaps the high and low order bytes of a pdp-11 word.
	 See at the top where DIRBLOCK is explained.}
    var save:integer;
  begin
  save := d.bytes[i];
  d.bytes[i] := d.bytes[i+1];
  d.bytes[i+1] := save
  end;

procedure readtape;
  {This routine processes the READ command. It opens a new tape and
   reads in the directory.  It must be done before DIRECT or RESTORE}
begin
cmnoi('FROM TAPE');
cmifi(tape);
cmcfm;
jsys(117B%dvchr\;0:tape;dvchr.word,dvchr.word);
if dvchr.dvtyp = 2 (*tape*)
  then begin
  reset(tape,'',true,0,0,70010B);  (* sinr/soutr *)
  jsys(77B%mtopr\;0:tape,4%set data mode\,4%industry\);
  end
 else reset(tape,'',true,0,0,10B);
if eof(tape)
  then begin
  analys(tape);
  rclose(tape);
  goto 9
  end;
if state <> null
  then writeln(tty,'[Old directory cleared]');
state := directoryread;
get(tape);  (* skip block 0 - bootstrap *)
for curblock := 1 to 62 do {Read all 496 directory entries}
  begin
  get(tape);
  for i := 1 to 8 do
    begin
    with tape^ do   {Swap to internal 20 representation, as explained above}
      begin checkcheck(dir[i]); swap(dir[i],39);  swap(dir[i],41); swap(dir[i],43); swap(dir[i],45);  end;
    dir[8*(curblock-1)+i] := tape^.dir[i];
    end
  end;
9:
end; {newtape}

procedure dosave;
 {This routine saves a group of files.  It doesn't write tape, just
  saves the directory information and the 20 filespec for later writing}
	var i,j:integer; ch,oldch:char;
	    time20:array[1..1]of integer;
begin
cmnoi('FILES');
gjgen(100120000000B);  {exists, wildcards OK, flags}
cmfil(input);
cmcfm;
if state = directoryread
  then writeln(tty,'? Please give the CLEAR command if you really want this')
  else begin
  if state = null
    then lastsaved := 0
  else if state = tapewritten
    then writeln(tty,'[Adding to existing directory]');
  state := buildingdirectory;
  repeat   {For all file in wild-card group}
    lastsaved := lastsaved + 1;
	{Create directory entries}
    if lastsaved > 496
      then begin
      writeln(tty,'? Directory is full');
      lastsaved := 496;
      goto 9
      end;
    jsys(30B{jfns};tops20dir[lastsaved],0:input,001100000001B{name.ext});
    i := 1;
    for j := 1 to 14 do  {Make a UNIX file name out of first 14 characters}
      begin
      oldch := tops20dir[lastsaved][i];
      if (oldch >= 'A') and (oldch <= 'Z')  {Use lower case for UNIX}
        then oldch := chr(ord(oldch) + 40B);
      dir[lastsaved].path[j] := ord(oldch);
      if oldch <> chr(0)
        then i := i+1
      end;
    for j := 15 to 32 do
      dir[lastsaved].path[j] := 0;
	{give the user a nice message}
jsys(30B{jfns};101B,0:input,221110000001B);
write(tty,' => ');
for i := 1 to 14 do
  write(tty,chr(dir[lastsaved].path[i]));
writeln(tty);
{Here we count characters in the file, ignoring CR's that will be killed}
    i := 0;
    reset(input,'',0,0,0,10B);
    if eof(input)
      then begin
      analys(input);
      dir[lastsaved] := nulldir;
      lastsaved := lastsaved - 1;
      goto 6
      end;
    while not eof do
      begin
      read(ch);
      if (input^ = chr(12B)) and (ch = chr(15B))
	then read(ch);
      i := i+1;
      end;
	{Now fill in the various fields in the UNIX directory entry}
    with dir[lastsaved] do
      begin
      uid := 0; gid := 0; dum1 := 0; dum2 := 0; dum4 := 0; time := 0;
      for j := 1 to 12 do
        dum3[j] := 0;
      mode := 133001B;  {This is 666B, the desired protection, swapped}
      size := i;
      if lastsaved = 1
	then addr := 63
	else addr := dir[lastsaved-1].addr + (dir[lastsaved-1].size+511)div 512;
      jsys(63B{gtfdb};0:input,1:14B{last user write},time20);
      time := unixdaytime(time20[1]);
	{We have to swap all funny words to PDP-11 format to do checksum.
	 Actually the algorithm computes it in non-reversed form.  So we
	 should probably treat all the words as full-words, and swap them
	 all to internal 20 format.  But since there are fewer full-word
	 quantities than bytes and dummy words, it is easier to reverse
	 the full-words to the funny PDP-11 reversed format.  Then the
	 checksum algorithm below explicitly unreverses the bytes.  So
	 the result is a checksum in internal 20 format}
      swap(dir[lastsaved],39); swap(dir[lastsaved],41); swap(dir[lastsaved],43); swap(dir[lastsaved],45);
{compute checksum in j}
      j := 0;
      for i := 1 to 31 do
        j := j + bytes[2*i]*400B+ bytes[2*i-1];
      checksum := -j;
      swap(dir[lastsaved],63);  {Reverse to PDP-11 format.  Since the checksum
				 is never used for the 20, we always store it
				 in PDP-11 format.}
{at this point DIR is in final UNIX format.  We now swap the full-word
 quantitiies back to internal 20 format.}
      swap(dir[lastsaved],39); swap(dir[lastsaved],41); swap(dir[lastsaved],43); swap(dir[lastsaved],45);
      end;
	{Produce the 20 file spec in TOPS20DIR so we can get the file back
	 when the tape is actually written}
    jsys(30B{jfns};tops20dir[lastsaved],0:input,111100000001B{name.ext});
6:
    until nextfile(input) = 0;
  end;
9:
rclose(input)
end;

procedure doclear;   {Clear directory}
  begin
  state := null;
  for j := 1 to 496 do
    dir[j] := nulldir;
  rclose(tape);
  end;

procedure writetape;
  {This routine processes the WRITE command. It opens a new tape and
   writes out the directory and all files requested by SAVE command.
   their 20 filespecs are in TOPS20DIR, and the Unix file specs are
   in DIR.  The 20 files had better not have changed since the
   save command was done.  That is not checked.  (Of course it is OK
   if new versions have been written.  The exact versions saved had
   better not have been changed though)}
  var i,j,curfile:integer; ch:char;
begin
cmnoi('TO TAPE');
cmofi(tape);
cmcfm;
if state <> buildingdirectory
  then writeln(tty,'? You must request files to save using SAVE first')
  else begin
  jsys(117B%dvchr\;0:tape;dvchr.word,dvchr.word);
	{Get the tape drive}
  if dvchr.dvtyp = 2 (*tape*)
    then begin
    rewrite(tape,'',0,0,0,70010B);  (* sinr/soutr *)
    jsys(77B%mtopr\;0:tape,4%set data mode\,4%industry\);
    end
   else rewrite(tape,'',0,0,0,10B); {Or file if not tape drive}
  if not eof(tape)
    then begin
    analys(tape);
    goto 9
    end;
  state := tapewritten;
  tape^.data := bootblock;
  put(tape);  {Put bootstrap in block 0}
{Put directory}
  for curblock := 1 to 62 do
    begin
    for i := 1 to 8 do
      begin
      tape^.dir[i] := dir[8*(curblock-1)+i];
      with tape^ do
        begin swap(dir[i],39); swap(dir[i],41); swap(dir[i],43); swap(dir[i],45); checkcheck(dir[i]) end;
      end;
    put(tape)
    end;
{Put files}
  for curfile := 1 to lastsaved do
    begin
    reset(input,tops20dir[curfile],0,0,0,10B);
    if eof (input)
      then begin
      analys(input);
      goto 6
      end;
	{Give user nice message}
    jsys(30B{jfns};101B,0:input,221110000001B);
    write(tty,' => ');
    for j := 1 to 14 do
      write(tty,chr(dir[curfile].path[j]));
	{Copy character by character, eliminating <CR>'s before <LF>'s}
    for j := 0 to dir[curfile].size-1 do
      begin
      read(ch);
      if (input^ = chr(12B)) and (ch = chr(15B))
	then read(ch);
      tape^.data[j mod 512] := ord(ch);
      if (j mod 512) = 511
        then put(tape);
      end;
	{Clear the rest of the last physical record}
    if (j mod 512) <> 0
      then begin
      for j := j mod 512 to 511 do
        tape^.data[j] := 0;
      put(tape)
      end;
    rclose(input);
    writeln(tty,'  [OK]');
6:
    end;
  end;
9:
rclose(tape);
end; {writetape}

procedure dorewind;
begin
cmnoi('TAPE');
cmifi(tape);
cmcfm;
if state = directoryread
  then writeln(tty,'? Can''t rewind while reading - do CLEAR to abort reading')
  else begin
  jsys(117B%dvchr\;0:tape;dvchr.word,dvchr.word);
  if dvchr.dvtyp <> 2 (*tape*)
    then writeln(tty,'? Not a tape drive')
    else begin
    reset(tape,'',true,0,0,10B);
    if eof(tape)
      then begin
      analys(tape);
      goto 6
      end;
    jsys(77B{mtopr};0:tape,1B{rewind});
    end
  end;
6:
rclose(tape);
end;

procedure doloadboot;
   {This routine loads the first physical record from a tape or
	file into BOOTBLOCK, for later output at the beginning of
	each tape.}
begin
cmnoi('BOOTSTRAP FROM TAPE');
cmifi(tape);
cmcfm;
if state = directoryread
  then begin
  writeln(tty,'[Old directory cleared]');
  doclear
  end;
jsys(117B%dvchr\;0:tape;dvchr.word,dvchr.word);
if dvchr.dvtyp = 2 (*tape*)
  then begin
  reset(tape,'',true,0,0,70010B);  (* sinr/soutr *)
  jsys(77B%mtopr\;0:tape,4%set data mode\,4%industry\);
  end
 else reset(tape,'',true,0,0,10B);
if eof(tape)
  then begin
  analys(tape);
  rclose(tape);
  goto 9
  end;
get(tape);  (* get block 0 - bootstrap *)
bootblock := tape^.data;  {This is the bootstrap}
haveboot := true;
9:
rclose(tape);
end;

begin {main program}
writeln(tty,'Unix TP - type HELP if you need it');
doclear;
star[1] := '*';
comtable := tbmak(maxcom);
tbadd(comtable,writecom,'WRITE',0);
tbadd(comtable,savecom,'SAVE',0);
tbadd(comtable,rewindcom,'REWIND',0);
tbadd(comtable,restore,'RESTORE',0);
tbadd(comtable,readcom,'READ',0);
if not haveboot
  then tbadd(comtable,loadbootcom,'LOAD',0);
tbadd(comtable,help,'HELP',0);
tbadd(comtable,done,'EXIT',0);
tbadd(comtable,directory,'DIRECTORY',0);
tbadd(comtable,clearcom,'CLEAR',0);
loop
  cmini('TP>');
  command := cmkey(comtable);
  exit if command = done;
  case command of
    clearcom: doclear;
    readcom:  readtape;
    help:  begin
writeln(tty,'TP is a utility to read and write Unix TP-format tapes.');
writeln(tty,'All files are assumed to be ASCII text files.');
writeln(tty);
if not haveboot
then begin
writeln(tty,'This copy of TP does not yet have the bootstrap blocked loaded.');
writeln(tty,'This block is written as the first block of all TP-format');
writeln(tty,'tapes.  To load the bootstrap block, use the command');
writeln(tty,'  LOAD tapename');
writeln(tty,'where tapename is a tape or file containing a valid bootstrap');
writeln(tty);
end;
writeln(tty,'To restore files, use the following commands:');
writeln(tty,'  READ tapename -  to open the tape and read the directory');
writeln(tty,'  RESTORE Unix-filespec - to cause files to be read');
writeln(tty,'  DIRECTORY Unix-filespec - to see what files are on the tape');
writeln(tty);
writeln(tty,'To save files, use the following commands:');
writeln(tty,'  SAVE Tops20-filespec - mark which files are to be saved');
writeln(tty,'  WRITE tapename - write all marked files on tape');
writeln(tty,'  DIRECTORY Unix-filespec - show files marked for saving');
writeln(tty);
writeln(tty,'* and % can be used for wildcarding in both kind of filespec');
writeln(tty);
writeln(tty,'In addition:');
writeln(tty,'  CLEAR - clear the directory before issuing more SAVEs');
writeln(tty,'  HELP - print this message');
writeln(tty,'  EXIT - return to monitor, closing files');
writeln(tty,'  REWIND tapename - rewind the tape');
writeln(tty);
writeln(tty,'WARNING: Rewinds are never done automatically');
	   end;
    directory:direct;
    restore:dorestore;
    writecom: writetape;
    savecom:dosave;
    rewindcom:dorewind;
    loadbootcom:doloadboot;
    end;
  end
end.