Trailing-Edge
-
PDP-10 Archives
-
AP-4178E-RM
-
swskit-sources/execin.mac
There are 47 other files named execin.mac in the archive. Click here to see a list.
;<3-EXEC-SNARK>EXECIN.MAC.50, 20-Apr-78 11:22:28, Edit by FORTMILLER
;<3-EXEC>EXECIN.MAC.49, 10-Nov-77 09:32:42, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-EXEC>EXECIN.MAC.48, 2-Nov-77 02:29:53, Edit by LCAMPBELL
;FIX ADDRESS BREAK
;<3-EXEC>EXECIN.MAC.47, 28-Sep-77 16:18:05, EDIT BY HURLEY
;<3-EXEC>EXECIN.MAC.46, 10-Sep-77 16:37:19, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.45, 21-Aug-77 15:17:33, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.44, 21-Aug-77 15:12:08, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.43, 21-Aug-77 15:10:36, Edit by LCAMPBELL
;MAKE "INFO ADDRESS-BREAK" SAY RIGHT THINGS
;<3-EXEC>EXECIN.MAC.42, 16-Aug-77 11:13:56, EDIT BY OSMAN
;MOVE "GFRKS" TO SUBROUTINE SO "FORK" COMMAND CAN DO IT TOO
;<3-EXEC>EXECIN.MAC.41, 10-Aug-77 16:54:19, EDIT BY HURLEY
;<3-EXEC>EXECIN.MAC.40, 10-Aug-77 16:51:58, EDIT BY HURLEY
;<3-EXEC>EXECIN.MAC.39, 10-Aug-77 13:11:56, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.38, 10-Aug-77 12:34:43, EDIT BY HURLEY
;<3-EXEC>EXECIN.MAC.37, 9-Aug-77 16:20:32, EDIT BY HURLEY
;CLEAN UP FOR RELEASE 3 DOCUMENTATION
;<3-EXEC>EXECIN.MAC.36, 8-Aug-77 20:05:50, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.35, 3-Aug-77 13:43:00, Edit by LCAMPBELL
;Make text messages for INFO ADDR be in proper case
;<3-EXEC>EXECIN.MAC.34, 3-Aug-77 13:23:50, Edit by LCAMPBELL
;<3-EXEC>EXECIN.MAC.33, 3-Aug-77 13:16:18, Edit by LCAMPBELL
;ADD INFORMATION (ABOUT) ADDRESS-BREAK
;<3-EXEC>EXECIN.MAC.32, 3-Aug-77 12:27:07, EDIT BY OSMAN
;MAKE "INFO SYS" TELL WHETHER ACCOUNT VALIDATION IS IN EFFECT
;<3-EXEC-NSW>EXECIN.MAC.1, 28-Jul-77 21:50:07, EDIT BY CLEMENTS.CALVIN
; Added "JSYS/UUO trap" for fork status 6
;<3-EXEC>EXECIN.MAC.31, 26-Jul-77 23:11:14, EDIT BY CROSSLAND
;ADD % TO NO INFO AVAILABLE RESPONSE TO I NETWORK COMMAND
;<3-EXEC>EXECIN.MAC.30, 21-Jul-77 20:32:00, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.29, 21-Jul-77 17:01:56, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.28, 21-Jul-77 15:48:30, EDIT BY OSMAN
;FIX "INFO STR *", IN WHICH COMND SAW "*" INSTEAD OF STRUCTURE NAME,
;BUT SINCE "*" IS A BREAK CHARACTER, THE STRUCTURE NAME INPUT WAS THE
;NULL STRING, SO COMND SUPPLIED THE DEFAULT WHICH THE EXEC HAD SET UP
;AS THE CONNECTED STRUCTURE. FIX IS TO CHECK FOR "*" BEFORE CHECKING
;FOR STRUCTURE NAME
;<3-EXEC>EXECIN.MAC.27, 4-Jul-77 21:16:30, EDIT BY CROSSLAND
;<3-EXEC>EXECIN.MAC.26, 30-Jun-77 20:54:29, EDIT BY CROSSLAND
;<3-EXEC>EXECIN.MAC.25, 17-Jun-77 05:22:58, EDIT BY CROSSLAND
;<3-EXEC>EXECIN.MAC.24, 16-Jun-77 20:55:02, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.23, 13-Jun-77 02:28:09, EDIT BY CROSSLAND
;ADD INFO ABOUT MAIL AND NETWORK COMMANDS
;<3-EXEC>EXECIN.MAC.22, 3-Jun-77 15:45:31, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.21, 2-Jun-77 13:45:54, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.20, 1-Jun-77 12:13:13, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.19, 25-May-77 14:49:21, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.18, 25-May-77 14:37:18, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.17, 19-May-77 10:32:03, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.16, 13-May-77 10:49:14, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.15, 12-May-77 16:40:13, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.14, 12-May-77 16:19:17, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.13, 12-May-77 16:13:09, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.12, 12-May-77 15:14:43, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.11, 12-May-77 14:51:14, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.10, 12-May-77 14:43:44, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.9, 12-May-77 13:33:56, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.8, 4-May-77 15:15:13, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.7, 26-Apr-77 17:00:10, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.6, 10-Apr-77 17:46:18, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.5, 10-Apr-77 17:10:03, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.4, 10-Apr-77 17:05:57, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.3, 10-Apr-77 17:02:49, EDIT BY OSMAN
;<3-EXEC>EXECIN.MAC.2, 10-Apr-77 16:57:45, EDIT BY OSMAN
;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 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH MONSYM,XDEF,COMSYM,MACSYM
.REQUIRE SYS:MACREL
TTITLE EXECIN
;THIS FILE CONTAINS
;INFORMATION COMMANDS
;EXCEPT INFORMATION (ABOUT) BATCH-REQUESTS AND
;INFORMATION (ABOUT) OUTPUT-REQUESTS, WHICH ARE IN EXECQU.MAC
.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 CCHRO
HRRZ B,P3 ;GET LAST UNIT NUMBER
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.
;RETURNS +2.
;DESTROYS A, B, C, D.
DEVLUP::SETO D,
GTB DEVNAM ;GET # DEVICES FROM TABLE 6
HRLZ D,A ;XWD AOBJN COUNT, TABLE INDEX
DEVL1: CALL .DVCHR ;GET DEVICE CHARACTERISTICS
JRST DEVL2 ;SKIP THIS ONE IF UNKNOWN DEVICE
HRR B,C ;GET UNIT NUMBER
HLRE C,C
GTB DEVNAM ;GET DEVICE NAME IN SIXBIT FROM TABLE 6
JUMPE A,DEVL2 ;SKIP NULL ENTRIES
PUSH P,D
XCT @-1(P)
POP P,D
DEVL2: 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 CCHRO
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 DEVNAM ;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:: noise (ON SUBJECT)
call maklst ;make list of things there's help on
movei b,[flddb. .cmkey,,$HELP,,,[
flddb. .cmtok,,<-1,,[asciz /*/]>,,,[
flddb. .cmcfm,,,,,]]]
call field ;get some input
txne a,cm%nop ;make sure good input got typed
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
CAIN C,.CMTOK ;*?
JRST TYPLST ;YES, TYPE OUT THE LIST
PUSH P,B ;SAVE POINTER TO ITEM HELP DESIRED ABOUT
MOVE A,CSBUFP ;PREPARE TO CREATE FILENAME STRING
HRROI B,[ASCIZ /HLP:/]
MOVEI C,0 ;WE WANT NULL AFTER FILENAME
SOUT ;PUT IN DEVICE NAME
POP P,B ;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
MOVE B,CSBUFP ;POINTER TO FILENAME
HLP3: MOVX A,GJ%OLD+GJ%SHT ;OLD FILE ONLY, SHORT FORM
GTJFN ;GET HANDLE ON HELP FILE
ERROR <No help available on that subject>
MOVEI Q1,1 ;SO "TYPE" LOGIC WILL KNOW IT'S US
CALL JFNSTK ;REMEMBER THE JFN
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
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: CALL RLJFNS ;RELEASE JFNS USED
CALL UNMAP ;UNMAP PAGES USED
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
GTJFN ;GET HANDLE ON FIRST HELP FILE
ERJMP r ;no help files
movem a,hlpjfn ;remember the jfn
CALL JFNSTK ;REMEMBER JFN SO IT GOES AWAY LATER
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
TLNN P3,NOLOG ;NEED TO BE LOGGED IN?
SKIPE CUSRNO ;YES, ARE WE?
CAIA ;OK
ERROR <LOGIN please>
TLNE P3,ONEWD ;THESE NEED CONFIRMING
CONFIRM
JRST (P3)
$INFO: TABLE
T ADDRESS-BREAK,ONEWD,.ADBRK
T AVAILABLE,NOLOG
T BATCH-REQUESTS,,.IBR
;T CARD-READER-INPUT-SET,ONEWD,CRDINF
T COMMAND-LEVEL,NOLOG+ONEWD,.EXECM
T DIRECTORY ;PRINT DIRECTORY PARAMETERS
T DISK-USAGE,,.DSKST
T FILE-STATUS,,.FILST
T JOB-STATUS,ONEWD,.JOBST
T LOGICAL-NAMES,,.LNLIS
T MAIL,NOLOG,.MALST
T MEMORY-USAGE,ONEWD,.MEMST
T MONITOR-STATISTICS,ONEWD,MONSTA
T NETWORK-STATUS,NOLOG+ONEWD,.NTSTS
T OUTPUT-REQUESTS,,.IPR
T PROGRAM-STATUS,ONEWD,.RUNST
T PSI-STATUS,ONEWD,.PISTA
T SPOOLED-OUTPUT-ACTION,ONEWD,SPLINF
T STRUCTURE,,.STRST
T SUBSYSTEM-STATISTICS,ONEWD,SUBSTA
T SYSTEM-STATUS,ONEWD,SYSINF
T TAPE-PARAMETERS,ONEWD,TAPINF
T TERMINAL-MODE,NOLOG+ONEWD,TRMPNT
T VERSION,NOLOG+ONEWD
TEND
;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
SKIPE C ;ANYTHING THERE?
TXNN C,ALLFLG ;ANY BITS SET?
JRST [ TYPE <Address break not set.>
RET] ;NO
ETYPE <Address break at %2P 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
>
RET
;"INFORMATION (ABOUT) SYSTEM-STATUS"
SYSINF: MOVEI A,.SFOPR
TMON
TYPE < Operator is >
SKIPN B
TYPE <not >
TYPE <in attendance
>
MOVEI A,.SFRMT
TMON
TYPE < Remote logins >
SKIPN B
TYPE <Are not >
TYPE <allowed
>
MOVEI A,.SFLCL
TMON
TYPE < Local logins >
SKIPN B
TYPE <are not >
TYPE <allowed
>
MOVEI A,.SFPTY
TMON
TYPE < Pseudo-terminal logins >
SKIPN B
TYPE <are not >
TYPE <allowed
>
MOVEI A,.SFNVT
TMON
TYPE < ARPANET terminal logins >
SKIPN B
TYPE <are not >
TYPE <allowed
>
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 >
SKIPE B
TYPE <enabled
>
SKIPN B
TYPE <disabled
>
MOVE A,COJFN ;CURRENT OUTPUT JFN
MOVEM A,OUTDSG ;FOR SPECIAL ROUTINE
CALLRET SYSDWN ;PRINT INFO AND EXIT
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(B)
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 PAGE MODE
TYPE < TERMINAL >
TXNN B,TT%PGM
TYPE <NO >
TYPE <PAGE
>
;PAGE LENGTH
PUSH P,A
PUSH P,B
PUSH P,C
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
TTYPLN==.-TTYPTB
TTYNTY: ETYPE < TERMINAL TYPE %2Q>
;LIST LOGICAL NAMES
.LNLIS::TLZ Z,F2+F3 ;EVERYTHING OFF SO WE CAN DEFAULT LATER
NOISE <OF>
KEYWD $LNLIS
T JOB,,.LNJB ;DEFAULT
JRST CERR ;ERROR
CONFIRM
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,SYSJNM
HLLZS A
.LNTY1: MOVEM A,SYSDIR
MOVE B,CSBUFP ;PUT IN UNUSED PORTION OF STRING BUFFER
INLNM
JRST [ CAIE A,INLNX1
CALL JERR
RET] ;ALL DONE
IBP B
MOVEM B,SYSTNM
MOVE B,CSBUFP
MOVE C,SYSTNM
MOVE A,SYSJNM
LNMST
JRST [ CAIE A,LNSTX1
CALL JERR
JRST .LNTY2]
MOVE A,CSBUFP
CALL CTYPE
UTYPE [ASCIZ /: => /]
MOVE A,SYSTNM
CALL CTYPE
ETYPE<%_>
.LNTY2: MOVE A,SYSDIR
AOJA A,.LNTY1
$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:: STKVAR <DEFNAM> ;CELL TO HOLD POINTER TO DEFAULT NAME
NOISE <NAME>
CALL CONST ;GET DESIGNATOR OF CONNECTED STRUCTURE
MOVE A,CSBUFP ;POINT TO SOME FREE SPACE
MOVEM A,CMDEF ;SET UP POINTER TO DEFAULT VALUE FOR FIELD
MOVEM A,DEFNAM ;REMEMBER POINTER TO DEFAULT
DEVST ;CREATE DEFAULT VALUE
CALL JERR ;GETTING NAME OF CONNECTED STRUCTURE SHOULD NEVER FAIL
IBP A ;LEAVE NULL AFTER NAME
MOVEM A,CSBUFP ;REMEMBER NEW BEGINNING OF FREE SPACE AREA
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,GSSALS ;STORE FOR GETTING STRUCTURE STATUS
CALL MSGSS ;GET STRUCTURE STATUS
CALL CJERRE ;FAILED, GO SAY WHY AND QUIT THE COMMAND
MOVE A,GSSMC ;GET MOUNT COUNT
MOVE B,GSSOFC ;AND OPEN FILE COUNT
MOVE C,GSSNUS ;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,GSSSTA ;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,GSSALS ;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
ERCAL CJERRE ;COULDN'T, SAY WHY AND DIE
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
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 SMOUNTed %2H: /]
MOVEI P5,[ASCIZ /No users have %2H: SMOUNTed/]
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: PUSH P,D ;DEVLUP ROUTINE NEEDS "D" AS INDEX
CALL STRWK1
POP P,D
RET
STRWK1: CAMN A,[SIXBIT /DSK/] ;IS IT STRUCTURE "DSK"?
RET ;YES, FORGET IT, SINCE IT'LL COME UP AGAIN AS SPECIFIC STRUCTURE
CALL .DVCHR ;GET INFO ON THIS DEVICE
RET ;SKIP THIS ONE IF UNKNOWN DEVICE
MOVEM A,ALIAS ;STORE DESIGNATOR FOR STRUCTURE ALIAS
LDB C,[221100,,B] ;GET DEVICE TYPE
CAIE C,.DVDSK ;MAKE SURE IT'S A DISK
RET
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: PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D ;CLOBBER NOTHING
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!
MOVE A,CSBUFP ;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
MOVE A,CSBUFP ;LOOK AT STRIN
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: POP P,D
POP P,C
POP P,B
POP P,A
RET
DUMNO: TYPE <
>
MOVEI P1,0 ;NOTE THAT WE'RE ON NEW LINE
JRST DIRUMX
;JOBSTAT
.JOBST::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 ;CURRENT JOB
HRROI B,CSBUFP ;USE FREE SPACE POINTER
MOVE D,CSBUFP ;REMEMBER POINTER TO BEGINNING OF STRING
MOVEI C,.JISRM ;SPECIFY WE WANT SESSION REMARK
GETJI ;GET SESSION REMARK
ERJMP R ;IF FAILS, THERE'S NO REMARK
MOVE A,D ;SUCCEEDED, GET POINTER TO REMARK
ILDB A,A ;GET FIRST CHARACTER
JUMPE A,R ;IF NULL STRING, THERE'S NO REMARK
ETYPE <Session remark: %4M
>
RET
;RUNSTAT
.RUNST::ETYPE < Used %B% in %C%
>
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]
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)
>
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
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
CALL FSTATA ;PRINT STATUS WITH 0 PC
JRST FSTR2]
TRZ B,B0 ;PRINT IN FORM ## NOT 4000##
MOVE A,COJFN
MOVEI C,10
NOUT ;FORK HANDLE, OCTAL
CALL JERRC ;JSYS ERROR ROUTINE FOR ERROR NUM IN C
TYPE <: >
HRRZ A,1(D) ;HANDLE AGAIN
CAIN A,.FHSLF ;SELF?
JRST [ TYPE <EXEC>
JRST FSTR2A]
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 SUBR FOR "RUNSTAT" AND "JOBSTAT".
;TAKES HANDLE IN A, CLOBBERS A.
;USED IN FSTRUC (JOBSTAT), RUNSTAT, ^T PSI ROUTINE (XSUBRS.MAC)
FSTATA: PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,[0] ;NO FORK HANDLE
SETZ B, ;GIVE ZERO PC HERE
JRST FSTAT0
FSTAT:: PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,A ;SAVE FOR %X LATER
RFSTS ;GET STATUS IN A, PC IN B
FSTAT0: HLRZ C,A ;B1-17 = STATUS
CAIN C,-1 ; -1 = UNASSIGNED HANDLE. MAYBE A SUPERIOR
JRST [ MOVEI D,[ASCIZ /Program disappeared/]; ..KILLED PROGRAM
JRST FSTAT8]
TRZ C,B0 ;FLUSH FROZEN BIT
CAIE C,2 ;HALT OR FORCED TERM