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 , 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 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, ;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 -CBUFSZ, > ;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 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, 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, 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+ > ;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, 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, 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, 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 / / ; BLANKS: ASCII / / ;5 spaces ;End of constants LITS: END ;Of RUNLIB