Trailing-Edge
-
PDP-10 Archives
-
BB-D348F-SM
-
exec/execin.mac
There are 47 other files named execin.mac in the archive. Click here to see a list.
;<4.EXEC>EXECIN.MAC.147, 3-Jan-80 16:07:04, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.EXEC>EXECIN.MAC.146, 17-Dec-79 16:39:16, Edit by HESS
;TCO #4.2594 - Fix symbol conflict in HELP command
;<4.EXEC>EXECIN.MAC.145, 26-Oct-79 11:23:03, EDIT BY TOMCZAK
;TCO#4.2554 - ILLEGAL TERMINAL TYPES NOT HANDLED RIGHT AT ILTTYP+1
;<4.EXEC>EXECIN.MAC.143, 22-Oct-79 13:44:36, EDIT BY OSMAN
;tco 4.2541 - Handle errors in INFO FILS better, where the jfn disappears
;<4.EXEC>EXECIN.MAC.142, 9-Oct-79 12:00:03, EDIT BY OSMAN
;tco 4.2521 - Fix up listing of I STR to not break up user names
;<4.EXEC>EXECIN.MAC.141, 24-Sep-79 12:01:50, Edit by HESS
;<4.EXEC>EXECIN.MAC.140, 20-Sep-79 14:20:35, Edit by HESS
; Use perm free space for FRKTBL
;<4.EXEC>EXECIN.MAC.139, 19-Sep-79 14:14:48, EDIT BY TOMCZAK
;TCO# 4.2475 - Remove parsing for * in HELP command (? does same thing>
;<4.EXEC>EXECIN.MAC.138, 17-Sep-79 14:55:07, Edit by HESS
; Cosmetic change to INFO PROGRAM-STATUS, add more data to INFO COMMAND
;<4.EXEC>EXECIN.MAC.137, 22-Aug-79 00:30:41, Edit by HESS
;<HESS.E>EXECIN.MAC.17, 20-Aug-79 16:33:39, Edit by HESS
; Add extended features
;<4.EXEC>EXECIN.MAC.133, 8-Aug-79 09:53:24, EDIT BY OSMAN
;tco 4.2378 - Expand INFO SYSTEM to include retrieval-wait info
;<4.EXEC>EXECIN.MAC.131, 1-Aug-79 14:59:28, EDIT BY OSMAN
;tco 4.2363 - add INFO DEFAULT TAKE
;<4.EXEC>EXECIN.MAC.128, 1-Aug-79 13:58:12, EDIT BY OSMAN
;tco 4.2362 - Don't list connected structure twice if LPT defined as DSK.
;<4.EXEC>EXECIN.MAC.127, 27-Jul-79 12:32:44, EDIT BY TOMCZAK
;STRST1 - Don't stop executing I STR command so can see subsequent structures
;<4.EXEC>EXECIN.MAC.126, 21-Jun-79 13:38:03, EDIT BY OSMAN
;REMOVE EXTRANEOUS REFS TO RLJFNS
;<4.EXEC>EXECIN.MAC.125, 19-Jun-79 13:03:14, EDIT BY OSMAN
;tco 4.2294 - Don't say "batch class -1"
;<4.EXEC>EXECIN.MAC.124, 5-Jun-79 11:24:26, EDIT BY OSMAN
;tco 4.2272 - Fix ADDRESS-BREAK error on 2020
;<4.EXEC>EXECIN.MAC.123, 1-May-79 11:19:12, EDIT BY OSMAN
;CHANGE GTJFN'S TO CALL GTJFS SO THAT ^C IN MIDDLE WON'T LEAVE JFN AROUND
;<4.EXEC>EXECIN.MAC.122, 27-Apr-79 14:44:24, EDIT BY OSMAN
;Catch error on ADBRK for 2020
;<4.EXEC>EXECIN.MAC.121, 5-Apr-79 06:59:58, EDIT BY R.ACE
;FIX INFO VOLUMES TO DISPLAY SCRATCH TAPES CORRECTLY
;<4.EXEC>EXECIN.MAC.120, 29-Mar-79 15:19:25, EDIT BY OSMAN
;DON'T BOMB ON LARGE MEMORY MAPS. PRINT WARNING AND PARTIAL MAP
;<4.EXEC>EXECIN.MAC.119, 21-Mar-79 10:22:59, EDIT BY OSMAN
;TCO 4.2220 - DON'T KEEL OVER ON INFO MEM IF PAGE IS MAPPED TO RESTRICTED JFN
;<4.EXEC>EXECIN.MAC.118, 14-Mar-79 07:39:58, EDIT BY R.ACE
;CHANGE NOISE ON INFO VOLUMES
;<4.EXEC>EXECIN.MAC.117, 12-Mar-79 17:59:38, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.EXEC>EXECIN.MAC.116, 7-Mar-79 13:27:35, EDIT BY OSMAN
;ADD DREGS REPORT IF CLASS SCHEDULING IS OFF
;<4.EXEC>EXECIN.MAC.115, 7-Mar-79 12:47:26, EDIT BY R.ACE
;ADD TAPE-DRIVE ALLOCATION TO INFO SYSTEM-STATUS COMMAND
;<4.EXEC>EXECIN.MAC.114, 5-Mar-79 15:25:49, EDIT BY HURLEY.CALVIN
; Fix INFO ARC NUL: bug
;<4.EXEC>EXECIN.MAC.110, 2-Mar-79 15:30:44, EDIT BY OSMAN
;TYPE CLASS SCHEDULER STUFF UNDER "INFO SYSTEM-STATUS"
;<4.EXEC>EXECIN.MAC.109, 28-Feb-79 10:32:28, EDIT BY OSMAN
;REMOVE REFS TO CTYPE (USE ETYPE INSTEAD)
;<4.EXEC>EXECIN.MAC.108, 27-Feb-79 15:56:13, EDIT BY OSMAN
;CHANGE CCHRO TO COUTC
;<4.EXEC>EXECIN.MAC.107, 12-Feb-79 14:08:46, EDIT BY HURLEY.CALVIN
; CHANGE BITS FOR SPECFN IN .ARSTS SO TRAILING "," DOESN'T SCREWUP
;<4.EXEC>EXECIN.MAC.106, 8-Feb-79 16:36:51, EDIT BY OSMAN
;ADD INFO DEF PLOT
;<4.EXEC>EXECIN.MAC.105, 7-Feb-79 10:42:06, EDIT BY OSMAN
;HANDLE FAILURE FROM GETNOD
;<HURLEY.CALVIN>EXECIN.MAC.1, 1-Feb-79 13:22:16, EDIT BY HURLEY.CALVIN
; Cause INFO ARCHIVE-STATUS to not print "None" files, find invisible
; ones, and default to * for extension
;<4.EXEC>EXECIN.MAC.101, 30-Jan-79 16:35:19, EDIT BY OSMAN
;ADD LA38, LA120
;<4.EXEC>EXECIN.MAC.100, 26-Jan-79 15:32:00, EDIT BY OSMAN
;keep all guide words UPPERCASE
;<4.EXEC>EXECIN.MAC.98, 26-Jan-79 13:46:30, EDIT BY OSMAN
;CHANGE INFO STR TO REFER TO MOUNT INSTEAD OF SMOUNT
;<4.EXEC>EXECIN.MAC.96, 26-Jan-79 13:41:43, EDIT BY OSMAN
;don't let INFO MEM buffer overflow
;<4.EXEC>EXECIN.MAC.95, 25-Jan-79 17:03:42, EDIT BY R.ACE
;MAKE INFO VOLUMES CONFORM TO NEW GALAXY TEXT MESSAGE FORMAT
;<4.EXEC>EXECIN.MAC.90, 25-Jan-79 14:12:53, EDIT BY OSMAN
;tco 4.2172 - speed up INFO MEM
;<4.EXEC>EXECIN.MAC.89, 23-Jan-79 09:42:18, EDIT BY OSMAN
;CHANGE NODE OUTPUT FORMAT "INFO JOB"
;<4.EXEC>EXECIN.MAC.88, 15-Jan-79 02:42:30, EDIT BY HEMPHILL
;MAKE EXEC UNDERSTAND USER EXTENDED ADDRESSING FOR "SET ADDRESS-BREAK",
; "INFORMATION PROGRAM", ^T, "INFORMATION MEMORY-USAGE"
;<4.EXEC>EXECIN.MAC.87, 14-Jan-79 13:40:41, EDIT BY KIRSCHEN
;USE SYMBOL .NDBK1 IN INFO DECNET
;<4.EXEC>EXECIN.MAC.86, 3-Jan-79 10:40:38, EDIT BY OSMAN
;try another flavor of "info job"
;<4.EXEC>EXECIN.MAC.85, 20-Dec-78 15:47:27, EDIT BY HURLEY.CALVIN
; Add 1B17 to SPECFN bits in .ARSTS
;<4.EXEC>EXECIN.MAC.84, 20-Dec-78 07:16:02, EDIT BY R.ACE
;ADD INFORMATION (ABOUT) VOLUMES
;<4.EXEC>EXECIN.MAC.83, 18-Dec-78 16:43:25, EDIT BY OSMAN
;ONLY DISPLAY NODE ON INFO JOB IF DIFFERENT FROM HOST NODE NAME
;<4.EXEC>EXECIN.MAC.80, 5-Dec-78 13:05:33, EDIT BY OSMAN
;Make INFO SYSTEM-STATUS display scheduler bias-control
;<4.EXEC>EXECIN.MAC.79, 22-Nov-78 12:54:39, EDIT BY KIRSCHEN
;REMOVE INFO DECNET STATUS, MAKE INFO DECNET NODES DEFAULT
;<4.EXEC>EXECIN.MAC.78, 8-Nov-78 16:06:08, EDIT BY HEMPHILL
;ALLOW WILDCARDS IN HLP: DEFINITION TO WORK BY ADDING GJ%IFG AT
; HLP3
;<4.EXEC>EXECIN.MAC.77, 26-Oct-78 16:03:38, EDIT BY OSMAN
;REMOVE REFS TO GSSBLK (USE LOCAL ISBLK INSTEAD)
;<4.EXEC>EXECIN.MAC.76, 25-Oct-78 16:29:32, EDIT BY OSMAN
;PRINT OUT LOGICAL LOCATION IN JOBSTAT (.JOBST)
;<ARC-DEC>EXECIN.MAC.6, 11-Oct-78 12:31:07, EDIT BY CALVIN
; Add INFO RETRIEVE-REQUESTS
;[BBN-TENEXD]<CALVIN>EXECIN.MAC.1, 8-Aug-78 11:20:29, Ed: CALVIN
; Install code for INFO ARCHIVE-STATUS command
;<3-ARC-EXEC>EXECIN.MAC.2, 14-May-78 20:38:35, Edit by MTRAVERS
;<3-ARC-EXEC>EXECIN.MAC.1, 14-May-78 15:40:28, Edit by MTRAVERS
; Added INFO ARCHIVE-STATUS to command table
;<4.EXEC>EXECIN.MAC.74, 13-Oct-78 10:55:15, EDIT BY OSMAN
;ADD INFO MOUNT-REQUESTS
;<4.EXEC>EXECIN.MAC.73, 10-Oct-78 09:56:15, EDIT BY R.ACE
;FIX BUG IN MT DEVICE DISPLAY FIX
;<4.EXEC>EXECIN.MAC.72, 29-Sep-78 15:39:33, EDIT BY R.ACE
;Make INF AVAIL DEV ;<4.EXEC>EXECIN.MAC.71, 28-Sep-78 15:21:48, EDIT BY KIRSCHEN
;ADD TEST FOR ILLEGAL FUNCTION AT DNTOPE, ALSO MERELY RETURN
;<4.EXEC>EXECIN.MAC.70, 28-Sep-78 15:05:29, EDIT BY KIRSCHEN
;AVOID !DISABLED! IN INFO TERM AT WRONG TIME
;<4.EXEC>EXECIN.MAC.69, 28-Sep-78 14:54:11, EDIT BY KIRSCHEN
;REMOVE IFN CONDITIONAL FROM .DNSTS
;<4.EXEC>EXECIN.MAC.68, 27-Sep-78 20:19:51, EDIT BY OSMAN
;GET RID OF Bn SYMBOLS
;<4.EXEC>EXECIN.MAC.64, 16-Sep-78 00:01:02, EDIT BY OSMAN
;GET RID OF REFS TO CSBUFP
;<4.EXEC>EXECIN.MAC.60, 14-Sep-78 14:14:00, EDIT BY OSMAN
;ONLY SEARCH XDEF, TTITLE DOES REST
;<4.EXEC>EXECIN.MAC.59, 7-Sep-78 15:21:37, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.58, 7-Sep-78 15:19:15, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.57, 7-Sep-78 15:18:00, EDIT BY HELLIWELL
;ADD " !DISABLED!" AFTER "TERMINAL PAUSE (ON) END-OF-PAGE" IF "TERMINAL NO PAUSE (ON) COMMAND"
;<4.EXEC>EXECIN.MAC.56, 1-Sep-78 22:17:05, EDIT BY OSMAN
;PUT IN VT100 STUFF
;<4.EXEC>EXECIN.MAC.55, 28-Aug-78 19:12:24, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.54, 28-Aug-78 19:04:19, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.53, 28-Aug-78 18:55:49, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.52, 28-Aug-78 18:53:07, EDIT BY HELLIWELL
;CHANGE "INFO TERMINAL" TO REFLECT "TERMINAL PAUSE"
;<4.EXEC>EXECIN.MAC.51, 25-Aug-78 17:05:05, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.50, 24-Aug-78 16:22:38, EDIT BY HELLIWELL
;REFORMAT "INFO DECNET NODES" TYPEOUT
;<4.EXEC>EXECIN.MAC.49, 23-Aug-78 11:48:32, EDIT BY HELLIWELL
;PLACE MANY NODE NAMES ON SAME LINE IN "INFO DECNET NODES"
;<4.EXEC>EXECIN.MAC.48, 23-Aug-78 08:12:26, EDIT BY KIRSCHEN
;FIX INFO DECNET NODES
;<4.EXEC>EXECIN.MAC.47, 21-Aug-78 16:47:56, EDIT BY HELLIWELL
;REMOVE "INFO EDITOR"
;<4.EXEC>EXECIN.MAC.46, 16-Aug-78 17:16:46, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.45, 16-Aug-78 17:12:10, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.44, 16-Aug-78 17:02:26, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.43, 16-Aug-78 17:01:18, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.42, 16-Aug-78 14:16:38, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.41, 16-Aug-78 14:10:19, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.40, 16-Aug-78 13:43:26, Edit by HELLIWELL
;CHANGE "INFO NETWORK-STATUS" TO "INFO ARPANET" AND "INFO DECNET"
;<4.EXEC>EXECIN.MAC.39, 16-Aug-78 11:34:43, EDIT BY OSMAN
;FIX "INFO LOG" (GETTER CLOBBERS B)
;<4.EXEC>EXECIN.MAC.38, 16-Aug-78 11:24:09, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.37, 16-Aug-78 11:13:47, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.36, 13-Aug-78 15:42:42, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.35, 13-Aug-78 15:36:26, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.34, 13-Aug-78 14:55:02, Edit by HELLIWELL
;<4.EXEC>EXECIN.MAC.33, 13-Aug-78 14:50:48, Edit by HELLIWELL
;ADD "INFO EDITOR"
;<4.EXEC>EXECIN.MAC.32, 10-Aug-78 11:28:39, EDIT BY OSMAN
;ALLOW WILDCARDING ON INFO DISK
;<4.EXEC>EXECIN.MAC.25, 28-Jul-78 13:50:21, EDIT BY OSMAN
;CHANGE "COMPILER-SWITCHES" TO "COMPILE-SWITCHES"
;<4.EXEC>EXECIN.MAC.22, 27-Jul-78 15:39:08, EDIT BY OSMAN
;<4.EXEC>EXECIN.MAC.21, 27-Jul-78 14:41:37, EDIT BY OSMAN
;allow "info logical-name foo:"
;<4.EXEC>EXECIN.MAC.20, 18-Jul-78 17:18:36, EDIT BY OSMAN
;MAKE HELP COMMAND SET UP Q1, AND CALL GTJFS
;<4.EXEC>EXECIN.MAC.19, 13-Jul-78 14:44:44, EDIT BY OSMAN
;CHANGE TAG DSKCN1 TO 0
;<4.EXEC>EXECIN.MAC.18, 13-Jul-78 14:33:48, EDIT BY OSMAN
;MAKE SIZCN1, SIZCN2, PAGFL1, PAGFL2 BE LOCAL (DSKCN1, ...)
;<4.EXEC>EXECIN.MAC.17, 11-Jul-78 16:21:40, EDIT BY OSMAN
;MAKE INFO LOGICAL NAMES AND INFO MAIL USE LOCAL VARIABLES
;<4.EXEC>EXECIN.MAC.16, 29-Jun-78 15:29:39, EDIT BY OSMAN
;make "alias" part of trvar
;<4.EXEC>EXECIN.MAC.15, 27-Jun-78 16:09:57, EDIT BY OSMAN
;CHANGE ALL THE GTB'S TO BE IMMEDIATE
;<4.EXEC>EXECIN.MAC.14, 23-Jun-78 21:26:42, EDIT BY OSMAN
;REMOVE UNREFERENCED SYMBOLS: CHKDLX, MMAP, .TE
;<4.EXEC>EXECIN.MAC.13, 14-Jun-78 14:53:19, EDIT BY OSMAN
;ADD INFO DEFAULTS
;<4.EXEC>EXECIN.MAC.11, 9-Jun-78 18:08:15, EDIT BY OSMAN
;CHANGE CALLS TO FIELD TO FLDSKP
;<3-EXEC-SNARK>EXECIN.MAC.50, 20-Apr-78 11:22:28, Edit by FORTMILLER
;<4.EXEC>EXECIN.MAC.9, 17-Jan-78 10:13:30, EDIT BY HELLIWELL
;RELEASE JFNS AFTER DSKCNT IN INFO DISK COMMAND
;<4.EXEC>EXECIN.MAC.8, 6-Jan-78 17:06:56, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.7, 6-Jan-78 17:04:15, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.6, 6-Jan-78 17:02:00, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.5, 6-Jan-78 16:53:38, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.4, 6-Jan-78 16:48:02, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.3, 6-Jan-78 16:47:19, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.2, 6-Jan-78 16:30:23, EDIT BY HELLIWELL
;<4.EXEC>EXECIN.MAC.1, 6-Jan-78 16:15:43, EDIT BY HELLIWELL
;MAKE INFO DISK DO * & %
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
;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 EXECIN
;THIS FILE CONTAINS
;INFORMATION COMMANDS
;EXCEPT INFORMATION (ABOUT) BATCH-REQUESTS AND
;INFORMATION (ABOUT) OUTPUT-REQUESTS, WHICH ARE IN EXECQU.MAC
; Print status (in terms of the archive) of files
.ARSTS::NOISE <OF FILES>
TXO Z,IGINV ; Find invisible ones to boot
MOVE A,[XWD [ASCIZ /*/],[ASCIZ /*/]] ; Default name & ext is *
HRLI B,-3 ; Default version is *
HRRI B,(GJ%OLD+GJ%IFG+GJ%NS+1B15+1B16+CF%NS)
CALL SPECFN
JRST CERR ; No "stuff,"
SETOM TYPGRP ; Always type name
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
ARSTS3: CALL RLJFNS
CALL NXFILE
JRST ARSTS4
CALL MFINP ; Get 2nd JFN
JRST ARSTS4 ; Failed
CALL ARSTS ; Print status
ARSTS4: SKIPE INIFH1 ; Done them all?
JRST ARSTS3 ; No, loop
RET
ARSTS:: TLZ Z,F2 ; Comma flag
MOVE B,[1,,.FBCTL]
MOVEI C,D
GTFDB
ERJMP [HRROI B,[ASCIZ / Tape information not available/]
CALL ARPNT
RET]
MOVE B,[1,,.FBBBT]
MOVEI C,C
GTFDB
EXCH C,D ; Swap 'em
TXNN C,FB%ARC ; File have archive status?
JRST ARSTS1 ; No
HRROI B,[ASCIZ / Archive status is not valid/]
TXNE D,AR%1ST
CALL ARPNT
HRROI B,[ASCIZ / Archived/]
TXNE D,AR%RAR ; Request too? (Archive in progress?)
HRROI B,[ASCIZ / Archive in progress/]
TXNN D,AR%1ST
CALL ARPNT
HRROI B,[ASCIZ / Migration requested/]
TXNE D,AR%RIV
CALL ARPNT
NONE: TLOE Z,F2 ; Print anything?
TYPE <
> ; Yes, end with CRLF
RET
ARSTS1: TXNN D,AR%RAR+AR%EXM+AR%RIV ; Anything we've an interest in?
JRST NONE ; No
HRROI B,[ASCIZ / Archive requested/]
TXNE D,AR%RAR
CALL ARPNT
HRROI B,[ASCIZ / Retain contents/]
TXNE D,AR%NDL
CALL ARPNT
HRROI B,[ASCIZ / Migration prohibited/]
TXNE D,AR%EXM
CALL ARPNT
HRROI B,[ASCIZ / Migration requested/]
TXNE D,AR%RIV
CALL ARPNT
JRST NONE
ARPNT: TLON Z,F2 ; Need <comma><space>?
JRST [ ETYPE < %1S> ; Print the file name
JRST .+2] ; And don't do the comma
TYPE <, >
UTYPE 0(B) ; Type the string
RET
.AVAIL::KEYWD $AVAIL
T DEVICES, ;[TAH] CHANGE DEFAULT TO DEVICES
JRST CERR
;CAN'T CONFIRM HERE BECAUSE OF FUDGE-ENTRIES IN TABLE
JRST (P3)
$AVAIL: TABLE
T DEVICES,
T LINES,,..TERM
TA T ;"T" = "TERMINALS"
TA T ;"T" IS "TERMINALS"
T TELETYPES,,..TERM,CM%INV
.T:
.TE:
T TERMINALS,,..TERM,CM%INV
T TTYS,,..TERM,CM%INV
TEND
;AVAILABLE TERMINALS
..TERM::CONFIRM
HLLZ D,TTYJOB ;SETUP NUMBER OF TERMINAL LINES
TERMI1: HRRZI A,.TTDES(D) ;TERMINAL DESIGNATOR
DVCHR ;GET ITS STATUS
TXNN B,DV%AV ;IS IT AVAILABLE
JRST TERMI9 ;NO - TRY NEXT
CALL BEFORE ;TYPE COMMA OR MAYBE EOL
HRRZ B,D
CALL TOCT ;TYPE LINE NUMBER
;SEE IF SEVERAL CONSECUTIVE LINES TO BE GROUPED, E.G. 21-26
PUSH P,D ;SAVE ONE JUST TYPED
AOBJN D,TERMI7 ;PEEK AT NEXT ONE
POP P,D ;NO MORE, WRAP UP
JRST TERMI9
TERMI7: HRRZI A,.TTDES(D) ;FORM TERM DESIGNATOR
DVCHR ;GET CHARACTERISTICS
TXNE B,DV%AV ;AVAILABLE?
AOBJN D,TERMI7 ;YES, KEEP LOOKING
POP P,C ;FOUND NOT AVAIL OR AND OF LIST
SUB D,[1,,1] ;GET BACK TO LAST AVAIL ONE FOUND
CAMN D,C ;SAME AS LAST ONE PRINTED?
JRST TERMI9 ;YES, NO GROUPING TO BE DONE
PRINT "-" ;FIRST OF GROUP HAS BEEN PRINTED, NOW
HRRZ B,D ; PRINT DASH AND LAST OF GROUP
CALL TOCT
TERMI9: AOBJN D,TERMI1
TLNN Z,F1
TYPE < All lines in use>
EOLRET::ETYPE<%_> ;COME HERE TO TYPE CRLF AND POPJ.
RET
;AVAILABLE DEVICES
;DOES NOT LIST TTYS
;ALSO LISTS SEPERATELY DEVICES ALREADY ASSIGNED TO THIS JOB.
.DEVIC::CONFIRM
TLZ Z,F1+F2 ;SAY NOTHING TYPED YET
MOVEI P3,-3 ;SAY NO PREVIOUS GROUP ITEM
MOVEI Q1,0 ;LAST DEVICE NAME PRINTED
;"DEVLUP" EXECUTES CALLER+1 FOR EACH DEVICE, WITH NAME IN A,
;DVCHR WORD IN B.
CALL DEVLUP
CALL DEVIC1 ;DO THIS FOR EACH DEVICE
TLZE Z,F2 ;GROUP STARTED?
CALL AVD1 ;YES, FINISH IT
TLNN Z,F1
TYPE <No devices currently available to this job>
ETYPE<%_>
JRST ASTTJ ;LIST DEVS ASSIGNED TO THIS JOB. WITH FILSTAT.
DEVIC1: TXNN B,DV%AV ;SKIP IF DEVICE AVAILABLE TO THIS JOB
RET
LDB C,[POINT 9,B,17] ;GET DEVICE TYPE
CAIN C,.DVTTY ;SKIP TTYS
RET
AND B,[DV%TYP!777777] ;MASK TO JUST DEVICE TYPE AND UNIT #
CAIN C,.DVDSK ;A MOUNTABLE STRUCTURE (DISK)?
JRST DEVIC9 ;YES, ALWAYS SEPERATE
LDB C,[360600,,A] ;GET FIRST LETTER OF DEVICE
LDB D,[360600,,Q1] ;GET FIRST LETTER OF LAST DEVICE
CAME C,D ;SAME?
JRST DEVIC9 ;NO, CAN'T POSSIBLY BE IN SEQUENCE
;WHY ALL THE BRUHAHA, YOU MUST ASK!
;WELL AT THIS TIME (10/26/76), PLPT0:
;AND LPT0: ETC. YIELD EXACT SAME
;DEVICE DESIGNATOR
MOVE C,P3 ;SEE IF DEVICE IS NEXT IN SEQUENCE
HRRI C,1(C) ;18BIT ADD
CAMN B,C ;NEXT UNIT OF SAME DEVICE?
JRST [ TLO Z,F2 ;YES, NOTE GROUP BEING PROCESSED
MOVEM B,P3 ;UPDATE UNIT NUMBER
MOVEM A,Q1 ;REMEMBER NEW LAST NAME
RET]
DEVIC9: TLZE Z,F2 ;NOT IN SEQUENCE, PREVIOUS SEQUENCE?
CALL AVD1 ;YES, FINISH IT
MOVEM B,P3 ;REMEMBER LAST DEVICE PRINTED
MOVEM A,Q1 ;REMEMBER NAME PRINTED
TLNN Z,F1 ;FIRST ONE?
TYPE <Devices available to this job:
>
CALL BEFORE ;DO SEPARATING CHARACTER
CALLRET SIXPRT ;PRINT NAME AND RETURN
AVD1: PUSH P,B
MOVEI B,"-" ;FINISH UP GROUP
CALL COUTC
MOVE B,P3 ;GET LAST DEVICE DESIGNATOR
TLC B,.DVMTA
TLZN B,777777 ;MAGTAPE DEVICE?
TRZ B,400000 ;YES, CLEAR B18 IN CASE IT'S AN MT
CALL TOCT ;PRINT IT
POP P,B
RET
;SUBROUTINE FOR FORMATTING A LIST OF ITEMS SEVERAL TO A LINE.
;USED FOR AVAILABLE TERMINALS, AVAILABLE DEVICES, AND FILSTAT.
;BEFORE EACH ITEM: COMMA EXCEPT CRLF IF TOO FAR TO RIGHT.
BEFORE::ATSAVE
MOVE A,COJFN
movei b,.morlw
MOVEI C,^D72 ;USE 72 COLUMNS IF NOT A TERMINAL
mtopr ;get line width
ERJMP .+1 ;IF NOT, USE 72(PRESUMABLY NOT A TERMINAL)
RFPOS
MOVEI B,(B) ;MASK COLUMN POSITION
CAIL B,-7(C) ;WITHIN 7 CHARS OF END OF LINE?
JRST [ ETYPE<%_> ;YES, START NEW LINE
JRST BEFO1]
TLOE Z,F1 ;SUPPRESS COMMA BEFORE FIRST ONE
PRINT ","
BEFO1: PRINT " " ;SPACE AFTER COMMA OR EOL
RET
;SUBROUTINE TO LOOP OVER ALL DEVICES FOR "AVAIL DEVICES" AND "FILSTAT".
;FOR EACH DEVICE, EXECUTES LOCATION AFTER CALL WITH SIXBIT NAME IN A
; DEVICE CHARACTERISTICS WORD IN LH B
; UNIT NUMBER IN RH OF B
; -1 OR JOB # ASSIGNED TO IN C.
; DEVICE DESIGNATOR IN D
;RETURNS +2.
;DESTROYS A, B, C, D.
DEVLUP::SETO D,
GTB .DEVNA ;GET # DEVICES FROM TABLE 6
HRLZ D,A ;XWD AOBJN COUNT, TABLE INDEX
DEVL1: PUSH P,D
CALL .DVCHR ;GET DEVICE CHARACTERISTICS
JRST DEVL2 ;SKIP THIS ONE IF UNKNOWN DEVICE
MOVE D,A ;GIVE GUY DEVICE DESIGNATOR IN D
HRR B,C ;GET UNIT NUMBER
HLRE C,C
EXCH D,(P) ;SAVE DESIGNATOR, GET INDEX INTO DEVICE TABLE
GTB .DEVNA ;GET DEVICE NAME IN SIXBIT FROM TABLE 6
EXCH D,(P) ;SAVE INDEX, GET DESIGNATOR
JUMPE A,DEVL2 ;SKIP NULL ENTRIES
XCT @-1(P)
DEVL2: POP P,D
AOBJN D,DEVL1
RETSKP
;TYPE SIXBIT SYMBOL FROM A.
;USED IN "AVAILABLE DEVICES", "SYSTAT", "STATISTICS", AND "FILSTAT".
SIXPRT::ATSAVE
MOVE C,A
SIXPR1: SETZ B,
LSHC B,6
ADDI B,40
CALL COUTC
JUMPN C,SIXPR1
RET
;THIS ROUTINE TAKES DEVICE INDEX IN D AND DOES DVCHR, RETURNING
;DVCHR'S INFO IN A,B,C. NOTHING ELSE IS CHANGED.
;RETURNS:
; +1: NO SUCH DEVICE
; +2: SUCCESS
.DVCHR: PUSH P,P1 ;WE'LL NEED THESE, BUT DON'T HURT THEM
PUSH P,P2
GTB .DEVNA ;GET SIXBIT NAME INTO A
MOVE B,[440600,,A] ;PREPARE TO READ THE SIXBIT NAME FROM A
DV1: TLNN B,770000 ;ARE WE DONE?
JRST DV2 ;YES, GO LEFT-JUSTIFY
ILDB C,B ;GET SIXBIT CHARACTER FROM NAME
CAIE C,0 ;LEAVE 0'S AS 0'S!
ADDI C,"A"-'A' ;CHANGE TO ASCII
LSHC P1,7 ;MAKE ROOM FOR THE CHARACTER
IOR P2,C ;PUT IN THE CHARACTER
JRST DV1 ;GO DO NEXT CHARACTER
DV2: LSHC P1,2*^D36-6*7-1 ;LEFT JUSTIFY
LSH P1,1 ;^D36=1(MOD 5*7)
HRROI A,P1 ;POINT TO THE ASCII NAME OF THE DEVICE
STDEV ;GET A DEVICE DESIGNATOR FOR THIS DEVICE
ERJMP DEVOUT ;JUST RETURN IF CAN'T
MOVE A,B ;PUT DESIGNATOR IN A
DVCHR ;GET CHARACTERISTICS
AOS -2(P) ;WE WANT TO SKIP RETURN
DEVOUT: POP P,P2
POP P,P1
RET
;help *, help <cr>, help foo
.help:: STKVAR <<HLPBUF,FILWDS>,HITEM>
noise (ON SUBJECT)
call maklst ;make list of things there's help on
movei b,[flddb. .cmkey,,$HELP.,,,[
flddb. .cmcfm,,,,,]]
CALL FLDSKP ;get some input
error <Invalid HELP request, try "HELP<RET>">
LDB C,[331100,,.CMFNP(C)] ;SEE WHAT GOT TYPED
CAIN C,.CMCFM ;CR?
JRST BLURB ;YES, GO TYPE GENERAL HELP BLURB
CONFIRM ;GET COMMAND CONFIRMATION
repeat 0,< ;TCO#4.2475
CAIN C,.CMTOK ;*?
JRST TYPLST ;YES, TYPE OUT THE LIST
>
MOVEM B,HITEM ;SAVE POINTER TO ITEM HELP DESIRED ABOUT
HRROI A,HLPBUF ;PREPARE TO CREATE FILENAME STRING
HRROI B,[ASCIZ /HLP:/]
MOVEI C,0 ;WE WANT NULL AFTER FILENAME
SOUT ;PUT IN DEVICE NAME
MOVE B,HITEM ;GET POINTER TO FILENAME STRING
HLRO B,(B) ;MAKE BYTE POINTER
SOUT ;PUT IN FILENAME
HRROI B,[ASCIZ /.HLP/] ;NOW WE'LL HAVE HLP:MUMBLE.HLP
SOUT
HRROI B,HLPBUF ;POINTER TO FILENAME
HLP3: MOVX A,GJ%OLD+GJ%SHT+GJ%IFG ;OLD FILE ONLY, SHORT FORM
CALL GTJFS ;GET HANDLE ON HELP FILE
ERROR <No help available on that subject>
MOVEI Q1,CP%HEL ;SO "TYPE" LOGIC WILL KNOW IT'S US
MOVE A,JBUFP ;GET POINTER TO JFN CELL
HRRZM A,INIFH1
HRRZM A,INIFH2 ;COPY CODE NEEDS THIS
JRST TYPE1 ;FINISH COMMAND BY COPYING HELP FILE TO TERMINAL
;HELP<CR> JUST TYPES OUT "HLP:HELP.HLP"
BLURB: HRROI B,[ASCIZ /HLP:HELP.HLP/]
JRST HLP3 ;GO TYPE OUT CONTENTS OF FILE
;HELP * LISTS ALL SUBJECTS FOR WHICH HELP IS AVAILABLE
repeat 0,< ;TCO#4.2475
TYPLST: HLRZ Q1,$HELP. ;GET NUMBER OF ENTRIES FOR WHICH THERE'S HELP
JUMPE Q1,NOHELP ;SPECIAL CASE IF NONE
TYPE <Help is available on these subjects:
>
MOVEI Q2,0 ;KEEPS TRACK OF HOW MANY ITEMS WE'VE PRINTED ON THIS LINE
MOVN Q1,Q1
HRLZ Q1,Q1 ;MAKE AOBJN POINTER
LST1: TRNN Q2,7 ;ENOUGH ITEMS BEEN PRINTED YET?
ETYPE<%_> ;YES, START NEW LINE
HLRO A, $HELP.+1(Q1) ;GET ASCII POINTER TO ENTRY
ETYPE <%1M > ;TYPE ENTRY WITH TAB AFTER IT
AOJ Q2, ;COUNT ITEMS ON LINE
AOBJN Q1,LST1 ;LOOP FOR REST OF ITEMS
ETYPE<%_> ;FINISH WITH CARRIAGE RETURN
JRST ENDHLP ;DONE
>
NOHELP: TYPE <No help available
>
JRST ENDHLP
;DONE DOING HELP COMMAND, CLEAN UP AND RETURN
ENDHLP: RET ;RETURN
;SPECIAL BUFFER ASSIGNMENTS FOR HELP COMMAND
$HELP.==BUF0 ;TABLE OF HELP CATEGORIES
HLPLEN==BUF1-BUF0-1 ;MAXIMUM NUMBER OF SUBJECTS AVAILABLE
;ROUTINE TO MAKE LIST OF SUBJECTS THERE'S HELP ON. THE LIST IS
;GENERATED BY THE FILENAMES OF ALL THE .HLP FILES ON THE HLP:
;DEVICE.
MAKLST: MOVEI A,HLPLEN ;MAXIMUM LENGTH OF TABLE
MOVEM A,$HELP. ;INITIALIZE TABLE OF ITEMS THERE'S HELP ON
HRROI Q1,BUF1 ;INITIALIZE POINTER TO NAME STORAGE AREA
HRROI B,[ASCIZ /hlp:*.HLP/] ;HANDLE ON HELP FILES
call hlplst ;accumulate help file names in table
RET
;routine to accumulate help file names in table
hlplst: stkvar <hlpjfn> ;holds jfn of help files
MOVX A,GJ%OLD+GJ%IFG+GJ%SHT ;OLD FILE ONLY, ALLOW STARS, SHORT FORM
CALL GTJFS ;GET AND STACK JFN
RET ;NO HELP FILES
MOVEM A,HLPJFN ;REMEMBER THE JFN
HLP2: MOVE A,Q1 ;POINTER TO AREA IN WHICH TO STORE NAME
HRRZ B,HLPJFN ;GET JFN OF HELP FILE
MOVX C,1B8 ;WE WANT JUST THE FILENAME
JFNS ;GET FILENAME (ENTRY FOR TABLE)
MOVEI A,BUF0 ;TELL SYSTEM WHERE TABLE BEGINS
HRLZ B,Q1 ;GET ENTRY FOR TABLE (POINTS TO FILENAME)
TBADD ;PUT NEW ENTRY IN TABLE
ADDI Q1,8+8 ;POINT TO NEXT FILENAME ENTRY
move a,hlpjfn ;get jfn again
gnjfn ;step to next help file
erjmp r ;no more in this set
jrst hlp2 ;got another, go process it
;INFO (ON)
.INFOR::NOISE <ABOUT>
KEYWD $INFO
0
JRST CERR
TXNN P3,NOLG ;NEED TO BE LOGGED IN?
SKIPE CUSRNO ;YES, ARE WE?
CAIA ;OK
ERROR <LOGIN please>
TXNE P3,ONEWRD ;THESE NEED CONFIRMING
CONFIRM
JRST (P3)
;INFO DEFAULTS
.DEFAU: NOISE (FOR)
KEYWD $DEF ;SEE WHAT TO PRINT DEFAULTS ABOUT
0 ;NO DEFAULT
CMERRX
CONFIRM ;WAIT FOR CONFIRMATION
JRST (P3) ;GO DO IT
$DEF: TABLE
T CARDS,,.IDC
T COMPILE-SWITCHES,,.IDCS
T PAPER-TAPE,,.IDP
T PLOT,,.IDPL
T PRINT,,.IDPRT
T SUBMIT,,.IDS
T TAKE,ONEWRD,.IDTAK
TEND
$INFO: TABLE
T ADDRESS-BREAK,ONEWRD,.ADBRK
XTND,<
T ALERTS,,.ALRST
>
T ARCHIVE-STATUS,,.ARSTS
T ARPANET,NOLG,.IARPA
T AVAILABLE,NOLG
T BATCH-REQUESTS,,.IBR
;T CARD-READER-INPUT-SET,ONEWRD,CRDINF
T COMMAND-LEVEL,NOLG+ONEWRD,.EXECM
T DECNET,NOLG,.IDECN
T DEFAULTS
T DIRECTORY ;PRINT DIRECTORY PARAMETERS
T DISK-USAGE,,.DSKST
XTND,<
T DOWNTIME,ONEWRD+NOLG ; ERUN MHALT (E-V 2)
TA F ; ALIAS FOR FILE STATUS
>
.F: T FILE-STATUS,,.FILST
XTND,<
T FORK-STATUS,ONEWRD,.FRKST
>
T JOB-STATUS,ONEWRD,.JOBST
T LOGICAL-NAMES,,.LNLIS
T MAIL,NOLG,.MALST
T MEMORY-USAGE,ONEWRD,.MEMST
T MONITOR-STATISTICS,ONEWRD,MONSTA
T MOUNT-REQUESTS,,.IMR
T OUTPUT-REQUESTS,,.IPR
T PROGRAM-STATUS,ONEWRD,.RUNST
T PSI-STATUS,ONEWRD,.PISTA
T RETRIEVAL-REQUESTS,,.IRR
T SPOOLED-OUTPUT-ACTION,ONEWRD,SPLINF
T STRUCTURE,,.STRST
T SUBSYSTEM-STATISTICS,ONEWRD,SUBSTA
T SYSTEM-STATUS,ONEWRD,SYSINF
T TAPE-PARAMETERS,ONEWRD,TAPINF
T TERMINAL-MODE,NOLG+ONEWRD,TRMPNT
T VERSION,NOLG+ONEWRD
T VOLUMES,,IVOL
TEND
;INFO DEFAULT TAKE
.IDTAK: HRROI A,[0] ;FIRST ASSUME NO NO
SKIPN PECHOF ;NO?
HRROI A,[ASCIZ /NO /] ;YES, NO
ETYPE < SET DEFAULT TAKE %1MECHO%_>
RET
;INFORMATION (ABOUT) ADDRESS-BREAK
ALLFLG==AB%RED!AB%WRT!AB%XCT ;ALL ADDR BREAK BITS
.ADBRK: SKIPG A,FORK ;GET FORK HANDLE
JRST [ TYPE < No program>
RET]
HRLI A,.ABRED ;FUNCTION TO READ ADDRESS BREAK INFO
ADBRK ;GET IT
ERJMP [ CALL DGETER ;GET REASON FOR FAILURE
CAIE A,ABRKX1 ;NOT AVAILABLE ON THIS SYSTEM?
CALL CJERR ;OTHER ERROR, DO ERROR MESSAGE
ETYPE <%%%%1?%%_>;YES, THAT'S THE "INFORMATION"!
RET] ;DONE
SKIPE C ;ANYTHING THERE?
TXNN C,ALLFLG ;ANY BITS SET?
JRST [ TYPE <Address break not set.>
RET] ;NO
ETYPE <Address break at %2Y on>
TXC C,ALLFLG ;FIRST CHECK FOR COMMON CASE OF
TXCN C,ALLFLG ;ALL BITS BEING SET
JRST [ TYPE < all types of references.>
RET] ;THAT WAS EASY!
TXNE C,AB%RED ;READ
TYPE < read>
TXNE C,AB%WRT ;WRITE
TYPE < write>
TXNE C,AB%XCT ;EXECUTE
TYPE < execute>
TYPE <.>
RET ;AND RETURN
;INFORMATION (ABOUT) DIRECTORY (NAME)
;SAME AS ^EPRINT
.DIREC: JRST EPRINT ;USE SAME CODE
;GET HERE ON "INFORMATION (ABOUT) COMMAND-LEVEL"
.EXECM:
TYPE < SET >
SKIPN CIDLYF
TYPE <NO >
TYPE <LATE-CLEAR-TYPEAHEAD
>
XTND,<
TYPE < SET >
SKIPN IITSET ; TIMER ENABLED?
TYPE <NO >
TYPE <AUTOMATIC (MAIL AND ALERT CHECKS)
>
>
RET
;"INFORMATION (ABOUT) SYSTEM-STATUS"
SYSINF: MOVEI A,.SFOPR
TMON
TYPE < Operator is >
SKIPN B
TYPE <not >
TYPE <in attendance
>
MOVEI A,.SFRMT
HRROI B,[ASCIZ / Remote logins /]
CALL TYPALO
MOVEI A,.SFLCL
HRROI B,[ASCIZ / Local logins /]
CALL TYPALO
MOVEI A,.SFPTY
HRROI B,[ASCIZ / Pseudo-terminal logins /]
CALL TYPALO
MOVEI A,.SFNVT
HRROI B,[ASCIZ / ARPANET terminal logins /]
CALL TYPALO
MOVEI A,.SFCTY
TMON
TYPE < Console terminal login >
SKIPN B
TYPE <is not >
TYPE <allowed
>
MOVEI A,.SFFAC
TMON
TYPE < Accounting is >
SKIPN B
TYPE <not >
TYPE <being done
>
MOVEI A,.SFCDE
TMON
SKIPE B
TYPE < CHECKD found errors
>
MOVEI A,.SFCDR
SKIPE B
TYPE < CHECKD is running
>
MOVEI A,.SFAVR ;SEE IF ACCOUNT VALIDATION IN EFFECT
TMON
TYPE < Account validation is >
CALL INSYED ;TYPE "ENABLED" OR "DISABLED"
MOVEI A,.SFMTA ;DISPLAY STATE OF TAPE-DRIVE ALLOCATION
TMON
TYPE < Tape-drive allocation is >
CALL INSYED
MOVEI A,.SFRTW ;SEE IF RETRIEVAL-WAITS ALLOWED
HRROI B,[ASCIZ / Automatic file-retrieval-waits /]
CALL TYPALO ;TYPE WHETHER ALLOWED OR NOT
MOVEI A,.SKRBC ;SAY WE WANT CONTROL SETTING
MOVEI B,C ;ARG BLOCK ADDRESS
MOVEI C,2 ;LENGTH OF ARG BLOCK
SKED% ;GET VALUE OF BIAS SETTING
ETYPE < Scheduler bias-control setting is %4Q%%_>
CALL CLSON ;SEE WHAT'S WITH CLASS SCHEDULING
JRST [ ETYPE < Class scheduling is disabled>
TXNE A,SK%DRG ;BATCH ON DREGS
ETYPE <, batch jobs being run on dregs queue>
JRST NOCLS]
ETYPE < Class scheduling>
TXNE A,SK%ACT ;SEE IF BY ACCOUNTS
ETYPE < by accounts>
ETYPE < enabled, windfall >
TXNE A,SK%WDF
ETYPE <withheld>
TXNN A,SK%WDF
ETYPE <allocated>
MOVEI A,.SKBCR ;READ BATCH CLASS
MOVEI B,C ;BLOCK IS IN C
MOVEI C,2 ;ALLOCATE ROOM
SKED% ;GET BATCH CLASS
JUMPL D,NOCLS ;IF NEGATIVE, NO BATCH CLASS
ETYPE <, batch class %4Q>
NOCLS: ETYPE <%_>
CALLRET SYSDWN ;PRINT INFO AND EXIT
;ROUTINE TO DO COMMON WORK FOR INFO SYSTEM-STATUS
;A/ CODE FOR ASKING MONITOR FOR INFO
;B/ POINTER TO STRING TO PRINT OUT
TYPALO: ETYPE <%2M> ;TYPE TITLE STRING
TMON ;ASK MONITOR FOR STATUS
CAIN A,.SFRTW ;FILE RETRIEVAL?
TRC B,1 ;YES, SENSE IS DIFFERENT THAN ALL OTHERS!
SKIPN B
TYPE <are not >
ETYPE <allowed%_>
RET
; ROUTINE TO REPORT DISABLED IF B/ 0 AND ENABLED IF B/ 1
INSYED: SKIPE B
TYPE <enabled
>
SKIPN B
TYPE <disabled
>
RET
; INFORMATION (ABOUT) VOLUMES (NAME) tapesetname:
IVOL: STKVAR <QID>
NOISE <OF TAPE>
DEVX <tape set name, terminated with a colon>
CMERRX
MOVEM B,IPCFP+.MATDV ;PUT DEVICE DESIGNATOR IN MESSAGE
CONFIRM
MOVE A,[.MATUS,,.QOMAT]
MOVEM A,IPCFP+.MSTYP ;SET UP MESSAGE LENGTH AND CODE
CALL QUASND ;SEND TO QUASAR
MOVEM A,QID ;SAVE IDENTIFIER
CALL GQPID ;GET QUASAR'S PID
MOVE B,QID ;GET IDENTIFIER
CALL IPCRCV ;RECEIVE RESPONSE
MOVX A,MF.FAT
TDNE A,IPCFP+.MSFLG ;FATAL ERROR?
UERR IPCFP+.OHDRS+1 ;YES, GIVE ERROR MESSAGE
MOVEI A,.TMSET
CALL FNDATR ;FIND SETNAME
MOVE A,1(A) ;GET SETNAME
ETYPE <Volumes of tape set %1': >
MOVEI A,.TMVOL
CALL FNDATR ;FIND VOLID LIST
LOAD P1,AR.LEN,(A) ;GET LENGTH OF ENTRY
MOVNI P1,-1(P1) ;GET NEGATIVE NUMBER OF VOLIDS
MOVSS P1 ;OVER TO LEFT HALF FOR AOBJN PTR
HRRI P1,1(A) ;POINT RIGHT HALF AT FIRST VOLID
SKIPA
IVOL1: TYPE <,>
SKIPN A,(P1) ;GET SIXBIT VOLID
JRST [ ETYPE <scratch> ;IF VOLID = 0, IT'S A SCRATCH TAPE
JRST .+2]
ETYPE <%1'> ;TYPE VOLID
AOBJN P1,IVOL1
ETYPE <%_>
RET
; FNDATR - FIND ENTRY FOR SPECIFIED ATTRIBUTE TYPE
; A/ ATTRIBUTE TYPE
; RETURNS +1, A/ ADDRESS OF ENTRY HEADER
FNDATR: MOVE C,A
MOVE B,IPCFP+.OARGC ;GET # OF ENTRIES IN LIST
MOVEI A,IPCFP+.OHDRS ;GET ADDRESS OF HEADER OF 1ST ENTRY
FNDAT1: LOAD D,AR.TYP,(A) ;GET TYPE OF ENTRY
CAMN C,D ;MATCH WHAT I WANT?
RET ;YES
LOAD D,AR.LEN,(A) ;NO, GET LENGTH
ADD A,D ;COMPUTE ADDRESS OF NEXT ENTRY
SOJG B,FNDAT1 ;LOOP THRU ENTRY LIST
ERROR <Error in response from QUASAR>
TAPINF: MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JIDEN
GETJI
CALL JERR
SETZ B,
CAMN C,[.SJDN2]
MOVEI B,[ASCIZ /200/]
CAMN C,[.SJDN5]
MOVEI B,[ASCIZ /556/]
CAMN C,[.SJDN8]
MOVEI B,[ASCIZ /800/]
CAMN C,[.SJD16]
MOVEI B,[ASCIZ /1600/]
CAMN C,[.SJD62] ;IS IT 6250 BPI?
MOVEI B,[ASCIZ /6250/] ;YES, 6250
JUMPE B,[ETYPE < Unknown default tape density, value = %3O
>
JRST ILLDEN]
TYPE < SET TAPE DENSITY >
UTYPE (B)
TYPE <
>
ILLDEN: MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JIPAR
GETJI
CALL JERR
SETZ B,
CAMN C,[.SJPRE]
MOVEI B,[ASCIZ /EVEN/]
CAMN C,[.SJPRO]
MOVEI B,[ASCIZ /ODD/]
JUMPE B,[ETYPE < Unknown default tape parity, value = %3O
>
JRST ILLPAR]
TYPE < SET TAPE PARITY >
UTYPE (B)
TYPE <
>
ILLPAR: MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JIDM
GETJI
CALL JERR
SETZ B,
CAMN C,[.SJDMC]
MOVEI B,[ASCIZ /CORE-DUMP/]
CAMN C,[.SJDMA]
MOVEI B,[ASCIZ /ANSI-ASCII/]
CAMN C,[.SJDM8]
MOVEI B,[ASCIZ /INDUSTRY-COMPATIBLE/]
CAMN C,[.SJDM6]
MOVEI B,[ASCIZ /SIXBIT/]
CAMN C,[.SJDMH] ;IT IT HIGH DENSITY MODE?
MOVEI B,[ASCIZ /HIGH-DENSITY/]
JUMPE B,[ETYPE < Unknown default tape format, value = %3O
>
JRST ILLFMT]
TYPE < SET TAPE FORMAT >
UTYPE (B)
TYPE <
>
ILLFMT: MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JIRS
GETJI
CALL JERR
ETYPE < SET TAPE RECORD-LENGTH %3Q
>
RET
SPLINF: MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JIDFS
GETJI
CALL JERR
SETZ B,
CAMN C,[.SJSPD]
MOVEI B,[ASCIZ /DEFERRED/]
CAMN C,[.SJSPI]
MOVEI B,[ASCIZ /IMMEDIATE/]
JUMPE B,[ETYPE < Unknown spooled-output-action, value = %3O
>
RET]
TYPE < SET SPOOLED-OUTPUT-ACTION >
UTYPE (B)
TYPE <
>
RET
;TYPE CURRENT TERMINAL MODES
TRMPNT:
;CHECK TERMINAL TYPE AND INTERPRET SOME CODES
MOVEI A,.CTTRM
GTTYP
JUMPL B,ILTTYP
CAIGE B,TTYPLN
SKIPA A,B
ILTTYP: MOVEI A,TTYPLN ;THIS INDEX DOES "ETYPE < TERMINAL TYPE %2Q>"
XCT TTYPTB(A)
ETYPE<%_>
;PRINT SPEED INFO
MOVEI A,.CTTRM
MOVEI B,.MORSP ;SPEED INFO
MTOPR
ERJMP NOSPD
CAME C,[-1] ;SPEEDS RECEIVED?
JRST TISP1 ;YES
TYPE < !Terminal speed indeterminate!>
JRST TISP2
TISP1: HLRZ A,C ;INPUT SPEED
HRRZS C
ETYPE < TERMINAL SPEED %1Q>
CAME A,C ;INPUT = OUTPUT
ETYPE < %3Q>
TISP2: ETYPE<%_> ;TERMINATE LINE
NOSPD:
MOVEI A,.CTTRM
RFMOD ;GET TERMINAL MODES
;CHECK LINKS BIT
TXNE B,TT%ALK
TYPE < RECEIVE LINKS
>
TXNN B,TT%ALK
TYPE < REFUSE LINKS
>
;CHECK ADVICE BIT
TXNE B,TT%AAD
TYPE < RECEIVE ADVICE
>
TXNN B,TT%AAD
TYPE < REFUSE ADVICE
>
PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,.CTTRM
MOVEI B,.MORNT
MTOPR
CAIN C,0
TYPE < RECEIVE SYSTEM-MESSAGES
>
CAIE C,0
TYPE < REFUSE SYSTEM-MESSAGES
>
POP P,C
POP P,B
POP P,A
;CHECK PAUSE (ON) COMMAND
TYPE < TERMINAL >
TXNN B,TT%PGM
TYPE <NO >
TYPE <PAUSE (ON) COMMAND
>
;CHECK PAUSE (ON) END-OF-PAGE
PUSH P,A
PUSH P,B
PUSH P,C
MOVEI A,.CTTRM
MOVEI B,.MORXO
MTOPR
TYPE < TERMINAL >
CAIN C,.MOOFF
TYPE <NO >
TYPE <PAUSE (ON) END-OF-PAGE>
CAIN C,.MOOFF
JRST NPEOPD
MOVE C,-1(P) ;GET RFMOD BITS
TXNN C,TT%PGM
TYPE < !DISABLED!>
NPEOPD: TYPE <
>
;PAGE LENGTH
MOVEI A,.CTTRM
MOVEI B,.MORLL ;PREPARE TO READ LENGTH
MTOPR ;DO IT
ETYPE < TERMINAL LENGTH %3Q
>
;PAGE WIDTH
MOVEI B,.MORLW ;READ WIDTH
MTOPR
ETYPE < TERMINAL WIDTH %3Q
>
POP P,C
POP P,B
POP P,A
;CHECK LOWER CASE
TYPE < TERMINAL >
TXNN B,TT%LCA
TYPE <NO >
TYPE <LOWERCASE
>
;CHECK RAISE
TYPE < TERMINAL >
TXNN B,TT%LIC
TYPE <NO >
TYPE <RAISE
>
;CHECK OUTPUT FLAGING
TYPE < TERMINAL >
TXNN B,TT%UOC
TYPE <NO >
TYPE <FLAG
>
;CHECK INDICATE FORMFEED FLAG
TYPE < TERMINAL >
PUSH P,B
MOVEI A,.CTTRM
RFCOC
LDB A,[POINT 2,B,25]
POP P,B
CAIE A,1
TYPE <NO >
TYPE <INDICATE
>
;CHECK MECHANICAL FORMFEED
TYPE < TERMINAL >
TXNN B,TT%MFF
TYPE <NO >
TYPE <FORMFEED
>
;CHECK MECHANICAL TAB
TYPE < TERMINAL >
TXNN B,TT%TAB
TYPE <NO >
TYPE <TABS
>
;ECHO MODE
TYPE < TERMINAL >
TXNN B,TT%ECM
TYPE <NO >
TYPE <IMMEDIATE
>
;CHECK DUPLEX CONTROL
BT.DUM==^L<TT%DUM&-TT%DUM>
SZ.DUM==BT.DUM-^L<TT%DUM>+1
LDB A,[POINT SZ.DUM,B,BT.DUM]
CAIN A,.TT0DX
JRST [ TYPE < Duplexing in reserved state
>
JRST DPLXDN]
TYPE < TERMINAL >
CAIN A,.TTFDX
TYPE <FULLDUPLEX
>
CAIN A,.TTHDX
TYPE <HALFDUPLEX
>
CAIN A,.TTLDX
TYPE <LINE
>
DPLXDN:
;ALL DONE
RET
TTYPTB: TYPE < TERMINAL 33> ;0
TYPE < TERMINAL 35> ;1
TYPE < TERMINAL 37> ;2
TYPE < TERMINAL TI> ;3
REPEAT 4,<XCT TTYNTY > ;4-7
TYPE < TERMINAL SYSTEM-DEFAULT> ;8
XCT TTYNTY ;9
TYPE < TERMINAL VT05> ;10
TYPE < TERMINAL VT50> ;11
TYPE < TERMINAL LA30> ;12
NOSHIP,<
TYPE < TERMINAL GT40> ;13
>;NOSHIP
SHIP,<
XCT TTYNTY ;13 (NOT SUPPORTED)
>;SHIP
TYPE < TERMINAL LA36> ;14
TYPE < TERMINAL VT52> ;15
TYPE < TERMINAL VT100> ;16
TYPE < TERMINAL LA38> ;17
TYPE < TERMINAL LA120> ;18
TTYPLN==.-TTYPTB
TTYNTY: ETYPE < TERMINAL TYPE %2Q>
;LIST LOGICAL NAMES
.LNLIS::TLZ Z,F2+F3 ;EVERYTHING OFF SO WE CAN DEFAULT LATER
NOISE <OF>
TRVAR <spnam,LNDIR,LNTNM,LNJNM,LNDAT>
MOVEI B,[ FLDDB. .CMKEY,,$LNLIS,,<JOB>,[
FLDDB. .CMDEV,CM%PO!CM%SDH,,<specific logical name>]]
CALL FLDSKP
CMERRX <"JOB", "SYSTEM", "ALL", or specific logical name required>
LDB C,[331100,,(C)] ;GET FIELD FLAVOR
MOVEM C,LNDAT ;REMEMBER FIELD FLAVOR
HRLM B,LNDAT ;AND KEYWORD POINTER
CALL BUFFF ;GET LOGICAL NAME OR KEYWORD
MOVEM A,SPNAM ;REMEMBER POINTER TO NAME
HRRZ C,LNDAT ;GET COMND DATA AGAIN
CAIN C,.CMDEV ;SPECIFIC LOGICAL NAME?
JRST LNSPEC ;YES
HLRZ B,LNDAT ;GET KEYWORD POINTER
CALL GETKEY ;GET THE KEYWORD DATA
CALL GETTER ;KEYWORD, BUT IS THERE A COLON AFTER IT?
CAIN A,":"
JRST [ COLONX <Colon to terminate logical name>
CMERRX
JRST LNSPEC]
CONFIRM ;CONFIRM THE KEYWORD
JRST (P3) ;DISPATCH
.LNALL: TLOA Z,F2!F3
.LNJB: TLOA Z,F3
.LNSYS: TLO Z,F2
TLNN Z,F3 ;JOB-WIDE?
JRST .LNSY1
TLNE Z,F2
TYPE <Job-wide logical names:
>
MOVE A,[.INLJB,,.LNSJB]
CALL .LNTYL
TLNE Z,F2
TYPE <
System-wide logical names:
>
.LNSY1: TLNN Z,F2
RET
MOVE A,[.INLSY,,.LNSSY]
;FALL INTO .LNTYL
.LNTYL: HRRZM A,LNJNM
HLLZS A
.LNTY1: MOVEM A,LNDIR
MOVE B,CSBUFP ;PUT IN UNUSED PORTION OF STRING BUFFER
INLNM
JRST [ CAIE A,INLNX1
CALL JERR
RET] ;ALL DONE
IBP B
MOVEM B,LNTNM
MOVE B,CSBUFP
MOVE C,LNTNM
MOVE A,LNJNM
LNMST
JRST [ CAIE A,LNSTX1
CALL JERR
JRST .LNTY2]
MOVE A,CSBUFP ;GET POINTER TO NAME
MOVE B,LNTNM ;GET POINTER TO DEFINITION
CALL LNTYPE ;TYPE THE GOODIES
.LNTY2: MOVE A,LNDIR
AOJA A,.LNTY1
;GET HERE WHEN SPECIFIC LOGICAL NAME REQUESTED
LNSPEC: CONFIRM ;CONFIRM THE SPECIFIC LOGICAL NAME
MOVE B,SPNAM ;POINTER TO NAME IN B
MOVE C,CSBUFP ;WRITE DEFINITION INTO STRING AREA
MOVEI A,.LNSJB ;SPECIFY JOB
LNMST ;GET JOB DEFINITION
ERJMP LNS1 ;NO JOB DEFINITION
TYPE <Job-wide:
>
MOVE A,SPNAM
MOVE B,CSBUFP
CALL LNTYPE ;TYPE THE DEFINITION
TYPE <
>
LNS1: MOVEI A,.LNSSY ;GET SYSTEM DEFINITION
MOVE B,SPNAM ;POINTER TO NAME AGAIN
MOVE C,CSBUFP ;STRING SPACE
LNMST ;GET SYSTEM VERSION
RET ;NONE
TYPE <System-wide:
>
MOVE A,SPNAM
MOVE B,CSBUFP
CALLRET LNTYPE ;TYPE SYSTEM VERSION AND RETURN
;ROUTINE TO TYPE A LOGICAL NAME DEFINITION. GIVE IT POINTERS TO
;NAME AND DEFINITION IN A, B RESPECTIVELY
LNTYPE: UETYPE [ASCIZ /%1M: => %2M%%_/]
RET
$LNLIS: TABLE
T ALL,,.LNALL
T JOB,,.LNJB
T SYSTEM,,.LNSYS
TEND
;INFORMATION (ABOUT) STRUCTURE <NAME>
GSUBLK==BUF0+<BUFL-BUF0+1>/2 ;USE DEEP HALF OF AVAILABLE AREA
;FOR JOB LIST. THIS ALLOWS STARTING
;USER LIST AT BEGINNING OF AREA WITHOUT
;FEAR OF COLLISION, DESPITE FACT THAT
;EACH USER ENTRY REQUIRES TWO WORDS
GSUALS==GSUBLK+.MSUAL ;ALIAS FOR GETTING USERS OF STRUCTURE
GSUFLG==GSUBLK+.MSUFL ;FLAGS,,LENGTH OF RESULTANT LIST
GSULST==GSUBLK+.MSUJ1 ;BEGINNING OF JOB LIST
GSULEN==BUFL-GSUBLK+1 ;TOTAL DATA BLOCK SIZE
GSUJLN==GSULEN-.MSUJ1+1 ;MAXIMUM NUMBER OF USERS WE CAN LIST
.STRST:: TRVAR <SIXALS,<ASCALS,2>,<ISBLK,GSSLEN>,ALIAS,DEFNAM> ;CELL TO HOLD POINTER TO DEFAULT NAME
NOISE <NAME>
CALL CONST ;GET DESIGNATOR OF CONNECTED STRUCTURE
MOVEM A,CMDEF ;SET UP POINTER TO DEFAULT VALUE FOR FIELD
MOVEM A,DEFNAM ;REMEMBER POINTER TO DEFAULT
STARX <Name of structure or * for all>
CAIA ;"*" NOT TYPED
JRST STRSTR ;"*" TYPED
MOVE A,DEFNAM
MOVEM A,CMDEF ;SET UP DEFAULT AGAIN
DEVX <Name of structure or * for all>
CMERRX <"*" or mounted structure name required>
CONFIRM ;WAIT FOR CONFIRMATION
MOVEM B,ALIAS ;STORE DEVICE DESIGNATOR
CALLRET STRST1 ;DO THE WORK AND RETURN
;ROUTINE THAT DOES THE REAL WORK OF PRINTING STRUCTURE STATUS
STRST1: MOVE A,ALIAS ;GET DEVICE DESIGNATOR
MOVEM A,.MSGSN+ISBLK ;STORE FOR GETTING STRUCTURE STATUS
SETZM .MSGSI+ISBLK ;DON'T GET PHYSICAL NAME
MOVE A,[GSSLEN,,.MSGSS] ;LENGTH,,FUNCTION
MOVEI B,ISBLK ;GET ANSWERS INTO ISBLK
MSTR ;ASK MONITOR FOR INFO ABOUT STRUCTURE
ERJMP [MOVE T1,.MSGSN+ISBLK ;Designator that caused problems
CALLRET STRST2] ;Print a warning and return
MOVE A,.MSGMC+ISBLK ;GET MOUNT COUNT
MOVE B,.MSGFC+ISBLK ;AND OPEN FILE COUNT
MOVE C,.MSGNU+ISBLK ;NUMBER OF UNITS IN STRUCTURE
MOVE D,ALIAS ;GET POINTER TO NAME
ETYPE <Status of structure %4H:
Mount count: %1Q, open file count: %2Q, units in structure: %3Q
>
MOVE A,.MSGST+ISBLK ;GET STATUS BITS
TXNE A,MS%PPS ;SKIP IF NOT THE PRIMARY PUBLIC STRUCTURE
TYPE <Public >
TXNE A,MS%DOM ;SKIP IF NOT DOMESTIC
TYPE <Domestic >
TXNN A,MS%DOM ;SKIP IF DOMESTIC
TYPE <Foreign >
TXNN A,MS%INI ;SKIP IF NOT "BEING INITIALIZED"
TXNE A,MS%DIS ;SKIP IF "BEING DISMOUNTED"
TYPE <Unavailable for mounting >
ETYPE<%_>
LDF A,MS%GTM+MS%GTA+MS%GTC ;REQUEST CONNECTORS, ACCESSORS, AND MOUNTERS
MOVEM A,GSUFLG
MOVE A,.MSGSN+ISBLK ;GET ALIAS
MOVEM A,GSUALS ;STORE FOR GETTING STRUCTURE USERS
DMOVE A,[EXP <GSULEN>B17+.MSGSU,GSUBLK]
MSTR ;GET LIST OF USERS FOR THIS STRUCTURE
ERJMP [MOVE T1,GSUALS ;Get the trouble maker
CALLRET STRST2] ;Print a warning on this device and return
HRRZ A,GSUFLG ;GET LENGTH OF USER LIST
JUMPN A,STRSTU ;NON-ZERO MEANS THERE'S A LIST TO PRINT
TYPE <There are no jobs currently using this structure
>
RET
STRST2: PUSH P,T1 ;Save the device designator
TYPE <%> ;Get ready to print warning
CALL %GETER ;Get last error we recieved
MOVE T1,ERCOD ;Set it up for printing
CALL $ERSTR ;Tell them what happened
POP P,T1 ;Now get the designator back
ETYPE < - %1H:%_> ;And print it
RET ;Return to wherever we came from
STRSTU: CAIL A,GSUJLN ;ARE WE SURE WE GOT THE WHOLE LIST?
TYPE <%Couldn't get entire user list for structure
>
PUSH P,P1
PUSH P,P2
PUSH P,P3
PUSH P,P4 ;GET SOME AC'S
PUSH P,P5
PUSH P,Q1
MOVN P1,A ;GET NEG OF NUMBER OF JOBS IN LIST
HRLZ P1,P1 ;MAKE AOBJN POINTER
MOVEI P2,0 ;LENGTH OF USER LIST
MOVEI C,.JIUNO ;SPECIFY WE WANT USER NUMBER
STR1: HRRZ A,GSULST(P1) ;PICK UP A JOB NUMBER
HRROI B,P3 ;WE'LL READ USER NUMBER INTO P3
GETJI ;GET IT'S USER NUMBER INTO P3
JRST STRX1 ;COULDN'T, CHECK WHY
MOVE P4,P2 ;GET LENGTH OF USER LIST
STR3: SOJL P4,STR2 ;JUMP IF WE'VE SCANNED THE WHOLE LIST
SOJ P4, ;SECOND WORD IS INFO BITS
CAME P3,BUF0(P4) ;FOUND IT IN LIST YET?
JRST STR3 ;NO, KEEP LOOKING
HLLZ A,GSULST(P1) ;FOUND IT, GET INFO BITS
IORM A,BUF0+1(P4) ;PERHAPS MORE BITS ON FOR THIS JOB
STR4: AOBJN P1,STR1 ;LOOP FOR REST OF JOBS
MOVE D,P2 ;SAVE FINAL LENGTH OF USER LIST
LDF P3,MS%GTM ;FIRST WE'LL LIST MOUNTERS
MOVEI P4,[ASCIZ /Users who have MOUNTed %2H: /]
MOVEI P5,[ASCIZ /No users have %2H: MOUNTed/]
CALL REPORT ;PRINT THE MOUNTERS OF THE STRUCTURE
LDF P3,MS%GTA ;LIST ACCESSERS
MOVEI P4,[ASCIZ /Users ACCESSing %2H: /]
MOVEI P5,[ASCIZ /No users are ACCESSing %2H:/]
CALL REPORT
LDF P3,MS%GTC ;NOW LIST CONNECTERS
MOVEI P4,[ASCIZ /Users CONNECTed to %2H: /]
MOVEI P5,[ASCIZ /No users CONNECTed to %2H:/]
CALL REPORT
POP P,Q1
POP P,P5
POP P,P4
POP P,P3
POP P,P2
POP P,P1 ;RESTORE THESE LITTLE DEVILS
ret
;GET TO HERE ON "INFO STR *" OR "INFO STR *:"
STRSTR: CONFIRM
CALL DEVLUP ;LOOP THROUGH ALL DEVICES
CALL STRWRK ;DO THE WORK FOR EACH ONE
RET ;DONE
STRWRK: CAMN A,[SIXBIT /DSK/] ;IS IT STRUCTURE "DSK"?
RET ;YES, FORGET IT, SINCE IT'LL COME UP AGAIN AS SPECIFIC STRUCTURE
MOVEM D,ALIAS ;STORE DESIGNATOR FOR STRUCTURE ALIAS
MOVEM A,SIXALS ;REMEMBER SIXBIT ALIAS
LDB C,[221100,,B] ;GET DEVICE TYPE
CAIE C,.DVDSK ;MAKE SURE IT'S A DISK
RET
HRROI A,ASCALS ;POINT TO AREA FOR ASCII ALIAS
MOVE B,D ;GET DESIGNATOR
DEVST ;GET ASCII
ERCAL JERRE ;SHOULDN'T FAIL, SINCE MONITOR SUPPLIED INPUT!
HRROI A,ASCALS ;POINT TO THE ASCII
CALL GETSIX ;GET SIXBIT
NOP ;WON'T EVER FAIL
CAME A,SIXALS ;DID WE GET BACK WHAT WE STARTED WITH?
RET ;NO, SKIP "DSK" OR "LPT" DEFINED AS A STRUCTURE
CALL STRST1 ;PRINT THE GOODS ON THIS STRUCTURE
ETYPE<%_>
RET
;ROUTINE TO LIST ELEMENTS FROM LIST STARTING IN BUF0.
REPORT: MOVEI P1,0 ;TELLS HOW MANY NAMES HAVE BEEN PRINTED ON THIS LINE
SETOM Q1 ;FLAG SAYING NO NAMES IN THIS LIST YET
move a,cojfn ;get output jfn
MOVEI B,.MORLW
MOVEI C,^D72 ;FOR NON-TERMINAL ASSUME 72 COLUMNS
MTOPR ;GET LINE WIDTH
ERJMP .+1 ;PROBABLY NOT A TERMINAL
MOVE P2,C ;REMEMBER IN P2
MOVN D,D ;GET NEGATIVE OF NUMBER OF ELEMENTS
HRLZ D,D ;MAKE AOBJN POINTER
MOVE B,ALIAS ;GET POINTER TO STRUCTURE NAME
str5: TDNN P3,BUF0+1(D) ;THIS USER HAVE CORRECT ATTRIBUTES?
JRST STR7 ;NO
AOSN Q1 ;FIRST NAME BEING PRINTED?
UETYPE @P4 ;YES, PUT IN HEADING
CAIE Q1,0 ;FIRST NAME BEING PRINTED?
TYPE <, > ;SEPARATE NAMES(NOT BEFORE FIRST ONE THOUGH!)
MOVE B,BUF0(D) ;GET USER NAME
CALL DIRRUM ;MAKE SURE THERE'S ENOUGH ROOM ON THIS LINE FOR ANOTHER NAME
dirst ;print user name
erjmp str6 ;go check error code
AOJ P1, ;COUNT NAMES ON THIS LINE
str7: AOBJN D,.+1
AOBJN D,STR5 ;LOOP FOR REST OF NAMES
CAIGE Q1,0 ;ANY NAMES PRINTED?
UETYPE @P5 ;NO, SO GIVE REMARK ABOUT LIST BEING EMPTY
ETYPE<%_> ;put cr after list
RET
STR6: CALL %GETER ;GET REASON FOR FAILING DIRST
MOVE B,ERCOD
CAIE B,DIRX1 ;USER GO AWAY?
CALL CJERRE ;NO, SO BOMB OUT
JRST STR7 ;YES, IGNORE AND GO ON
STR2: MOVEM P3,BUF0(P2) ;USER NOT FOUND, ADD TO LIST
HLL A,GSULST(P1) ;GET CONTROL BITS
HLLM A,BUF0+1(P2) ;SAVE BITS
AOJ P2, ;2 WORDS PER ENTRY IN USER LIST
AOJA P2,STR4 ;EXPAND LIST AND CHECK REST OF JOBS
STRX1: CAIE A,GTJIX4 ;MAKE SURE ERROR IS "NO SUCH JOB"
CALL CJERRE ;NO, SO BOMB OUT
JRST STR4 ;YES, JOB LOGGED OFF, SO SKIP IT
;ROUTINE USED WHEN PRINTING A LIST OF USER NAMES TO DECIDE WHETHER
;THE NEXT NAME WILL FIT ON THIS LINE. IF NOT, A CRLF AND TAB IS PRINTED.
;THE ROUTINE ALWAYS ASSUMES THE NAME FITS, IF IT'S THE FIRST ONE ON THE
;LINE, NO MATTER HOW LONG IT IS.
;ACCEPTS: B/ USER OR DIRECTORY NUMBER
; P1/ NUMBER OF NAMES SO FAR ON THIS LINE
; P2/ TERMINAL WIDTH
;RETURNS: +1 ALWAYS, WITH P1 RESET TO 0 IF THERE WAS NO ROOM
DIRRUM: SAVEAC <A,B,C,D> ;CLOBBER NOTHING
STKVAR <<DRRBUF,FILWDS>>
JUMPE P1,DIRUMX ;THERE'S ALWAYS ROOM FOR AT LEAST ONE NAME!
JUMPE P2,DIRUMX ;IF 0 WIDTH, ASSUME INFINITE AND HENCE THERE'S ROOM!
HRROI A,DRRBUF ;GET SOME FREE SPACE
DIRST ;GENERATE THE STRING
ERJMP DIRUMX ;FAILED, SO JUST EXIT
MOVEI B,0 ;PUT NULL IN TO MARK END OF STRING
IDPB B,A
MOVEI A,DRRBUF ;LOOK AT STRING
HRLI A,440700 ;MAKE CORRECT BYTE POINTER
MOVEI D,0 ;D HOLDS LENGTH OF STRING
DUM1: ILDB C,A ;MORE CHARACTERS?
CAIE C,0 ;NO
AOJA D,DUM1 ;YES, COUNT 'EM
ADDI D,2 ;LEAVE ROOM FOR COMMA AND SPACE
MOVE A,COJFN ;GET POINTER TO OUTPUT DEVICE
RFPOS ;WHERE ARE WE ON LINE?
ADD B,D ;WHERE WILL WE BE AFTER PRINTING THIS NAME?
CAIGE P2,(B) ;OVER RIGHT MARGIN?
JRST DUMNO ;YES, NO ROOM ON THIS LINE
DIRUMX: RET
DUMNO: TYPE <
>
MOVEI P1,0 ;NOTE THAT WE'RE ON NEW LINE
JRST DIRUMX
;JOBSTAT
.JOBST:: STKVAR <LLPTR>
ETYPE < Job %J, User %N>
GJINF
CAME B,LIDNO ;SKIP IF CONNECTED TO LOGGED-IN DIR
UETYPE [ASCIZ /, %G/]
TYPE <, Account >
CALL PRACCT ;PRINT ACCOUNT INFO
ETYPE <, %L%%_>
HRROI A,-1 ;OURSELF
HRROI B,CSBUFP ;POINT TO BYTE POINTER
MOVEI C,.JILLO ;SAY WE WANT LOGICAL LOCATION
MOVE D,CSBUFP ;GET POINTER TO BEGINNING OF STRING
GETJI ;GET IT
ERCAL CJERRE ;SHOULDN'T FAIL
MOVE A,D ;GET POINTER TO LOGICAL LOCATION
CALL BUFFS ;SAVE THE LOCATION
MOVEM A,LLPTR ;REMEMBER POINTER TO IT
CALL GETNOD ;GET HOST NODE NAME
MOVE A,LLPTR ;ON NONDECNET, GUARANTEE THAT THEY MATCH
MOVE B,LLPTR ;COMPARE WITH OUR JOB'S NODE
STCMP
JUMPE A,NOLOC ;DON'T PRINT NAME IF THEY'RE THE SAME
MOVE A,LLPTR
ETYPE <Located at %1m%%_>
NOLOC: HRROI A,-1 ;CURRENT JOB
MOVE D,CSBUFP ;USE FREE SPACE POINTER
HRROI B,D ;SAY ONE ENTRY, POINTER IN D
MOVEI C,.JISRM ;SPECIFY WE WANT SESSION REMARK
GETJI ;GET SESSION REMARK
ERJMP NOS ;IF FAILS, THERE'S NO REMARK
MOVE A,CSBUFP ;GET POINTER TO REMARK
ILDB A,A ;GET FIRST CHARACTER
MOVE D,CSBUFP
CAIE A,0 ;PRINT NOTHING IF NO SESSION REMARK
ETYPE <Session remark: %4M%%_>
NOS: RET
;RUNSTAT
.RUNST::ETYPE < Used %B% in %C%
>
XTND,<
TLOA Z,F1 ; SET FLAG FOR JOB STATUS
.FRKST: TLZ Z,F1 ; CLEAR FLAG FOR FORK STATUS ONLY
>
CALL DGFRKS ;DO THE GFRKS TO GET FORK HANDLES
CALL [ CAIE A,GFKSX1 ;RAN OUT OF SPACE?
CAIN A,FRKHX6 ;RAN OUT OF HANDLES?
SKIPA ;YES - CONTINUE
JRST CJERR ;NO, STRANGE
TYPE <% >
CALL $ERSTR ;PRINT SYSTEM MESSAGE
ETYPE<%_> ;ADD CRLF
TYPE <% Partial structure will be printed.
>
RET]
XTND,<
TLNN Z,F1 ; WANT ALL INFO?
JRST .FKST2 ; NO - PRINT FORKS ONLY
>
MOVEI A,.FHSLF ;REPORT ON CURRENT FORK FIRST
ETYPE < TOPS-20: %1V
>
TYPE < SET >
SKIPE PAXLFL
TYPE <NO >
TYPE <UUO-SIMULATION (FOR PROGRAM)
>
TYPE < SET >
SKIPE CCFLAG
TYPE <NO >
TYPE <CONTROL-C-CAPABILITY (OF PROGRAM)
>
XTND,<
TYPE < SET >
SKIPN CCKEEP
TYPE <NO >
TYPE <KEEP-FORK (ON <CTRL-C>)
>
>
.FKST2: SETZ Q1,
HRRZ D,(C)
CALL FSTRUC ;PRINT FORK TREE
CALLRET UNMDIR ;UNMAP SPECIAL PAGES
;FSTRUC
;RECURSIVE SUBR TO TYPE FORK STRUCTURE OF JOB.
;FOR EACH FORK, TYPES HANDLE AND STATUS.
; FILE NAME OR "PROGRAM" WOULD ALSO BE DESIRABLE IF IT WERE AVAILABLE.
;STRUCTURE INDICATED BY PUTTING A FORK'S INFERIORS RIGHT AFTER IT,
; INDENTING 3 COLUMNS PER LEVEL.
;THUS PARELLEL FORKS ARE THOSE WHICH APPEAR AT SAME INDENTATION WITH
; NO LESS-INDENTED ENTRIES BETWEEN THEM.
;TAKES: D: POINTER TO GFRKS TABLE, SET UP BY CALLER.
; Q1: LEVEL COUNTER, ZEROED BY TOP LEVEL CALLER.
;ENTRY POINT IS AT END BUT COMES RIGHT HERE.
;TYPE STUFF FOR THIS FORK.
FSTR1: PRINT " "
HRRZ B,1(D)
CAMN B,FORK ;< TO MATCH FOLLOWING
UTYPE [ASCIZ/=> /]
CAME B,FORK
TYPE < >
SKIPA A,Q1
TYPE < > ;INDENT 3 SPACES PER LEVEL BELOW FIRST.
SOJGE A,.-1
NOXTND,<
TYPE <Fork >
>
HRRZ B,1(D) ;GET THIS FORK'S HANDLE FROM TABLE
JUMPE B,[UTYPE [ASCIZ /**: /]
MOVE A,2(D) ;Get status from table
MOVEM A,LRFSTS+.RFPSW ;Since we don't have a handle
SETZB A,LRFSTS+.RFPFL ; simulate a long RFSTS with
SETZM LRFSTS+.RFPPC ; as much information as we know
CALL FSTAT ;PRINT STATUS WITH 0 PC
JRST FSTR2]
TXZ B,1B18 ;PRINT IN FORM ## NOT 4000##
XTND,<
SKIPN A,FRKTAB(B) ; KNOW ABOUT THIS FORK?
JRST FSTR2N ; NO - MAKE A DUMMY ENTRY
TXNN A,FK%NAM ; FORK HAVE NAME?
JRST FSTR2B
HRROI A,.FKNAM(A) ; GET POINTER TO NAME STRING
ETYPE <%1\ (%2O)>
JRST FSTR2C ; COMMON CODE
FSTR2N: MOVEI A,.FKSZE ; SIZE OF ENTRY
MOVE Q2,B ; SAVE FORK #
PUSH P,D ; SAVE TABLE PNTR
MOVEI B,XDICT
CALL GETMEM ; GET BLOCK OF STORAGE
JRST [ POP P,D
MOVE B,Q2
JRST FSTR2B] ; NO SLOTS - JUST GIVE STATUS
EXCH Q2,B ; PNTR TO Q2, FORK # TO B
POP P,D ; RESTORE PNTR
HLRZ A,1(D) ; GET SUPERIOR PNTR
JUMPE A,FSTR2B ; NONE - MUST BE US
HRLZ A,1(A) ; GET HANDLE
MOVEM A,.FKOWN(Q2) ; STORE SUPERIOR HANDLE
HRRZM Q2,FRKTAB(B) ; STORE PNTR TO ENTRY
HRRZI A,.FKPTM+1(Q2) ; CLEAR FORK MODES
HRLI A,-1(A)
SETZM .FKPTM(Q2)
BLT A,.FKPTM+NTTYMD+1(Q2)
; FORK HAS NO NAME , BUT WE KNOW ABOUT IT NOW
FSTR2B: TYPE <Fork >
>
MOVE A,COJFN
MOVEI C,10
NOUT ;FORK HANDLE, OCTAL
CALL JERRC ;JSYS ERROR ROUTINE FOR ERROR NUM IN C
FSTR2C: TYPE <: >
HRRZ A,1(D) ;HANDLE AGAIN
CAIN A,.FHSLF ;SELF?
JRST [ TYPE <EXEC>
JRST FSTR2A]
XTND,< CAMN A,EDFORK ; EDITOR?
TYPE <Editor, >
MOVE C,SLFTAB(A)
TXNE C,FK%KPT ; THIS ONE KEPT?
TYPE <Kept, >
TXNE C,FK%BKG ; BACKGROUND?
TYPE <Background, >
TXNE C,FK%DBG ; DEBUGGER?
TYPE <Debugger, >
>
CALL FSTAT ;TYPE ITS STATUS
FSTR2A: HRRZ A,1(D) ;AND AGAIN
ETYPE <, %1V> ;RUNTIME OF FORK
FSTR2: ETYPE<%_>
;NOW DO ALL OF THE FORK'S INFERIORS, BY RECURSION.
PUSH P,D
HRRZ D,(D) ;INFERIOR PTR FROM GFRKS TABLE.
AOS Q1 ;DOWN LEVEL
CALL FSTRUC ;RECURSIVE CALL TO DO ENTIRE SUBTREE
SOS Q1 ;UP LEVEL
POP P,D
HLRZ D,(D) ;PARALLEL PTR FROM GFRKS TABLE
;ENTRY POINT. NOP IF 0 PTR GIVEN.
FSTRUC: JUMPN D,FSTR1
RET
;Fork status typeout subroutine for INFORMATION PROGRAM, ^T, etc.
;Takes a fork handle or 0 in A. If 0, a long RFSTS has been simulated
;containing all available information (as when there are too many forks).
FSTAT:: PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,A ;SAVE FOR %X LATER
JUMPE A,FSTAT0 ;Zero handle means use what's in LRFSTS
MOVEI B,.RFSFL+1 ;Set up LRFSTS for a long RFSTS
MOVEM B,LRFSTS+.RFCNT
HRLI A,(RF%LNG) ;Don't destroy fork handle in A
MOVEI B,LRFSTS
RFSTS ;GET STATUS IN A, PC IN B
FSTAT0: MOVE B,LRFSTS+.RFPSW ;Load status to determine message
HLRZ C,B ;B1-17 = STATUS
CAIN C,-1 ; -1 = UNASSIGNED HANDLE. MAYBE A SUPERIOR
JRST [ MOVEI D,[ASCIZ /Program disappeared/]; ..KILLED PROGRAM
JRST FSTAT8]
TXZ C,<(RF%FRZ)> ;FLUSH FROZEN BIT
CAIE C,.RFHLT ;HALT OR FORCED TERM?
CAIN C,.RFFPT
TXZ B,RF%FRZ ;YES, WASN'T RESULT OF ^C
XTND,<
CAIE C,.RFTTY ; TTY I/O WAIT?
>
CAIN C,.RFTRP ; JSYS trapped?
TXZ B,RF%FRZ ; Yes, not result of ^C
SKIPGE B
UTYPE [ASCIZ /^C from /] ;"FROZEN" BIT ON
UTYPE @[[ASCIZ /Running/]
[ASCIZ /IO wait/]
[ASCIZ /HALT/] ;INCLUDES NEVER STARTED
[ASCIZ /HALT: /]
[ASCIZ /Fork wait/]
[ASCIZ /SLEEP/]
[ASCIZ \JSYS/UUO trap\]
[ASCIZ /Address break/]
[ASCIZ \TTY I/O wait\] ] (C) ;NOTE INDEX!
MOVEI D,[ASCIZ / at %2Y/] ;%2Y TYPES PC FROM B
CAIE C,.RFFPT
JRST FSTAT8 ;GO OUTPUT "AT <PC>"
;AFTER ERROR STOP, TYPE REASON AS GIVEN
;BY PSI CHAN # IN RH OF A. USE TEXT
;FROM "START" COMMAND'S ERROR MSG TAB.
HRRZ C,LRFSTS+.RFPSW ;Instr at WHY indexes by chan thru C
MOVE D,@WHY ;WHY table has %1X, %2Y and/or %3Q
FSTAT8: MOVE B,LRFSTS+.RFPPC ;Load address part of PC for possible %Y
MOVE A,(P) ;Get back handle for possible %X
UETYPE (D) ;TYPE MSG. INCLUDES PC FROM B.
POP P,(P)
POP P,D
POP P,C
POP P,B
RET
;PISTAT
;PSI IS OFF, LEVTAB=NNNNNN, CHNTAB=NNNNNN, CHN MASK=NNNNNNNNNNNN, BIP=N
.PISTA::PRINT " "
SKIPGE 1,FORK
JRST [ UTYPE [ASCIZ /No program/]
JRST EOLRET]
UTYPE [ASCIZ /PSI is /]
MOVEI 5,[ASCIZ /ON/]
SKPIR
MOVEI 5,[ASCIZ /OFF/]
UTYPE 0(5)
RIR
HLRZ 4,2 ;LEVTAB
HRRZ 5,2 ;CHNTAB
RCM
MOVE 6,1 ;CHN MASK
MOVE 1,FORK
RWM
HLLZ 2,2
ETYPE <, LEVTAB=%4O, CHNTAB=%5O
Levels in progress = %2U
Channels enabled = %6U
Channels Waiting = %1U>
JRST EOLRET
;DSKSTAT
.DSKST::TRVAR <<DSCBUF,FILWDS>,DSKCN1,DSKCN2,DSKFL1,DSKFL2,EPFLG,EPDIR,EPWLS>
NOISE <OF DIRECTORY>
CALL CURNMS ;INPUT DIRECTORY NAME, GET # AND BITS IN A
ERROR <No such directory>
MOVEM A,EPFLG ;SAVE THE FLAGS FROM RCDIR
MOVEM B,EPWLS ;SAVE THE POINTER TO THE STRING
MOVEM C,EPDIR ;SAVE THE DIR #
CONFIRM
SETZM DSKFL1 ;CLEAR IN USE
SETZM DSKFL2 ;CLEAR DELETED
SETZM DSKCN1 ;CLEAR ASSIGNED
SETOM DSKCN2 ;FLAG FOR .GT. 1 DIR
DSKSTL: MOVE A,EPDIR ;DIR TO COUNT PAGES FROM
CALL DSKCNT ;COUNT PAGES
CALL RLJFNS ;RELEASE JFNS FROM DSKCNT
MOVE A,EPDIR ;GET DIR NUMBER
SKIPL DSKCN2 ;OTHER THAN FIRST DIR?
ETYPE <%_> ;YES, BLANK LINE
ETYPE < %1R
> ;PRINT IT
GTDAL ;GET WHAT SYSTEM THINKS
AOS DSKCN2 ;COUNT 1 DIR
ADDM B,DSKCN1 ;TOTAL ASSIGNED
ADDM D,DSKFL1 ;TOTAL IN USE
ADDM Q2,DSKFL2 ;TOTAL DELETED
ETYPE < %2Q Pages assigned>
SKIPE Q2 ;DON'T PRINT IF 0 DELETED
ETYPE <, %4Q in use, %6Q deleted>
TLNE Z,F3
ETYPE <
Excluding file(s) that are list protected from you>
ETYPE <
%1Q Working pages, %3Q Permanent pages allowed
>
JUMPE B,DSKSOK ;CAN'T BE OVER IF 0 USAGE
MOVE D,B
SUB B,A
SUB D,C
MOVE A,EPDIR ;DIRECTORY FOR PRINTOUT
SKIPLE D
ETYPE < Over permanent storage allocation by %4Q page(s).
>
SKIPLE B
ETYPE < Over working storage allocation by %2Q page(s).
>
DSKSOK: MOVE A,EPDIR ;NOW STEP TO THE NEXT DIR (IF ANY)
MOVE B,EPWLS ;GET POINTER TO ORIGINAL STRING
MOVE C,EPFLG ;GET FLAGS
TXNE C,RC%WLD ;ANY WILD CARD CHARACTERS IN STRING?
CALL STPDIR ;YES, GO STEP THE DIR NUMBER
JRST SYSFRE ;NO MORE DIRS, PRINT SYSTEM
MOVEM A,EPDIR ;SAVE THE NEW DIR NUMBER
JRST DSKSTL ;LOOP BACK FOR THE OTHER DIRS
SYSFRE: SKIPG DSKCN2 ;.GT. 1 DIR PRINTED?
JRST SYSFR1 ;NO, NO SUMMARY
MOVE A,DSKCN1 ;GET ASSIGNED
ETYPE <
Total of %1Q Pages assigned>
MOVE A,DSKFL1 ;GET IN USE
SKIPE B,DSKFL2 ;GET DELETED
ETYPE <, %1Q in use, %2Q deleted>
AOS A,DSKCN2 ;MAKE # OF DIRS AND LOAD
ETYPE <, in %1Q directories.
>
SYSFR1: HRROI A,DSCBUF ;POINTER TO FREE SPACE
MOVE B,EPDIR ;DIRECTORY NUMBER ASKED ABOUT
DIRST ;GET DIRECTORY NAME WRITTEN INTO FREE SPACE
ERCAL JERRE ;THIS SHOULD NOT FAIL
HRROI B,[ASCIZ /GET.NAM/] ;PUT IN A RANDOM FILE SPEC
MOVEI C,0 ;END ON NULL
SOUT ;NOW WE'VE GOT COMPLETE FILESPEC
LDF A,GJ%OFG+GJ%SHT ;SHORT FORM GTJFN, NAME ONLY( NO REAL FILE)
HRROI B,DSCBUF ;POINTER TO FILESPEC
CALL GTJFS ;PARSE THE FILESPEC( FOR STRUCTURE NAME)
CALL JERR ;SHOULDN'T FAIL FOR JUST A PARSE!
MOVE B,A ;PUT JFN IN B
HRROI A,DSCBUF ;POINTER TO FREE SPACE
LDF C,1B2 ;SPECIFY DEVICE FIELD, NO PUNCUATION
JFNS ;ISOLATE THE STRUCTURE NAME
MOVEI B,0 ;END WITH NULL
IDPB B,A
HRROI A,DSCBUF ;POINT AT STRUCTURE NAME
STDEV ;GET THE DEVICE DESIGNATOR FOR STRUCTURE
CALL JERRE ;ERROR CODE IN B, UNEXPECTED ERROR
MOVE A,B ;PUT DESIGNATOR IN A
GDSKC
HRROI C,DSCBUF ;GET POINTER TO STR NAME
NOXTND,<
ETYPE < %2Q Pages free on %3M:%_>
>
XTND,<
ETYPE < %2Q Pages free on %3M:, %1Q pages used.%_>
>
RET
DSKCNT: SETZB D,Q2 ;FOR SUMS OF TOTAL AND DELETED PAGES
MOVE B,A ;DIR NUMBER TO B
HRROI A,DSCBUF ;GET STRING SPACE POINTER
CAMN B,[-1] ;DEFAULT DIRECTORY?
JRST DSKCN0 ;YES
DIRST ;STORE DIR STRING
CALL CJERR ;WE JUST SCANNED IT?!
DSKCN0: MOVE B,A
HRROI A,[ASCIZ/*.*/]
SETZ C, ;READ TO NULL
SIN ;APPEND TO STRING
MOVX A,GJ%OLD!GJ%DEL!GJ%IFG!GJ%PHY!GJ%SHT ;OLD, *'S, SHORT CALL, INCL. DELETED, PHYSICAL DEVICE ONLY
HRRI A,.GJALL ;* VERSION
HRROI B,DSCBUF ;GET STRING POINTER
CALL GTJFS ;GET JFN
CALL [ CAIE A,GJFX20
CAIN A,GJFX32
JRST [ SUB P,[XWD 1,1] ;FOR NO FILES IN DIRECTORY,
SETZ Q3, ;CLEAR TOTAL
RET] ;TYPE "0 PAGES"
JRST CJERR]
MOVE Q1,A
;LOOP OVER FILES WITH GNJFN
DSKST1: TLZ Z,F1 ;RESET DELETED BIT
HRRZ A,Q1 ;JFN ONLY
MOVE B,[XWD 1,.FBCTL] ;CONTROL BITS WORD OF FDB
MOVEI C,C ;TO BE PUT IN C
CALL $GTFDB ;GET IT
JRST DSKST2 ;COULDN'T
TLNE C,(FB%DEL) ;DELETED?
TLO Z,F1 ;YES, SAY SO
MOVE B,[XWD 1,.FBBYV] ;# PAGES IN RH
MOVEI C,C
CALL $GTFDB ;DO GTFDB JSYS, NO SKIP IF NO ACCESS
DSKST2: TLOA Z,F3 ;SAY ACCESS ERROR AND SKIP ADD
JRST DSKST4 ;GO ADD UP PAGES
DSKST3: MOVE A,Q1 ;JFN AND FLAGS
GNJFN ;STEP TO NEXT FILE
JRST .+2 ;NO MORE FILES
JRST DSKST1
MOVE Q3,D ;FORM SUM
ADDI Q3,(Q2) ;OF DELETED AND UNDELETED
RET ;PRINT RELEVANT NUMS, RELEASE JFN
DSKST4: TLNE Z,F1 ;SUM DELETED OR UNDELETED
JRST .+3
ADDI D,(C) ;UNDELETED TOTAL
JRST DSKST3
ADDI Q2,(C) ;DELETED TOTAL
JRST DSKST3
;CHECK CONNECTED DIRECTORY FOR EXCEEDING DISK ALLOCATION
;USED BY LOGIN, LOGOUT, CONNECT
CHKDAL::GJINF
CHKDL3: MOVE D,B ;SAVE CONNECTED DIR
MOVE A,B ;PUT DIR NUM IN A
GTDAL ;GET QUOTA AND CURRENT ALLOC
ERJMP R ;DON'T TRY TO PRINT OVER QUOTA IF THIS FAILS
JUMPE B,R ;NO MESSAGE IF 0 USAGE
CAME D,LIDNO ;IS THIS LOGGED IN DIR?
JRST CHKDA1 ;NO, CHECK PERM STORAGE
SUB B,A ;GET AMOUNT OVER WORKING QUOTA
SKIPLE B ;SKIP IF NOT OVER
ETYPE < %4R Over working storage allocation by %2Q page(s).
>
RET
CHKDA1: SUB B,C ;GET AMOUNT OVER PERMANENT QUOTA
SKIPLE B ;SKIP IF NOT OVER
ETYPE < %4R Over permanent storage allocation by %2Q page(s).
>
RET
;INFORMATION ABOUT MAIL
;TELLS IF THERE IS NEW MAIL FOR A USER
;DEFAULTS TO SELF
.MALST: NOISE <FOR USER>
NOXTND,<
CALL USRNAM ;GET USER NAME. DEFAULT TO SELF
ERROR <No such USER>
>
XTND,<
CALL USRNAM ; GET USER NAME. DEFAULT TO SELF
JRST [ MOVEI B,[FLDDB. .CMKEY,,[1,,1
[ASCIZ "SYSTEM"],,0]]
CALL FLDSKP
ERROR <No such USER>
CONFIRM
HRROI B,[GETSAVE <SYS:MS.>]
CALL TRYGTJ
RET
PUSH P,[CMDIN2] ; RETURN HERE
MOVEI B,1 ; OFFSET 1
CALLRET REPH1] ; RUN MS AS EPHEMERON
>
MOVE B,C ;USER NUMBER IN B
CONFIRM
CALL MALCHK ;SEE IF THAT USER HAS ANY NEW MAIL
JRST MALSTF ;MAIL.TXT NOT READABLE OR NO MAIL
XTND,< ; STRING PNTR IN A
TLNN B,77 ; CHECK NET-MAIL
JRST [ ETYPE < Netmail %1\>
JRST EOLRET]
ETYPE < Mail %1\>
JRST EOLRET
>
NOXTND,<
UTYPE [ASCIZ / New mail exists/]
JRST EOLRET
>
MALSTF: JUMPE A,MALSTN ;IF ZERO NO MAIL
UTYPE [ASCIZ/ Mailbox protected/]
JRST EOLRET
MALSTN: UTYPE [ASCIZ/ No new mail exists/]
JRST EOLRET
XTND,<
;INFORMATION ABOUT ALERTS
.ALRST: NOISE <PENDING>
CONFIRM
SKIPG A,ALRTIM ; ANY PENDING?
JRST ALRST4 ; NO
ETYPE < Next alert at %1D %1E>
SKIPE B,REASON ; USER MESSAGE
TYPE < - >
ETYPE <%2\%%_>
MOVSI D,-NALTS ; CHECK FOR MORE
ALRST2: SKIPG A,ALRTMS(D) ; ANY?
JRST ALRST3 ; EMPTY SLOT - GO ON
TLON Z,F1 ; FIRST TIME FLAG
TYPE < Other alerts set for:
>
ETYPE < %1D %1E>
SKIPE B,REASON+1(D) ; MESSAGE TABLE
TYPE < - >
ETYPE <%2\%%_>
ALRST3: AOBJN D,ALRST2 ; LOOP OVER ALL
RET ; DONE
ALRST4: TYPE < No alerts set
>
RET
;INFORMATION (ABOUT) DOWNTIME
.DOWNT: SETOM TYPING ; SAY OUTPUT IN PROGRESS
HRROI B,[GETSAVE <SYS:MHALT.>]
CALL TRYGTJ
RET
MOVEI B,2 ; START AT OFFSET 2
CALLRET REPH1
>
;MEMSTAT
;TYPES, FOR CURRENT FORK, # PAGES, ENTRY VECTOR,
;AND A TABLE GIVING IDENTITY OF EACH PAGE IN FORK.
.MEMST::SKIPGE FORK
JRST [ UTYPE [ASCIZ / No program/]
JRST EOLRET]
TRVAR <LPC,NPGS>
SETOM LPC ;LAST PAGE COUNTED
SETZM NPGS ;NO PAGES YET
MOVEI A,BUF0 ;MAKE BYTE POINTER FOR BUILDING MESSAGE
HRLI A,440700
MOVEM A,COJFN
;SUBROUTINE TO TYPE MEMORY MAP FOR CURRENT FORK, FOR MEMSTAT.
;ACS: D: PAGE #
; Q1 & Q2: IDENTITY OF CURRENT PAGE, A LA RMAP A & B.
; P3, P4: SAVED IDENTITY OF 1ST PAGE OF GROUP.
; Q3: INCREMENT FOR PAGE # IN GROUP OF CONSECUTIVE PAGE IDENTITIES.
MEMMXL==FILCRS+^D80 ;maximum number of characters in an output line of INFO MEM
SETZ D,
;FIND EXISTING PAGE (TREAT INDIRECT POINTERS AS EXISTING)
MMAP1: HRL A,FORK
MMAP2: HRRZ B,COJFN ;SEE WHAT WORD WE'RE WRITING INTO
CAIL B,BUFEND-MEMMXL/5 ;AT END OF BUFFER?
JRST [ CALL FIXIO ;REVERT IO TO REAL OUTPUT, SO WARNING GETS SEEN
ETYPE <%%Memory map too fragmented for internal buffer - partial map being displayed...%_>
JRST MMD1]
CAIL D,40000
JRST MMAPDN ;NO MORE PAGES, DONE
HRR A,D
RPACS
ERJMP [ SETZ B, ;Currently fails if no such section
ADDI D,777 ;Fake non-existant page and skip
JRST .+1] ; to next section for speed
TXNN B,PA%PEX!PA%IND
AOJA D,MMAP2 ;DOESN'T EXIST, TRY NEXT
;FOUND ONE, PRINT NUMBER
CALL PAGID ;GET FULL IDENTITY
JRST .+2 ;3-RETURN SUBR, BUT IRRELEVANT HERE.
JRST .+1
MOVE P3,Q1 ;SAVE IDENTITY FOR LATER COMPARISONS
MOVE P4,Q2 ;...AND PRINTING
SETZ Q3, ;INIT # CONSECUTIVE IDENTITIES
HRRZ B,D
CALL TOCT ;PRINT PAGE NUMBER IN OCTAL
;LOOK AT IDENTITY OF NEXT PAGE
CALL NPAGID ;STEPS D AND GETS IDENTITY
SOJA Q3,MMAP10 ;DIFFERENT, GO TYPE IDENTITY
JRST MMAP6 ;NEXT HIGHER IN SAME FILE OR FORK
;IDENTICAL, SEE HOW MANY MORE ARE
CALL NPAGID
JRST .+3 ;DIFFERENT
JRST .+2 ;NEXT HIGHER
JRST .-3 ;IDENTICAL, KEEP LOOKING
SETZ Q3, ;SAY IDENTICAL NOT CONSECUTIVE GROUP
JRST MMAP7 ;GO PRINT "-# <FILE OR FORK> #
;GET HERE WHEN DONE MAKING TEXT
MMAPDN: CALL FIXIO ;REVERT TO REAL OUTPUT STREAM
MMD1: MOVE A,NPGS ;GET NUMBER OF PAGES
ETYPE <%_%%1Q. pages>
;PRINT ENTRY VECTOR
MOVE A,FORK
GEVEC
JUMPE B,MEMS3 ;NONE
HRRZ A,B ;For now, can only handle half-word vec addr
HLRZ B,B
ETYPE <, Entry vector loc %1O len %2O>
MEMS3: ETYPE<%_>
SKIPN NPGS ;ANY PAGES?
RET ;NO, DONE!
ETYPE<%_>
UETYPE BUF0 ;TYPE REST OF MESSAGE
CALLRET UNMAP ;UNMAP BUFFER PAGES USED FOR TEXT
;NEXT HIGHER OF SAME FILE OR FORK, SEE HOW MANY MORE ARE CONSECUTIVE
MMAP6: CALL NPAGID
JRST .+2 ;DIFFERENT
JRST .-2 ;CONSECUTIVE, KEEP LOOKING
;PRINT "-#" FOR GROUP OF IDENTICAL OR CONSECUTIVE PAGES
MMAP7: PRINT "-"
MOVEI B,-1(D) ;LAST IN GROUP WAS THE PREVIOUS PAGE
CALL TOCT ;TYPE IN OCTAL
;MMAP...
;PRINT IDENTITY OF PAGES WHOSE #'S WE HAVE JUST PRINTED:
;TYPICALLY FORK OR FILE NAME, # FOR A SINGLE PAGE OR IDENTICAL GROUP,
; #-# FOR CONSECUTIVE GROUP. ALL PRECEDED BY @ IF INDIRECT.
MMAP10: PRINT TAB
PRINT " "
TXNE P4,PA%IND
UTYPE [ASCIZ /@ /] ;INDICATE INDIRECT POINTER
TXNN P4,PA%PEX ;DOES PAGE EXIST?
JRST [ UTYPE [ASCIZ /No page/] ;CAN HAPPEN WITH INDIRECT.
JRST MMAP13]
TXNE P4,PA%PRV
JRST [ UTYPE [ASCIZ /Private/]
JRST MMAP13]
CAMN P3,[-1] ;RMAP RETURNS -1 IF NO JFN FOR FILE
JRST [ UTYPE [ASCIZ /Forgotten file/]
JRST MMAP13]
LDB B,[POINT 9,P3,17] ;JFN OR FORK #
TXNE P3,1B0 ;ON IF FORK
JRST [ UETYPE [ASCIZ /Fork %2O/]
JRST MMAP11]
ETYPE <%2S> ;PRINT FILNAME
MMAP11: TYPE < >
HRRZ B,P3
CALL TOCT ;PAGE # IN FILE OR FORK
JUMPLE Q3,MMAP13 ;0 INDICATES ONE PAGE ONLY
PRINT "-"
ADDI B,-1(Q3) ;DON'T COUNT LAST PAGE TESTED!
CALL TOCT ;PAGE # OF LAST PAGE OF CONSECUTIVE GROUP
MMAP13: TYPE ( )
TLZ Z,F1 ;USED BY "BEFORE"
TXNN P4,PA%RD
JRST .+3
CALL BEFORE ;TYPE COMMA OR EOL BETWEEN ITEMS
PRINT "R"
TLNN P4,F3
JRST .+3
CALL BEFORE ;SUBR WITH "AVAIL DEVICES"
PRINT "W"
TXNN P4,PA%CPY
JRST .+3
CALL BEFORE
TYPE <CW> ;COPY-ON-WRITE
TXNN P4,PA%EX
JRST .+3
CALL BEFORE
PRINT "E"
ETYPE<%_>
JRST MMAP1 ;GO BACK FOR ANOTHER PAGE OR GROUP
;SUBROUTINE FOR MMAP TO GET AND COMPARE IDENTITY OF PAGE
;TAKES IN D: PAGE #, IN P3, P4: IDENTITY OF FIRST PAGE IN GROUP,
; IN Q3: PAGE # INCREMENT FOR CONSECUTIVE GROUP.
;RETURNS: Q1, Q2: IDENTITY OF PAGE, A LA RMAP.
; +1: DIFFERENT IDENTITY FROM FIRST PAGE OF GROUP
; +2: NEXT HIGHER PAGE # (THAN P4+Q3, Q3), Q3 INDEXED
; +3: IDENTICAL
;IF D > 37777, BEHAVES AS THOUGH CURRENT PAGE IS NON-EXISTENT.
;CLOBBERS A,B.
NPAGID: ADDI D,1 ;ENTRY FOR NEXT PAGE
ADDI Q3,1
PAGID: MOVE A,D ;ENTRY TO NOT INDEX PAGE #
SETZ Q1, ;FOR NON-EXISTENT OR PRIVATE PAGE
CAIL A,40000
JRST [ MOVX Q2,PA%PEX ;PAGES OVER 37777 DON'T EXIST
JRST PAGID8]
HRL A,FORK
MOVE C,A ;GET COPY OF HANDLE TO CHECK FOR PRIVATENESS
RMAP ;GET PAGE INFORMATION
ERJMP [ SETZ B, ;Currently fails if no such section
JRST .+1] ;Fake no such page for now
CAMN A,C ;DID RMAP RETURN SAME HANDLE AS GIVEN?
TXO B,PA%PRV ;YES, SO PAGE IS PRIVATE
HLLZ Q2,B ;RETURN RPACS INFO IN Q2
MOVE Q1,A ;REMEMBER IDENTIFIER
TXNE Q2,RM%PEX ;DOES PAGE EXIST?
JRST [ HRRZ C,C ;YES, SEE WHAT PAGE THIS IS
CAMG C,LPC ;LARGER THAN ONE ALREADY COUNTED?
JRST .+1 ;NO, DON'T COUNT IT AGAIN!
MOVEM C,LPC ;YES, REMEMBER LARGEST COUNTED
AOS NPGS ;COUNT NUMBER OF EXISTENT PAGES
JRST .+1]
;COMPARISON TO DETERMINE WHETHER SAME AS PREVIOUS PAGE
;COMPARE THAT INFO WHICH IS PRINTED:
; ALL Q1, Q2 BITS 2-6, 9, 10.
PAGID8: MOVE A,Q1
XOR A,P3
TLNE A,-1
JRST PAGID9 ;DIFFERENT FILES OR FORKS, R1
MOVE B,Q2 ;RMAP'S ACCESS IS WRONG (1/22/71)
XOR B,P4
TLNE B,<37B6+3B10>B53
JRST PAGID9 ;DIFFERENT ACCESS, R1.
TRNE A,-1
JRST [ MOVE A,Q3
ADD A,P3
SUB A,Q1
TRNE A,-1
JRST .+3 ;REALLY DIFFERENT PAGE, R1
JRST .+2] ;NEXT HIGHER PAGE #, R2
AOS (P) ;SAME IDENTITY INCLUDING PAGE #, R3.
AOS (P)
PAGID9: RET
;INFORMATION (ABOUT) ARPANET
.IARPA: KEYWD $IARPA
T STATUS,ONEWRD,.ANSTS
JRST CERR
TXNE P3,ONEWRD ;THESE NEED CONFIRMING
CONFIRM
JRST (P3)
$IARPA: TABLE
T STATUS,ONEWRD,.ANSTS
TEND
;INFORMATION (ABOUT) APRANET STATUS
.ANSTS: MOVE A,[SIXBIT /NETRDY/]
SYSGT ;GET NETWORK STATUS TABLE
MOVEM B,NETRDY ;SETUP FOR GTB
HRR A,B ;GET TABLE NUMBER
HRLI A,1 ;MUST DO THIS GETAB HERE TO SEE IF THE
GETAB ; TABLE EXIST
JRST [ ETYPE <%%No ARPANET%_>
RET]
TYPE < ARPANET service is >
JUMPN A,[TYPE <enabled
>
JRST NTST01]
TYPE <disabled
>
NTST01: TYPE < The IMP interface is >
MOVEI D,0 ;SEE IF IMP IS UP
GTB .NETRD
JUMPE A,[TYPE <down
> ;IF ZERO, IMP IS DOWN
JRST NTST02]
JUMPG A,[TYPE <initializing
> ;IF POSITVE, IMP IS INITIALIZING
JRST NTST02]
TYPE <up
> ;IF NEGATIVE, IMP IS UP
NTST02: MOVEI D,6 ;GET TIME OF LAST IMP UP TIME
GTB .NETRD
SKIPLE A
ETYPE < Most recent IMP ready line on-transition: %1W
>
MOVEI D,5 ;AND LAST DOWN TIME
GTB .NETRD
SKIPLE A
ETYPE < Most recent IMP ready line off-transition: %1W
>
RET ;END OF STATUS PRINTING
;INFORMATION (ABOUT) DECNET
.IDECN: KEYWD $IDECN
T NODES,ONEWRD,.DNTOP
JRST CERR
TXNE P3,ONEWRD ;THESE NEED CONFIRMING
CONFIRM
JRST (P3)
$IDECN: TABLE
T NODES,ONEWRD,.DNTOP
TEND
REPEAT 0,<
;INFORMATION (ABOUT) DECNET STATUS
.DNSTS: MOVEI A,BUFL-BUF0-.NDNLN-1 ;WORDS AVAILABLE FOR LINE TABLE
MOVEM A,BUF0+.NDNLN ;TO COUNT WORD
MOVEI A,.NDGLI ;FUNCTION
MOVEI B,BUF0
NODE
ERCAL DNTOPE
HLRZ A,BUF0+.NDNLN ;GET COUNT OF RETURNED NODES
JUMPE A,DNSTSX
MOVN A,A
HRLZ A,A
HRRI A,BUF0+.NDNLN+1 ;WE NOW HAVE AOBJN POINTER
DNSTS3: MOVE B,(A) ;GET POINTER TO NODE BLOCK
MOVE C,.NDLST(B) ;GET LINE STATE
HRROI D,[ASCIZ /unknown/]
CAIN C,.NDLON
HRROI D,[ASCIZ /on line/]
CAIN C,.NDLOF
HRROI D,[ASCIZ /off line/]
CAIN C,.NDLCN
HRROI D,[ASCIZ /controller loopback/]
CAIN C,.NDLCB
HRROI D,[ASCIZ /cable loopback/]
MOVE C,.NDLNM(B) ;GET PORT NUMBER
MOVE B,.NDLND(B) ;POINTER TO NODE NAME
ETYPE < Line %3O, Node %2M, State is %4M%%_>
AOBJN A,DNSTS3
RET
DNSTSX: ETYPE <%%No DECNET status%_>
RET
> ;END OF REPEAT 0
;INFORMATION (ABOUT) DECNET NODES
.DNTOP: MOVEI A,BUFL-BUF0-.NDNND-1 ;WORDS AVAILABLE FOR TOPOLOGY TABLE
MOVEM A,BUF0+.NDNND ;TO COUNT WORD
MOVEI A,.NDGNT ;FUNCTION
MOVEI B,BUF0
NODE
ERCAL DNTOPE
HLRZ A,BUF0+.NDNND ;GET COUNT OF RETURNED NODES
JUMPE A,DNTOPX
MOVN A,A
HRLZ A,A
HRRI A,BUF0+.NDBK1 ;WE NOW HAVE AOBJN POINTER
DNTOP3: MOVE B,(A) ;GET POINTER TO NODE BLOCK
MOVE C,.NDSTA(B) ;GET NODE STATE
MOVE B,.NDNAM(B) ;GET NODE NAME POINTER
CAIE C,.NDSON ;ONLY PRINT ON-LINE NODES
JRST DNTOP2
TLNN Z,F1 ;ANY PRINTED YET?
TYPE < Accessible DECNET nodes are:>
CALL BEFORE
ETYPE <%2M>
DNTOP2: AOBJN A,DNTOP3
TLNN Z,F1
DNTOPX: TYPE <%No DECNET nodes accessible>
ETYPE <%_>
RET
DNTOPE: CALL %GETER
MOVE A,ERCOD ;GET FAILURE REASON
CAIN A,ARGX04 ;NOT ENOUGH SPACE
JRST DNTOP1 ;YES, PRINT WARNING
CAIE A,ILINS2 ;NO NODE JSYS?
CAIN A,ARGX02 ;OR ILLEGAL FUNCTION?
RET ;YES, RETURN AS IF EMPTY TABLE
JRST CJERR
DNTOP1: ETYPE <%%Not enough storage, incomplete data will be printed%_>
RET
;FILSTAT
.FILST:: NOISE <OF JFN>
OCTX <Octal JFN number or blank for all>
jrst filst1 ;non-octal number typed, check for blank
confirm ;confirm the number
CAIG b,MAXJFN ;LEGAL JFN NUMBER?
SKIPg b
ERROR <Illegal JFN number>
MOVE D,b ;SAVE JFN FOR JSTAT
move a,b ;put jfn in a
GTSTS
TXNN B,GS%NAM ;JFN ACTIVE?
ERROR <JFN not in use>
CALLRET JSTAT ;PRINT INFO FOR JFN
FILST1: CONFIRM
GJINF
ETYPE < Connected to %G%. >
;JFNS
TYPE < JFNS:
>
MOVEI D,MAXJFN ;JFN AND COUNTER
CALL JSTAT ;TYPE INFO IF JFN ASSIGNED
SOJGE D,.-1
ETYPE<%_>
;DEVICES ASSIGNED TO THIS JOB
PUSH P,[[TLNE Z,F1 ;SET RETURN FOR ASTTJ
ETYPE<%_>
RET]]
;"AVAILABLE DEVICES" ALSO COMES HERE TO TYPE DEVS ASS TO THIS JOB.
ASTTJ:: GJINF ;GET JOB # IN C
MOVE Q1,C
TLZ Z,F1
CALL DEVLUP ;GET NAME & CHARACTERISTICS FOR EACH
;DEVICE AND EXECUTES THE NEXT LOCATION.
CALL [ CAME C,Q1 ;ASSIGNED TO THIS JOB?
RET ;NO.
TLNN Z,F1 ;FIRST ONE? ("BEFORE" SETS F1)
TYPE <Devices assigned to/opened by this job:>
CALL BEFORE ;COMMA OR CR OR NIL. AFTER "AVAIL DEV".
JRST SIXPRT] ;PRINT SIXBIT NAME FROM A.
TLNE Z,F1
ETYPE<%_>
RET
;TYPE STATUS OF JFN IN RH OF D.
;NOP IF UNASSIGNED.
;IF ASSIGNED, TYPE <JFN> <NAME>
;AND WHAT OPEN FOR AND "NOT OPEN" OR "DATA ERROR" OR "EOF" IF PERTINENT.
;DESTROYS A, B, C, E. USED IN "FILSTAT".
JSTAT: HRRZ A,D
GTSTS
TLNN B,200
RET ;UNASSIGNED, RETURN.
MOVE Q1,B ;STATUS FOR USE BELOW
PRINT " "
MOVE A,COJFN
HRRZ B,D
MOVE C,[XWD 4,10]
NOUT ;JFN, LEFT ADJ IN 4 COLS
CALL JERRC
HRRZ B,D
SETZ C, ;DEFAULT FORMAT
JFNS ;PRINT NAME
ERJMP [ CALL JFNSIL ;ANALYZE ERROR
JRST JFNGON ;JFN PROBABLY WENT AWAY
JRST .+1] ;MESSAGE PRINTED, LIKE "RESTRICTED JFN"
;JSTAT...
;TYPE "NOT OPEN" OR LIST OF "READ", "EXECUTE", ETC.
;IF B0 ON AND B1-3 & 5-6 OFF, TYPES NOTHING. CAN THIS HAPPEN? ______
PRINT TAB
TLZ Z,F1 ;TELL "BEFORE" NOTHING HAS BEEN PRINTED
TXNN Q1,GS%OPN
TYPE < Not opened>
TXNN Q1,GS%RDF
JRST JSTAT3
CALL BEFORE ;TYPE SPACE OR COMMA-SPACE OR EOL-SPACE
TYPE <Read>
JSTAT3: TXNN Q1,GS%WRF ;OK TO WRITE
JRST JSTAT4
CALL BEFORE
TXNN Q1,GS%RND ;ALSO OK TO CHANGE POINTER?
TYPE <Append> ;NO
TXNE Q1,GS%RND
TYPE <Write> ;YES
JSTAT4: TXNN Q1,GS%XCF ;EXECUTE
JRST JSTAT5
CALL BEFORE
TYPE <Execute>
JSTAT5: TXNN Q1,GS%APT ;AS SPECIFIED BY PAGE TABLE
JRST JSTAT6
CALL BEFORE
TYPE <New file>
JSTAT6: TXNN Q1,GS%CAL ;CALL AS PROCEDURE
JRST JSTAT7
CALL BEFORE
TYPE <Overlapped dump I/O>
JSTAT7: TXNN Q1,GS%ERR
JRST JSTAT8
CALL BEFORE
TYPE <Data error>
JSTAT8: TXNN Q1,GS%EOF
JRST JSTAT9
CALL BEFORE
TYPE <EOF>
JSTAT9: TXNE Q1,GS%RDF!GS%WRF
TXNN Q1,GS%OPN
JRST JSTA10
TXNE Q1,GS%XCF
JRST JSTA10
HRRZ A,D
RFPTR
ERJMP [ TXNN Q1,GS%FRK ;RESTRICTED?
JRST JFNGON ;NO, PRINT LOSE MESSAGE
JRST JSTA10] ;SKIP POSITION
CALL BEFORE
MOVE A,COJFN
MOVEI C,12
NOUT
CALL JERRC
TYPE <.(>
HRRZ A,D
RFBSZ
ERJMP JFNGON ;JFN DISAPPEARED
MOVE A,COJFN
NOUT ;PRINT BYTE SIZE (C STILL SET FROM LAST NOUT)
CALL JERRC
MOVEI B,")"
CALL TBOUT
JSTA10: JRST EOLRET
;COME HERE IF A JSYS FAILS WHICH IS TRYING TO INTERROGATE THE JFN BEING
;PRINTED. THE USUAL FAILURE IS IF THE JFN GETS CLOSED WHILE THE INTERROGATION
;IS GOING ON.
JFNGON: CALL DGETER ;GET THE REASON FOR THE FAILURE
CAIE A,DESX3 ;MAKE SURE IT'S "JFN IS NOT ASSIGNED"
CALL JERR ;STRANGE ERROR, SO FAIL
ETYPE < ...[JFN has just been released]%_>
RET ;CONTINUE WITH REST OF JFNS
END