Trailing-Edge
-
PDP-10 Archives
-
BB-D348F-SM
-
exec/execsu.mac
There are 47 other files named execsu.mac in the archive. Click here to see a list.
;<4.EXEC>EXECSU.MAC.366, 3-Jan-80 16:07:39, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.EXEC>EXECSU.MAC.365, 24-Oct-79 15:41:45, EDIT BY TOMCZAK
;TCO# 4.2545 - Change PECHOF/ECHOF flag test at ECHCMD
;<4.EXEC>EXECSU.MAC.364, 22-Oct-79 11:26:00, EDIT BY OSMAN
;CHANGE JFNSIL
;<4.EXEC>EXECSU.MAC.363, 20-Oct-79 15:13:44, EDIT BY R.ACE
;In message "[MOUNT request remaining in queue]" change MOUNT to Mount
;<4.EXEC>EXECSU.MAC.361, 9-Oct-79 09:49:05, EDIT BY OSMAN
;CHANGE $XXX SYMBOLS TO XXX$ TO AVOID CONFLICT WITH MACRO NAMES
;<4.EXEC>EXECSU.MAC.360, 8-Oct-79 15:50:57, EDIT BY OSMAN
;tco 4.2519 - Make ^T output go to .PRIOU
;<4.EXEC>EXECSU.MAC.359, 4-Oct-79 10:41:47, EDIT BY OSMAN
;tco 4.2510 - Fix EOF interrupt
;<4.EXEC>EXECSU.MAC.358, 28-Sep-79 13:59:31, EDIT BY OSMAN
;EXPAND BCOUNT TO GIVE CHARACTER COUNT
;<4.EXEC>EXECSU.MAC.356, 26-Sep-79 14:50:12, Edit by HESS
; Fix mail watch typeout for user other than self (XTND only)
;<4.EXEC>EXECSU.MAC.355, 20-Sep-79 13:53:30, EDIT BY OSMAN
;INSTEAD OF RJFN, JUST REPLACE THE ENTRY
;<OSMAN>EXECSU.MAC.1, 19-Sep-79 11:58:54, EDIT BY OSMAN
;MORE CLZFFF STUFF, CALL RJFN IN CFNE1 TO GET RID OF SCRATCH JFN
;<4.EXEC>EXECSU.MAC.352, 18-Sep-79 12:33:23, EDIT BY TOMCZAK
;Get rid of CFN1 since it isn't unique from SPECFN anymore
;<4.EXEC>EXECSU.MAC.351, 17-Sep-79 16:32:54, EDIT BY OSMAN
;tco 4.2472 - prevent "?JFN is not assigned" on "TAKE FOO NUL:"
;<4.EXEC>EXECSU.MAC.350, 17-Sep-79 10:37:56, EDIT BY OSMAN
;ADD BITS
;<4.EXEC>EXECSU.MAC.349, 14-Sep-79 08:52:27, EDIT BY OSMAN
;Call JFNSTK in FIELD instead of after CFN2
;<4.EXEC>EXECSU.MAC.346, 12-Sep-79 14:01:43, EDIT BY OSMAN
;HAVE ONLY ONE ERSTR, SO CLZFFF CAN BE HANDLED
;<4.EXEC>EXECSU.MAC.345, 12-Sep-79 11:14:30, EDIT BY OSMAN
;DON'T SOS CLZFFF IN JFNSTK IF JFN IS REALLY A FORK
;<4.EXEC>EXECSU.MAC.344, 12-Sep-79 11:04:11, EDIT BY OSMAN
;tco 4.2459 - Allow ^C out of magtape commands
;CHANGE CLZF TO CLZFFF, USE CLZFFF INSTEAD OF PIOFF IN GTJFS
;Use %3? instead of ERSTR at ERR5C
;Use %? in RJWARN
;<4.EXEC>EXECSU.MAC.341, 6-Sep-79 15:10:23, EDIT BY OSMAN
;tco 4.2448 - Print filespec and EOT info on data error
;<4.EXEC>EXECSU.MAC.339, 5-Sep-79 10:56:12, EDIT BY OSMAN
;TCO 4.2440 - Add DOGET
;<4.EXEC>EXECSU.MAC.338, 4-Sep-79 14:36:07, Edit by HESS
; Add call to IPCHEK to IITPSI (XTND)
;<4.EXEC>EXECSU.MAC.337, 4-Sep-79 14:17:35, Edit by HESS
; Don't do Auto Mail Watch if under batch (XTND only)
;<4.EXEC>EXECSU.MAC.336, 4-Sep-79 11:56:00, EDIT BY OSMAN
;MAKE GETMEM BE GLOBAL
;<4.EXEC>EXECSU.MAC.334, 31-Aug-79 13:07:25, EDIT BY OSMAN
;tco 4.2433 - Make SETM be SETZM
;<4.EXEC>EXECSU.MAC.332, 28-Aug-79 15:27:12, EDIT BY OSMAN
;TCO 4.2427 - ADD MFINP0
;<4.EXEC>EXECSU.MAC.331, 28-Aug-79 14:36:26, EDIT BY OSMAN
;MAKE GNFIL RETURN GNJFN FLAGS IN LEFT HALF OF A, SO DELETE KNOWS WHEN DIR CHANGES
;<HESS.E>EXECSU.MAC.17, 21-Aug-79 13:30:36, Edit by HESS
; Add extended features
;<4.EXEC>EXECSU.MAC.329, 15-Aug-79 11:08:30, EDIT BY OSMAN
;tco 4.2399 - If ECHO is on for TAKE, be sure to echo the erroneous commands!
;<4.EXEC>EXECSU.MAC.325, 10-Aug-79 15:15:14, EDIT BY OSMAN
;ADD TYPFLS
;<4.EXEC>EXECSU.MAC.323, 2-Aug-79 16:53:00, EDIT BY DNEFF
;TCO 4.2370 - Fix illegal instruction traps from 777777.
;<4.EXEC>EXECSU.MAC.322, 17-Jul-79 11:11:20, EDIT BY OSMAN
;tco 4.2332 - Fix /AFTER:SATURDAY on SUNDAY, AND @@SINCE ... on DIR command
;<4.EXEC>EXECSU.MAC.321, 16-Jul-79 09:06:34, EDIT BY OSMAN
;REMOVE %ERSTR, USE %? FOR $ERSTR
;<4.EXEC>EXECSU.MAC.319, 13-Jul-79 15:44:06, EDIT BY OSMAN
;tco 4.2327 - Make RELDIR
;<4.EXEC>EXECSU.MAC.318, 13-Jul-79 14:49:13, EDIT BY OSMAN
;tco 4.2326 - Prevent ILL MEM WR on INFO DIR PS:[*] when enabled.
;<4.EXEC>EXECSU.MAC.315, 29-Jun-79 14:08:42, EDIT BY OSMAN
;FIX ICLEAR TO NOT EVER LOSE IPCF OF ^T INTERRUPTS
;<4.EXEC>EXECSU.MAC.314, 7-Jun-79 09:01:37, EDIT BY EKLUND
;tco 4.2276 - CHANGE ERROR MESSAGE TO INCLUDE "ILLEGAL CHARACTER IN COMMAND"
;<4.EXEC>EXECSU.MAC.313, 6-Jun-79 12:58:35, EDIT BY HELLIWELL
;CHANGE ATMBFR TO ATMBUF
;<4.EXEC>EXECSU.MAC.312, 6-Jun-79 09:59:36, EDIT BY OSMAN
;tco 4.2274 - Don't leave jfn's around on ^C
;<4.EXEC>EXECSU.MAC.311, 4-Jun-79 10:36:59, EDIT BY OSMAN
;tco 4.2270 - use CLZF to decide whether to do CLZFF on ^C
;<4.EXEC>EXECSU.MAC.309, 16-May-79 16:09:00, EDIT BY OSMAN
;TRY TO ENABLE ^C IN LTTYMD BEFORE DOING STIW
;<4.EXEC>EXECSU.MAC.308, 15-May-79 09:05:29, EDIT BY OSMAN
;BETTER CALL LTTYMD ON ^C FROM PROG, PROG MAY HAVE DIDDLED TTY STATE.
;<4.EXEC>EXECSU.MAC.307, 4-May-79 15:30:20, EDIT BY OSMAN
;REMOVE EXTRA SFMOD AT ERR1 (ALREADY DONE AT ERFRS1 TO TURN OFF ^O)
;<4.EXEC>EXECSU.MAC.306, 2-May-79 17:00:39, EDIT BY OSMAN
;FIX RLJFNS TO HANDLE RESTRICTED JFNS BETTER
;<4.EXEC>EXECSU.MAC.304, 2-May-79 15:08:50, EDIT BY OSMAN
;FIX ICLEAR TO DO LESS WORK
;<4.EXEC>EXECSU.MAC.302, 1-May-79 11:27:11, EDIT BY OSMAN
;GTJFN => CALL GTJFS, SO ^C DOESN'T LEAVE JFN AROUND
;<4.EXEC>EXECSU.MAC.301, 1-May-79 11:12:01, EDIT BY OSMAN
;REMOVE CLZFF AT RERET (FOR EFFICIENCY. IF WANTED, FLAG SHOULD BE DESIGNED
;TO SHOW WHETHER IT'S NEEDED)
;<4.EXEC>EXECSU.MAC.300, 30-Apr-79 15:02:07, EDIT BY OSMAN
;MAKE DOECHO CHECK NECHOF, TO AVOID UNNECESSARY JSYS'S
;<4.EXEC>EXECSU.MAC.299, 30-Apr-79 14:55:02, EDIT BY OSMAN
;DON'T CALL LTTYMD ON ^C, COMND WILL FIX THINGS UP
;<4.EXEC>EXECSU.MAC.298, 26-Apr-79 11:42:44, EDIT BY OSMAN
;ADD .FIJFN
;<4.EXEC>EXECSU.MAC.295, 18-Apr-79 13:57:10, EDIT BY OSMAN
;ADD GTBUFX
;<4.EXEC>EXECSU.MAC.293, 18-Apr-79 09:55:10, EDIT BY OSMAN
;ADD RETBUF
;<4.EXEC>EXECSU.MAC.291, 12-Apr-79 10:44:33, EDIT BY OSMAN
;FIX OPNMAG
;<4.EXEC>EXECSU.MAC.290, 6-Apr-79 10:05:01, EDIT BY OSMAN
;ADD %@ (%LM) TO GET TO LEFT MARGIN
;<4.EXEC>EXECSU.MAC.288, 2-Apr-79 12:58:19, EDIT BY OSMAN
;REMOVE OPLEAS STUFF
;<4.EXEC>EXECSU.MAC.284, 28-Mar-79 15:10:52, EDIT BY OSMAN
;CHECK MPENDF IN ^C AND WARN THAT MOUNT STILL PENDING
;<4.EXEC>EXECSU.MAC.283, 27-Mar-79 17:12:49, EDIT BY OSMAN
;tco 4.2223 - don't say "device is not a terminal" when better error exists
;<4.EXEC>EXECSU.MAC.282, 22-Mar-79 10:12:29, EDIT BY OSMAN
;BE MORE EXPLICIT ON INTERNAL ILLEGAL INSTRUCTIN TRAPS
;<4.EXEC>EXECSU.MAC.280, 15-Mar-79 16:21:58, EDIT BY OSMAN
;USE FI%ERR INSTEAD OF -2 FOR FILESPEC ERRORS. ALSO, .FIERR, .FISTR
;<4.EXEC>EXECSU.MAC.279, 15-Mar-79 14:30:59, EDIT BY OSMAN
;ADD OPNMAG
;<4.EXEC>EXECSU.MAC.275, 14-Mar-79 13:56:27, EDIT BY OSMAN
;ADD $DTP TO READ DATE AND TIME IN PAST (LIKE FOR SINCE SUBCOMMAND OF DIR)
;<4.EXEC>EXECSU.MAC.274, 13-Mar-79 15:54:33, EDIT BY OSMAN
;ADD REWIND ROUTINE
;<4.EXEC>EXECSU.MAC.273, 12-Mar-79 18:06:40, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;UNBREAK RLJFNS (CHECK FOR GS%NAM)
;<4.EXEC>EXECSU.MAC.271, 12-Mar-79 09:58:58, EDIT BY OSMAN
;ADD LM
;<4.EXEC>EXECSU.MAC.270, 9-Mar-79 16:45:02, EDIT BY OSMAN
;don't ever "fail" in RJFN, since it is in error recovery loop!
;<4.EXEC>EXECSU.MAC.269, 9-Mar-79 10:37:36, EDIT BY OSMAN
;MAKE %B ALLOW SPECIFIC TIME
;<4.EXEC>EXECSU.MAC.267, 7-Mar-79 13:32:19, EDIT BY OSMAN
;FIX GLOADS
;REMOVE A BILLION EDIT HEADERS
;<4.EXEC>EXECSU.MAC.260, 2-Mar-79 15:48:18, EDIT BY OSMAN
;handle TIMER errors better
;<4.EXEC>EXECSU.MAC.258, 2-Mar-79 14:41:22, EDIT BY OSMAN
;ADD GLOADS; PRINT LOAD AVERAGE ON ^T
;<4.EXEC>EXECSU.MAC.257, 1-Mar-79 17:02:27, EDIT BY OSMAN
;CALL RJFNER INSTEAD OF JERR IN RJFNS2 TO PREVENT "?JFN IS NOT ASSIGNED"
;<4.EXEC>EXECSU.MAC.256, 1-Mar-79 09:31:15, EDIT BY OSMAN
;CHANGE %EOL AND SNDEOL TO BE MORE EFFICIENT (SOUT INSTEAD OF BOUT BOUT)
;<4.EXEC>EXECSU.MAC.254, 28-Feb-79 15:14:05, EDIT BY OSMAN
;put floating nums back to the old way (*sigh*)
;REMOVE CTYPE, %TYPE
;<4.EXEC>EXECSU.MAC.250, 27-Feb-79 16:52:13, EDIT BY OSMAN
;SPEED UP EXEC BY NOT DOING BOUTS IN ETYPE AND TYPE. DO SOUT INSTEAD
;REMOVE ATSVAR
;<4.EXEC>EXECSU.MAC.249, 27-Feb-79 15:54:49, EDIT BY OSMAN
;GET RID OF CCHRO
;<4.EXEC>EXECSU.MAC.248, 27-Feb-79 11:38:09, EDIT BY OSMAN
;change %Q to not put out any leading spaces on floating pt nums
;<4.EXEC>EXECSU.MAC.246, 27-Feb-79 10:12:36, EDIT BY OSMAN
;ADD CLSON
;<4.EXEC>EXECSU.MAC.245, 27-Feb-79 09:38:55, EDIT BY OSMAN
;<4.EXEC>EXECSU.MAC.244, 27-Feb-79 09:37:25, EDIT BY OSMAN
;<4.EXEC>EXECSU.MAC.243, 20-Feb-79 16:18:50, EDIT BY OSMAN
;MAKE ^T OUTPUT ALWAYS GO TO COJFN EVEN IF OUTPUT DIVERTED TO A BUFFER
;<4.EXEC>EXECSU.MAC.240, 19-Feb-79 14:31:25, EDIT BY OSMAN
;IF AT COMMAND LEVEL, ALLOW MOUNT RECEIPTS TO BE ANNOUNCED
;<4.EXEC>EXECSU.MAC.239, 15-Feb-79 16:42:56, EDIT BY HEMPHILL
;TCO 4.2190 -- FIX MFOUT TO USE *.* AS DEFAULT IF ONLY ONE INPUT FILESPEC
;HAD BEEN SPECIFIED, AND THAT FILE DIDN'T EXIST
;<4.EXEC>EXECSU.MAC.236, 13-Feb-79 17:54:30, EDIT BY OSMAN
;HANDLE QUASAR DISAPPEARING MORE GRACEFULLY (SEE SPTBL)
;<4.EXEC>EXECSU.MAC.235, 13-Feb-79 15:15:55, EDIT BY OSMAN
;CHANGE MFBUF SIZE FROM EXTSIZ TO FILWDS AT MFSET
;<4.EXEC>EXECSU.MAC.234, 7-Feb-79 10:35:38, EDIT BY OSMAN
;change GETNOD to give an error return if fails
;<4.EXEC>EXECSU.MAC.232, 1-Feb-79 18:58:09, EDIT BY ACARLSON
;DELETE GQSRPD TO APPEASE BIG WIGS (CODE FREEZE)
;<4.EXEC>EXECSU.MAC.230, 1-Feb-79 17:19:50, EDIT BY OSMAN
;ADD IPCHEK
;<4.EXEC>EXECSU.MAC.229, 1-Feb-79 17:07:50, EDIT BY OSMAN
;MAKE IPCOFF/IPCON NESTABLE. HANDLE MESSAGE OVERFLOW BETTER
;<4.EXEC>EXECSU.MAC.228, 31-Jan-79 20:29:54, EDIT BY ACARLSON
;ADD GQSRPD TO REQUEST A PRIVATE QUASAR'S PID FROM SYSTEM INFO
;<4.EXEC>EXECSU.MAC.226, 31-Jan-79 14:29:54, EDIT BY OSMAN
;DON'T FLJFNS AT ERRF1. DO IT AT SUBCOMMAND ERROR INSTEAD (SBCOM1)
;<4.EXEC>EXECSU.MAC.225, 30-Jan-79 14:08:59, EDIT BY OSMAN
;CHECK FOR DESX3 IN RJFNER
;<4.EXEC>EXECSU.MAC.224, 29-Jan-79 09:17:02, EDIT BY OSMAN
;ADD REFERENCE TO CF%NS
;<4.EXEC>EXECSU.MAC.223, 26-Jan-79 14:30:54, EDIT BY OSMAN
;ADD $RNODE AND $FNODE
;<4.EXEC>EXECSU.MAC.221, 25-Jan-79 13:24:47, EDIT BY OSMAN
;ADD FIXIO, UPDATE COJFN IN TOCT, CALL FIXIO IN ERFRS1
;<4.EXEC>EXECSU.MAC.219, 24-Jan-79 13:59:47, EDIT BY OSMAN
;DON'T CALL UNMAP UNTIL RERET. DON'T CALL UNMAP IN REPARS.
;THIS IS NECESSARY SO THAT TYPING ERRORS DURING SUBCOMMAND MODE
;DOESN'T CAUSE SAVED STRINGS FOR CURRENT COMMAND TO BE LOST!
;<4.EXEC>EXECSU.MAC.218, 23-Jan-79 10:41:29, EDIT BY OSMAN
;CHANGE SUBCOMMANDS, SEE "SUBCOM" IN EXECDE
;<4.UTILITIES>EXECSU.MAC.1, 22-Jan-79 14:12:02, EDIT BY OSMAN
;MAKE SURE PIOFF AND PION PRESERVE AC'S
;<4.EXEC>EXECSU.MAC.214, 18-Jan-79 14:11:32, EDIT BY OSMAN
;add STREM
;<4.EXEC>EXECSU.MAC.213, 18-Jan-79 11:35:13, EDIT BY OSMAN
;MAKE PION/PIOFF NESTABLE
;<4.EXEC>EXECSU.MAC.212, 15-Jan-79 02:43:34, EDIT BY HEMPHILL
;MODIFY SUBROUTINES TO HANDLE USER EXTENDED ADDRESSING PROPERLY
;<4.EXEC>EXECSU.MAC.209, 13-Jan-79 16:09:04, EDIT BY OSMAN
;ADD XBUFFS, XFRINI
;<4.EXEC>EXECSU.MAC.208, 12-Jan-79 17:37:25, EDIT BY OSMAN
;REMOVE REFS TO RUNFK
;<4.EXEC>EXECSU.MAC.207, 12-Jan-79 17:08:35, EDIT BY OSMAN
;tco 4.2159 - single line error messages, no more lone "?"
;<4.EXEC>EXECSU.MAC.206, 10-Jan-79 18:32:29, EDIT BY HURLEY.CALVIN
; PRITXT - change QUASAR ack text offset from .MSDAT to .OHDRS+ARG.DA
;<4.EXEC>EXECSU.MAC.205, 5-Jan-79 10:36:30, EDIT BY OSMAN
;put FREINI here, and call it from UNMAP
;<4.EXEC>EXECSU.MAC.204, 4-Jan-79 10:21:41, EDIT BY OSMAN
;FIX UNMAP TO DELETE FREE SPACE
;<4.EXEC>EXECSU.MAC.203, 20-Dec-78 10:33:22, EDIT BY OSMAN
;make /after:thursday really mean "after Thursday"!!
;<4.EXEC>EXECSU.MAC.201, 18-Dec-78 16:49:25, EDIT BY OSMAN
;ADD GETNOD
;<4.EXEC>EXECSU.MAC.200, 7-Dec-78 11:25:19, EDIT BY OSMAN
;MAKE GETAMT GLOBAL, AND MAKE IT RETURN SECONDS IN B (INTERNAL IN A)
;<4.EXEC>EXECSU.MAC.198, 6-Dec-89 10:43:50, EDIT BY OSMAN
;tco 4.2110 - Fix recovery from bad confirmation of KILL subcommand
;<4.EXEC>EXECSU.MAC.196, 5-Dec-78 11:49:11, EDIT BY R.ACE
;ADD ATSAVR - DRIVER FOR ATSAVE MACRO
;<4.EXEC>EXECSU.MAC.195, 1-Dec-78 10:48:44, EDIT BY KIRSCHEN
;ADD SET [NO] DEFAULT TAKE
;<4.EXEC>EXECSU.MAC.194, 29-Nov-78 14:52:12, EDIT BY KIRSCHEN
;TURN OFF TAKE ECHOING AT CCHEOF NOT EOFPSI
;<4.EXEC>EXECSU.MAC.192, 22-Nov-78 15:33:46, EDIT BY KIRSCHEN
;TURN OFF PER-TAKE-COMMAND ECHOING AT EOFPSI
;<4.EXEC>EXECSU.MAC.191, 10-Nov-78 14:10:58, EDIT BY OSMAN
;CHANGE /AFTER:TOMORROW TO /AFTER:TODAY (LIKE THE SPEC SAYS! AND LIKE TOPS10 DOES!)
;<4.EXEC>EXECSU.MAC.188, 7-Nov-78 14:34:31, EDIT BY OSMAN
;tco 4.2082 - REMOVE PUSH'S AT ERRFIN BEFORE CALL UNMAP, AND POP'S AFTER CALL UNMAP.
;1) WHY ARE THEY NEEDED, 2) THERE WAS ONE MORE POP THAN PUSH ANYWAY!
;3) they cause an infinite loop if TIMER fails at CMDIN4+40
;<4.EXEC>EXECSU.MAC.187, 1-Nov-78 15:13:44, EDIT BY OSMAN
;DETECT CHANGE OF SYSTEM PIDS, AND UPDATE EXEC'S COPY AS NEED BE
;<4.EXEC>EXECSU.MAC.186, 31-Oct-78 16:45:09, EDIT BY OSMAN
;ADD GETSXB
;<4.EXEC>EXECSU.MAC.185, 30-Oct-78 14:39:10, EDIT BY OSMAN
;MAKE GETSIX RECOGNIZE QUOTED CHARACTERS
;<4.EXEC>EXECSU.MAC.184, 27-Oct-78 18:22:22, EDIT BY OSMAN
;MAKE GETDIR, GETDRP RETURN POINTER TO ACCOUNT
;<4.EXEC>EXECSU.MAC.183, 27-Oct-78 12:12:15, EDIT BY OSMAN
;MAKE DIRINI ALLOCATE AND INITIALIZE SUBBLOCKS
;<4.EXEC>EXECSU.MAC.181, 26-Oct-78 14:37:19, EDIT BY OSMAN
;tco 4.2068 - Call DOECHO in REPARS
;<CALVIN>EXECSU.MAC.1, 9-Aug-78 12:56:14, EDIT BY CALVIN
; Install function routine for d&t or interval in days (DTIV)
;<3-ARC-EXEC>EXECSU.MAC.4, 4-Aug-78 10:22:05, EDIT BY CALVIN
; bugfixes from BBN's release 3 exec
;<3-ARC-EXEC>EXECSU.MAC.3, 14-May-78 18:34:50, Edit by MTRAVERS
;<3-ARC-EXEC>EXECSU.MAC.2, 14-May-78 17:20:51, Edit by MTRAVERS
;<3-ARC-EXEC>EXECSU.MAC.1, 14-May-78 17:04:27, Edit by MTRAVERS
; Added IGINV flag in SPECFN.
;<4.EXEC>EXECSU.MAC.173, 20-Oct-78 19:31:20, EDIT BY OSMAN
;MAKE IPCRCV/IPCFND RETURN MESSAGES IN THE ORDER THEY WERE SENT
;<4.EXEC>EXECSU.MAC.167, 16-Oct-78 13:32:57, EDIT BY OSMAN
;CLEAR IPCCTL IN ICLEAR, SO THAT ^C OUT OF IPCF WAIT WORKS
;<4.EXEC>EXECSU.MAC.166, 10-Oct-78 15:45:54, EDIT BY OSMAN
;tco 4.2039 - Make "TYPE A,B" name each file before typing it (worked in r2!)
;<4.EXEC>EXECSU.MAC.164, 8-Oct-78 20:14:20, EDIT BY OSMAN
;REMOVE PTY CHECK IN MWATCH ROUTINE
;CHANGE CIS'S TO CALL ICLEAR'S
;<4.EXEC>EXECSU.MAC.157, 8-Oct-78 17:28:00, EDIT BY OSMAN
;ADD %\ (SEE %CHAR)
;<4.EXEC>EXECSU.MAC.156, 8-Oct-78 14:54:55, EDIT BY OSMAN
;FLUSH NERET, CHANGE REFS TO RERET, SINCE THAT'S ALL NERET EVER HAD IN IT!
;<4.EXEC>EXECSU.MAC.155, 7-Oct-78 00:45:11, EDIT BY OSMAN
;add DGETER
;<4.EXEC>EXECSU.MAC.124, 28-Sep-78 16:43:08, EDIT BY OSMAN
;PUT IN STUFF FOR GETTING INTERRUPT ON IPCF MESSAGE
;<4.EXEC>EXECSU.MAC.123, 28-Sep-78 14:27:33, EDIT BY OSMAN
;REMOVE ALL Bn SYMBOLS
;<4.EXEC>EXECSU.MAC.115, 26-Sep-78 13:28:16, EDIT BY OSMAN
;TURN ON CM%WKF IF NOT LOGGED IN
;<4.EXEC>EXECSU.MAC.114, 22-Sep-78 16:56:24, EDIT BY OSMAN
;ADD GETASC
;<4.EXEC>EXECSU.MAC.110, 18-Sep-78 17:01:29, EDIT BY OSMAN
;MAKE BCOUNT BE GLOBAL
;TCO 4.2010 - FIX ERROR MESSAGE ON "DIR A,B,C,D" IF C DOESN'T EXIST
;<4.EXEC>EXECSU.MAC.92, 15-Sep-78 15:30:13, EDIT BY OSMAN
;USE STANDARD FREE-SPACE MANAGEMENT FOR MANIPULATING STRINGS
;<4.EXEC>EXECSU.MAC.90, 14-Sep-78 14:10:59, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXECSU.MAC.89, 14-Sep-78 11:17:28, EDIT BY OSMAN
;ADD QUASAR ROUTINES QUASND, QCLEAN
;<4.EXEC>EXECSU.MAC.88, 12-Sep-78 15:15:18, EDIT BY OSMAN
;REMOVE WAKE AND NOWAKE
;<4.EXEC>EXECSU.MAC.87, 14-Aug-78 16:51:55, EDIT BY OSMAN
;FIX GETTER TO RETURN -1 INSTEAD OF GARBAGE IF THERE IS NO TERMINATOR
;<4.EXEC>EXECSU.MAC.86, 13-Aug-78 14:37:03, Edit by HELLIWELL
;ADD CPFNA ENTRY FOR "SET EDITOR"
;<4.EXEC>EXECSU.MAC.85, 12-Aug-78 16:17:35, EDIT BY OSMAN
;MAKE ERRFIN GLOBAL
;<4.EXEC>EXECSU.MAC.83, 10-Aug-78 10:05:55, EDIT BY OSMAN
;IN CFN, CHANGE DEFINITION OF B17 TO MEAN "NO SUBCOMMANDS"
;<4.EXEC>EXECSU.MAC.81, 5-Aug-78 14:23:48, Edit by DBELL
;<4.EXEC>EXECSU.MAC.80, 5-Aug-78 14:04:26, Edit by DBELL
;TCO 1971. MAKE ^T ALWAYS SHOW THE CURRENT PROGRAM NAME
;<4.EXEC>EXECSU.MAC.79, 3-Aug-78 16:13:35, EDIT BY OSMAN
;FIX SPELLING OF SEPARATE, AND MAKE HELP MESSAGE FOR /AFTER: LOWERCASE
;<4.EXEC>EXECSU.MAC.78, 3-Aug-78 15:13:17, EDIT BY OSMAN
;PUT SPACE IN FRONT OF $ PROMPT TO PREVENT CONFUSION FOR OPERATOR MODE BATCH JOBS
;<4.EXEC>EXECSU.MAC.77, 3-Aug-78 14:50:59, EDIT BY OSMAN
;PREVENT FATAL ERROR/LOGOUT IF "TAKE" JFN CLOSED "ACCIDENTALLY"
;USE STANDARD TRAP LOGIC FOR ILL INST TRAP
;<4.EXEC>EXECSU.MAC.76, 2-Aug-78 11:07:04, EDIT BY OSMAN
;MAKE THINGS LIKE "ILLEGAL MEMORY READ" HAVE "?" IN FRONT OF THEM
;<4.EXEC>EXECSU.MAC.73, 2-Aug-78 10:13:06, EDIT BY OSMAN
;ADD PDL OVERFLOW ROUTINE
;<4.EXEC>EXECSU.MAC.71, 27-Jul-78 15:56:38, EDIT BY OSMAN
;CHANGE $STR TO USE CM%PO
;<4.EXEC>EXECSU.MAC.69, 25-Jul-78 10:12:15, EDIT BY OSMAN
;ADD RJFN TO UNSTACK A SINGLE JFN
;<4.EXEC>EXECSU.MAC.66, 21-Jul-78 10:11:52, Edit by PORCHER
;MAKE "TAKE, ECHO" PRINT RIGHT PROMPT
;ADD GETMOD
;<4.EXEC>EXECSU.MAC.59, 20-Jul-78 15:42:01, EDIT BY OSMAN
;ADD SETMOD
;ALLOW FANCIER /AFTER:
;<4.EXEC>EXECSU.MAC.53, 18-Jul-78 15:54:52, EDIT BY OSMAN
;ALLOW "/AFTER:+72:0:0" ETC. (SEE BIGTIM:)
;<4.EXEC>EXECSU.MAC.49, 17-Jul-78 11:13:10, EDIT BY OSMAN
;GET RID OF REFS TO GTBUF
;<4.EXEC>EXECSU.MAC.48, 13-Jul-78 13:16:58, EDIT BY OSMAN
;REMOVE REFS TO ERPC
;REMOVE %Y:
;<4.EXEC>EXECSU.MAC.46, 10-Jul-78 20:40:12, EDIT BY OSMAN
;MAKE SVCSBP BE LOCAL
;<4.EXEC>EXECSU..1, 10-Jul-78 20:35:19, EDIT BY OSMAN
;REMOVE SVPRMT
;<4.EXEC>EXECSU.MAC.38, 10-Jul-78 14:09:25, EDIT BY OSMAN
;CLEAN UP CFN1 CODE TO NOT DO PUSH'S
;<4.EXEC>EXECSU.MAC.36, 29-Jun-78 15:39:33, EDIT BY OSMAN
;make cfnmod be local variable
;<4.EXEC>EXECSU.MAC.35, 29-Jun-78 13:49:19, EDIT BY OSMAN
;ADD SETT20, SETPRG
;<4.EXEC>EXECSU.MAC.30, 27-Jun-78 16:10:53, EDIT BY OSMAN
;CHANGE ALL GTB'S TO USE MONSYM SYMBOLS
;<4.EXEC>EXECSU.MAC.29, 27-Jun-78 16:02:40, EDIT BY OSMAN
;CHANGE GTB UUO TO BE IMMEDIATE
;<4.EXEC>EXECSU.MAC.28, 27-Jun-78 14:22:21, EDIT BY OSMAN
;ADD PION AND PIOFF ROUTINES THAT DON'T DO ANY JSYS'S
;<4.EXEC>EXECSU.MAC.25, 27-Jun-78 11:10:46, EDIT BY OSMAN
;ADD GTJFS AND REMOVE REF TO LNGJFN (IN JFNSTK)
;<4.EXEC>EXECSU.MAC.24, 26-Jun-78 13:54:16, EDIT BY OSMAN
;SET PROGRAM NAME TO COMMAND NAME WHEN COMMAND CONFIRMED
;<4.EXEC>EXECSU.MAC.22, 23-Jun-78 18:43:57, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: CFN2A, CFN4, CFNLEV, DEVN1, DIRNMS,
;DIRNMX, DWNPNT, ERRDO, MCOPY0, USRNMX, %Q1A
;<4.EXEC>EXECSU.MAC.14, 21-Jun-78 17:01:08, EDIT BY OSMAN
;USE INTERRUPT FOR MAIL-WATCH (AVOIDS DOING GTAD ON EVERY COMMAND)
;<4.EXEC>EXECSU.MAC.11, 19-Jun-78 14:43:34, EDIT BY OSMAN
;DON'T DO DVCHR EVERY TIME READY IS CALLED. (TEST TINPF INSTEAFD)
;<4.EXEC>EXECSU.MAC.9, 19-Jun-78 10:43:27, EDIT BY OSMAN
;ADD GETSIX, FIXPT
;<4.EXEC>EXECSU.MAC.8, 12-Jun-78 13:48:10, EDIT BY OSMAN
;ADD BUFFS
;<4.EXEC>EXECSU.MAC.6, 9-Jun-78 18:01:27, EDIT BY OSMAN
;ADD FLDSKP
;<4.EXEC>EXECSU.MAC.5, 9-Mar-78 09:22:08, Edit by ENGEL
;ADD MTOPR FUNCTIONS FOR SAVEING AND RESTORING THE FULL MASK
;<4.EXEC>EXECSU.MAC.4, 31-Jan-78 13:37:00, Edit by PORCHER
;<4.EXEC>EXECSU.MAC.3, 31-Jan-78 11:51:09, Edit by PORCHER
;<4.EXEC>EXECSU.MAC.2, 31-Jan-78 09:33:07, Edit by PORCHER
;Add stuff for "TAKE,ECHO"
;<4.EXEC>EXECSU.MAC.1, 30-Jan-78 17:18:19, Edit by PORCHER
;Add stuff for execute-only
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE - SUBROUTINES
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH XDEF
TTITLE SUBRS
;THIS FILE CONTAINS SUBROUTINES AND SERVICE ROUTINES IN THREE SECTIONS:
; 1. MONITOR-INDEPENDENT LANGUAGE DECODING OPERATIONS
; 2. MONITOR-DEPENDENT OPERATIONS, E.G. I/O
; 3. PSEUDO-INTERRUPT AND ERROR PROCESSORS
;INTERNS -- ROUTINES IN THIS ASSEMBLY
INTERN READY,read1,READY2,REPARS ;PRINT ONE OR TWO READY CHARACTERS (@ OR !)
INTERN PRVCK ;ROUTINE FOR CHECKING PRIVILEGES
INTERN %KEYW ;SERVICE ROUTINE FOR KEYWORD LOOKUP UUO (KEYWD)
INTERN %NOI ;SERV ROUTINE FOR NOISE WORD UUO ("NOISE" MACRO)
INTERN %SBCOM ;UUO TO INPUT AND DISPATCH ON SUBCOMMANDS
INTERN CONF ;TERMINATE AND CONFIRM COMMAND
INTERN SPRTR ;ANALYZE separatOR/TERMINATOR IN ARG LIST
DEFINE XX (FOO)
<
INTERN FOO'$
>
ULIST
INTERN COUTFN,CSAVFN,SPECFN,CPFN,CPFNA ;INPUT IN, OUT, SPECIAL, PROG FILE NAMES
INTERN .INFG,$INFGX,DIRARG ;INPUT FILE GROUP DESCRIPTORS
INTERN TYPIF,TYPOK,GNFIL ;ROUTINES FOR STEPPING THRU FILES IN GRP
INTERN DEVN ;COLLECT DEVICE NAME
INTERN TOCT,OCTCOM,TOUT,TOUTD ;NUMBER OUTPUT SUBRS
INTERN BUFFF ;BUFFER LAST FIELD SUITABLY FOR USE AS JSYS ARG
INTERN NOECHO,DOECHO,LTTYMD,RTTYMD ;TTY MODES ETC
INTERN %PRINT ;OUTPUT CHARACTER UUO
INTERN MAPPF ;MAP PAGE OF FORK SUBR
INTERN LOADF ;LOAD WORD FROM FORK SUBR
INTERN STOREF ;STORE WORD INTO FORK SUBR
INTERN %GTB ;convenIENT GETAB JSYS CALL UUO
INTERN USEPSI ;TERMINAL PSI TO PRINT RUNTIME (^T)
INTERN NIYE,NIM,SCREWUP,JERR,JERRC ;VARIOUS ERROR CONDITIONS
INTERN %TRAP ;CHANNEL 1 ERROR PSI MESSAGE UUO
INTERN ILIPSI ;ILLEGAL INSTRUCTION PSI
INTERN EOFPSI ;END-OF-FILE PSEUDO-INTERRUPT ON CHANNEL 1
INTERN DATPSI ;FILE DATA ERROR INTERRUPT
INTERN CCPSI ;^C PSI ON CHANNEL 1
INTERN TLMPSI ;TIME EXCEEDED ON CHANNEL 4
INTERN COBPSI ;^O PSI ON CHANNEL 5
INTERN ALOPSI ;PSI ON CHAN 1 FROM AUTOLOGOUT FORK
INTERN AUTOLO ;ROUTINE TO DO AUTOLOGOUT
INTERN %ERR,%$ERR,%.$ERR ;GENERAL ERROR UUOS (MACROS "ERROR" ETC)
INTERN RERET ;NORMAL AFTER-ERROR ROUTINE FOR CERET TO PT TO
INTERN RLJFNS ;CLOSE & RELEASE JFNS USED BY CURRENT COMMAND
INTERN %ETYPE ;TYPE MESSAGE, INTERPRETING %-CODES
INTERN CERR
INTERN FLOAT ;FLOAT INTEGER IN A
;to do table lookup of next field of command, do:
;
; helpx <this is what "?" types out>
; keywd table ;"table" is address of table
; t foo... ;appropriate "t" macro form of default value
; error return
; success return ;p3 has value from table
%KEYW: PUSH P,A ;DON'T CLOBBER ANY AC'S
HLRO A,@-1(P) ;PICK UP POINTER TO DEFAULT FIELD VALUE
AOS -1(P) ;SKIP THE DEFAULT ON RETURN
TRNE A,-1 ;LEAVE DEFAULT POINTER AS IS IF NO FIELD SUPPLIED
MOVEM A,CMDEF ;SAVE DEFAULT STRING POINTER
POP P,A
ATSAVE ;SAVE AC'S
HRRZ A,40 ;PICK UP ADDRESS OF KEYWORD TABLE
MOVEM A,CMDAT ;SAVE ADDRESS OF TABLE
MOVX A,CMKEY ;PREPARE TO PARSE KEYWORD
SKIPE CMDEF ;IS THERE A DEFAULT?
TXO A,CM%DPP ;YES, TELL COMND TO READ IT
skipe cmhlp ;user help message?
txo a,cm%hpp ;yes, use it
MOVEM A,CMFNP ;STORE FLAGS
MOVEI B,FBLOCK ;GET ADDRESS OF FUNCTION BLOCK
CALL FIELD ;INPUT THE KEYWORD FIELD
SETZM CMDEF ;DON'T LET SAME DEFAULT BE USED OVER.
setzm cmhlp ;don't let same help be used over
TXNE A,CM%NOP ;MAKE SURE FIELD PARSED ALRIGHT
RET ;DIDN'T, TAKE SINGLE RETURN
CALL GETKEY ;GET KEYWORD DATA
RETSKP ;GIVE SKIP RETURN
;ROUTINE TO TAKE TABLE ADDRESS IN B AND RETURN TABLE DATA IN P3.
GETKEY:: HRRZ P3,(B) ;GET ADDRESS OF CONTROL DATA
MOVE P3,(P3) ;GET THE CONTROL DATA ITSELF
RET ;GIVE GOOD RETURN
;FIELD INPUT ROUTINE. CALL IT WITH ADDRESS OF FUNCTION DESCRIPTOR
;BLOCK IN AC "B". ROUTINE RETURNS WITH A, B, C, CONTAINING
;WHATEVER COMND PUT THERE.
FIELD:: STKVAR <<CMDDAT,2>,CMDFDB>
MOVEI A,CCHEOF ;GET EOF DISPATCH ADDRESS
MOVEM A,EOFDSP ;WHERE TO GO ON END OF FILE
MOVX A,CM%WKF!CM%XIF ;WAKE ON EVERY FIELD SO ECHO CAN BE TURNED OFF IN TIME FOR LOGIN
SKIPN CUSRNO ;IS USER LOGGED IN?
IORM A,CMFLG ;NO, SO DON'T ALLOW "@" AND WAKE PER FIELD
MOVX A,CM%WKF
SKIPE CUSRNO ;LOGGED IN?
ANDCAM A,CMFLG ;YES, SO DON'T WAKE PER FIELD
AOS CLZFFF ;SAY CLZFF BETTER BE DONE IF ^C HERE.
MOVEI A,SBLOCK ;ADDRESS OF COMMAND STATE BLOCK
COMND ;DO THE COMND JSYS ITSELF (ONLY ONE IN EXEC! 6/16/77 EO)
ERCAL EOFJER ;FAILED, SAY WHY AND DIE
DMOVEM B,CMDDAT ;REMEMBER DATA
MOVEM C,CMDFDB
AOS TTYACF ;NOTE THAT SOME TTY ACTION OCCURED
SETZM CMDEF ;CLEAR DEFAULT STRING, SO ISN'T USED AGAIN INADVERTANTLY
SETZM CMHLP ;CLEAR HELP MESSAGE, SO IT ISN'T USED AGAIN
SETZM CMDAT ;DON'T LET SAME DATA BE ARBITRARILY USED AGAIN
SETZM EOFDSP ;CLEAR EOF DISPATCH ADDRESS
; If this is a confirmation, echo the command if desired.
TXNE A,CM%NOP ;Success?
JRST [ SOS CLZFFF ;NO, CLZFF NO LONGER NEEDED
JRST FIELD1] ;SKIP FUNCTION CODE ANALYSIS
LDB A,[POINTR((C),CM%FNC)] ;Get function code
CAIE A,.CMIFI ;SOMETHING PARSED WHICH CREATED A JFN?
CAIN A,.CMOFI
JRST FIELDF ;YES, LEAVE CLZFFF ON TO FORCE CLZFF IF ^C.
CAIN A,.CMFIL
JRST FIELDF ; " "
SOS CLZFFF ;NOT FILESPEC FUNCTION, CLZFF NOT NEEDED
CAIE A,.CMCFM ;Confirmation?
JRST FIELD1 ;No, go on
SETZM CLF ;NOT AT COMMAND LEVEL IF JUST PARSED RETURN
SKIPE CIPF ;COMMAND ALREADY IN PROGRESS?
JRST FIELD1 ;YES
MOVE A,COMAND ;GET ADDRESS OF TABLE ENTRY
HLRZ A,(A) ;GET ADDRESS OF COMMAND NAME INFO
MOVSI B,774000 ;SEE IF THIS IS A FLAG WORD
TDNN B,(A) ;IS IT?
AOJ A, ;YES, SO COMMAND NAME STARTS IN NEXT WORD
HRLI A,440700 ;MAKE POINTER TO BEGINNING OF COMMAND NAME
MOVEM A,COMAND ;REMEMBER POINTER TO ASCII
CALL GETSIX ;GET SIXBIT NAME FOR COMMAND
JFCL ;TRUNCATE IF COMMAND TOO LONG
MOVEM A,COMSIX ;REMEMBER IT
SETNM ;TELL SYSTEM, SO SYSTAT SHOWS IT
SETOM CIPF ;SAY COMMAND IN PROGRESS
CALL ECHCMD ;ECHO THE COMMAND IF NECESSARY
FIELD1: MOVX A,CM%XIF
ANDCAB A,CMFLG ;ALLOW "@" UNLESS CALLER SAYS DON'T, RETURN FLAGS IN A
DMOVE B,CMDDAT ;RETURN COMND DATA IN B
RET
FIELDF: MOVE A,B ;GET JFN
CALL JFNSTK ;STACK IT SO WE REMEMBER TO RELEASE IT LATER
SOS CLZFFF ;CLZFF NO LONGER NEEDED WHEN JFN IS STACKED
JRST FIELD1
;ROUTINE WHICH CALLS FIELD AND SKIPS IFF SUCCESSFUL PARSE
FLDSKP:: CALL FIELD ;PARSE THE INPUT
TXNE A,CM%NOP ;DID IT PARSE CORRECTLY?
RET ;NO, NON-SKIP
RETSKP ;YES, SKIP
;ROUTINE TO ECHO THE CURRENT COMMAND STRING IF NEED BE
ECHCMD:: SKIPN ECHOF ;Echo only if requested
RET ;No echoing
ECH1: MOVE A,IOPT ;Get current pointer to TAKE JFNS
POP A,(A) ;Back up one
CAMN A,IOPTB ;Top of command stack?
RET ;Yes-- Don't echo
MOVE A,SVPRMT ;Get pointer to prompt string
ETYPE <%1M> ;Type prompt string
UTYPE CBUF ; And command buffer
CALLRET LM ;GET TO LEFT MARGIN IF COMMAND WASN'T COMPLETE
;ROUTINES TO TELL MONITOR WE'RE AT TOPS20 LEVEL AND PROGRAM LEVEL.
;THE BATCH SYSTEM NEEDS THESE TO KNOW TO SEND ^C IF WE'RE AT PROGRAM
;LEVEL, AND NEXT LINE OF BATCH JOB INPUT IS SUPPOSED TO GO TO THE
;EXEC.
;
;NOTE: EXEC IS CAREFUL NOT TO CALL THESE ON EVERY COMMAND, IN ORDER
;TO MINIMIZE NUMBER OF JSYS'S DONE PER COMMAND.
SETMOD:: MOVE C,A ;ARG IN C
JRST SETMD1
SETPRG:: SKIPA C,[0] ;SPECIFY PROGRAM LEVEL
SETT20:: HRROI C,-1 ;SPECIFY TOPS20 LEVEL
SETMD1: HRROI A,-1 ;CURRENT JOB
MOVX B,.SJT20 ;SPECIFY TOPS20 FUNCTION
SETJB ;TELL MONITOR WHICH LEVEL
ERJMP .+1 ;FAILED, PROBABLY OLD MONITOR
RET
;ROUTINE TO GET TOPS20 MODE
;RETURNS RESULT IN A
GETMOD:: HRROI A,-1 ;CURRENT JOB
HRROI B,A ;PUT RESULT IN A
MOVEI C,.JIT20 ;SPECIFY THIS FUNCTION
GETJI ;GET THE INFO FROM SYSTEM
ERJMP .+1 ;IGNORE ERROR, PROBABLY OLD MONITOR
RET
;GET CURRENT CLASS AND LOAD AVERAGES
;ACCEPTS: A/ JOB NUMBER OR -1 FOR CURRENT JOB
;RETURNS: +1
; A/ -1 FOR NO CLASS SCHEDULING, OR CLASS NUMBER
; B/ 1-MINUTE LOAD AVERAGE
; C/ 5-MINUTE LOAD AVERAGE
; D/ 15-MINUTE LOAD AVERAGE
GLBLN==10 ;ROOM TO GET LOAD AVERAGES
GLOADS:: STKVAR <WJOBN,<GLBLK,GLBLN>>
MOVEM A,WJOBN ;REMEMBER WHICH JOB
CALL CLSON ;CLASS SCHEDULING ON?
JRST GLNO ;NO
MOVEI A,GLBLN ;ALLOCATE ROOM IN BLOCK
MOVEM A,.SACNT+GLBLK
MOVE A,WJOBN ;GET JOB
MOVEM A,.SAJOB+GLBLK
MOVEI A,.SKRJP ;READ THIS JOB'S CLASS
MOVEI B,GLBLK
SKED% ;SEE WHAT CLASS WE'RE IN
MOVE A,.SAJCL+GLBLK
MOVEM A,.SACLS+GLBLK ;MOVE CLASS FOR ASKING FOR LOADS
MOVEI A,GLBLN ;ALLOCATE ROOM IN BLOCK
MOVEM A,.SACNT+GLBLK
MOVEI A,.SKRCS ;NOW GET LOAD AVERAGES FOR THE CLASS
SKED%
GLN2: HRLI A,.SA1ML+GLBLK ;MOVE DATA STARTING WITH LOAD AVS
HRRI A,B ;MOVE INTO AC'S
BLT A,D ;GET CLASS, 1M LOAD, 5M LOAD, 15M LOAD
MOVE A,.SACLS+GLBLK ;RETURN CLASS IN A
RET
GLNO: MOVEI D,14 ;FIRST SYSTEM LOAD AVERAGE IS WORD 14
GTB .SYSTA
MOVEM A,.SA1ML+GLBLK ;STORE THE LOAD AVERAGES
MOVEI D,15
GTB .SYSTA
MOVEM A,.SA5ML+GLBLK
MOVEI D,16
GTB .SYSTA
MOVEM A,.SA15L+GLBLK
HRROI A,-1 ;-1 MEANS CLASS SCHEDULING IS OFF
MOVEM A,.SACLS+GLBLK
JRST GLN2 ;GO RETURN RESULTS
;SKIP IF CLASS SCHEDULER IS ON...
;A CONTAINS STATUS BITS OF SCHEDULER
CLSON:: MOVEI B,C ;ARG BLOCK IN C
MOVEI A,.SKRCV ;READ STATUS
MOVEI C,2 ;SPECIFY A 2-WORD BLOCK
SKED% ;GET THE INFO
MOVE A,D ;RETURN DATA IN A
TXNN A,SK%STP ;CLASS SCHEDULER ON?
RETSKP ;YES, SKIP
RET ;NO, DON'T.
;GET TERMINATOR OF LASS FIELD, RETURNED IN A. -1 IS RETURNED IF NO
;TERMINATOR HAS BEEN TYPED YET
GETTER:: MOVE B,SBLOCK+.CMPTR ;GET POINTER TO REST OF LINE
HRROI A,-1 ;RETURN -1 IF NO TERMINATOR YET
SKIPLE SBLOCK+.CMINC ;MAKE SURE THERE ARE SOME UNPARSED CHARACTERS
ILDB A,B ;GET NEXT CHARACTER AFTER PARSED FIELD
RET
;NACL SKIPS IF NOT AT TOPS20 COMMAND LEVEL. THIS IS USEFUL IF SOME
;ASYNCHRONOUS CODE HAS SOMETHING TO SAY AND DOESN'T WANT INTERRUPT OTHER
;OUTPUT OR COMMAND INPUT
NACL:: SKIPN CLF ;AT COMMAND LEVEL?
RETSKP ;NO
MOVE A,CMRTY ;YES, SEE HOW MANY CHARACTERS IN PROMPT
CALL FIXPT
MOVEI C,0 ;C WILL ACCUMULATE COUNT
NACL1: ILDB B,A ;GET NEXT CHARACTER OF PROMPT STRING
CAIE B,0 ;DONE COUNTING WHEN NULL HIT
AOJA C,NACL1
MOVE A,CIJFN ;GET INPUT CHANNEL
RFPOS ;SEE IF USER HAS STARTED TYPING COMMAND YET
CAIL C,(B) ;HAS HE STARTED TYPING YET?
RET ;NO, SO DON'T SKIP. IT'S O.K. TO BLURT MESSAGE NOW
RETSKP ;HE STARTED TYPING, SO DON'T DISTURB HIM
;ROUTINE WHICH SKIPS IFF LAST FIELD WASN'T TERMINATED WITH ALTMODE.
;THIS ROUTINE ONLY NEEDS TO BE CALLED IN SITUATIONS WHERE IT'S AMBIGUOUS
;AS TO WHETHER USER SHOULD BE PROMPTED FOR NEXT FIELD, OR ALLOWED TO ENTER
;MORE FOR THIS FIELD. FOR INSTANCE, IN A "COPY" COMMAND, "COPY FOO$":
;SHOULD WE WAIT FOR MORE, DESPITE THE ALTMODE, IN CASE USER WANTS TO
;MAKE IT "COPY FOO,BAR (TO) ...", OR SHOULD WE ASSUME THAT THE ALTMODE
;MEANS DO "COPY FOO (TO)" ? THE CURRENT ANSWER IS THAT THE ALTMODE MEANS
;GO ON TO THE NEXT FIELD. OTHERWISE, USER WOULD NEVER SEE "(TO)" PRINTED
;OUT. ANOTHER EXAMPLE IS A COMMAND LIKE "SET PAGE-ACCESS 1:3$". ALTHOUGH
;THE USER COULD AT THIS POINT MAKE IT "...1:3,4...", WE ASSUME THAT
;THE ALTMODE MEANS GO ON TO NEXT FIELD, HENCE MAKING IT
;"SET PAGE-ACCESS 1:3 (TO)". THIS ROUTINE CLOBBERS NO AC'S.
NESC: ATSAVE ;PRESERVE TEMPY'S
MOVE A,CMFLG ;GET FLAGS
TXNE A,CM%ESC ;LAST FIELD END WITH ALTMODE?
RET ;YES, NO SKIP
RETSKP ;NO, SO SKIP
;ROUTINE TO INITIALIZE COMMAND LINE JSYS AND PRINT PROMPT FOR NEW COMMAND.
READY: MOVEM A,CMDACS ;DON'T CLOBBER ANY AC'S
HRROI A,[ASCIZ / $/] ;PRECEDE PROMPT WITH SPACE IF BATCH
SKIPN BATCHF ;THIS PREVENTS CONFUSION WITH OPERATOR MODE
HRROI A,[ASCIZ /$/] ;USE A DOLLAR SIGN
SKIPN PRVENF ;USE @ IF NOT ENABLED
HRROI A,[ASCIZ /@/] ;ONE PROMPT FOR REGULAR COMMAND
JRST READ1 ;JOIN COMMON CODE
READY2: MOVEM A,CMDACS ;DON'T CLOBBER AC1
HRROI A,[ASCIZ / $$/] ;PRECEDE PROMPT WITH SPACE IF BATCH
SKIPN BATCHF ;THIS PREVENTS CONFUSION WITH OPERATOR MODE
HRROI A,[ASCIZ /$$/] ;USE A DOLLAR SIGN
SKIPN PRVENF ;USE @ IF NOT ENABLED
HRROI A,[ASCIZ /@@/] ;ONE PROMPT FOR REGULAR COMMAND
;enter here for custom prompt characters:
READ1: MOVEM A,CMRTY ;SET UP PROMPT BUFFER
MOVEM A,SVPRMT ; AND REMEMBER THE POINTER FOR "TAKE, ECHO"
POP P,REPARA ;REMEMBER WHERE TO REPRASE TO
MOVE A,CMDACS ;GET SAVED AC1 (SEE %$TYPE:)
MOVEM 17,CMDACS+17 ;SAVE AC17 AWAY
MOVEI 17,CMDACS ;MAKE BLT POINTER 0,,CMDACS
BLT 17,CMDACS+16 ;SAVE REST TO AC'S
MOVE 17,CMDACS+17 ;LEAVE AC17 INTACT
MOVE A,JBUFP ;GET CURRENT LOCATION ON JFN STACK
MOVEM A,.J ;REMEMBER WHERE WE ARE FOR REPARSE
HRR A,COJFN ;GET OUTPUT JFN
HRL A,CIJFN ;AND INPUT
MOVEM A,CMIOJ
HRROI A,[0] ;GET NULL STRING
SKIPN TINPF ;INPUTTING FROM TERMINAL?
MOVEM A,CMRTY ;NO PROMPT UNLESS INPUTTING FROM TERMINAL
MOVX A,CMINI ;DO INITIALIZATION, PRINT PROMPT
MOVEM A,CMFNP
MOVEI B,FBLOCK ;SPECIFY FUNCTION BLOCK ADDRESS
CALL FIELD ;TYPE THE PROMPT
MOVE A,CMDACS+A
MOVE B,CMDACS+B ;RESTORE AC'S WE USED
MOVE C,CMDACS+C ;LEAVE ALL AC'S AS WE FOUND THEM
JRSTF @REPARA ;RETURN TO CALLER
;GUIDE WORD HANDLER, INVOKED WITH "NOISE" MACRO
%NOI: ATSAVE ;DON'T CLOBBER AC'S
HRRO A,40 ;GET POINTER TO GUIDE STRING
MOVEM A,CMDAT ;SET UP GUIDE STRING
MOVX A,CMNOI ;SPECIFY NOISE FUNCTION
MOVEM A,CMFNP
MOVEI B,FBLOCK
CALL FLDSKP ;READ THE GUIDE WORDS
CMERRX
RET
;ROUTINES TO TURN IPCF INTERRUPTS ON AND OFF. INTS MUST BE TURNED OFF IN
;VARIOUS PLACES TO AVOID RECEIVING AN IPCF MESSAGE WITHOUT KNOWING ABOUT IT.
IPCON:: SOSLE IINTDF ;DECREMENT AMOUNT OF NESTING
RET ;SOMEONE ELSE STILL WANTS IPCOFF!
SETOM IPCALF ;ALLOW IPCF INTERRUPTS AGAIN
MOVEI A,.FHSLF ;TALK TO OURSELF
MOVX B,1B<IPCCHN> ;PREPARE TO SIMULATE IPCF INTERRUPT
SKIPE IPCWTF ;IS THERE A WAITING INTERRUPT?
IIC ;YES, FORCE AN INTERRUPT
RET
IPCOFF:: AOS IINTDF ;NEST DEEPER INTO OFFNESS
SETZM IPCALF ;THIS FLAG 0 MEANS DON'T ALLOW IPCF INTERRUPT
RET
;PION/PIOFF CONTROL PRIORITY INTERRUPT, TURNING IT ON AND OFF.
;USE PIOFF TO PREVENT ^C, AND PION TO ALLOW IT AGAIN.
PION:: SOSLE INTDF ;DECREMENT AMOUNT OF NESTING
RET ;SOMEONE ELSE STILL WANTS NO ^C, DO NOTHING MORE
SETOM ACTRCF ;ALLOW ^C
TLNE Z,CTLCF1 ;USER ALREADY TYPE ^C?
JRST .CTRLC ;YES
RET
PIOFF:: AOS INTDF ;INCREMENT AMOUNT OF NESTING
SETZM ACTRCF ;DISALLOW ^C
RET
;PRVCK
;SUBROUTINE TO CHECK SPECIAL CAPABILITIES THIS USER HAS AGAINST THOSE
; REQUIRED AS INDICATED BY BITS IN B, GENERALLY FROM
; A KEYWORD TABLE.
;SKIPS UNLESS SPEC CAP(S) ARE REQUIRED BUT USER HAS NONE OF THEM.
;USES: FORK COMMAND (XCMD1.MAC), %KEYWD (JUST ABOVE).
PRVCK: TXNN B,WHLU+OPRU+ERRU
RETSKP
SKIPN CUSRNO ;MUST BE LOGGED IN TO HAVE PRIVILEGES
RET
ATSAVE
MOVE D,B
MOVEI A,.FHSLF
RPCAP ;READ CAPABILITIES ENABLED FOR THIS PROCESS
TXNE D,WHLU
TXNN C,SC%WHL
JRST .+2
JRST PRVCK8 ;WHEEL COMMAND AND "ENABLE"D WHEEL USER
TXNE D,OPRU
TXNN C,SC%OPR
JRST .+2
JRST PRVCK8 ;OPERATOR COMMAND AND "ENABLE"D OPERATOR USER
TXNE D,ERRU
TXNN C,SC%CNF ;TEST "CONFIDENTAIL INFORMATION ACCESS" CAP
RET
PRVCK8: RETSKP
;USUBCO UUO, INVOKED BY SUBCOM MACRO
;INPUT AND DISPATCH ON SUBCOMMANDS, USING TABLE EFFECTIVE ADDR POINTS TO
;TERMINATES ON NULL SUBCOMMAND OR ONE WITH 0 DISPATCH ADDRESS
;USES INCLUDE DIRECTORY, COPY, PRINT, CREATE, TYPE/LIST
%SBCOM: STKVAR <OCERET,OJBUFP,KADDR,INITR>
MOVE A,CERET
MOVEM A,OCERET ;SAVE OLD LOCATION FOR ERROR DISPATCH
MOVE A,.JBUFP
MOVEM A,OJBUFP ;SAVE OLD JFN STACK POINTER BOUNDARY
HRRZ A,40 ;GET KEYWORD TABLE ADDRESS ADDRESS
MOVE B,(A) ;GET TABLE ADDRESS
MOVEM B,KADDR
MOVE B,1(A) ;GET INIT ROUTINE ADDRESS
MOVEM B,INITR
MOVEI A,[ CALL FLJFNS ;ON ERROR, FLUSH JFN FOR ERRONEOUS SUBCOMMAND
JRST SBCOM1] ;THEN GO AND PROMPT FOR NEXT SUBCOMMAND
MOVEM A,CERET ;SAY COME BACK HERE AFTER PRINTING ERROR MESSAGE
MOVEM P,.P ;REMEMBER STACK POINTER IN CASE ERROR DURING SUBCOMMAND
SBCOM1: MOVE A,JBUFP
MOVEM A,.JBUFP ;PREVENT ERRONEOUS SUBCOMMANDS FROM CAUSING COMMAND JFNS TO BE FLUSHED
CALL READY2 ;TYPE 2 READY CHARACTERS: @@ OR !!
MOVEI B,[FLDDB. .CMCFM,,,,,fblock]
MOVE C,KADDR ;GET ADDRESS OF KEYWORD TABLE
movem c,cmdat ;store address of keyword table
movx a,cmkey ;specify keyword function, no special flags
movem a,cmfnp ;store function
CALL FLDSKP ;READ TYPED IN FIELD
CMERRX <Carriage return or subcommand required>
CALL GETKEY ;GET KEYWORD INFO
TXNE P3,ONEWRD ;SINGLE WORD SUBCOMMAND?
CONFIRM ;CONFIRM BEFORE DISPATCH
TRNN P3,-1
JRST SBCOM9 ;0 DISPATCH ADDRESS MEANS TERMINATE SUBCOMMANDS
SKIPE INITR ;IS THERE AN INITIALIZATION ROUTINE?
CALL @INITR ;YES, EXECUTE IT
CALL (P3) ;CALL CALLER'S ROUTINE FOR THIS SUBCOMMAND
JRST SBCOM1 ;GO GET ANOTHER
SBCOM9: MOVE A,OJBUFP ;GET OLD JFN BOUNDARY
MOVEM A,.JBUFP ;RESTORE AS BEFORE SUBCOMMANDS
MOVE A,OCERET ;GET OLD ERROR DISPATCH ADDRESS
MOVEM A,CERET
RET
;CONF
;CONFIRMATION AND COMMAND TERMINATION SUBROUTINE
;ALL COMMANDS, EVEN NON-CONFIRMATION ONES, SHOULD CALL THIS.
;IF TYPIST TYPES "?", IT TELLS HIM THAT IT'S WAITING FOR
;CONFIRMATION. IF HE STARTS WITH ! OR ; (RECOGNIZED COMMENT CHARACTERS
;DUE TO PHASE OF MOON AT TIME OF THIS DOCUMENTATION), IT ALLOWS
;A COMMENT TO PRECEDE THE CONFIRMATION. (CONFIRMATION ITSELF IS
;CARRIAGE RETURN, LINEFEED, CONTROL-L ETC.) IF A NON-COMMENT PRECEDES
;THE CONFIRMATION, AN ERROR MESSAGE RESULTS.
;FCONF PRINTS [CONFIRM] THEN FORCES FURTHER CONFIRMATION
FCONF:: prompt <[Confirm]>
FCONFA::
;CONF
CONF: ATSAVE ;SAVE TEMPORARIES
CRRX <Confirm with carriage return>
CMERRx ;BAD CONFIRMATION TYPED
RET ;GOOD CONFIRMATION, RETURN.
;SPRTR
;READS END OF LINE, DETECTING COMMA FOR SUBCOMMANDS. TAKES non-skip RETURN IF COMMA THEN
;CARRIAGE RETURN. TAKES SKIP IF JUST CARRIAGE RETURN.
SPRTR: ATSAVE ;DON'T CLOBBER AC'S
COMMAX <Confirm with carriage return or comma to enter subcommands>
JRST SPR1 ;NOT COMMA, MAYBE END OF INE
CRRx <Carriage return to enter subcommands>
ERROR <Carriage return required after comma to enter subcommands>
RET ;REGULAR SKIP IF COMMA SEEN
SPR1: CRRX ;NO COMMA, CHECK FOR END OF LINE
ERROR <Comma or carriage return required>
RETSKP ;TYPIST ENDED LINE WITH NO COMMA
;GET HERE FOR LINE REPARSE, WHICH HAPPENS WHEN PREVIOUSLY
;PARSED FIELDS ARE REQUIRED TO BE REPARSED.
REPARS: MOVE A,.J ;FIX JFN STACK
MOVEM A,.JBUFP ;RESTORE JFN STACK FRAME
CALL FLJFNS ;GET RID OF ANY JFN'S THAT WERE USED FOR COMMAND
CALL DOECHO ;ECHOING MAY HAVE BEEN TURNED OFF FOR PASSWORD
MOVSI 17,CMDACS ;MAKE BLT POINTER CMDACS,,0
BLT 17,17 ;RESTORE AC'S TO HOW THEY WERE WHEN THIS PART OF COMMAND STARTED
JRSTF @REPARA ;RETURN TO BEGINNING OF COMMAND LINE
;EOF WHILE READING COMMAND FILE
CCHEOF: CALL CIOREL
JFCL
ETYPE < End of %1S
>
CLOSF ;CLOSE INPUT SIDE
CALL JERR ;SHOULDN'T FAIL
SETZM ECHOF ;TURN OFF "PER-TAKE-COMMAND" ECHOING
JRST CMDIN4 ;GO BACK FOR NEXT COMMAND
;ROUTINE TO POP BACK TO LAST EXEC INPUT STREAM. RETURNS WITH JFN
;OF OLD INPUT IN AC1.
;IT SKIP RETURNS IFF THERE WAS NOTHING TO DELETE (I.E. ONLY ONE
;SET OF JFNS ON THE COMAND STREAM STACK
;IT CLOSES THE OUTPUT SIDE, AND LEAVES RIJFN HOLDING THE INPUT
;SIDE BUT INPUT ISN'T CLOSED YET, SO THAT ERROR MESSAGES ETC. MAY
;DO JFNS ON INPUT JFN BEFORE CLOSING IT.
CIOREL:: STKVAR <OLDJFS>
MOVE A,IOPT ;GET POINTER TO STREAM STACK
POP A,OLDJFS ;GET OLD JFNS
CAMN A,IOPTB ;ONLY ONE SET ON STACK?
RETSKP ;YES, SKIP RETURN BUT OTHERWISE DO NOTHING
MOVE C,(A) ;GET "NEW" ONES
MOVEM A,IOPT ;STORE UPDATED POINTER
HRRZM C,COJFN
HLRZM C,CIJFN ;RESTORE OLD VALUE OF IO CELLS
CALL SETIOF ;SET IO FLAGS
HRRZ A,OLDJFS
CAME A,COJFN ;Don't close output if same!
CLOSF ;CLOSE OUTPUT BUT NOT INPUT YET
ERCAL JERR
HLRZ A,OLDJFS ;RETURN INPUT JFN IN A
RET
;ROUTINE TO SET UP IO FLAGS. THIS ROUTINE SHOULD BE CALLED WHENEVER
;COJFN OR CIJFN ARE CHANGED REQUIRING AN UPDATE OF FLAGS
SETIOF:: HRRZ A,CIJFN ;FIND OUT WHERE WE'RE READING FROM
DVCHR
LDB B,[221100,,B] ;GET DEVICE TYPE OF INPUT DEVICE
SETOM TINPF ;FIRST ASSUME INPUTTING FROM TERMINAL
CAIE B,.DVTTY ;GOOD GUESS?
SETZM TINPF ;NO, LOUSY ONE.
RET
;ROUTINE TO GET RID OF ALL COMMAND JFNS. THIS HAPPENS, FOR INSTANCE,
;IF USER TYPES ^C DURING "TAKE" COMMAND PROCESSING
;SKIPS IFF THERE ARE NONE TO GET RID OF
CLRIO: CALL CIOREL ;CLOSE STREAM
CAIA ;THERE WAS AT LEAST ONE TO CLOSE
RETSKP ;NONE TO CLOSE, TAKE SKIP
PUSH P,A ;SAVE JFN IN CASE LAST ONE
CLR1: CALL CIOREL ;CLOSE NEXT ONE
JRST CLR2 ;NEXT ONE WASN'T LAST
POP P,A ;IT WAS THE LAST ONE, SO RETURN IT
RET
CLR2: EXCH A,(P) ;GET THE ONE THAT WASN'T LAST
CLOSF ;CLOSE THE INPUT SIDE
CALL JERR ;SHOULDN'T FAIL
JRST CLR1 ;LOOP BACK TO CLOSE THE REST
;UUO DISPATCH TABLE
CUUOT: EXP %ERR,%ETYPE,%KEYW
EXP %NOI,%$TYPE,%LERRO
EXP 0,%$ERR,%ETYPE,%GTB
EXP %PRINT,%TRAP,%.$ERR
EXP %SBCOM
%%U==.-CUUOT
DEFINE XX(UUL)
<
%%X==.
RELOC CUUOT+<U'UUL>_-^D23-20 ;;BITS 0-8 CAN'T BE 0
UUL'$
IFG .-CUUOT-%%U,<%%U==.-CUUOT>
RELOC %%X
>
ULIST
RELOC CUUOT+%%U ;LEAVE ROOM FOR ALL UUO ENTRIES
;UUO DISPATCHER
CUUO:: MOVEM A,CTUUO
HLRZ A,40
LSH A,-5
HRRZ A,CUUOT-20(A)
EXCH A,CTUUO
JRST @CTUUO
;ROUTINE INVOKED BY "$TYPE <FOO>" MACRO. IT STARTS A NEW LINE
;PART OF THE COMMAND, WITH THE PROMPT BEING "FOO".
%$TYPE: MOVEM A,CMDACS ;WE DON'T WANT TO CLOBBER ANYTHING
MOVEI A,@40 ;GET ADDRESS OF PROMPT STRING
HRLI A,440700 ;MAKE BYTE POINTER
CALLRET READ1 ;TYPE PROMPT AND RETURN TO PROGRAM
;SEE ALSO "%ETYPE" IN S3.MAC
;ROUTINES FOR INPUTTING FIELDS OF COMMAND. INVOKED BY MACROS.
;THESE ROUTINES ARE NAMED $FOO AND %FOO. ROUTINE $FOO ASSUMES
;THE EFFECTIVE ADDRESS OF THE UUO CONTAINS THE HELP STRING FOR
;THE FIELD. %FOO ASSUMES THAT THE PREVIOUS HELP STRING IS TO
;BE USED.
;DECIMAL NUMBER...
DEC$: CALL GETHLP ;SET UP HELP MESSAGE
MOVEI A,5+5 ;RADIX
NUM13: MOVEM A,CMDAT
MOVX A,CMNUM
CALL $WORK ;INPUT THE NUMBER
RET ;SINGLE RETURN, NON-NUMBER TYPED
RETSKP ;SKIP RETURN, GOOD NUMBER TYPED
;OCTAL NUMBER
OCT$: CALL GETHLP
MOVEI A,8 ;OCTAL RADIX
JRST NUM13 ;JOIN COMMON CODE
;TIME
TIME$: CALL GETHLP
MOVX A,CM%ITM ;TIME ONLY
MOVEM A,CMDAT
MOVX A,CMTAD ;TIME AND DATE FUNCTION
CALLRET $WORK
;DATE AND TIME
;THE POSSIBILE THINGS ARE:
;
;1) SPECIFIC DATE AND TIME (OR JUST TIME, WHICH ASSUMES TODAY)
;
;2) "+" OR "-" FOLLOWED BY AMOUNT OF TIME, WHICH MEANS NOW + - AMOUNT
;
;3) KEYWORD, FOLLOWED BY KEYWORD-DEPENDENT DATA
DA%DAY==1B18 ;BIT TO MEAN DAY OF THE WEEK
;KEYWORD TABLE FOR DATE AND TIME
$DKEYS: TABLE
T FRIDAY,,DA%DAY+4
T MONDAY,,DA%DAY+0 ;TOO BAD THIS HAS TO BE ALPHABETICAL
T SATURDAY,,DA%DAY+5
T SUNDAY,,DA%DAY+6
T THURSDAY,,DA%DAY+3
T TODAY
T TUESDAY,,DA%DAY+1
T WEDNESDAY,,DA%DAY+2
TEND
DTR$: MOVEI A,1 ; SAY WE WANT TIME RELATIVE TO NOW
JRST DT1
DT$: TDZA A,A ; SAY WE WANT TIME IN THE FUTURE
DTP$: MOVNI A,1 ;SAY WE WANT TIME IN THE PAST
DT1: TRVAR <TODAY,SENSE,DAYWEK,NOW,TOMORO,BTIME,<STRNG0,10>>
MOVEM A,SENSE ;REMEMBER WHETHER FUTURE OR PAST
CALL GETHLP
GTAD ;GET CURRENT TIME AND DATE
MOVEM A,NOW
MOVSI B,1
ADD B,A ;GET TOMORROW SAME TIME IN A
HRROI A,STRNG0 ;WRITE TO SCRATCH
MOVX C,OT%NTM ;WE WANT ONLY DATE
ODTIM ;GET STRING FOR TOMORROW'S DATE
HRROI B,[ASCIZ / 0:0:0/]
MOVEI C,0
SOUT ;MAKE DATE AND TIME FOR BEGINNING OF TOMORROW
HRROI A,STRNG0 ;POINT AT FULL STRING
MOVEI B,0 ;NO SPECIAL FORMAT
IDTIM ;GET INTERNAL FORMAT FOR TOMORROW
CALL JERR ;SHOULDN'T FAIL
MOVEM B,TOMORO ;REMEMBER VALUE FOR TOMORROW
SUB B,[1B17] ;CREATE BEGINNING OF TODAY
MOVEM B,TODAY
MOVX A,CM%IDA+CM%ITM
MOVEM A,CMDAT ;FIRST FUNCTION IN CHAIN IS DATE AND TIME
MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<"+" to enter amount of time from now>,,[
FLDDB. .CMKEY,CM%SDH,$DKEYS,<day of the week or TODAY>]]]]]
SKIPGE SENSE ;DIFFERENT CHOICES FOR DATE AND TIME IN PAST
MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /-/]>,<"-" to enter amount of time in past>,,[
FLDDB. .CMKEY,CM%SDH,$DKEYS,<day of the week or TODAY>]]]]]
CALL $WORK
RET ;BAD INPUT TYPED
LDB C,[331100,,(C)] ;GET FUNCTION FLAVOR
CAIN C,.CMKEY ;KEYWORD
JRST DAKEY ;YES, GO HANDLE IT
CAIE C,.CMTOK ;"+"?
RETSKP ;NO, SO REAL DATE AND TIME TYPED
CALL GETAMT ;YES, GET AMOUNT
RET ;SYNTAX ERROR
SKIPGE SENSE
MOVN A,A ;HANDLE "DIRECTORY SINCE -4:0:0"
ADD A,NOW ;ADD TO NOW
MOVE B,A ;RETURN RESULT IN B
RETSKP
;routine to input an amount of time.
;returns:
; +1 syntax error
; +2 A/ internal format
; B/ seconds
GETAMT:: STKVAR <CTIM>
DECX <Amount of time in form hh:mm>
RET ;GIVE UP IF CAN'T READ HOURS
IMULI B,^D3600 ;CHANGE TO SECONDS
MOVEM B,CTIM ;SAVE NUMBER OF SECONDS
COLONX <Colon to separate hours and minutes>
JRST ONENUM ;ONLY ONE NUMBER BEING TYPED
DECX <Minutes>
RET ;ERROR IF NO NUMBER AFTER COLON
IMULI B,^D60 ;CHANGE MINUTES TO SECONDS
ADDM B,CTIM ;ACCUMULATE RESULT
COLONX <Colon, if seconds are being entered>
JRST NOSECS ;NO SECONDS FORTHCOMING (THAT'S O.K.)
DECX <Seconds>
RET ;ERROR IF SECOND COLON AND NO SECONDS
ADD B,CTIM ;GET TOTAL SECONDS
T22: MOVEM B,CTIM ;REMEMBER SECONDS
MUL B,[1B17] ;IN INTERNAL FORMAT, RIGHT HALF OVER 1B17 IS FRACTION OF A DAY
DIV B,[^D86400] ;DIVIDE BY SECONDS IN A DAY
CAILE C,^D86400/2 ;ROUND
AOJ B,
MOVE A,B ;RETURN RESULT IN A
MOVE B,CTIM ;RETURN SECONDS IN B
RETSKP
ONENUM: MOVE B,CTIM ;GET NUMBER OF SECONDS GIVEN HOURS
IDIVI B,^D60 ;TREAT NUMBER AS THOUGH IT WERE ORIGINALLY MINUTES
JRST T22
NOSECS: MOVE B,CTIM ;NO SECONDS FORTHCOMING
JRST T22
;KEYWORD TYPED AFTER /AFTER:
DAKEY: CALL GETKEY ;GET KEYWORD DATA
TXNN P3,DA%DAY ;DAY OF THE WEEK?
JRST (P3) ;NO, DO SPECIFIC THING
ANDI P3,7 ;DAY OF THE WEEK, KEEP ONLY IT
MOVEM P3,DAYWEK ;REMEMBER DAY
MOVE B,TOMORO ;PUT TOMORROW REAL EARLY MORNING IN B
MOVEI D,0 ;NO SPECIAL BITS
ODCNV ;SEE WHAT DAY OF WEEK TOMORROW IS
SKIPN SENSE
JRST [ MOVNI C,-1(C) ;NEGATE DAY OF WEEK AND FLUSH DAY OF MONTH
HRRE C,C ;FOR SUNDAY, GET RID OF 777777 IN LEFT HALF
ADD C,DAYWEK ;GET NUMBER OF DAYS FROM TOMORROW IS DESIRED
CAIGE C,0
ADDI C,7 ;FOR FUTURE, "SUBMIT /AFTER:MONDAY" MEANS NEXT TUESDAY OR LATER
JRST SL]
SUB C,DAYWEK
MOVNI C,(C) ;GET NEGATIVE NUMBER OF DAYS BEFORE TOMORROW WE WANT, AND FLUSH DAY OF MONTH
HRRE C,C ;IN CASE C WAS NEGATIVE BEFORE
SKIPLE SENSE ; RELATIVE TO NOW?
JRST SL ; YES - CHECK LATER
CAIL C,0
SUBI C,7 ;FOR PAST, "DIRECTORY SINCE MONDAY" MEANS FILES WRITTEN LAST MONDAY OR MORE RECENTLY"
SL: ASH C,22 ;SHIFT INTO POSITION FOR INTERNAL FORMAT
ADD C,TOMORO ;GET INTERNAL REPRESENTATION FOR DAY SPECIFIED
MOVEM C,BTIME
JRST DAPLSQ ;MAYBE USER TYPING "+" AFTER THE DAY
;USER HAS TYPED /AFTER:TODAY OR SINCE TODAY
.TODAY: MOVE A,TOMORO ;GET VALUE FOR TOMORROW
SKIPE SENSE
MOVE A,TODAY ;FOR TIME IN PAST, BASE IS BEGINNING OF TODAY
MOVEM A,BTIME ;REMEMBER IT AS BASE VALUE
DAPLSQ: MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<Optional "+" to add amount of time>]
CALL FLDSKP ;IS USER TYPING "+"?
JRST NOPLUS ;NO
CALL GETAMT ;YES, GET AMOUNT OF TIME
RET ;IF ERROR, NON-SKIP
DAA1: ADD A,BTIME
MOVE B,A ;RETURN INTERNAL DATE-AND-TIME IN B
SKIPG SENSE ; RELATIVE TO NOW?
RETSKP ; NO - DONE
CAMG B,NOW ; TIME IN FUTURE?
ADD B,[7B17] ; NO - JUMP AHEAD 1 WK
RETSKP ; RETURN
NOPLUS: MOVEI A,0 ;NO PLUS, SO NO MODIFICATION OF BASE TIME
JRST DAA1
; Date and time or interval in days "+nnn"
DTIV$: CALL GETHLP
MOVX A,CM%IDA+CM%ITM ; First function in chain is d&t
MOVEM A,CMDAT
MOVE A,[CMTAD+[FLDDB. .CMTAD,CM%SDH,CM%IDA,,,[
FLDDB. .CMTAD,CM%SDH,CM%ITM,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /+/]>,<"+" to enter interval in number of days>,,]]]]
CALL $WORK
RET ; Bad input
LDB C,[331100,,(C)] ; Get flavor of function
CAIE C,.CMTOK ; "+"?
RETSKP ; No, a valid date & time was given
DECX <Interval in number of days>
RET ; Invalid
RETSKP ; Return # of days
;QUOTED STRING
QUOTE$: CALL GETHLP
MOVX A,CMQST ;QUOTED STRING FUNCTION CODE
CALLRET $WORK
;USER NAME
USERS$: MOVX A,CM%DWC ;ALLOW WILD CARDING
MOVEM A,CMDAT ;STOR IN DATA FIELD
USER$: CALL GETHLP
MOVX A,CMUSR ;USER NAME FUNCTION
CALLRET $WORK
;DIRECTORY NAME
DIRS$: MOVX A,CM%DWC ;ALLOW WILD CARDING
MOVEM A,CMDAT ;STOR IN DATA FIELD
DIR$: CALL GETHLP
MOVX A,CMDIR
CALLRET $WORK
;STRUCTURE NAME, LIKE DEVICE BUT NEEDN'T EXIST
STR$: CALL GETHLP
MOVX A,CMDEV!CM%PO
JRST $DEV1 ;REST SAME AS DEVICE
;DEVICE
DEV$: CALL GETHLP
MOVX A,CMDEV
$DEV1: CALL $WORK
RET
RETSKP
;FAKE NODE, SYNTAX CORRECT ONLY
FNODE$: CALL GETHLP
MOVX A,CMNOD!CM%PO
JRST $RNOD1 ;REST SAME AS REAL NODE
;REAL NODE, MUST BE KNOWN BY SYSTEM
RNODE$: CALL GETHLP
MOVX A,CMNOD
$RNOD1: CALL $WORK
RET
RETSKP
;FILE SPECIFICATION
FILE$: CALL GETHLP
MOVX A,CMFIL ;SPECIFY FILE FUNCTION
CALLRET $WORK
;READ ENTIRE REST OF LINE
LINE$: CALL GETHLP
MOVX A,CMTXT ;TEXT FUNCTION
CALL $WORK
RET
RETSKP
;CONTROL-E
CTRLE$: HRROI A,[ASCIZ //] ;EXPECTED FIELD
JRST CHAR ;JOIN COMMON CODE
;PARSE A COMMA
COMMA$: CALL GETHLP
MOVX A,CMCMA ;COMMA FUNCTION
CALLRET $WORK
;PARSE A SLASH
SLASH$: HRROI A,[ASCIZ ./.]
JRST CHAR
;PARSE A BACKSLASH
BSLSH$: HRROI A,[ASCIZ .\.]
JRST CHAR
;PARSE A DOT
DOT$: HRROI A,[ASCIZ /./]
JRST CHAR
;PARSE A COLON
COLON$: HRROI A,[ASCIZ /:/]
JRST CHAR
;PARSE CHARACTER PASSED IN AC1
CHAR$: STKVAR <STRNG> ;STORAGE FOR CHARACTER STRING
ROT A,-7 ;MAKE ASCIZ STRING
MOVEM A,STRNG ;PUT IT ON STACK
HRROI A,STRNG ;POINT TO STRING
JRST CHAR ;FINISH UP
;PARSE A FIELD WHICH IS JUST "*"
STAR$: HRROI A,[ASCIZ /*/] ;EXPECTED FIELD
CHAR: MOVEM A,CMDAT
CALL GETHLP
MOVX A,CMTOK
CALL $WORK
RET
RETSKP
;PARSE A HYPHEN
DASH$: HRROI A,[ASCIZ /-/]
JRST CHAR ;USE COMMON CODE
;ACCOUNT
ACCT$: CALL GETHLP ;SET UP HELP TEXT
MOVX A,CMACT ;SPECIFY ACCOUNT FUNCTION
CALLRET $WORK
;word
word$: USTAR @40 ;WORD MIGHT BE "*"
CAIA ;NON-* TYPED
RETSKP ;YUP, WAS.
call gethlp
movx a,cmfld ;arbitrary field function
callret $work
;END OF LINE
CRR$: CALL GETHLP
MOVX A,CMCFM ;"CONFIRM" FUNCTION
CALL $WORK
RET ;NON-END-OF-LINE TYPED
RETSKP
$WORK: MOVEI B,FBLOCK ;GET ADDRES OF FUNCTION BLOCK
WORKB$: TXO A,CM%HPP+CM%DPP+CM%SDH ;USE OUR OWN HELP AND DEFAULTS
SKIPN CMDEF ;ANY DEFAULT STRING SUPPLIED?
TXZ A,CM%DPP ;NO, SO TELL COMND THERE'S NONE
MOVEM A,CMFNP
CALL FLDSKP ;INPUT THE FIELD
RET ;INCORRECT, SINGLE RETURN
RETSKP ;GOOD, SKIP RETURN
GETHLP: SKIPN A,@40 ;GET HELP STRING
RET ;USE SAME AS LAST TIME
HRRO A,40 ;GET POINTER TO HELP STRING
MOVEM A,CMHLP ;SET UP HELP TEXT POINTER
RET
;service "helpx" macro. use arg as default help string for next
;field input.
help$: hrro a,40 ;get pointer to string
movem a,cmhlp ;store help string
ret
;SERVICE ROUTINE FOR DEXTX MACRO, WHICH SETS UP
;JFN BLOCK WITH DEFAULT EXTENSIONS FOR INPUT AND OUTPUT FILESPECS
DEXT$: SETZM CJFNBK ;CLEAR OUT JFN BLOCK
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+JBLEN-1
HRRO A,40 ;GET DEFAULT EXTENSION
SKIPE @40 ;DON'T SET UP POINTER IF NO DEFAULT EXTENSION
MOVEM A,CJFNBK+.GJEXT ;STORE IT
RET
;ROUTINE TO SERVICE "DEFX" MACRO, WHICH SETS THE DEFAULT STRING
;VALUE
DEF$: HRRO A,40 ;GET POINTER TO DEFAULT FIELD VALUE
MOVEM A,CMDEF ;SET UP DEFAULT STRING VALUE
RET
;MULTI FILE INPUT AND OUTPUT ROUTINES
;SCAN OUTPUT FILESPEC FOR MULTI FILE OP
;IF GROUPF NOT SET, DEFAULTS NAME AND EXT TO INPUT JFN
;RETURNS OUTPUT JFN IN OUTDSG
;IF GROUPF SET, DEFAULTS TO *.*;-1 AND RETURNS JFN IN MCOJFN
MFOUT::
MOVE A,[XWD [ASCIZ/*/],[ASCIZ/*/]] ;DEFAULT TO *'S
MOVE B,INIFH1
CAME B,INIFH2 ;IF EXACTLY 1 TERM, MAYBE USE NAMES
JRST MCOPY1
HRRZ B,@INIFH1 ;GET JFN ONLY
CAIN B,FI%ERR ;DID FILE EXIST?
JRST MCOPY1 ;NO--USE *.* AS DEFAULT
MOVE B,@INIFH1 ;GET JFN AND BITS
TXNN B,GJ%NAM ;* FOR NAME?
HRLI A,2 ;NO, USE PREVIOUS NAME
TXNN B,GJ%EXT ;* FOR EXT?
HRRI A,2 ;NO, USE PREVIOUS EXT
MCOPY1: MOVEI B,(GJ%FOU+GJ%IFG+GJ%OFG+GJ%MSG) ;DEFAULT TO -1 VERSION
CALL SPECFN ;COLLECT FILE NAME, GTJFN FLAGS IN RH B.
JRST CERR
MOVEM A,OUTDSG ;DESTINATION JFN
MOVEM A,MCOJFN ;HERE FOR MULTI FILE COPY
MOVE B,A ;PUT FILE HANDLE IN B (WITH WILDCARD BITS)
LDF C,1B2 ;BITS TO GET DEVICE FIELD
TXNE B,GJ%DEV+GJ%UNT ;WILDCARDS USED IN DEVICE FIELD?
CALL BADSTR ;ERROR IF BAD WILDCARD SYNTAX
LDF C,1B5 ;SPECIFY DIRECTORY
TXNE B,GJ%DIR ;STAR IN DIRECTORY FIELD?
CALL BADSTR ;YES, MAKE SURE IT'S LEGAL
LDF C,1B8 ;NAME FIELD
TXNE B,GJ%NAM
CALL BADSTR ;MAKE SURE LEGAL STARS IN NAME FIELD
LDF C,1B11 ;TYPE FIELD (EXTENSION)
TXNE B,GJ%EXT
CALL BADSTR
LDF C,1B14 ;GENERATION NUMBER
TXNE B,GJ%VER
CALL BADSTR ;MAKE SURE LEGAL WILCARDS IN GENERATION FIELD
HLRZ A,JBUFP ;WILL REQUIRE AT LEAST 1 MORE JFN FOR COMMAND
CAIN A,-1
ERROR <Too many JFNs in command>
RET
;FOLLOWING ROUTINE RETURNS IFF STRING RETURNED BY JFNS CONTAINS
;ONLY "*". CALL THIS ROUTINE WITH INDEXABLE FILE HANDLE (FLAGS,,JFN)
;IN B, AND JFNS BITS IN C. AC'S PRESERVED. THE PURPOSE OF THIS ROUTINE
;IS TO CATCH FANCY FILENAMES THAT WON'T CAUSE EXPECTED RESULT.
;FOR INSTANCE "RENAME *.* (TO BE) X*.*" DOESN'T REALLY PUT "X" IN FRONT
;OF EVERY NAME, SO THIS ROUTINE MAKES SURE YOU'RE NOT TRYING TO DO
;THAT TYPE OF THING.
BADSTR: SAVEAC <A,B,C>
STKVAR <<JFNSP,EXTSIZ>>
HRROI A,JFNSP
JFNS ;GET FIELD
HRROI A,JFNSP ;POINT AT FIELD WE JUST WROTE
HRROI B,[ASCIZ /*/]
STCMP ;MAKE SURE ONLY "*" AND NOT "F*" ETC.
JUMPN A,[ERROR <Invalid use of wildcard characters>]
RET ;RETURN SUCCESFULLY
;GET OUTPUT NAME FOR MULTI FILE OPERATION
;GETS JFN INTO OUTDSG, ASSUMES SCANNED
;OUTPUT NAME JFN IN MCOJFN. SKIPS ON SUCCESSFUL GTJFN AFTER
;PRINTING FILESPEC.
;DIRECT RETURN ON GTJFN ERROR, NAME AND MESSAGE ALREADY PRINTED
MFSET:: TRVAR <MFPP,<MFBUF,FILWDS>>
SKIPN MCOJFN ;MULTI FILE OUTPUT?
RETSKP ;NO, JFN ALREADY IN OUTDSG
SETZM MFBUF ;SO WE CAN CHECK FOR NULL STRING
HRROI A,MFBUF
MOVEM A,MFPP ;INITIALIZE BYTE POINTER TO BUFFER
MOVSI A,(GJ%DEV) ;FLAG BIT TO TEST
MOVE C,[1B2+1B35] ;GET DEVICE
CALL MCOSTR ;GET STRING
MOVSI A,(GJ%DIR)
MOVE C,[1B5+1B35] ;GET DIRECTORY
CALL MCOSTR
MOVSI A,(GJ%NAM)
MOVE C,[1B8+1B35] ;NAME
CALL MCOSTR
SKIPN MFBUF ;NULL FILESPEC?
JRST MFSET1 ;YES
MOVSI A,(GJ%EXT)
MOVE C,[1B11+1B35] ;EXT
move d,mfpp ;save the current string pointer
CALL MCOSTR
movei a,"." ;for null extensions
camn d,mfpp ;see if we got something
idpb a,mfpp ;nothing changed, force a null extension
MOVSI A,(GJ%VER)
MOVE C,[1B14+1B35] ;VERSION
CALL MCOSTR
MOVE C,[2B17+1B35] ;PROTECTION
CALL MCOSTO ;GET PROTECTION FROM OUTPUT
MOVE C,[2B20+1B35] ;ACCOUNT
CALL MCOSTO
MOVE C,[1B21+1B35] ;";T"
CALL MCOSTO
MOVE C,[JS%ATR!JS%PAF] ;GET ATTRIBUTES
CALL MCOSTO
MFSET1: SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, ONLY IF GROUP
UTYPE [ASCIZ/ => /]
HRROI B,MFBUF
MOVSI A,(GJ%FOU!GJ%SHT!GJ%DEL!GJ%FLG!GJ%PHY) ;OUTPUT, SHORT CALL, DELETED OK, PHYSICAL ONLY
CALL GTJFS ;DO GTJFN, STACK IN CASE ^C
JRST [ HRROI B,MFBUF ;GET POINTER TO BEGINNING OF STRING
LERROR <Destination GTJFN failure on %2M%%_% %1?>
RET]
HRRZM A,OUTDSG
MOVE B,A ;GET FULL JFN INTO B
TXZ B,GJ%UHV!GJ%NHV!GJ%ULV ;MAKE VERSION NUMBER COME OUT RIGHT
MOVE A,COJFN ;OUTPUT NAME TO HERE
MOVE C,[2B2+2B5+2B8+2B11+2B14+2B17+2B20+1B21+JS%ATR+1B35]
SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, ONLY IF GROUP
JFNS
HRRZ A,OUTDSG
DVCHR ;GET DEVICE CHARACTERISTICS OF OUTPUT FILE
LDB A,[POINT 9,B,17] ;DEVICE TYPE
CAIE A,.DVDSK ;IF DISK, SPECIAL CHECK
RETSKP ;ELSE INDICATE SUCCESS
HRRZ A,OUTDSG
MOVE B,[1,,.FBCTL] ;GET FLAG WORD
MOVEI C,A ;INTO A
CALL $GTFDB
SETZ A, ;MAKE SURE FB%NXF OFF IF ACCESS PREVENTED
TXNN A,FB%NXF ;NEW FILE?
TYPE < [Superseding]> ;NO, INFORM USER
RETSKP
MCOSTR: TDNN A,MCOJFN ;OUTPUT * HERE?
MCOSTO: SKIPA B,MCOJFN ;NO, USE OUTPUT FIELD
HRRZ B,@INIFH1 ;YES, USE INPUT FIELD
MOVE A,MFPP ;GET STRING SPACE POINTER
JFNS ;GET STRING
MOVEM A,MFPP ;STORE STRING SPACE POINTER
RET
;CALL TO COPY JFN POINTED TO BY INIFH1 TO SECOND JFN
;THEN ADVANCE INIFH1 PAST THAT FILE. USED BY DELETE AND
;RENAME BECAUSE GNJFN DOES NOT WORK AFTER RENAME AND SOME DELETES.
MFINP:: CALL MFINP0 ;GET JFN AND FLAGS
RET ;FAILED
HRRZ A,A ;GET RID OF FLAGS
RETSKP
;MFINP0 IS LIKE MFINP BUT RETURNS GNJFN FLAGS IN LEFT HALF OF A
MFINP0:: STKVAR <MFJFN,<MFIBUF,FILWDS>>
HRROI A,MFIBUF
HRRZ B,@INIFH1 ;JFN
MOVE C,[1B2+1B5+1B8+1B11+1B14+JS%ATR+1B35] ;DEVICE:<DIR>NAME.EXT;GEN
JFNS
CALL GNFIL ;ADVANCE FIRST JFN BEFORE DELETE OR WE GET LOST
SETZM INIFH1 ;CLEAR THIS TO INDICATE NO MORE JFNS
MOVEM A,MFJFN ;REMEMBER FLAGS
MOVEI A,[GJ%OLD+GJ%NS+GJ%PHY+GJ%DEL+GJ%XTN
.NULIO,,.NULIO ; No I/O
0 ; DSK:
0 ; <Dir>
0 ; file.
0 ; Ext
0 ; ;p
0 ; ;a
0 ; JFN
G1%IIN] ; Allow invisible files
HRROI B,MFIBUF ;GET FILE FROM OTHER JFN
CALL GTJFS ;DO GTJFN, STACK IT
JRST [ HRROI B,MFIBUF ;GET POINTER TO FILESPEC
LERROR <Source GTJFN failure on %2M%%_% %1?>
RET]
HLL A,MFJFN ;RETURN GNJFN'S FLAGS
RETSKP ;RETURN WITH JFN IN A
;COLLECT FILE NAMES:
;COUTFN & SPECFN & CPFN & .INFG & INFG & DIRARG & SO ON.
;VARIOUS ENTRIES FOR INPUT, OUTPUT, SPECIAL CASE, & GROUP DESCRIPTORS.
;CAN INPUT LIST OF NAMES separateD BY COMMAS AS WELL AS *.MAC FORMS.
;TAKE: A: RH: 0, 2, OR DEFAULT EXTENSION POINTER
; 2 => USE EXT OF LAST FILE NAME INPUT AS DEFAULT EXT
; LH: 0, -1, -2, 1, 2, OR DEFAULT NAME POINTER
; 0 => RETURN +1 IF NULL, PRINTING "-" ON ALT MODE
; 1 => LIKE 0 BUT ALSO RETURN +1 IF "*" INPUT
; 2 => LIKE 0 BUT USE LAST NAME INPUT AS DEFAULT NAME
; -1=> GIVE INPUT TO GTJFN EVEN IF NULL OR *
; -2 LIKE -1 BUT GIVE R1 IF NO SUCH FILE
; ALSO ENTRY "SPECFN" TAKES IN B: LH: DEFAULT VERSION (USUALLY 0)
; RH: FLAGS FOR GTJFN PLUS:
; B15: ALLOW GROUP OF NAMES, ALL BUT LAST TERMINATED WITH ",".
; DOES NOT HANDLE ALTMODE-COMMA (USE ^F FOR RECOGNITION),
; MAY THUS BE USED WHERE A NOISE WORD, ETC FOLLOWS (COPY)
; B16: ALLOW GROUP OF NAMES separateD BY SPACE, ALTMODE, OR
; SPACE-COMMA OR ALTMODE-COMMA. IF LAST COMMA IS FOLLOWED
; BY ALTMODE OR EOL, GIVE R1 (TO INDICATE SUBCOMMAND
; INPUT REQUIRED).
; B15 SHOULD ALSO BE ON.
; ONLY USEABLE IF LIST IS LAST THING IN COMMAND; CAN
; PRE-READ FOLLOWING FIELD
;CF%NS B17: NO SUBCOMMANDS FOLLOW THE LIST.
;
; B14: IF NO SUCH DEVICE, NO SUCH DIRECTORY,...,
; NO SUCH GENERATION... RETURN PTR,,FI%ERR IN PLACE OF JFN
; PTR POINTS TO <CHAR COUNT>,,<ERROR #> FOLLOWED BY
; BYTE POINTER TO TYPESCRIPT.
;
;
; ALSO, F3 IN Z SAYS TO DEFAULT DIRECTORIES TO CONNECT AND LOGIN
; AFTER INITIAL TRY FAILS -- FOR DEFAULT RUN
; IGINV in Z says to allow invisible files (G1%IIN)
;COLLECT FILE NAMES COMMENTS...
;RETURN: +1: NULL INPUT AND 0 OR 1 IN LH OF A, OR "-" INPUT,
; OR "*" INPUT AND 1 IN LH OF A (INDICATED BY "*" IN A),
; OR P2=EOL AT ENTRY (IN WHICH CASE NO INPUT),
; OR -2 IN LH OF A AND NO SUCH FILE,
; OR B16 ON AND LIST ENDED WITH COMMA.
; THE FIRST 3 OF THESE RETURN +1 OPTIONS SHOULDN'T
; BE USED IF B15 OR B16 ON.
; +2: SUCCESS, JFN IN A AND ALSO STACKED IN BUFFER "JBUF"
; (POINTER JBUFP). 1ST LOCATION IN THIS BUFFER
; (FIRST JFN IN COMMAND) CAN BE ADDRESSED AS CJFN1,...
; IF AN INPUT GROUP DESCRIPTOR COULD HAVE BEEN INPUT
; (B11,15,16 ON), SETS INIFH1 &2 TO 1ST & LAST USED
; LOCS IN JBUF, RETURNS FIRST JFN IN A, AND SETS "GROUPF"
; IF A GROUP WAS SPECIFIED (* OR MORE THAN 1 NAME INPUT).
; EITHER: TERMINATOR IN "P2"
;ASSUME NULL INPUT IF LAST TERMINATOR=EOL AND BAKFF OFF,
; AS %KEYW DOES. SEE %KEYW'S GLITCH NOTE (S1.MAC).
;FLAGS IN AC D
;RH: FROM CALLER
;LH:
; B1: B16 ON, ALREADY AT LEAST ONE ARG, NOT FOLLOWED BY COMMA
; B2: DITTO, DITTO, FOLLOWED BY COMMA
;COLLECT FILE NAMES... ENTRIES.
CSAVFN: MOVEI B,<GJ%FOU!GJ%MSG>B53 ;GTJFN FLAGS FOR OUTPUT FILE NAME
JRST SPECFN
;OUTPUT FILE NAME ENTRY (OLD OR NEW NAME).
;PRINTS WHETHER OLD OR NEW, NO CONFIRMATION.
COUTFN: MOVEI B,(GJ%FOU!GJ%MSG) ;GTJFN FLAGS FOR OUTPUT FILE NAME
JRST SPECFN
;THE NEXT FOUR ENTRIES INPUT AN INPUT FILE GROUP.
;ALL PERMIT *'S AND ADDITIONAL NAME AFTER ONE TERMINATED BY COMMA.
;NO SPECIAL RETURN FOR "*" OR NULL INPUT.
;THESE EXEMPLIFY USE OF GROUP FEATURES, OTHERS POSS USING "SPECFN".
;COLLECT FILE NAMES... GROUP ENTRIES
;.INFG
;ACCEPTS COMMAS ONLY IF THEY TERMINATE FILE NAME -
; THUS ^F MUST BE USED FOR RECOGNITION IF COMMA IS TO FOLLOW.
;SUITABLE FOR USE WHERE ADDITIONAL FIELDS OF COMMAND FOLLOW,
; AS IN 1ST ARG TO "COPY".
;NAME AND EXT DEFAULT TO LAST INPUT (THUS NONE FOR 1ST IN GROUP),
; VERSION TO HIGHEST.
;ONE RETURN ONLY.
;.INFG, BUT WITH NO SEARCH (FOR ACCOUNT, VERSION-RET..., PROTECTION)
INFGNS:: MOVE B,[XWD -3,<GJ%OLD!GJ%IFG!GJ%NS!1B14!1B15>B53] ;* VERSION FOR RENAME
JRST .INFG1
.INFG: MOVEI B,(GJ%OLD!GJ%IFG!1B15)
.INFG1: MOVE A,[XWD 2,2]
CALL SPECFN
JRST CERR
RET
;$INFGX
;SIMILAR TO ABOVE EXCEPT RETURNS +1 IF LIST ENDED WITH COMMA NOT
;FOLLOWED BY ANOTHER NAME (TO INDICATE SUCCOMMAND INPUT).
$INFGX: MOVEI B,(GJ%OLD!GJ%IFG!1B14!1B15!1B16)
MOVE A,[XWD 2,2]
JRST SPECFN
;FLAVOR THAT READS LIST OF FILESPECS, AS IN "TYPE" COMMAND, OR
;"SET FILE INVISIBLE". NOTE THAT THIS IS THE WRONG ROUTINE FOR
;THINGS LIKE "SET FILE PROTECTION" WHICH TAKE ANOTHER ARG (THE PROTECTION)
;AFTER THE LIST
TYPFLS:: DMOVE A,[EXP 0,<(GJ%OLD!GJ%IFG!1B15!1B16!1B17)>] ;NO SPECIAL, OLD FILE, STARS ALLOWED, LIST O.K., LIST IS LAST ON LINE, NO SUBCOMMANDS
CALL SPECFN ;GATHER SPECS TO TYPE
JFCL ;NO SUBCOMMANDS
RET
;DIRARG
;FANCIEST INPUT GROUP, LIKE ABOVE EXCEPT:
; DEFAULTS NAME, EXT, VERSION TO "*". ALLOWS DELETED FILE NAMES (UG!).
; IF PRECEDING FIELD ENDED WITH COMMA OR EOL, OR IF A NULL ARG IS
; SEEN, SUPPLIES DEFAULT ARG "*.*;*" BUT HIDES THIS FROM USER.
; ACCEPTS * FOR NAME IN EMPTY DIRECTORY
; SETS NO SEARCH FOR GTJFN
DIRARG: MOVE A,[XWD [ASCIZ /*/],[ASCIZ /*/]]
HRLI B,-3 ;DEFAULT VERSION: *
HRRI B,(GJ%OLD!GJ%DEL!GJ%IFG!1B14!1B15!1B16)
JRST SPECFN
;COLLECT FILE NAMES ENTRIES...
;ENTRY FOR GTJFN FLAGS IN RH OF B, DEFAULT VERSION (NORMALLY 0) IN LH.
; USED IN SPECIAL CASES, EG:
; DELETED FILE NAME FOR "UNDELETE"
; ANYWHERE *'S ARE ALLOWED, AS IN "DIRECTORY".
;END OF ENTRIES. CASES MERGE HERE.
SPECFN: SETZM CJFNBK+2 ;NO DEFAULT DEVICE
SETZM CJFNBK+3 ;AND NO DEFAULT DIRECTORY
CFN1A: TRVAR <SAVFGS,CEX,SEXJFN,CFNMOD,CFLAGS>
MOVEM A,CFNMOD ;SAVE MODE BITS
HRRZ D,B ;SAVE GTJFN AND LOCAL FLAGS IN RH D
MOVEM D,CFLAGS ;SAVE FLAGS
TRZ B,(1B14!1B15!1B16) ;DON'T GIVE LOCAL FLAGS TO GTJFN
TRNN D,(GJ%OFG) ;IF OUTPUT GROUP THEN NOT INPUT
TRNN D,(GJ%IFG!1B15!1B16) ;IF AN INPUT GROUP IS BEING REQUESTED,
SKIPA
SETZM INIFH1 ;SAY NO NAMES HAVE BEEN INPUT YET.
;COLLECT FILE NAMES...
;SET UP GTJFN PARAMETER BLOCK
MOVSM B,SAVFGS ;FLAGS AND DEFAULT VERSION
SETZ B, ; Set up .GJF2 word
TXNE Z,IGINV ; Allow invisible?
TXO B,G1%IIN ; Yes
MOVEM B,CJFNBK+.GJF2 ; Store in GTJFN block
;COME BACK HERE TO GET ANOTHER FILE NAME IN GROUP
CFN2: MOVE A,SAVFGS ;GET SAVED FLAGS
MOVEM A,CJFNBK+.GJGEN ;SET UP FOR GTJFN (ERROR HANDLING MAY HAVE CLOBBERED THEM)
MOVE A,CFNMOD ;RESTORE MODES
MOVE B,JBUFP
MOVEM B,.JBUFP
; FORM "DEFAULT STRING POINTER" TO EXTENSION
HRRZ B,A
MOVX C,FLD(.JSAOF,JS%TYP) ;ARGUMENT FOR LFJFNS: EXT ONLY, NO PUNCT
CAIN B,2 ;2 SAYS USE EXT OF LAST FILE NAME INPUT
CALL LFJFNS ;GET A STRING FOR LAST FILE'S EXT
SKIPE B
HRLI B,<POINT 7,0,-1>B53
MOVEM B,CJFNBK+5
; FORM "DEFAULT STRING POINTER" TO DEFAULT NAME
HLRZ B,A
MOVX C,FLD(.JSAOF,JS%NAM) ;ARGUMENT FOR LJFNS: NAME ONLY, NO PUNCT.
CAIN B,2 ;2 SAYS USE NAME OF LAST FILE NAME INPUT
CALL LFJFNS ;GET A STRING FOR LAST FILE'S NAME
CAIE B,-2
CAIN B,-1
SETZ B,
SKIPE B
HRLI B,<POINT 7,0,-1>B53
MOVEM B,CJFNBK+4
HLRZ B,JBUFP ;CHECK SPACE IN JFN BUFFER
CAIN B,-1
ERROR <Too many JFNs in command>
FILEX <FILE NAME> ;TRY TO READ FILE NAME
JRST CFNE ;COULDN'T
MOVE A,B ;PUT JFN INTO A
;COLLECT FILE NAMES...
;CODE FOR THE VARIOUS GROUP CASES
CFN4Z: MOVE D,CFLAGS ;GET FLAGS (SUBROUTINES MAY CLOBBER D!)
TRNN D,(GJ%OFG)
TRNN D,(GJ%IFG!1B15!1B16)
RETSKP ;NO SUCH OPTIONS ON
HRRZ B,JBUFP
SKIPN INIFH1 ;FIRST JFN IN GROUP?
MOVEM B,INIFH1 ;YES, SAVE JBUF POINTER
TLNE A,<77B5>B53 ;ANY *'S INPUT OR DEFAULTED TO?
TLO Z,GROUPF ;YES, SAY GROUP WAS SPECIFIED.
TRNN D,(1B15) ;INPUTTING GROUPS OF FILES?
JRST CFN7Z ;NO
TRNE D,(1B16) ;INPUTTING UNTIL END OF LINE?
JRST B16ON ;YES
MOVE A,CMFLG ;NOT INPUTTING TO END OF LINE, GET FLAGS
TXNE A,CM%ESC ;DID USER END FILE NAME WITH $ ?
JRST CFN7Z ;YES, SO WE'RE DONE
;Note here that ESCAPE is being used for
;two purposes, both to complete the filespec
;automatically, and to declare that you want
;the guide words for the next field of the
;command. This is sort of a loser. What if
;you want one and not the other???
COMMAX <Comma to specify another filespec, or next field of command>
;REGULAR GROUP, SO WE NEED COMMA TO READ ANOTHER NAME
JRST CFN7Z ;GROUP BUT NO COMMA AFTER FILE NAME, SO WE'RE DONE
CFN22: TLO Z,GROUPF ;NOTE THAT GROUP HAS BEEN INPUT
JRST CFN2 ;GET NEXT FILE AFTER THE COMMA
B16ON: HELPX <Carriage return to end command
or comma and another filespec
or comma and carriage return to enter subcommands>
TRNE D,(CF%NS) ;DON'T ADVERTISE SUBCOMMANDS IF CALLER HAS NONE
HELPX <Carriage return to end command
or comma and another filespec>
CRRX ;INPUTTING UNTIL END OF LINE, HAVE WE REACHED IT YET?
CAIA ;NOT YET
JRST CFN7Z ;YES
COMMAX ;COMMA AFTER FILE NAME?
ERROR <Comma missing between filespecs or illegal character in command>
TRNE D,(CF%NS) ;NO SUBCOMMANDS?
JRST CFN22 ;RIGHT, SO COMMA MEANS ANOTHER FILE COMING
CRRX <Carriage return to enter subcommands
or another filespec> ;SUBCOMMANDS, SO WE WANT R1
JRST CFN22 ;COMMA NOT FOLLOWED BY CR, MUST BE ANOTHER FILE SPEC
CALL CFNFIX ;GET RETURN DATA
RET ;NONSKIP
CFN7Z: CALL CFNFIX
RETSKP
CFNFIX: HRRZ B,JBUFP
MOVEM B,INIFH2 ;RETURN JBUFP VALUE FOR LAST NAME IN GROUP
MOVE A,@INIFH1 ;RETURN FIRST, NOT LAST, JFN IN A
RET
;GTJFN ERRORS
;FIRST TEST ERROR CODE FOR EXCEPTIONS.
CFNE: CALL GETERR ;GET REASON THE GTJFN FAILED
CAIN A,GJFX3
ERROR <No JFNs available: You must close some files first>
CAIN A,GJFX22
ERROR <JSB full: Try closing some files then repeating command>
CAIN A,GJFX23
ERROR <Directory full: Can't create new files until you
"DELETE" some files and "EXPUNGE (DIRECTORY)">
TRNN D,(1B14) ;NO SUCH FILE OK?
JRST CFNE2 ;NO, NO CHECK
CAIL A,GJFX16
CAILE A,GJFX21
CAIN A,GJFX24
JRST CFNE1
CAIE A,GJFX36
CAIN A,GJFX32
JRST CFNE1
CAIN A,GJFX35 ;DIR ACCESS DENIED
JRST CFNE1 ;YES - DEFER
CFNE2:
MOVEM A,ERCOD ;SAVE ERROR CODE
HLRZ A,CFNMOD ;MOST GTJFN ERRORS RETURN +1 IF CALLER GAVE
CAIN A,-2 ;... -2 IN LH OF A.
JRST [ MOVE A,CFNMOD ; CPFN. 4/30/70)
RET] ;RETURN +1.
MOVE A,ERCOD ;NOT SPECIAL ERROR CODE, DO GENERAL
JRST CJERR ;ERROR HANDLING
;IF FLAG B14 ON GIVE GOOD RETURN WITH PTR,,FI%ERR INSTEAD
;OF JFN WHEN GJFX32 ERROR OCCURS.
;USED FOR "DIRECTORY" (DIRARG).
CFNE1: MOVEM A,CEX ;SAVE ERROR CODE
MOVE A,CMFLG ;GET FLAGS
TXNE A,CM%ESC ;MAKE SURE NO RECOGNITION WAS ATTEMPTED
CMERRX ;LET MONITOR SAY WHAT'S WRONG WITH FILESPEC
DEXTX <> ;CLEAR GTJFN BLOCK
MOVX A,GJ%OFG ;WE WANT SPEC, DON'T CARE IF EXISTS ANYMORE
IORM A,CJFNBK+.GJGEN
FILEX <> ;TRY TO READ THE FILESPEC
CMERRX ;SPEC NOT EVEN SYNTACTICALLY CORRECT
MOVEM B,SEXJFN ;REMEMBER JFN AND FLAGS
HRROI A,ATMBUF ;LOOK AT FILESPEC
CALL BCOUNT ;SEE HOW MANY WORDS IT IS
ADDI A,.FILEN ;LEAVE ROOM FOR OTHER INFO BEFORE STRING
CALL GTBUFX ;GET BUFFER FOR BLOCK (NOT GETBUF, SINCE UNMAP
;MIGHT BE CALLED BEFORE RLJFNS!)
EXCH A,CEX ;STORE ADDRESS IN CEX, GET ERROR CODE IN A
MOVE B,CEX ;GET ADDRESS OF BLOCK
MOVEM A,.FIERR(B) ;STORE ERROR CODE IN FIRST WORD OF BLOCK
MOVE A,SEXJFN ;GET JFN AND FLAGS IN CASE CALLER WANTS IT
MOVEM A,.FIJFN(B) ;REMEMBER IT IN CASE CALLER NEEDS IT
HRROI A,ATMBUF ;POINT TO FILESPEC
CALL XBUFFS ;REMEMBER (XBUFFS SINCE UNMAP MIGHT BE CALLED BEFORE RLJFNS)
MOVE B,A ;POINTER TO FILESPEC IN B
HRROI A,@CEX ;POINT AT BLOCK
ADDI A,.FISTR ;GET PAST NON-STRING DATA IN BLOCK
MOVEI C,0 ;END ON NULL
SOUT ;PUT FILESPEC STRING AFTER ERROR CODE
HRL A,CEX ;ADDRESS IN LEFT HALF
HRRI A,FI%ERR ;SPECIAL CODE
MOVE B,JBUFP ;SEE WHERE ON STACK THIS ENTRY SHOULD BE PUT
MOVEM A,(B) ;REPLACE PARSE-ONLY JFN WITH ERROR ENTRY
JRST CFN4Z ;FINISH PROCESSING
;NXFILE
;CHECK FOR FLAG IN PLACE OF JFN (FI%ERR)
;IF ON, PRINT ERROR MESSAGE AND TYPESCRIPT
NXFILE::ATSAVE
HRRZ A,@INIFH1
CAIE A,FI%ERR ;SPECIAL CASE?
RETSKP ;NO
CALL %MESS
HLRZ D,@INIFH1 ;GET POINTER TO STRING
HRRZ A,.FIERR(D) ;GET GTJFN ERROR CODE
CALL $ERSTR ;PRINT ERROR
TYPE < - >
UTYPE .FISTR(D) ;PRINT TYPESCRIPT
ETYPE<%_>
AOS A,INIFH1 ;SKIP OVER THIS TERM
CAMLE A,INIFH2 ;PAST END?
SETZM INIFH1 ;YES, FLAG SUCH
RET
$ERSTR:: ETYPE <%1?> ;TYPE MESSAGE FOR CODE IN A
RET
;LFJFNS: SUBROUTINE FOR CINFN, COUTFN, SPECFN.
;DO A JFNS FOR MUST RECENT PREVIOUSLY INPUT FILE NAME, USING
; JFNS FORMAT SPECIFICATION IN C.
;RETURNS IN B: POINTER TO LEFT-ADJUSTED STRING
;IF LAST JFN NOT ON A DIRECTORY DEVICE, OR NO PREVIOUS JFN FOR THIS
; COMMAND, RETURNS 0 IN B.
LFJFNS: SAVEAC <A>
STKVAR <<LFBUF,FILWDS>>
SETZM LFBUF ;SO WE'LL KNOW IF SOMETHING'S WRITTEN
HRRZ B,JBUFP ;JFN STACK POINTER
CAIN B,JBUF-1 ;HAS A NAME BEEN INPUT YET?
JRST LFJF9 ;NO, GO RETURN 0 POINTER
HRRZ A,(B) ;PICK UP JFN OF LAST NAME INPUT
CAIE A,-2
CAIN A,-1
JRST LFJF9 ;-1, -2 ISN'T A JFN BUT MIGHT GET HERE
HRROI A,LFBUF
MOVE B,JBUFP
MOVE B,(B) ;PICK UP JFN AGAIN
JFNS ;DO THE JFN TO STRING CONVERSION
SKIPN LFBUF
JRST LFJF9 ;NULL STRING
SETZ B,
IDPB B,A ;APPEND NULL TO STRING
HRROI A,LFBUF ;POINT TO STRING
CALL BUFFS ;RETURN POINTER TO STRING
MOVE B,A ;RETURN POINTER IN B
RET
LFJF9: SETZ B, ;RETURN 0 IF CAN'T RETURN A STRING
RET
;CPFN: COLLECT PROGRAM FILE NAME
;TAKES: A: 0 OR WORD POINTER TO DEFAULT DEVICE NAME.
;NO DEFAULT NAME, DEFAULT EXTENSION ALWAYS ".SAV".
;RETURNS +1 ON GTJFN FAILURE.
CPFN: MOVEI B,100000
CPFNA: JUMPE A,.+2
HRLI A,<POINT 7,0,-1>B53 ;IF NON-0, FILL OUT BYTE PTR
MOVEM A,CJFNBK+2 ;DEFAULT DEVICE
HRRI A,[GETSAVE()] ;DEFAULT EXT
HRLI A,-2 ;SAY RETURN +1 ON GTJFN FAILURE
JRST CFN1A ;JOIN CINFN & COUTFN
;TYPIF: TYPE NAME OF CURRENT FILE IN INPUT FILE GROUP
; BUT NOT IF NOT A GROUP (IE ONLY ONE NAME AND NO *'S INPUT)
;RETURNS JFN IN A
TYPIF: HRRZ A,@INIFH1 ;GET CURRENT JFN
SKIPN TYPGRP ;FORCED PRINT?
TLNE Z,GROUPF ;NO, SKIP IF NON-GROUP
ETYPE < %1S> ;%S: TYPE NAME FOR JFN
RET
;TYPOK: TYPES [OK] CORRESPONDING TO TYPIF ABOVE
;SHOULD BE CALLED ONCE FOR EACH CALL ON TYPIF, BUT
;ONLY AFTER SUCCESFULL COMPLETION OF FILE
TYPOK: SKIPN TYPGRP
TLNE Z,GROUPF
TYPE < [OK]
>
RET
;GNFIL
;GET NEXT INPUT FILE OF GROUP WHICH MAY CONTAIN *'S OR MULTIPLE NAMES.
;R1 IF NO MORE FILES. R2 WITH NEXT JFN IN A WITH FLAGS FROM GNJFN.
;CLOSES PREVIOUS FILE IF OPEN. DOESN'T RELEASE JFN (RLFJNS DOES THIS).
GNFIL: PUSH P,A
PUSH P,B
HRRZ A,@INIFH1
GTSTS
JUMPGE B,GNFIL3 ;JUMP IF NOT OPEN
TXO A,CO%NRJ ;SAY DON'T RELEASE JFN
CLOSF
CALL JERR
GNFIL3: MOVE A,@INIFH1
TLNN A,<77B5>B53 ;NO *-FLAGS, SKIP GNJFN AND ITS BUGS
JRST GNFIL5
CAME A,[-2] ;-2 MEANS "NO FILES AT ALL" IN CERTAIN CASES
;(THAT SHOULDN'T GET HERE ANYWAY)
GNJFN ;STEP TO NEXT FILE IN *-GROUP
JRST GNFIL5 ;NO MORE
JRST GNFIL8 ;LEAVE FLAGS IN LEFT HALF OF A
GNFIL5: AOS A,INIFH1 ;NEXT NAME IN GROUP
CAMLE A,INIFH2 ;ARE THERE MORE?
JRST [ POP P,B ;NO
POP P,A
RET]
HRRZ A,@INIFH1 ;RETURN NEXT JFN IN A
GNFIL8: AOS -2(P)
POP P,B
SUB P,[XWD 1,1]
RET
;THIS ROUTINE OBTAINS CONNECTED STRUCTURE. RETURNS POINTER THERETO IN A.
CONST:: GJINF ;GET CONNECTED DIRECTORY NUMBER
MOVE A,CSBUFP ;POINT TO STRING SPACE
DIRST ;GET STR:<DIR>
ERJMP CJERRE ;GO TELL USER WHY IT FAILED (PROBABLY STRUCTURE DISMOUNTED)
MOVE A,CSBUFP ;POINTER TO STRING
STDEV ;GET DEVICE DESIGNATOR FOR STRUCTURE
ERJMP CJERRE ;COULDN'T, SAY WHY AND DIE
MOVE A,CSBUFP ;POINT TO FREE SPACE
DEVST ;MAKE STRING NAME OF STRUCTURE
ERJMP CJERRE ;FAILED
MOVE A,CSBUFP ;POINT TO THE NAME
CALLRET BUFFS ;BUFFER IT AND RETURN POINTERTO USER
;DEVN
;INPUT AND VERIFY A DEVICE NAME.
;READS STRING, ACCEPTING ALT MODE (ECHO COLON), EOL, SPACE, COLON, SEMI
; AS TERMINATOR.
;DOES NOT DISTINGUISH PHYSICAL NAMES AND ALREADY-DEFINED SYNONYMS.
;RETURNS:
; A: DEVICE DESIGNATOR
; B: CHARACTERISTICS WORD AS RETURNED BY "DVCHR". HIGHLIGHTS THEREOF:
; B5: ON IF AVAILABLE OR ASSIGNED TO THIS JOB
; B6: ON IF ASSIGNED
; BOTH B5 & B6 ON IF ASSIGNED TO SELF
; C: JOB # ASSIGNED TO IF B6 OF B ON
;ENTRY
DEVN:
;RETURN HERE TO TRY AGAIN AFTER TYPING " ? " AFTER ERROR.
DEVX <Device name>
CMERRX
MOVE A,B
DVCHR ;GET CHARACTERISTICS WORD
HLRE C,C
RET
;ROUTINE TO GET DIRECTORY INFORMATION
;ACCEPTS IN A/ DIRECTORY NUMBER
; B/ POINTER TO PASSWORD STRING (GETDRP ONLY)
; C/ ADDRESS OF BLOCK INTO WHICH TO READ INFO
;RETURNS +1: FAILED
; +2: OK
; A/ POINTER TO DEFAULT ACCOUNT STRING
GETDIR::MOVEI B,0 ;NO PASSWORD GIVEN
GETDRP:: STKVAR <GACTPR,DNOO,DRADR,SAVPP,DRPASP>
MOVEM A,DNOO ;REMEMBER DIRECTORY NUMBER
MOVEM C,DRADR ;SAVE ADDRESS OF DIRECTORY BLOCK
MOVEM B,DRPASP ;SAVE THE POINTER TO THE PASSWORD STRING
MOVEI A,EXTSIZ ;ALLOCATE BLOCK FOR PASSWORD
CALL GETBUF
HRLI A,440700 ;MAKE BYTE POINTER
MOVEM A,SAVPP ;REMEMBER POINTER TO PASSWORD BLOCK
MOVE A,DRADR ;GET ADDRESS OF BLOCK
CALL DIRINI ;INIT GROUP POINTERS AND GROUP BUFFERS
MOVE A,DRADR ;GET ADDRESS OF GTDIR BLOCK
MOVE A,.CDDAC(A) ;GET POINTER TO ACCOUNT BEFORE GTDIR BLOODY DESTROYS IT
MOVEM A,GACTPR ;REMEMBER POINTER TO ACCOUNT
MOVE A,SAVPP ;COPY PASSWORD INTO BLOCK FOR DIRECTORY
MOVE B,DRPASP ;COPY FROM GIVEN PASSWORD (OR 0!)
MOVEI C,0 ;STOP COPYING ON NULL CHARACTER
SOUT ;COPY THE PASSWORD
MOVE A,DNOO ;GET DIRECTORY NUMBER
MOVE B,DRADR ;GET ADDRESS OF BLOCK
MOVEI C,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM C,.CDLEN(B) ;IN FIRST WORD OF BUFFER
MOVE C,SAVPP ;WHERE TO PUT PASSWORD (POINTER RETURNED IN BUFFER)
GTDIR ;GET ALL THE INFO INTO THAT BLOCK
ERJMP R ;IF FAILED, RETURN NO-SKIP
MOVE A,GACTPR ;RETURN ACCOUNT POINTER IN A
RETSKP
;INITIALIZE BUFFER FOR GTDIR (ALSO FOR NEW DIR DEFAULTS)
;TAKES ADDRESS OF BLOCK IN A
;ALLOCATES AND INITIALIZES ALL THE SUBBLOCKS THAT GTDIR NEEDS (USER GROUPS,
;ACCOUNT, SUBDIRECTORY USER GROUPS ALLOWED)
DIRINI:: STKVAR <BFA>
MOVEM A,BFA
SETZM (A)
HRL B,A
HRRI B,1(A)
BLT B,GTDLN-1(A)
MOVEI A,UGBUFL ;LENGTH OF USER GROUP BUFFER
CALL GETBUF ;GET SPACE FOR USER GROUPS
MOVE B,BFA ;GET ADDRESS OF DIR BLOCK
MOVEM A,.CDUGP(B) ;REMEMBER ADDRESS OF USER GROUP BUFFER
MOVEI B,UGBUFL ;LENGTH OF BUFFER
MOVEM B,(A)
MOVEI A,DGBUFL ;ALLOCATE DIRECTORY GROUP BUFFER IN SAME WAY
CALL GETBUF
MOVE B,BFA
MOVEM A,.CDDGP(B)
MOVEI B,DGBUFL
MOVEM B,(A)
MOVEI A,SGBUFL ;GET BLOCK FOR ALLOWABLE USER GROUPS
CALL GETBUF
MOVE B,BFA
MOVEM A,.CDCUG(B) ;STORE ADDRESS OF BLOCK FOR USER GROUPS
MOVEI B,SGBUFL
MOVEM B,(A) ;SET FIRST WORD OF SUBBLOCK TO COUNT
MOVEI A,EXTSIZ ;GET ROOM FOR ACCOUNT STRING
CALL GETBUF
MOVE B,BFA
HRLI A,440700 ;MAKE REAL BYTE POINTER TO ACCOUNT
MOVEM A,.CDDAC(B) ;STORE POINTER TO ACCOUNT BLOCK
SETZM (A) ;INITIALIZE ACCOUNT BUFFER
MOVEI A,GTDLN ;SET UP LENGTH OF BUFFER
MOVEM A,.CDLEN(B) ;IN FIRST WORD OF BUFFER
RET
;ROUTINE TO RELEASE FREE SPACE TAKEN UP BY A DIRECTORY BLOCK. THE ITEMS
;RELEASED ARE:
;
; o PASSWORD
; o USER GROUPS
; o DIRECTORY GROUPS
; o SUBDIRECTORY ALLOWABLE USER GROUPS
; o DEFAULT ACCOUNT STRING FOR LOGIN
;
;ACCEPTS:
; A/ ADDRESS OF DIRECTORY BLOCK
;RETURNS:
; +1 YES
RELDIR:: SAVEAC <Q2,Q1> ;USE AN AC SO INDEXING CAN BE DONE
MOVE Q1,A ;PRESERVE ADDRESS OF DIRECTORY BLOCK
HRRZ Q2,(Q1) ;GET LENGTH OF BLOCK
MOVEI A,EXTSIZ ;SIZE OF PASSWORD BLOCK
CAILE Q2,.CDPSW ;PASSWORD POINTER GIVEN?
SKIPN B,.CDPSW(Q1) ;MAYBE, IS THERE ONE THERE?
CAIA ;NO
CALL RETBUF ;YES, RELEASE SPACE USED BY PASSWORD
MOVEI A,UGBUFL ;SIZE OF USER GROUP BLOCK
CAILE Q2,.CDUGP ;USER GROUP POINTER THERE?
SKIPN B,.CDUGP(Q1) ;YES, IS IT VALID?
CAIA ;NO
CALL RETBUF ;YES, RELEASE GROUPS STORAGE
MOVEI A,DGBUFL ;LENGTH OF DIRECTORY GROUP BUFFER
CAILE Q2,.CDDGP ;RELEASE DIRECTORY GROUP BLOCK
SKIPN B,.CDDGP(Q1)
CAIA
CALL RETBUF
MOVEI A,SGBUFL ;SIZE OF SUBDIRECTORY USER GROUP BUFFER
CAILE Q2,.CDCUG ;DO SUBDIRECTORY USER GROUPS
SKIPN B,.CDCUG(Q1)
CAIA
CALL RETBUF
MOVEI A,EXTSIZ ;PREPARE TO RELEASE ACCOUNT STRING STORAGE
CAILE Q2,.CDDAC ;ACCOUNT POINTER?
SKIPN B,.CDDAC(Q1)
CAIA
CALL RETBUF ;REMOVE ACCOUNT STRING STORAGE
RET
;DIRNAM
;INPUT A DIRECTORY (INCLUDES USER) NAME, WITH RECOGINITION.
;SKIP RETURNS WITH ENTIRE WORDS FROM RCDIR OR RCUSR IN A AND C ON SUCCESS.
; AND THE POINTER TO THE DIR/USER NAME STRING IN B.
;USED IN CONNECT, WHERE, ^EPRINT COMMANDS.
;PRESERVES Q1 (FOR DIRECTORY).
;CALL WITH F1 OFF FOR DEFAULTING TO LOGGED-IN USER NAME OR CURRENT
;CONNECTED DIRECTORY. CALL WITH F1 ON FOR NO DEFAULTING.
USRNMS::TLOA Z,F5 ;ALLOW WILD CARDING
USRNAM:: TLZ Z,F5 ;NO WILD CARDING
STKVAR <<USRDEF,EXTSIZ>>
TLZ Z,F6 ;DO NOT RETURN IF AMBIGUOUS
TLZ Z,F4 ;NO DEFAULT
SKIPE CUSRNO ;NO DEFAULTING ALLOWED IF NOT LOGGED IN
TLNE Z,F1 ;DEFAULTING ALLOWED?
JRST NODDF1 ;NO
HRROI A,USRDEF ;GET ROOM FOR STRING
MOVEM A,CMDEF ;REMEMBER POINTER TO DEFAULT STRING
MOVNI A,1 ;PREPARE TO READ ONE JOB DATUM
HRROI B,A ;WE'LL READ DATUM INTO A
MOVEI C,.JIUNO ;DEFAULT TO CURRENT USER
GETJI ;GET INTERNAL FORM OF DEFAULT
CALL JERR ;SHOULD NEVER FAIL
MOVE B,A ;PUT DEFAULT INTO B
MOVE A,CMDEF ;GET POINTER TO DEFAULT STRING AREA
DIRST ;MAKE DEFAULT STRING
JFCL
NODDF1: TLNE Z,F5 ;ALLOW WILD CARDS?
JRST [ USERSX <User name>
RET ;FAILED
JRST NODDF2]
USERX <User name>
RET ;SINGLE RETURN ON FAILURE
NODDF2: MOVE C,B ;RETURN USER NUMBER IN C
PUSH P,A ;SAVE A
CALL BUFFF ;COPY STRING FROM ATOM BUFFER
MOVE B,A ;RETURNS STRING POINTER IN B
POP P,A ;RESTORE A
RETSKP ;TAKE SKIP RETURN ON SUCCESS
CURNMS::TLOA Z,F5 ;ALLOW WILD CARDING
CURNAM::TLZ Z,F5 ;DO NOT ALLOW WILD CARDING
TLZ Z,F6
TLO Z,F4 ;FLAG DEFAULT TO CONNECTED DIR
JRST DIRNA0
DIRNAM::TLZ Z,F5 ;NO WILD CARDING
TLZ Z,F6 ;DO NOT RETURN IF AMBIGUOUS
TLZ Z,F4 ;NO DEFAULT
DIRNA0: STKVAR <<DIRDF,EXTSIZ>>
SKIPE CUSRNO ;NO DEFAULTING ALLOWED IF NOT LOGGED IN
TLNE Z,F1 ;DEFAULTING ALLOWED?
JRST NODDF ;NO
HRROI A,DIRDF ;GET BUFFER FOR DEFAULT
MOVEM A,CMDEF ;DEFAULT WANTED, SET UP POINTER
MOVNI A,1 ;PREPARE TO READ ONE JOB DATUM
HRROI B,A ;WE'LL READ DATUM INTO A
MOVEI C,.JIDNO ;FIRST ASSUME DEFAULT TO CONNECTED DIRECTORY
TLNN Z,F4 ;DEFAULT TO LOGGED-IN?
MOVEI C,.JILNO ;YES, GET LOGGED-IN DIRECTORY NUMBER
GETJI ;GET INTERNAL FORM OF DEFAULT
CALL JERR ;SHOULD NEVER FAIL
MOVE B,A ;PUT DEFAULT INTO B
MOVE A,CMDEF ;GET POINTER TO DEFAULT STRING AREA
DIRST ;MAKE DEFAULT STRING
JFCL
NODDF: TLNE Z,F5 ;ALLOW WILD CARDING?
JRST [ DIRSX <Directory name>
RET ;FAILED
JRST DIRNA1] ;GOT ONE
DIRX <Directory name>
RET ;SINGLE RETURN ON FAILURE
DIRNA1: CALL BUFFF ;MAKE A COPY OF THE STRING
PUSH P,A ;SAVE THE POINTER TO THE STRING
MOVE B,A ;GET POINTER TO DIR NAME AGAIN
MOVX A,RC%EMO!RC%AWL ;EXACT MATCH AND ALLOW WILD CARDS
RCDIR ;GET INFO ON THIS DIRECTORY
ERJMP [POP P,(P)
RET] ;IF FAILS, NO SUCH DIR
POP P,B ;RETURN THE STRING POINTER IN B
TXNE A,RC%NOM!RC%AMB!RC%NMD
RET ;NONE FOUND
RETSKP ;TAKE SKIP RETURN ON SUCCESS
;ROUTINES TO STEP USER AND DIRECTORY NUMBERS WITH RCDIR
;ACCEPTS IN A/ DIR NUMBER
; B/ STRING POINTER TO WILD CARD STRING
; CALL STPDIR OR CALL STPUSR
;RETURNS +1: NO MORE
; +2: A/ NEW DIR NUMBER
STPDIR::SKIPA D,[RCDIR] ;STEP THE DIR NUMBER
STPUSR::MOVE D,[RCUSR] ;STEP THE USER NUMBER
STKVAR <STPSTP>
MOVEM B,STPSTP ;SAVE THE STRING POINTER
MOVE C,A ;GET DIR NUMBER INTO C
STPUS1: ILDB A,STPSTP ;GET NEXT CHAR OF STRING
CAIE A,"*" ;IS IT A WILD CARD?
CAIN A,"%" ;...
JRST STPUS2 ;YES, GO TRY TO STEP THIS STRING
JUMPN A,STPUS1 ;NO, KEEP LOOKING
RET ;NONE FOUND, THEN DO NOT DO THE JSYS
STPUS2: MOVX A,RC%AWL!RC%STP ;STEP THE DIR
XCT D
ERJMP R ;FAILED, NO MORE DIRS
TXNN A,RC%NMD ;ANY MORE DIR'S?
TXNE A,RC%NOM!RC%AMB ;FOUND ONE?
RET ;NO
MOVE A,C ;RETURN THE NEW NUMBER
RETSKP
;$GTFDB
;SUBROUTINE TO DO GTFDB JSYS AND SKIP UNLESS
;AN INSTRUCTION TRAP WITH "LIST ACCESS NOT ALLOWED"
;ERROR OCCURED.
;USED IN DIRECTORY, UNDELETE, DSKSTAT, COPY/APPEND, LIST/TYPE.
;SHOULD BE IN SAME PAGE AS DSKDIR CAUSE ITS IN A LOOP THERE.
$GTFDB::GTFDB
ERJMP FDBILI
RETSKP
;TRAP OCCURRED, CHECK ERROR CODE
FDBILI: CALL %GETER ;GET ERROR CODE
PUSH P,A
HRRZ A,ERCOD
CAIE A,GFDBX3 ;"LIST ACCESS NOT ALLOWED"?
JRST [ POP P,(P)
JRST JERRE]
POP P,A
RET
;$CHFDB - AS ABOVE FOR CHFDB
$CHFDB::CHFDB
ERJMP CHFD1
RETSKP ;SUCCESSFUL RETURN
CHFD1: CALL %GETER
HRRZ A,ERCOD ;RETURN ERROR CODE ON FAILURE
RET
;OCTCOM inputs a 36-bit octal number in either of two formats. The
;number may simply be typed as a large octal number, or as two small
;numbers separated by ",,". If the first number has more than 6
;significant digits, we give an error. On call,
;A should contain the pointer to the help text for the field, and
;B should contain a pointer to the help text for the next field. This
;is necessary because after the first number has been read, the options to
;the user are ",," or the next field.
OCTCOM: STKVAR <HLP1,HLP2,OCTVL,<HLPTXT,40>>
MOVEM A,HLP1 ;Save the help pointers
MOVEM B,HLP2
UOCT @HLP1 ;Ask for first number with caller's help
CMERRX
MOVEM B,OCTVL ;Save value
CALL NESC ;Terminated with ESC?
JRST OCTDON ;Yes--assume done
TLC B,-1 ;Any significance in LH?
TLCE B,-1 ;Significance is other than all 1s or 0s
TLNN B,-1 ; to allow -m,,n
JRST OCTCO1 ;No--try for a right half
JRST OCTDON ;Yes--assume number is done
OCTCO1: HRROI A,HLPTXT ;Build combined help message
HRROI B,[ASCIZ /",," to separate left and right halves,
or /]
SETZ C,
SOUT ;Combine them
HRRO B,HLP2 ;Tack on caller's help text
SOUT
SETZ B, ;Terminate in ASCIZ format
IDPB B,A
MOVE A,[<ASCIZ /,/>+","];Fake out CHARX
UCHAR HLPTXT ;Look for ",,"
JRST OCTDON
HRLZS OCTVL ;First number was left half
DEFX <0> ;Default right half to 0
OCTX <Right half> ;Accept right half of number
CMERRX
TLC B,-1 ;Any significance in LH now is an error
TLCE B,-1 ; but allow m,,-n
TLNN B,-1
JRST OCTCO2 ;No--store result
ERROR <Right half exceeds 777777>
OCTCO2: HRRM B,OCTVL ;Store rest of number
OCTDON: MOVE A,OCTVL ;Return number to user
RET
;routine to input list of octal number ranges in the form:
;n1,n2:n3,n4:n5,n6...
;"rlist" starts with count of number of numbers, followed by the
;numbers themselves. numbers are all two-Word pairs showing beginning
;and end of range. for instance, "n1,n2:n3,n4,n5:n6" would get
;stored like this:
;
; rlist/ 8 ;8 numbers altogether (4 pairs)
; rlist+1/n1
; rlist+2/n1 ;note that first pair goes from n1 to n1!
; rlist+3/n2
; rlist+4/n3
; rlist+5/n4
; rlist+6/n4
; rlist+7/n5
; rlist+8/n6
;THIS ROUTINE RETURNS IF THE USER ENDS A RANGE WITH $. THIS IS NECESSARY
;TO ALLOW THE USER TO BE PROMPTED FOR THE NEXT FIELD.
octlst::
SETZM RLIST ;START WITH 0 NUMBERS
octl2: octx <Octal number>
cmerrx ;at least one number must be entered
call numstr ;store the number in the list
CALL NESC ;SKIP IF ESCAPE DIDN'T TERMINATE NUMBER
JRST OCTL5 ;IT DID, SO DON'T INPUT MORE
COLONX <":" to enter range, or "," for another number, or next field of command>
CAIA ;NO COLON TYPED
JRST OCTL4 ;COLON TYPED, GO GET END OF RANGE
COMMAX <"," to enter another number, or next field of command>
JRST OCTL5 ;NO COMMA OR COLON AFTER NUMBER, MUST BE END OF LIST
CALL NUMREP ;REPEAT LAST NUMBER
JRST OCTL2 ;GO GET NEXT SET (REQUIRED BECAUSE WE SAW COMMA)
OCTL4: OCTX <Octal number for end of range>
CMERRX
CALL NUMSTR ;STORE END OF RANGE
CALL NESC ;DID NUMBER END WITH ESCAPE?
JRST OCTL6 ;YES, SO GO ON TO NEXT FIELD OF COMMAND
COMMAX <Comma to enter another number, or next field of command>
JRST OCTL6 ;NO COMMA AFTER RANGE, MUST BE END OF LIST
JRST OCTL2 ;COMMA, SO GET ANOTHER PAIR
;SINGLE NUMBER FOLLOWED BY NON-COMMA AND NON-COLON
OCTL5: CALL NUMREP ;REPEAT PREVIOUS NUMBER
OCTL6: RET ;ALL DONE
NUMREP: MOVE D,RLIST ;TO REPEAT LAST NUMBER, GET END OF LIST
MOVE B,RLIST(D) ;GET LAST NUMBER, AND FALL INTO REGULAR NUMBER STORE ROUTINE...
numstr: AOS D,RLIST ;INCREASE NUMBER OF NUMBERS
movem b,rlist(d) ;save number
RET
;OUTPUT OCTAL NUMBER FROM B, NO LEADING ZEROES OR SPACES.
TOCT: PUSH P,A
PUSH P,C
MOVE A,COJFN ;DESTINATION
MOVE C,[1B0+10] ;"MAGINITUDE" FLAG AND RADIX
NOUT
CALL JERRC ;GENERAL JSYS ERROR, CODE IN C
MOVEM A,COJFN ;SAVE IN CASE BYTE POINTER
POP P,C
POP P,A
RET
;TYPE SYSTEM DOWN TIME IF SET
DWNTYP::GJINF
JUMPN A,R ;NO TYPE IF ALREADY LOGGED IN
DWNPNT::MOVEI D,0 ;GET ITEM 0 FROM DWNTIM TABLE
GTB .DWNTI
JUMPE A,R ;DO NOTHING IF NOT SET
ETYPE < System shutdown scheduled for %1W>
MOVEI D,1 ;GET ITEM 1
GTB .DWNTI
JUMPE A,DWNTY1 ;JUMP IF UPTIME NOT SET
ETYPE <,
Up again at %1W>
DWNTY1: ETYPE<%_>
RET
;ROUTINE THAT TAKES SIXBIT IN A AND RETURNS A POINTER TO ASCII STRING
GETASC:: STKVAR <REMSIX,ASCPR>
MOVEM A,REMSIX ;REMEMBER THE SIXBIT
MOVEI A,2 ;NEED TWO WORDS FOR ASCII
CALL GETBUF
HRLI A,440700 ;MAKE BYTE POINTER TO ASCII
MOVEM A,ASCPR ;REMEMBER POINTER TO ASCII
HRRI B,REMSIX
HRLI B,440600 ;GET SIXBIT POINTER
MOVEI D,0 ;NULL FOR CLEARING PROCESSED CHARACTERS
ASC1: SKIPN REMSIX ;ANY MORE LEFT?
JRST ASC2 ;NO
ILDB C,B ;YES, PICK UP NEXT CHARACTER
ADDI C,40 ;CHANGE TO ASCII
IDPB C,A ;STORE ASCII CHARACTER
DPB D,B ;CLEAR CHARACTER SO WE'LL KNOW WHEN WE'VE HIT END
TLNE B,770000 ;DONE SIX CHARACTERS?
JRST ASC1 ;NO, MIGHT BE MORE
ASC2: MOVEI C,0 ;GUARANTEE NULL AT END
IDPB C,A
MOVE A,ASCPR ;GET POINTER TO ASCII
RET ;RETURN POINTER
;ROUTINE TO RETURN SIXBIT VERSION OF LATEST FIELD IN A.
GETSXB:: HRROI A,ATMBUF ;POINT AT WHAT USER TYPED
CALL GETSIX ;GET SIXBIT VERSION
ERROR <Name too long or contains invalid character>
RET
;ROUTINE TO YIELD SIXBIT DATA IN A FOR ASCII STRING POINTED TO BY
;POINTER IN A. SKIP RETURNS, UNLESS ILLEGAL SIXBIT CHARACTER ENCOUNTERED,
;OR STRING MORE THAN SIX CHARACTERS, IN WHICH CASE A WILL CONTAIN SIXBIT THROUGH LAST GOOD CHAR
GETSIX:: STKVAR <ASPTR,SIXPTR>
CALL FIXPT ;FIX POINTER
MOVEM A,ASPTR ;REMEMBER ASCII POINTER
MOVE A,[440600,,A] ;POINTER TO SIXBIT RESULT
MOVEM A,SIXPTR
MOVEI A,0 ;START WITH NULL RESULT
MOVSI B,-6 ;DO SIX CHARS MAXIMUM
GETSX1: ILDB C,ASPTR ;GET NEXT ASCII CHARACTER
JUMPE C,RSKP ;DONE IF NULL
CAIN C,"" ;THE QUOTING CHARACTER?
JRST [ ILDB C,ASPTR ;YES, ALLOW NEXT CHARACTER REGARDLESS
JRST .+1]
CAIL C,141 ;CHANGE LOWERCASE LETTERS TO UPPERCASE
CAILE C,172
CAIA ;NOT LOWERCASE
TRZ C,40 ;LOWERCASE, CHANGE IT
SUBI C,40 ;CHANGE TO SIXBIT
JUMPL C,R ;IF ILLEGAL CHARACTER, GIVE NON-SKIP
IDPB C,SIXPTR ;STORE IN SIXBIT RESULT IN A
AOBJN B,GETSX1 ;ONLY DO SIX CHARACTERS
ILDB C,ASPTR ;GET CHARACTER AFTER SIXTH
JUMPE C,RSKP ;IF NULL, STRING ENDED "JUST IN THE NICK OF TIME"
RET ;NON-SKIP IF STRING TOO LONG
;ROUTINE TO CHANGE -1,,FOO TO 440700,,FOO
FIXPT:: TLC A,-1 ;IF WAS -1, IS NOW 0 (IF OTHER, IS NOW OTHER')
TLCN A,-1 ;SKIP AND RESTORE IF WASN'T -1
HRLI A,440700 ;CHANGE TO 440700 IF WAS -1
RET
;BUFFF
;SUBROUTINE TO BUFFER LAST FIELD IN A MANNER SUITABLE FOR JSYS'S AND
; RETURN A BYTE PTR TO IT IN A.
;COPIES TO separate BUFFER SPACE, PUTS NULL BYTE AT END.
BUFFF: PUSH P,B
PUSH P,C
PUSH P,D
HRROI A,ATMBUF ;POINT TO THE FIELD
CALL BUFFS ;BUFFER THE STRING
POP P,D
POP P,C
POP P,B
RET
;ROUTINES TO BUFFER A STRING. GIVE IT POINTER TO STRING IN A.
;ROUTINE RETURNS POINTER TO BUFFERED STRING IN A.
;THE STRING ALWAYS BEGINS ON A WORD BOUNDARY. (SOME CALLERS ASSUME SO!)
;XBUFFS USES PERMANENT STORAGE, BUFFS USES TEMPORARY STORAGE
XBUFFS:: SKIPA B,[XDICT] ;SPECIFY PERMANENT FREE POOL
BUFFS:: MOVEI B,DICT ;TEMPORARY POOL
CALL READNM ;COPY STRING INTO FREE SPACE
ERROR <String space exhausted>
RET
;ROUTINE TAKING A STRING POINTER IN A. IT COPIES THE STRING TO FREE SPACE
;AND TAKES A SKIP RETURN, YIELDING THE POINTER TO THE STRING IN
;A. IF NO ROOM FOR THE STRING, A NON-SKIP RETURN IS TAKEN AND CONTENTS
;OF A IS INDETERMINATE
;GIVE IT FREE POOL HEADER ADDRESS IN B
READNM: STKVAR <FPA,RPTR,NEWPTR>
MOVEM A,RPTR ;REMEMBER POINTER
MOVEM B,FPA ;REMEMBER FREE POOL ADDRESS
CALL BCOUNT ;HOW MANY WORDS IN THIS STRING?
MOVE B,FPA ;SAY WHICH FREE POOL TO USE
CALL GETMEM ;GET THAT MANY
JRST NOREAD ;COULDN'T, SO TAKE NON-SKIP RETURN
HRLI B,440700 ;MAKE BYTE POINTER TO SPACE OBTAINED
MOVEM B,NEWPTR ;REMEMBER NEW POINTER
MOVE A,B
MOVE B,RPTR ;GET POINTER TO STRING
MOVEI C,0 ;STORE NULL AT END OF STRING
SOUT ;COPY THE STRING
MOVE A,NEWPTR ;GET ADDRESS WHERE STRING GOT PUT
RETSKP ;SUCCESFUL RETURN
NOREAD: RET ;NO ROOM FOR STRING
;ROUTINE TO GET MEMORY BLOCK. RETURNS +1 ALWAYS WITH ADDRESS OF BLOCK
;IN A. GIVE IT NUMBER OF WORDS DESIRED IN A.
GTBUFX:: SKIPA B,[XDICT] ;PERMANENT STORAGE
GETBUF:: MOVEI B,DICT ;USE TEMPORARY POOL
CALL GETMEM ;GET THE MEMORY
ERROR <Exec free space exhausted>
MOVE A,B ;RETURN ADDRESS IN A
RET
; /GETMEM/ - ROUTINE TO ASSIGN MEMORY AS REQUESTED
; INPUTS: A - CONTAINS NUMBER OF WORDS WANTED
; B - FREE SPACE HEADER ADDRESS
; OUTPUTS: A - NUMBER OF WORDS OBTAINED
; B - CONTAINS ADDRESS OF WORDS GOTTEN
; RETURNS: SKIPS IF SUCCESSFUL, NON-SKIP IF NO ROOM
GETMEM:: STKVAR <<SAVSTF,2>,DADR>
MOVEM B,DADR ;REMEMBER HEADER ADDRESS
GETM2: MOVE C,B ;REMEMBER WHO POINTS TO CURRENT
HRRZ B,0(C) ;B IS NOW CURRENT BLOCK
JUMPE B,R ;IF 0, WE HAVE REACHED END OF THE ROAD
HLRZ D,0(B) ;GET SIZE OF CURRENT BLOCK
CAMGE D,A ;IS IT SUFFICIENT FOR REQUEST?
JRST GETM2 ;NO, SO TRY NEXT BLOCK
GETM3: HRL B,0(B) ;GET LINK OF CURRENT BLOCK
HLRM B,0(C) ;MAKE PREV LINK BE WHAT WAS OUR LINK
HRRZS B ;ISOLATE CURRENT BLOCKS ADDRESS
CAMN D,A ;IS THIS AN EXACT MATCH ON SIZE?
RETSKP ;SUCCESS, SKIP RETURN
DMOVEM A,SAVSTF ;SAVE NUMBER OF WORDS AND ADDRESS
ADD B,A ;GET FIRST WORD TO RETURN
SUBM D,A ;NUMBER OF WORDS TO RETURN
MOVE C,DADR ;GET ADDRESS OF CONTROL WORD
CALL RETMEM ;RETURN THE EXTRA WORDS
DMOVE A,SAVSTF ;RESTORE NUMBER OF WORDS AND ADDRESS
RETSKP ;SUCCESS, SKIP RETURN
;STREM ROUTINE TAKES POINTER TO STRING IN A, AND "REMOVES" THE STRING
;FROM THE STRING STORAGE SPACE. THE SPACE WHERE THE STRING WAS IS
;RETURNED TO FREE SPACE
STREM:: ATSAVE ; NEED TO BE TRANSPARENT
STKVAR <SPT000>
MOVEM A,SPT000 ;REMEMBER POINTER
CALL BCOUNT ;COUNT NUMBER OF WORDS IN THE STRING
HRRZ B,SPT000 ;GET RID OF BYTE POINTER P AND S
CALLRET RETBUF ;RETURN THE BUFFER
;RETBUF RETURNS A BUFFER TO FREE STORAGE
; A/ SIZE BEING RETURNED
; B/ ADDRESS OF BLOCK BEING RETURNED
RETBUF:: MOVEI C,DICT ;FIRST ASSUME TEMPORARY FREE SPACE
CAIL B,XFREE ;MAYBE ADDRESS IS IN PERMANENT FREE SPACE
CAIL B,XFREE+XFRESZ
CAIA
MOVEI C,XDICT ;YES
CALLRET RETMEM ;RETURN THE SPACE TO THE FREE POOL
; /RETMEM/ - ROUTINE TO DE-ALLOCATE MEMORY WHEN WE ARE THROUGH WITH IT
; INPUT: A - CONTAINS SIZE OF BLOCK TO RETURN
; B - CONTAINS ADDRESS OF BLOCK BEING RETURNED
; C - FREE SPACE HEADER ADDRESS
; OUTPUT: NONE
; RETURNS: ALWAYS CPOPJ
;
RETMEM:: HRRZ D,0(C) ;GET PREV'S LINK
SKIPE D ;IF CURRENT IS 0 OR
CAIL D,0(B) ; ITS ADDRESS IS PAST ADDR OF RETURN BLK
JRST RETM4 ; THEN RETURN BLOCK HERE
MOVE C,D ;MAKE PREV=CURRENT
JRST RETMEM ;CONTINUE
RETM4: HRRM D,0(B) ;FORWARD PTR OF RETURNED BLOCK
HRRM B,0(C) ;FORWARD PTR OF PREV BLOCK
HRLM A,0(B) ;STORE SIZE OF THIS BLOCK
ADD A,B ;ADD ADDR+SIZE
CAIE A,0(D) ;ARE WE RIGHT UP AGAINST NEXT BLOCK?
JRST RETM5 ;NO, CANT COMBINE
HRRZ A,0(D) ;GET NEXT GUYS FORWARD LINK
HRRM A,0(B) ;MAKE IT OURS. IE POINT PAST HIM
HLRZ A,0(B) ;GET OUR SIZE
HLRZ D,0(D) ;GET HIS SIZE
ADD A,D ;GET OUR NEW COMBINED SIZE
HRLM A,0(B) ;STORE INTO RETURNED BLOCK
HRRZ D,0(B) ;GET LINK OF CURRENT BLOCK
RETM5: HLRZ A,0(C) ;GET PREV BLOCKS SIZE
ADDI A,0(C) ;ADD HIS ADDRESS AND SIZE
CAIE A,0(B) ;DOES HE BUTT RIGHT UP AGAINST US?
RET ;NO, RETURN WITH NO COMBINATION
HRRM D,0(C) ;MAKE PREV POINT TO OUR NEXT
HLRZ A,0(C) ;GET HIS SIZE
HLRZ B,0(B) ;AND OUR SIZE
ADD A,B ;COMBINE THE SIZES
HRLM A,0(C) ;STORE COMBINED SIZE
RET ;RETURN
;ROUTINE TO INITIALIZE FREE SPACE STORAGE. DONE BEFORE EACH COMMAND IS
;EXECUTED.
FREINI:: SETZM DICT ;INITIALIZE FREE SPACE SYSTEM
MOVEI A,FRESIZ ;FREE UP THIS MUCH FREE SPACE (ALL OF IT!)
MOVEI B,FREE ;STARTS AT ADDRESS IN B
CALL RETBUF ;FREE IT UP IN STANDARD WAY
MOVEI A,STRSIZ ;ALLOCATE SOME SPACE FOR STRINGS
CALL GETBUF
HRLI A,440700 ;MAKE POINTER TO STRING STORAGE
MOVEM A,CSBUFP ;REMEMBER POINTER TO STRING STORAGE
RET
;ROUTINE TO INITIALIZE PERMANENT FREE SPACE. THIS IS DONE ONCE PER RUNNING
;OF THE EXEC
XFRINI:: SETZM XDICT
MOVEI A,XFRESZ
MOVEI B,XFREE
CALLRET RETBUF ;RETURN ALL PERMANENT FREE SPACE TO POOL
;BCOUNT MEASURES AN ASCIZ STRING.
;
;ACCEPTS: A/ POINTER (-1,,FOO O.K.!)
;
;RETURNS+1: A/ NUMBER OF WORDS NEEDED IN A
; B/ NUMBER OF CHARACTERS
BCOUNT:: CALL FIXPT ;CHANGE -1 TO 440700
MOVEI B,0 ;B WILL ACCUMULATE COUNT OF BYTES
BC1: ILDB C,A ;READ NEXT BYTE
CAIE C,0 ;DONE COUNTING IF NULL SEEN
AOJA B,BC1 ;NOT DONE, KEEP COUNTING
MOVE D,B ;REMEMBER EXACT COUNT IN D
AOJ B, ;LEAVE ROOM FOR NULL
IDIVI B,5 ;GET NUMBER OF WORDS
CAIE C,0 ;EXTRA CHARACTERS?
AOJ B, ;YES, THEY TAKE A WHOLE WORD
MOVE A,B
MOVE B,D ;RETURN BYTE COUNT IN B
RET
;ROUTINE TO RETURN HOST'S NODE NAME. RETURNS A POINTER TO IT IN A.
;THIS RETURN SKIPS IFF SUCCESSFUL
GETNOD:: MOVEI A,.NDGLN ;SAY WE WANT HOST'S NODE NAME
MOVEI B,CSBUFP ;USE POINTER TO STRING SPACE TO WRITE THE NAME
MOVE C,CSBUFP ;REMEMER POINTER TO NAME
NODE ;GET THE NAME
ERJMP R ;FAILED, GIVE SINGLE RETURN
MOVE A,C ;GET POINTER TO NAME
CALL BUFFS ;BUFFER THE NAME AND RETURN
RETSKP
;SUBROUTINE TO TURN OFF ECHOING BEFORE PASSWORD INPUT
NOECHO: PUSH P,C
TXO Z,NECHOF ;SAY ECHOING OFF (TESTED IN %NOI)
MOVEI C,0 ;SAY NO ECHOING NOHOW
JRST ECHOST ;JOIN "DOECHO"
;SUBROUTINE TO TURN ON ECHOING AFTER PASSWORD INPUT
DOECHO: TXNN Z,NECHOF ;WAS ECHOING OFF?
RET ;NO, SO NOTHING TO DO
PUSH P,C
MOVEI C,2 ;SAY IMMEDIATE OR DEFERRED ECHOING
ECHOST: PUSH P,A ;ENTRY TO SET ECHO BITS FROM C
PUSH P,B
MOVE A,CIJFN
RFMOD ;READ TELETYPE MODE WORD
DPB C,[POINT 2,B,25]
SFMOD ;SET TTY MODE WORD
CAIN C,2 ;ECHOING NOW ON?
TXZ Z,NECHOF ;SAY ECHOING NOT SUPPRESSED
POP P,B
POP P,A
POP P,C
RET
;LTTYMD - LOAD TELETYPE MODES
;AC Q1 POINTS TO 11-WORD BLOCK OF VALUES TO PUT INTO EFFECT:
;SEE EXECDE FOR STRUCTURE OF BLOCK
XTND,<
UTTYMD::PUSH P,A ; SAVE REG
SKIPLE A,FORK ; USER CURRENT FORK
CALL FTTYMD ; IF VALID
POP P,A ; RESTORE REG
RET ; RETURN
FTTYMD::SKIPN Q1,SLFTAB(A) ; SETUP MODE BLOCK PNTR
RET
MOVEI Q1,.FKPTM(Q1) ; ADDRS OF FORK'S MODE BLOCK
>
LTTYMD: SKIPN (Q1) ;DO NOTHING IF BLOCK IS 0 DUE TO A BUG OR
RET ;A STRANGE INTERRUPT-RESTART SEQUENCE
ATSAVE
MOVEI A,.CTTRM
MOVE B,TTWMOD(Q1) ;FILE MODE WORD
TXZ B,TT%OSP ;ENSURE NO OUTPUT SUPPRESS
SFMOD
DVCHR ;MTOPR WORKS ON TTY ONLY
LDB B,[POINTR B,DV%TYP] ;GET DEVICE TYPE CODE
CAIE B,.DVTTY ;SKIP IF IT'S A TERMINAL
JRST NOTTY1 ;NO - NOT A TTY
MOVEI A,.CTTRM ;NOW RESTORE THE MASK
MOVEI B,.MOSBM
MOVEI C,TTWMSK(Q1)
MTOPR
ERJMP NOTTY1 ;ERROR MEANS WRONG MONITOR
MOVEI B,.MOSFW ;NOW FOR THE FIELD WIDTH
MOVE C,TTWFWT(Q1)
MTOPR
MOVEI A,.CTTRM
NOTTY1: MOVE B,TTWCOC(Q1) ;2 CCOC WORDS
MOVE C,TTWCOC+1(Q1)
SFCOC
MOVEI A,.FHSLF
RPCAP
TXON C,SC%CTC ;CAN'T SET JOB TIW IF NO ^C PRIV
JRST [ TXNN B,SC%CTC ;^C NOT ENABLED. ENABLABLE?
JRST NOSTIW ;NO, DON'T TRY THE STIW
EPCAP ;ENABLABLE, SO DO IT
JRST .+1] ;NOTE: LOGIN JSYS CLEARS AC3 CAPABILITIES!
MOVEI A,.FHJOB
MOVE B,TTWJTI(Q1) ;SET JOB TIW
STIW
NOSTIW: MOVE A,TTWSNM(Q1) ;GET SUBSYS NAME
MOVE B,TTWPNM(Q1) ;GET PROGRAM NAME
SETSN ;SET THEM
CALL JERR
RET
;RTTYMD - STORE CURRENT TTY MODE, TAB STOPS, CCOC
; INTO 6-WORD BLOCK THAT AC Q1 POINTS TO.
XTND,<
RFTYMD::SKIPN Q1,SLFTAB(A) ; SETUP MODE BLOCK PNTR
RET
MOVEI Q1,.FKPTM(Q1) ; MODES FOR FORK
>
RTTYMD: ATSAVE
MOVEI A,.CTTRM
RFMOD
MOVEM B,TTWMOD(Q1)
DVCHR ;MTOPR WORKS ON TTY ONLY
LDB B,[POINTR B,DV%TYP] ;GET DEVICE TYPE CODE
CAIE B,.DVTTY ;SKIP IF IT'S A TERMINAL
JRST NOTTY2 ;NO - NOT A TTY
MOVEI A,4 ;PUT LENGTH INTO BLOCK
MOVEM A,TTWMSK(Q1)
MOVEI A,.CTTRM ;NOW SAVE THE MASK
MOVEI B,.MORBM
MOVEI C,TTWMSK(Q1)
MTOPR
ERJMP NOTTY2 ;ERROR MEANS WRONG MONITOR
MOVEI B,.MORFW ;NOW FOR THE FIELD WIDTH
MTOPR
MOVEM C,TTWFWT(Q1)
MOVEI B,.MOSFW
SETZ C, ;TURN OFF FIELD WIDTH
MTOPR
NOTTY2: MOVEI A,.CTTRM
RFCOC
MOVEM B,TTWCOC(Q1)
MOVEM C,TTWCOC+1(Q1)
MOVEI A,.FHJOB
RTIW
MOVEM B,TTWJTI(Q1)
SETO A, ;SAY THIS JOB
MOVE B,[-2,,C] ;SAY 2 WORDS INTO C AND D
MOVEI C,.JISNM ;STARTING WITH SUBSYS NAME
GETJI ;GET SUBSYS AND PROGRAM NAME
CALL JERR
MOVEM C,TTWSNM(Q1) ;SAVE THEM
MOVEM D,TTWPNM(Q1)
RET
;NOTE: ALL MODE STUFF IN EXEC IS DONE WITH OUTPUT FILE, WHICH IS
;LESS LIKELY TO BE REDIRECTED TO NON-TTY THAN INPUT.
;MODE IS UNLIKELY TO NEED CHANGING FOR NON-TTY INPUT FILE;
;TO CHANGE IT USER MUST: A) USE A PROGRAM, SUCH AS DDT, OR B) TEMP SET
; OUTFILE=INFILE (IF PSEUDO-ECHOING DOESN'T INTERFERE). 4/22/70.
;UUO TO OUTPUT SINGLE ASCII CHARACTER FROM EFFECTIVE ADDRESS
%PRINT: PUSH P,A
PUSH P,B
AOS TTYACF ;TELL AUTOLOGOUT CODE THAT TTY IS ACTIVE
MOVE A,COJFN
HRRZ B,40
BOUT
MOVEM A,COJFN ;IN CASE IT'S A BYTE POINTER
AOS TTYACF ;AGAIN IN CASE BLOCKED DUE TO FULL BUFFER
POP P,B
POP P,A
RET
;OUTPUT CHARACTER FROM B WITHOUT STORAGE FLAG TEST (USED?)
COUTC:: PUSH P,A
MOVE A,COJFN ;GET OUUTPUT STREAM
TLNE A,-1 ;BYTE POINTER?
JRST [ IDPB B,COJFN ;YES, SAVE TIME TO OPTIMIZE ETYPE
JRST COUTC1]
AOS TTYACF ;TELL AUTOLOGOUT THAT THERE'S BEEN TTY ACTIVITY
BOUT ;MONITOR CALL TO OUTPUT CHARACTER
AOS TTYACF
COUTC1: POP P,A
RET
;TBOUT, TSOUT0 -- USED INSTEAD OF BOUT AND SOUT WHERE TEXT
;MAY CONTAIN EOL'S.
TBOUT:: BOUT
RET
;SOUT WHERE C=0, I.E. TERMINATE ON NULL
TSOUT0::PUSH P,B
HLRZ B,B
CAIN B,-1 ;DEFAULT BYTE PTR LH?
JRST [ MOVSI B,(<POINT 7,0>) ;YES, SETUP 7 BIT
HLLM B,0(P)
JRST .+1]
TSOUT1: ILDB B,0(P) ;GET NEXT CHAR
JUMPE B,[POP P,B ;NULL TERMINATES, RESTORE UPDATED PTR
RET]
BOUT
JRST TSOUT1
;MAP A PAGE OF A FORK
;Accepts in A: A 30-bit address in the fork, or -1 to clear the buffer
; FORK: Fork handle
;Returns:
; +1: Cannot map process (last error says why)
; +2: Success,
; A: Untouched
; B: Access and existence bits (from RPACS), unless A had -1
; PAGEN: The page mapped
MAPPF: PUSH P,C
PUSH P,A
JUMPL A,MPPF1
SKIPGE FORK ;IS THERE A CURRENT FORK?
ERROR <No program> ;NO.
TDNN A,[777776,,777760] ;SECTION 0 OR 1, ADDRS 0-17 ARE ACS
JRST MAPACS
LSH A,-^D9 ;SEPARATE PAGE #
HRL A,FORK ;FORK HANDLE OF PAGE WE WANT
TLO A,(1B0) ;SAY FORK HANDLE NOT JFN
MPPF1: MOVEI B,PAGEN ;GENERATE DESTINATION PAGE IDENTIFIER
LSH B,-^D9 ;...MUST SHIFT AT RUN TIME CAUSE EXTERNAL
TLO B,(1B0) ;...SAY THIS FORK
MOVX C,PM%RD!PM%WR!PM%EX ;REQUEST ALL ACCESS, NORMAL DISPOSAL
CAME A,NPAGE ;SAVE TIME IF ALREADY MAPPED
PMAP ;MAP IT
ERJMP MAPPFF ;Can't MAP-- return +1
MOVEM A,NPAGE ;SAY ITS MAPPED
CAMN A,[-1]
JRST MPPF8
RPACS ;GET ACCESS/EXISTENCE OF MAPPED PAGE
ERJMP [ SETZ B, ;SECTION CONTAINING PAGE DOESN'T EXIST
JRST MPPF8] ;JUST SAY PAGE CAN'T BE USED
SKIPN B ;ANY BITS?
TXO B,PA%WT ;NO - SET WRITE ACCESS (NEW PAGE)
JRST MPPF8 ;Restore and return +2
;REFERENCE IS TO AN AC. READ ACS INTO PAGEN WITH "RFACS".
;IN THIS CASE CALLER MUST USE SFACS IF HE WISHES TO CHANGE A LOCATION.
MAPACS: SETO A,
CALL MAPPF ;UNMAP PAGE IN BUFFER, IF ANY.
JFCL ;Unmap shouldn't fail
MOVE A,FORK
MOVEI B,PAGEN
RFACS ;READ FORK ACS INTO "PAGEN"
ERJMP MAPPFF ;Failed-- restore ACs and return +1
MOVX B,PM%RD!PM%WR!PM%EX!PM%PLD ;REQUEST ALL ACCESS, NORMAL DISPOSAL
MPPF8: POP P,A ;RH A TRANSPARENT
POP P,C
RETSKP ;Return +2 success from MAPPF
MAPPFF: POP P,A ;Restore all
POP P,C ; . . .
RET ; and return +1 from MAPPF
;LOAD SINGLE WORD FROM FORK, GIVEN ADDRESS IN A
LOADF: CALL MAPPF
RET ;Failed-- return +1
TXNN B,PA%PEX
ERROR <No such page>
TXNN B,PA%RD
ERROR <Can't read that page>
ANDI A,777
MOVE A,PAGEN(A)
RETSKP ;Return +2 from LOADF
;STORE SINGLE WORD FROM B INTO FORK, ADDRESS IN A
STOREF: PUSH P,B ;SAVE WORD TO STORE OVER MAPPF
CALL MAPPF
JRST [ POP P,B
RET] ;Failed-- return +1
TXNE B,PA%PEX ;OK TO STORE IF PAGE NON-EXISTENT
TXNE B,PA%WT!PA%CPY ;OR IF WRITE ACCESS OR COPY ON WRITE PERMITTED
CAIA
ERROR <Can't write into page>
ANDI A,777
POP P,B ;GET BACK VALUE TO STORE
MOVEM B,PAGEN(A)
RETSKP
;%GTB
;UUO TO DO A "GETAB" JSYS WITH A REASONABLE CALLING SEQUENCE.
;TABLE # IN C(Q1), INDEX IN RH OF D, ONE RETURN WITH WORD IN A.
;TYPICAL USAGE: LH D CONTAINS AOBJN COUNTER, B AND C ARE FREE
; FOR USE IN OTHER JSYS CALLS INSIDE LOOP.
%GTB: HRL A,D
HRR A,40
GETAB
CALL JERR
RET
;ERROR, PSEUDO-INTERRUPT, %-MESSAGE-TYPING STUFF
;PSI ROUTINE FOR TERMINAL CHARACTER THAT PRINTS RUNTIME (^T)
USEPSI: CALL USEX ;DO THE WORK
DEBRK ;DISMISS THE INTERRUPT
USEX:
STAT,< AOS STBUF >;THIS INDEX FOR ^T
ATSAVE
STKVAR <CIJFN0,COJFN0,SAV40>
MOVE A,CIJFN
MOVE B,COJFN
MOVEM A,CIJFN0 ;SAVE POSSIBLE DIVERTED OUTPUT
MOVEM B,COJFN0
MOVE A,40
MOVEM A,SAV40 ;POSSIBLE UUO IN PROGRESS
MOVEI A,.PRIOU ;ALWAYS DISPLAY OUTPUT TO PRIMARY,
MOVEM A,COJFN ;SINCE THAT'S WHERE ^T WAS TYPED FROM.
SKIPE CIPF ;COMMAND IN PROGRESS?
JRST USEPS9 ;YES, DIFFERENT MESSAGE
XTND,<
SKIPLE EFORK ; EPHERMERAL?
JRST [ GETNM ; YES - GET NAME
ETYPE < %1' (;E) >
MOVE A,EFORK ; TELL USER ^T IN EPHERMERAL
JRST USEPS0]
>
SKIPGE A,FORK
JRST USEPS2 ;NO INFERIOR
XTND,<
SKIPN B,SLFTAB(A) ; KNOW TO US
JRST USEPS0 ; NO - NO NAME THEN
MOVE B,.FKPTM+TTWPNM(B) ; GET NAME FROM TABLE
ETYPE < %2' >
>
NOXTND,<
GETNM ;GET CURRENT PROGRAM NAME
CAMN A,['EXEC '] ;IS IT US?
MOVE A,PTTYMD+TTWPNM ;YES, THEN USE OLD NAME
ETYPE < %1' > ;TYPE PROGRAM NAME
MOVE A,FORK ;GET BACK FORK HANDLE
>
USEPS0: CALL FSTAT ;PRINT STATUS & PC OF INFERIOR (HANDLE IN A)
PRINT " " ;FSTAT IS IN XMAIN.MAC
USEPS2: HRROI A,-1 ;GET LOAD AVERAGES FOR CURRENT JOB
CALL GLOADS ;GET LOAD AVERAGES
ETYPE < Used %V in %C, Load %2Q
>
USEOUT: MOVE A,SAV40
MOVEM A,40
MOVE A,CIJFN0
MOVEM A,CIJFN
MOVE B,COJFN0
MOVEM B,COJFN ;RESTORE POSSIBLE BUFFERED OUTPUT
RET
;IF ^T DURING COMMAND EXECUTION, TELL USER WHAT COMMAND IS BEING
;EXECUTED.
USEPS9: MOVE B,COMAND ;GET POINTER TO COMMAND
ETYPE < %2M command >
JRST USEPS2 ;JOIN COMMON CODE
CERR: CMERRX ;catch-all command error
;ROUTINE TO HANDLE CMERRX MACRO CALL.
CMERR$: STKVAR <SAVMES>
HRROI A,@40 ;GET POINTER TO MESSAGE
MOVEM A,SAVMES ;REMEMBER IT (ECHCMD CLOBBERS 40)
CALL ECHCMD ;ECHO THE COMMAND IF WE'RE SUPPOSED TO
MOVE A,SAVMES
HRROI B,[ASCIZ / - /] ;FIRST ASSUME MESSAGE HAS TWO PARTS
SKIPN (A) ;IS CALLER SUPPLYING SPECIFIC STRING?
HRROI B,[0] ;NO, SO NO SEPARATOR NEEDED BETWEEN STRINGS
ERROR <%1M%%2M%%?> ;USER, SEPARATOR, MONITOR
;NOT IMPLEMENTED YET ERROR
;DISPATCH TO HERE AUTOMATICALLY SUPPLIED BY COMMAND TABLE ENTRY MACRO
; IF NO ROUTINE IS DEFINED FOR THE COMMAND.
NIM:
NIYE: ERROR <Not implemented yet>
;INTERNAL ERROR
SCREWUP:HRRZ Q1,(P) ;PC (GET HERE WITH PUSHJ)
SUBI Q1,1
ERROR <Internal error at %5P>
;ERROR RETURN FROM A JSYS, SYSTEM ERROR # IN 1.
;PRINTS SYSTEM MESSAGE AND GOES BACK TO COMMAND INPUT.
;MOST ERROR RETURNS WILL REQUIRE SOME SPECIAL CASE CHECKS
; BEFORE COMING TO THIS GENERAL ROUTINE.
;NOTE: ERROR NUMBER IN A IS USED INSTEAD OF -1 ARG TO "ERSTR"
; BECAUSE THIS ROUTINE IS ALSO USED WITH SUBROUTINES THAT SIMULATE
; JSYS'S. 6/26/70.
JERR: MOVEM A,ERCOD ;SAVE ERROR NUMBER
JERR1: CALL ERFRST ;GET SET TO TYPE MSG
CALL CRIF ;EOL UNLESS AT LEFT
HRRZ Q2,(P) ;PC (GOT TO JERR WITH PUSHJ)
SUBI Q2,2 ;PROBABLE LOC OF JSYS
ETYPE <JSYS error at %6P>
CALL SYSERA ;GO TYPE SYSTEM ERROR MESSAGE
JRST ERRFIN ;FINISH
JERRC: MOVEM C,ERCOD ;"JERR" FOR ERROR CODE IN C
JRST JERR1 ; (AS AFTER "NOUT")
;ROUTINES FOR USE WITH ERJMP AND ERCAL JSYS RETURNS
;GET ERROR CODE FROM SYSTEM AND STORE IN ERCOD
;THEN CALL REGULAR ERROR PRINT
JERRE:: CALL %GETER
JRST JERR1
CJERRE::CALL %GETER
JRST CJERR1
;ERROR RETURN FROM JSYS WHERE ERROR MESSAGE FROM JSYS SHOULD BE
;MEANINGFUL TO USER
CJERR:: MOVEM A,ERCOD
CJERR1: CALL ERFRST ;INIT ERROR STUFF
CALL SYSERA ;PRINT JSYS MSG ONLY
JRST ERRFIN ;FINISH
;ROUTINE TO PRINT WARNING ABOUT FAILING JSYS.
;PUT "JWARN" AFTER ANY JSYS THAT ISN'T EXPECTED TO FAIL, BUT FOR WHICH
;YOU DON'T REALLY CARE IF IT DOES, EXCEPT THAT YOU WANT THE USER TO KNOW
;WHY.
RJWARN:: ETYPE <%_%%%Unexpected error: %?%%_%%% proceeding...%_>
RET ;RETURN TO CALLER
;ERROR PSEUDO-INTERRUPT ON LEVEL 1 UUO SERVICE ROUTINE
;DEBREAK IMMEDIATELY BECAUSE IF ANOTHER TRAP WERE TO OCCUR DURING
;THIS ONE, MONITOR MIGHT HAVE TROUBLE HANDLING IT.
;THEN TYPE TEXT EFF ADDR POINTS TO, "TRAP IN EXEC",
; TYPE SYSTEM ERROR MESSAGE WITH
; REGULAR ROUTINE, AND RETURN TO COMMAND INPUT.
%TRAP: PUSH P,D
PUSH P,Q1
MOVE Q1,@40 ;GET LEVEL
CAILE Q1,0
CAILE Q1,3 ;LEGAL LEVEL?
SKIPA Q1,[0,,-1] ;NO, GIVE -1
HRRZ Q1,PCTAB(Q1) ;YES, GET PC
CALL ICLEAR ;CLEAR THIS INTERRUPT
MOVEI D,RERET ;CHANGE ERROR ROUTINE RETURN
MOVEM D,CERET ;...TO "REGULAR"
SETZM .JBUFP ;SAY FLUSH ALL JFNS
;HERE WE MUST CHECK FOR EOF IN COMMAND FILE AND HANDLE SPECIALLY.
;ALSO I'M SURE MANY OTHER EXECEPTIONAL CASES WILL TURN UP.
MOVE D,40 ;SAVE TEXT ADDRESS
CALL ERFRST ;DO THINGS NEEDED BEFORE TYPING MESSAGE
CALL CRIF ;EOL IF CARRIAGE NOT AT LEFT MARGIN
UTYPE 1(D) ;TYPE CHANNEL-SPECIFIC MESSAGE
ETYPE < internal trap at %5P>
POP P,Q1
POP P,D
PUSH P,[ERRFIN] ;WHERE TO GO AFTER ERROR MESSAGE PRINTING
PUSH P,[U$ERR] ;NO MESSAGE
JRST ERR1 ;GO FINISH ERROR PROCESSING
;NOTE: EXCEPT FOR ^O, THERE ARE NO INTERRUPTS WHICH DEBREAK TO THE POINT
;OF INTERRUPTION. HENCE WE NEEDN'T WORRY ABOUT CELLS SUCH AS "RERET"
;BEING CHANGED. BUT WE DO HAVE TO CODE ROUTINES SUCH AS "RLJFNS" TO
;WORK OK IF INTERRUPTED IN THE MIDDLE AND RESTARTED.
;PDL OVERFLOW. THIS ROUTINE MUST FIRST CLEAR THE STACK BEFORE IT
;CAN CALL ANYTHING ELSE!
PDLOV:: XCT INISTK ;CLEAR THE STACK
TRAP LV.POV,<Pushdown overflow>
;ILLEGAL INSTRUCTION PSI
;GO TO SPECIAL CASE ROUTINE ILIDSP POINTS TO, IF NON-0,ELSE
;TREAT LIKE OTHER ERROR PSI'S.
;ILIDSP USED, FOR INSTANCE, TO DETECT "LIST ACCESS NOT ALLOWED" FROM
; GTFDB JSYS.
;SPECIAL ROUTINE GETS ERROR CODE IN ERCOD.
;IF SPECIAL ROUTINE ISN'T INTERESTED IN THIS PARTICULAR ERROR,
; IT CAN JRST TO ILIPSI AGAIN.
ILIPSI: SKIPE ILIDSP ;IS THERE A SPECIAL DISPATCH?
JRST ILIDO ;YES, DO IT
STKVAR <ILCOD>
CALL DGETER ;SEE WHY FAILED
MOVEM A,ILCOD ;REMEMBER
CALL ICLEAR ;CLEAR INTERRUPT
HRRZ A,LV.ILI+PCTAB ;GET PC OF ERROR
MOVE B,ILCOD ;PRINT REASON
ERROR <Internal illegal instruction at %1O - %2?>
ILIDO: CALL ILI0 ;DO THE WORK
DEBRK ;DISMISS TO SPECIAL PLACE
ILI0: ATSAVE
MOVE A,ILIDSP ;GET WHERE TO GO
MOVEM A,LV.ILI+PCTAB ;TELL DEBRK
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH TO PROTECT
MOVEM A,41 ;IT FROM MALICIOUS USERS
SETZM ILIDSP ;CLEAR SPECIAL DISPATCH
MOVEI A,.FHSLF
GETER ;GET ERROR CODE
HRRZM B,ERCOD ;ERROR CODE, FOR SPECIAL ROUTINE
RET ;DISPATCH TO SPECIAL ROUTINE
;END-OF-FILE INTERRUPT
;DEBREAK TO SPECIAL ROUTINE "EOFDSP" POINTS AT, OR,
; IF EOFDSP ZERO, TREAT LIKE OTHER ERROR PSEUDO-INTERRUPTS.
;"EOFDSP" IS NORMALLY ZERO BUT IS SET NON-0 FOR FILE-COPYING COMMANDS.
EOFPSI: CALL SAVACS ;DON'T CLOBBER AC'S
CALL ICLEAR ;CLEAR INTERRUPT
CALL RESACS ;RESTORE AC'S
JRST EOFCHK ;HANDLE CONDITION
;CALL THE FOLLOWING ROUTINE AFTER A FAILING TEXTI. IT CHECKS THE
;ERROR CODE FOR END-OF-FILE CONDITION, HANDLING SPECIALLY. OTHER ERRORS
;ARE HANDLED STANDARDLY.
EOFJER::
CALL GETERR ;GET ERROR CODE
CAIE A,IOX4 ;END OF FILE?
CALL CJERRE ;NO, TREAT AS UNEXPECTED ERROR
POP P,(P) ;THROW AWAY THE CALL TO THIS ROUTINE
JRST EOFCHK
;ROUTINE TO HANDLE END OF FILE CONDITION.
EOFCHK: SKIPN EOFDSP
TRAP LV.EOF,<Unexpected end-of-file> ;NO SPEC DISPATCH, TREAT AS ERROR
PUSH P,EOFDSP ;PREPARE TO DISPATCH TO SPECIAL PLACE WITHOUT CLOBBERING AC'S
SETZM EOFDSP ;DON'T ALLOW FURTHER INTERRUPTS
RET ;SERVICE THE END OF FILE CONDITION
;QUOTA EXCEEDED INTERUPT
;DISPATCH ON QTADSP IF NON-ZERO, ELSE TREAT LIKE OTHER
;"PSEUDO-INTERUPTS". QTADSP IS USUALLY NON-ZERO DURING ROUTINES
;WHICH WOULD CREATE PAGES AND WISH TO HELP THE USER.
QTAPSI:: CALL SAVACS ;SAVE A REG
SKIPN QTADSP
CALL ICLEAR ;CLEAR INTERRUPTS IF NO SPECIAL DISPATCH ADDRESS
SKIPN QTADSP ;CHECK ROUTINE ADDRS
ERROR <Quota exceeded or disk full>
MOVE A,QTADSP ;GET ADDRS OF SPECIAL ROUTINE
HRRM A,PCTAB+LV.QTA ;SET UP FOR DEBRK
SETZM QTADSP ;ONLY ONCE
CALL RESACS ;RESTORE
DEBRK ;BYE
;FILE DATA ERROR INTERRUPT
;TYPES A MORE USER-ORIENTED MESSAGE THAN "TRAP" UUO.
;IF A COPY OPERATION, ETC, IS IN PROGRESS, IT GETS ABORTED AND
; FILES ARE CLOSED, SO OUTPUT FILE IS TRUNCATED.
DATPSI: CALL SAVACS ;DON'T CLOBBER AC'S
CALL ICLEAR ;CLEAR INTERRUPT
CALL RESACS
SKIPN DATDSP
JRST DATPS1 ;NO DISPATCH, TYPE ERROR MESSAGE
PUSH P,DATDSP ;SAVE SPECIAL DISPATCH ADDR FOR "RET" BELOW
SETZM DATDSP ;CLEAR SPECIAL DISPATCH
RET ;DISPATCH TO SPECIAL ROUTINE
DATPS1: MOVEI Q1,RERET
MOVEM Q1,CERET ;RESET ERROR RETURN TO "NORMAL"
SETZM .JBUFP
GTSTS ;TREAT CONTENTS OF AC1 AS A JFN, SEE IF ERROR
TXC B,GS%ERR!GS%NAM ;IF ERROR AND LEGAL JFN, BOTH BITS ARE OFF NOW
TXNE B,GS%ERR!GS%NAM ;SKIP IF JFN IS LEGAL AND IN ERROR
ERROR <File data error>
MOVE D,A ;REMEMBER JFN
DVCHR ;SEE WHAT KIND OF DEVICE WE HAVE
LOAD A,DV%TYP,B ;SEE WHAT FLAVOR DEVICE
CAIE A,.DVMTA ;DO SPECIAL MESSAGE FOR MAGTAPE
DTANOF: ERROR <File data error on file %4S>
MOVE A,D ;GET THE JFN BACK
GDSTS ;IT'S A MAGTAPE, SEE IF WE'RE AT END OF TAPE
TXNN B,MT%EOT ;ARE WE AT END OF TAPE?
JRST DTANOF ;NO
ERROR <End of tape reached on file %4S>
;CLEAR OUTPUT BUFFER PSI
;ISSUES CFOBF ON PRIMARY OUTPUT JFN
;NORMALLY INVOKED BY ^O
COBPSI: PUSH P,A
PUSH P,B
PUSH P,C
MOVE A,COJFN
RFMOD ;GET PRESENT TTY MODES
TLCE B,(1B0) ;COMPLEMENT SUPPRESS FLAG
JRST [ SFMOD ;WAS ON BEFORE, TURN IT OFF AND PROCEED
JRST COBPS1]
PUSH P,B
CFOBF ;CLEAR OUTBUF OF TTY (PRESUMABLY)
HRROI B,[ASCIZ / ^O...
/]
SETZ C,
SOUT ;NOTE WHAT HAPPENED FOR USER
POP P,B ;RECOVER TTY MODES
SFMOD ;SET OUTPUT SUPPRESS
COBPS1: POP P,C
POP P,B
POP P,A
SKIPE ADVFLG
JRST ADVCTO ;GO TO ADVISE CODE
DEBRK
;ROUTINE TO CLEAR INTERRUPT. WE TRY TO AVOID CIS JSYS, WHICH REQUIRES
;FAKING AN IPCF INTERRUPT, SINCE ^C OUT OF IPCF INTERRUPT COULD OTHERWISE
;PREVENT ANY MORE IPCF MESSAGES FROM BEING RECEIVED
;ONE OF THE GOALS OF THIS ROUTINE IS TO DO MINIMAL JSYS'S SINCE, ^C CALLS
;IT AND WANTS TO BE EFFICIENT.
ICLEAR:: MOVEI A,.FHSLF ;OURSELF
RWM ;SEE WHICH LEVELS ARE IN PROGRESS
JFFO B,IC1 ;FIGURE OUT HIGHEST LEVEL IN PROGRESS
RET ;NO LEVELS IN PROGRESS!
IC1: XMOVEI D,IC2 ;GET DUMMY PC FOR CLEARING INTERRUPT
EXCH D,PCTAB(C) ;STORE DUMMY PC, GET REAL ONE
DEBRK ;CLEAR THIS INTERRUPT LEVEL
IC2: MOVEM D,PCTAB(C) ;RESTORE REAL INTERRUPT ADDRESS IN CASE SOMEONE CARES
HLLZ B,B ;IGNORE MONITOR INTERRUPTS
LSH B,1(C) ;THROW AWAY BIT REPRESENTING LEVEL WE JUST CLEARED
CAIN B,0 ;ARE OTHER LEVELS IN PROGRESS?
RET
;...
;CODE TO FLUSH OUT THE INTERRUPT SYSTEM. THIS IS NEEDED WHEN CLEARING
;AN INTERRUPT LEVEL (SUCH AS ^C) IF OTHER LEVELS WERE IN PROGRESS, IN ORDER
;TO PREVENT ALL SUBSEQUENT CODE TO BE AT INTERRUPT LEVEL.
;WE MUST FAKE AN IPCF INTERRUPT, SINCE THE MONITOR ONLY GIVES US ONE WHEN
;THE COUNT OF MESSAGES GOES FROM 0 TO 1.
SETZM IPCCTL ;PREVENT IPCF DISPATCH
CIS ;CLEAR ALL OTHER LEVELS
MOVEI A,.FHSLF ;OURSELF
MOVX B,1B<IPCCHN>
IIC ;FAKE IPCF INTERRUPT IN CASE WE ARE RESTARTING OR BOMBING OUT OF IPCF INTERRUPT ROUTINE
RET
;SUPER-PANIC CHARACTER (CURRENTLY ^C) PSEUDO-INTERRUPT ROUTINE.
;CHANNEL 1, LEVEL 1
CCPSI: TLOE Z,CTLCF1 ;SAY WE'VE SEEN ^C
TLO Z,CTLCF2 ;IF ITS THE SECOND ONE, SAY SO
;(CTLCF2 CAUSES OUTBUF TO BE CLEARED BELOW).
SKIPN ACTRCF ;^C ALLOWED?
DEBRK ;NO
.CTRLC: SETZM ILIDSP ;CLEAR SPECIAL IL INST DISPATCH ADDRESS
SETZM CLF ;SAY NOT AT COMMAND LEVEL
CALL ICLEAR ;CLEAR INTERRUPT SO MULTIPLE ^C'S WORK
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF
MOVEM A,41 ;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41
;TO MAKE EXEC TRANSFER TO ANY CODE THEY WISH).
XTND,<
SKIPLE A,EFORK ; EPHERMERAL
FFORK ; YES - FREEZE IT
>
TLNN Z,RUNF ;PROGRAM RUNNING?
JRST [ TLO Z,CTLCF2 ;NO, ^C FROM EXEC. DO CLEAR OUTBUF
JRST CCDB3]
;*** NEED TO SET CTLCF2 HERE IFF FORK WAS IN TTY INPUT WAIT ***
TXO Z,NECHOF ;PRETEND ECHOING OFF IN CASE PROG TURNED IT OFF, IN ORDER THAT DOECHO TURN IT BACK ON
XTND,<
SKIPG A,RUNFK ; HAVE A RUNNING FORK
>
MOVE A,FORK
FFORK ;FREEZE THE WORLD
ERCAL [TYPE <% Process disappeared>
ETYPE<%_>
RET]
NOXTND,<
MOVEI Q1,PTTYMD
CALL RTTYMD ;STORE TTY MODES FOR "CONTINUE".
>
XTND,<
MOVX Q1,FK%INT ; MARK INTERRUPTED
SKIPE SLFTAB(A)
IORM Q1,SLFTAB(A)
CALL RFTYMD ; READ FORKS MODES
>
TLZ Z,RUNF ;DON'T DO TTY MODES ON 2ND ^C!
MOVEI Q1,ETTYMD
CALL LTTYMD ;SET UP OUR MODES, PROGRAM MAY HAVE CAUSED STRANGE STATE.
CCDB3: MOVE A,COJFN
TLNE Z,CTLCF2 ;2ND ^C?
CFOBF ;YES, CLEAR OUTPUT BUFFER.
;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "^C", RELEASE JFNS,
;AND GENERALLY CLEAN UP.
;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE.
SETZM ERRMF ;CLEAR "PROCESSING AN ERROR" FLAG, BECAUSE
;ANOTHER ^C WHILE PROCESSING EARLIER ONE IS OK.
MOVEI A,CCERET ;SET ERROR ROUTINE TO SPECIAL ^C VALUE
MOVEM A,CERET ;..
SETZM .JBUFP ;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND
CALL CLRIO ;CHECK AND RELEASE EXEC IO
CALL CIOER1 ;GET RID OF "TAKE" JFN
SKIPE MPENDF ;WARN IF ^C OUT OF MOUNT
ETYPE <%@[Mount request remaining in queue]
>
SETZM MPENDF ;DON'T KEEP REMINDING HIM
.$ERROR <^C> ;NO CLEAR INBUF, NO CR FIRST
;WAIT FOR OUTBUF TO EMPTY BEFORE CLEARING ^C FLAGS,
; FOR PROPER DETECTION OF 2ND ^C.
CCERET: MOVE A,COJFN
TLNN Z,CTLCF2 ;BUT DON'T WAIT IF 2ND ^C
DOBE
TLZ Z,CTLCF1+CTLCF2
JRST RERET ;GO TO STANDARD ERROR HANDLER
;TIME LIMIT EXCEEDED INTERUPT COMES HERE
TLMPSI: SETZM .JBUFP ;SAY FLUSH ALL JFN'S USED IN CURRENT COMMAND
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH (BECAUSE IF PAGE 0 IS IN PMF
MOVEM A,41 ;(WHICH IT ISN'T), MALICOUS USERS CAN PATCH 41
;TO MAKE EXEC TRANSFER TO ANY CODE THEY WISH).
TLNN Z,RUNF ;PROGRAM RUNNING?
JRST [ TLO Z,CTLCF2 ;NO, ^C FROM EXEC. DO CLEAR OUTBUF
JRST TLMPS1]
;*** NEED TO SET CTLCF2 HERE IFF FORK WAS IN TTY INPUT WAIT ***
XTND,<
SKIPG A,RUNFK ; CURRENT FORK
>
MOVE A,FORK
FFORK ;FREEZE THE WORLD
NOXTND,<
MOVEI Q1,PTTYMD
CALL RTTYMD ;STORE TTY MODES FOR "CONTINUE".
>
XTND,<
MOVX Q1,FK%INT ; MARK INTERRUPTED
SKIPE SLFTAB(A)
IORM Q1,SLFTAB(A)
CALL RFTYMD ; READ FORKS MODES
>
TLZ Z,RUNF ;DON'T DO TTY MODES ON 2ND ^C!
TLMPS1: MOVEI Q1,ETTYMD ;PUT EXEC'S TTY MODES INTO EFFECT.
CALL LTTYMD ;MUST ALWAYS BE DONE: EG GTJFN LEAVES THEM BAD.
MOVE A,COJFN
TLNE Z,CTLCF2 ;2ND ^C?
CFOBF ;YES, CLEAR OUTPUT BUFFER.
;USE REGULAR ERROR ROUTINE TO CLEAR INBUF, TYPE "^C", RELEASE JFNS,
;AND GENERALLY CLEAN UP.
;RETURNS TO FOLLOWING LOCATION BECAUSE WE SET "CERET" ABOVE.
SETZM ERRMF ;CLEAR "PROCESSING AN ERROR" FLAG, BECAUSE
;ANOTHER ^C WHILE PROCESSING EARLIER ONE IS OK.
MOVEI A,TLMRET
MOVEM A,CERET ;COME BACK HERE AFTER ERROR PRINT
ERROR <Time limit exceeded>
TLMRET: SKIPN CJPTIM ; CRJOB startup & time limit set?
JRST TLMRE1 ;AND REENTER EXEC
IFNBATCH(TLMRE1) ; If batch, allow batcon to handle
SETO A,
LGOUT
JFCL
HALTF ; Mini-exec will catch us?
TLMRE1: CALL ICLEAR ;CLEAR INTERRUPT
JRST ERRET ; Reenter EXEC
;AUTOLOGOUT PSI AND ROUTINE
;PROGRAM-GENERATED PSI ON CHANNEL 2, LEVEL 1 DISPATCHES HERE
ALOPSI: PUSH P,[[DEBRK]] ;FAKE UP RETURN
ATSAVE
GJINF ;GETS LOGIN USER # IN A
JUMPN A,R ; Login is complete, done with all this
MOVE C,TTYACF ; Get # chars typed so far
CAMN C,PTTYAC ; Same as last pass?
JRST ALOPS1 ; Yes, clobber job, it is inactive
MOVEM C,PTTYAC ; No, save current as previous
MOVE A,[.FHSLF,,.TIMEL] ; Set next time to check
MOVE B,[AUTOL3*^D1000]
MOVEI C,2 ; Channel 2
TIMER
ERROR <Couldn't set auto-logout timer - %?>
RET
ALOPS1: CIS ;ITS REAL. CLEAR PSI SYSTEM SO AUTOLOGOUT
;IS DONE NOT ON AN INTERRUPT LEVEL.
;EXEC'S MAIN FORK JSRT'S HERE,
;ALSO PSI FALLS INTO HERE, TO DO AUTOLOGOUT.
;MAKE CHECKS, TYPE MESSAGE, LOG JOB OUT.
AUTOLO: SKIPE CUSRNO ;SKIP IF NOT LOGGED IN
ERROR <Autologout screwup>
GJINF ;GETS CONTROLLING TTY # IN 4
CAMN D,[-1] ;-1 IF NONE (DETACHED)
JRST AUTOL6 ;DETACHED, TYPING MESSAGE WOULD HANG UP JOB.
;CAN BE DETACHED IF DATAPHONE HUNG UP AND CARRIER-OFF PSI
;ISN'T FULLY PROCESSED, OR IF ATACH HAS SOMEHOW FAILED TO
;COMPLETE.
MOVE A,COJFN
CFOBF ;CLEAR POSSIBLE ^S
TYPE <
Autologout
>
MOVE A,COJFN
DOBE ;MAKE SURE IT ALL TYPES (NEEDED?)
AUTOL6: SETO A, ;SAY SELF
LGOUT ;LOG JOB OUT
CALL JERR ;SHOULDN'T BE ABLE TO HAPPEN.
;ERROR UUO HANDLER. MESSAGE TEXT AT EFFECTIVE ADDRESS.
;SERVICES UUO'S UERR, U$ERR, U.$ERR (MACROS ERROR, $ERROR AND .$ERROR)
;USE "LERROR <TEXT>" TO PRINT ERROR MESSAGE AND RETURN. SAME AS
;"ERROR <TEXT>" EXCEPT LATTER DOESN'T RETURN TO CALLER.
%LERRO: TLZ Z,F1 ;LOCAL ERROR HANDLER, RETURNS TO CALLER
CALL ERRX ;PRINT ERROR MESSAGE
SETZM ERRMF ;CLEAR FLAG TO SAY ERROR IS OVER
RET ;RETURN
%ERR: %$ERR: TLZ Z,F1
CAIA
%.$ERR: TLO Z,F1 ;SAY DON'T CLEAR INBUF (ERFRS1)
CALL ERRX ;PRINT ERROR MESSAGE
JRST ERRFIN ;FINISH ERROR HANDLING
;MAIN WORK ROUTINE FOR ERROR MESSAGES. HANDLES CLEARING OF TYPEAHEAD,
;TYPING "?" IN FRONT OF MESSAGES, ETC.
ERRX: PUSH P,40 ;TEXT ADDRESS AND UUO VALUE
CALL ERFRS1 ;DO WHAT MUST BE DONE BEFORE TYPING ERROR MSG
JRST ERR1
;ENTER HERE TO TYPE SYSTEM ERROR MESSAGE FOR ERROR # IN "ERCOD"
;MUST HAVE ALREADY CALLED "ERFRST"
SYSERA: PUSH P,[-2]
ERR1: PUSH P,A ;AC'S MUST BE SAVED FOR ETYPE OR ERSTR
;TYPE MESSAGE: CR FIRST UNLESS ALREADY AT LEFT, THEN "?" (ALWAYS),
;THEN TEXT, THEN CR.
;BUT NO INITIAL CR-SPACE IF "U$ERR" UUO.
HLRZ A,-1(P) ;-1 FOR SYSTEM MSG, OR UUO FOR EXEC MSG
CAIE A,<U.$ERR>B53
CAIN A,<U$ERR>B53
JRST ERR5 ;NO CR-SPACE FOR U$ERR UUO ($ERROR MACRO)
CALL CRIF ;TYPE EOL IF NOT ALREADY AT LEFT
ERR5: MOVE A,-1(P) ;0, -1, -2, OR UUO-TEXT ADDRESS
TRNN A,-1
JRST ERR7 ;0 RH MEANS NO TEXT
JUMPGE A,ERR5A ;POSITIVE: USE TEXT A POINTS TO
CAME A,[-1] ;-1 MEANS LATEST ERROR FROM SYSTEM
JRST ERR5C
XTND,<
SKIPG A,EFORK ; USE EPHEMERAL IF PRESENT
>
MOVEI A,.FHSLF ;GET ERROR # FROM SYSTEM NOW FOR
GETER ; LATER USE IN MSG
ERR5C: HRLI B,.FHSLF ;FORK: SELF
CAMN A,[-2]
HRR B,ERCOD ;-2 SAYS USE SYSTEM ERR # FROM "ERCOD"
HRRZ C,B ;GET ERROR CODE
CAIE C,GJFX3 ;NO JFNS?
CAIN C,GJFX22 ;OR JSB FULL?
JRST [ TYPE <Can't create another JFN for this job --
Try releasing some with "CLOSE" command>
JRST ERR6] ;SPECIAL CASE BECAUSE ERSTR WILL FAIL HERE
ETYPE <%3?> ;Type error message
JRST ERR6 ;DONE.
ERR5A: MOVE A,(P) ;VALUE THAT CAME IN A MIGHT BE USED BY ETYPE
UETYPE @-1(P) ;TYPE MESSAGE FROM CORE
ERR6: ETYPE<%_>
TLNE Z,LOGOFF
TYPE < Not logged off
> ;ERROR DURING LOGOUT, LIKELY AFTER "LOGGED OFF" MESSAGE
;ERROR UUOS AND SYSERM...
;MESSAGE ALL TYPED.
ERR7: TLNN Z,F1 ;DON'T CLEAR INBUF FOR RUBOUT, ^X (.$ERROR)
SKIPN CIDLYF ;REQUESTING DELAYED CFIBF?
JRST ERR7A ;NO
MOVE A,CIJFN
DOBE
CFIBF ;CLEAR FILE INPUT BUFFER
ERR7A: CALL DOECHO ;MAKE SURE ECHOING IS ON
POP P,B
POP P,A
RET ;RETURN TO CALLER
;GET HERE IF ERROR IS FATAL, AND NO RETURN TO CALLER IS TO BE DONE.
;RESETTING OF VARIOUS THINGS DONE HERE...
ERRFIN::SETZM IPCCTL ;CLEAR SPECIAL IPCF INTERRUPT DISPATCH
NOXTND,<
SETZ A,
EXCH A,EFORK
CAIE A,0
KFORK ;KILL SPECIAL EXEC FORK IF ANY
>
XTND,<
SKIPLE A,EFORK ; SPECIAL FORK?
KFORK ; YES - KILL IT
SETOM EFORK ; NO MORE
>
BTCHER ;SHOULD STOP NON-CONVERSATIONAL JOB
ADJSP P,-1 ; FORGET UUO
;RESTORE EARLIER (LESS FULL) PUSHDOWN LEVEL IF LEVEL
;WAS SAVED . THIS IS GENERALLY USED DURING SUBCOMMAND
;INPUT.
SKIPE .P ;DON'T RESET P IF NEVER SAVED!
MOVE P,.P ;RESTORE P TO AS IT WAS BEFORE COMMAND
SETZM ERRMF ;NO LONGER PROCESSING AN ERROR
JRST @CERET ;VARIABLE ERROR RETURN, GOES SPECIAL PLACES
;DURING SUB-COMMAND INPUT AS FOR "DIRECTORY" CMD
;REGULAR ERROR RETURN - CERET USUALLY POINTS HERE
RERET: CALL UNMAP ;UNMAP SPECIAL PAGES (BEFORE FLJFNS TO PREVENT CLOSF FAILURE)
SKIPN OKERR ;ERRORS ALRIGHT DURING TAKE?
CALL UNTAKE ;NO, END TAKE FILE
SETZM .JBUFP ;FLUSH ALL JFNS
CALL FLJFNS ;RELEASE JFNS FLUSHING OUTPUT FILES
MOVE A,[CZ%NIF+CZ%NCL+.FHSLF]
SKIPE CLZFFF ;DO CLZFF IF POSSIBLE LOST JFN
CLZFF ;RELEASE ANY UNOPEN JFNS
JRST ERRET ;GO BACK TO COMMAND INPUT
;ROUTINE TO UNMAP SPECIAL PAGES, SAVES SWAPPING SPACE.
UNMAP:: SETO A, ;PAGE OF INFERIOR FORK
CALL MAPPF
JFCL ;Unmap should never fail
SETO A,
MOVE B,[XWD .FHSLF,<FREE>B44] ;CLEAR PAGES 740-767 WHICH INCLUDES
MOVE C,[PM%CNT+<BUFL-FREE>B44+1] ; BUF1, BUF2, DIRECTORY
PMAP
CALL FREINI ;Fix free storage database
RET
;SUBROUTINE TO CALL BEFORE TYPING ANY ERROR MESSAGE TEXT
; OR EXECUTING ANY JSYS'S. MUST BE CALLED ONLY ONCE PER ERROR.
ERFRST: TLZ Z,F1 ;NORMAL ENTRY
ERFRS1: ;ENTER HERE TO NOT CLEAR INBUF IF F1 ON
SAVEAC <A,B,C,D> ;AC'S MAY HAVE DATA FOR MESSAGE PRINTOUT
CALL %GETER ;GET ERROR CODE IN CASE "%?"
CALL FIXIO ;MAKE SURE ERROR SEEN IN "REAL" OUTPUT STREAM
CALL SETT20 ;SAY TOPS20 LEVEL NOW
SKIPN CINITF ;IS EXEX INITIALIZED?
JRST [ MOVEI 1,.PRIOU ;NO, ASSUME COJFN, ETC. NOT SETUP
HRLOI 2,.FHSLF
SETZ 3,
ERSTR ;BUT TRY TO GET OUT ERROR MSG
JFCL
JFCL
HRROI 1,[ASCIZ /
?TOPS-20 command processor not properly initialized.
/]
PSOUT
HALTF]
MOVE A,[CALL CUUO] ;RESET UUO DISPATCH, BECAUSE OTHERWISE
MOVEM A,41 ;MALICIOUS USERS CAN MAKE EXEC TRANSFER
;TO ANY CODE THEY WISH BY PATCHING PAGE 0 OF PMF
MOVE A,COJFN
DOBE ;WAIT IN CASE USER ^O'S SOME OTHER TYPEOUT
RFMOD ;GET TTY MODES
TLZE B,(1B0) ;CLEAR OUTPUT SUPPRESS IF IT WAS ON
SFMOD
SKIPE ERRMF ;DID THIS ERROR OCCUR WHILE PROCESSING ANOTHER?
JRST [ CALL UNTAKE ;IF MULTIPLE ERROR, ALWAYS END TAKE FILE
UTYPE [ASCIZ /
?Error within an error
/] ;YES, GIVE UP
JRST ERRET]
SKIPN OKERR ;ERRORS OK DURING TAKE?
CALL UNTAKE ;NO SO END TAKE FILE
SETOM ERRMF ;SAY PROCESSING AN ERROR
TLNN Z,F1 ;DON'T CLEAR INBUF FOR ^U
SKIPE CIDLYF ;REQUESTING DELAYED CFIBF?
RET ;YES, DON'T DO IT NOW
MOVE A,CIJFN
CFIBF
RET
;ROUTINE TO RESTORE CIJFN/COJFN TO THEIR CORRECT VALUE. THIS IS DONE
;TO UNDO POSSIBLE MEDDLING WITH CI/COJFN BY CERTAIN COMMANDS THAT MAY DIVERT
;OUTPUT TEMPORARILY TO A STRING.
FIXIO:: MOVE A,IOPT ;GET POINTER TO CURRENT LEVEL
HLR B,(A) ;GET CIJFN VALUE
HRRZM B,CIJFN ;RESTORE INPUT STREAM
HRR B,(A) ;GET COJFN VALUE
HRRZM B,COJFN ;RESTORE OUTPUT STREAM
RET
;ROUTINE TO FINISH TAKE FILE BECAUSE THERE IS A FATAL ERROR WHILE
;PROCESSING IT.
UNTAKE: CALL CIOREL ;END TAKE FILE
CALL CIOER ;THERE WAS ONE, SO SAY WHICH ONE WAS ENDED
RET
;ROUTINE TO GET RID OF "TAKE" JFN WHEN ERROR FROM WITHIN IT.
CIOER1: SKIPA D,[[ASCIZ /%% ^C while reading %1M, file aborted.
/]]
CIOER: MOVEI D,[ASCIZ /%% Error while reading %1M, file aborted.
/]
STKVAR <<CSIBUF,EXTSIZ>>
MOVE B,A ;JFN
HRROI A,CSIBUF ;SPACE TO STORE STRING
MOVEI C,0 ;NO SPECIAL FLAGS
JFNS ;GET FILENAME
MOVE A,B ;PUT JFN BACK INTO A
CLOSF ;CLOSE TAKE FILE BEFORE PRINTING MESSAGE BECAUSE ERROR MIGHT BE IN TAKE FILE ITSELF!
CALL JERR ;SHOULDN'T FAIL
HRROI A,CSIBUF ;GET POINTER TO FILENAME
UETYPE @D ;PRINT ERROR MESSAGE
RET
;BEGIN ERROR MESSAGE LINE. DO CRLF IF NOT ALREADY AT LEFT MARGIN,
;THEN PRINT "?"
CRIF:: ATSAVE
CALL LM ;GET TO LEFT MARGIN
PRINT "?"
RET
;ROUTINE TO GET TO LEFT MARGIN
LM:: MOVE A,COJFN
RFPOS ;READ FILE POSITION
TRNE B,-1 ;LINE POSITION 0?
ETYPE<%_> ;NO, DO CRLF
RET
%MESS:: ATSAVE
CALL LM
PRINT "%"
RET
;ROUTINE TO GET LAST MONITOR ERROR CODE, RETURNS IT IN A.
GETERR: CALL %GETER
MOVE A,ERCOD
RET
;SUBROUTINE TO OBTAIN LAST JSYS ERROR IN A.
DGETER:: MOVEI A,.FHSLF ;OURSELF
GETER ;GET LAST ERROR
HRRZ A,B ;RETURN ERROR IN A
RET
;SUBROUTINE TO DO "GETER" JSYS FOR EXEC AND STORE
;CODE IN "ERCOD"
%GETER::PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,.FHSLF
GETER
HRRZM B,ERCOD
POP P,C
POP P,B
POP P,A
RET
;DOGET DOES THE GET JSYS.
;
;ACCEPTS: AC'S/ WHATEVER GET JSYS WANTS
;
;RETURNS: AC'S/ WHATEVER GET RETURNS
; +1 ERROR
; +2 SUCCESS, FAME AND FORTUNE
;
;This routine makes sure the jfn being used by the GET jsys is NOT on the
;exec's jfn stack before the GET jsys. This is necessary to ensure that
;the exec won't attempt to close the jfn later, when it may already be
;associated with another filespec being used by some random fork in the job.
;Normally, the monitor GET code will close the jfn appropariately at the end
;of the GET jsys, so there's no need for the exec to try to close it anyway.
DOGET:: STKVAR <<GETARG,3>>
DMOVEM A,GETARG ;REMEMBER GET ARGUMENTS
MOVEM C,2+GETARG
LOAD A,GT%JFN,A ;ISOLATE THE JFN
MOVE B,JBUFP ;GET POINTER TO CURRENT SAVED JFNS
DG1: CAMN B,[IOWD JBUFL,JBUF];HAVE WE SCANNED ENTIRE LIST?
JRST DG2 ;YES, JFN WAS NEVER STACKED
HRRZ C,(B) ;NO, EXAMINE NEXT JFN ON STACK
ADJSP B,-1 ;STEP BACK TO NEXT SLOT
CAME C,A ;HAVE WE FOUND THE CORRECT ONE YET?
JRST DG1 ;NO, KEEP LOOKING.
SETZM 1(B) ;YES, CLEAR THIS ENTRY SO EXEC DOESN'T TRY TO CLOSE IT
DG2: DMOVE A,GETARG ;NOW DO THE GET JSYS
MOVE C,2+GETARG
GET
ERJMP R ;NON-SKIP ON FAILURE
RETSKP ;SKIP IF GOOD.
;RELEASE JFNS USED BY COMMAND BEING DECODED OR EXECUTED --
; USED AFTER ERRORS (%ERR) AND BY COMMAND EXECUTION ROUTINES.
;CLOSES AND RELEASES JFNS STACKED IN JBUF.
;EXCEPT DOESN'T GO BELOW CONTENTS OF ".JBUFP", WHICH IS NORMALLY 0
; BUT IS SET TO PRESERVE ASSIGNED JFN'S THRU ERRORS THAT RETURN
; TO A SUBCOMMAND INPUT LOOP.
FLJFNS: ATSAVE
LDF D,CZ%ABT ;ABORT OUTPUT FILES
JRST RJFNS0
RLJFNS: ATSAVE
SETZ D, ;BITS TO INCLUDE IN CLOSF
RJFNS0: MOVE C,JBUFP ;SCAN JFN BUFFER
CAMLE C,[IOWD JBUFL,JBUF] ;STOP AT BOTTOM OF STACK,
CAMN C,.JBUFP ;OR AT SAVED POINTER LEVEL
RET
CALL RJFN ;DELETE ONE JFN
JRST RJFNS0
;ROUTINE TO GET RID OF TOP JFN ON STACK. COMMANDS THAT WANT TO GET
;RID OF A STACKED JFN SHOULD CALL THIS ROUTINE (RJFN).
RJFN:: MOVE C,JBUFP ;GET POINTER TO STACK
CALL RJFNS2
ADJSP C,-1 ;DECREMENT POINTER
MOVEM C,JBUFP
RET
;PROCESS ONE WORD OF JBUF
RJFNS2: HRRZ A,(C) ;GET A JFN TO CONSIDER
JUMPE A,R ;RETURN IF 0
CAIN A,FI%ERR ;BUFFERED ERROR?
JRST [ HLRZ A,(C) ;YES, GET ADDRESS OF ERROR BLOCK
HRRZ A,.FIJFN(A);GET PARSE-ONLY JFN
JRST .+1]
CALL SKPJFN ;SKIP IF THIS IS A JFN
JRST RJFNS9 ;IT'S A FORK
CAIE A,.PRIIN
CAIN A,.PRIOU
JRST RJFNS8
CALL NOTIO ;MAKE SURE JFN ISN'T AN IO JFN
JRST RJFNS8 ;IT IS!
GTSTS ;GET ITS STATUS
TXNN B,GS%NAM ;JFN EVEN EXIST?
JRST RJFNS8 ;INVALID, FORGET IT
HRRZ A,A ;PREPARE FOR RLJFN/CLOSF
TXNN B,GS%OPN ;IS IT OPEN?
JRST [ RLJFN ;NO, RELEASE IT
JRST RJFNE ;FAILED, GO ANALYZE
JRST RJFNS8] ;SUCCEEDED
HLL A,D ;GET BITS FOR CLOSF
CLOSF ;YES, CLOSE AND RELEASE
RJFNE: CALL RJFNER ;ANALYSE ERROR RETURN
;DONE WITH THIS WORD
RJFNS8: SETZM (C) ;ZERO JBUF WORD
RET
;LARGE JFNS ARE ASSUMED TO BE FORK HANDLES
RJFNS9: CAMN A,FORK ;ARE WE KILLING MAIN FORK?
SETOM FORK ;YES, SO SAY FORK IS GONE
KFORK ;KILL THE FORK
ERJMP RJFNS8
JRST RJFNS8 ;CONTINUE
;ROUTINE TO SKIP IF WE'VE GOT A JFN
;
;ACCEPTS: A/ ANIMAL
;
;RETURNS: +1: ANIMAL IS NOT A JFN
; +2: ANIMAL IS A JFN
SKPJFN: CAIL A,MAXJFN ;1000 IS MAX FOR NOW
RET ;TOO LARGE, NOT A JFN
RETSKP
;ROUTINE WHICH SKIPS IFF JFN IN A IS NOT AN EXEC COMMAND JFN. CLOBBERS
;NOTHING
NOTIO:: ATSAVE ;DON'T CLOBBER ANY AC'S
MOVE B,IOPTB ;GET POINTER TO COMMAND JFN STACK
RJFNSA: CAMN B,IOPT ;HAVE WE SEARCHED ENTIRE STACK YET?
JRST RJFNSB ;YES
ADJSP B,1 ;NO, STEP TO NEXT SET OF JFNS
HRRZ D,(B) ;GET OUTPUT JFN
CAMN A,D ;DOES JFN IN QUESTION MATCH A COMMAND OUTPUT JFN?
RET ;YES
HLRZ D,(B) ;NO, CHECK INPUT
CAMN A,D ;DOES JFN MATCH AN INPUT JFN?
RET ;YES
JRST RJFNSA ;NO, KEEP LOOKING
RJFNSB: RETSKP ;JFN DOESN'T MATCH ANYTHING
;ROUTINE TO DETERMINE IF ERROR FROM CLOSF IS OK
;OR CAN BE HANDLED
RJFNER: CAIE A,DESX3 ;YOU CAN GET "JFN IS NOT ASSIGNED" AFTER
;A LOWER EXEC HAS POPED BACK TO US, WHICH
;WE STARTED WITH A PUSH
;THIS IS BECAUSE WE STACKED THE JFN OF THAT
;EXEC, BUT MONITOR CLOSED THAT JFN DURING THE
;GET, AND THEN THE JFN GOT REUSED FOR A PROGRAM
;UNDER THE NEW EXEC. SO THE GTSTS CAN SAY THERE IS
;STILL A NAME ASSOCIATED WITH IT, ALTHOUGH IT
;IS BEING DELETED DUE TO
;THE KFORK IN THE PUSH CODE.
;...NOT TO MENTION THE FACT THAT THE JFN GOT
;REUSED AS A RESTRICTED JFN, WHICH WILL ALSO
;CAUSE DESX3. (ACTUALLY, MONITOR SHOULD BE
;FIXED TO GIVE A SPECIAL ERROR IN THAT CASE)
CAIN A,CLSX3 ;IGNORE PAGE STILL MAPPED
RET
CAIE A,CLSX4 ;DEVICE STILL ACTIVE REQUIRES WORK
JRST [ HRRZ A,(C) ;GET JFN AGAIN
GTSTS ;GET INFO FOR DIAGNOSTIC
ETYPE <%%Couldn't close JFN %1O, status %2o - %?%%_>
RET] ;MUSTN'T BOMB COMPLETELY, lest we loop
TYPE <% Device active - wait...>
MOVEI B,^D20 ;# OF HALF SECONDS
RJFNR1: MOVEI A,^D500 ;MS TO SLEEP
DISMS ;ZZZZZ
HRRZ A,0(C) ;GET JFN BACK
HLL A,D ;BITS TO SET
CLOSF ;TRY AGAIN
JRST RJFNR2 ;MORE PROCESSING TO COME
TYPE < [OK]
>
RET
RJFNR2: CAILE B,1 ;GIVE UP IF TRIED MANY TIMES
CAIE A,CLSX4 ;CHECK SAME LOSAGE
JRST [ HRRZ A,(C) ;GET JFN AGAIN
GTSTS ;GET INFO FOR DIAGNOSTIC
ETYPE <%%%Couldn't close JFN %1O, status %2o - %?%%_>
RET] ;MUSTN'T BOMB COMPLETELY, lest we loop
SOJA B,RJFNR1 ;TRY AGAIN
;ROUTINE TO STACK JFNS OR FORK, CHECKS FOR SPACE FIRST
JFNSTK:: MOVE B,A ;JFN IN B
HLRZ A,JBUFP
CAIN A,-1
ERROR <Too many JFNs in command>
MOVE A,JBUFP
PUSH A,B ;STACK JFN
MOVEM A,JBUFP
HRRZ A,B ;GET RID OF FLAGS
CALL SKPJFN ;IS THIS REALLY A JFN?
CAIA ;NO
MOVE A,B ;RETURN JFN OR FORK IN A
RET
;ROUTINE TO DO GTJFN AND STACK THE JFN. THIS SHOULD BE USED WHEREVER
;A JFN IS NEEDED DURING COMMAND EXECUTION, IN ORDER THAT THE JFN BE
;GUARANTEED TO BE FREED IF THE USER ^C'S OUT OF THE COMMAND.
;THIS ROUTINE SKIPS AND CLOBBERS 1 AND 2 EXACTLY AS GTJFN DOES, EXCEPT
;THAT ERJMP AFTER THE CALL TO THIS ROUTINE WILL NOT WORK (USE JRST).
;(IF YOU FIND PLACES WHERE THE EXEC DOES GTJFN FOLLOWED BY A CALL TO
;JFNSTK, YOU SHOULD CHANGE THEM TO CALL GTJFS INSTEAD)
GTJFS:: STKVAR <<GTDATA,2>>
DMOVEM A,GTDATA ;SAVE THE GTJFN DATA
AOS CLZFFF ;IF ^C BEFORE JFN STACKED, CAUSE CLZFF
GTJFN ;DO THE GTJFN
ERJMP GTFAIL ;FAILED
DMOVEM A,GTDATA ;SAVE RESULTANT DATA
CALL JFNSTK ;STACK THE JFN
SOS CLZFFF ;CLZFF NO LONGER NEEDED SINCE JFN IS STACKED
DMOVE A,GTDATA ;GET WHAT GTJFN RETURNED
RETSKP ;SAY SUCCESS
GTFAIL: DMOVEM A,GTDATA ;SAVE WHAT FAILING GTJFN RETURNED
SOS CLZFFF ;GTJFN FAILED, CLZFF NOT NEEDED
DMOVE A,GTDATA ;GET WHAT GTJFN SAID (ABOUT FAILURE)
RET ;ERROR RETURN
;ROUTINE TO PRINT JOBS ACCOUNTING STRING (OR NUMBER)
PRACCT:: STKVAR <<ACCBUF,EXTSIZ>>
HRROI B,ACCBUF ;POINT TO ACCOUNT BUFFER
MOVNI A,1 ;-1 FOR SELF
GACCT ;GET IT
LDB A,[410300,,B] ;GET SIG. OCTAL DIGIT
CAIE A,5 ;5 MEANS NUMBER INSTEAD OF STRING
JRST [HRROI A,ACCBUF ;POINT TO STRING
ETYPE <%1M> ;DUMP IT
JRST PRACC1]
TLZ B,500000 ;GET RID OF CONTROL BITS
ETYPE <%2Q> ;DECIMAL
PRACC1: RET ;RETURN
;UTILITY ROUTINES FOR IPCF FACILITY
;GET PID FOR EXEC AND INIT PDB'S
;RETURNS PID IN A
GETPID: SKIPE A,MYPID ;HAVE ONE ALREADY?
RET ;YES - RETURN
STKVAR <<GUTIL,3>>
MOVE A,[1000,,<IPCFP>B44]
MOVEM A,SNDPDB+.IPCFP ;PAGE TO USE FOR IPCF SEND
MOVEI A,.MUCRE ;FCN TO CREATE A PID
MOVEM A,GUTIL ;STASH IN BLOCK
LDF A,IP%NOA+.FHSLF ;MINE ONLY
MOVEM A,1+GUTIL
MOVEI A,3 ;SIZE OF BLOCK
MOVEI B,GUTIL ;LOC OF BLOCK
MUTIL ;GET PID
CALL CJERR ;OOPS
MOVE A,2+GUTIL ;RETURNS PID HERE
MOVEM A,MYPID ;STORE OF LATER
MOVEI A,.MUPIC ;WE WANT TO PUT PID ON INTERRUPT CHANNEL
MOVE B,MYPID ;OUR PID
DMOVEM A,GUTIL ;SET UP ARGS FOR MUTIL
MOVEI A,IPCCHN ;CHANNEL ON WHICH TO GET INTERRUPTS
MOVEM A,2+GUTIL
MOVEI A,3 ;LENGTH OF ARG BLOCK
MOVEI B,GUTIL ;ADDRESS OF ARG BLOCK
MUTIL ;POST INTERRUPT REQUEST
ERCAL JERR ;SHOULDN'T FAIL
RET ;RETURN
;ROUTINE TO SEND REQUEST TO QUASAR AND HANDLE ACKNOWLEDGEMENT
;IT RETURNS UNIQUE ID FOR IDENTIFYING RESPONSES
QUASND:: STKVAR <SAVQCX>
AOS A,UNIQUE ;GET AN IDENTIFICATION NUMBER
MOVEM A,IPCFP+.MSCOD
MOVEM A,SAVQCX ;REMEMBER IT
MOVEI A,1 ;SAY WE WANT AN ACKNOWLEDGEMENT
STOR A,MF.ACK,.MSFLG+IPCFP
CALL GQPID ;GET QUASAR'S PID
MOVE B,A
CALL SNDMS1 ;SEND THE REQUEST
CALL CJERR ;FAILED, TELL USER WHY
PRITXT: MOVE B,SAVQCX ;MATCH CODE WITH MESSAGE COMING BACK
MOVE A,QSRPID ;RECEIVE FROM QUASAR
CALL IPCRCV ;GET ANSWER
HRROI B,IPCFP+.OHDRS+ARG.DA ;GET POINTER TO MESSAGE
MOVE A,IPCFP+.MSFLG ;GET MESSAGE CONTROL BITS
TXNE A,MF.NOM ;ANY MESSAGE?
JRST PRI2 ;NO, SO WE MIGHT BE DONE
TXNN A,MF.FAT+MF.WRN ;NOT WARNING OR FATAL ERROR?
JRST PRIT1 ;RIGHT, SO JUST PRINT INFORMATIONAL MESSAGE
TXNE A,MF.FAT ;FATAL?
UERR (B) ;RIGHT, SO PRINT MESSAGE AS AN ERROR AND DON'T RETURN
UETYPE [ASCIZ /%%%2M%%_/] ;WARNING MESSAGE, PRINT AS SUCH
PRI2: TXNE A,MF.MOR ;MORE?
JRST PRITXT ;YES GO GET IT
MOVE A,SAVQCX ;RETURN ID IN A
RET ;NO, WE'RE DONE
PRIT1: UETYPE [ASCIZ /[%2M]%_/]
JRST PRI2
;GET PID OF INFO
;STORES IT IN INFPID AND A. ASSUMES THAT NON-ZERO INFPID IS GOOD PID.
GIPID: SKIPE A,INFPID ;ALREADY EXIST?
RET ;YES, WE'RE DONE
MOVEI A,.SPINF ;SAY WE WANT INFO'S PID
CALL GSPID ;GET PID OF INFO
CALL JERRE ;NO ERROR HANDLER (YET!)
MOVEM A,INFPID ;REMEMBER IT
RET
;GET PID OF MDA (MOBY DEVICE ANIMAL)
GMDPID: SKIPE A,MDAPID ;GOT IT ALREADY?
RET ;YES
MOVEI A,.SPMDA ;SAY WE WANT MDA'S PID
CALL GSPID ;GET SPECIAL PID
CALL JERRE ;FAILED
MOVEM A,MDAPID ;REMEMBER IT SO NO GYRATIONS NEXT TIME THROUGH
RET
;GET PID OF QUASAR
GQPID:: SKIPE A,QSRPID ;ALREADY HAVE ONE?
RET ;YES, DONE
CALL GQPID1 ;TRY TO GET PID
JRST GQPID2 ;FAILED, PRINT MESSAGE AND TRY AGAIN
RET ;GOT IT, RETURN
GQPID2: TYPE <%Waiting for QUASAR to start...
>
GQPID3: MOVEI A,^D3000 ;SLEEP FOR 3 SECONDS AND TRY AGAIN
DISMS
CALL GQPID1 ;TRY AGAIN
JRST GQPID3 ;DIDN'T GET IT YET
RET ;GOT IT
GQPID1: MOVEI A,.SPQSR ;SAY WE WANT QUASAR'S PID
CALL GSPID ;GET SPECIAL PID
RET ;FAILED
MOVEM A,QSRPID ;GOT IT
RETSKP
;ROUTINE TO GET A SPECIAL PID. CALL IT WITH FUNCTION IN A. SKIPS WITH PID IN A.
;NON-SKIP MEANS ERROR IN AC1.
GSPID: STKVAR <SPID,<QUTILB,3>>
MOVEM A,SPID ;REMEMBER SPECIAL FUNCTION
MOVEI A,3 ;LENGTH OF ARGUMENT BLOCK
MOVEI B,QUTILB ;ADDRESS OF ARG BLOCK
MOVEI C,.MURSP ;DESIRED FUNCTION (GET PID FROM SYSTEM PID TABLE)
MOVEM C,QUTILB ;STORE FUNCTION
MOVE C,SPID ;GET SPECIAL FUNCTION
MOVEM C,1+QUTILB ;STORE INDEX WE WANT
MUTIL ;GET DESIRED PID
RET ;FAILED, SINGLE RETURN
MOVE A,2+QUTILB ;GOT PID
RETSKP
;ROUTINE TO DO RECIEVE (PACKET AND PAGE MODE)
;THIS ROUTINE TAKES THE PID IN A WHOSE MESSAGE YOU WANT TO RECEIVE. IT
;RETURNS THE MESSAGE IN IPCFP AND THE FLAGS, AS RECEIVED IN .IPCFL, IN A.
;IF A IS QUASAR'S PID (AS ADVERTISED BY QSRPID), B CONTAINS THE IDENTIFICATION
;NUMBER YOU ARE RECEIVING.
IPCRCV:: TRVAR <SAVIFG,MESIDN,QUAIDN,SAVIPP> ;MUST NOT BE STKVAR DUE TO SAVIPP
MOVEM A,MESIDN ;REMEMBER IDENTIFIER OF MESSAGE
MOVEM B,QUAIDN ;REMEMBER IDENTIFIER FOR QUASAR MESSAGE
MOVEM P,SAVIPP ;REMEMBER STACK IN CASE NOTRANSPARENT INTERRUPT OUT OF SUBROUTINE
IPCAGN: MOVE P,SAVIPP ;IN CASE INTERRUPTED OUT OF SUBROUTINE
CALL IPCOFF ;PREVENT NEW MESSAGES WHILE WE'RE PERUSING
MOVE A,MESIDN ;GET IDENTIFYING INFORMATION
MOVE B,QUAIDN
CALL IPCFND ;FIND THE MESSAGE IN THE QUEUE
JRST NOMESS ;IT'S NOT THERE
MOVE C,IPCFGS(B) ;GET FLAGS THAT GO WITH MESSAGE
MOVEM C,SAVIFG ;REMEMBER FLAGS
MOVEI A,IPCBPN(B) ;GET PAGE NUMBER OF MESSAGE
LSH A,9+22 ;9 TO MAKE ADDRESS, 22 TO PUT IT IN LEFT HALF
HRRI A,IPCFP ;BLT POINTER TO MOVE MESSAGE TO IPCFP
BLT A,IPCFP+777 ;MOVE ENTIRE MESSAGE
MOVE A,B ;SAY WHICH MESSAGE TO FLUSH
CALL IPCFLS ;FLUSH MESSAGE FROM BUFFER
CALL IPCON ;TURN COM CHANNEL BACK ON
MOVE A,SAVIFG ;GIVE CALLER THE FLAGS
RET ;DONE
;HERE WITH IPCF QUEUE INDEX TO FLUSH A MESSAGE FROM THE QUEUE. THIS IS DONE,
;FOR INSTANCE, IF THE MESSAGE IS ONE WE'VE BEEN WAITING FOR AND HAVE JUST
;RECEIVED, OR THE MESSAGE IS ONE WE'VE DECIDED WE NEVER WANT.
IPCFLS: HRRI B,IPCBPN(A) ;GET PAGE NUMBER OF PAGE BEING ERASED
SETZM IPCTBL(A) ;CLEAR THE SLOT
HRROI A,-1 ;PREPARE TO REMOVE PAGE FROM OUR MAP
HRLI B,.FHSLF ;REMOVE FROM OURSELF
MOVEI C,0 ;NO REPETITION COUNT
PMAP ;REMOVE PAGE
RET
;HERE IF MESSAGE WE WERE LOOKING FOR ISN'T RECEIVED YET
NOMESS: MOVEI A,IPCAGN ;ADDRESS TO GO BACK TO NEXT TIME A MESSAGE COMES IN
MOVEM A,IPCCTL ;SET UP CONTROL WORD SAYING WHERE TO GO WHEN NEXT MESSAGE RECEIVED
CALL IPCON ;TURN ON INTERRUPTS AGAIN
WAIT ;WAIT FOR A COM INTERRUPT (WHICH WILL GO TO IPCAGN)
;ROUTINE TO SKIP IF A SOUGHT MESSAGE HAS ARRIVED. HAND IT IN REGISTER
;A THE PID FROM WHOM YOU WANT A MESSAGE. IF THE PID IS QUASAR'S, SUPPLY
;THE .MSCOD IN REGISTER B. IF YOU GIVE QUASAR'S PID, THIS ROUTINE WILL MATCH
;A MESSAGE FROM EITHER QUASAR OR MDA.
;WHEN SKIPS, A CONTAINS ADDRESS OF MESSAGE
;ALSO ON SKIP, B CONTAINS BUFFER SLOT NUMBER OF MESSAGE.
;THIS ROUTINE IS CAREFUL TO DELIVER OLDER MESSAGES BEFORE NEWER ONES, AND
;TO THROW AWAY "DEAD LETTERS"
IPCFND:: STKVAR <IPCCAN,IPCOLD,MESPID,QUAID2>
MOVEM A,MESPID ;REMEMBER PID OF MESSAGE WE'RE LOOKING FOR
MOVEM B,QUAID2 ;REMEMBER QUASAR IDENTIFICATION
SETOM IPCCAN ;SAY THERE ARE NO CANDIDATES YET
HRLOI A,377777 ;START WITH OLDEST BIRTHDAY SO FAR AS SOMETHING IN FUTURE
MOVEM A,IPCOLD
MOVEI A,IPCMAX ;INITIALIZE POINTER TO IPCF QUEUES
MOVEM A,IPCIDX
FM1: SOSGE C,IPCIDX ;STEP TO NEXT SLOT TO EXAMINE
JRST FM2 ;NO, EVERYTHING'S BEEN CONSIDERED
SKIPN IPCTBL(C) ;ANY MESSAGE IN THIS SLOT?
JRST FM1 ;NO, SKIP IT
MOVE A,MESPID ;GET PID OF MESSAGE WE'RE LOOKING FOR
CAME A,IPCTBL(C) ;HAVE WE JUST FOUND ENTRY?
JRST [ CAME A,QSRPID ;DOESN'T MATCH. ARE WE SEEKING A QUASAR MESSAGE?
JRST FM4 ;NO, SO DEFINITELY DOESN'T MATCH
CALL GMDPID ;SEEKING QUASAR MESSAGE, GET MDA'S PID
MOVE C,IPCIDX
CAMN A,IPCTBL(C);IS CURRENT MESSAGE FROM MDA?
JRST .+1 ;YES, ACCEPT IT AS THOUGH FROM QUASAR
JRST FM4] ;SEEKING QUASAR, BUT CURRENT ISN'T FROM EITHER QUASAR OR MDA, SO DOESN'T MATCH
MOVE A,MESPID
CAME A,QSRPID ;WE MAY HAVE FOUND MESSAGE. ARE WE SEEKING A QUASAR MESSAGE?
JRST FM3 ;NO, SO WE'VE DEFINITELY WON
MOVEI D,IPCBPN(C) ;YES, GET PAGE NUMBER CONTAINING MESSAGE
LSH D,9 ;MAKE ADDRESS OF MESSAGE
MOVE D,.MSCOD(D) ;GET QUASAR IDENTIFICATION CODE
CAME D,QUAID2 ;IS IT THE CORRECT CODE?
JRST FM4 ;NO, KEEP SEARCHING FOR MESSAGE
FM3: MOVE A,IPCAGE(C) ;GET BIRTHDAY OF INTERESTING MESSAGE
CAML A,IPCOLD ;IS THIS ONE OLDER THAN BEST SO FAR?
JRST FM1 ;NO, NOT TIME TO DELIVER THIS ONE
MOVEM A,IPCOLD ;YES, REMEMBER BIRTHDAY OF THIS ONE
MOVEM C,IPCCAN ;REMEMBER CANDIDATE
JRST FM1
FM2: SKIPGE C,IPCCAN ;ANY CANDIDATES?
RET ;MESSAGE NOT FOUND
MOVE B,C ;RETURN SLOT NUMBER IN B
LSH C,9 ;MAKE ADDRESS
ADDI C,IPCBUF ;MAKE ABSOLUTE ADDRESS OF MESSAGE
MOVE A,C ;RETURN MESSAGE ADDRESS IN A
RETSKP ;SKIP TO SHOW MESSAGE FOUND
;GET TO HERE FROM ABOVE WHEN MESSAGE ENCOUNTERED IN THE QUEUE ISN'T ONE WE'RE
;LOOKING FOR. VERIFY HERE IF ANYONE IS LOOKING FOR IT. IF NOT, FLUSH IT
;SO AS TO FREE UP ITS SLOT IN THE QUEUE
FM4: SKIPN A,IPCTBL(C) ;GET PID THAT SENT THIS MESSAGE
JRST FM1 ;EMPTY SLOT, SO ITS ALREADY FLUSHED
CAME A,QSRPID ;DID QUASAR SEND IT?
JRST [ CAME A,MDAPID ;NO, DID MDA SEND IT?
JRST FM5 ;NO, SO FLUSH IT
JRST .+1] ;YES, TREAT LIKE QUASAR
MOVEI B,IPCBPN(C) ;QUASAR SENT IT, GET ITS PAGE NUMBER
LSH B,9 ;GET ADDRESS OF MESSAGE IN BUFFER
MOVE B,.MSCOD(B) ;GET ID OF MESSAGE WE'RE EXAMINING
MOVEI D,NOWPTR ;SCAN PENDING MOUNTS
FMLUP: SKIPN D,MLNK(D) ;MORE BLOCKS IN LINK?
JRST FM5 ;NO, SO FLUSH MESSAGE
CAME B,MQID(D) ;IS THIS MESSAGE ONE WE'RE WAITING FOR?
JRST FMLUP ;NO, KEEP LOOKING
JRST FM1 ;YES, DON'T FLUSH IT
;HERE IF WE'VE DECIDED TO FLUSH THE MESSAGE
FM5: MOVE A,C ;INDEX OF MESSAGE TO FLUSH
CALL IPCFLS ;FLUSH JUNK MESSAGE FROM QUEUE
JRST FM1 ;CONTINUE SCANNING FOR ORIGINAL MESSAGE
;CALL IPCHEK TO PRINT RESPONSES FROM IPCF MESSAGES WHICH HAVE BEEN
;RECEIVED. WHEN THIS IS DONE:
;
; o AT COMMAND LEVEL, IF SOME MESSAGES HAVE ARRIVED
;
; o WITHIN IPCF INTERRUPT, IF BUFFER IS FULL
IPCHEK:: CALL CHECKM ;CHECK FOR COMPLETED /NOWAITS
RET ;ADD MORE CALLS BEFORE THIS RET AS NECESSARY
;INTERRUPT TO HERE WHEN AN IPCF MESSAGE IS SENT TO US
IPCINT:: SKIPN IPCALF ;ALLOWED TO DO IPCF INTERRUPTS?
SETOM IPCWTF ;NO, SO REMEMBER THAT THERE'S ONE WAITING
SKIPN IPCALF ;ALLOWED TO TAKE IPCF INTERRUPTS?
DEBRK ;NO, SO DON'T DO ANYTHING
SETZM IPCWTF ;YES, SO SAY NONE WAITING ANYMORE
CALL SAVACS ;DON'T CLOBBER CODE THAT WAS RUNNING WHEN INT OCCURED
CALL IPCIN1 ;DO WORK IN INNER ROUTINE SO THAT STK/TRVARS MAY BE USED
MOVE A,IPCCTL ;GET SPECIAL PLACE TO DISMISS TO
SETZM IPCCTL ;REQUIRE IPCCTL TO BE SET UP IF WANTED AGAIN
CAIE A,0 ;SPECIAL PLACE TO GO?
MOVEM A,PCTAB+LV.IPC ;YES, TELL MONITOR TO GO THERE
CALL NACL ;SKIP IF NOT AT COMMAND LEVEL
JRST [ CALL IPCHEK ;AT COMMAND LEVEL, ANNOUNCE RECEPTION OF MESSAGE
MOVEI A,CMDIN4
MOVEM A,PCTAB+LV.IPC ;FORCE EXEC TO REPROMPT
JRST .+1]
CALL RESACS ;RESTORE AC'S
DEBRK
;THE FOLLOWING ROUTINE RECEIVES ANY OUTSTANDING IPCF MESSAGES. IT IS CALLED
;AT INTERRUPT LEVEL. DO NOT CALL IT OUTSIDE OF INTERRUPT LEVEL, SINCE IT
;MAY GET INTERRUPTED AND CALLED FROM THE MIDDLE OF ITSELF, CAUSING AN IPCF
;MESSAGE TO BE LOST
IPCIN1: STKVAR <IOLDPD,<RCVPDB,PDBSIZ>,IPSLOT,ISAGE,OLDIDX>
HRLOI A,377777 ;START WITH VERY YOUNG MESSAGE AS OLDEST SO FAR
MOVEM A,ISAGE
IPCMR1: MOVEI A,IPCMAX ;GET NUMBER OF SLOTS IN MESSAGE TABLE
IPB1: SOJL A,IPBE ;NO FREE SLOT, GO CREATE ONE
SKIPE IPCTBL(A) ;FIND A FREE SLOT?
JRST [ MOVE B,IPCAGE(A) ;NO, GET BIRTHDAY OF OLD MESSAGE
CAML B,ISAGE ;OLDEST SEEN SO FAR?
JRST IPB1 ;NO
MOVEM B,ISAGE ;YES, REMEMBER OLDEST AGE SEEN SO FAR
MOVEM A,OLDIDX ;REMEMBER INDEX OF OLDEST SEEN
JRST IPB1] ;CONTINUE LOOKING FOR FREE SLOT
IPBE3: MOVEM A,IPSLOT ;REMEMBER WHICH SLOT WE'RE USING
MOVEI A,IPCBPN(A) ;GET IPCF BUFFER PAGE NUMBER
IPB3: HRLI A,1000 ;MESSAGE IS 1000 WORDS LONG
MOVEM A,.IPCFP+RCVPDB
IPCMOR: SETOM .IPCFR+RCVPDB ;WE WANT MESSAGE FOR ANY PID WE OWN
MOVX A,IP%CFB!IP%CFV ;DON'T BLOCK, PAGE MODE
MOVEM A,.IPCFL+RCVPDB
DORCV: MOVEI A,PDBSIZ ;PDB SIZE
MOVEI B,RCVPDB ;PDB ADDR
MRECV ;RECIEVE MSG
ERJMP [ CAIE A,IPCF15 ;NO PID CREATED YET? (SUCH AS AT STARTUP)
CAIN A,IPCFX2 ;ERROR SAYS NO MORE MESSAGES?
RET ;YES, DONE
CAIE A,IPCF16 ;WRONG DATA MODE?
CALL JERRE ;NO, UNEXPECTED ERROR
MOVX A,IP%CFV ;GET PAGE BIT
ANDCAM A,.IPCFL+RCVPDB ;TRY NON-PAGE MODE
LDB A,[001100,,.IPCFP+RCVPDB] ;GET PAGE NUMBER
LSH A,9 ;CHANGE TO ADDRESS
HRRM A,.IPCFP+RCVPDB ;CHANGE TO ADDRESS
JRST DORCV]
MOVE A,.IPCFC+RCVPDB ;GET CAPS OF SENDER
TXNN A,SC%WHL!SC%OPR ;PRIVILEGED?
JRST IPCMOR ;NO, IGNORE MESSAGE
MOVE A,.IPCFS+RCVPDB ;GOOD MESSAGE, GET PID OF SENDER
MOVE B,IPSLOT ;GET INDEX FOR STORING MESSAGE
SETOM IPCRCF ;MARK THAT SOME MESSAGES HAVE BEEN RECEIVED
MOVEM A,IPCTBL(B) ;SAVE THIS ENTRY
MOVE A,.IPCFL+RCVPDB ;GET FLAGS
MOVEM A,IPCFGS(B) ;SAVE FLAGS
AOS A,UNIQUE ;GET A BIRTHMARK FOR THIS MESSAGE
MOVEM A,IPCAGE(B) ;SO WE'LL KNOW WHAT ORDER TO DELIVER MESSAGES
JRST IPCMR1 ;LOOP FOR MORE MESSAGES
;GET HERE WHEN THERE'S NO ROOM TO PUT A WAITING MESSAGE
IPBE: CALL IPCHEK ;PRINT RESPONSES FROM ACCUMULATED MESSAGES
MOVEI A,IPCMAX ;SCAN FOR A FREED SLOT
IPBE1: SOJL A,IPBE2 ;IF NO SLOT GOT FREED...
SKIPE IPCTBL(A) ;HAVE WE FOUND A GOOD ONE?
JRST IPBE1 ;NO, KEEP LOOKING
JRST IPBE3 ;YES!
;NOW WE'RE REALLY FULL.
IPBE2: SKIPE IPCCTL ;IS SOMEONE LOOKING FOR SOMETHING?
JRST [ SETOM IPCWTF ;YES, FORCE INTERRUPT TO HAPPEN AGAIN
RET] ;MAYBE WHAT WE WANT HAS ARRIVED!
MOVE C,OLDIDX ;GET INDEX OF MESSAGE BEING FLUSHED (OLDEST IN QUEUE)
MOVE B,IPCTBL(C) ;GET SENDER OF MESSAGE WE'RE FLUSHING
MOVEM B,IOLDPD ;REMEMBER PID OF MESSAGE BELING FLUSHED
ETYPE <%_%%%EXEC: IPCF buffer full; discarding message(s)>
CALL GQPID ;GET QUASAR'S PID
CAMN A,IOLDPD ;IS THE MESSAGE FROM QUASAR?
ETYPE < from QUASAR%_>
CALL GMDPID ;SEE IF FROM MDA
CAMN A,IOLDPD
ETYPE < from MDA%_> ;FEEL FREE TO ADD!
MOVE A,OLDIDX ;GET INDEX OF OLD MESSAGE
CALL IPCFLS ;THROW IT AWAY
MOVE A,OLDIDX
JRST IPBE3 ;GO USE FREED SLOT
;ROUTINE TO SEND MSG TO PID IN B
;FCN CODE IN A
SNDMSG::MOVEM A,IPCFP+.IPCI0 ;STASH CODE
SNDMS1:: MOVEM B,SNDPDB+.IPCFR ;PID TO SEND TO
CALL GETPID ;MAKE SURE WE HAVE A PID
LDF A,IP%CFS+IP%CFV ;FLAGS
MOVEM A,SNDPDB+.IPCFL
MOVEI A,MYPID ;SET UP SENDERS PID
MOVEM A,SNDPDB+.IPCFS
MOVEI A,4 ;PDB SIZE
MOVEI B,SNDPDB
MSEND ;XMIT
ERJMP BADPID ;GO CHECK FOR INVALID PID
RETSKP ;OK RETURN
;TABLE OF KNOWN SPECIAL SYSTEM PIDS
SPTBL: QSRPID,,GQPID ;CELL HOLDING PID,,ROUTINE TO INIT PID
MDAPID,,GMDPID
INFPID,,GIPID
SPLEN==.-SPTBL ;NUMBER OF ENTRIES IN TABLE
BADPID: CAIE A,IPCFX4 ;IS PROBLEM "RECIEVER'S PID INVALID"?
RET ;NO, LET CALLER HANDLE IT
MOVEI A,SPLEN ;INDEX INTO SPECIAL PID TABLE
MOVE B,.IPCFR+SNDPDB ;GET BAD PID
BAD1: SOJL A,[ MOVEI A,IPCFX4 ;MESSAGE WASN'T BEING SENT TO SPECIAL PID, LET CALLER HANDLE PROBLEM
RET]
HLRZ C,SPTBL(A) ;GET ADDRESS OF CELL CONTAINING SPECIAL PID
CAME B,(C) ;HAVE WE FOUND THE BAD PID?
JRST BAD1 ;NOT YET, KEEP LOOKING
SETZM (C) ;FORCE THIS PID TO BE RECALCULATED
HRRZ A,SPTBL(A) ;GET ROUTINE TO CALL
CALL (A) ;RECALCULATE REQUESTED PID
MOVE B,A ;GET REVISED PID IN B
JRST SNDMS1 ;GO TRY TO RESEND MESSAGE
;%ETYPE (ETYPE MACRO, UETYPE UUO)
;HANDLER FOR UUO THAT TYPES MESSAGE, INTERPRETING % CODES.
;SPECIAL CODES ARE OF FORM %NL%
; WHERE N IS AN OPTIONAL OCTAL NUMBER SPECIFYING AN AC
; L IS A LETTER:
; D: TYPE CURRENT DATE
; J: TYPE TSS JOB #
; O: TYPE CONTENTS OF INDICATED AC IN OCTAL
; SEE DISPATCH TABLE %LETS ON NEXT PAGE FOR FULL LIST.
EBLN==50 ;BUFFER SIZE FOR CHARACTERS DURING ETYPE
%ETYPE: TRVAR <<ETBFR,EBLN>,<RACS,5>,ETPTR,SRCPTR,ETYPF,EDAT>
MOVEM Z,RACS ;SAVE REAL AC'S AWAY
DMOVEM A,1+RACS
DMOVEM C,3+RACS
HLRZ A,40 ;SEE WHICH INSTRUCTION
SETOM ETYPF ;FIRST ASSUME ETYPE
CAIE A,<UETYPE>B53 ;MAYBE REGULAR TYPE
SETZM ETYPF ;YES
CALL %GETER ;GET ERROR CODE IN CASE "%?"
HRR A,40
HRLI A,<POINT 7,0,-1>B53 ;FORM BYTE PTR FROM EFF ADDR
MOVEM A,SRCPTR ;REMEMBER SOURCE POINTER
MOVEI A,ETBFR ;CREATE POINTER TO BUFFER FOR CHARACTERS
HRLI A,440700
MOVEM A,ETPTR ;DIVERT OUTPUT TO TEMPORARY BUFFER
ETYP2: HRRZ A,ETPTR ;GET CURRENT OUTPUT ADDRESS
CAIL A,-10+EBLN+ETBFR ;GETTING NEAR END OF BUFFER?
CALL EDMP ;YES, DUMP BUFFER
ILDB B,SRCPTR ;NEXT CHARACTER
ETYP2A: JUMPE B,ETYPDN ;IF NULL, STRING IS DONE
SKIPE ETYPF ;% IS NOT SPECIAL UNLESS ETYPE
CAIE B,"%"
JRST [ IDPB B,ETPTR ;NOT A %, BUFFER IT
JRST ETYP2]
CALL EDMP ;OUTPUT BUFFERED STUFF PRECEDING THE %
;%ETYPE...
;"%" SEEN
SETZB C,D ;C: IF NO NUMBER, USE 0 IN PLACE OF AC CONTENTS
;D: INIT NUMBER TO 0.
ETYP4: ILDB B,SRCPTR ;CHARACTER AFTER %
CAIG B,"9"
CAIGE B,"0"
JRST ETYP5
IMULI D,10
ADDI D,-"0"(B) ;ADD NEW DIGIT TO NUMBER
MOVE C,D ;COMPUTE LOCATION TO GET AC FROM...
CAIG C,D ;...AC'S 5-9 ARE PRESERVED,
ADDI C,RACS ;...CONTENTS OF 0-4 ARE IN PUSHDOWN.
MOVE C,(C) ;FETCH CONTENTS OF AC INDICATED BY NUMBER SO FAR
JRST ETYP4 ;GO CHECK FOR ADDITIONAL DIGIT(S)
ETYPDN: CALL EDMP ;DUMP LAST BUFFERFUL
DMOVE Z,RACS ;RESTORE AC'S
DMOVE B,2+RACS
MOVE D,4+RACS
RET ;ALL DONE
;EDMP DUMPS BUFFER ONTO ACTUAL OUTPUT DEVICE
EDMP: MOVEI A,0 ;GUARANTEE NULL
IDPB A,ETPTR
MOVE A,COJFN ;OUTPUT TO REAL JFN
HRROI B,ETBFR ;FROM OUR BUFFER
MOVEI C,0 ;STOP ON NULL
SOUT ;SEND THE DATA
MOVEM A,COJFN ;UPDATE JFN IN CASE BYTE POINTER
MOVEI A,ETBFR ;RECONSTRUCT BYTE POINTER TO BUFFER
HRLI A,440700
MOVEM A,ETPTR
RET
ETYP5: CAIL B,141
CAILE B,172
CAIA
TRZ B,40 ;MAKE THE CHARACTER UPPER CASE
MOVEI A,LETLEN ;INDEX INTO TABLE OF CODES
MOVEM C,EDAT ;DON'T CLOBBER DATA
ETYP7: SOJL A,LETNF ;COULDN'T FIND CHARACTER IN TABLE IF THIS JUMPS
HLRZ C,%LETS(A) ;GET NAME OF ELEMENT FROM TABLE
CAIL C,141
CAILE C,172
CAIA
TRZ C,40 ;MAKE THE CHARACTER UPPER CASE
CAME B,C ;IS THIS THE CORRECT ENTRY?
JRST ETYP7 ;NOT YET...
MOVE C,EDAT ;RESTORE DATA
HRRZ A,%LETS(A) ;GET ADDRESS OF ROUTINE
CALL (A) ;DO THE WORK
;DONE INTERPRETING A % CODE.
MOVE C,SRCPTR ;SAVE COPY
ILDB B,C ;NEXT CHARACTER
CAIN B,"%" ;PASS FOLLOWING %
MOVEM C,SRCPTR
JRST ETYP2 ;CONTINUE TYPING
;%ETYPE...
;DISPATCH TABLE FOR LETTERS AFTER %
;KEEP THIS TABLE IN ASCII ASCENDING ORDER SO IT REMAINS EASY TO SEE IF A
;CHARACTER IS IMPLEMENTED OR NOT
;(NOTE THAT EXEC DOESN'T ASSUME TABLE IS ORDERED THOUGH)
%LETS: "%",,%PER ;%% JUST PRINTS A PERCENT
"=",,%FLT ;SIX-COLUMN FLOATING POINT NUMBER, NN.MM
"@",,%LM ;GET TO LEFT MARGIN
"A",,%A ;CURRENT TIME
"B",,%B ;Cpu time as hh:mm:ss, or specific time in milliseconds
"C",,%C ;CONNECT TIME
"D",,%D ;CURRENT DATE(OR SPECIFIC DATE)
"E",,%E ;SAME TIME AS LAST %D(OR SPECIFIC TIME)
"F",,%F ;"FORK N " IF >1 INFERIOR
"G",,%G ;CONNECTED DIR NAME
"H",,%H ;DEVICE NAME FOR DESIGNATOR IN INDICATED AC
"I",,%I ;PRINT # OF USER JOBS + # OF OPR JOBS
"J",,%J ;TSS JOB #
"K",,%K ;UPTIME
"L",,%L ;"LINE N" OR "DETACHED"
"M",,%M ;NUMBER OR STRING (5B0+N OR BYTE POINTER)
"N",,%N ;NAME UNDER WHICH USER IS LOGGED IN (or specific user name)
"O",,%O ;CONTENTS OF SPECIFIED AC IN OCTAL
"P",,%P ;CONTENTS OF RIGHT HALF OF SPECIFIED AC IN OCTAL
"Q",,%Q ;CONTENTS OF AC IN DECIMAL OR FLOATING!
"R",,%R ;DIRECTORY NAME FOR DIR # OR STRING POINTER IN AC
"S",,%S ;FILE NAME FOR JFN IN AC
"T",,%T ;CONTENTS OF AC AS PERCENTAGE OF UP TIME
"U",,%U ;DECIMAL BIT NUMBERS, separatED BY COMMAS
"V",,%V ;CPU TIME WITH TENTHS OF SECONDS (FORK HANDLE IN AC IF NOT 0)
"W",,%W ;STD FORMAT DATE AND TIME IN AC
"X",,%X ;TYPE ILLEG INST ERROR MSG
"Y",,%Y ;Octal number potentially separated by ",,"
XTND,<
"\",,%STRNG ; TYPE STRING OR CHAR IN AC
>
NOXTND,<
"\",,%CHAR ;TYPE CHARACTER IN AC
>
"'",,%six ;print contents of ac in sixbit
"_",,%EOL ;TYPE A CRLF
"?",,%sysms ;ERROR MESSAGE (CONTENTS OF AC OR LATEST)
LETLEN==.-%LETS
;UNRECOGNIZED %-CODE
LETNF: POP P,(P) ;THROW AWAY DATA
POP P,A ;RESTORE BYTE POINTER
TYPE <%> ;DIGIT, IF ANY, IS LOST.
JRST ETYP2A ;CONTINUE TYPING, STARTING WITH CHAR AFTER %.
;%ETYPE...
;ROUTINES FOR LETTERS AFTER %.
;THESE ROUTINES RECEIVE IN C: CONTENTS OF SPECIFIED AC, OR 0 IF NONE.
;THEY MAY CLOBBER AC'S A, B, C, AND D ONLY.
;%% JUST PRINTS A %
%PER: PRINT "%"
RET
;CURRENT TIME
%A: GTAD ;GET CURRENT DATE & TIME
A1: MOVX C,OT%NDA ;TIME ONLY
A2: MOVE B,A
MOVE A,COJFN
CAMN B,[-1] ;DOES SYSTEM HAVE DATE & TIME?
HRLZI B,1 ;CHANGE TO CALL SCREWUP ________
ODTIM
MOVEM A,COJFN ;SAVE UPDATED POINTER
RET
;GET TO LEFT MARGIN
%LM: CALLRET LM
;CPU TIME USED. ALSO SEE %V.
%B: SKIPE A,C ;SPECIFIC TIME SUPPLIED?
JRST [ IDIVI A,^D1000 ;YES, CHANGE TO SECONDS
JRST TOUT] ;PRINT AS HH:MM:SS
HRROI A,-5 ;SAY WHOLE JOB
RUNTM
%B1: IDIV A,B ;CONVERT TO SECS
JRST TOUT ;TYPE AS H:MM:SS
;CONSOLE TIME USED
%C: HRROI A,-5
RUNTM
MOVE A,C
JRST %B1
;DATE
%D: SKIPN A,C ;USE GIVEN QUANTITY IF ANY
GTAD ;GET CURRENT DATE & TIME FROM SYSTEM
MOVEM A,%EDAYT ;SAVE FOR %E
MOVX C,OT%NTM!OT%SCL ;DATE ONLY, STANDARD CONCISE FORMAT
JRST A2 ;GO PRINT DATE
;SAME TIME AS LAST %D, TO AVOID INCONSISTENCIES AT MIDNITE.
%E: SKIPN A,C ;IF SPECIFIC TIME GIVEN, USE IT
MOVE A,%EDAYT
JRST A1 ;SEE %A
;ETYPE'S % ROUTINES ...
;TYPE "FORK N " ONLY IF THIS EXEC HAS >1 INFERIORS.
; GET FORK HANDLE FROM INDICATED AC, OR IF NONE, CELL "RFORK".
;FIRST READ FORK STRUCTURE TO FIND OUT HOW MANY FORKS THERE ARE.
%F: MOVEI A,.FHSLF ;SAY START AT SELF
MOVX B,GF%GFH ;ASSIGN FORK HANDLES
MOVE C,[-300,,BUF0] ;WHERE TO PUT FORK STRUCTURE
GFRKS ;GET FORK STRUCTURE
CALL [ CAIE 1,GFKSX1 ;RAN OUT OF SPACE?
JRST JERR ;NO, STRANGE
POP P,(P)
JRST %F1] ;PRINT ANYWAY
HRRZ A,(B) ;PTR TO INFERIOR
MOVE A,(A) ;XWD ITS PARELLEL, ITS INFERIOR
JUMPE A,[RET] ;NEITHER EXISTS, ITS ONLY ONE, PRINT NOTHING.
%F1: TYPE <Fork >
SKIPG B,C ;USE GIVEN HANDLE IF AC W >0 CONTENTS GIVEN
MOVE B,FORK ;ELSE HANDLE OF LAST RUN FORK
TRZ B,(1B0) ;PRINT ## NOT 4000##.
CALL TOCT ;OCTAL OUTPUT FROM B
PRINT " "
RET
;DEVICE NAME FOR DESIGNATOR IN INDCATED AC.
%H: MOVE A,C
DVCHR ;TRANSLATE JFN (IF GIVEN) TO DEVICE DESIGNATOR
MOVE B,A
MOVE A,COJFN
DEVST ;DEVICE TO STRING
CALL JERR
MOVEM A,COJFN ;SAVE IN CASE POINTER
RET
;NUMBER OF USERS ON SYSTEM.
;COUNTS NUMBER OF POSITIVE ENTRIES IN SYSTEM TABLE 1.
%I: CALL USRCNT
PUSH P,A ;SAVE OPR JOB COUNT
MOVE A,COJFN
MOVEI C,^D10
NOUT ;PRINT NUMBER
CALL JERRC ;GENERAL JSYS ERROR ROUTINE FOR ERR COD IN C
MOVEI B,"+" ;SEPARATE USER/OPR JOBS
BOUT
POP P,B ;GET COUNT OF OPR JOBS
NOUT ;PRINT IT
CALL JERRC
MOVEM A,COJFN ;SAVE IN CASE POINTER
RET
USRCNT:: MOVSI A,(RC%EMO) ;EXACT MATCH ONLY
HRROI B,[ASCIZ /OPERATOR/]
RCUSR ;GET DIRNUM OF OPERATOR
TLNE A,(RC%NOM+RC%AMB) ;COULDN'T?
MOVEI C,-1 ;NO, SO USE -1
PUSH P,C ;SAVE IT FOR COMPARES BELOW
SETZB B,C ;COUNTER
HLLZ D,JOBRT ;SETUP AOBJN PTR
GTB .JOBRT
JUMPL A,%I1 ;NO JOB 0
GTB .JOBTT
JUMPL A,%I3 ;IGNORE DETACHED JOB 0
%I1: GTB .JOBRT ;TABLE 1 IS POSITIVE IF JOB EXISTS
JUMPL A,%I3
CALL USERNO ;GET USER NUMBER
JUMPE A,%I3 ;SKIP JOB IF NOT LOGGED IN
CAMN A,0(P) ;LOGGED IN AS 'OPERATOR'?
AOJA C,%I3 ;YES, COUNT OPERATOR JOBS
AOS B ;COUNT REGULAR JOBS
%I3: AOBJN D,%I1
MOVE A,C
POP P,(P)
RET
;UPTIME
%K: TIME ;TIME SINCE SYSTEM RESTARTED
IDIV A,B ;CONVERT TO SECONDS
CALL TOUT ;PRINT AS HH:MM:SS
RET
;ETYPE'S % ROUTINES ...
;"TTY N" OR "DETACHED"
%L: GJINF
JUMPL D,[UTYPE [ASCIZ /Detached/]
RET]
TYPE <TTY>
MOVE A,COJFN
MOVE B,D
JRST TOCT ;TYPE OCTAL FROM B
;TAKES 5B2+NUMBER, OR STRING POINTER, IN INDICATED AC
%M: MOVE A,COJFN
LDB B,[POINT 3,C,2]
CAIE B,5
JRST [ MOVE B,C
SETZ C,
SOUT
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET]
MOVE B,C
TLZ B,700000
MOVEI C,^D10
NOUT
CALL JERRC
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
;NAME OF CONNECTED DIRECTORY. MUST PRECEDE %N.
%G: GJINF
JRST %N1
;USER (DIRECTORY) NAME LOGGED IN UNDER.
%N: skipn a,c ;use specific user name if given
GJINF
MOVE B,A ;LOGIN DIRECTORY NO
%N1: MOVE A,COJFN
DIRST
ERJMP DIRSTB ;THE DIRST FAILED
MOVEM A,COJFN ;UPDATE IN CASE BYTE POINTER
RET
DIRSTB: PRINT "?" ;R1: UNASSIGNED DIR #, NO SYST ERR # IN A.
RET
;ETYPE'S % ROUTINES...
;OCTAL NUMBER IN SPECIFIED AC.
%O: MOVE B,C
JRST TOCT ;TYPE OCTAL FROM B
XTND,<
%STRNG: HLRZ A,C ; GET PNTR LHS
JUMPE A,%CHAR ; IF NO POINTER THEN CHARACTER RJ
CAIE A,-1 ; CHECK FOR -1,,
CAIN A,(<POINT 7,,>) ; OR 440700
CAIA
RET ; RETURN IF CRAP
HRLI C,(<UETYPE>) ; FORM LUUO
PUSH P,C ; SAVE IT
MOVE Z,RACS ; RESTORE ACS
DMOVE A,1+RACS
DMOVE C,3+RACS
XCT 0(P) ; DO IT
POP P,C ; PRUNE PDL
RET ; RETURN
%CHAR: SKIPN B,C ;GET CHARACTER
RET ; RETURN IF NULL
CALLRET COUTC ;TYPE IT AND RETURN
>
NOXTND,<
;TYPE CHARACTER IN AC
%CHAR: MOVE B,C ;GET CHARACTER
CALLRET COUTC ;TYPE IT AND RETURN
>
;sixbit of data in ac
%six: move a,[440600,,c] ;pointer to sixbit data
MOVEI D,0 ;NULL TO CLEAR CHARACTERS AS WE PRINT THEM
six1: tlnn a,770000 ;have we done all six characters yet?
ret ;yes
ildb b,a ;no, get one
DPB D,A ;CLEAR OUT CHARACTER WE JUST READ
JUMPN B,SIX2 ;IF CHARACTER IS NON-0, ALWAYS PRINT IT
JUMPE C,R ;IF CHARACTER IS 0, PRINT IT UNLESS IT'S A TRAILING SPACE
SIX2: addi b,40 ;change to ascii
print @b ;print character
jrst six1 ;go back for rest
;18 BIT OCTAL NUMBER FROM RIGHT HALF OF SPECIFIED AC
%P: HRRZ B,C
JRST TOCT
;FLOATING POINT NUMBER
%FLT: MOVE B,C ;GET NUMBER
JRST %Q2
;TSS JOB NUMBER. MUST PRECEDE %Q.
%J: GJINF ;GETS JOB # IN C
;FLOATING PT OR DECIMAL NUMBER FROM AC.
;PRINT AS FLOATING IF NORMALIZED AND WITH EXPONENT 100<Q1<377
%Q: MOVE B,C
MOVM C,B
TLNE C,700000 ;EXPONENT .GE. 100?
TLNN C,400 ;NORMALIZED?
JRST %Q1 ;NO, PRINT DECIMAL
LDB C,[POINT 9,C,8] ;GET EXPONENT
CAIN C,377 ;SPECIAL INFINITY?
JRST [ TYPE <+INF> ;YES - SAY SO
RET]
%Q2: MOVE A,COJFN
;THE FOLLOWING FORMAT WORD WILL USE 6 PLACES FOR NUMBERS LESS THAN
;1000. OTHERWISE, IT GOES TO 'FREE' FORMAT AND USES WHATEVER NECESSARY.
MOVE C,[1B4+1B6+1B11+3B23+2B29]
FLOUT
CALL [ CAIE C,FLOTX1 ;COLUMN OVERFLOW?
JRST JERRC ;NO, SOMETHING UNEXPECTED
POP P,C ;YES, THAT'S OK
JRST .+1]
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
%Q1: MOVEI C,^D10 ;RADIX TO USE
MOVE A,COJFN
NOUT
CALL JERRC
MOVEM A,COJFN ;UPDATE, IN CASE BYTE POINTER
RET
;FLOAT THE INTEGER IN A
FLOAT: IDIVI A,400000 ;BREAK NUMBER INTO TWO PARTS
FSC A,254 ;CONVERT HIGH PART
FSC B,233 ;CONVERT LOW PART
FADR A,B ;COMBINE PARTS
RET
;RETURN USER NUMBER IN A OF JOB # IN D
;RETURNS 0 IF THE JOB IS NOT LOGGED IN!
USERNO:: PUSH P,B
PUSH P,C ;CLOBBER NOTHING
HRROI B,A ;DIRECT OUTPUT TO LOCATION A
HRRZ A,D ;GET JOB #
MOVEI C,.JIUNO ;SPECIFY USER NUMBER REQUESTED
GETJI ;GET THE USER NUMBER
JRST USERN1 ;FAILED, GO SEE WHY
USERN2: POP P,C
POP P,B
RET
USERN1: CAIE A,GTJIX4 ;"JOB NOT LOGGED IN" ERROR?
CALL JERR ;NO, OTHER. UNEXPECTED...
MOVEI A,0 ;YES, SO RETURN 0.
JRST USERN2
;DIRECTORY NAME FOR NUMBER IN AC
%R: CAMN C,[-1]
JRST %G ;-1 = CONNECTED
LDB B,[POINT 3,C,2] ;SEE IF THIS IS A NUMBER
CAIE B,5 ;OR IF IT IS A STRING POINTER
JRST %M ;STRING POINTER
MOVE B,C
JRST %N1
;FILE NAME FOR JFN IN AC
%S: MOVE A,COJFN
MOVE B,C
SETZ C,
JFNS
ERCAL [ CALL JFNSIL ;ANALYZE ERROR
JRST JERR ;STRANGE ERROR
RET] ;"GOOD" ERROR
MOVEM A,COJFN ;UPDATE IN CASE BYTE POINTER
RET
;JFNSIL ANALYZES JFNS ERROR. IF IT RECOGNIZES THE ERROR, IT PRINTS OUT
;THE EXPLANATION AND SKIP RETURNS.
;IF IT DOESN'T RECOGNIZE THE ERROR, IT GIVES A NON-SKIP RETURN.
JFNSIL::CALL %GETER
HRRZ A,B
GTSTS
MOVE A,ERCOD
TXNN B,GS%NAM ;DOES JFN HAVE NAME?
RET ;NO, JUST RETURN ERROR CODE
CAIN A,DESX3 ;UNASSIGNED JFN ERROR?
JRST [ TYPE < Restricted JFN>
RETSKP]
CAIN A,GJFX24 ;FILE GONE?
JRST [ TYPE < Nonexistent file>
RETSKP]
RET ;NON-SKIP TO DENOTE STRANGE ERROR
;CONTENTS OF AC AS PERCENTAGE OF UP TIME
%T: TIME ;GET UPTIME IN A
MULI C,^D200
DIV C,A ;HOPE DIVISORS TO CONVERT TO SECS ARE SAME
ADDI C,1 ;ROUND
LSH C,-1
CALL %Q ;PRINT IN DECIMAL
PRINT "%"
RET
;ETYPE'S % ROUTINES...
;CONTENTS OF AC AS LIST OF DECIMAL NUMBERS FOR SET BITS,
; OR "NONE" IF AC 0.
%U: JUMPE C,[UTYPE [ASCIZ /None/]
RET]
SETZ D, ;BIT NUMBER
;FIND FIRST SET BIT
TLNE C,(1B0)
JRST %U2
LSH C,1
AOS D
JRST .-4
;LOOP FOR SUCCESSIVE BITS
%U1: TLNN C,(1B0)
JRST %U3
PRINT "," ;COMMA (AND SPACE) BEFORE ALL BUT FIRST
MOVE A,COJFN
RFPOS
MOVEI B,(B)
CAIL B,^D55
ETYPE<%_> ;EOL IF TOO FAR RIGHT
PRINT " "
%U2: ETYPE <%4Q> ;BIT # IN DECIMAL
%U3: AOS D
LSH C,1
JUMPN C,%U1
RET
;CPU TIME USED, INCLUDING TENTHS OF SECONDS, FOR ^T FOR DGB.
%V: SKIPE D ;IF AC SPECIFIED
SKIPA A,C ;THEN IT IS FORK HANDLE
HRROI A,-5 ;SAY WHOLE JOB
RUNTM
MOVE C,B ;TICKS PER SECOND
IDIV A,B ;CONVERT TIME IN TICKS TO SECS
CALL TOUT ;TYPE H:MM:SS
IDIVI C,^D10 ;GET TICKS PER 1/10 SEC
JUMPN D,[RET] ;NOT EVEN, DON'T PRINT TENTHS OF SECS
IDIV B,C ;CONVERT REMAINDER OF TICKS TO TENTHS
ETYPE <.%2Q> ;TYPE TENTHS OF SECONDS
RET
;PRINT C(AC) AS DATE AND TIME
%W: MOVE A,COJFN
MOVE B,C ;ARG SUPPLIED IN C
MOVEI C,0 ;USE STANDARD BRIEF FORMAT
ODTIM
MOVEM A,COJFN ;UPDATE COJFN IF BYTE POINTER
RET
;ETYPE's % routines...
;Argument to %nX is handle of a process stopped because of an
;illegal instruction. Type the instruction, the PC, and if the
;instruction was a JSYS, the associated system message. Though the
;PC could be found by doing a long RFSTS here, callers have done it,
;leaving it in LRFSTS+.RFPPC.
%X: PUSH P,FORK ;SAVE GLOBAL FORK HANDLE
XTND,<
SKIPLE EFORK ; USE EPHEMERAL IF PRESENT
MOVE C,EFORK
>
MOVEM C,FORK ;TEMP STORE FOR MAPPF CALL
MOVE C,LRFSTS+.RFPPC ;Get PC of process
HRRI C,-1(C) ;Get PC of offending instruction, but
MOVE A,C ; by subtracting without carry from LH
CALL LOADF ;GET CONTENTS OF PC
JRST %X1 ;Can't read instruction-- don't print it
ETYPE <%1Y at %3Y>
HLRZS A ;Get opcode to see if it's a JSYS
CAIN A,<JSYS>B53
TYPE < - JSYS error:>
JRST %X2 ;Continue . . .
%X1: ETYPE <at %3Y>
%X2: MOVE A,FORK ;GET ERROR CODE NOW FOR USE IN ERSTR
GETER ;DO JSYS
HRRZ B,B ;KEEP ONLY THE ERROR CODE
ETYPE <%_?%2?>
SETO A,
CALL MAPPF ;UNMAP PAGE
JFCL ;Unmap shouldn't fail
POP P,FORK ;RESETORE FORK INFO
RET ;RETURN
;ETYPE's % routines...
; %Y types an octal number as n,,m, or just m if n=0.
%Y: PUSH P,C ;Save the number
HLRZ B,C ;Set up left half of number
MOVE A,COJFN ;Standard output stream
MOVEI C,8 ;Octal
JUMPE B,%Y1 ;Don't print anything if zero
NOUT
CALL JERRC ;Type standard message
MOVEI B,"," ;Separate halves
BOUT
BOUT
%Y1: POP P,B ;Restore number
MOVEI B,(B) ;Print just the right half this time
NOUT
CALL JERRC ;Print standard message
MOVEM A,COJFN ;Update in case it's a byte pointer
RET
; %? types last error message
%sysms: HRLI B,.FHSLF ;OURSELF
HRR B,ERCOD ;USE LAST ERROR IF NO ARG
CAIE C,0 ;SPECIFIC ERROR DESIRED?
HRR B,C ;YES, USE IT
MOVE A,COJFN ;STANDARD OUTPUT STREAM
MOVEI C,0 ;NO SIZE LIMIT
AOS CLZFFF ;IF ^C WHILE ERSTR HAS ERRMES.BIN OPEN, DO CLZFF
ERSTR ;TYPE MESSAGE
JRST [ CALL CRIF ;START ON A NEW LINE IF NEEDED
ETYPE <?Error message not found for error %2P>
JRST .+2] ;R1: BAD ERROR NUMBER
JRST .+1 ;R2: DESTINATION PROBLEM, FORGET IT.
SOS CLZFFF ;WE NO LONGER REQUIRE CLZFF
MOVEM A,COJFN ;UPDATE COJFN IN CASE BYTE POINTER
RET
;ETYPE'S % ROUTINES...
;PRINT CRLF
%EOL: MOVE A,COJFN ;GET OUTPUT STREAM
CALL SNDEOL ;WRITE THE CRLF
MOVEM A,COJFN ;UPDATE OUTPUT STREAM
RET
;ROUTINE TO PUT OUT END OF LINE. CALL WITH JFN IN A.
SNDEOL::PUSH P,B
HRROI B,[BYTE(7).CHCRT,.CHLFD]
MOVEI C,0 ;END ON NULL
SOUT ;WRITE THE CRLF
POP P,B
RET
;SUBROUTINE TO TYPE NUMBER OF SECONDS IN A IN THE FORM H:MM:SS.
TOUTD: PUSH P,A
PUSH P,B
PUSH P,C
MOVE B,A
MOVE A,OUTDSG
JRST TOUT1
TOUT: PUSH P,A
PUSH P,B
PUSH P,C
MOVE B,A
MOVE A,COJFN
TOUT1: IDIVI B,^D3600
PUSH P,C
MOVEI C,^D10
NOUT ;HOURS
CALL JERRC
MOVEI B,":"
BOUT
POP P,B
IDIVI B,^D60
PUSH P,C
MOVX C,NO%LFL!NO%ZRO!FLD(2,NO%COL)!5+5 ;2 COLS, LEADING 0'S.
NOUT ;MINUTES
CALL JERRC
MOVEI B,":"
BOUT
POP P,B
NOUT ;SECONDS
CALL JERRC
JRST [ POP P,C
POP P,B
POP P,A
RET]
NOXTND,<
;SUBROUTINE CALLED AT RETURN TO COMMAND LOOP, TO DO MAIL WATCH.
; CALLED IFF MWATCF (MAIL WATCH FLAG) IS NON-ZERO.
;"CALL CHKPTY" REMOVED FROM THIS ROUTINE BECAUSE 1) IT WAS CAUSING TWO
;EXTRA JSYS'S TO BE EXECUTED PER EXEC COMMAND AND 2) USER RUNNING UNDER NEWRUN
;OR PTYCON MAY VERY WELL HAVE MAIL BE WATCHED.
MWATCH:: SKIPN CUSRNO ;MUST BE LOGGED IN
RET
SKIPN MAILF ;TIME TO CHECK?
RET ;NO
CALL MINT0 ;ENABLE FOR ANOTHER MAIL INTERRUPT
MOVE B,CUSRNO ;GET LOGGED-IN USER NUMBER
CALL MALCHK ;CHECK MY MAIL BOX
RET ;NO NEW MAIL
TYPE <[You have new mail]
>
RET ;RETURN TO COMMAND LOOP
;ROUTINE TO ENABLE FOR A TIMER INTERRUPT AT SOME ELAPSED TIME FROM NOW.
;WHEN THE INTERRUPT OCCURS, IT MEANS THAT MAIL SHOULD BE CHECKED.
MINT0:: SETZM MAILF ;SAY NO INTERRUPT YET
GTAD ;GET CURRENT TIME AND DATE
MOVX B,MWATCI ;GET INCREMENT
ADD B,A ;CALCULATE WHEN TO INTERRUPT
MOVEM B,MALWEN ;REMEMBER WHEN
MOVE A,[.FHSLF,,.TIMDT] ;SAY TO INTERRUPT AT EXACT TIME
MOVEI C,MALCHN ;USE MAIL CHANNEL
TIMER ;ENABLE FOR INTERRUPT
ETYPE <
%%Unexpected MAIL-WATCH failure, mail no longer being watched - %?
>
RET
> ; NOXTND
;ROUTINE TO STACK ALL THE AC'S. THIS IS USEFUL FOR INTERRUPT
;ROUTINES THAT HAVEN'T THE SLIGHTEST IDEA WHERE THE EXEC WAS WHEN
;THE INTERRUPT OCCURED, SO THE INTERRUPT ROUTINE CALLES SAVACS TO
;SAVE ALL THE AC'S ON THE STACK. THE INTERRUPT ROUTINE MUST CALL
;RESACS BEFORE DISMISSING THE INTERRUPT, IN ORDER TO RESTORE THE
;AC'S.
;THIS ROUTINE DOESN'T SAVE P.
SAVACS: EXCH 0,(P) ;SAVE AC0, GET RETURN ADDRESS
ADJSP P,17 ;ALLOCATE ROOM FOR THE REST OF THE AC'S
MOVEM 0,(P) ;STORE RETURN ADDRESS "AFTER" AC BLOCK
HRRI 0,-16(P) ;PLACE ON STACK TO STORE AC'S
HRLI 0,1 ;STARTING FROM AC1
BLT 0,-1(P) ;SAVE REST OF AC'S
RET ;RETURN TO CALLER
;ROUTINE TO RESTORE AC'S
RESACS: HRLI 0,-16(P) ;GET ADDRESS OF STORED AC'S
HRRI 0,1 ;RESTORE AC'S INTO AC1 ONWARD
BLT 0,16 ;RESTORE 1 THROUGH 16
MOVE 0,(P) ;GET RETURN ADDRESS
EXCH 0,-17(P) ;STORE RETURN ADDRESS, GET ORIGINAL AC0
ADJSP P,-17 ;FREE UP SPACE USED BY RETURN ADDRESS AND 1 THRNOUGH 16
RET ;RETURN TO CALLER (PHYEW!)
NOXTND,<
;SUBROUTINE USED BY MAIL WATCH LOGIC AND INFO MAIL COMMAND
;CALLED WITH B CONTAINING THE USER NUMBER
;SKIP RETURNS IF THAT DIRECTORY'S MAIL.TXT EXISTS AND HAS NEW STUFF.
;NON-SKIP IF NO NEW MAIL (A=0) OR CANNOT TELL (A=-1).
MALCHK:: STKVAR <MALUSR,<MALBFR,FILWDS>>
MOVEM B,MALUSR ;SAVE USER NUMBER
HRROI A,MALBFR ;SPACE TO CREATE FILENAME
HRROI B,[ASCIZ /PS:</] ;MUST BE ON PS:
MOVEI C,0
SOUT
MOVE B,MALUSR ;RESTORE USER NUMBER
DIRST ;ADD USER NAME
CALL JERR ;NO SUCH DIRECORY. SHOULDN'T HAPPEN
HRROI B,[ASCIZ />MAIL.TXT.1/]
MOVEI C,0
SETO Q1, ;NO JFN YET
SOUT ;FINISH FILE NAME
MOVX A,GJ%OLD+GJ%DEL+GJ%SHT ;OLD,DELETED AND SHORT FORM
HRROI B,MALBFR ;POINT TO FILE NAME
CALL GTJFS ;GET AND STACK JFN
JRST MALCH2 ;FAILED
HRRZ Q1,A ;SAVE THE JFN IN MORE PERMANENT AC
MOVE B,[1,,.FBCTL] ;ANALYZE THE FILE
MOVEI C,C
CALL $GTFDB ;SEE IF IT IS DELETED
JRST MALCHP ;PROTECTED
TXNE C,FB%DEL ;DELETED?
JRST MALCHM ;YES. NO NEW MAIL
MOVE B,[1,,.FBSIZ] ;NOT DELETE. GET SIZE
MOVEI C,C
CALL $GTFDB ;GET SIZE
JRST MALCHP ;PROTECTED
JUMPLE C,MALCHM ;IF EMPTY. NO MAIL
MOVE B,[1,,.FBWRT] ;NOT EMPTY GET WRITE DATE
MOVEI C,D ;PUT WRITE DATE IN D
CALL $GTFDB
JRST MALCHP ;PROTECTED
MOVE B,[1,,.FBREF] ;GET LAT REFERANCE DATE
MOVEI C,C
CALL $GTFDB
JRST MALCHP ;PROTECTED
CAMLE C,D ;WRITTEN LATELY?
JRST MALCHM ;NO. NO MAIL
RETSKP
;... MALCHK CONTINUED
MALCH2: CAIN A,GJFX24 ;SPECIFIC FILE NOT FOUND
JRST MALCHM ;RIGHT. NO NEW MAIL
CAIL A,GJFX16 ;RANGE FOR NOT FOUND
CAILE A,GJFX20 ;..
JRST MALCHP ;SAY DON'T KNOW ABOUT MAIL
MALCHM: TDZA A,A ;MAIL REALLY NOT THERE
MALCHP: SETO A, ;CAN'T TELL IF MAIL IS THERE
RET
> ; NOXTND
XTND,<
;New mail watch subroutine - can be called from either interrupt level
; or command returns , does nothing if not logged in or mail watch turned
; off, MWATCF := 0
MWATCH::SKIPE BATCHF ; NO MAIL WATCH IF UNDER BATCH
RET
SKIPE CUSRNO ; LOGGED IN?
SKIPN MWATCF ; YES - WANT MAIL WATCH
RET ; NO - RETURN
GTAD ; OK - GET D/T
MOVEI D,MWATAT ; AUTO TIMER
SKIPN AUTOF ; THIS CALL FROM IIT
MOVEI D,MWATCT ; NO - USE COMMAND TIMER
CAMGE A,0(D) ; TIME TO CHECK MAIL?
RET ; NOPE - RETURN
ADDI A,^D910 ; TRY AGAIN 5 MINS FROM NOW
MOVEM A,0(D)
MOVEI Q2,NMWAT-1 ; # OF ENTRIES
MWATC0: SKIPE B,MWATDR(Q2) ; GET DIRECTORY #
CALL MALCHK ; CHECK ONE
JRST MWATC4 ; NO NEW MAIL
CAMN D,MWATWR(Q2) ; CHECK LAST WRITE DATE/TIME
JRST [ SKIPE AUTOF ; STILL THE SAME , CHECK IIT
JRST MWATC4 ; AUTO WATCH - GO TO NEXT
JRST MWATC1] ; NOT AUTO - DECREMENT COUNT
MOVE Q1,MWATN0(Q2) ; GET INITIAL COUNT
MOVEM Q1,MWATN(Q2) ; RESET FOR NEW D/T
MOVEM D,MWATWR(Q2) ; REMEMBER WRITE DATE
SKIPE AUTOF ; IIT?
JRST MWATC2 ; YES - TELL USER
MWATC1: SOSGE MWATN(Q2) ; REDUCE REPEAT COUNT
JRST MWATC4 ; COUNT EXPIRED, GO ON
JRST MWATC3 ; INFORM USER OF MAIL
MWATC2: PUSH P,A ; SAVE STRING PNTR FROM MALCHK
MOVE A,COJFN
DOBE ; WAIT FOR TYPEOUT TO STOP
POP P,A ; RESTORE PNTR
TYPE <> ; RING CHIMES
MWATC3: MOVE Q1,MWATDR(Q2) ; USER BEING WATCHED
CAME Q1,CUSRNO ; IS IT ME?
JRST [ ETYPE <[%5N has > ; NO - TELL ME WHO THEN
JRST .+2]
TYPE <[You have > ; ITS MINE
TLNN B,77 ; NETWORKS
TYPE <net>
ETYPE <mail %1\]%_>
MWATC4: SOJGE Q2,MWATC0 ; LOOP BACK FOR NEXT
RET ; DONE, RETURN
;Subroutine used by mail watch logic and info mail command
;Called with c(B) := user #
;Returns:
; +1 ;No mail, or some other failure
; +2 ;New mail - c(A) := -1,,message
; c(D) := write date/time
; c(C) := aux message
MALCHK::STKVAR <MALUSR,<MALFDB,16>>
SETO Q1, ; INIT FLAG
HRROI A,MALBUF ; POINT AT BUFFER
MOVEM B,MALUSR ; SAVE USER #
HRROI B,[ASCIZ "PS:<"]
MOVEI C,0
SOUT ; COPY STRING
MOVE B,MALUSR ; RESTORE USER
DIRST ; NAME STRING TO BUFFER
CALL JERR
HRROI B,[ASCIZ ">MAIL.TXT.1"]
SOUT ; FINISH FILE SPEC
MOVX A,GJ%OLD!GJ%DEL!GJ%SHT
HRROI B,MALBUF
GTJFN ; GRASP AT FILE
JRST MALCH2 ; HANDLE ERROR
MOVEI Q1,(A) ; JFN TO Q1
MOVE B,[15,,.FBCTL] ; GET SOME FDB INFO
MOVEI C,.FBCTL+MALFDB ; POINT AT STG
CALL $GTFDB ; GET IT
JRST MALCHP ; PROTECTED
MOVX C,FB%DEL ; CHECK DELETED
TDNN C,.FBCTL+MALFDB
SKIPG .FBSIZ+MALFDB ; EXISTS - HAVE CONTENTS?
JRST MALCHN ; EMPTY OR DELETED
MOVE D,.FBWRT+MALFDB ; GET D/T LAST WRITE
CAMG D,.FBREF+MALFDB ; COMPARE AGAINS LAST READ
JRST MALCHN ; NO NEW MAIL
HRLI A,.GFLWR ; GET LAST WRITER STRING
HRROI B,MALBUF ; POINT TO BUFFER
SETZM MALBUF ; MAKE SURE WE HAVE A VALID ERROR STRING
GFUST
ERJMP .+1
HRROI B,MALBUF ; ASSUME LOCAL MAIL (-1,,MALBUF)
SKIPA A,[POINT 7,MALBUF]
MALCKL: JUMPE C,MALLCL ; LOCAL IF NO SPECIAL CHARS
ILDB C,A ; FETCH CHAR IN NAME
CAIE C," " ; IMBEDDED SPACE
CAIN C,"@" ; OR AT SIGN MEANS NET MAIL
SKIPA B,[POINT 7,MALBUF] ; RETURN 440700,,MALBUF
JRST MALCKL ; NO SPECIAL KEEP LOOKING
MALLCL: MOVEI A,(Q1) ; JFN TO RELEASE
RLJFN
CALL JERR ; BITCH ABOUT IT
GTAD ; GET D/T NOW
SUB A,D ; CHECK FOR GREATED THAN 1 DAY
TLNN A,-1
TDZA C,C ; LESS - CLEAR XTR MSG
HRROI C,[ASCIZ "%4D "] ; GIVE DATE AS WELL AS
HRROI A,[ASCIZ "from %2\ at %3\%%4E%"] ; TIME
RETSKP ; GOOD RETURN
; MALCHK CONTINUED....
;HERE ON GTJFN FAILURE FOR MAIL.TXT.1
MALCH2: CAIN A,GJFX24 ; FILE NOT FOUND
JRST MALCHN ; NO FILE RETURN
CAIL A,GJFX16 ; MORE NOT FOUND ERRORS
CAILE A,GJFX20
JRST MALCHP ; MUST BE PROTECTED
MALCHN: TDZA A,A ; RETURN 0 IF NOT FOUND
MALCHP: SETO A, ; -1 IF PROTECTED (OR SOMETHING)
JUMPL Q1,R ; HAVE JFN?
EXCH A,Q1 ; YES - RELEASE IT
RLJFN
CALL JERR ; BITCH IF LOSAGE
MOVE A,Q1 ; RESTORE VALUE
RET ; AND RETURN
; STILL IN XTND
;INTERUPT ROUTINE FOR IIT (TIMER)
;INTERUPTS OCCUR EVERY MINUTE IF SET AUTO (MAIL-WATCH AND ALERTS) IS ON
IITPSI::PUSH P,40 ; SAVE LUUO LOC
PUSH P,P1 ; TOP AC TO SAVE
ADJSP P,7 ; MAKE SOME STACK ROOM
MOVSI P1,A ; SAVE REGS
HRRI P1,-6(P)
BLT P1,0(P) ; ...
SKIPE TYPING ; TYPEOUT IN PROGRESS?
JRST IITRET ; YES - EXIT NOW
SETOM AUTOF ; NO - SAY WE ARE IN AUTO CHECK
CALL MWATCH ; INVOKE WATCHERS
CALL ALRCHK
SKIPE IPCRCF ; ANY IPCF MESSAGES?
CALL IPCHEK ; YES - INFORM USER
IITRET: MOVE A,[.FHSLF,,.TIMEL] ; ELAPSED TIME FOR SELF
MOVEI B,^D60000 ; 1MIN FROM NOW
MOVEI C,IITCHN ; PSI CHL
TIMER ; ARM IT
SETZM IITSET ; CLEAR FLAG
MOVEI Q3,A ; RESTORE ACS
HRLI Q3,-6(P)
BLT Q3,Q3
ADJSP P,-7
POP P,P1
POP P,40 ; RESTORE LUUO
DEBRK ; EXIT INT
> ; XTND
;ROUTINE TO SUBTRACT TWO BYTE POINTERS
;CALL: A/ BYTE POINTER 1
; B/ BYTE POINTER 2
;RETURN: +1
; A/ 1-2
SUBBP:: TLC A,-1
TLCN A,-1
HRLI A,440700 ;IF LEFT HALF -1, IT'S NOW 440700
TLC B,-1
TLCN B,-1
HRLI B,440700 ;SAME FOR OTHER POINTER
MOVEI C,1
ADJBP C,B ;PUT SECOND POINTER INCREMENTED IN C
IBP A ;NOW NEITHER POINTER IS "44XX00,,"
MULI A,5 ;MULTIPLY POINTER BY BYTES PER WORD
SUBI B,-4(A) ;B HOLDS CHARACTER ADDRESS
MULI C,5 ;DO SAME TO OTHER POINTER
SUBI D,-4(C)
SUB B,D ;CALCULATE DIFFERENCE
HRRE A,B ;RETURN ANSWER IN A.
RET
;ROUTINE TO DO GFRKS JSYS TO GET FORK HANDLES ON ALL PROCESSES
;UNDER THIS EXEC.
;SKIPS IFF SUCCESSFUL
DGFRKS:: MOVEI A,.FHSLF ;SAY START AT SELF
LDF B,GF%GFH+GF%GFS ;ASSIGN FORK HANDLES, GET STATUS
MOVE C,[-1000*<<BUFL-BUF0>B44+1>,,BUF0] ;WHERE TO PUT FORK STRUCTURE (BUF0-BUFL)
GFRKS ;GET FORK STRUCTURE
RET ;FAILED
RETSKP ;WIN
;ROUTINE TO REWIND MAGTAPE. GIVE IT JFN IN A
;THIS ROUTINE LEAVES THE TAPE OPEN OR NOT DEPENDING ON WHETHER JFN WAS
;OPEN TO START WITH
REWIND:: GTSTS ;SEE IF JFN IS OPEN
TXNN B,GS%OPN ;OPEN?
JRST [ MOVX B,OF%RD ;NO, OPEN FOR READING
CALL OPNMAG ;OPEN THE TAPE
CALL REWIND ;REWIND THE TAPE
TXO A,CO%NRJ
CLOSF ;CLOSE FILE BUT DON'T RELEASE JFN
NOP ;IGNORE FAILURE
RET]
MOVEI B,.MOREW ;SAY "REWIND"
MTOPR ;DO IT
ERCAL CJERRE ;IF FAILS, SAY WHY AND DIE
RET
;ROUTINE TO OPEN MAG TAPE
;ACCEPTS: A/ JFN
; B/ BITS FOR OPENF
OPNMAG:: STKVAR <MJFN,OBITS>
MOVEM B,OBITS ;REMEMBER OPENF BITS
MOVEM A,MJFN ;REMEMBER JFN
OPN1: OPENF ;TRY TO OPEN
JRST [ CAIE A,OPNX9 ;INVALID SIMULTANEOUS ACCESS?
CALL CJERR ;NO, I CAN'T HANDLE THIS ONE
MOVE A,MJFN ;GET JFN
DVCHR ;TRANSLATE TO DEVICE DESIGNATOR
CALL CJDEV ;TRY TO FIND ANOTHER OPEN JFN
JRST [ MOVEI A,OPNX9 ;NONE
CALL CJERR] ;SO HANG IT UP
MOVE A,MJFN ;RESTORE JFN
MOVE B,OBITS ;RESTORE OPENF BITS
JRST OPN1] ;GO TRY AGAIN
RET
;BITS+N CONTAINS A WORD WITH A 1 IN BIT N
XX==0
BITS:: REPEAT ^D36,<EXP 1B<XX>
XX=XX+1>
XEND==:. ;MUST BE LAST LOCATION OF EXEC !!!!!
END