Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50547/pltlib/tek/runlib.mac
There is 1 other file named runlib.mac in the archive. Click here to see a list.
TITLE	RUNLIB - FORTRAN callable routines to do TMPCOR and RUN UUO's
SUBTTL	By Joe Smith 22-Oct-81

;In order to load easily with FORTRAN routines, RUNLIB is assembled into
;the LOWSEG only.  To make a REL file to go in the HISEG, do the following:
;	.R MACRO
;	*TOPLIB,RUNLIB/C=TTY:,DSK:RUNLIB
;	TOPSEG=-1
;	^Z
;	[MCREP1 END OF PASS 1]
;	TOPSEG=-1	;Put these routines in the HISEG
;	^Z
;	*CREF!
;	*RUNLIB
;	*^Z
;
; The above commands are in RUNLIB.MIC

SEARCH	MACTEN,UUOSYM	;Standard TOPS-10 definitions

	LIBWHO==2		;Non-DEC program
	LIBVER==4		;Major version number
	LIBMIN=="A"-"@"		;Minor version
	LIBEDT==17		;Edit level

	MODSHW	(LIB)		;Define %%LIB as version number




;;  NOTE:  Don't let the size of this file throw you, it is more than 2/3
;;  comments.  The start of executable code is on page 23.




;       Table of Contents for FORTRAN callable RUN library
;
;
;			   Section			      Page
;
;    1. Table of Contents  . . . . . . . . . . . . . . . . . .   2
;    2. Definitions  . . . . . . . . . . . . . . . . . . . . .   3
;    3. Revision History . . . . . . . . . . . . . . . . . . .   5
;    4. Documentation - RUNLIB.DOC . . . . . . . . . . . . . .   6
;    5. Calling sequence
;         5.1   Introduction . . . . . . . . . . . . . . . . .   7
;         5.2   RESCAN . . . . . . . . . . . . . . . . . . . .   9
;         5.3   INCHWL . . . . . . . . . . . . . . . . . . . .  10
;         5.4   TMPCOR and RUNUUO  . . . . . . . . . . . . . .  11
;         5.5   OUTSTR . . . . . . . . . . . . . . . . . . . .  12
;         5.6   SAVRUN . . . . . . . . . . . . . . . . . . . .  13
;         5.7   JBINFO . . . . . . . . . . . . . . . . . . . .  14
;         5.8   EXIT0, EXIT1, and EXITGO . . . . . . . . . . .  15
;         5.9   HELPER . . . . . . . . . . . . . . . . . . . .  16
;         5.10  MATCH  . . . . . . . . . . . . . . . . . . . .  17
;         5.11  Examples . . . . . . . . . . . . . . . . . . .  18
;         5.12  Writing a FORTRAN program that compiles itse .  19
;    6. Appendix - Calling RUNLIB from MACRO programs  . . . .  21
;    7. LOWSEG data area . . . . . . . . . . . . . . . . . . .  23
;    8. TMPCOR
;         8.1   Write TEMP file  . . . . . . . . . . . . . . .  24
;    9. RUNUUO
;         9.1   Run next program . . . . . . . . . . . . . . .  25
;         9.2   Prepare to go  . . . . . . . . . . . . . . . .  26
;         9.3   Error recovery . . . . . . . . . . . . . . . .  27
;   10. INCHWL
;        10.1   Give prompt and input a full line from TTY . .  28
;        10.2   Prompt the user  . . . . . . . . . . . . . . .  29
;   11. RESCAN
;        11.1   Check monitor line, TMPCOR or DSK:nnnPRG.TMP .  30
;        11.2   Do RESCAN uuo  . . . . . . . . . . . . . . . .  31
;   12. HELPER
;        12.1   Subroutine to output SYS:??????.HLP  %5(42)  .  33
;        12.2   Try the other ersatz devices . . . . . . . . .  34
;        12.3   I/O routines . . . . . . . . . . . . . . . . .  35
;   13. EXITGO
;        13.1   Return to the monitor  . . . . . . . . . . . .  36
;        13.2   Close any open channels  . . . . . . . . . . .  37
;   14. OUTSTR
;        14.1   Output a string on the TTY . . . . . . . . . .  38
;   15. JBINFO
;        15.1   Return info about the job  . . . . . . . . . .  39
;   16. SAVRUN
;        16.1   Save the /RUN switch and clean up buffer . . .  41
;        16.2   Look for /RUN  . . . . . . . . . . . . . . . .  42
;   17. MATCH
;        17.1   Check if command matches list  . . . . . . . .  43
;   18. Subroutines
;        18.1   Read TMPCOR or DSK:nnnxxx.TMP  . . . . . . . .  44
;        18.2   Read file from disk  . . . . . . . . . . . . .  45
;        18.3   TSTABR - Test if T1 is an abbreviation . . . .  46
;        18.4   GETWRD - Get alphameric word in T1, input vi .  47
;        18.5   SCAN - read DEV:FILENAME . . . . . . . . . . .  48
;        18.6   CLRBUF - clear BUFFER, KOUNT, LASTC, set up  .  49
;        18.7   COMCH and TTYIN - character input routines . .  50
;        18.8   GETNAM - Returns 3 SIXBIT characters for pro .  51
;   19. Data area
;        19.1   Constants and literals . . . . . . . . . . . .  52
SUBTTL	Definitions

;Ac definitions
	F=0			;Flag
	T1=1			;Temp
	T2=2
	T3=3
	T4=4
	C=5			;Counter
	C2=C+1			;Second counter, stop IOWD
	BP=7			;ASCII byte pointer
	CH=10			;Holds character
	L=16			;Link to arg list
	P=17			;PDL pointer
	.XCREF	T1,T2,T3,T4,C,C2,CH,BP,P	;CREF only F and L

;Argument indices
	NAM==0			;TMPCOR name or prompt
	COD==0			;Error code/SAVRUN flags
	BUF==1			;Addr of buffer
	CNT==2			;Number of chars in buffer
	LEN==3			;Size of buffer or RUNOFFSET
	CHR==4			;Last character
	IDX==4			;Index returned from MATCH
	DNM==5			;Double precision name from MATCH

;Character definitions
	BEL==7
	TAB=11
	LF=12
	VT=13
	FF=14
	CR=15
	CZ=32			;Control-Z
	ESC=33
	SP=" "

;Flag bits, right half (Must match the options for SAVRUN)
	F.RUN==  1		;1 Look for @CCLFIL/RUN/RUNOFF/EXIT/HELP
	F.COM==  2		;2 Ignore comments
	F.CTL==  4		;4 Ignore control chars
	F.LSP== 10		;8 Ignore leading spaces
	F.SSP== 20		;16 Convert tabs and multiple spaces to 1 space
	F.UC==  40		;32 Convert lower case to upper
	F.BRK==100		;64 Convert <> to [] (APPLEs and 2741)
	F.TAB==200		;128 Convert tabs to multiple spaces
	F.ALL= 377		;All defined bits for SAVRUN

	F.SP== 400000		;Ignore further spaces
	F.CZ== 200000		;Control-Z or /EXIT was seen
	F.QUO==100000		;Inside quotes, leave ; ! / alone
;More definitions

;Define OPCODEs which have the same name as entry points
	OPDEF	TMPCOR	[TMPCOR]
	OPDEF	OUTSTR	[OUTSTR]
	OPDEF	INCHWL	[INCHWL]
	OPDEF	RESCAN	[RESCAN]

;Misc definitions

  ;Set FT603==1 if you plan to use RUNLIB with the 6.03A monitor.
	ND	FT701,-1	;Use 7.01 extended FILOP channels for I/O
	ND	FT603,-1	;Include code for using channel 0 for I/O
IFE FT603!FT701,< FT603==-1 >	;Must have one or the other or both

	ND	CBUFSZ,^D512	;Size of COMBUF, can be 128 for 6.03A
IFN <CBUFSZ&177>,<PRINTX ?CBUFSZ must be a multiple of 128>
	CBUFS5=CBUFSZ*5		;Max bytes in COMBUF

	%0==0			;Temporary I/O channel


DEFINE	HELLO (.NAME.),< LALL
	  ENTRY	.NAME.		  ;For library searches
	  ENTRY	$'.NAME. 	  ;Alternate name for MACRO subroutines
	  $'.NAME.==.NAME. 	  ;...
	  SIXBIT /.NAME./	  ;For subroutine TRACE.
.NAME.:	  MOVEM	F,SAVE0		  ;Save the AC's
	  MOVE	F,[T1,,SAVE1]	  ; ...
	  BLT	F,SAVEND	  ; AC's 1 thru 17
			   sall			;(End of HELLO expansion) >

SUBTTL	Revision History

;  Created by Joe Smith, Colorado School of Mines Computing Center.

;1(1)	First versions written Oct 77.  TMPCOR and RESCAN in separate files.

;2(2)	Combined into one file Nov 77.

;3(3)	Put in library, RUNLIB.  Separated RUNUUO from TMPCOR.  Added
;	mode 3 to SAVRUN.  12-Sep-78.

;4(4)	Rewrote SAVRUN completely.  14-Dec-78

;4(5)	Implemented /RUNOFF, added more comments.  30-Dec-78.

;4(6)	Fixed bug in CHKRUN, code cleanup.  14-Aug-79.

;4(7)	Fix bug in OUTSTR.  17-Apr-80.

;4A(10)	RESCAN returns data only if TTCALL succeeded.  If it found a CCL
;	file, it sets KOUNT=-1.  INCHWL must be used to read the CCL file,
;	one line at a time.  INCHWL returns KOUNT=-1 when it hits end of CCL
;	file.  13-Jun-81.

;(11)	General clean up.  12-Aug-81

;(12)	Added subroutine MATCH.  9-Sep-81

;(13)	Add option in RESCAN to read binary TMP files.  25-Sep-81

;(14)	Have MATCH return the unabbreviated command in A6 format.  17-Oct-81

;(15)	Add IOPT to SAVRUN.  5-Nov-81

;(16)	Replaced all RESET uuos in RUNUUO with RELEAS %0 to not wipe out
;	FOROT6 (version 6 of FOROTS).  9-Sep-82

;(17)	Fix to use CH instead of C in GETOCT.  20-May-83
SUBTTL	Documentation - RUNLIB.DOC
	XLIST	;RUNLIB.DOC is extracted from the following 17 pages
COMMENT	|	RUNLIB.DOC - Description of routines in FOR:RUNLIB.REL

This library of routines was started in 1976 for use by the DRAW package.
The DRAW package is a set of FORTRAN programs which require some monitor calls
not available in FORLIB.  RUNLIB fills this requirement by including subroutines
to read and write TMPCOR files, get the user's name and job number, and execute
the RUN UUO.  The subroutines originally used by DRAW were:

  EXITGO  Exit to the monitor unless a /RUN: switch was specified.
  HELPER  Type the help file.
  INCHWL  Read in one line from the terminal, or from an indirect file.
  JBINFO  Job info, such as job number and user name.
  MATCH   Check if a word matches a list of commands.
  RESCAN  Read TMPCOR, or the monitor command line.
  RUNUUO  Run the next .EXE file in the package.
  SAVRUN  Check for /RUN:, /RUNOFF, /HELP, or /EXIT in command line.
  TMPCOR  Write files in TMPCOR, giving commands to the next program.

Later on, more routines were added to increase functionality.  These are:

  EXIT0   Return to monitor level, type "EXIT".
  EXIT1   Return to monitor level quietly, the "CONTINUE" command will work.
  OUTSTR  Type a string on the terminal, complement of INCHWL.




SUBTTL	Calling sequence -- Quick summary

	CALL EXIT0
	CALL EXIT1
	CALL EXITGO
	CALL HELPER (0)
	CALL INCHWL (NAME, BUFFER, KOUNT, LENGTH, LASTC)
	CALL MATCH ('LIST,OF,COMMANDS,ETC',BUFFER,KOUNT,LENGTH,INDEX,DNAME)
	      GOTO (100, 200,  300,   400) INDEX
	CALL OUTSTR (ICC,  BUFFER, KOUNT)
	CALL RESCAN (NAME, BUFFER, KOUNT, LENGTH, LASTC)
	CALL RUNUUO (IERR, PRGNAM, KOUNT, ICCL)
	CALL SAVRUN (IOPT, BUFFER, KOUNT, LENGTH, LASTC)
	CALL TMPCOR (NAME, BUFFER, KOUNT)

	IVALUE = JBINFO(ITABLE)
SUBTTL	Calling sequence -- Introduction

    These routines are provided to allow FORTRAN programs  to  act  like
CUSP's  (Commonly  Used System Programs).  In particular, these routines
can be used  to  check  for  command-input,  exit  to  the  monitor,  or
chain-off to another program.

===============  Introduction to TMPCOR and RESCAN  ====================

    Commonly Used System Programs have many ways to  pick  up  commands.
Let's  take  DIRECT  for  example.  You can give commands to DIRECT in 5
different ways.  1) Monitor command;  ".DIRECT TEST.FOR".  2) The  R  or
RUN  command;   ".R  DIRECT  (TEST.FOR)".   3) The temp-core file 'DIR';
"TEST.FOR".  4) Temp disk file 'nnnDIR.TMP';  "TEST.FOR".  5)  When  the
program prompts;  "*TEST.FOR".

    1) The monitor recognizes the word  "DIRECT"  and  runs  SYS:DIRECT.
DIRECT  does a RESCAN to re-read the same command that the monitor read.
It skips over the first word, and takes  the  rest  of  the  line  as  a
command.

    2) The monitor recognizes the "R" command to run a  program  off  of
SYS:.   It  ignores  anything  in  parentheses.   DIRECT  does a RESCAN,
recognizes  the  "R",  and  expects  its  command  to  be  enclosed   in
parentheses.

    3) The  monitor  has space  for  short  files in temp-core (TMPCOR).
Each file goes by a three letter name,  such as 'DIR' for  DIRECT, 'FOR'
for  FORTRAN,  'LNK'  for LINK, 'MCR' for MACRO, etc.  When your program
writes the words "TEST.FOR" into  the  'DIR'  temp-file.   DIRECT  reads
'TMP:DIR' and uses it as a command.

    4) If TMPCOR is full, the temp-file can be put on DSK:.  If your job
is  number  12,  then  the name of the file is 'DSK:012DIR.TMP'.  DIRECT
searches for this file if it cannot find anything in TMPCOR.

    5) If DIRECT connot find a command anywhere, it prints a prompt  and
waits  for  you  to  type a command.  DIRECT uses an asterisk "*" as its
prompt.  Only in case 5 will DIRECT expect more commands.  As soon as it
is  dones  with  the first command, it will give another prompt and wait
for another one, it does not return to the monitor.  Typing a  Control-Z
or "/EXIT" will get you to the monitor.  If you type "TEST.FOR^Z", DIRECT
will give a listing for the file TEST.FOR and then return to the monitor.

    The temp files in steps 3 and 4 are often referred to as CCL files.
CCL stands for Concise Command Language, and were first used by the
COMPIL program.

    The  RESCAN  routine  handles cases 1 through 4.  For case 5, RESCAN
will report that it could not find anything, and your program will  have
to call INCHWL to give a prompt and pick up a command.
==============  Common Switches (Commands to SAVRUN)  ==================

    Most  system  programs  understand  comments  and  at  least   three
switches.  The routine SAVRUN scans an array (buffer) and interprets the
standard switches and comments.  A comment is anything after a semicolon
or an exclaimation point, ";" and "!".  SAVRUN will remove comments,
remove leading spaces, convert tabs to spaces, reduce multiple
spaces to a single  space, and  convert  lowercase  to  upper.

  SAVRUN recognizes four switches; /HELP, /EXIT, /RUN:, and /RUNOFF.
When SAVRUN sees "/H" or "/HELP", it will type the  help  file  for  the
program.  "/EXIT" and "/RUN:PROGRAM" cause LASTC to be set to 26, as a signal
to call the EXITGO routine.
SUBTTL	Calling sequence -- RESCAN

    RESCAN checks for command input.  The commands may come from monitor
level, from a TMPCOR file, or from the temp file on disk.

	CALL RESCAN (NAME, BUFFER, KOUNT, LENGTH, LASTC)

NAME	= (INPUT) Three letter name of the temp-core file.
	-1 means to use the name of the program, 0 to not check CCL files.

BUFFER	= (OUTPUT) Array receiving the command, 5 characters per word.

KOUNT	= (OUTPUT) Number of characters read in.  Zero if nothing was found,
	negative if a CCL file was input, to be read by INCHWL.

LENGTH	= (INPUT) Size that BUFFER is dimensioned for.  RESCAN will read
	binary data if LENGTH is negative.

LASTC	= (OUTPUT) ASCII code for the last character read in.

    RESCAN  first  trys  checking  for the monitor command which started
your program.  Then it checks temp-core, and finally the disk  file  for
commands.  Because the CCL files in temp-core and disk can have more than
one line of commands, RESCAN will only check for the existance of such files
if LENGTH is positive.  When this occurs, your program should call INCHWL to
get lines from the command file.  Each call to INCHWL will read one line from
the CCL file, your program should continue reading until LASTC=26 (End of File).

    In order to make it possible to read arbitrary binary data from TMPCOR
files, RESCAN will do input differently if you specify a negative number for
LENGTH.  In this case, the entire file is read in all at once, KOUNT is 5
times the number of words read in, and LASTC is set to zero.  RESCAN will not
check the monitor command line when LENGTH is negative.

KOUNT = 0 means that no command was found.  This is the usual case.
KOUNT positive means that RESCAN has read the command into BUFFER.
KOUNT negative means that RESCAN found a CCL file for INCHWL to read.
SUBTTL	Calling sequence -- INCHWL

   INCHWL gets a line of input from the terminal (or command file).	<<

	CALL INCHWL (NAME, BUFFER, KOUNT, LENGTH, LASTC)

NAME	= (INPUT) Three letter prompt, such as 'ABC' for "ABC>".
	A value of zero or all blanks will suppress the prompt.
	If NAME = -1, INCHWL will use the first three letters of the
	name of your program.

BUFFER	= (OUTPUT) Array receiving the command, 5 characters per word.

KOUNT	= (OUTPUT) Number of characters read in.  0 for a blank line,
	-1 (and LASTC=26) at end of CCL file read in by RESCAN.

LENGTH	= (INPUT) Size that BUFFER is dimensioned for.

LASTC	= (OUTPUT) ASCII code for the last character read in.
	Your program should call EXITGO if LASTC=26 (End-Of-File).

    INCHWL reads commands from the terminal, or from  the  CCL  file  if
RESCAN  found  one.   When reading from the terminal, INCHWL prompts the
user if NAME is not zero or blanks, and then waits for the user to  type
in a line.  If NAME='ABC', then INCHWL would type "ABC>" on the terminal
to signify that it is waiting for input.  If the user types in  a  blank
line  (just  hits  the  RETURN  key),  then INCHWL will return BUFFER as
blanks, KOUNT=0, and LASTC=13 (the code  for  RETURN).   The  only  time
INCHWL  returns  with KOUNT negative is if it was reading from a command
file, and hit the end of file.

    The end-of-line character gets stored in LASTC, right  justified  in
an  (R1)  format.  Usually the user will type a carriage return so LASTC
will be 13.  Other characters often  used  is  the  'ESCape'  to  signal
special processing and Control-Z to exit when done.

Character	 Code  Decimal Octal
--------        ------ ------- -----
Bell		CTRL-G	  7	"07
Linefeed	CTRL-J	 10	"12
Vertical Tab	CTRL-K	 11	"13
Formfeed	CTRL-L	 12	"14
Return		CTRL-M	 13	"15
End-of-file	CTRL-Z	 26*	"32	*Control-Z means "/EXIT"
Escape $	CTRL-[	 27	"33
SUBTTL	Calling sequence -- TMPCOR and RUNUUO

   TMPCOR can be used to leave temporary messages for other programs.

	CALL TMPCOR (NAME, BUFFER, KOUNT)

NAME	= (INPUT) Three letter name of the temp-core file.

BUFFER	= (INPUT) Array or literal containing the message.

KOUNT	= (INPUT) Number of characters in the message.

    In the 6.03A and previous  monitors,  temp-core  was  limited  to  8
blocks of 20 characters each.  TMPCOR was easily filled by medium length
messages.  In the 7.01 monitor, the maximum size of  any  single  TMPCOR
file  is  2550 characters, and there is no limit to the number of TMPCOR
files.


-----------------------------------------------------------


   RUNUUO will start the execution of another program.

	CALL RUNUUO (IERR, PRGNAM, KOUNT)
	CALL RUNUUO (IERR, PRGNAM, KOUNT, ICCL)

IERR	= (OUTPUT) Error code if the next program cannot be run.
	Error codes are 0=No such program,  1=No such PPN,  2=Protection
	failure, 12 octal (10 decimal)=No such device.

PRGNAM	= (INPUT) Array or literal containing the name of the program to
	run.  Must be in the form of 'DEV:PROG.EXT[ppn]'.  EXT is
	usually left off.  If a PPN is given, it must be last.  DEV is
	optional and defaults to 'DSK:', so you may run your programs.
	You must specify 'SYS:' for system programs.  Examples:
	'SYS:FORTRA', 'DSK:TEST.SAV[60,60]'.

KOUNT	= (INPUT) Number of characters in the program name.

ICCL	= (Optional INPUT) RUN-offset.  If you leave a TMPCOR file for a
	system program, ICCL must be 1 or else the program will not even
	look for the TMPCOR file.

    All  files  must be explicitly closed befor calling RUNUUO.  Another
way to run a new program is by calling EXITGO.  See the descriptions  of
SAVRUN and EXITGO.
SUBTTL	Calling sequence -- OUTSTR

    OUTSTR  outputs  the  buffer, with or without a <CR><LF> at the end.
This routine is not intended to replace FORTRAN  formatted  output,  but
provides a simple way of typing character strings to the TTY.

	CALL OUTSTR (ICRLF, BUFFER, KOUNT)

ICRLF	= (INPUT) Carriage control.  ICRLF=0 works like $ format.
	-2 = Output a formfeed before BUFFER, but no CRLF after.
	-1 = Output a formfeed before BUFFER, and a CRLF after.
	 0 = Do not output CRLF after BUFFER, used as a prompt.
	 1 = Output a CRLF after BUFFER, this is the normal case.
	 N = Output N CRLFs, creating N-1 blank lines after BUFFER.

BUFFER	= (INPUT) Literal or array of characters to be output

KOUNT	= (INPUT) Number of characters in BUFFER.  If the characters to
	  be output are in a literal, KOUNT can be zero.  Example:
		CALL OUTSTR (0, 'What is your answer? ', 0)
SUBTTL	Calling sequence -- SAVRUN

    The primary function of SAVRUN is to look for a /RUN: command.  It also
does general clean-up on the BUFFER.

	CALL SAVRUN (IOPT, BUFFER, KOUNT, LENGTH, LASTC)

IOPT	= (INPUT) Options.  These may be added, ie, IOPT=2+4+8+16
	  0 or -1 = Do everything
	  1 = Act upon /RUN, /RUNOFFSET, /EXIT, or /HELP switches and start
	      reading an indirect file if the first character is "@".
	  2 = Remove comments which start with ";" or "!".
	  4 = Remove all control characters except tab.
	  8 = Remove leading spaces and/or tabs.
	 16 = Change tabs or multiple spaces to a single space.
	 32 = Convert lowercase to upper.
	 64 = Convert <> to [] (for APPLEs and 2741 terminals).
	128 = Convert tabs to multiple spaces, if option 16 is not included.

BUFFER	= (INPUT) The array of characters to be searched.
	  (OUTPUT) The cleaned-up array.

KOUNT	= (INPUT) The number of characters to search.
	  (OUTPUT) The number of character left in BUFFER.

LENGTH	= (INPUT) Number for the size of BUFFER in words.

LASTC	= (INPUT) The last character in the BUFFER.  If the user typed
	Control-Z or if /EXIT was seen for IOPT=32, LASTC will be 26.
		IF (LASTC.EQ.26) CALL EXITGO	! Time to exit

    This routine will allow your FORTRAN programs to respond to commands
much like the system CUSPS.  After SAVRUN  gets  done,  the  significant
characters  in  the  BUFFER  will  be  shifted to the left and all extra
characters removed.  You can then check what's left and let your program
decide  what to do.  Note that you will not have to worry about checking
for lowercase or tabs since SAVRUN has converted these characters.

    The /HELP switch can be abbreviated to /H.   SAVRUN uses the name of
your program in finding help, which can be in your disk area or on HLP:.

    The  /RUN  switch must be followed by the name of a program, such as
"/RUN:SYS:FORTRA".  The device  defaults  to  SYS:  since  that  is  the
behavior  of  the  system  CUSPS.   The  /RUN  command  is  not executed
immediately, but sets LASTC to 26.
   For all you RSTS/E users, you can call SAVRUN with "PUSHJ P,CVT$$".
Options 4, 8, 16, 32, and 64 work like RSTS, but trailing spaces are
always suppressed and characters in quotes are never changed.  (RSTS
option 1 trims the parity bit, 2 discards all spaces and tabs, 4 discards
CR+LF+FF+ESC+RUBOUT+NULL, 8 discards leading spaces, 16 reduces tabs to
1 space, 32 converts to uppercase, 64 converts [] to (), 128 discards
trailing spaces, 256 does not alter characters in quotes.)
   If you want to output a message but without trailing blanks, use
option 4 to set KOUNT, the number of words to output is (KOUNT+4)/5.

	KOUNT = LENGTH * 5		! Set to max, scan entire BUFFER
	CALL SAVRUN (4,BUFFER,KOUNT,LENGTH,LASTC) ! Throw away control chars
	IWORDS = (KOUNT + 4) / 5	! Get number of A5 words in message
	TYPE 10,(BUFFER(I),I=1,IWORDS)	! Suppress all but last 4 spaces




SUBTTL	Calling sequence -- JBINFO


   JBINFO will return information about your job.

	IVALUE = JBINFO(ICODE)

IVALUE	= (OUTPUT) The information returned.

ICODE	= (INPUT) The code for what piece of information to return.

  "0 =  0 = The value in the KA or KI CPU console switches (0 for KL or KS)
  "1 =  1 = Your job number
  "2 =  2 = Your PPN (octal in both halves)
  "3 =  3 = Name of your program (in SIXBIT)
  "4 =  4 = The runtime your job has accumulated since LOGIN
  "5 =  5 = The kilo-core ticks charged to your job
  "6 =  6 = Your privilege bits (octal)
  "7 =  7 = Causes your job to sleep for one second
 "10 =  8 = Get line characteristics and number, ITTY=(JBINFO(8).AND."777)
 "11 =  9 = The date as (((year-1964)*12 + month-1)*31 + day-1
 "12 = 10 = Time of day, in integer milliseconds since midnight
 "13 = 11 = Universal date/time, divide by 262144 to get days since 17-Nov-1858
 "14 = 12 = The day of the week (Sunday=1, Saturday=7)
                (GETTAB values for 13-18)
 "23 = 19 = Check typeahead, 0=none, 1=some characters, 2=complete line ready
            (I=JBINFO(19) also cancels the effect of Control-O)
 "24 = 20 = Input a single character (for 'Y' or 'N' answer) in an A1 format
 "25 = 21 = Input a single character, right justified in an R1 format (1-127)
 "26 = 22 = Node number.  At CSM, KL1091 = 1 and KS2020 = 2
 "30 = 24 = Get first 5 letters of user name, in an A5 format
 "31 = 25 = Get next 5 letters of user name
 "32 = 26 = Get last 2 letters of user name and 3 blanks

	Other codes match those for the GETTAB TOPS10 Monitor Call.
SUBTTL	Calling sequence -- EXIT0, EXIT1, and EXITGO

All files must be explicitly closed before calling these routines.

	CALL EXIT0
	CALL EXIT1
	CALL EXITGO

EXIT0	Returns to the monitor and types the message "EXIT".  Cannot be
	continued.  The standard FORTRAN routine "CALL EXIT" is the one
	that closed all files and types  "END OF EXECUTION ...".  EXIT0
	is a little quieter.  NOTE: RANDOM and BINARY output files must
	be closed by CLOSE(UNIT=n).

EXIT1	Returns to the monitor by typing a dot.  Can be continued. EXIT1
	does not check for open files.   If you type anything other than
	".CONTINUE", any open files may be lost.

EXITGO	Stops execution of the program.  Returns to the monitor if there
	is not another program to run.   The program to run is set up by
	SAVRUN if it receives a command like "/RUN:FORTRA".  EXITGO will
	complain if it finds any files open, and close them for you.

	EXITGO is the suggested way of to stop your program.
SUBTTL	Calling sequence -- HELPER

    HELPER types the help file for your program.

	CALL HELPER (0)
	CALL HELPER (IARG)

IARG	= (INPUT) Octal number representing the name in SIXBIT, or zero
	to use the name of your program.

    Ask a MACRO programmer if you need to  know  the  translation  of  a
particular name.  For example, 'DIRECT' is 445162454364 so you could use

	CALL HELPER ("445162454364)

Usually you want to use zero.   This means that if your program has been
saved as TEST01, HELPER will look for DSK:TEST01.HLP
SUBTTL	Calling sequence -- MATCH

    MATCH checks to see if the command typed in by the user matches a
list of commands.  It accepts valid abbreviations to commands.

	CALL MATCH ('LIST,OF,COMMANDS,ETC',BUFFER,KOUNT,LENGTH,INDEX)
	      GOTO (100, 200,   300,  400) INDEX
	CALL MATCH ('ONE111,TWO222',BUFFER,KOUNT,LENGTH,INDEX,DNAME)
	      GOTO (  1000,  2000) INDEX

LIST	= (INPUT) A list of commands in quotes, separated by commas.  The
	commands can be up to 6 letters and numbers each, no spaces.

BUFFER	= (INPUT) The array with the command, usually read in by INCHWL.
	= (OUTPUT) The array with the command removed, if there is a match.

KOUNT	= (INPUT) The number of characters in BUFFER.
	= (OUTPUT) The number of characters left in BUFFER.

LENGTH	= (INPUT) The size of BUFFER.

INDEX	= (OUTPUT) Small positive number if a match was found.

DNAME	= (optional OUTPUT) The matched command is stored in this
	DOUBLE PRECISION variable in an (A6) format.

    If INDEX is returned as +1, it means that the command matched the 1st
    one on the list, +2 for the second, etc.  DNAME gets the full command,
    even if it was abbreviated in the BUFFER.
INDEX= 0 means that BUFFER is all blanks.
INDEX=-1 means that the command in BUFFER does not match any on the list.
INDEX=-2 means that the command is ambiguous.

    The MATCH routine always removes any leading spaces or tabs from BUFFER.
If a match was found, the command and the first space or tab is removed from
BUFFER.  This is so that MATCH can be called with a second list to decode
any sub-commands.
SUBTTL	Calling sequence -- Examples

CC  This shows how to use SAVRUN
100	CALL INCHWL ('*',  BUFFER, KOUNT, LENGHT, LASTC) ! Get command
	CALL SAVRUN (-1, BUFFER, KOUNT, LENGTH, LASTC)	! Look at it
	CALL MYPROG (BUFFER)		! Do your processing
	IF (LASTC.EQ.26) CALL EXITGO	! Stop if we should
	GOTO 100			! Else loop
	END

---------------------------------------------------------------------

CC  This shows a complete program using the RUNLIB routines
CC  This program understands only "STOP" and "CHAIN" (and /EXIT/HELP/RUN)
	DIMENSION BUFFER(27)			!135 characters
	LENGTH=27				!Size of buffer in words
	CCLNAM='ABC'				!Prompt and name of file

	CALL RESCAN (CCLNAM, BUFFER, KOUNT, LENGTH, LASTC)	!Fill buffer
	IF (KOUNT .GT. 0) GOTO 110		!Skip INCHWL if have command

100	CALL INCHWL (CCLNAM, BUFFER, KOUNT, LENGTH, LASTC) !Get another command
CC  Here with a command, process it
110	CALL SAVRUN (-1, BUFFER, KOUNT, LENGTH, LASTC)
	LEN = (KOUNT + 4) / 5			!Round up to next full word
	TYPE 120, (BUFFER(JJ), JJ=1,LEN)	!No trailing spaces
120	FORMAT (' You typed:  ', 27A5)
	CALL MATCH ('CHAIN,STOP',BUFFER,KOUNT,LENGTH,INDEX,DNAME)
	IF (INDEX.GT.0) TYPE 130, DNAME
130	FORMAT (' The command was ', A6)
	GOTO       (  200,  300 ) INDEX		!Go of INDEX=1 or 2
	IF (LASTC.EQ.26) CALL EXITGO		!Stop on Control-Z or /EXIT
	GOTO 100				!Loop until done

CC  Here if we get a "CHAIN" command
200	CALL RUNUUO (IERR, BUFFER, KOUNT)	!Run next program
	TYPE 210, IERR, (BUFFER(JJ), JJ=1, LEN)	!Type error message
210	FORMAT (' ?Error code ', O2, 3X, 27A5)
	CALL EXIT0		!Return to the monitor, never to continue

CC  Here if we get a "STOP" command
300	CALL EXITGO				!Give /RUN a chance
	END
SUBTTL	Calling sequence -- Writing a FORTRAN program that compiles itself

	PROGRAM TESTER
CC To run this program, do the following:
CC  	.COPY = FOR:TESTER.REL, F.FOR, RUNLIB.REL
CC	.EXECUTE TESTER.REL, F.FOR, RUNLIB.REL
CC If you type in an illegal function, you must start over by:
CC	.COPY = FOR:F.FOR
CC	.EXECUTE

	DIMENSION BUFFER(27)				!135 characters

	LENGTH=27					!Size of BUFFER
	CALL RESCAN ('TST', BUFFER, KOUNT, -LENGTH, LASTC) !Check for F(X)
	IF (KOUNT .GE. 0) GOTO 2000			!If first time thru
	IWORDS = (KOUNT + 4) / 5			!Number of words
1000	TYPE 1010, (BUFFER(I), I=1,IWORDS)		!Type the function
1010	FORMAT ('0The function is F(X) = ', 27A5)
	TYPE 1015					!Ask for values
1015	FORMAT ('0What are XMIN, XMAX, and XINC? ',$)
	ACCEPT 1020, XMIN, XMAX, XINC			!Get parameters
1020	FORMAT (3G)
	IF (XINC .EQ. 0.0) XINC = 1.0			!Default increment
	TYPE 1030, (BUFFER(I), I=1,IWORDS)		!Print heading
1030	FORMAT ('0    X', 14X, 27A5)

	DO 1040 XX = XMIN, XMAX, XINC			!Set up loop
		X = XX	!Prevents "Possible modification of index in loop"
		Y = F(X)				!Evaluate function
1040		TYPE 1020, X, Y				!Show the values

	CALL OUTSTR (0,Do you want more values? ',0)
	IANS = JBINFO(20)				! Get single letter ans
	IF (IANS .EQ. 'Y' .OR. IANS .EQ. 'y') GOTO 1000	!Lowercase too
	CALL OUTSTR (0,' Do you want to try another function? ',0)
	IANS = JBINFO(20)				!Get answer
	IF (IANS .EQ. 'Y' .OR. IANS .EQ. 'y') GOTO 2000	!Lowercase too
	CALL EXITGO					!Return to monitor

Continued on next page
Compiler program continued

CC  Here to get a new function
CC  Note that this section does not use any FORTRAN I/O to the TTY

2000	CALL OUTSTR (0, 'Type in the function; F(X) = ', 0) !Give prompt
	CALL INCHWL ('   ', BUFFER, KOUNT, LENGTH, LASTC) !Get reply
	CALL SAVRUN (-1,BUFFER, KOUNT, LENGTH, LASTC)	!Clean it up
	IF (KOUNT .LE. 0) GOTO 2000			!Ask again
	IF (LASCT.EQ.26) CALL EXITGO			!Stop if /EXIT
	IWORDS = (KOUNT + 4) / 5			!Number of words
	OPEN (UNIT=1, DEVICE='DSK', FILE='F.FOR', ACCESS='SEQOUT')
	WRITE (1,2010) (BUFFER(I), I=1,IWORDS)		!Write the function
2010	FORMAT ('        FUNCTION F(X)', /, '        F = ', 27A5)
	WRITE (1,2030)					!Finish it up
2030	FORMAT ('        RETURN', /, '        END')
	CLOSE (UNIT=1)					!Finish the file
	CALL TMPCOR ('TST', BUFFER, KOUNT)		!Remember the function
	CALL TMPCOR ('LNK', 'TESTER,F,RUNLIB/E/G', 19)	!Message for LINK
	CALL TMPCOR ('FOR', 'F=F/RUN:LINK/RUNOFF', 19)	!Message for FORTRA
	CALL RUNUUO (IERR,  'SYS:FORTRA', 10, 1)	!Run the compiler
	STOP '?Cannot run SYS:FORTRA'

	END						!Of TESTER
SUBTTL	Appendix - Calling RUNLIB from MACRO programs


These routines preserve all accumulators.

    Most routines have alternate entry names, so that MACRO programs can
avoid  using  names of monitor calls when referring to subroutines.  The
alternate names start  with  a  dollar-sign  and  have  the  first  five
characters  of  the  FORTRAN entry names.  For instance, "$INCHW" is the
alternate name for "INCHWL" - a subroutine which does TTCALL's and more.

The MACRO calling sequences are:
	L=16			;Link to arg list
	P=17			;Push-down-list pointer

	MOVEI	L,TMPARG	;Args for TMPCOR
	PUSHJ	P,$TMPCO	;Call TMPCOR

	MOVEI	L,RUNARG	;Args for RUNUUO
	PUSHJ	P,$RUNUU	;Call RUNUUO

	MOVEI	L,CMDARG	;Args for RESCAN
	PUSHJ	P,$RESCA	;Call RESCAN

	MOVEI	L,CMDARG	;Same args for INCHWL
	PUSHJ	P,$INCHW	;Call INCHWL

	MOVEI	L,SAVARG	;Args for SAVRUN
	PUSHJ	P,$SAVRU	;Call SAVRUN (also known as CVT$$)

	PUSHJ	P,EXITGO	;No args for EXITGO

	PUSHJ	P,EXIT0		;No args for EXIT0

	PUSHJ	P,EXIT1		;No args for EXIT1

	MOVE	1,[SIXBIT /NAME/] ;Put name in AC1
	PUSHJ	P,.HELPR	;Call HELPER

	MOVEI	L,OUTARG	;Args for OUTSTR
	PUSHJ	P,$OUTST	;Call OUTSTR

	MOVEI	L,MATARG	;Args for MATCH
	PUSHJ	P,$MATCH	;Call MATCH
;Example of argument blocks for MACRO routines

	-3,,0			;3 args for TMPCOR
TMPARG:	NAME			;Addr of name of TMP file
	BUFFER			;Starting addr of array for buffer
	KOUNT			;Addr of integer for count

	-3,,0	;Or -4,,0	;3 or 4 args for RUNUUO
RUNARG:	IERR			;Addr to put error code
	PRGNAM			;Start of program name in ASCII
	KOUNT1			;Addr of number of chars in PRGNAM
	ICCL			;Optional addr of the run offset

	-5,,0			;5 args for RESCAN and INCHWL
CMDARG:	NAME			;Addr of prompt text
	BUFFER			;Start addr of array
	KOUNT			;Addr of integer
	LENGTH			;Addr of word containing size of BUFFER
	LASTC			;Addr to store last character

	-5,,0			;5 args for SAVRUN
SAVARG:	FLAG			;Addr of flag, bit 0 gets set (negative=.TRUE.)
	BUFFER			;Starting addr of array
	KOUNT			;Addr of integer, count of characters
	LENGTH			;Addr of word containing size of BUFFER
	LASTC			;Addr to store last character

	-3,,0			;3 args for OUTSTR
OUTARG:	ICC			;Addr of carriage control
	BUFFER			;Starting addr of array
	KOUNT			;Addr of number of chars

	-6,,0			;6 args for MATCH (the last 1 is optional)
MATARG:	[ASCIZ /LIST,OF,COMMANDS,SEPARATED,BY,COMMAS/]
	BUFFER			;Array with command to be processed
	KOUNT			;Addr of integer
	LENGTH			;Addr of word containing size of BUFFER
	INDEX			;Addr of integer for match
	DNAME			;(optional) Addr of double-precision variable

NAME:	ASCII	/ABC  /		;Prompt or name of TMP file
BUFFER:	BLOCK	BUFSIZ		;Array
KOUNT:	BLOCK	1		;Integer character count
LENGTH:	BUFSIZ			;Word containing size of BUFFER
LASTC:	BLOCK	1		;Integer for last char, right justified
FLAG:	-1			;-1 to do everything
PRGNAM:	ASCII	/DSKB:TESTER.EXE[10,10]/	;Name of program in ASCII
KOUNT1:	^D22			;Number of characters in PRGNAM
IERR:	BLOCK	1		;Gets error code if RUNUUO fails
ICC:	0			;0 for CRLF, -1 to suppress CRLF
ICCL:	1			;Run-offset, 0 or 1
INDEX:	BLOCK	1		;Number denoting match
DNAME:	BLOCK	2		;Command name stored in A6 format
|  ;End of comment
	LIST
SUBTTL	LOWSEG data area

IFDEF  TOPSEG,<	TWOSEG >	;Make these routines reentrant

	RELOC	0		;Put COMBUF in the LOWSEG
COMBUF:	BLOCK	CBUFSZ		;Temp buffer (TMPCOR in 701 is 510 words max)
CBUFND:	BLOCK	1		;Zero word at end of COMBUF for ASCIZ
CPOINT:	BLOCK	1		;Byte pointer into COMBUF

SAVECH:	BLOCK	1		;Left-over character from COMBUF
OLDBP:	BLOCK	1		;Old byte pointer
OLDC:	BLOCK	1		;Old byte count

CCLNAM:	BLOCK	1		;Name of DSK:nnnxxx.TMP file
CCLSIZ:	BLOCK	1		;Number of blocks in file, 0 at EOF
CCLBLK:	BLOCK	1		;Block to read into COMBUF next

TEMP20:	BLOCK	^D20		;COMCH - Place to save all ACs
				;MATCH - Commands in SIXBIT
				;SAVRUN - Used when expanding tabs
HLPPPN==TEMP20+0		;HELPER - UFD program came from
HLPBFR==TEMP20+1		;HELPER - Buffer header
HIDEV==TEMP20+0			;RUNUUO - Data about old HISEG,
HINAM==HIDEV+1			;RUNUUO -  in case RUN uuo fails
HIPPN==HINAM+3			;RUNUUO -  ...
ERCODE==HIPPN+2			;RUNUUO - Error code
JOBHRL==ERCODE+1		;RUNUUO - Nonzero if HISEG present

SAVE0:	BLOCK	1		;Place to store AC0
SAVE1:	BLOCK	17		;Area to save AC1 through AC17
SAVEND=.-1			;Last loc of save area

GOFSET:	BLOCK	1		;Run-offset, set by SAVRUN for EXITGO
GODEV:	BLOCK	1		;Device for EXITGO
GOPROG:	BLOCK	5		;Program to run
GOEND=.-1			;End of BLT

PRGZER==.			;Start of area to zero, set by SCAN
PRGDEV:	BLOCK	1		;Device name
PRGNAM:	BLOCK	1		;Program name
PRGEXT:	BLOCK	2		; extension
PRGPPN:	BLOCK	2		;Directory and core assignment
PRGLST==.-1			;End of area to zero
MYPPN:	BLOCK	1		;Default for [,]



SUBTTL	Actual start of routines
IFDEF  TOPSEG,<	RELOC  400000 >	;Put code in HISEG
SUBTTL	TMPCOR -- Write TEMP file

;	CALL TMPCOR (NAME, BUFFER, KOUNT)

HELLO	(TMPCOR)		;Set up entry point
	PUSHJ	P,GETNAM	;Get CCL name in left half of T1
	SKIPG	T2,@CNT(L)	;Get size of message
	 JRST	RETURN		;Must have positive byte count
	MOVNI	T2,4(T2)	;Round up to next word, make negative
	IDIVI	T2,5		;Make into a word count
	MOVEI	C,@BUF(L)	;Get addr of message
	SUBI	C,1		;Form an IOWD
	HRL	C,T2		; in C
	MOVE	T2,C		;Get the IOWD
	MOVE	T3,[.TCRWF,,T1]	;Write file, args start at T1
	TMPCOR	T3,		;Write message into TMPCOR
	  SKIPA			;TMPCOR failed, try DSK:
	JRST	RETURN		;File written OK, return from TMPCOR

;Here when TMPCOR UUO failed.

IFN FT603,<	;Since FOROTS doesn't use channel 0, we can use it temporarily
	PUSHJ	P,OPNDSK	;Open channel 0 in dump mode, set up T1-T4
	ENTER	%0,T1		;Create the file
	  JRST	RETURN		;We tried
	OUTPUT	%0,C		;Write the message
	CLOSE	%0,		;Finish the file
	RELEAS	%0,		;Done with channel 0
>  ;End of IFN FT603
IFE FT603,<PRINTX ?The 701-only TMPCOR input has not been debugged, @TMPCOR>
				;Return from TMPCOR

SUBTTL	RETURN -- Return to main program

;Note: "JRST RETURN" works at any time, regardless of what is on the stack

RETURN:	MOVE	F,[SAVE1,,T1]	;Restore the AC's
	BLT	F,P		;This takes an extra instruction,
	MOVE	F,SAVE0		; but always keeps P as a valid PDL pointer
	POPJ	P,		;Return to caller (using original PDL)
SUBTTL	RUNUUO -- Run next program

;	CALL RUNUUO (IERR, PRGNAM, KOUNT, ICCL)

HELLO	(RUNUUO)		;Set up entry point
	PUSHJ	P,CLOSFL	;Close files, type CRLF if needed
	SKIPG	C,@CNT(L)	;Get count of chars in filespec
	 JRST	RETURN		;No program to run

IFDEF TOPSEG,<	;The CORE UUO and RUN UUO must be in the LOWSEG
	MOVE	T1,[RUNIT,,COMBUF];Copy the routine into the LOWSEG
	BLT	T1,RUNEND	; ...
	SETZM	CPOINT		;Any data in COMBUF has been wiped out
>  ;End of IFDEF TOPSEG

	MOVEI	BP,@BUF(L)	;Get addr of buffer
	HRLI	BP,(POINT 7,)	;Make into a byte pointer
	MOVE	T1,(BP)		;Get the first word
	JUMPE	T1,NOPROG	;First word can be spaces, but not null
	PUSHJ	P,FILENM	;Scan for file name

;If extension was given, try to LOOKUP the .EXE file

	MOVE	T1,PRGNAM	;Get the program name
	JUMPE	T1,NORUN	;File not found, error code 0
	SKIPN	T3,PRGDEV	;Get the PRGDEV
	 MOVSI	T3,'DSK'	;None given, let user run his other programs
	MOVEM	T3,PRGDEV	;Default to DSK
	SKIPN	PRGEXT		;Was an extension given
	 JRST	NOLOOK		;No, let the monitor track down the extension

;Since the RUN uuo will reset I/O channel 0, it is OK to use it here

	SETZB	T2,T4		;ASCII mode, no buffers
	OPEN	%0,T2		;Open a channel
	  JRST	[MOVEI	T1,ERNSD% ;No such device
		 JRST	NOPROG	] ;Return error code
	MOVE	T2,PRGEXT	;Get the extension
	SETZ	T3,		;Make a 4 word LOOKUP block
	MOVE	T4,PRGPPN	;Look in the right directory
	LOOKUP	%0,T1		;See if the EXE file is there
	  JRST	[HRRZ	T1,T2		;Get error code
		 CAIE	T1,ERPRT%	;Check for protection failure
		  JRST	NOPROG		;No, give up
		 JRST	NOLOOK]		;Yes, may be execute only
SUBTTL	RUNUUO -- Prepare to go

NOLOOK:	RELEAS	%0,		;Undo the LOOKUP (and everything else)
	MOVE	T1,[-2,,.GTPPN]	;Get the directory the HISEG came from
	GETTAB	T1,		; ...
	  SETZ	T1,		;Assume default directory
	MOVEM	T1,HIPPN	;Save it
	MOVE	T3,[-2,,.GTPRG]	;Get the name of the HISEG
	GETTAB	T3,		; ...
	  SETZ	T3,		;No HISEG
	MOVEM	T3,HINAM	;Save it
	MOVE	T1,[-2,,.GTDEV]	;Get the device that the HISEG came from
	GETTAB	T1,		; ...
	  MOVSI	T1,'DSK'	;Assume DSK
	MOVEM	T1,HIDEV	;Save it
	HRRZ	T1,.JBHRL##	;Get highest addr of HISEG
	MOVEM	T1,JOBHRL	;Save it to be tested later for nonzero
	SETZ	T2,		;Assume runoff of 0
	HLRZ	T1,-1(L)	;Get number of args
	CAIGE	T1,-LEN		;Is there a run-offset?
	 MOVE	T2,@LEN(L)	;Yes, get it

IFDEF TOPSEG,<
	JRST	COMBUF		;Say bye-bye to this HISEG
RUNIT:	PHASE	COMBUF		;Assemble addresses for the LOWSEG
>  ;End of IFDEF TOPSEG

	MOVSI	T1,1		;1 in left half and 0 in right
	CAMN	T3,[SIXBIT/FOROTS/] ;Version 5A or earlier?
	CORE	T1,		; gets rid of the HISEG
	  JFCL			;Ignore error
	MOVEI	T1,PRGDEV	;Point to args
	HRL	T1,T2		;Runoffset of 1 or 0
	RUN	T1,		;Call next program
	  ;ERROR return

;The accumulators and all I/O channels have been blown
;Still in PHASE COMBUF
SUBTTL	RUNUUO -- Error recovery

;If your HISEG was nonsharable and not FOROTS, you will die horribly!
;No problem if your HISEG was sharable.

	MOVE	T2,HINAM	;Get name of HISEG
	CAME	T2,[SIXBIT/FOROTS/] ;OK if version 5A or earlier,
	 JRST	NOPROG		; do not play with FOROT6 or FOROT7
	MOVE	T2,JOBHRL	;Was there a HISEG?
	JUMPE	T2,NOPROG	;No, don't even try a GETSEG
	MOVEM	T1,ERCODE	;Save the error code
	MOVEI	T1,HIDEV	;Point to HISEG args
	GETSEG	T1,		;Restore HISEG
	  SKIPA			;Error
	JRST	GOTSEG		;Success
	OUTSTR	TMPCRH		;GETSEG failed
	MOVEI	T1,FOROTS	;This is a FORTRAN callable routine
	GETSEG	T1,		; so try for FOROTS
	  OUTSTR TMPNOT		;"not "
	OUTSTR	TMPFOR		;"set up"

GOTSEG:	MOVE	T1,ERCODE	;Get error code
NOPROG:	RELEAS	%0,		;Reset the I/O channel
NORUN:	MOVE	L,SAVE0+L	;Restore AC16
	MOVEM	T1,@COD(L)	;Return error code
	MOVSI	P,SAVE1		;Source addr
	HRRI	P,T1		;Dest addr
	BLT	P,P		;Restore the AC's, especially P
	POPJ	P,		;Return to caller
				;Remember, this routine expects a sharable HISEG

	.DIRECTIVE FLBLST	;List only first line of binary
TMPCRH:	ASCIZ	/%TMPCRH cannot restore HISEG
%TMPFOR FOROTS is /
TMPNOT:	ASCIZ	/not /
TMPFOR:	ASCIZ	/set up
/
FOROTS:	SIXBIT	/SYS/		;In case we can't get the original HISEG back
	SIXBIT	/FOROTS/
	EXP	0,0,0,0		;Must have 4 zeros

IFDEF	TOPSEG,<
RUNEND=.-1			;End of BLT
	DEPHASE			;End of PHASE COMBUF
IFG <RUNEND-COMBUF>-CBUFSZ,<PRINTX ?COMBUF is not big enough for RUNIT code>
>  ;End of IFDEF TOPSEG
SUBTTL	INCHWL -- Give prompt and input a full line from TTY

;	CALL INCHWL (NAME, BUFFER, KOUNT, LENGTH, LASTC)

HELLO	(INCHWL)		;Set up entry point
	SKIPE	CPOINT		;CCL file already in COMBUF?
	 JRST	INCHW0		;Yes, go get it

	PUSHJ	P,PROMPT	;Output prompt if necessary

	PUSHJ	P,REDTTY	;Get a line from the terminal into COMBUF

;Here when a command is in COMBUF.

INCHW0:	PUSHJ	P,CLRBUF	;Clear BUFFER, KOUNT, LASTC, set up C and BP

;Copy one line from COMBUF to BUFFER

INCHW1:	PUSHJ	P,COMCH		;Get a char from COMBUF
	  JRST	INCHW2		;End of line
	SOJL	C,INCHW1	;Look for end of line if BUFFER is full
	IDPB	CH,BP		;Put in user's buffer
	AOS	@CNT(L)		;Count this char
	JRST	INCHW1		;Loop till end of line

;Here at when one line from COMBUF has been transfered to the caller

INCHW2:	MOVEM	CH,@CHR(L)	;Return the end-of-line char in LASTC
	SKIPN	CCLNAM		;If not reading CCL file,
	 SETZM	CPOINT		; COMBUF is now empty
	JUMPN	CH,RETURN	;Return if not end of CCL file

;Here at end of CCL file.  If it did not end with a linefeed, set LASTC=0
;and return real EOF next time.

	SKIPN	@CNT(L)		;If nothing in BUFFER at EOF,
	 JRST	[SETOM	@CNT(L)	  ; show EOF by KOUNT=-1
		 MOVEI	CH,CZ	  ; and by LASTC=26
		 MOVEM	CH,@CHR(L); (Control-Z is EOF from terminal)
		 JRST	RETURN	] ;CPOINT is zero, so INCHWL will prompt
	MOVE	T1,[POINT 7,CBUFND] ;Point to 5 nulls at end of CBUF
	MOVEM	T1,CPOINT	;Set up to recognize EOF next time
	JRST	RETURN		;Return with KOUNT#0 and LASTC=0
SUBTTL	INCHWL -- Prompt the user

PROMPT:	SKIPE	T1,@NAM(L)	;Get the prompt
	CAMN	T1,BLANKS	;Is it all blanks?
	 POPJ	P,		;Yes, punt the prompt
	PUSHJ	P,TCRLF		;Type CRLF if needed
	PUSHJ	P,GETNAM	;Convert prompt to SIXBIT in T1		<
	HRRI	T1,'>  '	;Make a prompt
	MOVE	T2,[POINT 6,T1]	;SIXBIT in T1
	MOVEI	T3,5		;3 + bracket + space

PROMP1:	ILDB	CH,T2		;Get a char
	ADDI	CH,SP		;Convert to ASCII
	OUTCHR	CH		;Type it
	TLNE	T1,007777	;Don't loop if single char prompt
	 SOJG	T3,PROMP1	;Loop
	POPJ	P,		;Return from PROMPT


;Routine to output CRLF if not at left margin already, and cancel Control-O

TCRLF:	PJOB	T2,		;Get job number
	TRMNO.	T2,		;Now the TTY UDX
	  JRST	TCRLF3		;If detached, go into 'TO' wait state
	MOVEI	T1,.TOSOP	;Skip if output in progress

TCRLF1:	MOVE	T3,[2,,T1]	;2 args starting in T1
	TRMOP.	T3,		;Is output buffer empty?
	  JRST	TCRLF2		;Yes
	MOVEI	T3,^D250	;No, wait a quarter second
	HIBER	T3,		;ZZZ
	  JRST	TCRLF2		;Cannot fail
	JRST	TCRLF1		;Check now

;Cancel Control-O

TCRLF2:	   IFN FT701,<	;Watch out for deferred echo
	MOVEI	T1,.TOOSU+.TOSET;Change output suppression (.TOOSU==1045)
	MOVEI	T3,0		;Clear the bit
	MOVE	T4,[3,,T1]	;Point to args
	TRMOP.	T4,		;Clear Control-O without starting deferred echo
>  ;End of IFN FT701
	  SKPINL		;Do it the 6.03 way
	   JFCL

;Type CRLF if not already at left margin

	MOVE	T3,[2,,T1]	;2 args starting in T1
	MOVEI	T1,.TOHPS	;To read horizontal position
	TRMOP.	T3,		;Read position
	  MOVEI	T3,0		;Should not happen
	SKIPE	T3		;Position zero is left margin
TCRLF3:	OUTSTR	CRLF		;Send <CR><LF>
	POPJ	P,		;Return from TCRLF
SUBTTL	RESCAN -- Check monitor line, TMPCOR or DSK:nnnPRG.TMP

;	CALL RESCAN (NAME, BUFFER, KOUNT, LENGTH, LASTC)

HELLO	(RESCAN)		;Set up entry point
	PUSHJ	P,CLRBUF	;Clear BUFFER, KOUNT, and LASTC
	SETZB	C,CCLNAM	;Clear CCL file flag and byte count

	SKIPGE	@LEN(L)		;Negative size means
	 JRST	REDBIN		; to read in binary mode

	PUSHJ	P,RSCAN		;Try rescanning the command line
	JUMPN	C,INCHW0	;Jump to INCHWL code if something there

	PUSHJ	P,REDTMP	;Try reading TMPCOR
	MOVEM	C,CCLNAM	;Make nonzero if anything there
	JUMPN	C,RESCA1	;Set KOUNT to -1 for TMPCOR CCL file

	PUSHJ	P,READSK	;Try reading DSK:nnnXXX.TMP, success sets CCLNAM
	SKIPN	C		;If nothing was found,
	 SETZM	CPOINT		; clear the pointer so INCHWL will prompt
	JUMPE	C,RETURN	;Leave KOUNT zero if no command anywhere
	SOS	@CNT(L)		;Set KOUNT to -2 for disk CCL file

;Here if CCL file was found.  Tell user to call INCHWL to read command file
;one line at a time.

RESCA1:	SOS	@CNT(L)		;Set KOUNT negative to signify CCL input
	JRST	RETURN		;Return from RESCAN
SUBTTL	RESCAN -- Read binary data when LENGTH is negative

;Here to read binary file, data goes directly into BUFFER.

REDBIN:	PUSHJ	P,GETNAM	;Get CCL name in T1
	MOVEI	T2,@BUF(L)	;Get addr of buffer
	SUBI	T2,1		;IOWDs need addr-1
	HRL	T2,@LEN(L)	;Get negative word length
	MOVE	C,[.TCRDF,,T1]	;Read and delete file, args in T1
	TMPCOR	C,		;Try to input file
	  PUSHJ	P,DSKBIN	;Not there, try disk
	IMULI	C,5		;Convert words to bytes
	MOVEM	C,@CNT(L)	;Tell user the byte count
	JRST	RETURN		;Let user decode binary data

DSKBIN:	MOVE	C,T2		;Save the IOWD
	PUSHJ	P,OPNDSK	;Open %0 to DSK in dump mode
IFE FT603,<PRINTX ?The 701-only binary input has not been debugged, @DSKBIN>
	LOOKUP	%0,T1		;Read the file
	  TDZA	T4,T4		;Pretend it's 0 words long
	INPUT	%0,C		;Read data into BUFFER
	RELEAS	%0,		;Done with channel
	HLRE	C,T4		;Get negative length in words
	MOVMS	C		;Positive word count
	POPJ	P,		;Tell user and return
SUBTTL	RESCAN -- Do RESCAN uuo

;Check for ".PROGRAM COMMAND", ".RUN PROGRAM-COMMAND" or ".RU PROGRAM(COMMAND)"
;Remove matching close parenthesis

RSCAN:	SETZB	C,CCLSIZ	;In case this fails, and don't read old CCL file
	MOVEI	C2,0		;Clear parenthesis counter
	RESCAN	1		;Is there a rescannable line?
	 SKPINL			;Yes, is it really there?
	  POPJ	P,		;No, return with C=0

	PUSHJ	P,REDTTY	;Read a line from terminal into COMBUF

	MOVE	BP,CPOINT	;Set to read from COMBUF
	MOVEI	C,CBUFS5	;Set byte count very high
	PUSHJ	P,GETWRD	;Get first word into T1, ignoring leading blanks
	MOVEM	CH,SAVECH	;Save terminator for later
	MOVEM	BP,CPOINT	;Update pointer

	HRROI	T2,.GTPRG	;Get the name
	GETTAB	T2,		; of this program
	  MOVSI	T2,'???'	;Can never happen
	MOVEM	T2,PRGNAM	;Save for a while
	HRROI	T2,PRGNAM	;MOVE T2,[-1,,PRGNAM]
	PUSHJ	P,TSTABR	;Test for match
	  SKIPA			;No match
	   JRST	RSCAN2		;It matches, get rid of leading spaces
	MOVE	T2,[-2,,[SIXBIT /RUN/
			 SIXBIT /START/]]
	PUSHJ	P,TSTABR	;See if it matches
	  JRST	RSCAN4		;No, return with C=0

;Here when the monitor command was ".RUN" or ".START"

RSCAN1:	PUSHJ	P,COMCH		;Get a char from COMBUF
	  JRST	RSCAN4		;End of line already, no command
	CAIN	CH,"-"		;Hypen?
	 JRST	RSCAN2		;Yes, command follows
	CAIE	CH,"("		;Or open paren?
	 JRST	RSCAN1		;No, keep looking
	MOVEI	C2,1		;1 unmatched parenthisis

;Here at start of command.  Remove leading blanks

RSCAN2:	MOVE	BP,CPOINT	;Save pointer to start of command
	PUSHJ	P,COMCH		;Get a char from COMBUF using CPOINT
	  JRST	RSCAN4		;End of line already, no command
	CAIE	CH,SP		;Space?
	CAIN	CH,TAB		; or tab?
	 JRST	RSCAN2		;Yes, ignore it
	JUMPE	C2,RSCANX	;Return with C nonzero
;Here if started by open paren, search for matching close paren

RSCAN3:	CAIN	CH,"("		;Open paren?
	 ADDI	C2,1		;Yes, count it
	CAIN	CH,")"		;Close paren?
	 SOJE	C2,RSCANP	;Yes, decrement count, stop at end
	PUSHJ	P,COMCH		;Keep looking for matching close paren
	  JRST	RSCANX		;End of line is good enough
	JRST	RSCAN3		;Keep looking

;Found matching close paren

RSCANP:	MOVEI	CH,LF		;Get a linefeed
	DPB	CH,CPOINT	;Store on top of close paren

;Remember pointer to good command

RSCANX:	MOVEM	BP,CPOINT	;Reset CPOINT to start of command
	JRST	RSCAN5		;Return success

;Here when no command was found

RSCAN4:	TDZA	C,C		;C=0 to signify failure
RSCAN5:	 MOVEI	C,1		;Set C nonzero
	POPJ	P,		;Return from RSCAN
SUBTTL	HELPER -- Subroutine to output HLP:xxxxxx.HLP

;  This code was taken from HELPER.MAC %5(41).
;Because HELPER is called from user programs, first LOOKUP the help file
;in the same area that the program came from, then try HLP:.

	ENTRY	.HELPR		;Entry point for MACRO
.HELPR:	MOVEM	F,SAVE0		;Save the AC's
	MOVE	F,[T1,,SAVE1]	;  (Clear flags)
	BLT	F,SAVEND
	JRST	HLP0		;Name must already be in T1


;	CALL HELPER (0)

HELLO	(HELPER)		;Set up entry point
	MOVE	T1,@NAM(L)	;Fetch first arg
HLP0:	PUSHJ	P,HLP		;Do the dirty work
	JRST	RETURN		;Restore ACs and return

;Output help file whose SIXBIT name is in T1.
;Uses T1-T4

HLP:	OUTSTR	CRLF		;Start a new line
	PUSH	P,.JBFF##	;Save .JBFF
	HRROI	T2,.GTPRG	;Get the program name
	GETTAB	T2,		; ...
	  MOVE	T2,['HELP  ']	;Should never happen
	SKIPN	T1		;Do we have an arg?
	 MOVE	T1,T2		;No, use the name of this program
	HRROI	T3,.GTRDV	;Get the device this program came from
	GETTAB	T3,		; ...
	  MOVEI	T3,0		;FILDAE not implemented
	SKIPN	T3		;See if we got a real device name
	 MOVSI	T3,'DSK'	;Try the user's area
	HRROI	T4,.GTRDI	;Get directory program was run from
	GETTAB	T4,		; ...
	  SETZ	T4,		;FILDAE not implemented
HLPUSR:	MOVEI	T2,.IOASC	;ASCII mode (device in T3)
	MOVEM	T4,HLPPPN	;Save PPN for a while
	MOVEI	T4,HLPBFR	;Buffer header, input only
IFE FT603,<PRINTX ?The 701-only HELP input has not been debugged, @HLPUSR>
	OPEN	%0,T2		;INIT device
	  JRST	HLPHLP		;Only if DSKU: was dismounted
	MOVSI	T2,'HLP'	;Extension
	SETZ	T3,		;Clean LOOKUP block
	MOVE	T4,HLPPPN	;PPN
	LOOKUP	%0,T1		;Find file
	  SKIPA			;Not there
	JRST	HLPMOR		;Go read file

HLPHLP:	MOVSI	T3,'HLP'	;File not found on DSK:,
	MOVE	T4,HLPPPN	;Get PPN used in LOOKUP (T4 may have 2,,5)
	TDZE	T4,T4		;Clear it, if non-zero,
	 JRST	HLPUSR		; try HLP:[0,0]
	OUTSTR	[ASCIZ /%HLRCFF Cannot find help file, sorry/]
	JRST	HLPDON		;Been here twice now, give up

HLPMOR:	IN	%0,		;Read a buffer
	  JRST	HLPGCH		;Get a char
				;Treat any I/O error as EOF
HLPDON:	OUTSTR	CRLF		;Finish the line
	RELEAS	%0,
	POP	P,.JBFF##	;Restore .JBFF
	POPJ	P,		;Return from HLP section of HELPER

HLPGCH:	SOSGE	T2,HLPBFR+2	;Decrement count of chars in buffer
	 JRST	HLPMOR		;Get another buffer
	ILDB	T1,HLPBFR+1	;Get next char
	OUTCHR	T1		;Type it
	JRST	HLPGCH		;Do all chars in buffer
SUBTTL	EXITGO -- Return to the monitor

	ENTRY	EXIT0, EXIT1, EXITGO

	SIXBIT	/EXIT0/
EXIT0:	EXIT			;Cannot continue

	SIXBIT	/EXIT1/
EXIT1:	EXIT	1,		;Quiet return to monitor
	POPJ	P,		;In case of continue

	SIXBIT	/EXITGO/
EXITGO:	PUSHJ	P,CLOSFL	;Close files, type CRLF if needed

IFDEF TOPSEG,<	;Put the routine in the LOWSEG
	MOVE	T1,[EXITG2,,COMBUF]
	BLT	T1,COMBUF+<EXITG3-RUNIT2>
>  ;End of IFDEF TOPSEG

	SKIPN	GOPROG		;Is there a program to run?
	 JRST	EXIT2		;No, exit to monitor
	SKIPN	T1,GODEV	;Get the device
	 MOVSI	T1,'SYS'	;The default is SYS
	MOVEM	T1,GODEV	;Put device back

IFDEF TOPSEG,<
	JRST	COMBUF		;Go to it

EXITG2:	PHASE	COMBUF		;This routine gets BLT'ed down
>  ;End of IFDEF TOPSEG

RUNIT2:	MOVSI	T1,1		;1 in the left half and 0 in the right
	CORE	T1,		;Gets rid of our HISEG
	  JFCL			;Ignore the error
	MOVEI	T1,GODEV	;Point to saved program name
	HRL	T1,GOFSET	;Runoffset of 1 or 0
	RUN	T1,		;Exit to this program
				;In case of error, stop
EXIT2:	EXIT	1,		;Return to monitor
EXITG3:	EXIT			;Cannot continue
IFDEF TOPSEG,< DEPHASE >	;End of RUNIT2 routine
SUBTTL	EXITGO -- Close any open channels

CLOSFL:	PUSHJ	P,TCRLF		;Type CRLF if not at margin
	MOVSI	T3,-17		;Check all 17 channels in order
CLOSF1:	MOVEI	T2,(T3)		;Copy channel number
	DEVNAM	T2,		;See if this channel is open
	  JRST	CLOSF3		;Not open
	OUTSTR	[ASCIZ /%EXITGO Channel /]
	MOVEI	T1,(T3)		;Copy channel number
	TRZE	T1,10		;2 digits?
	 OUTCHR	["1"]		;Yes
	ADDI	T1,"0"		;Convert to ASCII
	OUTCHR	T1		;Type it
	OUTSTR	[ASCIZ / open to /]

CLOSF2:	SETZ	T1,		;Clear junk
	LSHC	T1,6		;Get a byte
	ADDI	T1,SP		;Convert to ASCII
	OUTCHR	T1		;Type it
	JUMPN	T2,CLOSF2	;Loop
	OUTSTR	[ASCIZ	/: closed
/]
	HRLZ	T1,T3		;Copy channel number
	LSH	T1,5		;Put in the accumulator field
	TLO	T1,(RELEAS 0,)	;Make UUO
	XCT	T1		;Release the channel

CLOSF3:	AOBJN	T3,CLOSF1	;Loop for all channels
	POPJ	P,		;Return from CLOSEF
SUBTTL	OUTSTR -- Output a string on the TTY

;	CALL OUTSTR (ICC, BUFFER, KOUNT)

HELLO	(OUTSTR)		;Set up entry point
	MOVEI	BP,@BUF(L)	;Get starting addr
	HRLI	BP,(POINT 7,)	;Make into byte pointer
	SKIPGE	@COD(L)		;Is carriage control code negative?
	 OUTCHR	[FF]		;Yes, output formfeed first
	MOVE	C,@CNT(L)	;Get length of string
	SOJGE	C,OUTST0	;If non-zero, force ASCIZ first
	OUTSTR	(BP)		;Otherwise, assume ASCIZ literal
	JRST	OUTST1		;Finish up

OUTST0:	IDIVI	C,5		;Get number of words
	ADDI	C,(BP)		;Get addr of last word
	SETZB	T1,T2		;2 zero words
	EXCH	T1,(C)		;Force ASCIZ at end of array
	OUTSTR	(BP)		;Output first part
	OUTSTR	T1		;And last part
	EXCH	T1,(C)		;Restore original data

OUTST1:	SKIPE	T1,@COD(L)	;Get the carriage control
	CAMN	T1,[-2]		;0 or -2?
	 JRST	RETURN		;Yes, no CRLFs
	MOVMS	T1		;Get absolute value
	OUTSTR	CRLF		;Type a CRLF
	SOJG	T1,.-1		;Do as many as requested
	JRST	RETURN		;Return from OUTSTR
SUBTTL	JBINFO -- Return info about the job

;	IVALUE = JBINFO(ICODE)

HELLO	(JBINFO)		;Set up entry point
	MOVSI	T1,-CODLEN	;Make AOBJN pointer

JBINF1:	HRRZ	T2,CODTAB(T1)	;Get dispatch address
	HLRE	T3,CODTAB(T1)	;Get code from table
	CAMN	T3,@COD(L)	;Match?
	 JRST	(T2)		;Yes
	AOBJN	T1,JBINF1	;No, keep trying

;Here if no match, do a GETTAB with [-1,,CODE]

	HRRO	T1,@COD(L)	;Get GETTAB table number, this job
	GETTAB	T1,		;Get info from monitor table
	  MOVEI	T1,0		;Reasonable default
RETUR0:	MOVEM	T1,SAVE0	;Function value will be returned in AC0
	JRST	RETURN		;Return from JBINFO

;Some GETTAB values are worthless to FORTRAN programs, return something useful

CODTAB:	 ^D0,,GSWITC		;Get value of switches on KA or KI (usually 0)
	 ^D1,,GPJOB		;Job number
;2=PPN, 3=Program name, 4=Runtime, 5=KCS, 6=Priv bits
	 ^D7,,GSLEEP		;Sleep for 1 second
	 ^D8,,GTLCH		;Terminal number and characteristics
	 ^D9,,GDATE		;Date in 15 bit format
	^D10,,GMSTIM		;Time in milliseconds
	^D11,,GUDT		;Universal date/time
	^D12,,GWEEKD		;Day of week, 1=Sunday, 7=Saturday
	^D19,,GSKPIN		;Return 1 if char of typeahead, 2 if whole line
	^D20,,GINCHA		;Input one character in A1 format
	^D21,,GINCHW		;Input one character
	^D24,,GNAME0		;Get first 5 letters of user name
	^D25,,GNAME1		;Get next 5 letters of user name
	^D26,,GNAME2		;Get last 2 letters, padded with 3 blanks
CODLEN==.-CODTAB		;Length of this table

GSWITC:	SWITCH	T1,		;(0) Read console switches (usually zero)
	JRST	RETUR0		;Store value

GUDT:	MOVE	T1,[%CNDTM]	;(11) Get universal date time
	GETTAB	T1,		;This always skips
GPJOB:	PJOB	T1,		;(1) Get job number
	JRST	RETUR0		;Store value
GSLEEP:	MOVEI	T1,1		;(7) Sleep for 1 second
	SLEEP	T1,		;ZZZ
	JRST	RETUR0		;Store 1 as value

GTLCH:	SETO	T1,		;(8) Indicate this line
	GETLCH	T1,		;Get terminal number and line characteristics
	JRST	RETUR0		;Store value

GDATE:	DATE	T1,		;(9) Get date in 15 bit format
	JRST	RETUR0		;Store value

GMSTIM: MSTIME	T1,		;(10) Get time of day, milliseconds past midnite
	JRST	RETUR0		;Store value

GWEEKD: MOVE	T1,[%CNDTM]	;(12) Get universal date/time
	GETTAB	T1,		; ...
	  MOVEI	T1,0		;Can never happen
	HLRZS	T1		;Put date portion in right half
	IDIVI	T1,7		;Get weekday in T2
	HRREI	T1,-3(T2)	;T1=1 if its Sunday
	SKIPG	T1		;If Wed, Thu, Fri, or Sat,
	 ADDI	T1,7		;Make Wed=4, Sat=7
	JRST	RETUR0		;Store value

GSKPIN:	MOVEI	T1,2		;(19) Assume a whole line has been typed in
	SKPINC			;Partial line input?
	 MOVEI	T1,1		;No, SKPINL will not skip either, T1=0
	SKPINL			;Entire line?
	 SUBI	T1,1		;No, T1=0 if no input, =1 if partial line
	JRST	RETUR0		;Store value

GINCHA:	INCHRW	T1		;(20) Input a single character
	LSH	T1,^D29		;Shift over
	IOR	T1,[BYTE (7) 0,SP,SP,SP,SP] ;Add 4 spaces
	JRST	RETUR0		;Return character in A1 format

GINCHW: INCHRW	T1		;(21) Input char, wait char mode
	JRST	RETUR0		;Store value
;JBINFO continued

GNAME0:	HRROI	T1,.GTNM1	;(24) Get first 5 letters of user name
	GETTAB	T1,		;Get 6 SIXBIT bytes
	  MOVSI	T1,'???'	;Can never fail
	JRST	GNAME3		;Convert to ASCII

GNAME1:	HRROI	T1,.GTNM1	;(25) Get next 5 letters of user name
	GETTAB	T1,		;Get 6th byte
	  MOVEI	T1,'???'	;Can never fail
	HRROI	T2,.GTNM2	;Get next 4
	GETTAB	T2,		; from second word
	  MOVSI	T2,'???'	;Can never fail
	LSHC	T1,5*6		;Left justify wanted bytes in T1
	JRST	GNAME3		;Convert to ASCII

GNAME2:	HRROI	T1,.GTNM2	;(26) Get last 2 letters of user name
	GETTAB	T1,		;Get 11th and 12th bytes
	  MOVEI	T1,'???'	;Can never fail
	LSH	T1,4*6		;2 bytes plus 4 blanks

GNAME3:	MOVE	T3,[POINT 7,SAVE0] ;Where to store results
	SETZM	SAVE0		;Clear bit 35
GNAME4:	SETZ	T2,		;Clear junk
	ROTC	T1,6		;Put byte in T2
	ADDI	T2," "-' '	;Convert to ASCII
	IDPB	T2,T3		;Store in SAVE0
	TLNE	T3,760000	;If byte pointer is not exhausted,
	 JRST	GNAME4		; loop for all 5
	JRST	RETURN		;Restore AC0 and return
SUBTTL	SAVRUN -- Save the /RUN switch and clean up buffer

;	CALL SAVRUN (IOPT, BUFFER, KOUNT, LENGTH, LASTC)
;IOPT 1=/RUN, 2=;Comment, 4=No CTRL, 8=Leading SP, 16=Reduce SP
;     32=Upper case, 64=Brackets, 128=Expand tabs

	CVT$$==SAVRUN		;For all you PDP-11 RSTS freaks
HELLO	(SAVRUN)		;Set up entry point
	MOVM	T1,@LEN(L)	;Get the length of the buffer
	JUMPE	T1,RETURN	;Punt if nothing there
	SETZB	C2,GOFSET	;Zero the output char count, no /RUNOFF
	IMULI	T1,5		;Get max possible char count
	MOVEI	BP,@BUF(L)	;Get addr of buffer
	HRLI	BP,(POINT 7,)	;Make into byte pointer
	MOVE	T4,BP		;Copy to make an output byte pointer
	MOVE	C,@CNT(L)	;Get the character count
	SETZM	@CNT(L)		;Zero it for now (in case of all blanks)
	CAMLE	C,T1		;Do KOUNT and LENGTH agree?
	 MOVE	C,T1		;No, KOUNT was too big, use LENGTH*5
	MOVE	F,@COD(L)	;Get the IOPT code
	TRNN	F,F.ALL		;Any bits set?
	 MOVEI	F,F.ALL		;No, do everything
	ANDI	F,F.ALL		;Set only the defined bits
	TRNE	F,F.LSP		;Ignore leading spaces?
	 TRO	F,F.SP		;Yes
	TRNE	F,F.SSP		;Convert to single spaces?
	 TRZ	F,F.TAB		;Yes, don't expand tabs
	TRNN	F,F.TAB		;Expanding tabs?
	 JRST	RUNLOP		;No
	HRRI	T4,TEMP20	;Yes, do conversion in 2 steps.  First copy to
	CAILE	C,^D20*5	; to TEMP20, then back to BUFFER
	 MOVEI	C,^D20*5	;Can only do 100 chars this way
;Use BP and C to read from BUFFER, use T4 and C2 to write back into it

RUNLOP:	SOJL	C,ENDBUF	;Stop at end of buffer
	ILDB	CH,BP		;Get a character
RUNLP0:	CAIN	CH,CZ		;Control-Z?
	 JRST	[TRO	F,F.CZ	  ;Yes, remember that fact
		 JRST	RUNLOP	] ;Skip over the char
	CAIN	CH,""""		;Double quote?
	 TRC	F,F.QUO		;Yes, toggle flag
	TRNE	F,F.QUO		;Inside quotes?
	 JRST	OK.QUO		;Yes, don't convert anything
	CAIE	CH,TAB		;Tab?
	TRNN	F,F.CTL		;No, suppressing control chars?
	 JRST	OK.CTL		;Let this one go
	CAIGE	CH,SP		;Control char?
	 JRST	RUNLOP		;Yes, ignore it
OK.CTL:	TRNN	F,F.LSP!F.SSP	;Leading spaces or single space?
	 JRST	OK.LSP		;No
	CAIN	CH,TAB		;Yes, convert tabs
	 MOVEI	CH,SP		; to spaces
	CAIE	CH,SP		;Is this a space?
	 JRST	OK.LSP		;No, clear space flag
	TROE	F,F.SP		;Yes, set space flag, skip if was off
	 JRST	RUNLOP		;Second or later space, ignore it
	SKIPA			;Keep the space flag set
OK.LSP:	 TRZ	F,F.SP!F.LSP	;Clear space flags
	TRNN	F,F.RUN		;Searching for @ or /RUN?
	 JRST	OK.RUN		;No
	CAIN	CH,"/"		;Search for a slash
	 PUSHJ	P,GETSWT	;Get switch value, skip if known
	  JRST	OK.RUN		;Not a known switch
	 JRST	RUNLP0		;Check terminator, may be another "/"
OK.RUN:	TRNN	F,F.COM		;Ignore comments?
	 JRST	OK.COM		;No
	CAIE	CH,"!"		;Comment
	CAIN	CH,";"		; ...
	 JRST	ENDBUF		;Yes, ignore what follows
OK.COM:	TRNN	F,F.UC		;Doing upper case conversion?
	 JRST	OK.UC		;No
	CAILE	CH,"_"		;Upper case?
	 SUBI	CH,40		;No, make it so
OK.UC:	CAIE	CH,"<"		;Angle brackets?
	CAIN	CH,">"		; ...
	 TRNN	F,F.BRK		;Yes, converting them?
	  JRST	OK.BRK		;Don't convert
	ADDI	CH,"["-"<"	;> Convert < to [ and > to ]
OK.BRK:
OK.QUO:	IDPB	CH,T4		;Put the character back
	ADDI	C2,1		;Increment output byte count
	CAIE	CH,SP		;If not a trailing space,
	 MOVEM	C2,@CNT(L)	; remember the KOUNT
	JRST	RUNLOP		;Process rest of input buffer
SUBTTL	SAVRUN -- Look for /RUN/RUNOFF/HELP/EXIT

GETSWT:	MOVEM	BP,OLDBP	;Save input pointer
	MOVEM	C,OLDC		;Save count
	PUSHJ	P,GETWRD	;Get the switch
	MOVE	T2,[-4,,[SIXBIT	/RUN/
			 SIXBIT	/RUNOFF/
			 SIXBIT	/HELP/
			 SIXBIT	/EXIT/]]
	AOS	(P)		;Set for success
	PUSHJ	P,TSTABR	;Test for abbreviation
	  JRST	UNKSWT		;Not recognized
	JRST	@[EXP RUNSWT,OFFSWT,HLPSWT,EXISWT](T2)	;Go to it

;Unknown switch, reset pointers

UNKSWT:	MOVE	BP,OLDBP	;Restore pointer
	MOVE	C,OLDC		; and byte count
	LDB	CH,BP		;Re-get the slash at start of switch
	SOS	(P)		;Unknown or bad /RUN switch
	POPJ	P,		;Error return from GETSWT

;/RUN:PROGRAM - get file name

RUNSWT:	CAIE	CH,":"		;Did it end with a colon?
	 JRST	UNKSWT		;No, ignore it
	PUSHJ	P,FILENM	;Evaluate the program name
	MOVE	T1,[PRGDEV,,GODEV];Copy into our area
	BLT	T1,GOEND	; ...
	SETZ	T1,		;In case no program
	SKIPE	GOPROG		;If there was a name,
EXISWT:	 TRO	F,F.CZ		;Set the Control-Z flag
	POPJ	P,		;Keep searching for other switches

OFFSWT:	MOVEI	T1,1		;Default value
	CAIN	CH,":"		;Value to follow?
	 PUSHJ	P,GETWRD	;Yes, get first digit
	ANDI	T1,7		;0 to 7
	MOVEM	T1,GOFSET	;Save the runoffset
	POPJ	P,		;Now see what's in CH

HLPSWT:	SETZ	T1,		;Use name of program
	PUSH	P,T4		;.HELPR uses T1-T4
	PUSHJ	P,HLP		;Read the file
	POP	P,T4		;Restore output byte pointer
	POP	P,		;Examine the delimiter in CH
SUBTTL	SAVRUN -- Fix up the buffer


ENDBUF:	MOVE	CH,@CHR(L)	;Get the last character
	CAIN	CH,CZ		;Is it a Control-Z?
	 TRO	F,F.CZ		;Yes, flag the fact
	MOVEI	CH,CZ		;Get the Control-Z character
	TRZE	F,F.CZ		;Is the flag set? (via /EXIT or /RUN)
	 MOVEM	CH,@CHR(L)	;Yes, set LASTC
	MOVM	C,@LEN(L)	;Get size of BUFFER
	IMULI	C,5		;Total byte count
	CAML	C2,C		;Is the buffer full after conversion?
	 JRST	ENDBF2		;Yes, every single char is nonblank
	MOVEI	CH,SP		;Get a space

ENDBF1:	IDPB	CH,T4		;Store in buffer
	CAMGE	C2,C		;Finished?
	 AOJA	C2,ENDBF1	;No

ENDBF2:	MOVEI	BP,@BUF(L)	;Addr of array
	HRLI	BP,(POINT 7,)	;Make into output pointer
	TRZN	F,F.TAB		;Expanding tabs?
	 JRST	ENDBF7		;No
	MOVE	T4,BP		;Output pointer
	MOVE	BP,[POINT 7,TEMP20] ;Input pointer
	MOVE	C,@CNT		;Get byte count
	MOVN	C2,C		;Negate it
	HRLZS	C2		;Make AOBJN pointer

ENDBF3:	SOJL	C,ENDBF6	;Stop at end of TEMP20
	ILDB	CH,BP		;Get a char
	CAIE	CH,TAB		;Control-I?
	 JRST	ENDBF5		;No
	MOVEI	CH,SP		;Yes, convert to space
ENDBF4:	AOBJP	C2,ENDBF6	;Increment count
	IDPB	CH,T4		;Store in BUFFER
	TRNE	C2,7		;At a tab stop?
	 JRST	ENDBF4		;No
	JRST	ENDBF3		;Yes, get next char

ENDBF5:	AOBJP	C2,ENDBF6	;Test for buffer overflow
	IDPB	CH,T4		;Store in buffer
	JRST	ENDBF3		;Loop

ENDBF6:	HRRZM	C2,@CNT(L)	;Store expanded KOUNT

ENDBF7:	TRZN	F,F.RUN		;Looking for @?
	 JRST	RETURN		;No
	MOVEI	BP,@BUF(L)	;BP may have been trashed by ENDBF3
	HRLI	BP,(POINT 7,)	;Make into output pointer
	ILDB	CH,BP		;Get first char
	CAIE	CH,"@"		;At sign?
	 JRST	RETURN		;No
	SUBI	C,1		;Yes, decrement byte count
	PUSHJ	P,FILENM	;Get the file name
	OUTSTR	[ASCIZ /% @-indirect not yet finished
/]
  ;Open the specified file, and read 4 blocks into COMBUF, copy first
  ;line into BUFFER, and go through SAVRUN cleanup again
	JRST	RETURN		;Return from SAVRUN
SUBTTL	MATCH -- Check if command matches list

;	CALL MATCH ('LIST,OF,COMMANDS,ETC',BUFFER,KOUNT,LENGTH,INDEX,DNAME)
;	GOTO       ( 100, 200,  300,  400 ) INDEX

HELLO	(MATCH)
	MOVEI	BP,@NAM(L)	;Get addr of list of command names
	HRLI	BP,(POINT 7,)	;Make into byte pointer

MATCH0:	MOVEI	C,CBUFS5	;Set byte count very high
	SETZM	OLDBP		;Clear old pointer
	MOVSI	C2,-^D20	;AOBJN pointer into TEMP20

MATCH1:	PUSHJ	P,GETWRD	;Get SIXBIT word in T1
	MOVEM	T1,TEMP20(C2)	;Store
	CAIN	CH,","		;Comma?
	 AOBJN	C2,MATCH1	;Yes, get another (up to 20)
	SKIPL	C2		;More than 20 in the list?
	 MOVEM	BP,OLDBP	;Yes, do this in 2 passes
	MOVNI	C2,1(C2)	;Get negative number of commands in list

	MOVEI	BP,@BUF(L)	;Get addr of command line
	HRLI	BP,(POINT 7,)	;Make into byte pointer
	MOVE	C,@CNT(L)	;Get byte count
	PUSHJ	P,GETWRD	;Get the first word of command line in T1
	JUMPN	T1,MATCH2	;Jump if first char alphameric
	SETZM	@IDX(L)		;Pretend blank line
	CAIN	CH,"?"		;Delimiter a question mark?
	 JRST	[OUTSTR [ASCIZ /Commands are: /] ;And nothing in front of it
		 OUTSTR	@NAM(L)		;Type string
		 OUTSTR	CRLF		;Make it nice looking
		 JRST	RETURN]		;Continue
	CAIE	CH,SP		;Totally blank line?
	 SETOM	@IDX(L)		;No, command did not start with letter or number
	JRST	RETURN		;Unknown or blank command

MATCH2:	MOVEI	T2,TEMP20	;Point to list of SIXBIT commands
	HRL	T2,C2		;Negative count
	PUSHJ	P,TSTABR	;Check for abbreviations
	  JRST	[SKIPE	BP,OLDBP  ;Is there more to check?
		  JRST	MATCH0	  ;Yes, try next 20 on list
		 MOVEM	T2,@IDX(L);0=blank, -1=unknown, -2=ambiguous
		 JRST	RETURN	]
	MOVEM	T2,@IDX(L)	;Tell user which command matched
	AOS	@IDX(L)		;FORTRAN starts arrays at 1 not 0
	HLRZ	T1,-1(L)	;Get argument count
	CAIL	T1,-DNM		;Is DNAME requested?
	 JRST	MATCH4		;No
	MOVEI	T1,@DNM(L)	;Yes, get addr of double word
	MOVE	T2,TEMP20(T2)	;Get full command name
	MOVEI	T3,0		;6 SIXBIT blanks
	PUSHJ	P,ASC10		;Convert SIXBIT to 10 ASCII bytes
	JRST	MATCH4		;Jump into loop

;Remove command from BUFFER

MATCH3:	PUSHJ	P,GETBP		;Get a char
MATCH4:	CAIE	CH,SP		;Space?
	CAIN	CH,TAB		; or Tab?
	 JUMPG	C,MATCH3	;Yes, ignore it (but don't loop forever)
	MOVEI	T1,@BUF(L)	;Get addr of BUFFER
	HRLI	T1,(POINT 7,)	;Destination byte pointer
	MOVM	T2,@LEN(L)	;Get word count
	IMULI	T2,5		;Make into byte count
	SETZM	@CNT(L)		;Clear returned byte count

MATCH5:	SKIPL	C		;If this is a significant character,
	 AOS	@CNT(L)		; tell caller how many
	IDPB	CH,T1		;Store char
	PUSHJ	P,GETBP		;Get a char (or a space if empty)
	SOJG	T2,MATCH5	;Loop till BUFFER has been shuffled
	JRST	RETURN		;Return from MATCH


;Routine to convert SIXBIT to ASCII
;Call with destination pointer in T1, and SIXBIT doubleword in T2 and T3
;Uses T1 and T4, preserves T2 and T3

ASC5:	SKIPA	T4,[5]		;Do 5 chars
ASC10:	MOVEI	T4,^D10		;Do 10 chars
	TLCE	T1,-1		;Is left half zero?
	TLCE	T1,-1		;Or all ones?
	 HRLI	T1,(POINT 7,)	;Yes, make into byte pointer
	PUSH	P,T1		;Save pointer
	PUSH	P,[POINT 6,T2]	;Set source pointer

ASC1:	ILDB	T1,0(P)		;Get a byte
	ADDI	T1,SP		;Make into ASCII
	IDPB	T1,-1(P)	;Store it
	SOJG	T4,ASC1		;Loop for all
	POP	P,(P)		;Dump source pointer
	POP	P,(P)		;Dump dest pointer
	POPJ	P,		;Return from ASC5 or ASC10
SUBTTL	Subroutines -- Read TMPCOR or DSK:nnnxxx.TMP

;Here to read the temp-core file, putting it in COMBUF.
;The TMPCOR file name is stored @NAM(L).

REDTMP:	PUSHJ	P,GETNAM	;Get CCL name into T1
	MOVE	T2,[IOWD CBUFSZ,COMBUF]
	MOVE	C,[.TCRDF,,T1]	;Read and delete file, args start at T1
	TMPCOR	C,		;Try to input file
	  MOVEI	C,0		;Not there
	MOVE	T1,[POINT 7,COMBUF]
	MOVEM	T1,CPOINT	;Set up byte pointer
	SKIPE	C		;Monitor bug returns nonzero data for null file
	 ILDB	C,T1		; so get first character if not zero-length file
	POPJ	P,		;Return with C=0 if no input

;Routine to open a channel to the disk.
;Call OPNDSK with TMPCOR name in left half of T1
;Call OPNDS1 with disk file name in T1
;Returns with 4 word LOOKUP/ENTER block in T1-T4, 0 in C2 (for IOWD)

OPNDSK:	MOVSS	T1		;Put PRG in right half
	HRLI	T1,'000'	;Set up bits in T1 (This code taken from LOGOUT)
	PJOB	T2,		;Get the job number
	IDIVI	T2,^D10		;Get low order digit in T3
	MOVS	T4,T3		;Save in T4
	IDIVI	T2,^D10		;High order in T2, middle in T3
	LSH	T2,^D12+^D18	;Put high char where it belongs
	LSH	T3,^D6+^D18	; and middle char
	ADD	T1,T2		;Add the digits to '000PRG'
	ADD	T1,T3		; ...
	ADD	T1,T4		; ...

OPNDS1:	MOVEI	T2,.IODMP	;Dump mode
	MOVSI	T3,'DSK'	;Device DSK
	SETZB	T4,C2		;No buffers, STOP IOWD
IFE FT603,<PRINTX ?The 701-only TMPCOR input has not been debugged, @OPNDS1>
	OPEN	%0,T2		;Init channel 0
	  POPJ	P,		;?Cannot init DSK:??
	MOVSI	T2,'TMP'	;File extension
	SETZB	T3,T4		;Default directory
	POPJ	P,		;Return from OPNDSK
SUBTTL	Subroutines -- Read file from disk

READSK:	PUSHJ	P,GETNAM	;Get CCL name in T1
	PUSHJ	P,OPNDSK	;Open disk file, get file name in T1,T2
	MOVEM	T1,CCLNAM	;Save in case file greater than 512 words long
	SETZM	COMBUF		;Clear first word in case LOOKUP or INPUT fails
IFE FT603,<PRINTX ?The 701-only TMPCOR input has not been debugged, @READSK>
	LOOKUP	%0,T1		;Find the file
	  JRST	READS1		;Not there, set C=0 and return
	MOVE	C,[IOWD CBUFSZ,COMBUF]
	INPUT	%0,C		;Read in up to 4 blocks
	HLRE	T3,T4		;Get size of file
	JUMPGE	T3,READS0	;Should be negative word count
	SUBI	T3,1		;Make 128 show up as 0 blocks left
	IDIV	T3,[-200]	;Make into positive block count
READS0:
IFN CBUFSZ-200,< IDIVI T3,CBUFSZ/200 >	;Convert to pages
	MOVEM	T3,CCLSIZ	;Non-zero if greater than 1 page
	SETZM	CCLBLK		;No name, clear current page number
	SKIPN	T3		;Don't delete if more to come
DELTMP:	SETZB	T1,CCLNAM	;CCL file no longer open
	RENAME	%0,T1		;Delete the CCL file
	  JFCL			;Ignore error

;Return with C=0 if nothing was read in

READS1:	RELEAS	%0,		;Done with channel 0
	MOVE	T1,[POINT 7,COMBUF]
	MOVEM	T1,CPOINT	;Set up byte pointer
	SKIPN	C,COMBUF	;If nothing was read in,
	 SETZM	CCLNAM		; clear the CCL flag
	POPJ	P,		;C is non-zero if command is in COMBUF

;Here to reopen CCL file and read next 4 blocks.  Preserves all ACs

REOPEN:	MOVE	T1,CCLNAM	;Get disk file name
	MOVE	C,[IOWD CBUFSZ,COMBUF]
	PUSHJ	P,OPNDS1	;Open disk channel, set up T1-T4, and C2
IFE FT603,<PRINTX ?The 701-only TMPCOR input has not been debugged, @REOPEN>
	LOOKUP	%0,T1		;Find file again
	 JRST	[SETZM	CCLSIZ	  ;Error, forget about CCL file
		 JRST	READS1	] ;Release channel
	AOS	T1,CCLBLK	;Page number to read in
IFN CBUFSZ-200,< IMULI T1,CBUFSZ/200 >	;Convert page number to block number
	USETI	%0,1(T1)	;Set to read proper block
	INPUT	%0,C		;Get 512 words
	MOVE	T1,CCLBLK	;Get current page number again
	CAMGE	T1,CCLSIZ	;More yet to come?
	 JRST	READS1		;Yes, keep file around a little longer
	SETZM	CCLSIZ		;No, forget about the file
	JRST	DELTMP		;Delete it and set up pointer to COMBUF
SUBTTL	Subroutines -- TSTABR - Test if T1 is an abbreviation

;Test if word in T1 matches any in a list pointed to by T2
;Return CPOPJ with T2 = match number
;Return POPJ with T2 = 0 for blank, -1 for unknown, -2 for ambiguous
;Changes T2, preserves all other ACs

TSTABR:	JUMPE	T1,[MOVEI T2,0	  ;If T1 is blank,
		    POPJ  P,	] ;Give error return with T2=0
	PUSH	P,T3		;Save ACs
	PUSH	P,T4		; ...
	PUSH	P,C		; ...
	PUSH	P,T2		;Save original pointer
	SETO	T3,		;Set full mask

;First generate a mask in T3 with ones where T1 has blanks

TSTAB1:	LSH	T3,-6		;Shift mask to the right
	TDNE	T3,T1		;Skip if masking only spaces
	 JRST	TSTAB1		;Loop till finished
	MOVEI	C,0		;Clear flag

TSTAB2:	MOVE	T4,(T2)		;Get word to match
	XOR	T4,T1		;Clear chars that do match
	JUMPE	T4,TSTAB4	;Exact match
	ANDCM	T4,T3		;Look only at chars typed in
	JUMPN	T4,TSTAB3	;Jump if not a proper abbreviation
	TLON	C,1		;Skip if not first match
	 TROA	C,(T2)		;Put pointer in RH if first match
          TRZ	C,-1		;2nd match, clear pointer

TSTAB3:	AOBJN	T2,TSTAB2	;Try next possiblity
	MOVE	T2,C		;Get possible match
	TRNE	T2,-1		;Was one abbreviation found?
	 JRST	TSTAB4		;Yes, use it
	POP	P,T3		;No, dump the original pointer
	MOVNI	T2,1		;Assume unknown
	TLNE	C,1		;Any matches at all?
	MOVNI	T2,2		;Yes, ambiguous
	JRST	TSTAB5		;Finish up

TSTAB4:	POP	P,T3		;Get original pointer off stack
	AOS	-3(P)		;Make skip return
	ANDI	T2,-1		;Clear count in left half
	SUBI	T2,(T3)		;Find relative offset

TSTAB5:	POP	P,C		;Restore ACs
	POP	P,T4		; ...
	POP	P,T3		;T1 has remaind unchanged
	POPJ	P,
SUBTTL	Subroutines -- GETWRD - Get alphameric word in T1, input via BP and C

GETWRD:	MOVEI	T1,0		;Clear out result
	MOVE	T2,[POINT 6,T1]	;Returns SIXBIT result in T1

GETWR1:	SOSGE	C		;Any more chars?
	 JRST   GETWR3		;No, but the delimiter is a space
	ILDB	CH,BP		;Get a char
	CAIE	CH,SP		;Space?
	CAIN	CH,TAB		;Or tab?
	 JRST	GETWR1		;Yes, ignore leading blanks

GETWR2:	CAILE	CH,"_"		;Lower case?
	 SUBI	CH,40		;Convert to upper
	CAIL	CH,"0"		;Alphanumeric?
	CAILE	CH,"Z"		; ...
	 POPJ	P,		;No, end of first word
	CAILE	CH,"9"		;More on alphanumeric
	CAIL	CH,"A"		; ...
	 SKIPA			;OK, is alphanumeric
	  POPJ	P,		;Delimiter
	SUBI	CH,SP-' '	;Convert to SIXBIT
	TLNE	T2,770000	;Any room in word?
	 IDPB	CH,T2		;Yes, put char in T1
	SOJL	C,GETWR3	;Decrement byte count
	ILDB	CH,BP		;Get a char
	JRST	GETWR2		;Loop

GETWR3:	MOVEI	CH,SP		;Assume an infinite supply of blanks when
	POPJ	P,		; byte count goes negative
SUBTTL	Subroutines -- FILENM - read DEV:FILENAME[P,PN]

FILENM:	SETZB	T3,PRGZER	;Zero out PRG area
	MOVE	T1,[PRGZER,,PRGZER+1] ;Source,,destination
	BLT	T1,PRGLST	;Zero out our data area

GETFIL:	PUSHJ	P,GETWRD	;Get word in T1
	CAIN	CH,":"		;Colon?
	 JRST	[MOVEM	T1,PRGDEV ;Yes, that was the device
		 JRST	GETFIL	] ;Go for file
	MOVEM	T1,PRGNAM	;No, file name
	CAIN	CH,"."		;Period?
	 JRST	[PUSHJ	P,GETWRD  ;Yes, get extension
		 HLLZM	T1,PRGEXT ;Store it
		 JRST	.+1	] ;Check out delimiter
	CAIE	CH,"["		;Open bracket?
	 POPJ	P,		;No, all done
	SKIPN	T1,MYPPN	;Is PPN set up?
	 GETPPN	T1,		;No, get it
	MOVEM	T1,MYPPN	; ...
	PUSHJ	P,GETOCT	;Get octal number
	SKIPN	T1		;Project specified?
	 HLRZ	T1,MYPPN	;No, default to logged in project
	HRLZM	T1,PRGPPN	;Store project number
	CAIE	CH,","		;Should have comma next
	 POPJ	P,		;No, stop now
	PUSHJ	P,GETOCT	;Get octal number
	SKIPN	T1		;Programmer specified?
	 HRRZ	T1,MYPPN	;No, default to logged in PN
	HRRM	T1,PRGPPN	;Store it
	CAIN	CH,","		;Another comma?
	 OUTSTR	[ASCIZ /%SFDs not supported
/]
	POPJ	P,		;Return from FILENM

GETOCT:	MOVEI	T1,0		;Clear result
GETOC1:	SOSGE	C		;Any more chars?
	 POPJ	P,		;No
	ILDB	CH,BP		;Yes, get a char
	CAIL	CH,"0"		;Is it an octal digit?
	CAILE	CH,"7"		; ...
	 POPJ	P,		;No
	IMULI	T1,8		;Shift over accumulated result
	ADDI	T1,-"0"(CH)	;Reduce to binary and add
	JRST	GETOC1		;Go for more
SUBTTL	Subroutines -- CLRBUF - clear BUFFER, KOUNT, LASTC, set up C and BP

;Get the byte pointer, character count, and set the buffer to all spaces

CLRBUF:	MOVEI	BP,@BUF(L)	;Get the address of the buffer
	HRLI	BP,(POINT 7,)	;Make into a byte pointer
	SETZM	@CHR(L)		;Clear LASTC
	SETZM	@CNT(L)		;No characters read in yet
	MOVM	C,@LEN(L)	;Get buffer size in words
	JUMPE	C,RETURN	;Size cannot be zero, RETURN restores P
	MOVE	T1,BLANKS	;5 spaces
	MOVEM	T1,0(BP)	;Clear first word of buffer
	MOVSI	T1,0(BP)	;Source
	HRRI	T1,1(BP)	;Destination
	MOVEI	T2,-1(C)	;Calculate addr of end of buffer
	ADD	T2,BP		; ...
	CAIE	C,1		;Only one word?
	 BLT	T1,(T2)		;No, clear all of them
	IMULI	C,5		;Make into byte count
	POPJ	P,		;Return from CLRBUF


SUBTTL	Subroutines -- REDTTY - clear COMBUF and fill it with line from terminal

REDTTY:	SETZB	CH,SAVECH	;Clear saved character
	SETZM	COMBUF		;Store zeros in COMBUF
	MOVE	T1,[COMBUF,,COMBUF+1] ;BLT pointer
	BLT	T1,CBUFND	;Propagate zero through all of COMBUF

	MOVE	T1,[POINT 7,COMBUF] ;Set up byte pointer
	MOVEM	T1,CPOINT	;Save
	MOVEI	C,CBUFS5	;Max characters

REDTT1:	PUSHJ	P,TTYIN		;Get a char
	  JRST	REDTT2		;End of line
	SKIPLE	C		;Skip if more than 2550 chars type in
	 IDPB	CH,T1		;Store in COMBUF
	SOJA	C,REDTT1	;Loop till end of line

REDTT2:	SKIPLE	C		;Not likely to skip
	 IDPB	CH,T1		;Store last char in COMBUF
	POPJ	P,		;Extra word at CBUFND ensures ASCIZ
SUBTTL	Subroutines -- COMCH and TTYIN - character input routines

;COMCH and TTYIN get the next character into CH, non-skip return if end of line
;COMCH reads from COMBUF, TTYIN reads from terminal

COMCH:	SKIPN	CH,CPOINT	;See if byte pointer is set up
	 POPJ	P,		;No, non-skip return with 0 in CH
	SKIPN	CH,SAVECH	;Get left-over character if any
	 ILDB	CH,CPOINT	;Get a char from COMBUF
	SETZM	SAVECH		;No more saved char
	JUMPE	CH,CBUFMT	;There are at least 2 nulls at end of COMBUF
	CAIE	CH,CR		;Carriage return?
	 JRST	BREAKC		;No, check for break char
	IBP	CPOINT		;Yes, increment pointer past linefeed
	POPJ	P,		;Non-skip return with CR in CH

CBUFMT:	SETZM	CPOINT		;In case no more
	SKIPN	CCLSIZ		;Reading a large CCL file?
	 POPJ	P,		;No, end of COMBUF
	MOVEI	CH,TEMP20	;Save ACs
	BLT	CH,TEMP20+BP	;F, T1-T4, C, C2, BP
	PUSHJ	P,REOPEN	;Reopen disk file and read in another page
	MOVSI	CH,TEMP20	;Restore ACs
	BLT	CH,BP		;F, T1-T4, C, C2, BP
	JRST	COMCH		;Try again

;Here to read a char from the TTY, give non-skip if End-of-Line

TTYIN:	INCHWL	CH		;Get a char from terminal
				;Then check for end-of-line

;Routine to skip if character in CH is not a break (end of line) char

BREAKC:	CAIE	CH,LF		;Linefeed?
	CAIN	CH,ESC		;Escape?
	 POPJ	P,		;Yes, nonskip for usual break characters
	CAIE	CH,FF		;Formfeed?
	CAIN	CH,VT		;Vertical tab?
	 POPJ	P,		;Yes, break char
	CAIE	CH,CZ		;Control-Z?
	CAIN	CH,BEL		;Bell?
	 POPJ	P,		;Yes, also break
	CAIE	CH,3		;Did a Control-C happen to sneak in?
	 AOS	(P)		;None of the above
	POPJ	P,		;Non-skip return for break character


;GETBP - Routine to get a char from string pointed to by BP, byte count in C.

GETBP:	MOVEI	CH,SP		;In case no more
	SOSL	C		;Any more bytes?
	 ILDB	CH,BP		;Yes, get one
	POPJ	P,
SUBTTL	Subroutines -- GETNAM - Returns 3 SIXBIT characters for program name

;If NAM is all blanks or a small integer the name returned is taken
;from the name of the program (via GETTAB).

GETNAM:	MOVE	T1,@NAM(L)	;Get the name
	JUMPE	T1,NONAME	;Must be nonzero
	CAMN	T1,BLANKS	;Is it all blanks?
	 JRST	NONAME		;Not an allowable name

;Name can be ASCII, left justified, or SIXBIT, 3 chars in right half
	TLCN	T1,771000	;Any bits on in the first char position?
	 JRST	GETNM6		;No, try for SIXBIT in right half
	TLCN	T1,771000	;Is first char a RUBOUT
	 JRST	NONAME		;Yes, T1 is small negative number.
	MOVE	T2,[POINT 7,T1]	;Take chars from T1
	MOVE	T3,[POINT 6,T1]	;And put result back in T1
	MOVEI	T4,3		;Pick up only 3 characters

GETNM0:	ILDB	CH,T2		;Get a char
	CAILE	CH,"_"		;Lower case?
	 SUBI	CH,40		;Convert to upper
	SUBI	CH,SP-' '	;Convert to SIXBIT
	IDPB	CH,T3		;Store back in T1
	SOJG	T4,GETNM0	;Loop for 3 chars
	JRST	.+2		;Skip over the swap

GETNM6:	MOVSS	T1		;Make left justified SIXBIT
	TRZ	T1,-1		;Clear right half
	TLNE	T1,770000	;Is the first letter nonblank?
	 POPJ	P,		;Yes, return from GETNAM

NONAME:	HRROI	T1,.GTPRG	;Program name is in table 3
	GETTAB	T1,		;Get it
	  MOVSI	T1,'CCL'	;Fake it
	TRZ	T1,-1		;Clear right half
	POPJ	P,		;Return from GETNAM

SUBTTL	Data area -- Constants and literals

CRLF:	ASCIZ	/
/				;<CR><LF>
BLANKS:	ASCII	/     /		;5 spaces

;End of constants



LITS:	END			;Of RUNLIB