Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50547/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