PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 1

    1   {  									}
    2   {  A N S I M T . P A S   L O G -					}
    3   {									}
    4   {									}
    5   {  Revision 85/07/85 10:00:00 Nelson Kanemoto				}
    6   {  Modified to run with new version of Rutgers Pascal.  Modifications	}
    7   {  were passing constants by value by removing the 'var' off the fol-	}
    8   {  lowing procedures:  scopy, ctoi, GarbageErr, and WarnMess.		}
    9   {									}
   10   {  Installation 85/03/08 12:45:00 Nelson Kanemoto			}
   11   {  Latest version installed in PS:<UHCCSYS-SUBSYS>			}
   12   {									}
   13   {  Revision 85/02/15 12:00:00 Nelson Kanemoto				}
   14   {  Added warning messages for EBCDIC and DEC-20 labelled tapes for	}
   15   {  the TAPE command.							}
   16   {									}
   17   {  Installation 85/01/17 10:45:00 Nelson Kanemoto			}
   18   {  Latest version installed in PS:<UHCCSYS-SUBSYS>			}
   19   {									}
   20   {  Revision 85/01/15 16:00:00 Nelson Kanemoto				}
   21   {  Installed a modified ansimt.doc into doc:, with modifications on	}
   22   {  wildcards for the STORE and RESTORE commands				}
   23   {									}
   24   {  Revision 85/01/09 12:00:00 Nelson Kanemoto				}
   25   {  Restore command with wildcards is now working, but changed bits	}
   26   {  in gjgen in ParseRestore1.						}
   27   {									}
   28   {  Revision 84/12/26 14:00:00 Nelson Kanemoto				}
   29   {  Started working on procedure RestoreFile by extracting from 		}
   30   {  ProcessRestore.							}
   31   {									}
   32   {  Revision 84/12/26 13:00:00 Nelson Kanemoto                     	}
   33   {  Working on wildcards for the restore command, modifying procedures	}
   34   {  ParseRestore1 and ParseDiskOutput2, and adding in procedure 		}
   35   {  ParseDirOutput2.							}
   36   {									}
   37   {  Revision 84/11/29 15:00:00 Nelson Kanemoto				}
   38   {  Wildcards are working for the store command, doing simple testing	}
   39   {									}
   40   {  Revision 84/10/29 15:00:00 Nelson Kanemoto				}
   41   {  Moved the storing part of ProcessStore to StoreFile to make way	}
   42   {  for handling wildcards.  Compiled and executed new version, but	}
   43   {  didn't test it on storing files.					}
   44   {									}
   45   {  Installation 84/10/29 14:40:00 Nelson Kanemoto			}
   46   {  Updated ANSIMT.DOC, ANSIMT.HLP, and ANSIMT.EXE then installed them	}
   47   {  to their proper locations (DOC:, HLP:, PS:<UHCCSYS-SUBSYS>).		}
   48   {									}
   49   {  Revision 84/10/25 13:45:00 Nelson Kanemoto				}
   50   {  Fixed bug in procedure ParseDiskOutput2.  If someone added tape	}
   51   {  parameters to the tape file spec, it wouldn't return the intended	}
   52   {  error message.  That's fixed now.					}
   53   {									}
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 1-1

   54   {  Revision 84/09/25 15:30:00 Nelson Kanemoto				}
   55   {  Added in an option to turn warning messages off and on in the	}
   56   {  default command.  Also added a no option in the default command	}
   57   {  instead of "no-".							}
   58   {									}
   59   {  Revision 84/09/25 14:00:00 Nelson Kanemoto				}
   60   {  Program now automatically sets the default data mode to industry	}
   61   {  compatible and returns to original data mode when it exits		}
   62   {									}
   63   {  Revision 84/09/24 14:30:00 Nelson Kanemoto				}
   64   {  Got rid of ^A in ANSIMT heading.					}
   65   {									}
   66   {  Installation 84/09/20 16:00:00 Nelson Kanemoto			}
   67   {  Latest version installed in PS:<UHCCSYS-SUBSYS>			}
   68   {									}
   69   {  Revision 84/09/20 14:00:00 Nelson Kanemoto				}
   70   {  Added in procedure to print ANSIMT heading.				}
   71   {									}
   72   {  Revision 84/09/19 15:00:00 Nelson Kanemoto				}
   73   {  corrected directory command to handle files w/ incorrect record	}
   74   {  lengths and modified /FULL directory listing for 'U' format tape	}
   75   {  files.								}
   76   {									}
   77   program ANSIMT_TapeUtility;
   78   include 'sys:pascmd.pas';
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1

sys:pascmd.pas

    1   const {declarations to help using break masks}
    2   
    3    {Standard Field break mask
    4     all control chars, space through comma, dot, slash, 
    5     colon through question mark, atsign, open bracket through accent grave,
    6     and close bracket through tilde}
    7       fldb0=777777777760B;
    8       fldb1=777754001760B;
    9       fldb2=400000000760B;
   10       fldb3=400000000760B;
   11   
   12    {Keyword break set.  Same as standard field for now}
   13       keyb0=777777777760B;
   14       keyb1=777754001760B;
   15       keyb2=400000000760B;
   16       keyb3=400000000760B;
   17   
   18    {Username break set.  Breaks on everything except dot and alphabetics.}
   19       usrb0=777777777760B;
   20       usrb1=747544001760B;
   21       usrb2=400000000740B;
   22       usrb3=400000000760B;
   23   
   24    {Account mask currently the same as user mask}
   25       actb0=777777777760B;
   26       actb1=747544001760B;
   27       actb2=400000000740B;
   28       actb3=400000000760B;
   29   
   30    {Filespec field - filespec punctuation characters are legal ( :, <, >, ., ;)}
   31       filb0=777777777760B;
   32       filb1=74544000120B;
   33       filb2=400000000240B;
   34       filb3=400000000760B;
   35   
   36    {Read Device Name - like standard field, but allow dollarsign and underscore}
   37       devb0=777777777760B;
   38       devb1=757754001760B;
   39       devb2=400000000740B;
   40       devb3=400000000760B;
   41   
   42    {Read To End Of Line - break on linefeed and carraige return}
   43       eolb0=000220000000B;
   44       eolb1=000000000000B;
   45       eolb2=000000000000B;
   46       eolb3=000000000000B;
   47   
   48   type
   49    bitset=set of 0..35;
   50    t=array[0:100]of integer;
   51    table=^t;
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1-1

   52    tadrec=packed record
   53   	year:0..777777B; month:0..777777B;
   54   	dayofmonth:0..777777B; dayofweek:0..777777B;
   55   	zoneused:boolean;
   56   	daylightsavings:boolean;
   57   	zoneinput:boolean;
   58   	julianday:boolean;
   59   	dum:0..377B;
   60   	zone:0..77B;
   61   	seconds:0..777777B
   62   	end;
   63    cmmodes=(normal,rescan);
   64    brkmsk=array [0..3] of integer;
   65   	
   66   procedure cmini(prompt:string);extern;
   67     {Use this procedure first.  It will issue the prompt, and set things
   68      up for reparsing in case of errors.  Beware that if an error occurs
   69      in any of the other CM functions, control may be returned to the
   70      statement after the CMINI.  Effectively this is done with a non-local
   71      GOTO.  Thus the code between the CMINI and the end of the parse must
   72      be designed so that it can be restarted.  Also, you must not exit the
   73      block in which the CMINI is issued until the entire parse is done.
   74      Since control will be returned to the CMINI in case of an error, it
   75      would cause serious troubles if that block was no longer active. }
   76   
   77   procedure cminir(prompt:string);extern;
   78   {Special version of CMINI to be used when you want to read a rescanned
   79      command from the EXEC.  If this is done in a loop, the second time
   80      it is done, the program exits.}
   81   
   82   procedure cmfni(prompt: string; flag:integer); extern;
   83   procedure cmfnir(prompt: string; flag:integer); extern;
   84   {Special versions of CMINI and CMINIR.  The left half of FLAG is set in
   85       the .CMFLG word of the COMND JSYS state block.  This is needed when
   86       you want to set CM%RAI, CM%XIF, or CM%WKF}
   87   
   88   function cmmode:cmmodes;extern;
   89   {Says what "mode" we are running in.  At the moment normal or rescan.
   90      Rescan means that a CMINIR succeeded in finding valid rescanned data.}
   91   
   92   procedure cmrscn; extern;
   93   {Clears the RSCANF flag saying whether a RSCAN was done by CMINIR so
   94       the next time CMINIR is called it will try for a rescaned command
   95       again.  The old value of RSCANF is returned. }
   96   
   97   {The following two procedures are used in making up tables of commands
   98    and switches.  Note that tables and their contents are stored in the
   99    heap.  So you can use MARK and RELEASE to release them.}
  100   function tbmak(size:integer):table;extern;
  101       {Issue this one first.  It allocates space for a table with the
  102        specified number of entries.  It returns a table pointer,
  103        which is used for the other functions that operate on tables.}
  104   procedure tbadd(t:table;value:integer;key:string;bits:integer);extern;
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1-2

  105       {Issue this once for each entry to go in the table.
  106   	T - the value return by the call to TBMAK that allocated the table.
  107   	VALUE - This is the value that will be returned when this entry
  108   		in the table is found.
  109   	KEY - This string is the name of the table entry.
  110   	BITS - as documented in the JSYS manual.  Normally zero.
  111        For example, one entry in a table of terminal types might be
  112   	tbadd( termtable, 6, 'I400', 0)
  113        This entry will be matched by the string 'I400' (or any unique
  114        abbreviation), and will return the value 6, presumably the internal
  115        code for the I400 terminal.}
  116     {WARNING:  You must issue these in reverse alphabetical order, i.e.
  117      the last entry in the table must be done first.  This may be a
  118      monitor bug.}
  119   
  120   {The following procedures are used to parse individual fields in a command.
  121    They should be issued in the same order that the user is expected to
  122    type the fields.}
  123   
  124   function cmkey(t:table):integer;extern;
  125      {Expects the user to type one of the keywords in the table.  It returns
  126       the value that was specified by TBADD when the keyword was put in the
  127       table.  E.g. if the user typed I400, this would return 6 if the
  128       table had the entry shown above.}
  129   
  130   function cmswi(t:table):integer;extern;
  131      {Similar to cmkey, except the table is of switches.  The slash should
  132       not be part of the name in the table.
  133   
  134       If the user ended the switch with a colon (i.e. you can
  135       expect a value after the switch), the negative of the value 
  136       normally returned will be returned.}
  137   
  138   procedure cmifi(var f:file);extern;
  139      {Expects the user to type an input file name.  The argument should
  140       be a Pascal file.  That file will be preset to use the file specified.
  141       E.g. if you say CMIFI(INPUT), you can then use RESET(INPUT) and INPUT
  142       will be open on the file that the user specified.  This function
  143       actually gets a jfn for the file specified by the user.  That jfn is
  144       then stored in the file's file control block.}
  145   
  146   procedure cmofi(var f:file);extern;
  147      {Expects an output file name.}
  148   
  149   procedure cmfil(var f:file);extern;
  150      {Expects a general file spec.  You must set up an extended gtjfn
  151       block appropriately to read the file spec.  This is done with
  152       the gjxxx procedures below.  At least gjgen must be used.}
  153   
  154   function cmnum:integer; extern;
  155      {Get a decimal number.}
  156   
  157   function cmnum8:integer; extern;
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1-3

  158      {Get an octal number.}
  159   
  160   function cmnux:integer; extern;
  161      {Get a decimal number, ends with any non-numeric}
  162   
  163   function cmnux8:integer; extern;
  164      {Get an octal number, ends with any non-numeric}
  165   
  166   function cmflt:real; extern;
  167      {Get a real number}
  168   
  169   procedure cmnoi(stuff:string);extern;
  170      {Puts out a noise word if the user types altmode.  Note that the
  171       parentheses are not part of the noise word.}
  172   
  173   procedure cmcfm; extern;
  174      {Expects the user to type a carriage return.  This would usually be
  175       the last call made for parsing a command.}
  176   
  177   procedure cmcma; extern;
  178      {Expects the user to type a comma.  If this is for an optional
  179       field, you should set CMAUTO(false) first, to prevent an error
  180       trap if there isn't one.}
  181   
  182   procedure cmtok(stuff:string);extern;
  183      {Expects the user to type that particular thing.  See cmcma.}
  184   
  185   procedure cmctok(c:char);extern;
  186      {like CMTOK, but takes a single character instead of a string.}
  187   
  188   function cmdir:integer; extern;
  189      {Expects a directory name: returns the 36-bit dir. number.  To
  190       see the text, use CMATOM.}
  191   
  192   function cmdirw:integer; extern;
  193      {as above, but allows wildcards}
  194   
  195   function cmusr:integer; extern;
  196      {Expects a user name:  returns a 36-bit user number.(CMATOM for text)}
  197   
  198   function cmdev:integer; extern;
  199      {Expects a device name:  returns a device designator (CMATOM for text)}
  200   
  201   {The following functions parse date and/or time.  We have the following
  202    method:
  203      TAD - both date and time       null - returns internal form
  204      T - time only		  N - puts unconverted form into a record
  205      D - date only}
  206   
  207   function cmtad:integer; extern;
  208   function cmt:integer; extern;
  209   function cmd:integer; extern;
  210   procedure cmtadn(var r:tadrec); extern;
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1-4

  211   procedure cmtn(var r:tadrec); extern;
  212   procedure cmdn(var r:tadrec); extern;
  213   
  214   {The following procedures all return strings where you specify, and
  215    a count indicating how many characters were actually seen.  Any
  216    extra characters in the destination array are filled with blanks.
  217    If there is not enough space, an error message is given and a
  218    reparse triggered.}
  219   
  220   function cmatom(var s:string):integer; extern;
  221      {This returns the contents of the "atom buffer".  It is useful when
  222       you want to see what the user actually typed for the last field.  It
  223       not cause any extra parsing, the data comes from the last field parsed.}
  224   
  225   function cmtext(var s:string):integer; extern;
  226       {This returns the contents of the "text" buffer.  This will have what
  227        has been parsed.  Useful for writting you own error handlers.}
  228   
  229   function cmfld(var s:string):integer; extern;
  230      {Field delimited by first non-alphanumeric}
  231   
  232   function cmtxt(var s:string):integer; extern;
  233      {To next end of line}
  234   
  235   function cmqst(var s:string):integer; extern;
  236      {String in double quotes.  Quotes not returned.}
  237   
  238   function cmuqs(var s: string; break_mask: brkmsk; var b: char):integer;
  239   extern;
  240      {Unquoted string.  NOTE: Do NOT use CMBRK to set the break mask for
  241       this function.  Use the second argument provided for that task.
  242       The third argument has the break character that was used returned in
  243       it.  This doesn't seem to work for some special characters (like escape)
  244       also you might want to set the CM%WKF bit in the comnd state block to
  245       cause a wakeup on each field while parsing.  See CMFIN procedure for
  246       how to do that.}
  247   
  248   function cmact(var s:string):integer; extern;
  249      {Account string.  Not verified for legality}
  250   
  251   function cmnod(var s:string):integer; extern;
  252      {network node name.  Not verified for legality}
  253   
  254   {The following procedures are used to set up the extended gtjfn block
  255    for cmfil.  They must be given before the cmfil call.  gjgen must 
  256    always be used, and must be the first one of these to be called, as
  257    it clears the rest of the block.  These procedures simply set the
  258    corresponding words in the gtjfn block, so see the jsys manual for
  259    details.}
  260   
  261   procedure gjgen(flags_and_generation:integer);extern;
  262   
  263   procedure gjdev(default_device:string);extern;
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1-5

  264   
  265   procedure gjdir(default_directory:string);extern;
  266   
  267   procedure gjnam(default_name:string);extern;
  268   
  269   procedure gjext(default_extension:string);extern;
  270   
  271   procedure gjpro(default_protectin:string);extern;
  272   
  273   procedure gjact(default_account:string);extern;
  274   
  275   procedure gjjfn(try_to_use_this_jfn:integer);extern;
  276   
  277   procedure gjf2(more_flags:bitset);extern;
  278   
  279   {The following procedures are only needed for more complex parsers.
  280    They allow one to turn off various of the features that are normally
  281    supplied by default.}
  282   
  283   procedure cmauto(useauto:Boolean);extern;
  284      {Turn on or off automatic error processing.  It is turned on by default.
  285   
  286       When automatic error processing is in effect, if the user does not
  287       type what is requested, an error message is issued and the prompt is
  288       reissued.  At that point he can either type a new command, or type
  289       ^H to have the old command repeated up to the point of the error.  
  290       Thus in the normal mode, the programmer does not need to worry about
  291       errors.  Reparsing is done until the user types something valid.
  292   
  293       When automatic error processing has been turned off, no automatic
  294       reparsing is done for errors.  Instead the procedure that was trying
  295       to read the field returns with a null value (if any).  The user is
  296       expected to check for errors with cmerr.  This is useful in the
  297       case where there are several valid responses.  For example suppose
  298       either a keyword or a file is valid.  Then you could do
  299         cmauto(false);  % turn off error handling \
  300         cmifi(input);
  301         if cmerr % wasn't a valid file \
  302           then key := cmkey(keytable);
  303       In general one should probably turn cmauto back on before trying
  304       the last alternative, so that a reparse is done if it isn't valid.
  305   
  306       Note that even with cmauto false, some automatic reparses are still
  307       done if the user backspaces into a previously parsed fields.  cmauto
  308       only controls what happens on a genuine error.
  309   
  310       cmini reinitializes cmauto to true.}
  311      
  312   function cmerr:Boolean; extern;
  313      {Returns true if the most recent parse call got an error.}
  314   
  315   procedure cmagain; extern;
  316      {Abort the current parse, reissue the prompt and try again.  If
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1-6

  317       cmauto is in effect, this is done automatically whenever there is
  318       an error.  Note that cmagain does not print an error message.
  319       It is assumed that if you want the normal error message, you will
  320       turn on cmauto and let everything happen automatically.}
  321   
  322   procedure cmuerr(s:string); extern;
  323      {Print ?, clear the input buffer, print the string supplied,
  324       and call cmagain.  This is equivalent to the usual error
  325       processing, but with a user-supplied error message.}
  326   
  327   procedure cmerrmsg; extern;
  328      {This prints the official error message from the last failure.
  329       This followed by cmagain is equivalent to the usual error processing.}
  330   
  331   function cmeof(trap: boolean):boolean; extern;
  332      {This function is used to trap end of file conditions detected by the
  333       COMND jsys.  If TRAP is TRUE then the next eof will cause a reparse
  334       (instead of an illegal instruction trap) and cmeof will return true
  335       to indicate that the eof has happened.  Use of this is as followes:
  336   	CMINI('prompt');
  337   	IF CMEOF(TRUE) THEN eof_code;
  338   	normal parsing stuff
  339   
  340       NOTE: Because a reparse is done when the error is seen, you should
  341       place the call to CMEOF just after your call to CMINI (or CMINIR)
  342       and before ANY CALLES TO OTHER PROCEDURES IN THIS PACKAGE.  If you
  343       fail to do this the program will go into an infinite loop. }
  344   
  345   function cmioj(newjfns: integer):integer; extern;
  346      {This function sets .CMIOJ of the COMND state block to NEWJFNS and
  347       returns the old value of that word.  This is useful for "pushing"
  348       the current JFNs.}
  349   
  350   procedure cmhlp(helptext:string); extern;
  351      {Used to supply your own help message when the user types ?.  The
  352       text given will be used for the next field parsed.  To supply a
  353       message taking up more than one line, just call cmhlp several
  354       times.  Each call will add a line to the message.  (Thus cmhlp
  355       is vaguely like writeln.)  Note that the help message stays in
  356       effect only for the next field parsed.}
  357   
  358   procedure cmdef(default:string); extern;
  359      {Used to supply a default value for the next field parsed.  This
  360       default stays in effect only for the next field.}
  361   
  362   function cmstat:integer; extern;
  363      {Returns the address of the COMND state block.  Don't write into
  364       unless you really know what you're doing.}
  365   
  366   procedure cmbrk(break_mask: brkmsk); extern;
  367      {Used to supply a break mask for use in parsing the next field.}
  368   
  369   procedure brini(var break_mask: brkmsk; w0, w1, w2, w3: integer); extern;
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1-7

  370      {Used to copy w0 through w3 into BREAK_MASK.  Hint use this an the
  371       predefined CONSTants (at the beginning of this file) to set up break
  372       masks.  For example to be able to parse keywords with ^ in them:
  373   
  374   	    brini(break,fldb0,fldb1,fldb2,flbd3);
  375   	    brmsk(break,'^','');
  376   	    ...
  377   	    cmbrk(break);
  378   	    which := cmkey(keyword_table);
  379       }
  380   
  381   procedure brmsk(var break_mask: brkmsk; allow, disallow: string); extern;
  382      {Use to make a break mask with the characters, ALLOW, allowed and
  383       DISALLOW, disallowed.}
  384   
  385   {In some cases you may want to allow a choice of several alternatives.
  386    To do this, issue CMMULT, to go into "multiple choice mode".  Once
  387    in this mode, issue CMxxx calls as usual.  Instead of being done
  388    immediately, these calls store away specifications of the legal
  389    alternatives.  For those that are functions, the values returned are
  390    garbage.  Once you have specified all the alternatives, call
  391    CMDO.  This returns an integer, 1..the number of alternatives,
  392    telling you which (if any) succeeded, 0 if none did.
  393   	For alternatives that return values, you can then do
  394    CMINT to get the returned value if it is an integer, or CMREAL if it
  395    is real.  Alternatives that return values in variables passed by
  396    reference will do so, using the variable passed when the original
  397    CMxxx was called.  (Needless to say, that variable has better still
  398    be accessible.)}
  399   
  400   procedure cmmult; extern;
  401     {Enter multiple choice mode.  All CMxxx procedures until the next
  402      CMDO are interpreted as specifications, rather than done immediately.}
  403   
  404   function cmdo:integer; extern;
  405     {Do a COMND jsys, specifying the alternatives stored up since the
  406      last CMMULT.  Returns a code indicating which succeeded, or 0 if
  407      none did.  Since the return value is used to indicate which
  408      alternative was found, there is a possible question:  how do we
  409      get the returned value, if there is one (i.e. if the alternative
  410      found is a Pascal function that returns some value)?  The answer
  411      to this is that the value returned is stored away internally
  412      and is available by CMINT or CMREAL, depending upon its type.
  413      Note that files and strings are returned through variables
  414      passed by reference.  They do not need this mechanism, since
  415      that will be set automatically.  (What happens is that the
  416      addresses of all reference variables are stored away when the
  417      alternative is first set up, and the appropriate one is set when
  418      we find out which alternative is actually there.)}
  419   
  420   function cmint:integer; extern;
  421     {Return a value from the last CMDO, if the alternative that succeeded
  422      was an integer}
PASCAL %14(331)  19-Dec-85     ANSIMT      ****Included File****     PAGE 1-8

  423   
  424   function cmreal:real; extern
  425     {Return a value from the last CMDO, if the alternative that succeeded
  426      was a real}
  427   
  428   
  429   .
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 1-2

Main file continued

   78   
   79   const
   80   	DEFBLKFAC = '1 ';
   81   	DEFRECLEN = '80';
   82    	DEFTABNO = '8 ';
   83   	MAXFNAME = 39;
   84   	MAXBLKLEN = 32760;  {IBM max}
   85   	MAXRECLEN = 2048;  {ANSI standard}
   86   	MAXSTR = 80;
   87   	MINRECLEN = 18;  {ANSI standard}
   88   
   89   	{pascmd parsing}
   90   	{-CmdTable}
   91   	DIR = 1;
   92   	DEF = 2;
   93   	EOT = 3;
   94   	XIT = 4;
   95   	SKIP = 5;
   96   	STORE = 6;
   97   	RESTORE = 7;
   98   	REWIND = 8;
   99   	TAPE = 9;
  100   	HELP = 11;
  101   	LASTCMD = 11;
  102   	{-Sw1Table}
  103   	S1BLOCK = 1;
  104   	S1NOPAD = 2;
  105   	S1RECLN = 3;
  106   	S1TABEV	= 4;
  107   	LASTSW1 = 4;
  108   	{-Sw2Table}
  109   	S2NOSTR = 5;
  110   	S2STRIP = 6;
  111   	LASTSW2 = 2;
  112   	{-Sw3Table, switches for directory command}
  113   	S3FULL = 1;
  114   	S3SHORT = 2;
  115   	LASTSW3 = 2;
  116   	{-DefTable, uses above switches}
  117   	DFWARN = 1;
  118   	DFTABEV = 2;
  119   	DFSTRIP = 3;
  120   	DFRECLN = 4;
  121   	DFNOSWI = 5;
  122   	DFBLOCK = 6;
  123   	LASTDEF = 6;
  124   	LASTNO = 3;  {no options}
  125   
  126   	{JSYS monitor calls}
  127   	GETER = 12B;  {returns most recent error condition}
  128   	OPENF = 21B;
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 1-3

  129   	CLOSEF = 22B;
  130   	JFNS = 30B;
  131   	MTOPR = 77B;
  132   
  133   	{ASCII in decimal}
  134   	NULL = 0;
  135   	TAB = 9;
  136   	LF = 10;  {linefeed}
  137   	CR = 13;  {carriage return}
  138   	BLANK = 32;
  139   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 2

    1   
    2   type
    3   	DevicesType = (DiskDev, TapeDev, TTYDev, ErrDev);
    4   	DesigType = (JFNDes, DevDes);
    5   	DirectoryType = (FullDir, ShortDir);
    6   	WordSetType = set of 0..35;  {represents a 36bit word}
    7   	DateStrType = packed array [1..9] of char;
    8   	StrType = packed array [1..MAXSTR] of char;
    9   	FNameType = packed array [1..MAXFNAME] of char;
   10   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 3

    1   
    2   var
    3   	device : integer;
    4   	command : integer;
    5   	FilesToSkip : integer;
    6   	OriginalDataMode : integer;
    7   	DefaultRecLen, DefaultBlkFac, DefaultTabNo : integer;
    8   	GlobalRecLen, GlobalBlkFac, GlobalTabNo : integer;
    9   	HoldRecLen, HoldBlkFac, HoldTabNo : integer;
   10   	ThatsIt : boolean;
   11   	GlobalPadTabs, DefaultPadTabs, HoldPadTabs : boolean;
   12   	GlobalWarning, DefaultWarning, HoldWarning : boolean;
   13   	GlobalStripBlanks, DefaultStripBlanks, HoldStripBlanks : boolean;
   14   	GlobalDirectory, DefaultDirectory, HoldDirectory : DirectoryType;
   15   	GlobalTapeFile, GlobalTape, HoldTape : FNameType;
   16   	GlobalDiskFile, GlobalDirStr : StrType;
   17   	CmdTable, DefTable, NoTable, Sw1Table, Sw2Table, Sw3Table: table;
   18   
   19   function curjfn(var f : file) : integer;  extern;
   20   
   21   function erstat(var f : file) : integer;  extern;
   22   
   23   procedure analysis(var f : file);  extern;
   24   
   25   procedure clreof(var f : file);  extern;
   26   
   27   procedure quit;  extern;
   28   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 4

    1   
    2   {  StrEnd  --  marks the end of string w/ a null character.  If	end    	}
    3   {  position, SEnd, is out of bounds then the end is not marked.		}
    4   procedure StrEnd(var s : packed array [i..j:integer] of char;SEnd : integer);
    5   var
    6   	pos : integer;
    7   begin
    8   	pos := SEnd - (i - 1);  {actual index in string}
    9    	if (pos >= i) and (pos <= j) then
   10   	    s[pos] := chr(NULL);
   11   end;  {of procedure StrEnd}
   12   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 5

    1   
    2   {  StrPos  --  returns the position of a character in a string.  0 is	}
    3   {  returned if the character is not found.				}
    4   function StrPos(var s : packed array [i..j:integer] of char;c : char) : integer;
    5   var
    6   	pos : integer;
    7   	found : boolean;
    8   begin
    9   	pos := i - 1;
   10   	StrPos := 0; found := false;
   11   	while (pos < j) and not found do begin
   12   	    pos := pos + 1;
   13   	    if (s[pos] = c) then begin
   14   		StrPos := pos;
   15   		found := true;
   16   	    end;  {of if}
   17   	end;  {of while}
   18   end;  {of function StrPos}
   19   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 6

    1   
    2   {  StrLen  --  returns the length of string s which is marked by the 	}
    3   {  null character							}
    4   function StrLen(var s : packed array [i..j:integer] of char) : integer;
    5   var
    6   	pos : integer;
    7   begin
    8   	pos := StrPos(s,chr(NULL));
    9   	if (pos <> 0) then
   10   	    StrLen := pos - 1
   11   	else
   12   	    StrLen := j - (i - 1); {length of array, s}
   13   end;  {of function StrLen}
   14   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 7

    1   
    2   {  itoc  --  converts integer n to char string in s[i]...		}
    3   function itoc(n : integer; var s : StrType ; i : integer) : integer;
    4   begin
    5   	if (n < 0) then begin
    6   	    s[i] := '-';
    7   	    itoc := itoc(-n,s,i+1);
    8   	end  {of if}
    9   	else begin
   10   	    if (n >= 10) then
   11   		i := itoc(n div 10,s,i);
   12   	    s[i] := chr(n mod 10 + ord('0'));
   13   	    StrEnd(s,i+1);
   14   	    itoc := i + 1;
   15   	end;  {else}
   16   end;  {of function itoc}
   17   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 8

    1   
    2   {  ctoi  --  convert char string at s[i] to integer             	}
    3   function ctoi(s : packed array [SMin..SMax : integer] of char;
    4                 i : integer) : integer;
    5   var
    6   	n, sign : integer;
    7   begin
    8   	while (s[i] = ' ') or (s[i] = chr(TAB)) do
    9   	    i := i + 1;
   10   	if (s[i] = '-') then  {minus sign}
   11   	    sign := -1
   12   	else
   13   	    sign := 1;
   14   	if (s[i] = chr(ord('+'))) or (s[i] = chr(ord('-'))) then
   15   	    i := i + 1;
   16   	n := 0;
   17   	while (i <= SMax) do
   18   	    if (s[i] in ['0'..'9']) then begin
   19   	        n := 10 * n + (ord(s[i]) - ord('0'));
   20   	        i := i + 1;
   21   	    end  {of if}
   22   	    else
   23   		i := SMax + 1;  {force out}
   24   	ctoi := sign * n;
   25   end;  {of function ctoi}
   26   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 9

    1   
    2   {  scopy  --  copy string at src[i] to dest[j]				}
    3   procedure scopy(    src : packed array [SMin..SMax : integer] of char;
    4                       i : integer;
    5                   var dest : packed array [DMin..DMax : integer] of char;
    6                       j : integer);
    7   begin
    8   	while (i <= SMax) and (j <= DMax) do
    9   	    if (src[i] <> chr(NULL)) then begin
   10   		dest[j] := src[i];
   11   		i := i + 1;
   12   		j := j + 1;
   13   	    end
   14   	    else  {force it to stop if hits the end of string}
   15   		i := SMax + 1;  {end the while loop}
   16   
   17   	if (j <= DMax) then
   18   	    StrEnd(dest,j);
   19   end;  {of procedure scopy}
   20   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 10

    1   
    2   {  InToStrDate  --  converts a date i in internal format to a string	}
    3   {  of 9 chars in DD-Mmm-YY format					}
    4   procedure InToStrDate(i : integer;var str : DateStrType);
    5   const
    6   	ODTIM = 220B;
    7   begin
    8   	jsys(ODTIM;str,i,000400000000B);
    9   end;  {of procedure InToStrDate}
   10   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 11

    1   
    2   {  TabPos  --  return true if col is a tab stop				}
    3   function TabPos(col : integer) : boolean;
    4   begin
    5   	if (col > MAXRECLEN) then
    6   	    TabPos := true
    7   	else
    8   	    TabPos := (col mod GlobalTabNo = 1);
    9   end;  {of function TabPos}
   10   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 12

    1   
    2   {  ErrorMess  --  prints the last error in the buffer than goes back	}
    3   {  for a reparse							}
    4   procedure ErrorMess;
    5   begin
    6   	    cmerrmsg;  {print official error message}
    7   	    cmagain;  {reissue prompt}
    8   end;  {of procedure ErrorMess}
    9   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 13

    1   
    2   {  WarnMess  --  prints the given string as an official warning message	}
    3   {  (beginning w/ an '%')						}
    4   procedure WarnMess(s : packed array [i..j : integer] of char);
    5   begin
    6   	if DefaultWarning then
    7   	    writeln(tty,'%',s:StrLen(s));
    8   end;  {of procedure WarnMess}
    9   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 14

    1   
    2   {  ClearDataError  --  if the device has a data error it is cleared	}
    3   procedure ClearDataError(var f : file);
    4   const
    5   	GDSTS = 145B;  {device status}
    6   	SDSTS = 146B;  {sets device status}
    7   	INCORRECT_RECLN = 23;
    8   var
    9   	StatusBits, DummyBits : WordSetType;
   10   	i : integer;
   11   begin
   12   	jsys(GDSTS;0:f;DummyBits,StatusBits);
   13   	if (INCORRECT_RECLN in StatusBits) then begin  {data error}
   14   	    StatusBits := StatusBits - [INCORRECT_RECLN];
   15    	    jsys(SDSTS;0:f,StatusBits);
   16   	end;  {of if}
   17   end;  {of procedure ClearDataError}
   18   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 15

    1   
    2   {  FileOpen  --  returns true if file is open				}
    3   function FileOpen(var f : file) : boolean;
    4   const
    5   	GTSTS = 24B;  {file status}
    6   	FILE_IS_OPEN = 0;
    7   var
    8   	StatusBits, DummyBits : WordSetType;
    9   begin
   10   	jsys(GTSTS;0:f;DummyBits,StatusBits);
   11   	if (FILE_IS_OPEN in StatusBits) then
   12   	    FileOpen := true
   13   	else
   14   	    FileOpen := false;
   15   end;  {of function FileOpen}
   16   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 16

    1   
    2   function OpenInputFile(dev : DevicesType) : boolean;
    3   var
    4   	FileSpec : StrType;
    5   begin
    6   	if (dev = DiskDev) then
    7   	    reset(input,'','/e/o')
    8   	else if (dev = TTYDev) then begin
    9               jsys(JFNS;FileSpec,0:input,0);
   10   	    reset(input,'','/e/o/i');
   11   	end;  {of else if}
   12   	if (erstat(input) <> 0) then begin
   13   	    analysis(input);
   14   	    if (dev = TapeDev) then
   15   		if FileOpen(input) then
   16   		    ClearDataError(input);
   17   	    if FileOpen(input) then
   18   		close(input);
   19   	    OpenInputFile := false;
   20    	end  {of if}
   21   	else
   22   	    OpenInputFile := true;
   23   end;  {of function OpenInputFile}
   24   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 17

    1   
    2   function OpenInputTape : boolean;
    3   const
    4   	DATAERR = 600221B;
    5   	BIGREC = 601240B;
    6   var
    7   	message : StrType;
    8   begin
    9   	reset(input,'','/d/o/m:7');
   10   	if (erstat(input) <> 0) then begin
   11    	    if (erstat(input) = DATAERR) or (erstat(input) = BIGREC) then begin
   12   		jsys(JFNs;message,0:input,0);
   13   		scopy(' not able to be restored',1,message,StrLen(message)+1);
   14   		WarnMess(message);
   15   		if FileOpen(input) then
   16   		    ClearDataError(input);
   17   		if FileOpen(input) then  {if it is still open}
   18   		    close(input);
   19   		OpenInputTape := False;
   20   	    end  {of if}
   21   	    else begin
   22   		analysis(input);
   23   		if FileOpen(input) then
   24   		    ClearDataError(input);
   25   		if FileOpen(input) then  {if it is still open}
   26   		    close(input);
   27   		OpenInputTape := False;
   28   	        cmagain;
   29   	    end  {of else}
   30   	end  {of if}
   31   	else
   32   	    OpenInputTape := True;
   33   end;  {of procedure OpenInputTape}
   34   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 18

    1   
    2   function OpenOutputDisk : boolean;
    3   begin
    4   	rewrite(output,GlobalDiskFile,'/o');
    5   	if (erstat(output) <> 0) then begin
    6    	    analysis(output);
    7   	    OpenOutputDisk := false;
    8    	end  {of if}
    9   	else
   10   	    OpenOutputDisk := true;
   11   end;  {of function OpenOutputDisk}
   12   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 19

    1   
    2   function OpenOutputTape(var TapeFile : FNameType) : boolean;
    3   const
    4   	TFORM = ';FOR:F';  {tape format, always fixed}
    5   	TRECL = ';REC:';  {tape rec length}
    6   	TBLKS = ';BLO:';  {tape block size}
    7   	TOPTIONS = '/B:8/O';
    8   var
    9   	i : integer;
   10   	FileSpec : StrType;
   11   begin
   12   	scopy(TapeFile,1,FileSpec,1);
   13           scopy(TFORM,1,FileSpec,StrLen(FileSpec)+1);
   14   	scopy(TRECL,1,FileSpec,StrLen(FileSpec)+1);
   15   	i := itoc(GlobalRecLen,FileSpec,StrLen(FileSpec)+1);
   16   	scopy(TBLKS,1,FileSpec,StrLen(FileSpec)+1);
   17   	i := itoc(GlobalBlkFac*GlobalRecLen,FileSpec,StrLen(FileSpec)+1);
   18   	rewrite(output,FileSpec,TOPTIONS);
   19   	if (erstat(output) <> 0) then begin
   20    	    analysis(output);
   21   	    write(tty,'     - "',FileSpec:StrLen(FileSpec),'"');
   22   	    OpenOutputTape := false;
   23    	end  {of if}
   24   	else
   25   	    OpenOutputTape := true;
   26   end;  {of function OpenOutputTape}
   27   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 20

    1   
    2   {  KindOfDevice  --  returns the what kind of device is associated w/	}
    3   {  the file.								}
    4   function KindOfDevice(des : integer;TypeOfCall : DesigType) : DevicesType;
    5   const
    6   	DVCHR = 117B;
    7   var
    8   	ac1, ac2, TypeOfDev : WordSetType;
    9   begin
   10   	case TypeOfCall of
   11   	    JFNDes : jsys(DVCHR;0:des;ac1,ac2);	 {call using file JFN}
   12   	    DevDes : jsys(DVCHR;des;ac1,ac2);  {call using dev designator}
   13   	end;  {of case des}
   14   	TypeOfDev := ac2 and [9..17];  {mask the dev type bits}
   15   	if (TypeOfDev = []) then  {disk file}
   16   	    KindOfDevice := DiskDev
   17   	else if (TypeOfDev = [14,16]) then  {tty}
   18   	    KindOfDevice := TTYDev
   19   	else if (TypeOfDev = [16]) then  {tape file}
   20   	    KindOfDevice := TapeDev
   21   	else
   22   	    KindOfDevice := ErrDev;
   23   end;  {of function KindOfDevice}
   24   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 21

    1   
    2   {  space  --  spaces n number of blanks to the terminal.		}
    3   procedure space(n : integer);
    4   begin
    5   	for n := n downto 1 do
    6   	    write(tty,' ');
    7   end;  {of procedure space}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 22

    1   
    2   {  GarbageErr  --  outputs to dev tty: garbage that was entered as	}
    3   {  part of the command.							}
    4   procedure GarbageErr(mess : packed array [i..j:integer] of char;
    5   	             garb : packed array [k..l:integer] of char);
    6   var
    7   	MessLen : integer;
    8   begin
    9   	writeln(tty);
   10   	write(tty,'? ',mess:StrLen(mess));
   11   	write(tty,' - ');
   12   	write(tty,garb:StrLen(garb));
   13   	writeln(tty);
   14   	cmagain;
   15   end;  {of procedure GarbageErr}
   16   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 23

    1   
    2   {  GetJobDataMode  --  uses jsys GETJI and returns the default magtape	}
    3   {  data mode of the current job						}
    4   function GetJobDataMode : integer;
    5   const
    6   	GETJI = 507B;
    7   var
    8   	return : integer;
    9   	p : ^integer;
   10   begin
   11   	new(p);
   12   	jsys(GETJI,2,return;-1,-1:p,14B);
   13   	if (return = 1) then
   14   	    ErrorMess
   15   	else
   16   	    GetJobDataMode := p^;
   17   end;  {of function GetJobDataMode}
   18   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 24

    1   
    2   {  SetJobDataMode  --  sets data mode of the current job		}
    3   procedure SetJobDataMode(DataMode : integer);
    4   const
    5   	SETJB = 541B;  {sets job para for the specified job}
    6   	SJDM = 2B;  {func of SETJB to set def mt data mode}
    7   	CURRENT_JOB = -1;
    8   begin
    9   	jsys(SETJB;CURRENT_JOB,SJDM,DataMode);
   10   end;  {of procedure SetJobDataMode}
   11   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 25

    1   
    2   {  DirHeading  --  prints the heading for the tape directory		}
    3   procedure DirHeading;
    4   begin
    5   	{1st line}
    6   	space(33);
    7   	write(tty,'RECORD');
    8   	space(1);
    9   	write(tty,'BLOCK');
   10   	space(3);
   11   	if (GlobalDirectory = FullDir) then begin
   12   	    space(1);
   13   	    write(tty,'# OF');
   14   	    space(2);
   15   	    write(tty,'EST.');
   16   	    space(2);
   17   	end;  {of if}
   18   	space(1);
   19   	write(tty,'CREATE');
   20   	space(4);
   21   	write(tty,'EXPIRE');
   22   	writeln(tty);
   23   	{2nd line}
   24   	write(tty,'SEQ#');
   25   	space(6);
   26   	write(tty,'FILE NAME');
   27   	space(5);
   28   	write(tty,'VOLID');
   29   	space(2);
   30   	write(tty,'F');
   31   	space(1);
   32   	write(tty,'LENGTH');
   33   	space(1);
   34   	write(tty,'FACTOR');
   35   	space(2);
   36   	if (GlobalDirectory = FullDir) then begin
   37   	    space(1);
   38   	    write(tty,'RECS.');
   39   	    space(1);
   40   	    write(tty,'PAGES');
   41   	    space(1);
   42   	end;  {of if}
   43   	space(2);
   44   	write(tty,'DATE');
   45   	space(6);
   46   	write(tty,'DATE');
   47   	writeln(tty);
   48   	{3rd line}
   49   	writeln(tty);
   50   end;  {of procedure DirHeading}
   51   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 26

    1   
    2   {  GetDeviceJFN  --  gets the jfn for the defined tape divice		}
    3   procedure GetDeviceJFN;
    4   const
    5   	SGTJFN = 20B;  {short form GTJFN}
    6   var
    7   	DevStore, return : integer;
    8   	DevStr : FNameType;
    9   begin
   10   	DevStr := GlobalTape;
   11   	DevStr[StrLen(DevStr)+1] := ':';  {put a ':' at the end of string}
   12   	StrEnd(DevStr,StrPos(DevStr,':')+1);
   13   	jsys(SGTJFN, 3, return;100001b:0, DevStr;DevStore);
   14   	if (return = 1) then
   15   	    ErrorMess;
   16    	device := DevStore;
   17   end;  {of procedure GetDeviceJFN}
   18   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 27

    1   
    2   {  TapeInfo  --  calls MTOPR to find information about the current	}
    3   {  tape device								}
    4   function TapeInfo(InfoNo : integer) : integer;
    5   const
    6   	MOINF = 25B;
    7   	MAXINFO = 15B;
    8   type
    9   	ArgBlkType = packed array [0..MAXINFO] of integer;
   10   var
   11   	ArgPtr : ^ArgBlkType;
   12   begin
   13   	new(ArgPtr);
   14   	ArgPtr^[0] := MAXINFO;
   15   	GetDeviceJFN;
   16   	jsys(MTOPR;0:device, MOINF, ArgPtr);
   17   	TapeInfo := ArgPtr^[InfoNo];
   18   end;  {of function TapeInfo}
   19   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 28

    1   
    2   {  TapeStatus  --  returns status bits for user io			}
    3   procedure TapeStatus(var accum2 : WordSetType);
    4   const
    5   	GDSTS = 145B;
    6   var
    7   	accum1, return : integer;
    8   begin
    9   	GetDeviceJFN;
   10           jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
   11   	if (return = 1) then
   12   	    ErrorMess;
   13   	jsys(GDSTS;0:device;accum1, accum2);
   14   	jsys(CLOSEF, 2, return;001000:device);
   15   	if (return = 1) then
   16   	    ErrorMess;
   17   end;  {of procedure TapeStatus}
   18   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 29

    1   
    2   {  BeginningOfTape  --  returns true if tape is at bot			}
    3   function BeginningOfTape : boolean;
    4   const
    5   	BOTBIT = 24;
    6   var
    7   	StatBits : WordSetType;
    8   begin
    9   	TapeStatus(StatBits);
   10   	if (BOTBIT in StatBits) then
   11   	    BeginningOfTape := true
   12   	else
   13   	    BeginningOfTape := false;
   14   end;  {of function BeginningOfTape}
   15   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 30

    1   
    2   {  TapeFileInfo  --  prints out tape file info.  If the SeqNo passed	}
    3   {  is negative then the no. of records and the estimated pages are	}
    4   {  suppressed in the /FULL switch					}
    5   procedure TapeFileInfo(SeqNo : integer);
    6   const
    7   	MORLI = 50B;
    8   	ARGS = 15B;
    9   	UNDEFINED = 'U';  {undefined record format}
   10   type
   11   	BitsAndPtrType = record
   12   	    case boolean of
   13   		true : (ptr : ^FNameType);
   14   		false: (bits : WordSetType)
   15   	end;
   16   	ArgBlkType = record
   17   	    ArgWords : integer;
   18   	    TypeOfLabel : integer;
   19   	    p1 : ^FNameType;
   20   	    p2 : ^FNameType;
   21   	    TapeFormat : integer;
   22   	    RecLen : integer;
   23   	    BlkLen : integer;
   24   	    CreateDate : integer;
   25   	    ExpireDate : integer;
   26   	    p3 : ^FNameType;
   27   	    generation : integer;
   28   	    version : integer;
   29   	    ModeVal : integer;
   30   	end;  {of record}
   31   var
   32   	i : integer;
   33   	BadRead : boolean;  {record is unreadable}
   34   	VolName, OwnName, FilName : BitsAndPtrType;
   35   	DateStr : DateStrType;
   36   	ArgBlkPtr : ^ArgBlkType;
   37   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 31

    1   
    2   {  FullInformation  --  prints the record length and est. pages info	}
    3   {  for tape files							}
    4   procedure FullInformation(RecLen : integer);
    5   var
    6   	nl, EstPages : integer;
    7   begin
    8   	nl := 0;
    9   	while not eof do begin  {count # of lines}
   10   	    readln;
   11   	    nl := nl + 1;
   12   	end;  {of while}
   13   	{calculate estimated pages}
   14   	if ((RecLen * nl) mod (512 * 5) = 0) then
   15   	    EstPages := (RecLen * nl) div (512 * 5)
   16   	else
   17   	    EstPages := ((RecLen * nl) div (512 * 5)) + 1;  {add a page}
   18   	write(tty,nl:6);
   19   	space(1);
   20   	write(tty,EstPages:5);
   21   	space(1);
   22   end;  {of procedure FullInformation}
   23   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 32

    1   
    2   begin
    3   	if (SeqNo < 0) then begin
    4   	    BadRead := true;
    5   	    SeqNo := -SeqNo;  {set back to positive}
    6   	end
    7   	else
    8   	    BadRead := false;
    9   	new(ArgBlkPtr);
   10   	with ArgBlkPtr^ do begin
   11   	    ArgWords := ARGS;
   12   	    new(VolName.ptr);
   13   	    VolName.bits := VolName.bits or [0..17];
   14   	    p1 := VolName.ptr;
   15   	    new(OwnName.ptr);
   16   	    OwnName.bits := OwnName.bits or [0..17];
   17   	    p2 := OwnName.ptr;
   18   	    new(FilName.ptr);
   19   	    FilName.bits := FilName.bits or [0..17];
   20   	    p3 := FilName.ptr;
   21   	    jsys(MTOPR;0:input,MORLI,ArgBlkPtr);
   22   	    {formatted output to tty}
   23   	    write(tty,SeqNo:4);
   24   	    space(2);
   25   	    write(tty,FilName.ptr^:StrLen(FilName.ptr^));
   26   	    space(17-StrLen(FilName.ptr^));
   27   	    space(1);
   28   	    write(tty,VolName.ptr^:StrLen(VolName.ptr^));
   29   	    space(6-StrLen(VolName.ptr^));
   30   	    space(1);
   31   	    write(tty,chr(TapeFormat):1);
   32   	    space(2);
   33   	    if (chr(TapeFormat) = UNDEFINED) then begin
   34   		if (RecLen = 0) then  {no such thing as rec len 0}
   35   		    RecLen := 1;
   36   		write(tty,BlkLen:5);  {actually prints as Rec Len}
   37   		space(2);
   38   		write(tty,RecLen:5);
   39   	    end  {of if}
   40   	    else begin
   41   	        write(tty,RecLen:5);
   42   	        space(2);
   43   	        write(tty,(BlkLen div RecLen):5);
   44   	    end;  {of else}
   45   	    space(2);
   46   	    if (GlobalDirectory = FullDir) then
   47   		if BadRead then	 {cannot read records}
   48   		    write(tty,'    --    -- ')  {fill in info}
   49   		else
   50   		    FullInformation(RecLen);
   51   	    InToStrDate(CreateDate,DateStr);
   52   	    write(tty,DateStr:9);
   53   	    space(1);
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 32-1

   54   	    if (ExpireDate = -1) then
   55   		write(tty,' Invalid ')
   56   	    else begin
   57   		InToStrDate(ExpireDate,DateStr);
   58   		write(tty,DateStr:9);
   59   	    end;  {of else}
   60   	    writeln(tty);
   61   	end;  {of with}
   62   	{get rid of junk}
   63   	dispose(ArgBlkPtr);
   64   	dispose(VolName.ptr);
   65   	dispose(OwnName.ptr);
   66   	dispose(FilName.ptr);
   67   end;  {of procedure TapeFileInfo}
   68   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 33

    1   
    2   {  TrapEOT  --  returns true if defined device is at end of tape	}
    3   function TrapEOT : boolean;
    4   const
    5   	LOGEOT = 602240B;  {logical eot encountered}
    6   type
    7   	IOrBType = record
    8   	    case boolean of
    9   		true : (int : integer);
   10   		false: (bits : WordSetType)
   11   	end;  {of record}
   12   var
   13   	ac1, ac2 : integer;
   14   	Ac2Store : IOrBType;
   15   begin
   16   	jsys(GETER;400000B;ac1,ac2);
   17   	with Ac2Store do begin
   18   	    int := ac2;
   19   	    bits := (bits and [18..35]);  {clear 1st half}
   20   	    if (int = LOGEOT) then
   21   		TrapEOT := true
   22   	    else
   23   		TrapEOT := false;
   24   	end;  {of with}
   25   end;  {of function TrapEOT}
   26   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 34

    1   
    2   {  ForwardFile  --  calls mtopr to skip forward 1 logical file		}
    3   procedure ForwardFile;
    4   const
    5   	MOFWF = 16B;
    6   var
    7   	return : integer;
    8   begin
    9   	GetDeviceJFN;
   10           jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
   11   	if (return = 1) then
   12   	    ErrorMess;
   13     	jsys(MTOPR,-2,return;0:device, MOFWF);
   14   	if (return = 3) then begin
   15   	    cmerrmsg;  {print official error message}
   16   	    jsys(CLOSEF, 2, return;001000:device);
   17   	    if (return = 1) then
   18   	        cmerrmsg;
   19   	    cmagain;
   20   	end  {of begin}
   21   	else begin
   22   	    jsys(CLOSEF,2,return;001000:device);
   23   	    if (return = 1) then
   24   		ErrorMess;
   25   	end;  {of begin}
   26   end;  {of procedure ForwardFile}
   27   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 35

    1   
    2   {  BackwardFile  --  calls mtopr to skip backward 1 logical file	}
    3   procedure BackwardFile;
    4   const
    5   	MOBKF = 17B;
    6   var
    7   	return : integer;
    8   begin
    9   	GetDeviceJFN;
   10           jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
   11   	if (return = 1) then
   12   	    ErrorMess;
   13     	jsys(MTOPR;0:device, MOBKF);
   14   	jsys(CLOSEF,2,return;001000:device);
   15   	if (return = 1) then
   16   	    ErrorMess;
   17   end;  {of procedure BackwardFile}
   18   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 36

    1   
    2   {  RewindTape  --  rewinds tape to bot					}
    3   procedure RewindTape;
    4   const
    5   	MOREW = 1;
    6   var
    7   	return : integer;
    8   begin
    9   	GetDeviceJFN;
   10           jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
   11   	if (return = 1) then
   12   	    ErrorMess;
   13   	jsys(MTOPR;0:device, MOREW);
   14   	jsys(CLOSEF, 2, return;001000:device);
   15   	if (return = 1) then
   16   	    ErrorMess;
   17   end;  {of procedure RewindTape}
   18   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 37

    1   
    2   {  CheckIfTapeAssigned  --  check if user issued tape command to	}
    3   {  define a tape device, if not reparse					}
    4   procedure CheckIfTapeAssigned;
    5   begin
    6   	if (StrLen(GlobalTape) = 0) then
    7   	    cmuerr('Tape device not defined, use TAPE command to define device')
    8   end;  {of CheckIfTapeAssigned}
    9   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 38

    1   
    2   {  InitTables  --  initializes pascmd tables to be used for parsing	}
    3   procedure InitTables;
    4   begin
    5   	CmdTable := tbmak(LASTCMD);
    6   	tbadd(CmdTable,TAPE,'TAPE',0);
    7   	tbadd(CmdTable,REWIND,'REWIND',0);
    8   	tbadd(CmdTable,RESTORE,'RESTORE',0);
    9   	tbadd(CmdTable,STORE,'STORE',0);
   10   	tbadd(CmdTable,SKIP,'SKIP',0);
   11   	tbadd(CmdTable,HELP,'HELP',0);
   12   	tbadd(CmdTable,XIT,'EXIT',0);
   13   	tbadd(CmdTable,EOT,'EOT',0);
   14   	tbadd(CmdTable,DIR,'DIRECTORY',0);
   15   	tbadd(CmdTable,DEF,'DEFAULT',0);
   16   
   17   	Sw1Table := tbmak(LASTSW1);
   18   	tbadd(Sw1Table,S1BLOCK,'BLOCKING-FACTOR:',0);
   19   	tbadd(Sw1Table,S1NOPAD,'NO-PAD-TABS',0);
   20   	tbadd(Sw1Table,S1TABEV,'PAD-TABS:',0);
   21   	tbadd(Sw1Table,S1RECLN,'RECORD-LENGTH:',0);
   22   
   23   	Sw2Table := tbmak(LASTSW2);
   24   	tbadd(Sw2Table,S2STRIP,'STRIP-BLANKS',0);
   25   	tbadd(Sw2Table,S2NOSTR,'NO-STRIP-BLANKS',0);
   26   
   27   	Sw3Table := tbmak(LASTSW3);
   28   	tbadd(Sw3Table,S3SHORT,'SHORT',0);
   29   	tbadd(Sw3Table,S3FULL,'FULL',0);
   30   
   31   	DefTable := tbmak(LASTDEF);
   32   	tbadd(DefTable,DFWARN,'WARNING-MESSAGES',0);
   33   	tbadd(DefTable,DFTABEV,'TABS-EVERY',0);
   34   	tbadd(DefTable,DFSTRIP,'STRIP-BLANKS',0);
   35   	tbadd(DefTable,DFRECLN,'RECORD-LENGTH',0);
   36   	tbadd(DefTable,DFNOSWI,'NO',0);
   37   	tbadd(DefTable,DFBLOCK,'BLOCKING-FACTOR',0);
   38   
   39   	NoTable := tbmak(LASTNO);
   40   	tbadd(NoTable,DFWARN,'WARNING-MESSAGES',0);
   41   	tbadd(NoTable,DFTABEV,'TABS-EVERY',0);
   42   	tbadd(NoTable,DFSTRIP,'STRIP-BLANKS',0);
   43   end;  {of procedure InitTables}
   44   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 39

    1   
    2   {  DefaultTapeName  --  returns the default name and extent from the    }
    3   {  inputted disk name.  Tape file names must be 17 chars or less     	}
    4   {  including the '.' so in certain cases it must be shortened		}
    5   procedure DefaultTapeName(var name,ext : FNameType);
    6   const
    7   	MAXTNAME = 17;
    8   var
    9   	NameLen, ExtLen : integer;
   10   
   11   begin
   12   	jsys(JFNS;name,0:input,001000000000B);
   13   	NameLen := StrLen(name);
   14   	jsys(JFNS;ext,0:input,000100000000B);
   15   	ExtLen := StrLen(ext);
   16   	{check if name is too long}
   17    	if (ExtLen > 0) and (NameLen + 1 + ExtLen > MAXTNAME) then begin
   18   	    if (ExtLen > 10) then
   19   		ExtLen := 10;  {leave at least 6 chars for name}
   20   	    NameLen := MAXTNAME - ExtLen - 1;
   21   	end;  {of if}
   22   	StrEnd(name,NameLen+1);
   23   	StrEnd(ext,ExtLen+1);
   24   end;  {of procedure DefaultTapeName}
   25   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 40

    1   
    2   {  ListFiles  --  prints the source and destination filenames		}
    3   procedure ListFiles;
    4   var
    5   	source, dest : FNameType;
    6   begin
    7           jsys(JFNS;source,0:input,221110000001B);
    8   	jsys(JFNS;dest,0:output,221110000001B);
    9   	space(2);
   10   	writeln(tty,source:StrLen(source),' => ',dest:StrLen(dest));
   11   end;  {of procedure ListFile}
   12   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 41

    1   
    2   {  DefaultDiskFile  --  Creates a diskfile name depending on the name	}
    3   {  of the input tape name and the directory to output to		}
    4   procedure DefaultDiskFile;
    5   var
    6   	FileName : FNameType;
    7   begin
    8   	GlobalDiskFile := GlobalDirStr;
    9   	jsys(JFNS;FileName,0:input,001100000001B);
   10   	scopy(FileName,1,GlobalDiskFile,StrLen(GlobalDiskFile)+1);
   11   end;  {procedure DefaultDiskFile}
   12   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 42

    1   
    2   {  DefaultTapeFile  --	Takes the disk source file and turns it into	}
    3   {  a valid tape file and stores it into GlobalTapeFile.			}
    4   procedure DefaultTapeFile;
    5   var
    6   	Tname,Text : FNameType;
    7   begin
    8   	DefaultTapeName(Tname,Text);
    9   	GlobalTapeFile := GlobalTape;
   10   	GlobalTapeFile[StrLen(GlobalTapeFile)+1] := ':';
   11   	StrEnd(GlobalTapeFile,StrPos(GlobalTapeFile,':')+1);
   12   	scopy(Tname,1,GlobalTapeFile,StrLen(GlobalTapeFile)+1);
   13   	GlobalTapeFile[StrLen(GlobalTapeFile)+1] := '.';
   14   	StrEnd(GlobalTapeFile,StrPos(GlobalTapeFile,'.')+1);
   15   	scopy(Text,1,GlobalTapeFile,StrLen(GlobalTapeFile)+1);
   16   end;  {of procedure DefaultTapeFile}
   17   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 43

    1   
    2   {  ListRecordCount  --  lists the number of records read or written	}
    3   {  from or into a file							}
    4   procedure ListRecordCount(n : integer);
    5   begin
    6   	space(4);
    7   	writeln(tty,'[',n:1,' records]');
    8   end;  {of procedure ListRecordCount}
    9   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 44

    1   
    2   {  TruncMess  --  prints a message saying what line was truncated and	}
    3   {  by how much								}
    4   procedure TruncMess(line, col : integer);
    5   begin
    6   	jsys(JFNS;101B, 0:input, 0);
    7   	write(tty, ' - line ', line:1, ' : ', col:1,
    8   		   ' characters long, truncated to ', GlobalRecLen:1);
    9   	writeln(tty);
   10   end;  {of procedure TruncMess}
   11   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 45

    1   
    2   {  SwitchRecLenSw1  --  parses the record-length switch option for the	}
    3   {  store command							}
    4   procedure SwitchRecLenSw1;
    5   var
    6   	i, RecLen : integer;
    7   	HelpMess, ErrMess : StrType;
    8   begin
    9   	scopy('integer between 1 and ',1,HelpMess,1);
   10   	i := itoc(MAXRECLEN,HelpMess,StrLen(HelpMess)+1);
   11   	cmhlp(HelpMess);
   12   	cmdef(DEFRECLEN);
   13   	RecLen := cmnum;  {get an integer}
   14   	if (RecLen < MINRECLEN) or (RecLen > MAXRECLEN) then begin
   15   	    scopy('Record length must be between ',1,ErrMess,1);
   16   	    i := itoc(MINRECLEN,ErrMess,StrLen(ErrMess)+1);
   17   	    scopy(' and ',1,Errmess,StrLen(ErrMess)+1);
   18   	    i := itoc(MAXRECLEN,ErrMess,StrLen(ErrMess)+1);
   19   	    cmuerr(ErrMess);
   20   	end;  {of if}
   21   	if ((RecLen * HoldBlkFac) > MAXBLKLEN) then begin
   22   	    scopy
   23                 ('Record length too large with blocking factor of ',1,ErrMess,1);
   24   	    i := itoc(HoldBlkFac,ErrMess,StrLen(ErrMess)+1);
   25   	    cmuerr(ErrMess);
   26   	end;  {of if}
   27   	HoldRecLen := RecLen;  {set global variable}
   28   end;  {of procedure SwitchRecLenSw1}
   29   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 46

    1   
    2   {  SwitchNoPadSw1  --  parses the no-pad-tabs switch option for the	}
    3   {  store command							}
    4   procedure SwitchNoPadSw1;
    5   begin
    6   	HoldPadTabs := false;
    7   end;  {of procedure SwitchNoPadSw1}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 47

    1   
    2   {  SwitchBlockSw1  --  parses the records-per-block switch option for	}
    3   {  the store command							}
    4   procedure SwitchBlockSw1;
    5   var
    6   	i, BlkFac : integer;
    7   	HelpMess, ErrMess : StrType;
    8   begin
    9   	cmhlp('number of records per block');
   10   	cmdef(DEFBLKFAC);
   11   	BlkFac := cmnum;  {get and integer}
   12   	if (BlkFac = 0) then	 {0 same as 1}
   13   	    BlkFac := 1;
   14   	if (BlkFac < 1) or (BlkFac > MAXBLKLEN) then begin
   15   	    scopy('Blocking factor must be between 1 and ',1,ErrMess,1);
   16   	    i := itoc(MAXBLKLEN,ErrMess,StrLen(ErrMess)+1);
   17   	    cmuerr(ErrMess);
   18   	end;  {of if}
   19   	if ((BlkFac * HoldRecLen) > MAXBLKLEN) then begin
   20   	    scopy
   21                 ('Blocking factor too large with record length of ',1,ErrMess,1);
   22   	    i := itoc(HoldRecLen,ErrMess,StrLen(ErrMess)+1);
   23   	    cmuerr(ErrMess);
   24   	end;  {of if}
   25   	HoldBlkFac := BlkFac;  {set global variable}
   26   end;  {of procedure SwitchBlockSw1}
   27   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 48

    1   
    2   {  SwitchSetTabsSw1  --  parses the tabs-every switch option for the	}
    3   {  store command							}
    4   procedure SwitchSetTabsSw1;
    5   var
    6   	i, TabNo : integer;
    7   	HelpMess, ErrMess : StrType;
    8   begin
    9   	scopy('integer between 1 and ',1,HelpMess,1);
   10   	i := itoc(MAXRECLEN,HelpMess,StrLen(HelpMess)+1);
   11   	cmhlp(HelpMess);
   12   	cmdef(DEFTABNO);
   13   	TabNo := cmnum;  {get an integer}
   14   	if (TabNo < 1) or (TabNo > MAXRECLEN) then begin
   15   	    scopy('Argument must be between 1 and ',1,ErrMess,1);
   16   	    i := itoc(MAXRECLEN,ErrMess,StrLen(ErrMess)+1);
   17   	    cmuerr(ErrMess);
   18   	end;  {of if}
   19   	HoldTabNo := TabNo;  {set global variable}
   20   	HoldPadTabs := true;  {set global variable}
   21   end;  {of procedure SwitchSetTabsSw1}
   22   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 49

    1   
    2   {  SwitchNoStripSw2  --  handles the no-strip switch for the restore	}
    3   {  command								}
    4   procedure SwitchNoStripSw2;
    5   begin
    6   	HoldStripBlanks := false;
    7   end;  {of procedure SwitchNoStripSw2}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 50

    1   
    2   {  SwitchStripSw2  --  handles the strip-blanks switch for the restore	}
    3   {  command								}
    4   procedure SwitchStripSw2;
    5   begin
    6   	HoldStripBlanks := true;
    7   end;  {of procedure SwitchStripSw2}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 51

    1   
    2   {  SwitchFullDirSw3  --  handles the full switch for the directory	}
    3   {  command								}
    4   procedure SwitchFullDirSw3;
    5   begin
    6   	HoldDirectory := FullDir;
    7   end;  {of procedure SwitchFullDirSw3}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 52

    1   
    2   {  SwitchShortDirSw3  --  handles the short switch for the directory	}
    3   {  command								}
    4   procedure SwitchShortDirSw3;
    5   begin
    6   	HoldDirectory := ShortDir;
    7   end;  {of procedure SwitchShortDirSw3}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 53

    1   
    2   {  SwitchWarnMessDf  --  handles the Warning Messages option		}
    3   procedure SwitchWarnMessDf;
    4   begin
    5   	HoldWarning := true;
    6   end;  {of procedure SwitchWarnMessDf}
    7   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 54

    1   
    2   {  SwitchNoWarnDf  --  turns off the warning messages			}
    3   procedure SwitchNoWarnDf;
    4   begin
    5   	HoldWarning := false;
    6   end;  {of procedure SwitchNoWarnDf}
    7   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 55

    1   
    2   {  SwitchNoSwitchDf  --  handles the no option for the default command	}
    3   procedure SwitchNoSwitchDf;
    4   var
    5   	NoCommand : integer;
    6   begin
    7   	NoCommand := cmkey(NoTable);
    8   	case NoCommand of
    9   	    DFSTRIP : SwitchNoStripSw2;
   10   	    DFTABEV : SwitchNoPadSw1;
   11   	    DFWARN  : SwitchNoWarnDf;
   12   	    others  : cmuerr('Invalid switch');
   13   	end;  {of case}
   14   end;  {of procedure SwitchNoSwitchDf}
   15   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 56

    1   
    2   {  SaveStoreSwitchesSw1  --  assigns variables storing store switches	}
    3   {  information to global variable.					}
    4   procedure SaveStoreSwitchesSw1;
    5   begin
    6   	GlobalRecLen  := HoldRecLen;
    7   	GlobalBlkFac  := HoldBlkFac;
    8   	GlobalTabNo   := HoldTabNo;
    9   	GlobalPadTabs := HoldPadTabs;
   10   end;  {of procedure SaveStoreSwitchesSw1}
   11   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 57

    1   
    2   {  SaveRestoreSwitchesSw2  --  assigns vriables storing restore		}
    3   {  switches information to global variables				}
    4   procedure SaveRestoreSwitchesSw2;
    5   begin
    6   	GlobalStripBlanks := HoldStripBlanks;
    7   end;  {of procedure SaveRestoreSwitchesSw2}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 58

    1   
    2   {  SaveDirectorySwitchesSw3  --  assigns vriables storing directory	}
    3   {  switches information to global variables			 	}
    4   procedure SaveDirectorySwitchesSw3;
    5   begin
    6   	GlobalDirectory := HoldDirectory;
    7   end;  {of procedure SaveDirectorySwitchesSw3}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 59

    1   
    2   {  SaveDefaults  --  saves default settings 				}
    3   procedure SaveDefaults;
    4   begin
    5   	DefaultRecLen  := HoldRecLen;
    6   	DefaultBlkFac  := HoldBlkFac;
    7   	DefaultTabNo   := HoldTabNo;
    8   	DefaultPadTabs := HoldPadTabs;
    9   	DefaultWarning := HoldWarning;
   10   	DefaultStripBlanks := HoldStripBlanks;
   11   end;  {of procedure SaveDefaults}
   12   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 60

    1   
    2   {  StoreSwitchesSw1  --  parses multiple choices for	the store	}
    3   {  command								}
    4   procedure StoreSwitchesSw1;
    5   var
    6   	switch : integer;
    7   begin
    8   	loop
    9   	    cmmult;  {multiple mode}
   10   	    cmcfm;  {carriage return}
   11   	    switch := cmswi(Sw1Table);
   12   	    switch := cmdo;
   13   	exit if (switch = 1);
   14   	    switch := cmint;  {get real value from cmswi}
   15   	    if (switch > 0) then
   16   		case switch of
   17   		    S1NOPAD : SwitchNoPadSw1;
   18   		    others  : cmuerr('Argument not specified');
   19   		end  {of case}
   20   	    else if (switch < 0) then  {users gave argument, indicated by - }
   21   		case -switch of
   22   		    S1BLOCK : SwitchBlockSw1;
   23   		    S1RECLN : SwitchRecLenSw1;
   24   		    S1TABEV : SwitchSetTabsSw1;
   25   		    others  : cmuerr('Does not take an argument');
   26   		end;  {of case -switch}
   27   	end;  {of loop}
   28   end;  {of procedure StoreSwitchesSw1}
   29   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 61

    1   
    2   {  RestoreSwitchesSw2  --  parses multiple choice switches for the	}
    3   {  store command							}
    4   procedure RestoreSwitchesSw2;
    5   var
    6   	switch : integer;
    7   begin
    8   	cmmult;  {multiple mode}
    9   	cmdef('/STRIP-BLANKS');
   10   	cmcfm;  {cr}
   11   	switch := cmswi(Sw2Table);
   12   	switch := cmdo;
   13   	if (switch <> 1) then begin
   14   	    switch := cmint;  {get real value form cmswi}
   15   	    if (switch < 0) then
   16   		cmuerr('Does not take an argument')
   17   	    else
   18   	        case switch of
   19   		    S2NOSTR : SwitchNoStripSw2;
   20   		    S2STRIP : SwitchStripSw2;
   21   		    others  : cmuerr('Invalid switch')
   22   	    	end;  {of case switch}
   23   	    cmcfm;  {cr}
   24   	end;  {of if}
   25   end;  {of procedure RestoreSwitchesSw2}
   26   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 62

    1   
    2   {  DirectorySwitchesSw3  --  parses multiple choice switches for the	}
    3   {  Directory command							}
    4   procedure DirectorySwitchesSw3;
    5   var
    6   	switch : integer;
    7   begin
    8   	cmmult;  {multiple mode}
    9   	cmdef('/SHORT');
   10   	cmcfm;  {carriage return}
   11   	switch := cmswi(Sw3Table);
   12   	switch := cmdo;
   13   	if (switch <> 1) then begin
   14   	    switch := cmint;  {get real value form cmswi}
   15   	    if (switch < 0) then
   16   		cmuerr('Does not take an argument')
   17   	    else
   18   	        case switch of
   19   		    S3FULL  : SwitchFullDirSw3;
   20   		    S3SHORT : SwitchShortDirSw3;
   21   		    others  : cmuerr('Invalid switch')
   22   	    	end;  {of case switch}
   23   	    cmcfm;  {cr}
   24   	end;  {of if}
   25   end;  {of procedure DirectorySwitchesSw3}
   26   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 63

    1   
    2   {  ParseTapeOutput2  --  parses next field as output to tape		}
    3   procedure ParseTapeOutput2;
    4   var
    5   	Tname,Text : FNameType;
    6   	TapeFileStr : StrType;
    7    	TFStrLen : integer;
    8   begin
    9   	cmnoi('AS');
   10   	CheckIfTapeAssigned;
   11   	gjgen(600020000000B);
   12    	DefaultTapeName(Tname,Text);
   13           gjdev(GlobalTape);
   14           gjnam(Tname);
   15   	gjext(Text);
   16   	cmfil(output);
   17   	TFStrLen := cmatom(TapeFileStr);
   18   	StrEnd(TapeFileStr,TFStrLen+1);
   19   	if (StrPos(TapeFileStr,';') <> 0) then  {user enters extra junk}
   20   	    GarbageErr
   21   	      ('Invalid attribute for this device',TapeFileStr);
   22   	if (KindOfDevice(curjfn(output),JFNDes) <> TapeDev) then
   23   	    cmuerr('Use COPY command to copy from disk to disk');
   24   end;  {of procedure ParseTapeOutput2}
   25   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 64

    1   
    2   {  ParseDiskOutput2  --  parses next field as output to disk		}
    3   procedure ParseDiskOutput2;
    4   var
    5   	name, ext : FNameType;
    6   
    7   begin
    8   	cmnoi('TO');
    9   	jsys(JFNS;name,0:input,001000000000B);
   10   	jsys(JFNS;ext,0:input,000100000000B);
   11   	gjgen(600020000000B);
   12   	gjnam(name);
   13   	gjext(ext);
   14   	cmfil(output);
   15   	if not (KindOfDevice(curjfn(output),JFNDes) in [DiskDev,TTYDev]) then
   16   	    cmuerr('This utility does not support tape to tape copying');
   17   end;  {of procedure ParseDiskOutput2}
   18   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 65

    1   
    2   {  ParseDirOutput2  --  parses next field as a directory name		}
    3   procedure ParseDirOutput2;
    4   const
    5   	DIRST = 41B;
    6   	GJINF = 13B;
    7   var
    8   	ac1, ac2, DirNo, DirLen : integer;
    9   	DefaultDir : StrType;
   10   begin
   11   	jsys(GJINF;;ac1, ac2);  {get def dir no}
   12   	jsys(DIRST;DefaultDir, ac2);  {turn it into a string}
   13   	cmdef(DefaultDir);
   14   	DirNo := cmdir;
   15   	DirLen := cmatom(GlobalDirStr);
   16   	StrEnd(GlobalDirStr,DirLen+1);
   17   	if (DirLen = 0) then
   18   	    GlobalDirStr := DefaultDir;
   19   end;  {of procedure ParseDirOutput2}
   20   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 66

    1   
    2   procedure RestoreFile;
    3   var
    4   	line, RecLen : integer;
    5   	next : boolean;
    6   	buffer : packed array [1..MAXRECLEN] of char;
    7   begin
    8   	line := 0;
    9   	while not eof do begin
   10   	    next := true;
   11   	    readln(buffer:RecLen);
   12   	    line := line + 1;
   13   	    RecLen := RecLen - 2;  {disregard crlf}
   14   	    if GlobalStripBlanks then
   15   		while (RecLen >= 1) and next do
   16   		    if (buffer[RecLen] = chr(BLANK)) then
   17   		        RecLen := RecLen - 1
   18   		    else
   19   			next := false;
   20   	    if (RecLen = 0) then
   21   		writeln
   22   	    else
   23   	        writeln(buffer:RecLen);
   24   	end;  {of while}
   25           ListRecordCount(line);
   26   end;  {of procedure RestoreFile}
   27   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 67

    1   
    2   {  StoreFile  --  processes the store command				}
    3   procedure StoreFile;
    4   var
    5   	col, line : integer;
    6   	mess : StrType;
    7   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 68

    1   
    2   {  NewLine  --  handles end of line delimiter and sets up for the next	}
    3   {  line									}
    4   procedure NewLine;
    5   begin
    6   	if ((col - 1)  > GlobalRecLen) then
    7   	    TruncMess(line,col-1);
    8   	readln;
    9   	writeln;
   10   	col := 1;
   11   	line := line + 1;
   12   end;  {of procedure NewLine}
   13   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 69

    1   
    2   {  CopyChar  --  copies a single char from input to output and takes	}
    3   {  into account tabs							}
    4   procedure CopyChar;
    5   begin
    6   	if GlobalPadTabs and (input^ = chr(TAB)) then
    7   	    repeat   {pad tabs}
    8   		if (col <= GlobalRecLen) then begin
    9   		    output^ := chr(BLANK);
   10   		    put(output);
   11   		end;  {of if}
   12   		col := col + 1;
   13   	    until (TabPos(col))
   14   	else begin
   15   	    if (col <= GlobalRecLen) then begin
   16   		output^ := input^;
   17   		put(output);
   18   	    end;  {of if}
   19   	    col := col + 1;
   20   	end;  {of else}
   21   	get(input);
   22   end;  {of procedure CopyChar}
   23   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 70

    1   
    2   begin  {StoreFile}
    3   	col := 1; line := 1;
    4   	while not eof do begin  {store to tape}
    5   	    if (input^ = chr(CR)) then begin
    6   		get(input);  {check if crlf}
    7   		if eof then begin  {cr eof}
    8   		    if ((col - 1)  > GlobalRecLen) then
    9   		    	TruncMess(line,col-1);
   10   		    writeln;
   11   		    line := line + 1;
   12   		end  {of if}
   13       		else if (input^ = chr(LF)) then  {crlf}
   14   		    NewLine
   15   		else begin  {treat both cr and next char as normal char's}
   16   		    if (col <= GlobalRecLen) then begin
   17   		        output^ := chr(CR);  {add in already read cr}
   18   		        put(output);
   19   		    end;  {of if}
   20   		    col := col + 1;
   21   		    CopyChar;
   22   		end  {of else}
   23   	    end  {of if}
   24   	    else if (input^ = chr(LF)) then  {same as crlf}
   25   		NewLine
   26   	    else
   27   		CopyChar;
   28   	end;  {of while not eof}
   29   	ListRecordCount(line-1);
   30   end;  {of procedure StoreFile}
   31   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 71

    1   
    2   {  initialization  --  does the initializing				}
    3   procedure initialization;
    4   const
    5   	INDUSTRY_COMPATIBLE = 4B;
    6   begin
    7   	OriginalDataMode := GetJobDataMode;
    8   	if (OriginalDataMode <> INDUSTRY_COMPATIBLE) then
    9   	    SetJobDataMode(INDUSTRY_COMPATIBLE);
   10   	ThatsIt := false;
   11   	StrEnd(GlobalTape,1);  {null string}
   12   	InitTables;
   13   	DefaultRecLen := ctoi(DEFRECLEN,1);
   14   	DefaultBlkFac := ctoi(DEFBLKFAC,1);
   15   	DefaultTabNo  := ctoi(DEFTABNO,1);
   16   	DefaultWarning := true;
   17   	DefaultPadTabs := true;
   18   	DefaultStripBlanks := true;
   19   	DefaultDirectory := ShortDir;
   20   end;  {of procedure initialization}
   21   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 72

    1   
    2   {  PrintHeading  --  prints heading when ANSIMT starts up.  Prints	}
    3   {  title, version numbers, edit numbers, and date.			}
    4   procedure PrintHeading;
    5   const
    6   	WHO_EDITED = 2B;
    7   	MAJOR_VERSION_NUMBER = 001B;
    8   	MINOR_VERSION_NUMBER = 02B;
    9   	EDIT_NUMBER = 000001B;
   10   
   11   	ODTIM = 220B;
   12   var
   13   	ProgramStartTime : packed array [1..40] of char;  {date field}
   14   {$V:200102000001b}  {system version number}
   15   begin
   16   	writeln(tty,'UHCC DEC-20 ANSI Labelled Tape Utility version ',
   17   		    MAJOR_VERSION_NUMBER:3:O,'.',MINOR_VERSION_NUMBER:2:O,
   18   		    '(',EDIT_NUMBER:6:O,')-',WHO_EDITED:1:O);
   19   	jsys(ODTIM,1;ProgramStartTime,-1,336321000000B);
   20   	writeln(tty,ProgramStartTime:StrLen(ProgramStartTime));
   21   	writeln(tty);
   22   end;  {of procedure PrintHeading}
   23   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 73

    1   
    2   {  InitParameters  --  initializes the global and dummy variables to 	}
    3   {  their default values 						}
    4   procedure InitParameters;
    5   begin
    6   	HoldRecLen := DefaultRecLen;
    7   	HoldBlkFac := DefaultBlkFac;
    8   	HoldTabNo  := DefaultTabno;
    9   	HoldPadTabs := DefaultPadTabs;
   10   	HoldWarning := DefaultWarning;
   11   	HoldStripBlanks := DefaultStripBlanks;
   12   	HoldDirectory := DefaultDirectory;
   13   
   14   	GlobalRecLen := DefaultRecLen;
   15   	GlobalBlkFac := DefaultBlkFac;
   16   	GlobalTabNo  := DefaultTabno;
   17   	GlobalPadTabs := DefaultPadTabs;
   18   	GlobalWarning := DefaultWarning;
   19   	GlobalStripBlanks := DefaultStripBlanks;
   20   	GlobalDirectory := DefaultDirectory;
   21   end;  {of procedure InitParameters}
   22   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 74

    1   
    2   {  ParseDefault1  --  parses the default command			}
    3   procedure ParseDefault1;
    4   var
    5   	DefCommand : integer;
    6   begin
    7   	cmnoi('FOR');
    8   	DefCommand := cmkey(DefTable);
    9   	case DefCommand of
   10   	    DFBLOCK : SwitchBlockSw1;
   11   	    DFNOSWI : SwitchNoSwitchDf;
   12   	    DFRECLN : SwitchRecLenSw1;
   13   	    DFSTRIP : SwitchStripSw2;
   14   	    DFTABEV : SwitchSetTabsSw1;
   15   	    DFWARN  : SwitchWarnMessDf;
   16   	    others  : cmuerr('Invalid switch');
   17   	end;  {of case}
   18   	cmcfm;  {cr}
   19   end;  {of ParseDefault}
   20   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 75

    1   
    2   {  ParseDirectory  --  parses the directory command			}
    3   procedure ParseDirectory1;
    4   begin
    5   	cmnoi('OF TAPE');
    6   	DirectorySwitchesSw3;
    7   end;  {of procedure ParseDirectory1}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 76

    1   
    2   {  ParseEOT1  --  parses the eot command				}
    3   procedure ParseEOT1;
    4   begin
    5   	cmnoi('END OF TAPE');
    6   	cmcfm;
    7   end;  {of procedure ParseEOT1}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 77

    1   
    2   {  ParseExit1  --  parses the exit command				}
    3   procedure ParseExit1;
    4   begin
    5    	cmnoi('TO MONITOR');
    6   	cmcfm;
    7   end;  {of procedure ParseExit1}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 78

    1   
    2   {  ParseHelp1  --  parses the help command				}
    3   procedure ParseHelp1;
    4   begin
    5   	cmnoi('ON ANSIMT COMMANDS');
    6   	cmcfm;  {carriage return}
    7   end;  {of procedure ParseHelp1}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 79

    1   
    2   {  ParseRestore1  --  parses the restore command			}
    3   procedure ParseRestore1;
    4   var
    5   	FileStrLen : integer;
    6   	FileStr : StrType;
    7   begin
    8   	cmnoi('TAPE FILES');
    9   	CheckIfTapeAssigned;
   10   	gjgen(000120777775B);
   11   	gjdev(GlobalTape);
   12   	cmfil(input);
   13   	FileStrLen := cmatom(FileStr);
   14   	StrEnd(FileStr,FileStrLen+1);
   15   	if (KindOfDevice(curjfn(input),JFNDes) <> TapeDev) then
   16   	    cmuerr('Device must be TAPE');
   17   	if (StrPos(FileStr,'*') = 0) and
   18   	   (StrPos(FileStr,'%') = 0) then begin
   19   	    ParseDiskOutput2;
   20   	    jsys(JFNS;GlobalDiskFile,0:output,0);
   21   	end  {of if}
   22   	else begin
   23   	    ParseDirOutput2;
   24   	    GlobalDiskFile[1] := chr(NULL);
   25   	end;  {of else}
   26   	RestoreSwitchesSw2;
   27   end;  {of procedure ParseRestore1}
   28   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 80

    1   
    2   {  ParseRewind1  --  parses the rewind command				}
    3   procedure ParseRewind1;
    4   begin
    5   	cmnoi('TO THE BEGINNING OF TAPE');
    6   	cmcfm;
    7   end;  {of procedure ParseRewind1}
    8   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 81

    1   
    2   {  ParseSkip1  --  parses the skip command				}
    3   procedure ParseSkip1;
    4   const
    5   	DEFNFIL = '1 ';
    6   begin
    7   	cmnoi('NUMBER OF FILES');
    8   	cmhlp('positive integer for forward, negative for backward');
    9   	cmdef(DEFNFIL);
   10   	FilesToSkip := cmnum;  {global variable}
   11   	cmcfm;  {carriage return}
   12   end;  {of procedure ParseSkip1}
   13   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 82

    1   
    2   {  ParseStore1  --  parses the store command 				}
    3   procedure ParseStore1;
    4   var
    5   	i, FileStrLen : integer;
    6   	FileStr : StrType;
    7   begin
    8   	cmnoi('DISK FILES');
    9           gjgen(100120000000B);
   10   	cmfil(input);
   11   	FileStrLen := cmatom(FileStr);
   12   	StrEnd(FileStr,FileStrLen + 1);
   13   	if (StrPos(FileStr,'*') = 0) and  {wild card?}
   14   	   (StrPos(FileStr,'%') = 0) then begin
   15   	    ParseTapeOutput2;
   16               jsys(JFNS;GlobalTapeFile,0:output,0);
   17   	end  {if end}
   18   	else begin {it is a wild card}
   19   	    DefaultTapeFile;
   20   	end;  {of else}
   21   	StoreSwitchesSw1;
   22   end;  {of procedure ParseStore1}
   23   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 83

    1   
    2   {  ParseTape1  --  parses the tape command				}
    3   procedure ParseTape1;
    4   const
    5   	ASND = 70B;
    6   var
    7   	DevNo, DevStrLen, return : integer;
    8   	DevStr : FNameType;
    9   begin
   10   	cmnoi('DEVICE');
   11   	cmhlp('magtape device');
   12   	DevNo := cmdev;
   13   	DevStrLen := cmatom(DevStr);
   14    	StrEnd(DevStr,DevStrLen+1);
   15   	if (KindOfDevice(DevNo,DevDes) <> TapeDev) then
   16   	    GarbageErr('Not a magtape device',DevStr);
   17   	jsys(ASND, 3, return;DevNo);  {try to assign the device}
   18   	if (return = 1) then  {error}
   19   	    ErrorMess;
   20   	cmcfm;
   21   	HoldTape := DevStr;
   22   end;  {of procedure ParseTape1}
   23   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 84

    1   
    2   {  ProcessDefault  --  process the default command			}
    3   procedure ProcessDefault;
    4   begin
    5   	SaveDefaults;
    6   end;  {of procedure ProcessDefault}
    7   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 85

    1   
    2   {  ProcessDirectory  --  process the directory command			}
    3   procedure ProcessDirectory;
    4   const
    5   	WILDCARD = ':*.*.*';
    6   	DATAERR = 600221B;  {data error}
    7   	BIGREC = 601240B;
    8   var
    9   	i : integer;
   10   	WildFile : FNameType;
   11   begin
   12   	SaveDirectorySwitchesSw3;
   13   	CheckIfTapeAssigned;
   14   	RewindTape;
   15   	WildFile := GlobalTape;
   16   	scopy(WILDCARD,1,WildFile,StrLen(WildFile)+1);
   17   	i := 1;
   18   	repeat
   19   	    reset(input,WildFile,'/d/o/m:7',[11]{allow wildcards});
   20   	    if (erstat(input) <> 0) and
   21   	       (erstat(input) <> DATAERR) and (erstat(input) <> BIGREC) then
   22    	        analysis(input)
   23   	    else begin
   24   		if (i = 1) then
   25   		    DirHeading;
   26   		if (erstat(input) = DATAERR) or (erstat(input) = BIGREC) then
   27   		    TapeFileInfo(-i)
   28   		else
   29   		    TapeFileInfo(i);
   30   		i := i + 1;
   31   	    end;
   32   	    ClearDataError(input);
   33   	    if FileOpen(input) then
   34   		close(input);
   35   	until (nextfile(input) = 0);
   36   end;  {of procedure ProcessDirectory}
   37   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 86

    1   
    2   {  ProcessEOT  --  processes the eot command				}
    3   procedure ProcessEOT;
    4   const
    5   	MOEOT = 10B;
    6   var
    7   	return : integer;
    8   begin
    9   	CheckIfTapeAssigned;
   10   	GetDeviceJFN;
   11           jsys(OPENF, 2, return;0:device, 100000200000B);	 {8bit, w/ read access}
   12   	if (return = 1) then
   13   	    ErrorMess;
   14    	jsys(MTOPR,-2,return;0:device, MOEOT);
   15   	if (return = 3) then begin
   16   	    if TrapEOT then
   17   		WarnMess('Already at end of tape')
   18   	    else
   19   		cmerrmsg;  {print official error message}
   20   	    jsys(CLOSEF, 2, return;001000:device);
   21   	    if (return = 1) then
   22   	        cmerrmsg;
   23   	    cmagain;
   24   	end  {of if}
   25   	else begin
   26   	    jsys(CLOSEF,2,return;001000:device);
   27   	    if (return = 1) then
   28   		ErrorMess;
   29   	end;  {of begin}
   30   end;  {of procedure ProcessEOT}
   31   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 87

    1   
    2   {  ProcessExit  --  processes the exit command				}
    3   procedure ProcessExit;
    4   begin
    5   	ThatsIt := true;  {terminates program in major loop}
    6   end;  {of procedure ProcessExit}
    7   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 88

    1   
    2   {  ProcessHelp  --  processes the help command				}
    3   procedure ProcessHelp;
    4   var
    5   	rl : integer;
    6   	buffer : StrType;
    7   begin
    8   	reset(input,'HLP:ANSIMT.HLP','/o');
    9   	if (erstat(input) <> 0) then
   10   	    analysis(input);
   11   	rewrite(output,'TTY:','/o/i');
   12   	if (erstat(output) <> 0) then
   13   	    analysis(output);
   14   	while not eof do begin
   15   	    readln(buffer:rl);
   16   	    writeln(buffer:rl);
   17   	end;  {of while}
   18   	close(input);
   19   	close(output);
   20   end;  {of procedure ProcessHelp}
   21   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 89

    1   
    2   {  ProcessRestore  --  processes the restore command			}
    3   procedure ProcessRestore;
    4   begin
    5   	SaveRestoreSwitchesSw2;
    6   	loop
    7               if OpenInputTape then begin
    8   		if (GlobalDiskFile[1] = chr(NULL)) then
    9   		    DefaultDiskFile;
   10                   if not OpenOutputDisk then
   11                       cmagain;
   12                   ListFiles;
   13                   RestoreFile;
   14                   close(input);
   15                   close(output);
   16   	    end;  {of if}
   17   	exit if (nextfile(input) = 0);
   18   	    GlobalDiskFile[1] := chr(NULL);
   19   	end;  {of loop}
   20   end;  {of procedure ProcessRestore}
   21   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 90

    1   
    2   {  ProcessRewind  --  processes the rewind command			}
    3   procedure ProcessRewind;
    4   begin
    5   	CheckIfTapeAssigned;
    6   	RewindTape;
    7   	if BeginningOfTape then
    8   	    WarnMess('Already at beginning of tape');
    9   end;  {of procedure ProcessRewind}
   10   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 91

    1   
    2   {  ProcessSkip  --  processes the skip command				}
    3   procedure ProcessSkip;
    4   var
    5   	i : integer;
    6   begin
    7   	CheckIfTapeAssigned;
    8   	if (FilesToSkip > 0) then
    9   	    for i := 1 to FilesToSkip do
   10   	    	ForwardFile
   11   	else if (FilesToSkip < 0) then
   12   	    for i := 1 to -FilesToSkip do begin
   13   		BackwardFile;
   14   		if BeginningOfTape then
   15   		    cmuerr('Beginning of tape encountered');
   16   	    end;  {of for}
   17   end;  {of procedure ProcessSkip}
   18   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 92

    1   
    2   {  ProcessStore  --  processes the store command			}
    3   procedure ProcessStore;
    4   var
    5   	i : integer;
    6   	mess : StrType;
    7   begin  {ProcessStore}
    8   	SaveStoreSwitchesSw1;
    9           if (KindOfDevice(curjfn(input),JFNDes) = DiskDev) then begin
   10           	if not OpenInputFile(DiskDev) then
   11                       cmagain;
   12           end  {of if}
   13           else if (KindOfDevice(curjfn(input),JFNDes) = TTYDev) then begin
   14           	if not OpenInputFile(TTYDev) then
   15                       cmagain;
   16           end  {of else if}
   17           else
   18               cmuerr('Source device must be DISK');
   19   	loop
   20               if not OpenOutputTape(GlobalTapeFile) then
   21   	    	cmagain;
   22   	    if (GlobalRecLen * GlobalBlkFac > MAXRECLEN) then begin
   23   	    	scopy('Block size greater than the ANSI standard of ',1,mess,1);
   24   	    	i := itoc(MAXRECLEN,mess,StrLen(mess)+1);
   25   	    	WarnMess(mess);
   26   	    end;  {of if}
   27   	    ListFiles;
   28   	    StoreFile;
   29   	    close(input);
   30   	    close(output);
   31   	exit if (nextfile(input) = 0);
   32   	    if not OpenInputFile(DiskDev) then
   33   	        cmagain;
   34    	    DefaultTapeFile;
   35   	end;  {of loop}
   36   end;  {of procedure ProcessStore}
   37   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 93

    1   
    2   {  ProcessTape  --  processes the tape command				}
    3   procedure ProcessTape;
    4   const
    5   	MORLI = 50B;
    6   	MOSDM = 4B;  {set hardware data mode}
    7   	ARGS = 2B;
    8   	UNLABELED = 1;
    9   	ANSILABEL = 2;
   10   	EBCDICLABEL = 3;
   11   	TOPS20LABEL = 4;
   12   type
   13   	ArgBlkType = record
   14   	    ArgWords : integer;
   15   	    TypeOfLabel : integer;
   16   	end;  {of record}
   17   var
   18   	DummyTape : FNameType;
   19   	ArgBlkPtr : ^ArgBlkType;
   20   begin
   21   	new(ArgBlkPtr);
   22   	DummyTape := GlobalTape;
   23   	GlobalTape := HoldTape;  {set to global variable}
   24   	with ArgBlkPtr^ do begin
   25   	    ArgWords := ARGS;
   26   	    GetDeviceJFN;
   27   	    jsys(MTOPR;0:device,MORLI,ArgBlkPtr);
   28   	    if (TypeOfLabel = UNLABELED) then begin
   29   		GlobalTape := DummyTape;  {get back old value}
   30   		cmuerr('Tape cannot be unlabelled');
   31   	    end  {of if}
   32   	    else if (TypeOfLabel = EBCDICLABEL) then
   33   		WarnMess('EBCDIC tape, read only')
   34   	    else if (TypeOfLabel = TOPS20LABEL) then
   35                   WarnMess('TOPS-20 tape');
   36   	end;  {of with}
   37   	{get rid of junk}
   38   	dispose(ArgBlkPtr);
   39   end;  {of procedure ProcessTape}
   40   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 94

    1   
    2   {  termination  --  cleans up before exiting				}
    3   procedure termination;
    4   const
    5   	INDUSTRY_COMPATIBLE = 4B;
    6   begin
    7   	if (OriginalDataMode <> INDUSTRY_COMPATIBLE) then
    8   	    SetJobDataMode(OriginalDataMode);
    9   end;  {of procedure termination}
   10   
PASCAL %14(331)  19-Dec-85     ANSIMT         PAGE 95

    1   
    2   begin  {main program}
    3   	initialization;
    4   	PrintHeading;
    5   	repeat
    6   	    cminir('ANSIMT>');
    7   	    InitParameters;
    8   	    command := cmkey(CmdTable);
    9   	    case command of  {parse the command}
   10   		DEF	: ParseDefault1;
   11   		DIR	: ParseDirectory1;
   12   		EOT	: ParseEOT1;
   13   		XIT	: ParseExit1;
   14   		HELP	: ParseHelp1;
   15   		RESTORE : ParseRestore1;
   16   		REWIND	: ParseRewind1;
   17   		SKIP	: ParseSkip1;
   18   		STORE 	: ParseStore1;
   19   		TAPE	: ParseTape1;
   20   	    end;  {of case}
   21   	    case command of  {now process the command}
   22   		DEF	: ProcessDefault;
   23   		DIR	: ProcessDirectory;
   24   		EOT	: ProcessEOT;
   25   		XIT	: ProcessExit;
   26   		HELP	: ProcessHelp;
   27   		RESTORE : ProcessRestore;
   28   		REWIND	: ProcessRewind;
   29   		SKIP	: ProcessSkip;
   30   		STORE 	: ProcessStore;
   31   		TAPE	: ProcessTape;
   32   	    end;  {of case}
   33   	until ThatsIt;
   34   	termination;
   35   end. 


No error detected

Highseg:  24P
Lowseg :   1P