Trailing-Edge
-
PDP-10 Archives
-
decuslib20-01
-
decus/20-0003/tp.pas
There are no other files named tp.pas in the archive.
(*$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.