{  									}
{  A N S I M T . P A S   L O G -					}
{									}
{									}
{  Revision 85/07/85 10:00:00 Nelson Kanemoto				}
{  Modified to run with new version of Rutgers Pascal.  Modifications	}
{  were passing constants by value by removing the 'var' off the fol-	}
{  lowing procedures:  scopy, ctoi, GarbageErr, and WarnMess.		}
{									}
{  Installation 85/03/08 12:45:00 Nelson Kanemoto			}
{  Latest version installed in PS:<UHCCSYS-SUBSYS>			}
{									}
{  Revision 85/02/15 12:00:00 Nelson Kanemoto				}
{  Added warning messages for EBCDIC and DEC-20 labelled tapes for	}
{  the TAPE command.							}
{									}
{  Installation 85/01/17 10:45:00 Nelson Kanemoto			}
{  Latest version installed in PS:<UHCCSYS-SUBSYS>			}
{									}
{  Revision 85/01/15 16:00:00 Nelson Kanemoto				}
{  Installed a modified ansimt.doc into doc:, with modifications on	}
{  wildcards for the STORE and RESTORE commands				}
{									}
{  Revision 85/01/09 12:00:00 Nelson Kanemoto				}
{  Restore command with wildcards is now working, but changed bits	}
{  in gjgen in ParseRestore1.						}
{									}
{  Revision 84/12/26 14:00:00 Nelson Kanemoto				}
{  Started working on procedure RestoreFile by extracting from 		}
{  ProcessRestore.							}
{									}
{  Revision 84/12/26 13:00:00 Nelson Kanemoto                     	}
{  Working on wildcards for the restore command, modifying procedures	}
{  ParseRestore1 and ParseDiskOutput2, and adding in procedure 		}
{  ParseDirOutput2.							}
{									}
{  Revision 84/11/29 15:00:00 Nelson Kanemoto				}
{  Wildcards are working for the store command, doing simple testing	}
{									}
{  Revision 84/10/29 15:00:00 Nelson Kanemoto				}
{  Moved the storing part of ProcessStore to StoreFile to make way	}
{  for handling wildcards.  Compiled and executed new version, but	}
{  didn't test it on storing files.					}
{									}
{  Installation 84/10/29 14:40:00 Nelson Kanemoto			}
{  Updated ANSIMT.DOC, ANSIMT.HLP, and ANSIMT.EXE then installed them	}
{  to their proper locations (DOC:, HLP:, PS:<UHCCSYS-SUBSYS>).		}
{									}
{  Revision 84/10/25 13:45:00 Nelson Kanemoto				}
{  Fixed bug in procedure ParseDiskOutput2.  If someone added tape	}
{  parameters to the tape file spec, it wouldn't return the intended	}
{  error message.  That's fixed now.					}
{									}
{  Revision 84/09/25 15:30:00 Nelson Kanemoto				}
{  Added in an option to turn warning messages off and on in the	}
{  default command.  Also added a no option in the default command	}
{  instead of "no-".							}
{									}
{  Revision 84/09/25 14:00:00 Nelson Kanemoto				}
{  Program now automatically sets the default data mode to industry	}
{  compatible and returns to original data mode when it exits		}
{									}
{  Revision 84/09/24 14:30:00 Nelson Kanemoto				}
{  Got rid of ^A in ANSIMT heading.					}
{									}
{  Installation 84/09/20 16:00:00 Nelson Kanemoto			}
{  Latest version installed in PS:<UHCCSYS-SUBSYS>			}
{									}
{  Revision 84/09/20 14:00:00 Nelson Kanemoto				}
{  Added in procedure to print ANSIMT heading.				}
{									}
{  Revision 84/09/19 15:00:00 Nelson Kanemoto				}
{  corrected directory command to handle files w/ incorrect record	}
{  lengths and modified /FULL directory listing for 'U' format tape	}
{  files.								}
{									}
program ANSIMT_TapeUtility;
include 'sys:pascmd.pas';
const
	DEFBLKFAC = '1 ';
	DEFRECLEN = '80';
 	DEFTABNO = '8 ';
	MAXFNAME = 39;
	MAXBLKLEN = 32760;  {IBM max}
	MAXRECLEN = 2048;  {ANSI standard}
	MAXSTR = 80;
	MINRECLEN = 18;  {ANSI standard}

	{pascmd parsing}
	{-CmdTable}
	DIR = 1;
	DEF = 2;
	EOT = 3;
	XIT = 4;
	SKIP = 5;
	STORE = 6;
	RESTORE = 7;
	REWIND = 8;
	TAPE = 9;
	HELP = 11;
	LASTCMD = 11;
	{-Sw1Table}
	S1BLOCK = 1;
	S1NOPAD = 2;
	S1RECLN = 3;
	S1TABEV	= 4;
	LASTSW1 = 4;
	{-Sw2Table}
	S2NOSTR = 5;
	S2STRIP = 6;
	LASTSW2 = 2;
	{-Sw3Table, switches for directory command}
	S3FULL = 1;
	S3SHORT = 2;
	LASTSW3 = 2;
	{-DefTable, uses above switches}
	DFWARN = 1;
	DFTABEV = 2;
	DFSTRIP = 3;
	DFRECLN = 4;
	DFNOSWI = 5;
	DFBLOCK = 6;
	LASTDEF = 6;
	LASTNO = 3;  {no options}

	{JSYS monitor calls}
	GETER = 12B;  {returns most recent error condition}
	OPENF = 21B;
	CLOSEF = 22B;
	JFNS = 30B;
	MTOPR = 77B;

	{ASCII in decimal}
	NULL = 0;
	TAB = 9;
	LF = 10;  {linefeed}
	CR = 13;  {carriage return}
	BLANK = 32;

type
	DevicesType = (DiskDev, TapeDev, TTYDev, ErrDev);
	DesigType = (JFNDes, DevDes);
	DirectoryType = (FullDir, ShortDir);
	WordSetType = set of 0..35;  {represents a 36bit word}
	DateStrType = packed array [1..9] of char;
	StrType = packed array [1..MAXSTR] of char;
	FNameType = packed array [1..MAXFNAME] of char;

var
	device : integer;
	command : integer;
	FilesToSkip : integer;
	OriginalDataMode : integer;
	DefaultRecLen, DefaultBlkFac, DefaultTabNo : integer;
	GlobalRecLen, GlobalBlkFac, GlobalTabNo : integer;
	HoldRecLen, HoldBlkFac, HoldTabNo : integer;
	ThatsIt : boolean;
	GlobalPadTabs, DefaultPadTabs, HoldPadTabs : boolean;
	GlobalWarning, DefaultWarning, HoldWarning : boolean;
	GlobalStripBlanks, DefaultStripBlanks, HoldStripBlanks : boolean;
	GlobalDirectory, DefaultDirectory, HoldDirectory : DirectoryType;
	GlobalTapeFile, GlobalTape, HoldTape : FNameType;
	GlobalDiskFile, GlobalDirStr : StrType;
	CmdTable, DefTable, NoTable, Sw1Table, Sw2Table, Sw3Table: table;

function curjfn(var f : file) : integer;  extern;

function erstat(var f : file) : integer;  extern;

procedure analysis(var f : file);  extern;

procedure clreof(var f : file);  extern;

procedure quit;  extern;

{  StrEnd  --  marks the end of string w/ a null character.  If	end    	}
{  position, SEnd, is out of bounds then the end is not marked.		}
procedure StrEnd(var s : packed array [i..j:integer] of char;SEnd : integer);
var
	pos : integer;
begin
	pos := SEnd - (i - 1);  {actual index in string}
 	if (pos >= i) and (pos <= j) then
	    s[pos] := chr(NULL);
end;  {of procedure StrEnd}

{  StrPos  --  returns the position of a character in a string.  0 is	}
{  returned if the character is not found.				}
function StrPos(var s : packed array [i..j:integer] of char;c : char) : integer;
var
	pos : integer;
	found : boolean;
begin
	pos := i - 1;
	StrPos := 0; found := false;
	while (pos < j) and not found do begin
	    pos := pos + 1;
	    if (s[pos] = c) then begin
		StrPos := pos;
		found := true;
	    end;  {of if}
	end;  {of while}
end;  {of function StrPos}

{  StrLen  --  returns the length of string s which is marked by the 	}
{  null character							}
function StrLen(var s : packed array [i..j:integer] of char) : integer;
var
	pos : integer;
begin
	pos := StrPos(s,chr(NULL));
	if (pos <> 0) then
	    StrLen := pos - 1
	else
	    StrLen := j - (i - 1); {length of array, s}
end;  {of function StrLen}

{  itoc  --  converts integer n to char string in s[i]...		}
function itoc(n : integer; var s : StrType ; i : integer) : integer;
begin
	if (n < 0) then begin
	    s[i] := '-';
	    itoc := itoc(-n,s,i+1);
	end  {of if}
	else begin
	    if (n >= 10) then
		i := itoc(n div 10,s,i);
	    s[i] := chr(n mod 10 + ord('0'));
	    StrEnd(s,i+1);
	    itoc := i + 1;
	end;  {else}
end;  {of function itoc}

{  ctoi  --  convert char string at s[i] to integer             	}
function ctoi(s : packed array [SMin..SMax : integer] of char;
              i : integer) : integer;
var
	n, sign : integer;
begin
	while (s[i] = ' ') or (s[i] = chr(TAB)) do
	    i := i + 1;
	if (s[i] = '-') then  {minus sign}
	    sign := -1
	else
	    sign := 1;
	if (s[i] = chr(ord('+'))) or (s[i] = chr(ord('-'))) then
	    i := i + 1;
	n := 0;
	while (i <= SMax) do
	    if (s[i] in ['0'..'9']) then begin
	        n := 10 * n + (ord(s[i]) - ord('0'));
	        i := i + 1;
	    end  {of if}
	    else
		i := SMax + 1;  {force out}
	ctoi := sign * n;
end;  {of function ctoi}

{  scopy  --  copy string at src[i] to dest[j]				}
procedure scopy(    src : packed array [SMin..SMax : integer] of char;
                    i : integer;
                var dest : packed array [DMin..DMax : integer] of char;
                    j : integer);
begin
	while (i <= SMax) and (j <= DMax) do
	    if (src[i] <> chr(NULL)) then begin
		dest[j] := src[i];
		i := i + 1;
		j := j + 1;
	    end
	    else  {force it to stop if hits the end of string}
		i := SMax + 1;  {end the while loop}

	if (j <= DMax) then
	    StrEnd(dest,j);
end;  {of procedure scopy}

{  InToStrDate  --  converts a date i in internal format to a string	}
{  of 9 chars in DD-Mmm-YY format					}
procedure InToStrDate(i : integer;var str : DateStrType);
const
	ODTIM = 220B;
begin
	jsys(ODTIM;str,i,000400000000B);
end;  {of procedure InToStrDate}

{  TabPos  --  return true if col is a tab stop				}
function TabPos(col : integer) : boolean;
begin
	if (col > MAXRECLEN) then
	    TabPos := true
	else
	    TabPos := (col mod GlobalTabNo = 1);
end;  {of function TabPos}

{  ErrorMess  --  prints the last error in the buffer than goes back	}
{  for a reparse							}
procedure ErrorMess;
begin
	    cmerrmsg;  {print official error message}
	    cmagain;  {reissue prompt}
end;  {of procedure ErrorMess}

{  WarnMess  --  prints the given string as an official warning message	}
{  (beginning w/ an '%')						}
procedure WarnMess(s : packed array [i..j : integer] of char);
begin
	if DefaultWarning then
	    writeln(tty,'%',s:StrLen(s));
end;  {of procedure WarnMess}

{  ClearDataError  --  if the device has a data error it is cleared	}
procedure ClearDataError(var f : file);
const
	GDSTS = 145B;  {device status}
	SDSTS = 146B;  {sets device status}
	INCORRECT_RECLN = 23;
var
	StatusBits, DummyBits : WordSetType;
	i : integer;
begin
	jsys(GDSTS;0:f;DummyBits,StatusBits);
	if (INCORRECT_RECLN in StatusBits) then begin  {data error}
	    StatusBits := StatusBits - [INCORRECT_RECLN];
 	    jsys(SDSTS;0:f,StatusBits);
	end;  {of if}
end;  {of procedure ClearDataError}

{  FileOpen  --  returns true if file is open				}
function FileOpen(var f : file) : boolean;
const
	GTSTS = 24B;  {file status}
	FILE_IS_OPEN = 0;
var
	StatusBits, DummyBits : WordSetType;
begin
	jsys(GTSTS;0:f;DummyBits,StatusBits);
	if (FILE_IS_OPEN in StatusBits) then
	    FileOpen := true
	else
	    FileOpen := false;
end;  {of function FileOpen}

function OpenInputFile(dev : DevicesType) : boolean;
var
	FileSpec : StrType;
begin
	if (dev = DiskDev) then
	    reset(input,'','/e/o')
	else if (dev = TTYDev) then begin
            jsys(JFNS;FileSpec,0:input,0);
	    reset(input,'','/e/o/i');
	end;  {of else if}
	if (erstat(input) <> 0) then begin
	    analysis(input);
	    if (dev = TapeDev) then
		if FileOpen(input) then
		    ClearDataError(input);
	    if FileOpen(input) then
		close(input);
	    OpenInputFile := false;
 	end  {of if}
	else
	    OpenInputFile := true;
end;  {of function OpenInputFile}

function OpenInputTape : boolean;
const
	DATAERR = 600221B;
	BIGREC = 601240B;
var
	message : StrType;
begin
	reset(input,'','/d/o/m:7');
	if (erstat(input) <> 0) then begin
 	    if (erstat(input) = DATAERR) or (erstat(input) = BIGREC) then begin
		jsys(JFNs;message,0:input,0);
		scopy(' not able to be restored',1,message,StrLen(message)+1);
		WarnMess(message);
		if FileOpen(input) then
		    ClearDataError(input);
		if FileOpen(input) then  {if it is still open}
		    close(input);
		OpenInputTape := False;
	    end  {of if}
	    else begin
		analysis(input);
		if FileOpen(input) then
		    ClearDataError(input);
		if FileOpen(input) then  {if it is still open}
		    close(input);
		OpenInputTape := False;
	        cmagain;
	    end  {of else}
	end  {of if}
	else
	    OpenInputTape := True;
end;  {of procedure OpenInputTape}

function OpenOutputDisk : boolean;
begin
	rewrite(output,GlobalDiskFile,'/o');
	if (erstat(output) <> 0) then begin
 	    analysis(output);
	    OpenOutputDisk := false;
 	end  {of if}
	else
	    OpenOutputDisk := true;
end;  {of function OpenOutputDisk}

function OpenOutputTape(var TapeFile : FNameType) : boolean;
const
	TFORM = ';FOR:F';  {tape format, always fixed}
	TRECL = ';REC:';  {tape rec length}
	TBLKS = ';BLO:';  {tape block size}
	TOPTIONS = '/B:8/O';
var
	i : integer;
	FileSpec : StrType;
begin
	scopy(TapeFile,1,FileSpec,1);
        scopy(TFORM,1,FileSpec,StrLen(FileSpec)+1);
	scopy(TRECL,1,FileSpec,StrLen(FileSpec)+1);
	i := itoc(GlobalRecLen,FileSpec,StrLen(FileSpec)+1);
	scopy(TBLKS,1,FileSpec,StrLen(FileSpec)+1);
	i := itoc(GlobalBlkFac*GlobalRecLen,FileSpec,StrLen(FileSpec)+1);
	rewrite(output,FileSpec,TOPTIONS);
	if (erstat(output) <> 0) then begin
 	    analysis(output);
	    write(tty,'     - "',FileSpec:StrLen(FileSpec),'"');
	    OpenOutputTape := false;
 	end  {of if}
	else
	    OpenOutputTape := true;
end;  {of function OpenOutputTape}

{  KindOfDevice  --  returns the what kind of device is associated w/	}
{  the file.								}
function KindOfDevice(des : integer;TypeOfCall : DesigType) : DevicesType;
const
	DVCHR = 117B;
var
	ac1, ac2, TypeOfDev : WordSetType;
begin
	case TypeOfCall of
	    JFNDes : jsys(DVCHR;0:des;ac1,ac2);	 {call using file JFN}
	    DevDes : jsys(DVCHR;des;ac1,ac2);  {call using dev designator}
	end;  {of case des}
	TypeOfDev := ac2 and [9..17];  {mask the dev type bits}
	if (TypeOfDev = []) then  {disk file}
	    KindOfDevice := DiskDev
	else if (TypeOfDev = [14,16]) then  {tty}
	    KindOfDevice := TTYDev
	else if (TypeOfDev = [16]) then  {tape file}
	    KindOfDevice := TapeDev
	else
	    KindOfDevice := ErrDev;
end;  {of function KindOfDevice}

{  space  --  spaces n number of blanks to the terminal.		}
procedure space(n : integer);
begin
	for n := n downto 1 do
	    write(tty,' ');
end;  {of procedure space}

{  GarbageErr  --  outputs to dev tty: garbage that was entered as	}
{  part of the command.							}
procedure GarbageErr(mess : packed array [i..j:integer] of char;
	             garb : packed array [k..l:integer] of char);
var
	MessLen : integer;
begin
	writeln(tty);
	write(tty,'? ',mess:StrLen(mess));
	write(tty,' - ');
	write(tty,garb:StrLen(garb));
	writeln(tty);
	cmagain;
end;  {of procedure GarbageErr}

{  GetJobDataMode  --  uses jsys GETJI and returns the default magtape	}
{  data mode of the current job						}
function GetJobDataMode : integer;
const
	GETJI = 507B;
var
	return : integer;
	p : ^integer;
begin
	new(p);
	jsys(GETJI,2,return;-1,-1:p,14B);
	if (return = 1) then
	    ErrorMess
	else
	    GetJobDataMode := p^;
end;  {of function GetJobDataMode}

{  SetJobDataMode  --  sets data mode of the current job		}
procedure SetJobDataMode(DataMode : integer);
const
	SETJB = 541B;  {sets job para for the specified job}
	SJDM = 2B;  {func of SETJB to set def mt data mode}
	CURRENT_JOB = -1;
begin
	jsys(SETJB;CURRENT_JOB,SJDM,DataMode);
end;  {of procedure SetJobDataMode}

{  DirHeading  --  prints the heading for the tape directory		}
procedure DirHeading;
begin
	{1st line}
	space(33);
	write(tty,'RECORD');
	space(1);
	write(tty,'BLOCK');
	space(3);
	if (GlobalDirectory = FullDir) then begin
	    space(1);
	    write(tty,'# OF');
	    space(2);
	    write(tty,'EST.');
	    space(2);
	end;  {of if}
	space(1);
	write(tty,'CREATE');
	space(4);
	write(tty,'EXPIRE');
	writeln(tty);
	{2nd line}
	write(tty,'SEQ#');
	space(6);
	write(tty,'FILE NAME');
	space(5);
	write(tty,'VOLID');
	space(2);
	write(tty,'F');
	space(1);
	write(tty,'LENGTH');
	space(1);
	write(tty,'FACTOR');
	space(2);
	if (GlobalDirectory = FullDir) then begin
	    space(1);
	    write(tty,'RECS.');
	    space(1);
	    write(tty,'PAGES');
	    space(1);
	end;  {of if}
	space(2);
	write(tty,'DATE');
	space(6);
	write(tty,'DATE');
	writeln(tty);
	{3rd line}
	writeln(tty);
end;  {of procedure DirHeading}

{  GetDeviceJFN  --  gets the jfn for the defined tape divice		}
procedure GetDeviceJFN;
const
	SGTJFN = 20B;  {short form GTJFN}
var
	DevStore, return : integer;
	DevStr : FNameType;
begin
	DevStr := GlobalTape;
	DevStr[StrLen(DevStr)+1] := ':';  {put a ':' at the end of string}
	StrEnd(DevStr,StrPos(DevStr,':')+1);
	jsys(SGTJFN, 3, return;100001b:0, DevStr;DevStore);
	if (return = 1) then
	    ErrorMess;
 	device := DevStore;
end;  {of procedure GetDeviceJFN}

{  TapeInfo  --  calls MTOPR to find information about the current	}
{  tape device								}
function TapeInfo(InfoNo : integer) : integer;
const
	MOINF = 25B;
	MAXINFO = 15B;
type
	ArgBlkType = packed array [0..MAXINFO] of integer;
var
	ArgPtr : ^ArgBlkType;
begin
	new(ArgPtr);
	ArgPtr^[0] := MAXINFO;
	GetDeviceJFN;
	jsys(MTOPR;0:device, MOINF, ArgPtr);
	TapeInfo := ArgPtr^[InfoNo];
end;  {of function TapeInfo}

{  TapeStatus  --  returns status bits for user io			}
procedure TapeStatus(var accum2 : WordSetType);
const
	GDSTS = 145B;
var
	accum1, return : integer;
begin
	GetDeviceJFN;
        jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
	if (return = 1) then
	    ErrorMess;
	jsys(GDSTS;0:device;accum1, accum2);
	jsys(CLOSEF, 2, return;001000:device);
	if (return = 1) then
	    ErrorMess;
end;  {of procedure TapeStatus}

{  BeginningOfTape  --  returns true if tape is at bot			}
function BeginningOfTape : boolean;
const
	BOTBIT = 24;
var
	StatBits : WordSetType;
begin
	TapeStatus(StatBits);
	if (BOTBIT in StatBits) then
	    BeginningOfTape := true
	else
	    BeginningOfTape := false;
end;  {of function BeginningOfTape}

{  TapeFileInfo  --  prints out tape file info.  If the SeqNo passed	}
{  is negative then the no. of records and the estimated pages are	}
{  suppressed in the /FULL switch					}
procedure TapeFileInfo(SeqNo : integer);
const
	MORLI = 50B;
	ARGS = 15B;
	UNDEFINED = 'U';  {undefined record format}
type
	BitsAndPtrType = record
	    case boolean of
		true : (ptr : ^FNameType);
		false: (bits : WordSetType)
	end;
	ArgBlkType = record
	    ArgWords : integer;
	    TypeOfLabel : integer;
	    p1 : ^FNameType;
	    p2 : ^FNameType;
	    TapeFormat : integer;
	    RecLen : integer;
	    BlkLen : integer;
	    CreateDate : integer;
	    ExpireDate : integer;
	    p3 : ^FNameType;
	    generation : integer;
	    version : integer;
	    ModeVal : integer;
	end;  {of record}
var
	i : integer;
	BadRead : boolean;  {record is unreadable}
	VolName, OwnName, FilName : BitsAndPtrType;
	DateStr : DateStrType;
	ArgBlkPtr : ^ArgBlkType;

{  FullInformation  --  prints the record length and est. pages info	}
{  for tape files							}
procedure FullInformation(RecLen : integer);
var
	nl, EstPages : integer;
begin
	nl := 0;
	while not eof do begin  {count # of lines}
	    readln;
	    nl := nl + 1;
	end;  {of while}
	{calculate estimated pages}
	if ((RecLen * nl) mod (512 * 5) = 0) then
	    EstPages := (RecLen * nl) div (512 * 5)
	else
	    EstPages := ((RecLen * nl) div (512 * 5)) + 1;  {add a page}
	write(tty,nl:6);
	space(1);
	write(tty,EstPages:5);
	space(1);
end;  {of procedure FullInformation}

begin
	if (SeqNo < 0) then begin
	    BadRead := true;
	    SeqNo := -SeqNo;  {set back to positive}
	end
	else
	    BadRead := false;
	new(ArgBlkPtr);
	with ArgBlkPtr^ do begin
	    ArgWords := ARGS;
	    new(VolName.ptr);
	    VolName.bits := VolName.bits or [0..17];
	    p1 := VolName.ptr;
	    new(OwnName.ptr);
	    OwnName.bits := OwnName.bits or [0..17];
	    p2 := OwnName.ptr;
	    new(FilName.ptr);
	    FilName.bits := FilName.bits or [0..17];
	    p3 := FilName.ptr;
	    jsys(MTOPR;0:input,MORLI,ArgBlkPtr);
	    {formatted output to tty}
	    write(tty,SeqNo:4);
	    space(2);
	    write(tty,FilName.ptr^:StrLen(FilName.ptr^));
	    space(17-StrLen(FilName.ptr^));
	    space(1);
	    write(tty,VolName.ptr^:StrLen(VolName.ptr^));
	    space(6-StrLen(VolName.ptr^));
	    space(1);
	    write(tty,chr(TapeFormat):1);
	    space(2);
	    if (chr(TapeFormat) = UNDEFINED) then begin
		if (RecLen = 0) then  {no such thing as rec len 0}
		    RecLen := 1;
		write(tty,BlkLen:5);  {actually prints as Rec Len}
		space(2);
		write(tty,RecLen:5);
	    end  {of if}
	    else begin
	        write(tty,RecLen:5);
	        space(2);
	        write(tty,(BlkLen div RecLen):5);
	    end;  {of else}
	    space(2);
	    if (GlobalDirectory = FullDir) then
		if BadRead then	 {cannot read records}
		    write(tty,'    --    -- ')  {fill in info}
		else
		    FullInformation(RecLen);
	    InToStrDate(CreateDate,DateStr);
	    write(tty,DateStr:9);
	    space(1);
	    if (ExpireDate = -1) then
		write(tty,' Invalid ')
	    else begin
		InToStrDate(ExpireDate,DateStr);
		write(tty,DateStr:9);
	    end;  {of else}
	    writeln(tty);
	end;  {of with}
	{get rid of junk}
	dispose(ArgBlkPtr);
	dispose(VolName.ptr);
	dispose(OwnName.ptr);
	dispose(FilName.ptr);
end;  {of procedure TapeFileInfo}

{  TrapEOT  --  returns true if defined device is at end of tape	}
function TrapEOT : boolean;
const
	LOGEOT = 602240B;  {logical eot encountered}
type
	IOrBType = record
	    case boolean of
		true : (int : integer);
		false: (bits : WordSetType)
	end;  {of record}
var
	ac1, ac2 : integer;
	Ac2Store : IOrBType;
begin
	jsys(GETER;400000B;ac1,ac2);
	with Ac2Store do begin
	    int := ac2;
	    bits := (bits and [18..35]);  {clear 1st half}
	    if (int = LOGEOT) then
		TrapEOT := true
	    else
		TrapEOT := false;
	end;  {of with}
end;  {of function TrapEOT}

{  ForwardFile  --  calls mtopr to skip forward 1 logical file		}
procedure ForwardFile;
const
	MOFWF = 16B;
var
	return : integer;
begin
	GetDeviceJFN;
        jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
	if (return = 1) then
	    ErrorMess;
  	jsys(MTOPR,-2,return;0:device, MOFWF);
	if (return = 3) then begin
	    cmerrmsg;  {print official error message}
	    jsys(CLOSEF, 2, return;001000:device);
	    if (return = 1) then
	        cmerrmsg;
	    cmagain;
	end  {of begin}
	else begin
	    jsys(CLOSEF,2,return;001000:device);
	    if (return = 1) then
		ErrorMess;
	end;  {of begin}
end;  {of procedure ForwardFile}

{  BackwardFile  --  calls mtopr to skip backward 1 logical file	}
procedure BackwardFile;
const
	MOBKF = 17B;
var
	return : integer;
begin
	GetDeviceJFN;
        jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
	if (return = 1) then
	    ErrorMess;
  	jsys(MTOPR;0:device, MOBKF);
	jsys(CLOSEF,2,return;001000:device);
	if (return = 1) then
	    ErrorMess;
end;  {of procedure BackwardFile}

{  RewindTape  --  rewinds tape to bot					}
procedure RewindTape;
const
	MOREW = 1;
var
	return : integer;
begin
	GetDeviceJFN;
        jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
	if (return = 1) then
	    ErrorMess;
	jsys(MTOPR;0:device, MOREW);
	jsys(CLOSEF, 2, return;001000:device);
	if (return = 1) then
	    ErrorMess;
end;  {of procedure RewindTape}

{  CheckIfTapeAssigned  --  check if user issued tape command to	}
{  define a tape device, if not reparse					}
procedure CheckIfTapeAssigned;
begin
	if (StrLen(GlobalTape) = 0) then
	    cmuerr('Tape device not defined, use TAPE command to define device')
end;  {of CheckIfTapeAssigned}

{  InitTables  --  initializes pascmd tables to be used for parsing	}
procedure InitTables;
begin
	CmdTable := tbmak(LASTCMD);
	tbadd(CmdTable,TAPE,'TAPE',0);
	tbadd(CmdTable,REWIND,'REWIND',0);
	tbadd(CmdTable,RESTORE,'RESTORE',0);
	tbadd(CmdTable,STORE,'STORE',0);
	tbadd(CmdTable,SKIP,'SKIP',0);
	tbadd(CmdTable,HELP,'HELP',0);
	tbadd(CmdTable,XIT,'EXIT',0);
	tbadd(CmdTable,EOT,'EOT',0);
	tbadd(CmdTable,DIR,'DIRECTORY',0);
	tbadd(CmdTable,DEF,'DEFAULT',0);

	Sw1Table := tbmak(LASTSW1);
	tbadd(Sw1Table,S1BLOCK,'BLOCKING-FACTOR:',0);
	tbadd(Sw1Table,S1NOPAD,'NO-PAD-TABS',0);
	tbadd(Sw1Table,S1TABEV,'PAD-TABS:',0);
	tbadd(Sw1Table,S1RECLN,'RECORD-LENGTH:',0);

	Sw2Table := tbmak(LASTSW2);
	tbadd(Sw2Table,S2STRIP,'STRIP-BLANKS',0);
	tbadd(Sw2Table,S2NOSTR,'NO-STRIP-BLANKS',0);

	Sw3Table := tbmak(LASTSW3);
	tbadd(Sw3Table,S3SHORT,'SHORT',0);
	tbadd(Sw3Table,S3FULL,'FULL',0);

	DefTable := tbmak(LASTDEF);
	tbadd(DefTable,DFWARN,'WARNING-MESSAGES',0);
	tbadd(DefTable,DFTABEV,'TABS-EVERY',0);
	tbadd(DefTable,DFSTRIP,'STRIP-BLANKS',0);
	tbadd(DefTable,DFRECLN,'RECORD-LENGTH',0);
	tbadd(DefTable,DFNOSWI,'NO',0);
	tbadd(DefTable,DFBLOCK,'BLOCKING-FACTOR',0);

	NoTable := tbmak(LASTNO);
	tbadd(NoTable,DFWARN,'WARNING-MESSAGES',0);
	tbadd(NoTable,DFTABEV,'TABS-EVERY',0);
	tbadd(NoTable,DFSTRIP,'STRIP-BLANKS',0);
end;  {of procedure InitTables}

{  DefaultTapeName  --  returns the default name and extent from the    }
{  inputted disk name.  Tape file names must be 17 chars or less     	}
{  including the '.' so in certain cases it must be shortened		}
procedure DefaultTapeName(var name,ext : FNameType);
const
	MAXTNAME = 17;
var
	NameLen, ExtLen : integer;

begin
	jsys(JFNS;name,0:input,001000000000B);
	NameLen := StrLen(name);
	jsys(JFNS;ext,0:input,000100000000B);
	ExtLen := StrLen(ext);
	{check if name is too long}
 	if (ExtLen > 0) and (NameLen + 1 + ExtLen > MAXTNAME) then begin
	    if (ExtLen > 10) then
		ExtLen := 10;  {leave at least 6 chars for name}
	    NameLen := MAXTNAME - ExtLen - 1;
	end;  {of if}
	StrEnd(name,NameLen+1);
	StrEnd(ext,ExtLen+1);
end;  {of procedure DefaultTapeName}

{  ListFiles  --  prints the source and destination filenames		}
procedure ListFiles;
var
	source, dest : FNameType;
begin
        jsys(JFNS;source,0:input,221110000001B);
	jsys(JFNS;dest,0:output,221110000001B);
	space(2);
	writeln(tty,source:StrLen(source),' => ',dest:StrLen(dest));
end;  {of procedure ListFile}

{  DefaultDiskFile  --  Creates a diskfile name depending on the name	}
{  of the input tape name and the directory to output to		}
procedure DefaultDiskFile;
var
	FileName : FNameType;
begin
	GlobalDiskFile := GlobalDirStr;
	jsys(JFNS;FileName,0:input,001100000001B);
	scopy(FileName,1,GlobalDiskFile,StrLen(GlobalDiskFile)+1);
end;  {procedure DefaultDiskFile}

{  DefaultTapeFile  --	Takes the disk source file and turns it into	}
{  a valid tape file and stores it into GlobalTapeFile.			}
procedure DefaultTapeFile;
var
	Tname,Text : FNameType;
begin
	DefaultTapeName(Tname,Text);
	GlobalTapeFile := GlobalTape;
	GlobalTapeFile[StrLen(GlobalTapeFile)+1] := ':';
	StrEnd(GlobalTapeFile,StrPos(GlobalTapeFile,':')+1);
	scopy(Tname,1,GlobalTapeFile,StrLen(GlobalTapeFile)+1);
	GlobalTapeFile[StrLen(GlobalTapeFile)+1] := '.';
	StrEnd(GlobalTapeFile,StrPos(GlobalTapeFile,'.')+1);
	scopy(Text,1,GlobalTapeFile,StrLen(GlobalTapeFile)+1);
end;  {of procedure DefaultTapeFile}

{  ListRecordCount  --  lists the number of records read or written	}
{  from or into a file							}
procedure ListRecordCount(n : integer);
begin
	space(4);
	writeln(tty,'[',n:1,' records]');
end;  {of procedure ListRecordCount}

{  TruncMess  --  prints a message saying what line was truncated and	}
{  by how much								}
procedure TruncMess(line, col : integer);
begin
	jsys(JFNS;101B, 0:input, 0);
	write(tty, ' - line ', line:1, ' : ', col:1,
		   ' characters long, truncated to ', GlobalRecLen:1);
	writeln(tty);
end;  {of procedure TruncMess}

{  SwitchRecLenSw1  --  parses the record-length switch option for the	}
{  store command							}
procedure SwitchRecLenSw1;
var
	i, RecLen : integer;
	HelpMess, ErrMess : StrType;
begin
	scopy('integer between 1 and ',1,HelpMess,1);
	i := itoc(MAXRECLEN,HelpMess,StrLen(HelpMess)+1);
	cmhlp(HelpMess);
	cmdef(DEFRECLEN);
	RecLen := cmnum;  {get an integer}
	if (RecLen < MINRECLEN) or (RecLen > MAXRECLEN) then begin
	    scopy('Record length must be between ',1,ErrMess,1);
	    i := itoc(MINRECLEN,ErrMess,StrLen(ErrMess)+1);
	    scopy(' and ',1,Errmess,StrLen(ErrMess)+1);
	    i := itoc(MAXRECLEN,ErrMess,StrLen(ErrMess)+1);
	    cmuerr(ErrMess);
	end;  {of if}
	if ((RecLen * HoldBlkFac) > MAXBLKLEN) then begin
	    scopy
              ('Record length too large with blocking factor of ',1,ErrMess,1);
	    i := itoc(HoldBlkFac,ErrMess,StrLen(ErrMess)+1);
	    cmuerr(ErrMess);
	end;  {of if}
	HoldRecLen := RecLen;  {set global variable}
end;  {of procedure SwitchRecLenSw1}

{  SwitchNoPadSw1  --  parses the no-pad-tabs switch option for the	}
{  store command							}
procedure SwitchNoPadSw1;
begin
	HoldPadTabs := false;
end;  {of procedure SwitchNoPadSw1}

{  SwitchBlockSw1  --  parses the records-per-block switch option for	}
{  the store command							}
procedure SwitchBlockSw1;
var
	i, BlkFac : integer;
	HelpMess, ErrMess : StrType;
begin
	cmhlp('number of records per block');
	cmdef(DEFBLKFAC);
	BlkFac := cmnum;  {get and integer}
	if (BlkFac = 0) then	 {0 same as 1}
	    BlkFac := 1;
	if (BlkFac < 1) or (BlkFac > MAXBLKLEN) then begin
	    scopy('Blocking factor must be between 1 and ',1,ErrMess,1);
	    i := itoc(MAXBLKLEN,ErrMess,StrLen(ErrMess)+1);
	    cmuerr(ErrMess);
	end;  {of if}
	if ((BlkFac * HoldRecLen) > MAXBLKLEN) then begin
	    scopy
              ('Blocking factor too large with record length of ',1,ErrMess,1);
	    i := itoc(HoldRecLen,ErrMess,StrLen(ErrMess)+1);
	    cmuerr(ErrMess);
	end;  {of if}
	HoldBlkFac := BlkFac;  {set global variable}
end;  {of procedure SwitchBlockSw1}

{  SwitchSetTabsSw1  --  parses the tabs-every switch option for the	}
{  store command							}
procedure SwitchSetTabsSw1;
var
	i, TabNo : integer;
	HelpMess, ErrMess : StrType;
begin
	scopy('integer between 1 and ',1,HelpMess,1);
	i := itoc(MAXRECLEN,HelpMess,StrLen(HelpMess)+1);
	cmhlp(HelpMess);
	cmdef(DEFTABNO);
	TabNo := cmnum;  {get an integer}
	if (TabNo < 1) or (TabNo > MAXRECLEN) then begin
	    scopy('Argument must be between 1 and ',1,ErrMess,1);
	    i := itoc(MAXRECLEN,ErrMess,StrLen(ErrMess)+1);
	    cmuerr(ErrMess);
	end;  {of if}
	HoldTabNo := TabNo;  {set global variable}
	HoldPadTabs := true;  {set global variable}
end;  {of procedure SwitchSetTabsSw1}

{  SwitchNoStripSw2  --  handles the no-strip switch for the restore	}
{  command								}
procedure SwitchNoStripSw2;
begin
	HoldStripBlanks := false;
end;  {of procedure SwitchNoStripSw2}

{  SwitchStripSw2  --  handles the strip-blanks switch for the restore	}
{  command								}
procedure SwitchStripSw2;
begin
	HoldStripBlanks := true;
end;  {of procedure SwitchStripSw2}

{  SwitchFullDirSw3  --  handles the full switch for the directory	}
{  command								}
procedure SwitchFullDirSw3;
begin
	HoldDirectory := FullDir;
end;  {of procedure SwitchFullDirSw3}

{  SwitchShortDirSw3  --  handles the short switch for the directory	}
{  command								}
procedure SwitchShortDirSw3;
begin
	HoldDirectory := ShortDir;
end;  {of procedure SwitchShortDirSw3}

{  SwitchWarnMessDf  --  handles the Warning Messages option		}
procedure SwitchWarnMessDf;
begin
	HoldWarning := true;
end;  {of procedure SwitchWarnMessDf}

{  SwitchNoWarnDf  --  turns off the warning messages			}
procedure SwitchNoWarnDf;
begin
	HoldWarning := false;
end;  {of procedure SwitchNoWarnDf}

{  SwitchNoSwitchDf  --  handles the no option for the default command	}
procedure SwitchNoSwitchDf;
var
	NoCommand : integer;
begin
	NoCommand := cmkey(NoTable);
	case NoCommand of
	    DFSTRIP : SwitchNoStripSw2;
	    DFTABEV : SwitchNoPadSw1;
	    DFWARN  : SwitchNoWarnDf;
	    others  : cmuerr('Invalid switch');
	end;  {of case}
end;  {of procedure SwitchNoSwitchDf}

{  SaveStoreSwitchesSw1  --  assigns variables storing store switches	}
{  information to global variable.					}
procedure SaveStoreSwitchesSw1;
begin
	GlobalRecLen  := HoldRecLen;
	GlobalBlkFac  := HoldBlkFac;
	GlobalTabNo   := HoldTabNo;
	GlobalPadTabs := HoldPadTabs;
end;  {of procedure SaveStoreSwitchesSw1}

{  SaveRestoreSwitchesSw2  --  assigns vriables storing restore		}
{  switches information to global variables				}
procedure SaveRestoreSwitchesSw2;
begin
	GlobalStripBlanks := HoldStripBlanks;
end;  {of procedure SaveRestoreSwitchesSw2}

{  SaveDirectorySwitchesSw3  --  assigns vriables storing directory	}
{  switches information to global variables			 	}
procedure SaveDirectorySwitchesSw3;
begin
	GlobalDirectory := HoldDirectory;
end;  {of procedure SaveDirectorySwitchesSw3}

{  SaveDefaults  --  saves default settings 				}
procedure SaveDefaults;
begin
	DefaultRecLen  := HoldRecLen;
	DefaultBlkFac  := HoldBlkFac;
	DefaultTabNo   := HoldTabNo;
	DefaultPadTabs := HoldPadTabs;
	DefaultWarning := HoldWarning;
	DefaultStripBlanks := HoldStripBlanks;
end;  {of procedure SaveDefaults}

{  StoreSwitchesSw1  --  parses multiple choices for	the store	}
{  command								}
procedure StoreSwitchesSw1;
var
	switch : integer;
begin
	loop
	    cmmult;  {multiple mode}
	    cmcfm;  {carriage return}
	    switch := cmswi(Sw1Table);
	    switch := cmdo;
	exit if (switch = 1);
	    switch := cmint;  {get real value from cmswi}
	    if (switch > 0) then
		case switch of
		    S1NOPAD : SwitchNoPadSw1;
		    others  : cmuerr('Argument not specified');
		end  {of case}
	    else if (switch < 0) then  {users gave argument, indicated by - }
		case -switch of
		    S1BLOCK : SwitchBlockSw1;
		    S1RECLN : SwitchRecLenSw1;
		    S1TABEV : SwitchSetTabsSw1;
		    others  : cmuerr('Does not take an argument');
		end;  {of case -switch}
	end;  {of loop}
end;  {of procedure StoreSwitchesSw1}

{  RestoreSwitchesSw2  --  parses multiple choice switches for the	}
{  store command							}
procedure RestoreSwitchesSw2;
var
	switch : integer;
begin
	cmmult;  {multiple mode}
	cmdef('/STRIP-BLANKS');
	cmcfm;  {cr}
	switch := cmswi(Sw2Table);
	switch := cmdo;
	if (switch <> 1) then begin
	    switch := cmint;  {get real value form cmswi}
	    if (switch < 0) then
		cmuerr('Does not take an argument')
	    else
	        case switch of
		    S2NOSTR : SwitchNoStripSw2;
		    S2STRIP : SwitchStripSw2;
		    others  : cmuerr('Invalid switch')
	    	end;  {of case switch}
	    cmcfm;  {cr}
	end;  {of if}
end;  {of procedure RestoreSwitchesSw2}

{  DirectorySwitchesSw3  --  parses multiple choice switches for the	}
{  Directory command							}
procedure DirectorySwitchesSw3;
var
	switch : integer;
begin
	cmmult;  {multiple mode}
	cmdef('/SHORT');
	cmcfm;  {carriage return}
	switch := cmswi(Sw3Table);
	switch := cmdo;
	if (switch <> 1) then begin
	    switch := cmint;  {get real value form cmswi}
	    if (switch < 0) then
		cmuerr('Does not take an argument')
	    else
	        case switch of
		    S3FULL  : SwitchFullDirSw3;
		    S3SHORT : SwitchShortDirSw3;
		    others  : cmuerr('Invalid switch')
	    	end;  {of case switch}
	    cmcfm;  {cr}
	end;  {of if}
end;  {of procedure DirectorySwitchesSw3}

{  ParseTapeOutput2  --  parses next field as output to tape		}
procedure ParseTapeOutput2;
var
	Tname,Text : FNameType;
	TapeFileStr : StrType;
 	TFStrLen : integer;
begin
	cmnoi('AS');
	CheckIfTapeAssigned;
	gjgen(600020000000B);
 	DefaultTapeName(Tname,Text);
        gjdev(GlobalTape);
        gjnam(Tname);
	gjext(Text);
	cmfil(output);
	TFStrLen := cmatom(TapeFileStr);
	StrEnd(TapeFileStr,TFStrLen+1);
	if (StrPos(TapeFileStr,';') <> 0) then  {user enters extra junk}
	    GarbageErr
	      ('Invalid attribute for this device',TapeFileStr);
	if (KindOfDevice(curjfn(output),JFNDes) <> TapeDev) then
	    cmuerr('Use COPY command to copy from disk to disk');
end;  {of procedure ParseTapeOutput2}

{  ParseDiskOutput2  --  parses next field as output to disk		}
procedure ParseDiskOutput2;
var
	name, ext : FNameType;

begin
	cmnoi('TO');
	jsys(JFNS;name,0:input,001000000000B);
	jsys(JFNS;ext,0:input,000100000000B);
	gjgen(600020000000B);
	gjnam(name);
	gjext(ext);
	cmfil(output);
	if not (KindOfDevice(curjfn(output),JFNDes) in [DiskDev,TTYDev]) then
	    cmuerr('This utility does not support tape to tape copying');
end;  {of procedure ParseDiskOutput2}

{  ParseDirOutput2  --  parses next field as a directory name		}
procedure ParseDirOutput2;
const
	DIRST = 41B;
	GJINF = 13B;
var
	ac1, ac2, DirNo, DirLen : integer;
	DefaultDir : StrType;
begin
	jsys(GJINF;;ac1, ac2);  {get def dir no}
	jsys(DIRST;DefaultDir, ac2);  {turn it into a string}
	cmdef(DefaultDir);
	DirNo := cmdir;
	DirLen := cmatom(GlobalDirStr);
	StrEnd(GlobalDirStr,DirLen+1);
	if (DirLen = 0) then
	    GlobalDirStr := DefaultDir;
end;  {of procedure ParseDirOutput2}

procedure RestoreFile;
var
	line, RecLen : integer;
	next : boolean;
	buffer : packed array [1..MAXRECLEN] of char;
begin
	line := 0;
	while not eof do begin
	    next := true;
	    readln(buffer:RecLen);
	    line := line + 1;
	    RecLen := RecLen - 2;  {disregard crlf}
	    if GlobalStripBlanks then
		while (RecLen >= 1) and next do
		    if (buffer[RecLen] = chr(BLANK)) then
		        RecLen := RecLen - 1
		    else
			next := false;
	    if (RecLen = 0) then
		writeln
	    else
	        writeln(buffer:RecLen);
	end;  {of while}
        ListRecordCount(line);
end;  {of procedure RestoreFile}

{  StoreFile  --  processes the store command				}
procedure StoreFile;
var
	col, line : integer;
	mess : StrType;

{  NewLine  --  handles end of line delimiter and sets up for the next	}
{  line									}
procedure NewLine;
begin
	if ((col - 1)  > GlobalRecLen) then
	    TruncMess(line,col-1);
	readln;
	writeln;
	col := 1;
	line := line + 1;
end;  {of procedure NewLine}

{  CopyChar  --  copies a single char from input to output and takes	}
{  into account tabs							}
procedure CopyChar;
begin
	if GlobalPadTabs and (input^ = chr(TAB)) then
	    repeat   {pad tabs}
		if (col <= GlobalRecLen) then begin
		    output^ := chr(BLANK);
		    put(output);
		end;  {of if}
		col := col + 1;
	    until (TabPos(col))
	else begin
	    if (col <= GlobalRecLen) then begin
		output^ := input^;
		put(output);
	    end;  {of if}
	    col := col + 1;
	end;  {of else}
	get(input);
end;  {of procedure CopyChar}

begin  {StoreFile}
	col := 1; line := 1;
	while not eof do begin  {store to tape}
	    if (input^ = chr(CR)) then begin
		get(input);  {check if crlf}
		if eof then begin  {cr eof}
		    if ((col - 1)  > GlobalRecLen) then
		    	TruncMess(line,col-1);
		    writeln;
		    line := line + 1;
		end  {of if}
    		else if (input^ = chr(LF)) then  {crlf}
		    NewLine
		else begin  {treat both cr and next char as normal char's}
		    if (col <= GlobalRecLen) then begin
		        output^ := chr(CR);  {add in already read cr}
		        put(output);
		    end;  {of if}
		    col := col + 1;
		    CopyChar;
		end  {of else}
	    end  {of if}
	    else if (input^ = chr(LF)) then  {same as crlf}
		NewLine
	    else
		CopyChar;
	end;  {of while not eof}
	ListRecordCount(line-1);
end;  {of procedure StoreFile}

{  initialization  --  does the initializing				}
procedure initialization;
const
	INDUSTRY_COMPATIBLE = 4B;
begin
	OriginalDataMode := GetJobDataMode;
	if (OriginalDataMode <> INDUSTRY_COMPATIBLE) then
	    SetJobDataMode(INDUSTRY_COMPATIBLE);
	ThatsIt := false;
	StrEnd(GlobalTape,1);  {null string}
	InitTables;
	DefaultRecLen := ctoi(DEFRECLEN,1);
	DefaultBlkFac := ctoi(DEFBLKFAC,1);
	DefaultTabNo  := ctoi(DEFTABNO,1);
	DefaultWarning := true;
	DefaultPadTabs := true;
	DefaultStripBlanks := true;
	DefaultDirectory := ShortDir;
end;  {of procedure initialization}

{  PrintHeading  --  prints heading when ANSIMT starts up.  Prints	}
{  title, version numbers, edit numbers, and date.			}
procedure PrintHeading;
const
	WHO_EDITED = 2B;
	MAJOR_VERSION_NUMBER = 001B;
	MINOR_VERSION_NUMBER = 02B;
	EDIT_NUMBER = 000001B;

	ODTIM = 220B;
var
	ProgramStartTime : packed array [1..40] of char;  {date field}
{$V:200102000001b}  {system version number}
begin
	writeln(tty,'UHCC DEC-20 ANSI Labelled Tape Utility version ',
		    MAJOR_VERSION_NUMBER:3:O,'.',MINOR_VERSION_NUMBER:2:O,
		    '(',EDIT_NUMBER:6:O,')-',WHO_EDITED:1:O);
	jsys(ODTIM,1;ProgramStartTime,-1,336321000000B);
	writeln(tty,ProgramStartTime:StrLen(ProgramStartTime));
	writeln(tty);
end;  {of procedure PrintHeading}

{  InitParameters  --  initializes the global and dummy variables to 	}
{  their default values 						}
procedure InitParameters;
begin
	HoldRecLen := DefaultRecLen;
	HoldBlkFac := DefaultBlkFac;
	HoldTabNo  := DefaultTabno;
	HoldPadTabs := DefaultPadTabs;
	HoldWarning := DefaultWarning;
	HoldStripBlanks := DefaultStripBlanks;
	HoldDirectory := DefaultDirectory;

	GlobalRecLen := DefaultRecLen;
	GlobalBlkFac := DefaultBlkFac;
	GlobalTabNo  := DefaultTabno;
	GlobalPadTabs := DefaultPadTabs;
	GlobalWarning := DefaultWarning;
	GlobalStripBlanks := DefaultStripBlanks;
	GlobalDirectory := DefaultDirectory;
end;  {of procedure InitParameters}

{  ParseDefault1  --  parses the default command			}
procedure ParseDefault1;
var
	DefCommand : integer;
begin
	cmnoi('FOR');
	DefCommand := cmkey(DefTable);
	case DefCommand of
	    DFBLOCK : SwitchBlockSw1;
	    DFNOSWI : SwitchNoSwitchDf;
	    DFRECLN : SwitchRecLenSw1;
	    DFSTRIP : SwitchStripSw2;
	    DFTABEV : SwitchSetTabsSw1;
	    DFWARN  : SwitchWarnMessDf;
	    others  : cmuerr('Invalid switch');
	end;  {of case}
	cmcfm;  {cr}
end;  {of ParseDefault}

{  ParseDirectory  --  parses the directory command			}
procedure ParseDirectory1;
begin
	cmnoi('OF TAPE');
	DirectorySwitchesSw3;
end;  {of procedure ParseDirectory1}

{  ParseEOT1  --  parses the eot command				}
procedure ParseEOT1;
begin
	cmnoi('END OF TAPE');
	cmcfm;
end;  {of procedure ParseEOT1}

{  ParseExit1  --  parses the exit command				}
procedure ParseExit1;
begin
 	cmnoi('TO MONITOR');
	cmcfm;
end;  {of procedure ParseExit1}

{  ParseHelp1  --  parses the help command				}
procedure ParseHelp1;
begin
	cmnoi('ON ANSIMT COMMANDS');
	cmcfm;  {carriage return}
end;  {of procedure ParseHelp1}

{  ParseRestore1  --  parses the restore command			}
procedure ParseRestore1;
var
	FileStrLen : integer;
	FileStr : StrType;
begin
	cmnoi('TAPE FILES');
	CheckIfTapeAssigned;
	gjgen(000120777775B);
	gjdev(GlobalTape);
	cmfil(input);
	FileStrLen := cmatom(FileStr);
	StrEnd(FileStr,FileStrLen+1);
	if (KindOfDevice(curjfn(input),JFNDes) <> TapeDev) then
	    cmuerr('Device must be TAPE');
	if (StrPos(FileStr,'*') = 0) and
	   (StrPos(FileStr,'%') = 0) then begin
	    ParseDiskOutput2;
	    jsys(JFNS;GlobalDiskFile,0:output,0);
	end  {of if}
	else begin
	    ParseDirOutput2;
	    GlobalDiskFile[1] := chr(NULL);
	end;  {of else}
	RestoreSwitchesSw2;
end;  {of procedure ParseRestore1}

{  ParseRewind1  --  parses the rewind command				}
procedure ParseRewind1;
begin
	cmnoi('TO THE BEGINNING OF TAPE');
	cmcfm;
end;  {of procedure ParseRewind1}

{  ParseSkip1  --  parses the skip command				}
procedure ParseSkip1;
const
	DEFNFIL = '1 ';
begin
	cmnoi('NUMBER OF FILES');
	cmhlp('positive integer for forward, negative for backward');
	cmdef(DEFNFIL);
	FilesToSkip := cmnum;  {global variable}
	cmcfm;  {carriage return}
end;  {of procedure ParseSkip1}

{  ParseStore1  --  parses the store command 				}
procedure ParseStore1;
var
	i, FileStrLen : integer;
	FileStr : StrType;
begin
	cmnoi('DISK FILES');
        gjgen(100120000000B);
	cmfil(input);
	FileStrLen := cmatom(FileStr);
	StrEnd(FileStr,FileStrLen + 1);
	if (StrPos(FileStr,'*') = 0) and  {wild card?}
	   (StrPos(FileStr,'%') = 0) then begin
	    ParseTapeOutput2;
            jsys(JFNS;GlobalTapeFile,0:output,0);
	end  {if end}
	else begin {it is a wild card}
	    DefaultTapeFile;
	end;  {of else}
	StoreSwitchesSw1;
end;  {of procedure ParseStore1}

{  ParseTape1  --  parses the tape command				}
procedure ParseTape1;
const
	ASND = 70B;
var
	DevNo, DevStrLen, return : integer;
	DevStr : FNameType;
begin
	cmnoi('DEVICE');
	cmhlp('magtape device');
	DevNo := cmdev;
	DevStrLen := cmatom(DevStr);
 	StrEnd(DevStr,DevStrLen+1);
	if (KindOfDevice(DevNo,DevDes) <> TapeDev) then
	    GarbageErr('Not a magtape device',DevStr);
	jsys(ASND, 3, return;DevNo);  {try to assign the device}
	if (return = 1) then  {error}
	    ErrorMess;
	cmcfm;
	HoldTape := DevStr;
end;  {of procedure ParseTape1}

{  ProcessDefault  --  process the default command			}
procedure ProcessDefault;
begin
	SaveDefaults;
end;  {of procedure ProcessDefault}

{  ProcessDirectory  --  process the directory command			}
procedure ProcessDirectory;
const
	WILDCARD = ':*.*.*';
	DATAERR = 600221B;  {data error}
	BIGREC = 601240B;
var
	i : integer;
	WildFile : FNameType;
begin
	SaveDirectorySwitchesSw3;
	CheckIfTapeAssigned;
	RewindTape;
	WildFile := GlobalTape;
	scopy(WILDCARD,1,WildFile,StrLen(WildFile)+1);
	i := 1;
	repeat
	    reset(input,WildFile,'/d/o/m:7',[11]{allow wildcards});
	    if (erstat(input) <> 0) and
	       (erstat(input) <> DATAERR) and (erstat(input) <> BIGREC) then
 	        analysis(input)
	    else begin
		if (i = 1) then
		    DirHeading;
		if (erstat(input) = DATAERR) or (erstat(input) = BIGREC) then
		    TapeFileInfo(-i)
		else
		    TapeFileInfo(i);
		i := i + 1;
	    end;
	    ClearDataError(input);
	    if FileOpen(input) then
		close(input);
	until (nextfile(input) = 0);
end;  {of procedure ProcessDirectory}

{  ProcessEOT  --  processes the eot command				}
procedure ProcessEOT;
const
	MOEOT = 10B;
var
	return : integer;
begin
	CheckIfTapeAssigned;
	GetDeviceJFN;
        jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
	if (return = 1) then
	    ErrorMess;
 	jsys(MTOPR,-2,return;0:device, MOEOT);
	if (return = 3) then begin
	    if TrapEOT then
		WarnMess('Already at end of tape')
	    else
		cmerrmsg;  {print official error message}
	    jsys(CLOSEF, 2, return;001000:device);
	    if (return = 1) then
	        cmerrmsg;
	    cmagain;
	end  {of if}
	else begin
	    jsys(CLOSEF,2,return;001000:device);
	    if (return = 1) then
		ErrorMess;
	end;  {of begin}
end;  {of procedure ProcessEOT}

{  ProcessExit  --  processes the exit command				}
procedure ProcessExit;
begin
	ThatsIt := true;  {terminates program in major loop}
end;  {of procedure ProcessExit}

{  ProcessHelp  --  processes the help command				}
procedure ProcessHelp;
var
	rl : integer;
	buffer : StrType;
begin
	reset(input,'HLP:ANSIMT.HLP','/o');
	if (erstat(input) <> 0) then
	    analysis(input);
	rewrite(output,'TTY:','/o/i');
	if (erstat(output) <> 0) then
	    analysis(output);
	while not eof do begin
	    readln(buffer:rl);
	    writeln(buffer:rl);
	end;  {of while}
	close(input);
	close(output);
end;  {of procedure ProcessHelp}

{  ProcessRestore  --  processes the restore command			}
procedure ProcessRestore;
begin
	SaveRestoreSwitchesSw2;
	loop
            if OpenInputTape then begin
		if (GlobalDiskFile[1] = chr(NULL)) then
		    DefaultDiskFile;
                if not OpenOutputDisk then
                    cmagain;
                ListFiles;
                RestoreFile;
                close(input);
                close(output);
	    end;  {of if}
	exit if (nextfile(input) = 0);
	    GlobalDiskFile[1] := chr(NULL);
	end;  {of loop}
end;  {of procedure ProcessRestore}

{  ProcessRewind  --  processes the rewind command			}
procedure ProcessRewind;
begin
	CheckIfTapeAssigned;
	RewindTape;
	if BeginningOfTape then
	    WarnMess('Already at beginning of tape');
end;  {of procedure ProcessRewind}

{  ProcessSkip  --  processes the skip command				}
procedure ProcessSkip;
var
	i : integer;
begin
	CheckIfTapeAssigned;
	if (FilesToSkip > 0) then
	    for i := 1 to FilesToSkip do
	    	ForwardFile
	else if (FilesToSkip < 0) then
	    for i := 1 to -FilesToSkip do begin
		BackwardFile;
		if BeginningOfTape then
		    cmuerr('Beginning of tape encountered');
	    end;  {of for}
end;  {of procedure ProcessSkip}

{  ProcessStore  --  processes the store command			}
procedure ProcessStore;
var
	i : integer;
	mess : StrType;
begin  {ProcessStore}
	SaveStoreSwitchesSw1;
        if (KindOfDevice(curjfn(input),JFNDes) = DiskDev) then begin
        	if not OpenInputFile(DiskDev) then
                    cmagain;
        end  {of if}
        else if (KindOfDevice(curjfn(input),JFNDes) = TTYDev) then begin
        	if not OpenInputFile(TTYDev) then
                    cmagain;
        end  {of else if}
        else
            cmuerr('Source device must be DISK');
	loop
            if not OpenOutputTape(GlobalTapeFile) then
	    	cmagain;
	    if (GlobalRecLen * GlobalBlkFac > MAXRECLEN) then begin
	    	scopy('Block size greater than the ANSI standard of ',1,mess,1);
	    	i := itoc(MAXRECLEN,mess,StrLen(mess)+1);
	    	WarnMess(mess);
	    end;  {of if}
	    ListFiles;
	    StoreFile;
	    close(input);
	    close(output);
	exit if (nextfile(input) = 0);
	    if not OpenInputFile(DiskDev) then
	        cmagain;
 	    DefaultTapeFile;
	end;  {of loop}
end;  {of procedure ProcessStore}

{  ProcessTape  --  processes the tape command				}
procedure ProcessTape;
const
	MORLI = 50B;
	MOSDM = 4B;  {set hardware data mode}
	ARGS = 2B;
	UNLABELED = 1;
	ANSILABEL = 2;
	EBCDICLABEL = 3;
	TOPS20LABEL = 4;
type
	ArgBlkType = record
	    ArgWords : integer;
	    TypeOfLabel : integer;
	end;  {of record}
var
	DummyTape : FNameType;
	ArgBlkPtr : ^ArgBlkType;
begin
	new(ArgBlkPtr);
	DummyTape := GlobalTape;
	GlobalTape := HoldTape;  {set to global variable}
	with ArgBlkPtr^ do begin
	    ArgWords := ARGS;
	    GetDeviceJFN;
	    jsys(MTOPR;0:device,MORLI,ArgBlkPtr);
	    if (TypeOfLabel = UNLABELED) then begin
		GlobalTape := DummyTape;  {get back old value}
		cmuerr('Tape cannot be unlabelled');
	    end  {of if}
	    else if (TypeOfLabel = EBCDICLABEL) then
		WarnMess('EBCDIC tape, read only')
	    else if (TypeOfLabel = TOPS20LABEL) then
                WarnMess('TOPS-20 tape');
	end;  {of with}
	{get rid of junk}
	dispose(ArgBlkPtr);
end;  {of procedure ProcessTape}

{  termination  --  cleans up before exiting				}
procedure termination;
const
	INDUSTRY_COMPATIBLE = 4B;
begin
	if (OriginalDataMode <> INDUSTRY_COMPATIBLE) then
	    SetJobDataMode(OriginalDataMode);
end;  {of procedure termination}

begin  {main program}
	initialization;
	PrintHeading;
	repeat
	    cminir('ANSIMT>');
	    InitParameters;
	    command := cmkey(CmdTable);
	    case command of  {parse the command}
		DEF	: ParseDefault1;
		DIR	: ParseDirectory1;
		EOT	: ParseEOT1;
		XIT	: ParseExit1;
		HELP	: ParseHelp1;
		RESTORE : ParseRestore1;
		REWIND	: ParseRewind1;
		SKIP	: ParseSkip1;
		STORE 	: ParseStore1;
		TAPE	: ParseTape1;
	    end;  {of case}
	    case command of  {now process the command}
		DEF	: ProcessDefault;
		DIR	: ProcessDirectory;
		EOT	: ProcessEOT;
		XIT	: ProcessExit;
		HELP	: ProcessHelp;
		RESTORE : ProcessRestore;
		REWIND	: ProcessRewind;
		SKIP	: ProcessSkip;
		STORE 	: ProcessStore;
		TAPE	: ProcessTape;
	    end;  {of case}
	until ThatsIt;
	termination;
end.  {of program ANSIMT_TapeUtility}

