Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/date.mac
There is 1 other file named date.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<UTILITIES>DATE.MAC.117, 20-Oct-83 11:53:05, Edit by SATZ
;[NIC] Make EX a legal abbreviation for EXIT
;<UTILITIES>DATE.MAC.116, 9-Aug-83 12:11:32, Edit by MRC
;ERROR.SYS now lives on SERR
;<UTILITIES>DATE.MAC.115, 28-Jan-83 18:51:23, Edit by ADMIN.MRC
;Set CR%CAP in TTYULK+5
;<UTILITIES>DATE.MAC.114, 2-Jan-83 19:22:22, Edit by ADMIN.MRC
;Remove edit 113
;<UTILITIES>DATE.MAC.113, 2-Jan-83 17:49:01, Edit by ADMIN.MRC
;Restrict our TTY JFN so inferiors can't close it on us
;<UTILITIES>DATE.MAC.112, 13-Dec-82 21:07:16, Edit by ADMIN.MRC
;<UTILITIES>DATE.MAC.111, 13-Dec-82 21:02:39, Edit by ADMIN.MRC
;Kludge patch to avoid blowing up on bugs
;<UTILITIES>DATE.MAC.110, 3-Jun-82 14:44:17, Edit by ADMIN.MRC
;Output RETURN before linefeed
;Teach it about Heaths
;<UTILITIES>DATE.MAC.109, 12-Mar-82 19:04:24, Edit by ADMIN.MRC
;Don't try to enable privs we can't get
;SNARK:<V-SOURCES>DATE.MAC.108 8-Jan-81 15:17:05, Edit by OSMAN
;Don't try to go to bottom of screen if length is 0.
;<V-SOURCES>DATE.MAC.101 11-Dec-80 15:12:15, Edit by OSMAN
;On ^D, show what processing is going on and for how long
;SNARK:<V-SOURCES>DATE.MAC.100 2-Dec-80 11:26:56, Edit by OSMAN
;Use DUMP.EXE instead of DUMP.CPY since DUMP.CPY may be deleted
;SNARK:<V-SOURCES>DATE.MAC.97 30-Oct-80 14:07:45, Edit by OSMAN
;Check terminal type every time a new announcement is starting
;Make announcements at bottom of screen so it doesn't mix with EMACS text
;<V-SOURCES>DATE.MAC.67, 28-Jul-80 14:41:01, EDIT BY OSMAN
;Don't preview the mail if the user is in MS.
;<V-SOURCES>DATE.MAC.66, 19-Jun-80 10:05:24, EDIT BY OSMAN
;Don't announce batch background jobs
;<V-SOURCES>DATE.NEW.2, 15-May-80 16:09:56, EDIT BY OSMAN
;Make STATISTICS selectable
;<V-SOURCES>DATE.MAC.53, 30-Apr-80 10:14:05, EDIT BY OSMAN
;Avoid "illegal to manipulate superior" error during ^D jfn scan
;<V-SOURCES>DATE.MAC.41, 31-Mar-80 15:02:25, EDIT BY OSMAN
;Display percentage through file
;<V-SOURCES>DATE.MAC.40, 26-Mar-80 10:46:28, EDIT BY OSMAN
;Prevent entire grump form from coming out when several grumps at once
;<V-SOURCES>DATE.MAC.37, 26-Mar-80 09:03:17, EDIT BY OSMAN
;Make sure first message gets displayed after MS deletes mail file.
;<V-SOURCES>DATE.MAC.36, 11-Mar-80 10:31:02, EDIT BY OSMAN
;Don't do all the MONRD's for hogs being excluded
;<OSMAN.SOURCES>DATE.MAC.3, 31-Jan-80 13:42:33, EDIT BY OSMAN
;Clear exclusion table on restart. Make JSBOMB say where from.
;<V-SOURCES>DATE.MAC.33, 17-Jan-80 10:51:38, EDIT BY OSMAN
;Add SHOW LOGIN-TIME
;<V-SOURCES>DATE.MAC.22, 19-Dec-79 10:27:56, EDIT BY OSMAN
;Add EXCLUDE/INCLUDE HOG
;<V-SOURCES>DATE.MAC.21, 27-Nov-79 09:32:24, EDIT BY OSMAN
;Speed up ERROR.SYS reading by making guess as to first page to read
;<V-SOURCES>DATE.MAC.19, 6-Nov-79 10:35:05, EDIT BY OSMAN
;Don't put the bells in the log file
;<V-SOURCES>DATE.MAC.16, 2-Nov-79 13:52:54, EDIT BY OSMAN
;PRINT ENTIRE FILESPEC WHEN AN UPDATE HAPPENS
;<V-SOURCES>DATE.MAC.10, 2-Nov-79 09:33:27, EDIT BY OSMAN
;ADD ENABLE/DISABLE LOGGING
;<V-SOURCES>DATE.MAC.6, 1-Nov-79 15:55:11, EDIT BY OSMAN
;Put in ENABLE UPDATE-FILE-CHECKING (FOR FILES)
;<V-SOURCES>DATE.MAC.4, 22-Oct-79 14:43:47, EDIT BY OSMAN
;DON'T CLOBBER "SHOW VALUE" DATA WHEN DOING GRUMP OR MAIL
;<GUNN.DEVELOPMENT>DATE.MAC.25, 3-Oct-79 11:45:33, Edit by GUNN
;[V5.0] Replaced IGNORE-BUGCHK command by EXCLUDE command
; which allows wildcarding of bug names.
; Added INCLUDE command to complement EXCLUDE.
; Added TEXT option to SHOW command to type out text string
; for a BUG.
; Changed code which read in BUGSTRINGS to not set invisible
; bit for BUGHLT's.
; Changed code which printed out BUGCHK's to also print out
; BUGINF's as they occur since user can now more easily
; control which BUG's get reported.
; Changed code for SHOW SETTINGS command to print out the
; ignored BUG's in ascending order.
; Increased size of BIGTAB so all bugs may be excluded
;Note: For future the code should be changed so only one table is
; used for both functions.
;<OSMAN.SOURCES>DATE.MAC.196, 19-Sep-79 09:18:18, EDIT BY OSMAN
;Tell people who accidentally hit CTRL/Y how to get out
;<OSMAN.SOURCES>DATE.MAC.195, 21-Aug-79 16:02:33, EDIT BY OSMAN
;forgot to call PION in path where fork IS a ^P exec!
;<OSMAN.SOURCES>DATE.MAC.194, 10-Aug-79 17:09:58, EDIT BY OSMAN
;Don't try to release fork handles of ^P execs
;<OSMAN.SOURCES>DATE.MAC.193, 10-Aug-79 13:18:45, EDIT BY OSMAN
;If can't make output fork, wait
;<OSMAN.SOURCES>DATE.MAC.184, 9-Aug-79 14:53:22, EDIT BY OSMAN
;Flush the output fork when done with it, to save forks
;<OSMAN.SOURCES>DATE.MAC.183, 8-Aug-79 14:09:57, EDIT BY OSMAN
;Don't print entire grump form sheet when several grumps come in at once
;Shorten hog message to fit on one line
;<OSMAN.SOURCES>DATE.MAC.182, 1-Aug-79 08:50:43, EDIT BY OSMAN
;DON'T MISS FIRST GRUMP IN FILE
;<OSMAN.SOURCES>DATE.MAC.178, 31-Jul-79 11:16:56, EDIT BY OSMAN
;ALLOW SETTING THE INTERRUPT CHARACTER
;<OSMAN.SOURCES>DATE.MAC.175, 24-Jul-79 09:21:43, EDIT BY OSMAN
;INVALID PROCESS HANDLE" BOMBOUT, WHICH OCCURED IF USER ^C'ED
;FROM DATE, DID "INFO PROG", AND THEN CONTINUED DATE AND DID ^D. (RFRKH
;WITH -1 RELEASED OUR FORK HANDLES!)
;<OSMAN.SOURCES>DATE.MAC.173, 20-Jul-79 11:10:29, EDIT BY OSMAN
;ADD ENABLE MAIL-PREVIEWING
;<OSMAN.SOURCES>DATE.MAC.172, 25-Jun-79 09:54:17, EDIT BY OSMAN
;USE SYSTEM: INSTEAD OF SYS: FOR BUGSTRINGS TO AVOID "Can't find Message for Bug"
;<OSMAN.SOURCES>DATE.MAC.170, 19-Jun-79 10:10:07, EDIT BY OSMAN
;FIX "ILLEGAL MEMORY READ" DURING GRUMP PROCESSING
;<OSMAN.SOURCES>DATE.MAC.168, 18-Jun-79 14:28:46, EDIT BY OSMAN
;FIX SIXASC SO WE DON'T SAY "CAN'T FIND MESSAGE FOR BUG" SO OFTEN
;<OSMAN.SOURCES>DATE.MAC.167, 23-May-79 10:53:58, EDIT BY OSMAN
;add DISABLE SPY-PROTECTION
;<OSMAN.SOURCES>DATE.MAC.163, 17-May-79 15:13:09, EDIT BY OSMAN
;add SHOW SETTINGS
;<OSMAN.SOURCES>DATE.MAC.161, 14-May-79 11:01:59, EDIT BY OSMAN
;only freeze exec while reading command
;<OSMAN.SOURCES>DATE.MAC.160, 4-May-79 13:19:38, EDIT BY OSMAN
;IF GET TO .POP BEFORE TTYFRK SET UP, QUIETLY TOLERATE.
;<OSMAN.SOURCES>DATE.MAC.159, 2-May-79 16:07:22, EDIT BY OSMAN
;HANDLE CASE WHERE OPERATOR INITIALIZES GRUMP FILE
;<OSMAN.SOURCES>DATE.MAC.158, 30-Apr-79 10:47:21, EDIT BY OSMAN
;fix PERR1 to not clobber error code
;<OSMAN.SOURCES>DATE.MAC.151, 13-Apr-79 16:13:22, EDIT BY OSMAN
;ENABLE ALL PANIC INTERRUPT CHANNELS
;<OSMAN.SOURCES>DATE.MAC.149, 13-Apr-79 15:15:30, EDIT BY OSMAN
;Fix ILLEGAL MEMORY READ problem with grump system
;<OSMAN.SOURCES>DATE.MAC.128, 11-Apr-79 14:15:18, EDIT BY OSMAN
;SPEED UP BUGCHK/BUGHLT STUFF BY NOT RUNNING SYSERR
;TAKE JOB RANGE ON "WHO" COMMAND
;ALLOW INTERRUPTING ONE COMMAND AND STARTING ANOTHER
;IMPLEMENT THE WHO'S-USING COMMAND
;When scanning page table for open file, check for PA1050
;<OSMAN.SOURCES>DATE.MAC.88, 30-Mar-79 15:15:57, EDIT BY OSMAN
;IF USER "POP"S AND WE'RE ALREADY SICK, THEN HALT!
;<OSMAN.SOURCES>DATE.MAC.86, 28-Mar-79 09:47:07, EDIT BY OSMAN
;SAVE COMND STATE TO ALLOW BUGINI OR CTRL/Y DURING DATE.CMD
;ON FATAL ERROR, PRINT MESSAGE BUT DON'T BOMB OUT GUY'S EXEC
;<OSMAN.SOURCES>DATE.MAC.77, 26-Mar-79 14:04:06, EDIT BY OSMAN
;SPEED UP STARTUP BY NOT CALLING BUGINI UNTIL NEEDED
;ADD STANDARD VERSION NUMBER STUFF
;<OSMAN.SOURCES>DATE.MAC.68, 23-Mar-79 10:37:19, EDIT BY OSMAN
;ENABLE HOG-CHECKING
;DEFAULT EVERYTHING TO OFF, SO USERS CAN SELECT WHICH FEATURES THEY WANT
;<OSMAN.SOURCES>DATE.MAC.62, 22-Mar-79 15:01:28, EDIT BY OSMAN
;FREEZE EXEC WHILE DOING COMMANDS
;<OSMAN.SOURCES>DATE.MAC.59, 22-Mar-79 14:32:10, EDIT BY OSMAN
;ALWAYS RUN EXEC UNDER DATE
;RUN EXEC AS LOWER FORK INSTEAD OF REQUIRING "CONTINUE STAY"
;<OSMAN.SOURCES>DATE.MAC.57, 21-Mar-79 10:43:44, EDIT BY OSMAN
;TRY TO FIX A GRUMP BUG BY REMOVING RANSET
;<OSMAN.SOURCES>DATE.MAC.56, 20-Mar-79 09:53:38, EDIT BY OSMAN
;FIX BUG REPORTER TO NOT SAY "?INVALID TIME FORMAT"
;<OSMAN.SOURCES>DATE.MAC.54, 13-Mar-79 16:38:17, EDIT BY OSMAN
;announce death due to PDLOV, and increase stack size
;<OSMAN.SOURCES>DATE.MAC.53, 13-Mar-79 13:29:52, EDIT BY OSMAN
;TRY TO SPEED UP BUG REPORTING BY USING /BRIEF
;<OSMAN.SOURCES>DATE.MAC.52, 12-Mar-79 14:22:43, EDIT BY OSMAN
;FIX IGNORE FEATURE
;<OSMAN.SOURCES>DATE.MAC.51, 8-Mar-79 14:17:05, EDIT BY OSMAN
;change ttylck to use DIR, since mere AOS can cause deadlock if higher interrupt also tries to get lock
;<OSMAN.SOURCES>DATE.MAC.50, 7-Mar-79 09:51:54, EDIT BY OSMAN
;use DIR instead of TTYLCK for TOTRUN
;<OSMAN.SOURCES>DATE.MAC.49, 5-Mar-79 10:13:28, EDIT BY OSMAN
;PREVENT SEEING PERCENTAGES GT 100. (LOCK TOTRUN WITH TTYLCK)
;<OSMAN.SOURCES>DATE.MAC.46, 27-Feb-79 14:08:54, EDIT BY OSMAN
;DO BUGCHKS WITH SPECIAL TIMER SO THEY DON'T TIE UP REST OF FUNCTIONS
;<OSMAN.SOURCES>DATE.MAC.44, 26-Feb-79 15:49:15, EDIT BY OSMAN
;FIX BUGCHK EXECUTE-NOT-DURING-INTERRUPT STUFF
;<OSMAN.SOURCES>DATE.MAC.43, 26-Feb-79 15:35:47, EDIT BY OSMAN
;FIX "IGNORE BUGCHK MUMBLE" COMMAND
;<OSMAN.SOURCES>DATE.MAC.42, 26-Feb-79 13:59:22, EDIT BY OSMAN
;SEARCH MONITOR SYMBOLS FASTER
;<OSMAN.SOURCES>DATE.MAC.38, 23-Feb-79 14:55:52, EDIT BY OSMAN
;SPEED UP SYMBOL TABLE INITIALIZATION
;<OSMAN.SOURCES>DATE.MAC.32, 22-Feb-79 16:10:42, EDIT BY OSMAN
;READ DATE.CMD DURING LOGIN
;<OSMAN.SOURCES>DATE.MAC.30, 21-Feb-79 09:39:45, EDIT BY OSMAN
;FIX BUGCHK STUFF WHICH BROKE
;Don't ever bitch about job 0 hogging system
;Implement checking for users that are running with special scheduler priority
;<OSMAN.SOURCES>DATE.MAC.11, 2-Feb-79 13:27:36, EDIT BY OSMAN
;set up LSTTIM before trying TIMER JSYS
;<OSMAN.SOURCES>DATE.MAC.10, 31-Jan-79 15:36:04, EDIT BY OSMAN
;<OSMAN.SOURCES>DATE.MAC.9, 31-Jan-79 14:48:51, EDIT BY OSMAN
;BE MORE SPECIFIC WHEN INTERRUPT IS OVERDUE
;<OSMAN.SOURCES>DATE.MAC.7, 31-Jan-79 10:23:34, EDIT BY OSMAN
;SPEED UP BUG REPORTING BY NOT KILLING THE SYSERR FORK
;<OSMAN.SOURCES>DATE.MAC.6, 30-Jan-79 10:54:17, EDIT BY OSMAN
;PRINT ALL BUGHLTS SINCE PREVIOUS LOGIN, RATHER THAN SINCE .CPY CREATION
;MAKE BUGCHK CODE NOT BE INTERRUPT LEVEL
;<OSMAN>DATE.MAC.89, 22-Jan-79 08:44:37, EDIT BY OSMAN
;CATCH FAILING GTFDB AT WRTDAT
;<OSMAN>DATE.MAC.88, 16-Jan-79 11:20:02, EDIT BY OSMAN
;FIX SIXBIT OUTPUT ROUTINE TO NOT STOP ON FIRST NULL (LEADING SPACES!)
;<OSMAN>DATE.MAC.87, 4-Jan-79 15:43:45, EDIT BY OSMAN
;REMOVE PP, FIX GETPTY
;<OSMAN>DATE.MAC.86, 4-Jan-79 15:08:25, EDIT BY OSMAN
;TEMPORARILY PUT IN PP TO FIND OUT WHERE D IS GETTING CLOBBERED
;<OSMAN>DATE.MAC.85, 3-Jan-79 15:45:06, EDIT BY OSMAN
;CORRECTLY RESTORE AC'S AFTER ERROR MESSAGE AT ILL
;<OSMAN>DATE.MAC.84, 8-Dec-78 15:38:20, EDIT BY OSMAN
;DON'T SEND CR AFTER ###
;<OSMAN>DATE.MAC.73, 7-Nov-78 15:10:03, EDIT BY OSMAN
;RECOVER IF NO RESOURCES FOR TIMER ENTRY
;<OSMAN>DATE.MAC.72, 7-Nov-78 10:58:42, EDIT BY OSMAN
;CHANGE INTERVAL TO 10 SECONDS, MAKE ^D SHOW IF INTERRUPT OVERDUE
;<OSMAN>DATE.MAC.70, 6-Nov-78 17:12:21, EDIT BY OSMAN
;USE SAVACS/RESACS INSTEAD OF SAVIAC
;<OSMAN>DATE.MAC.65, 6-Nov-78 16:22:06, EDIT BY OSMAN
;Fix GRUMP logic to not get upset if FB%PGC is wrong
;PMAP the entire BUGSTRINGS.TXT instead of having COMND do lots of BINs!
;<OSMAN>DATE.MAC.15, 3-Nov-78 13:46:14, EDIT BY OSMAN
;Use ERROR.SYS instead of monitor for BUGs. Now non-wheels can enjoy!
;<OSMAN>DATE.MAC.13, 2-Nov-78 10:54:29, EDIT BY OSMAN
;TEACH IT TO PRINT BUGHLT
;<OSMAN>DATE.MAC.10, 17-Oct-78 14:33:01, EDIT BY OSMAN
;ALLOW BUGCHK NAMES TO BE ENTERED IN LOWERCASE IN "IGNORE" COMMAND
;ALSO, MAKE "?" AND RECOGNITION WORK
;<OSMAN>DATE.MAC.4, 3-Oct-78 17:01:36, EDIT BY OSMAN
;MAKE BOTH FORKS BEFORE HALTING SO "FORK 2" POINTS AT CORRECT DUMMY FORK
;<OSMAN>DATE.MAC.188, 29-Sep-78 13:58:04, EDIT BY OSMAN
;FIX "ERROR AT 7062 INVALID PROCESS HANDLE"
;<OSMAN>DATE.MAC.187, 12-Sep-78 13:11:41, EDIT BY OSMAN
;make grumps get printed in correct case
;CHANGE DATE CHARACTER TO CTRL/D (CTRL/A - CTRL/B ARE NOW TV CASE CONTROL IN INSERTS)
;<OSMAN>DATE.MAC.184, 7-Sep-78 14:20:54, EDIT BY OSMAN
;ALLOW % AND . IN SYMBOL NAMES (YEAH, FINALLY!). ALSO, DON'T HAVE A TIZZY
;WHEN JOB GETS DETACHED AND REATTACHED.
;<OSMAN>DATE.MAC.183, 28-Aug-78 09:16:16, EDIT BY OSMAN
;FIX GRUMP FAILURE HANDLING
;<OSMAN>DATE.MAC.181, 24-Aug-78 15:37:04, EDIT BY OSMAN
;MAKE GRUMP JFN BE RESTRICTED
;<OSMAN>DATE.MAC.177, 23-Aug-78 11:32:14, EDIT BY OSMAN
;GET ^A WORKING BEFORE INITIALIZING EVERYTHING ELSE
;ONLY PRINT HOGS, INSTEAD OF N JOBS
;<OSMAN>DATE.MAC.172, 22-Aug-78 16:51:49, EDIT BY OSMAN
;PRINT PERCENTAGES
;PROVIDE FOR "[FOO]"IN BUGSTRINGS FILE
;<OSMAN>DATE.MAC.168, 27-Jul-78 09:49:06, EDIT BY OSMAN
;FIX BUGSTRING TYPEOUT
;<OSMAN>DATE.MAC.167, 25-Jul-78 10:20:36, EDIT BY OSMAN
;PUT IN WHEELF TO SHOW IF WHEEL OR NOT
;<OSMAN>DATE.MAC.156, 5-Jun-78 14:09:14, EDIT BY OSMAN
;ADD EXIT COMMAND
;<OSMAN>DATE.MAC.154, 18-May-78 10:22:58, EDIT BY OSMAN
;MAKE ^A SHOW FILES BEING WRITTEN WITH PMAP
;<OSMAN>DATE.MAC.148, 17-May-78 14:27:28, EDIT BY OSMAN
;SIMPLIFY CODE
;<OSMAN>DATE.MAC.147, 16-May-78 16:22:04, EDIT BY OSMAN
;FIX CASE WHERE USER NAME CROSSES PAGE BOUNDARY
;<OSMAN>DATE.MAC.143, 16-May-78 15:25:55, EDIT BY OSMAN
;GUARD AGAINST TTY BUFFER OVERFLOW
;<OSMAN>DATE.MAC.142, 26-Apr-78 15:08:47, EDIT BY OSMAN
;PRINT "NOT LOGGED IN" FOR UNLOGGED IN JOBS ON ^A (INSTEAD OF ERROR!)
;<OSMAN>DATE.MAC.141, 21-Apr-78 14:35:12, EDIT BY OSMAN
;<OSMAN>DATE.MAC.140, 21-Apr-78 14:28:46, EDIT BY OSMAN
;MAKE OUTPUT COME SOONER AFTER EVENT
;<OSMAN>DATE.MAC.139, 21-Apr-78 13:12:30, EDIT BY OSMAN
;<OSMAN>DATE.MAC.138, 21-Apr-78 13:11:08, EDIT BY OSMAN
;PRINT PROGRAM NAME FOR BUGCHKS
;<OSMAN>DATE.MAC.135, 10-Apr-78 15:50:23, EDIT BY OSMAN
;SHOW WHO'S SLOWING DOWN THE SYSTEM
;<OSMAN>DATE.MAC.126, 28-Mar-78 15:37:30, EDIT BY OSMAN
;ADD IGNORE COMMAND
;<OSMAN>TILE.MAC.63, 22-Mar-78 14:24:44, Edit by OSMAN
;USE STANDARD COMND JSYS ERROR ROUTINE
;<OSMAN>DATE.MAC.118, 20-Mar-78 11:41:45, Edit by OSMAN
;PUT IN INFORMATIVE ERROR MESSAGE WHEN DYING
;<OSMAN>DATE.MAC.115, 13-Mar-78 16:50:56, Edit by OSMAN
;DON'T USE TBADD. IT TAKES TOO LONG.
;<OSMAN>DATE.MAC.88, 3-Mar-78 15:11:05, Edit by OSMAN
;ADD VALUE COMMAND
;ADD SYMBOL COMMAND
;ADD ^Y FEATURE TO TYPE IN COMMANDS.
;<OSMAN>DATE.MAC.86, 3-Mar-78 14:34:09, Edit by OSMAN
;<OSMAN>DATE.MAC.74, 28-Feb-78 11:41:00, Edit by OSMAN
;<OSMAN>DATE.MAC.73, 21-Feb-78 15:16:40, Edit by OSMAN
;PREVENT EXTRA NULLS FROM BEING PRINTED AT END OF GRUMP
;<OSMAN>DATE.MAC.72, 21-Feb-78 14:41:05, Edit by OSMAN
;PREVENT BOMBOUT IF OPERATOR DELETES GRUMP.LOG
;<OSMAN>DATE.MAC.71, 3-Feb-78 14:00:32, Edit by OSMAN
;PMAP DATA FROM GRUMP FILE INSTEAD OF BKJFN/BIN
;<OSMAN>DATE.MAC.56, 3-Jan-78 15:53:42, EDIT BY OSMAN
;TRY TO RECOVER IF GRUMP.LOG GETS RECREATED BY OPERATOR
;<OSMAN>DATE.MAC.55, 12-Dec-77 14:46:59, EDIT BY OSMAN
;END USERNAME BUFFER WITH NULL IN GRUMP LOGIC
;<OSMAN>DATE.MAC.54, 29-Nov-77 09:36:26, EDIT BY OSMAN
;<OSMAN>DATE.MAC.3, 10-Nov-77 22:12:59, EDIT BY OSMAN
;DON'T TRY TO LOCK TTY TWICE! (LIKE BY USING XTMSG AFTER TTYLCK)
;<OSMAN>DATE.MAC.52, 10-Nov-77 13:42:24, EDIT BY OSMAN
;UPDATED SOURCE POINTER AFTER SOUT IS LDB POINTER TO NULL!!
;<OSMAN>DATE.MAC.51, 10-Nov-77 13:09:04, EDIT BY OSMAN
;DON'T LOSE INFORMATION DUE TO AUTO-^S
;<OSMAN>DATE.MAC.47, 27-Sep-77 15:18:15, EDIT BY OSMAN
;FIX IT SO THAT IF USER ISN'T A WHEEL, NON-WHEEL FEATURES STILL WORK
;<OSMAN>DATE.MAC.45, 23-Sep-77 15:00:52, EDIT BY OSMAN
;PUT IN JFN UPDATE FEATURE
;<OSMAN>DATE.MAC.42, 20-Sep-77 15:21:24, EDIT BY OSMAN
;MAKE PROGRAM NOT GET CONFUSED IF WE DETACH AND REATTACH TO DIFFERENT TERMINAL
;<OSMAN>DATE.MAC.41, 12-Sep-77 17:23:41, EDIT BY OSMAN
;PREVENT INFINITE LOOP WHEN SEARCHING FOR BEGINNING OF GRUMP
;<OSMAN>DATE.MAC.40, 8-Sep-77 12:17:29, EDIT BY OSMAN
;MAKE DATE PROGRAM PRINT OUT GRUMPS AS THEY GET SUBMITTED
;<OSMAN>DATE.MAC.32, 3-Sep-77 12:46:52, EDIT BY OSMAN
;REMOVE "CLOSF" AT TERMINATION OF "POP"
;<OSMAN>DATE.MAC.31, 26-Aug-77 16:39:26, EDIT BY OSMAN
;PUT IN AUTO-PUSH
;<OSMAN>DATE.MAC.27, 24-Aug-77 16:06:48, EDIT BY OSMAN
;MAKE SURE TIMINT DOESN'T CLOBBER AC'S
;<OSMAN>DATE.MAC.23, 24-Aug-77 14:50:35, EDIT BY OSMAN
;MAKE THIS PROGRAM ANNOUNCE BUGCHKS!
;<OSMAN>DATE.MAC.13, 19-Aug-77 16:37:36, EDIT BY OSMAN
;MAKE THIS THING SHOW WHEN SOMEONE SPYS OR UNSPIES ON US
;<OSMAN>DATE.MAC.9, 15-Aug-77 17:05:25, EDIT BY OSMAN
;ONLY ENABLE CHANNEL FOR INTERRUPT CHARACTER.
;WAS ENABLING ALL, BUT MONITOR "BUG" CAUSES FORK TERMINATION
;INTERRUPT UNEXPECTEDLY
;<OSMAN>DATE.MAC.8, 15-Aug-77 16:56:46, EDIT BY OSMAN
;<OSMAN>DATE.MAC.7, 15-Aug-77 16:55:28, EDIT BY OSMAN
;<OSMAN>DATE.MAC.6, 15-Aug-77 16:51:34, EDIT BY OSMAN
;MAKE AN INFERIOR FORK, SO WE CAN RUN IN BACKGROUND
TITLE DATE
EXTERNAL .JBSYM,.RLEND
WH==0
VR==5 ;MAJOR VERSION #
RV==0 ;REVISION #
ED==26 ;EDIT NUMBER
%%RH==ED ;RHS FOR LINK
%%LH==<WH>B20+<VR>B29+RV ;LHS
SEARCH MONSYM,MACSYM,CMD,SERCOD
.REQUIRE SYS:MONSYM,SYS:CMD,SYS:MACREL
SALL ;CAUSE NON-UGLY LISTING PRINTOUT
A=1
B=2
C=3
D=4
Q1=5
Q2=6
Q3=7
P=17
JMAGIC==FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)!FLD(.JSAOF,JS%GEN)!JS%PAF ;BITS TO PRINT ALL FIELDS
DEFINE TYPE (MESSAGE) ;(IN ONE INSTRUCTION AND WITHOUT CLOBBERING ANYTHING)
< CALL [
PUSH P,A
HRROI A,[ASCIZ /Message/]
PSOUT
POP P,A
RET
]
>
SPLESC==.CHCNN ;ESCAPE CODE FOR OUTPUT
CTRLY=="Y"-100 ;INPUT A COMMAND ON CTRL/Y
PDLLEN==5000 ;large stack, because all of CMDSTG must fit on it!
NUFKS==30 ;NUMBER OF FORKS ALLOWED PER JOB
HGHFPN==37777 ;HIGHEST FORK PAGE NUMBER
FILWDS==200 ;NUMBER OF WORDS FOR REAL LONG FILESPEC
;DEFINITIONS FOR MONRD% JSYS
OPDEF MONRD% [JSYS 717]
.RDTST==0 ;FUNCTION CODE TO TEST FOR EXISTENCE
.RDJSB==2 ;READ JSB DATA
.RDPSB==3 ;READ PSB DATA
;MACRO TO DO SPECIAL TERMINAL OUTPUT (WITHOUT BLOCKING ON AUTO-^S)
DEFINE XTMSG(WHAT)
< HRROI A,[ASCIZ WHAT]
CALL STRNG
>
CMDBEG==. ;DELIMIT COMND STORAGE
CMDSTG ;PUT IN COMND STORAGE
CMDLEN==.-CMDBEG ;SINCE INTERRUPT ROUTINES SAVE CMDSTG ON THE STACK
INITF: 0 ;-1 WHEN DATABASES INITIALIZED
INCMDF: 0 ;-1 WHEN IN A COMMAND
SICKF: 0 ;-1 IF WE GET FATAL ERROR
BUSYF: 0 ;0 OR BYE POINTER TO EVENT BEING PROCESSED
SYMF: 0 ;-1 WHEN SYMBOL TABLE INITIALIZED
ICHAR: 0 ;INTERRUPT CHARACTER
BUGIF: 0 ;-1 WHEN BUGCHK MESSAGE TABLE INITIALIZED
LSTTIM: 0 ;SYSTEM UPTIME IN MILLISECONDS AT TIME OF LAST INTERRUPT
LDAV: 0 ;LOAD AVERAGE
TOTRUN: 0 ;TOTAL RUNTIME USED BY JOBS IN LAST INTERVAL
GOBFLG: 0 ;-1 WHEN SPECIAL MONITOR SYMBOLS READ
POVLEN==50 ;STACK FOR PDLOV HANDLER
POVSTK: BLOCK POVLEN
PDL: BLOCK PDLLEN
EFNLEN==50 ;MOST NUMBER OF PUSH'S WE CAN HANDLE
EFNTAB: BLOCK EFNLEN ;EFNTAB+N HOLDS JFN OF FORK 40000N
BNAME: 0 ;NAME OF BUGCHK IN SIXBIT
FORKH: 0 ;FORK HANDLE
MAXBGN==1500 ;NUMBER OF DIFFERENT BUGCHKS THAT CAN BE IGNORED
BIGTAB: BLOCK MAXBGN+1 ;BUGCHKS BEING IGNORED
TIMEX==^D10000 ;INTERRUPT EVERY THIS MANY SECONDS
IPC=="" ;CHARACTER FOR INSTANT PUSH
STC=="" ;STATISTICS CHARACTER
HANGT==^D50 ;MILLISECONDS TO WASTE WHILE WAITING FOR CONDITION
TTYPNT: 0 ;CURRENT OUTPUT POINTER
NBCHARS==300 ;NUMBER OF CHARACTERS TO BUFFER
BUFFER: BLOCK NBCHARS/5+1 ;ROOM FOR THE CHARACTERS
BROOM: 0 ;ROOM LEFT IN BUFFER BEFORE DUMP NEEDED
HEIGHT: 0 ;NUMBER OF PAPER ROWS TO USE
WIDTH: 0 ;NUMBER OF PAPER COLUMNS TO USE
SCRNF: 0 ;-1 IF ON SCREEN
TTYJFN: 0 ;BINARY CHANNEL FOR SCREENS
BPTR: 0 ;OUTPUT BUFFER POINTER
X: 0 ;X COORDINATE WE'RE GOING TO
Y: 0 ;LIKEWISE
SX: 0 ;SCREEN COLUMN
SY: 0 ;SCREEN LINE
CRR: 0 ;NUMBER OF CHARACTERS FOR CR THEN SPACE OVER
HOM: 0 ;NUMBER OF CHARACTERS FOR HOMEUP THEN SPACE OVER
OX: 0 ;OLD SCREEN COLUMN
OY: 0 ;OLD SCREEN LINE
OLDX: 0 ;LAST X WE MOVED TO
OLDY: 0 ;LAST Y WE MOVED TO
TRMTYP: 0 ;TERMINAL TYPE
TTBSIZ==3000
JMAXLN==200 ;MAXIMUM NUMBER OF JOBS WE CAN HANDLE
HOGMAX==30
EXHGMX==30 ;MAXIMUM SPECIFIC HOGS WE CAN EXCLUDE
EXHTAB: 0 ;TABLE OF HOGS BEING EXCLUDED
BLOCK EXHGMX ;ADDRESS OF STRING,,0
HOGTAB: BLOCK HOGMAX ;LIST OF JOB NUMBERS OF JOBS EATING THE SYSTEM
HMX==10 ;MAXIMUM HOGS WE CAN FOLLOW
HOGLST: BLOCK HMX ;LIST OF JOBS HOGGING THE SYSTEM
PERCNT==177B17 ;FIELD THAT CONTAINS GUARANTEED PERCENTAGE
LQP1==77B35 ;FIELD THAT CONTAINS WORST QUEUE PLUS 1
JRINTB: BLOCK JMAXLN ;AMOUNT OF RUNTIME IN LAST SEGMENT
OLDRUN: BLOCK JMAXLN ;TOTAL RUNTIME AT LAST SNAPSHOT
JTLEN: 0 ;ACTUAL LENGTH OF JOB TABLES
;*** KEEP NEXT TWO ENTRIES CONSECUTIVE!
TTYBUF: BLOCK TTBSIZ ;TTY OUTPUT BUFFER
DEAD: BLOCK 50 ;DEAD SPACE FOR TTY BUFFER TO OVERFLOW INTO
;*** KEEP TTYBUF AND DEAD CONSECUTIVE
TTYFLG: 0 ;-1 WHEN TTY DATABASE FREE
OUTFLG: 0 ;OUTPUT READY FLAG
MIDPNT: 0 ;RESULTANT POINTER OF PSOUT
TTYPLN==200 ;LENGTH OF OUTPUT SERVER STACK
TTYPDL: BLOCK TTYPLN ;STACK FOR OUTPUT SERVER
TTYFRK: 0 ;HANDLE OF TTY FORK
GRERRF: 0 ;SET IF GRUMP ERROR, OR MAIL ERROR
HOGERF: 0 ;-1 IF ERRORS REPORTING HOGGERS
SPYERF: 0 ;-1 IF ERRORS CHECKING SPYING
HGHJFN==777 ;HIGHEST LEGAL JFN
GRUSER: BLOCK 30 ;HOLDS USER NAME WHO SUBMITTED LAST GRUMP
GRPTR: 0 ;POINTER TO GRUMP BUFFER
GRPGN: 0 ;GRUMP FILE PAGE NUMBER CURRENTLY MAPPED
BACKF: 0 ;-1 IF READING BACKWARDS
GEOFDA: 0 ;0 OR GRUMP END OF FILE DISPATCH ADDRESS
GPP: 0 ;STACK POINTER SAVED DURING GRUMP PROCESSING
LPIG: 0 ;LAST PAGE IN GRUMP FILE
EOG: 0 ;BYTE POINTER TO END OF GRUMP
GRJFN: 0 ;JFN OF GRUMP FILE
GRSIZE: 0 ;NUMBER OF BYTES IN GRUMP FILE
OGRSIZ: 0 ;OLD NUMBER OF BYTES
GREOL: 0 ;POSITION IN GRUMP FILE OF LAST EOL
LOGJFN: 0 ;JFN OF LOG FILE
;UPDATE-FILE STUFF
ULEN==20 ;NUMBER OF FILESPECS THAT CAN BE WATCHED
UDIR: BLOCK ULEN ;0 OR DIRECTORY TO BE WATCHED
USIZE: BLOCK ULEN ;SIZE OF DIRECTORY USED FOR COMPARISON
UTIME: BLOCK ULEN ;MOST RECENT FILE WRITE-DATE AT LAST CHECK
UFPTR: BLOCK ULEN ;POINTER TO FILESPEC STRING
;MAIL PREVIEW DATA
SMJFN: 0 ;SYSTEM MAIL FILE
MALJFN: 0 ;MAIL FILE JFN
MALSIZ: 0 ;LATEST KNOWN SIZE FOR MAIL FILE
MALSPC: BLOCK 30 ;GETS NAME OF MAIL FILE
SMSIZ: 0 ;SYSTEM MAIL FILE SIZE
LOGNO: 0 ;HOLDS LOGIN DIRECTORY NUMBER
EXCNAM: BLOCK 30 ;[NIC] HOLD EXEC NAME
XFORK: 0 ;EXEC FORK
JFNZZZ==50 ;MAXIMUM NUMBER OF JFNS WE CAN HANDLE
JFNPAG: BLOCK JFNZZZ ;LOWEST,,HIGHEST MAPPED PAGE NUMBER
JFNLST: BLOCK JFNZZZ ;WHICH JFNS ARE IN TABLE
JFNNN: 0 ;NUMBER OF JFNS IN JFNLST
;*** KEEP LEVxPC CELLS CONSECUTIVE AND IN ORDER
LEV1PC: 0
LEV2PC: 0
LEV3PC: 0
;MACRO FOR PEEKING AT MONITOR CELL
STATF: 0 ;STATISTICS BITS (ONE BIT PER ENABLED FEATURE)
IOF==1B0 ;BIT FOR FILE PROGRESS
SHAREF==1B1 ;BIT FOR USAGE REPORTING
DATEF==1B2 ;BIT FOR LOAD LINE
SPYF: 0 ;-1 IF CHECKING FOR SPYERS
MAILF: 0 ;-1 IF MAIL BEING PREVIEWED
GRUMPF: 0 ;-1 IF GRUMPS BEING DISPLAYED
LOGGF: 0 ;-1 IF LOGGING
HOGF: 0 ;-1 IF CHECKING FOR REAL HOGS
BUGCHF: 0 ;-1 TO WATCH FOR BUGCHKS
OLDSPY: 0 ;LAST LINK WORD
SERDAT: 0 ;LAST TIMESTAMP OF ERROR.SYS FILE BEING WRITTEN
LSTBUG: 0 ;TIMESTAMP OF LAST BUG PRINTED
SERJFN: 0 ;JFN ON SYSTEM ERROR FILE
HLTJFN: 0 ;ANOTHER JFN ON SAME FILE!! (SO REPBUG IS QUASI-REENTERABLE)
OGPAG: 0 ;OLD GOOD PAGE (FIRST TO TRY)
SYMEND: 0 ;NEXT FREE LOCATION FOR STORING ASCII OF SYMBOL VALUE
KEYBLK: FLDBK. .CMKEY,,SYMLST,,,[BRMSK. KEYB0.,KEYB1.,KEYB2.,KEYB3.,<%.$>,<->] ;GETS MODIFIED FOR ACTUAL TABLE
SYMTAD=KEYBLK+.CMDAT ;HOLDS TABLE STARTING ADDRESS
FREE==240000 ;FREE SPACE BEGINS HERE
DICT: 0 ;FREE SPACE HEADER WORD
FRESIZ==40000 ;FREE SPACE ENDS AT BUGBUF
STRSIZ==400 ;WORDS FOR STRING SCRATCH STORAGE
CSBUFP: 0 ;POINTER TO STRING SCRATCH
BUGBUF==300000 ;BUFFER FOR READING BUG FILE INTO
BUGBPN==BUGBUF_-9 ;PAGE NUMBER OF BUFFER
BUGBSZ==<BUGTAB-BUGBUF>_-9 ;NUMBER OF PAGES WE HAVE ROOM FOR READING BUG FILE INTO
BUGTAB==400000 ;TABLE OF BUGCHKS
BUGSTR==500000 ;STRINGS OF BUGCHK NAMES START HERE
BUGMAX==BUGSTR-BUGTAB-1 ;MAXIMUM ENTRIES TABLE MAY HOLD
HLTPAG==600000 ;ERROR.SYS BUFFER FOR BUGHLTS
HLTPNN==HLTPAG_-9 ;PAGE NUMBER FOR BUGHLT BUFFER
SERPAG==601000 ;ADDRESS INTO WHICH ERROR.SYS PAGE IS MAPPED
SERPNN==SERPAG_-9 ;PAGE NUMBER
GRBPAG==SERPAG+1000 ;GRUMP PAGE
GRBPN==GRBPAG_-9 ;PAGE NUMBER
SYMLST=GRBPAG+1000 ;ROOM FOR SYMBOL TABLE
;*** NOTE: SYMBOL TEXT FOLLOW SYMBOL TABLE!
TTLINK: 0 ;VALUE OF MONITOR SYMBOL
TTACTL: 0 ;VALUE OF MONITOR SYMBOL
MAXJFN: 0 ;MAXIMUM JFN IN USE FOR JOB
MLJFN: 0 ;SIZE OF JFN BLOCK
FILNEN: 0 ;NAME,,EXT (POINTER)
FILVER: 0 ;FORK,,VERSION
FILDNM: 0 ;DIR,, (POINTER)
FILDDN: 0 ;DEV,,DIR #
FILSTS: 0 ;FILE STATUS
JOBBIT: 0 ;SCHEDULER CONTROL WORD FOR PROCESS
JOBSKD: 0 ;JOB'S SCHEDULER CONTROL WORD
SYSFK: 0 ;FORK TABLE WITHIN JOB
JSVAR: 0 ;BEGINNING OF JSB VARIABLES
PSVAR: 0 ;BEGINNING OS PSB VARIABLES
DEFINE INTX (CHANNEL,LEVEL,ADDRESS)
< %%X==. ;;REMEMBER WHERE WE ARE
RELOC CHNTAB+CHANNEL ;;GET TO APPROPRIATE PART OF TABLE
XWD LEVEL,ADDRES ;;TELL MONITOR PRIORITY AND WHERE TO GO
%%CH==%%CH!1B<CHANNEL> ;;REMEMBER TO ENABLE THIS CHANNEL
RELOC %%X ;;GET BACK TO WHERE WE WERE
>
ILLLEV==1 ;LEVEL OF ILL INST INT (MUST BE HIGHER PRIORITY THAN ALL ELSE!)
TIMCHN==1 ;CHANNEL FOR TIMER INTERRUPTS
TIMLEV==3 ;LEVEL FOR TIMER INTERRUPTS
;NOTE: TIMER INTERRUPTS MUST BE LESS PRIORITY
;THAN FORK TERMINATION, SINCE TTYULK STARTS
;TTYFRK WHICH WHEN HALTS WANTS TO BE KNOWN
CMDCHN==3 ;COMMAND EXECUTION CHANNEL
CMDLEV==3 ;COMMAND LEVEL
CTYCHN==5 ;CHANNEL FOR COMMAND REQUEST (CTRL/Y)
CTYLEV==2 ;LEVEL FOR COMMAND REQUEST (BUT NOT COMMAND EXECUTION)
%%CH==0 ;INTERESTING CHANNELS
CHNTAB: BLOCK 6*6 ;LEAVE ROOM FOR ALL CHANNELS
INTX 0,2,DATE ;USER WANTS DATE, TIME, LOAD AVERAGE
INTX .ICDAE,ILLLEV,ICDAE ;DATA ERROR
INTX .ICQTA,ILLLEV,ICQTA ;QUOTA EXCEEDED
INTX .ICIRD,ILLLEV,ICIRD ;ILLEGAL MEMORY READ
INTX .ICIWR,ILLLEV,ICIWR ;ILLEGAL MEMORY WRITE
INTX .ICMSE,ILLLEV,ICMSE ;SYSTEM RESOURCES EXHAUSTED
INTX TIMCHN,TIMLEV,TIMINT ;TIMER INTERRUPTS (DON'T MOVE UNLESS TIMCHN REDEFINED!)
;LOWER CHANNEL SO IN CASE WE HAVE TO WAIT FOR TIMER
;TO SUCCEED, EVERYTHING ELSE WILL STILL WORK
INTX 2,2,.PUSH ;USER WANTS TO DO AUTO-PUSH
INTX CMDCHN,CMDLEV,COMAND ;USER WANTS TO TYPE A COMMAND
INTX CTYCHN,CTYLEV,.CTRLY ;USER WANTS TO TYPE A COMMAND
INTX .ICPOV,1,PDLOV ;STACK OVERFLOW
INTX .ICILI,ILLLEV,ILL ;ILLEGAL INSTRUCTION EXECUTED
INTX .ICIFT,2,.POP ;ONE OF OUR INFERIORS HALTED
CHNS==%%CH ;REMEMBER WHAT CHANNELS TO ACTIVATE
LEVTAB: LEV1PC
LEV2PC
LEV3PC
BEG: MOVE P,[IOWD PDLLEN,PDL]
RESET ;DO AS LITTLE AS POSSIBLE BEFORE STARTING EXEC
SETZM SICKF ;NOT SICK YET
CALL FREINI ;INITIALIZE FREE SPACE
SETZM INCMDF ;NOT IN COMMAND (MUST BE DONE BEFORE AIC)
SETZM EFNTAB ;CLEAR FORK TABLE
MOVE A,[EFNTAB,,EFNTAB+1] ;MUST DO THIS BEFORE ENABLING FOR FORK TERMINATION INTERRUPT
BLT A,EFNTAB+EFNLEN-1 ;EFNTAB MUST BE ENABLED BEFORE .ICIFT ACTIVATED!!
SETZM UDIR ;NO DIRECTORIES BEING CHECKED YET
MOVE A,[UDIR,,UDIR+1]
BLT A,UDIR+ULEN-1
CALL TTYIN ;INIT TTY FORK
CALL TTYINI ;INITIALIZE TERMINAL STUFF
MOVEI A,400000
MOVE B,[LEVTAB,,CHNTAB]
SIR
EIR
MOVX B,CHNS ;ACTIVATE INTERESTING CHANNELS
AIC ;DO EARLY SO "POP" GETS DIAGNOSED
CALL EXEINI ;GET EXEC SO USER CAN WORK
JRST [ TYPE <?DATE: Couldn't start an exec - >
CALL PERR ;GIVE AN EXCUSE
HALTF
JRST BEG] ;IF CONTINUE, RETRY
MOVEM A,XFORK ;REMEMBER HANDLE OF EXEC
MOVEI B,0 ;STANDARD STARTUP
SFRKV ;START IT
SETOM OLDSPY ;SO IF SPYERS WHEN WE START, WE'LL KNOW
SETZM INITF ;SAY NOT INITIALIZED YET
SETZM GOBFLG ;HAVEN'T READ SPECIAL MONITOR SYMBOLS YET
MOVEI A,400000
IFE STANSW,<
SETOB B,C ;WE WANT ALL PRIVS
>;IFE STANSW
IFN STANSW,<
RPCAP ;GET OUR PRIVS
IOR C,B ;WE WANT ALL PRIVS WE CAN GET
>;IFN STANSW
EPCAP
MOVE A,[-1,,.JOBRT]
GETAB ;SEE HOW MANY JOBS CAN EXIST
JSERR
CAMGE A,[-JMAXLN] ;MAKE SURE WE HAVE ROOM FOR THEM ALL
MOVNI A,JMAXLN ;NO, SO ONLY USE THIS MUCH
MOVNM A,JTLEN ;REMEMBER
SETOM HOGLST ;NO HOGS YET
MOVE A,[HOGLST,,HOGLST+1]
BLT A,HOGLST+JMAXLN-1
CALL RUPDAT ;INITIALIZE RUNTIME TABLES (NOW, SO ^D WORKS)
SETZM BUSYF ;DO AFTER INITIAL RUPDAT, SINCE RUPDAT SETS IT
MOVEI A,EXHGMX ;SAY NO EXCLUSIONS YET BUT EXHGMX MAX ALLOWED
MOVEM A,EXHTAB
SETZM GRERRF ;NOTE THAT WE MAY STILL BE ABLE TO LOG GRUMPS
SETZM SPYERF ;NO SPY ERRORS YET
SETZM HOGERF ;NO ERRORS CHECKING FOR HOGGERS YET
SETZM GRJFN ;NO GRUMP JFN YET
SETZM MALJFN ;NO MAIL JFN YET
SETZM SMJFN ;NO SYSTEM MAIL JFN YET
HRLOI A,377777 ;SET SIZES LARGE, SO NO DISPLAY HAPPENS...
MOVEM A,GRSIZE ;FIRST TIME, BUT WE WANT DISPLAY...
MOVEM A,SMSIZ ;IF FILE BECOMES EXISTENT
MOVEM A,MALSIZ
SETZM SERJFN ;NO SYSTEM ERROR JFN YET
SETZM CMDJFN ;NO DATE.CMD JFN YET
SETZM GRUMPF ;INITIALLY DON'T TYPE GRUMPS
SETZM LOGGF ;NOT LOGGING YET
SETZM MAILF ;NOT PREVIEWING MAIL YET
SETZM BUGCHF ;INITIALLY DON'T REPORT BUGCHKS
SETZM STATF ;NO INSTANT STATISTICS ENABLED YET
CALL DTIMER ;GET TIMER INTERRUPTS HAPPENING
MOVEI A,MAXBGN
MOVEM A,BIGTAB ;INITIALLY NO BUGCHKS BEING IGNORED
MOVEI A,CTRLY
CALL SETIC ;SET UP INTERRUPT CHARACTER AS CTRL/Y
CALL NEWCMD ;NOW THAT DATABASES ARE INITIALIZED
SETOM INITF ;MARK THAT INITIALIZATION IS OVER
WAIT ;WAIT FOR SOMETHING TO HAPPEN
;ROUTINE TO GET WRITE DATE AND TIME OF FILE.
;ACCEPTS: A/ POINTER TO FILENAME OR 0,,JFN
;RETURNS: +1: ERROR
; A/ REASON CODE
; +2: SUCCESS
; A/ JFN
; B/ INTERNAL DATE AND TIME OF LAST WRITE
WRTDAT: MOVEI B,.FBWRT ;WHAT GTFDB TO DO
CALLRET DOFDB ;DO IT AND RETURN
DOFDB: STKVAR <WHAT>
HRLI B,1 ;SAY WE WANT ONE WORD
MOVEM B,WHAT
MOVE B,A ;STRING POINTER IN B
TLNN B,-1 ;MAKE SURE IT IS A POINTER
JRST WRT1 ;NO, IT'S A JFN, SKIP THE GTJFN
MOVX A,GJ%ACC!GJ%OLD!GJ%SHT ;RESTRICTED (SO OTHER FORKS DON'T SCREW US UP WITH CLOSF), OLD FILE, SHORT FORM GTJFN
GTJFN ;GET HANDLE ON LAST FILE
ERJMP R ;DO NOTHING IF NO FILE
WRT1: MOVEI C,B ;WHERE TO WRITE DATA
MOVE B,[1,,.FBCTL] ;FIRST SEE IF FILE IS DELETED
GTFDB
ERJMP R ;FAILURE RETURN IF CAN'T EVEN FIND OUT
TXNE B,FB%DEL ;HAS FILE BEEN DELETED?
RET ;YES, HANDLE CASE OF MS DELETING EMPTY MAIL FILE
MOVE B,WHAT ;SAY WHAT INFO CALLER REALLY WANTS
GTFDB ;GET THE INFO
ERJMP R ;WILL FAIL IF OPERATOR EXPUNGES FILE!
RETSKP ;SAY SUCCESS
;ROUTINE TO GET SIZE IN BYTES OF FILE.
;ACCEPTS: A/ POINTER TO FILENAME OR 0,,JFN
;RETURNS: +1: ERROR
; A/ REASON CODE
; +2: SUCCESS
; A/ JFN
; B/ NUMBER OF BYTES
GETFSZ: MOVEI B,.FBSIZ ;SAY WHAT TO GET
CALLRET DOFDB ;GET IT
;ROUTINE TO PRINT INFORMATION ABOUT LAST CRASH. THIS ROUTINE TRIES TO ONLY
;GIVE THE INFO IF THIS IS YOUR FIRST LOGIN SINCE THE CRASH.
PRTHLT: STKVAR <PRVLOG,CPYDAT>
HRROI A,-1 ;OURSELF
HRROI B,PRVLOG ;ONE WORD, READ INTO D
MOVEI C,.JILLN ;GET TIME OF PREVIOUS LOGIN
GETJI
JSERR ;SHOULDN'T FAIL
HRROI A,[ASCIZ /SYSTEM:DUMP.EXE/]
CALL WRTDAT ;GET WRITE DATE OF FILE
RET ;COULDN'T SO MUST NOT BE ONE
MOVEM B,CPYDAT
RLJFN ;NO MORE NEED FOR DUMP FILE
JSERR ;SHOULDN'T FAIL
MOVE D,PRVLOG
CAML D,CPYDAT ;HAS A DUMP BEEN MADE MORE RECENTLY THAN LOGIN?
RET ;NO, SO NO CRASH TO REPORT
CALL GETSYS ;GET JFN ON ERROR.SYS
RET ;NO ERROR.SYS
MOVEM A,HLTJFN ;REMEMBER JFN
MOVEI A,1 ;SAY WE WANT HALTS REPORTED
MOVE B,PRVLOG ;ANY REPORTED SINCE PREVIOUS LOGIN
CALLRET REPBUG ;REPORT THE BUGHLTS
;ROUTINE TO REPORT BUGS.
;ACCEPTS: A/ 0 FOR CHKS, 1 FOR HLTS
; B/ STARTING LOGTIME (INTERNAL FORMAT) FOR SYSERR
;RETURNS: +1 ALWAYS A/ LOGTIME OF LAST ENTRY REPORTED or 0 if none
SERHLN==10 ;MAXIMUM HEADER SIZE WE CAN READ
SERBLN==300 ;MAXIMUM ENTRY SIZE WE CAN READ
;OFFSETS IN HEADER WORD
HDRCOD==0 ;HEADER WORD
SER%ET==777B8 ;ENTRY TYPE
SER%BG==102 ;BUGCHK
SER%ER==377 ;FILE ABORTED DUE TO ERROR
SER%EF==777 ;NORMAL END OF FILE MARKER (BUT I'VE NEVER SEEN ONE!)
SER%HL==7B26 ;HEADER LENGTH FIELD
SER%EL==777B35 ;ENTRY LENGTH FIELD
HDRDAT==1 ;TIME ENTRY WAS LOGGED
REPBUG: TRVAR <WCHJFN,MIDP,SERWCH,<SERHDR,SERHLN>,<SERBLK,SERBLN>,DATLR1,<BUGFVR,2>,HLTFLG,<BUGNAM,2>,<BUGTIM,4>,<BUGPRG,2>,<BUGUSR,20>,BUGDAT,SERPN,SERFST,SERLST,SERHEL,SERLEN,SERWP,BIGP,SMLP,ENDP,SERPN0,SERPG0>
MOVEM A,HLTFLG ;REMEMBER WHICH WE'RE LOOKING FOR
MOVEM B,BUGDAT ;REMEMBER WHAT DATE TO USE
MOVEI A,SERPNN ;FIRST ASSUME BUGCHKS
MOVEI B,SERPAG
MOVEI C,SERJFN
SKIPE HLTFLG
JRST [ MOVEI A,HLTPNN
MOVEI B,HLTPAG ;DIFFERENT BUFFERS FOR BUGHLT PROCESSING
MOVEI C,HLTJFN
JRST .+1]
MOVEM A,SERPN0 ;REMEMBER PAGE NUMBER OF BUFFER
MOVEM B,SERPG0 ;REMEMBER ADDRESS OF BUFFER
MOVEM C,WCHJFN ;REMEMBER WHICH JFN
SETZM DATLR1 ;NO BUG TIMESTAMP YET
SETOM SERPN ;SAY THERE'S NO MAPPED PAGE YET
MOVE A,@WCHJFN ;GET HANDLE ON ERROR.SYS
MOVX B,OF%RD ;OPEN FOR READING
OPENF ;OPEN IT
ERJMP [ MOVE A,@WCHJFN ;COULDN'T OPEN, MAYBE NEW ERROR.SYS FILE.
RLJFN ;RELEASE OLD HANDLE ON IT
JSERR
SETZM @WCHJFN ;FORCE GTJFN TO BE DONE AGAIN
MOVEI A,0 ;NOTE THAT NO ENTRIES REPORTED
RET] ;WAIT TILL NEXT TIME AROUND
FFFFP ;GET FIRST FILE PAGE
ERJMP PRTKF ;FILE PROBABLY GOT DELETED
TRNN A,-1 ;IS FILE NONEMPTY?
JRST PRTKF ;NO, NOTHING TO DO
SOJ A, ;YES, GET LAST USED PAGE NUMBER
HRRZM A,ENDP ;REMEMBER
CALL SERBEG ;FIGURE OUT WHICH PAGE TO START WITH
JRST PRTKF ;FAILED, GIVE UP FOR NOW
CALL SERMAP ;MAP IN THE STARTING PAGE
JRST PRTKF ;FAILED
MOVE A,SERPN ;SEE WHICH PAGE IS MAPPED
LSH A,9 ;MAKE AN ADDRESS
SOJ A, ;PRETEND LAST BLOCK ENDED JUST BEFORE IT
MOVEM A,SERLST ;SAY WHERE "LAST BLOCK" ENDED
SUBI A,200
MOVEM A,SERFST ;FORCE SYNCHRONIZATION ON FIRST CALL TO SERNXT
BUGLUP: CALL SERNXT ;GET NEXT BLOCK
JRST PRTKF ;NO MORE BLOCKS
LOAD A,SER%ET,HDRCOD+SERHDR ;GET ENTRY TYPE
CAIE A,SER%EF ;END OF FILE?
CAIN A,SER%ER ;OR FILE ABORTED DUE TO ERROR?
JRST PRTKF ;YES, NO MORE
CAIE A,SER%BG ;IS THIS ENTRY A BUG?
JRST BUGLUP ;NO, SKIP IT
MOVE A,HDRDAT+SERHDR ;GET TIME STAMP ON ENTRY
CAMGE A,BUGDAT ;IS THIS ONE A NEW ONE?
JRST BUGLUP ;NO, SKIP IT
MOVEM A,DATLR1 ;REMEMBER STAMP ON BUG
MOVX B,BG%HLT ;GET BUGHLT FLAG
SKIPE HLTFLG ;REPORTING HALTS?
CAMN B,BG%FLG+SERBLK ;AND... IS THIS A BUGHLT ENTRY?
SKIPA ;YES..., REPORT IT
JRST BUGLUP ;NO..., DON'T REPORT IT
MOVE A,BG%NAM+SERBLK ;GET SIXBIT NAME
HRROI B,BUGNAM ;SAY WHERE TO WRITE ASCII
CALL SIXASC ;CHANGE SIXBIT TO ASCII
MOVE B,BG%DAT+SERBLK ;GET TIME OF BUG
HRROI A,BUGTIM ;WRITE ASCII TIME IN BUGTIM
MOVX C,OT%NDA ;ONLY THE TIME
ODTIM ;GET STRING FOR THE TIME
MOVX A,BYTE(7)"?"
MOVEM A,BUGUSR ;USE QUESTION MARK IF NO USER NUMBER
MOVE B,BG%USR+SERBLK ;GET USER WHO "CAUSED" THE BUG
HRROI A,BUGUSR ;WE WANT ASCII USER NAME IN BUGUSR
DIRST ;GET USER NAME
ERJMP .+1 ;USE "?" IF CAN'T GET USER NAME
MOVE A,BG%PNM+SERBLK ;GET PROGRAM NAME
HRROI B,BUGPRG ;WRITE ASCII TO BUGPRG
CALL SIXASC
SKIPN HLTFLG ;NO IGNORE FEATURE FOR HALTS
JRST [ HRROI B,BUGNAM ;WE'RE DOING BUGCHKS, SEE WHICH ONE
MOVEI A,BIGTAB ;LOOK AT TABLE OF ONES BEING IGNORED
TBLUK ;SEE IF THIS ONE IS BEING IGNORED
TXNE B,TL%EXM ;EXACT MATCH?
JRST BUGLUP ;YES, IGNORE THIS ONE
JRST .+1]
CALL BUGINI ;INITIALIZE BUGCHK TABLE
XTMSG <*[> ;BELL TO GET USER'S ATTENTION
HRROI A,BUGTIM ;PUT TIME STAMP ON
CALL STRNG
HRROI A,[ASCIZ / BUG??? /] ; DEFAULT TO UNKNOWN BUG TYPE
MOVE B,BG%FLG+SERBLK ;GET BUG TYPE FOR THIS ENTRY
CAIN B,BG%HLT ; BUGHLT?
HRROI A,[ASCIZ / BUGHLT /] ; YES
CAIN B,BG%CHK ; BUGCHK?
HRROI A,[ASCIZ / BUGCHK /] ; YES
CAIN B,BG%INF ; BUGINF?
HRROI A,[ASCIZ / BUGINF /] ; YES
CALL STRNG ;DUMP STRING WITHOUT BLOCKING
HRROI A,BUGNAM ;WE HAVE ENTIRE NAME NOW, TYPE IT OUT
CALL STRNG
XTMSG <: USER >
HRROI A,BUGUSR ;GET POINTER TO USER NAME
CALL STRNG
XTMSG <, PROGRAM >
HRROI A,BUGPRG
CALL STRNG ;TYPE PROGRAM NAME
XTMSG <
>
MOVEI A,BUGTAB ;LOOK UP MESSAGE FOR BUG (SYSERR BLOCK MIGHT NOT HAVE MESSAGE IN IT!)
HRROI B,BUGNAM ;POINT TO CURRENT BUGHLT
TBLUK ;TRY TO FIND IT
TXNN B,TL%EXM ;EXACT MATCH ON SOMETHING?
JRST [ HRROI A,[ASCIZ /Can't find message for BUG/]
JRST PRTMS1]
CALL GETSTR ;GET POINTER TO STRING
PRTMS1: CALL STRNG ;TYPE OUT BUG EXPLANATION
XTMSG <]
>
JRST BUGLUP ;SEE IF ANY MORE BUGS
PRTKF: HRROI A,-1 ;UNMAP PAGE OF ERROR.SYS FILE
HRLI B,.FHSLF
HRR B,SERPN0 ;DIFFERENT PAGE NUMBER FOR BUGHLTS AND BUGCHKS
MOVEI C,0 ;NO SPECIAL BITS
PMAP ;UNMAP IT
MOVE A,@WCHJFN ;GET JFN
SKIPN HLTFLG ;RELEASE FILE IF BUGHLT REPORT
TXO A,CO%NRJ ;DON'T RELEASE THE JFN
CLOSF ;CLOSE IT
JSERR ;SHOULDN'T FAIL
MOVE A,DATLR1 ;RETURN DATE-AND-TIME OF LAST ONE PRINTED
RET
;ROUTINE TO INPUT THE NEXT ERROR BLOCK. SERLST IS THE FILE ADDRESS OF THE
;LAST WORD OF THE PREVIOUS BLOCK
SERNXT: SAVEAC <Q1,Q2,Q3> ;SAVE PERMANENTS!
MOVE Q3,SERLST ;GET LAST ADDRESS OF PREVIOUS BLOCK
AOJ Q3, ;GET FIRST ADDRESS OF BLOCK WE'RE READING
TRNN Q3,177 ;IS THIS ADDRESS OF HEADER WORD?
AOJ Q3, ;NO, NOW IT IS. (SKIP BLOCK SYNCH WORDS)
MOVE A,Q3 ;GET FIRST ADDRESS OF NEW ENTRY
MOVE B,SERFST ;GET FIRST ADDRESS OF OLD ENTRY
LSH A,-7 ;ROUND TO BLOCK NUMBER
LSH B,-7
CAMN A,B ;IS NEW ENTRY IN A NEW BLOCK?
JRST SERNX0 ;NO
LSH A,7 ;YES, GET ADDRESS OF BEGINNING OF BLOCK
CALL SERGET ;READ SYNCH WORD TO MAKE SURE WE'RE IN SYNCH
RET ;FAILURE RETURN IF CAN'T READ SYNCH WORD
DPB A,[000700,,Q3] ;FORCE FIRST WORD OF SYSERR BLOCK TO WHAT SYNCH WORD SAYS
SERNX0: MOVEM Q3,SERFST ;REMEMBER FIRST WORD OF SYSERR BLOCK
MOVE A,Q3
CALL SERGET ;GET HEADER WORD CONTAINING LENGTH OF HEADER
RET ;FAILED
JUMPE A,R ;IF HEADER WORD 0, ASSUME WE'RE AT END OF FILE
LOAD B,SER%HL,A ;GET HEADER LENGTH
MOVE A,B
CAILE A,SERHLN ;MAKE SURE OUR HEADER BLOCK HAS ENOUGH ROOM
MOVEI A,SERHLN ;NO, SO READ ONLY WHAT FITS
MOVEM A,SERHEL ;REMEMBER HOW MANY HEADER WORDS WE'RE ACTUALLY READING
MOVN B,B ;SET UP LOOP FOR READING ENTIRE HEADER
HRL Q1,B ;SET UP LOOP COUNTER TO DO EXACTLY AS MANY WORDS AS IN HEADER
MOVEI Q2,0 ;KEEP TRACK OF HOW MANY WORDS WE'VE READ
SERNX1: TRNN Q3,177 ;IS THIS THE FIRST WORD OF BLOCK?
AOJ Q3, ;YES, IT'S A SYNCH WORD, SO SKIP IT
CAML Q2,SERHEL ;READ ALL WORDS WE CAN HANDLE?
JRST SERNX4 ;YES, JUST SCAN FOR SYNCH WORDS
MOVE A,Q3 ;GET ADDRESS OF HEADER WORD WE'RE READING
CALL SERGET ;READ WORD, SKIP SYNCH WORDS
RET ;FAILED
MOVEI B,SERHDR ;GET ADDRESS OF HEADER BLOCK
ADD B,Q2 ;FIGURE OUT WHICH WORD OF HEADER WE'RE SETTING UP
MOVEM A,(B) ;SET UP WORD OF HEADER
SERNX4: AOJ Q2, ;REMEMBER HOW MANY WORDS READ
AOJ Q3, ;STEP TO NEXT ADDRESS
AOBJN Q1,SERNX1 ;READ ALL WORDS OF HEADER
LOAD A,SER%EL,HDRCOD+SERHDR ;GET LENGTH OF ENTRY
CAILE A,SERBLN ;MAKE SURE WE HAVE ROOM FOR ENTRY OF THIS LENGTH
MOVEI A,SERBLN ;NO, SO READ ONLY WHAT WE HAVE ROOM FOR
MOVEM A,SERLEN ;REMEMBER ENTRY LENGTH WE'RE ACTUALLY READING
LOAD A,SER%EL,HDRCOD+SERHDR ;SET UP LOOP TO ACTUALLY READ ENTIRE ENTRY
MOVN A,A
HRL Q1,A ;MAKE LOOP COUNTER FOR READING ENTRY
MOVEI Q2,0 ;REMEMBER WHICH WORD OF ENTRY WE'RE READING
SERNX2: TRNN Q3,177 ;IS THIS THE FIRST WORD OF BLOCK?
AOJ Q3, ;YES, IT'S A SYNCH WORD, SO SKIP IT
CAML Q2,SERLEN ;HAVE WE READ AS MANY WORDS AS WE WANT?
JRST SERNX3 ;YES, JUST SCAN REST TO CALCULATE LAST ADDRESS
MOVE A,Q3 ;GET ADDRESS OF ENTRY WE'RE READING
CALL SERGET ;READ WORD OF ENTRY
RET ;FAILED
MOVEI B,SERBLK ;GET ADDRESS OF ENTRY BLOCK
ADD B,Q2 ;CALCULATE WHICH WORD WE'RE SETTING UP
MOVEM A,(B) ;SET UP AN ENTRY WORD
SERNX3: AOJ Q2, ;REMEMBER WHICH WORD WE'RE READING
AOJ Q3, ;REMEMBER ABSOLUTE WORD WE'RE READING
AOBJN Q1,SERNX2 ;LOOP FOR ENTIRE ENTRY
SOJ Q3, ;CALCULATE LAST ADDRESS USED BY ENTRY
MOVEM Q3,SERLST ;REMEMBER LAST ADDRESS OF ENTRY
RETSKP ;GIVE GOOD RETURN
;ROUTINE TO MAP IN A PAGE FROM THE ERROR.SYS FILE
SERMAP: CAMN A,SERPN ;IS THIS PAGE ALREADY MAPPED?
RETSKP ;YES, NOTHING TO DO
CAMLE A,ENDP ;MAKE SURE STILL IN FILE
RET ;NO (PREVENT ILL MEM READ IF ERROR.SYS BEING UPDATED SLOWER THAN WE'RE READING IT!)
MOVEM A,SERPN ;NO, SAY IT'S MAPPED NOW
HRL A,@WCHJFN ;USE APPRORIATE JFN
HRLI B,.FHSLF ;OURSELF
HRR B,SERPN0 ;DIFFERENT PAGE NUMBER FOR BUGHLTS AND BUGCHKS
MOVX C,PM%RD ;WE WANT TO READ IT
PMAP ;MAP IT
ERJMP R ;FAILED, FILE PROBABLY EXPUNGED
RETSKP ;SKIP FOR SUCCESS
;ROUTINE TO READ WORD FROM ERROR.SYS FILE
SERGET: MOVEM A,SERWCH ;REMEMBER WHICH WORD TO GET
LSH A,-9 ;CALCULATE PAGE NUMBER
CALL SERMAP ;MAP IN CORRECT PAGE
RET ;FAILURE RETURN
LDB A,[001100,,SERWCH] ;SEE WHICH WORD OF PAGE IS DESIRED
MOVE B,SERPG0 ;GET BASE ADDRESS
ADD B,A ;GET ADDRESS CONTAINING DATA
MOVE A,(B) ;GET THE DATA
RETSKP
;ROUTINE TO FIGURE OUT WHICH PAGE IN ERROR.SYS IS THE MOST CURRENT PAGE
;STARTING WITH AN ENTRY OLDER THAN THE ONES WE'RE LOOKING FOR.
SERBEG: SETZM SMLP ;START LOWER BOUND AT BEGINNING OF FILE
MOVE A,ENDP
MOVEM A,BIGP ;START HIGH BOUND AT END OF FILE
MOVE A,OGPAG ;GET OLD GOOD PAGE AS GUESS FOR PAGE TO START WITH
CAMG A,ENDP ;DON'T TRY TO GUESS IF GUESS IS TOO HIGH
JRST SERI1
SERI2: MOVE A,BIGP ;GET LARGE PAGE NUMBER
SUB A,SMLP ;CALCULATE RANGE
CAIG A,1 ;MORE THAN ONE PAGE DIFFERENT?
JRST [ MOVE A,SMLP ;RANGE IS REAL SMALL, RETURN WITH BEGINNING OF RANGE
MOVEM A,OGPAG ;REMEMBER WHICH PAGE TO SEARCH FROM NEXT TIME
RETSKP]
ASH A,-1
ADD A,SMLP ;CALCULATE MIDPAGE
SERI1: MOVEM A,MIDP ;REMEMBER MIDDLE
CALL GETLOG ;GET FIRST DATE ON THIS PAGE
RET ;FAILED
CAMGE A,BUGDAT ;IS THIS ENTRY TOO RECENT TO BE FIRST GOOD ONE?
JRST [ MOVE A,MIDP ;ENTRY IS TOO OLD, CHANGE LOW BOUND TO MIDDLE
MOVEM A,SMLP
JRST SERI2] ;TRY AGAIN
MOVE A,MIDP ;ENTRY IS TOO NEW, MOVE UPPERBOUND DOWN
MOVEM A,BIGP
JRST SERI2
;ROUTINE TO GET LOG STAMP OF FIRST SYSERR ENTRY ON SPECIFIED PAGE
GETLOG: LSH A,9 ;MAKE ADDRESS
MOVEM A,SERWP ;REMEMBER ADDRESS WE'RE READING
CALL SERGET ;GET CONTENTS OF FIRST WORD OF PAGE
RET ;FAILED
MOVEI A,HDRDAT(A) ;GET OFFSET FOR TIMESTAMP
ADD A,SERWP ;GET ACTUAL ADDRESS CONTAINING TIMESTAMP
CALL SERGET ;READ TIMESTAMP
RET ;FAILED
RETSKP ;SUCCESS
;ROUTINE WHICH TAKES TABLE ADDRESS IN A, AND RETURNS POINTER OF FORM -1,,ADR
;TO THE STRING POINTED TO BY THE TABLE ENTRY
GETSTR: HRRO A,(A) ;YES, GET POINTER TO STRING, MAYBE PRECEDED BY FLAGS
MOVX B,177B6 ;MASK FOR FIRST CHARACTER POSITION
TDNN B,(A) ;DOES STRING START ON FIRST WORD?
AOJ A, ;NO, FLAGS FIRST, GET TO STRING
RET
;MACRO FOR CAUSING A COMMAND ERROR THAT WE DETECT, AS OPPOSED TO ONE THAT
;COMND JSYS DETECTS
DEFINE COMERR (TEXT)
< CALL [ HRROI A,[ASCIZ /TEXT/]
ESOUT
TMSG <
>
MOVE A,XFORK
FFORK ;REFREEZE SINCE OURCFM MAY HAVE UNFROZEN
JRST CMDER1]
>
;MACRO FOR GETTING MONITOR SYMBOL VALUE
DEFINE GETSYM(NAME,MODULE<STG>)
<
MOVE A,[SQUOZE 0,NAME]
SKIPE NAME ;DO WE ALREADY KNOW THE VALUE?
JRST .+5 ;YES, DON'T GROVEL AGAIN!
MOVE B,[SQUOZE 0,MODULE]
CALL SYMBOL
RET ;FAILED, GIVE NONSKIP
MOVEM B,NAME
>
DEFINE TA (TEXT,ADDR)<
IFNB <ADDR>,<%%X==ADDR>
IFB <ADDR>,<%%X==.'TEXT>
[ CM%INV!CM%ABR!CM%FW
ASCIZ /TEXT/],,%%X
>
;ROUTINE TO GET VALUES FOR VARIOUS MONITOR SYMBOLS
;SKIPS IFF SUCCESSFUL
GOBSYM: SKIPE GOBFLG ;HAVE WE ALREADY GOTTEN MONITOR SYMBOLS?
RETSKP ;YES
GETSYM TTACTL ;TABLE OF TTY DATABASE ADDRESSES
GETSYM MLJFN ;SIZE OF JFN BLOCK
GETSYM SYSFK
GETSYM TTLINK,TTYSRV ;OFFSET TO SHOW WHO'S LINKED
GETSYM MAXJFN ;MAXIMUM JFN IN USE BY JOB
GETSYM FILSTS ;JFN STATUS
GETSYM FILNEN ;NAME,,EXT (POINTER)
GETSYM FILVER ;FORK,,VERSION
GETSYM FILDNM ;DIR,, (POINTER)
GETSYM FILDDN ;DEV,,DIR #
GETSYM JOBSKD ;JOBWIDE SCHEDULER CONTROL WORD
GETSYM JOBBIT
GETSYM JSVAR,JOBDAT
GETSYM PSVAR,JOBDAT
SETOM GOBFLG ;MARK THAT SYMBOLS HAVE BEEN READ
RETSKP ;MARK SUCCESS WITH SKIP
;GET TO HERE IF WE WON'T BE ABLE TO DETECT SPYERS
NOSPY: SETOM SPYERF ;REMEMBER THAT ERROR HAPPENED
TMSG <
%Won't be able to report who's spying! Reason:
>
CALLRET PERR ;PRINT SYSTEM ERROR MESSAGE
;PRINT LAST SYSTEM ERROR FOR OURSELF..
PERR: MOVE A,[.FHSLF,,-1] ;OURSELF, MOST RECENT ERROR
PERR1: MOVE B,A
MOVEI A,101
MOVEI C,0
ERSTR
JFCL
JFCL
TMSG <
>
RET
DATE: CALL SAVACS ;DON'T CLOBBER AC'S
CALL DATEX ;DO THE WORK
JRST .DEBRK
DATEX: STKVAR <REALI>
TIME ;SEE WHAT TIME IT IS NOW
SUB A,LSTTIM ;SEE HOW LONG SINCE LAST INTERRUPT
MOVEM A,REALI ;REMEMBER REAL INTERVAL
SKIPN BUSYF ;IF PROCESSING, EXCUSE LONG INTERRUPT LAPSE
CAIGE A,TIMEX*3/2 ;ALLOW 50% SLOP
CAIA
JRST [ TYPE <
%DATE: >
MOVEI A,TIMEX ;SHOW EXPECTED INTERVAL
CALL PSECS
TYPE <-sec interval expected; >
MOVE A,REALI ;GET OBSERVED LAPSE
CALL PSECS
TYPE < secs passed! Attempting to force an interrupt...
>
MOVEI A,.FHSLF ;INTERRUPT OURSELF
MOVX B,1B<TIMCHN>
IIC
JRST .+1]
SKIPE A,BUSYF ;DOING ANYTHING?
JRST [ TYPE <(> ;YES, PUT IN PARENTHESES
PSOUT ;SHOW WHAT WE'RE DOING
TYPE < >
MOVE A,REALI ;SAY HOW LONG SINCE LAST INTERRUPT
CALL PSECS
TYPE <) > ;FINISH MESSAGE
JRST .+1]
MOVE A,[14,,.SYSTA]
GETAB ;GET SYSTEM LOAD AVERAGE
JFCL
MOVEM A,LDAV ;REMEMBER LOAD AVERAGE
MOVE Q3,STATF ;SEE WHAT'S ENABLED
TXNN Q3,DATEF ;SEE IF LOAD-LINE ENABLED
JRST NODATE
MOVEI A," "
PBOUT
HRROI B,-1
MOVEI A,101
MOVEI C,0
ODTIM
JFCL
MOVEI A," "
PBOUT
MOVE B,LDAV ;LOAD AVERAGE IN B
MOVEI A,101
MOVEI C,0
FLOUT
JFCL
TMSG <
>
NODATE: TXNE Q3,SHAREF ;PRINT SHARES IF REQUESTED
CALL SLOHAK ;PRINT HOGS IF SYSTEM IS SLOW
TXNE Q3,IOF ;PRINT FILE PROGRESS IF REQUESTED
CALL PFILES ;PRINT FILE STATUS
DATEND: TYPE <---
> ;SHOW END OF REPORT
RET
;ROUTINE WHICH TAKES MILLISECONDS AS AN INTEGER IN A, AND TYPES IT AS
;A FLOATING POINT NUMBER OF SECONDS
PSECS: FLTR B,A ;PRINT AS SECONDS
FDVRI B,(1000.0)
MOVEI A,.PRIOU
MOVEI C,0 ;NO SPECIAL FORMAT
FLOUT
JSERR
RET
;ROUTINE TO PRINT STATUS OF FILES BEING READ OR WRITTEN
PFILES: STKVAR <FSTATS,FPTR,COMJFN,FILPOS,FPGC,PAGPOS,FNBYTS,FBSZ,BSZ,SAVED,SIDX,WJFN>
CALL JFNINI ;INITIALIZE JFN TABLE
SETZM WJFN ;START AT BEGINNING OF JFN'S
JLUP: AOS A,WJFN ;STEP TO NEXT JFN
MOVEM A,COMJFN ;FIRST ASSUME NO SPECIAL JFN
GTSTS ;SEE WHAT'S UP WITH THIS JFN
MOVEM B,FSTATS ;REMEMBER STATUS
TXNN B,GS%XCF ;DON'T DO JFNS OPEN FOR EXECUTE
TXNN B,GS%NAM ;IS JFN IN USE?
JRST NOJFN ;NO, SKIP THIS ONE( GO MARK AS NOT IN USE)
CALL DRFPTR ;GET FILE POSITION
JRST NOJFN ;IF FAILS, ASSUME JFN HAS BEEN FREED
CAIGE B,0 ;JFN IS INTERESTING IF IT HAS MAPPED PAGES
JUMPE A,NOJFN ;SKIP PRINT ROUTINE IF ZERO FILE POSITION
MOVE A,WJFN ;PRINT THE JFN
CALL POCT
MOVEI A,.PRIOU
MOVEI B,11
BOUT ;FOLLOWED BY A TAB
MOVE B,WJFN ;NEXT, PRINT THE FILESEPC
MOVEI C,0 ;NO SPECIAL BITS
JFNS
ERJMP JFNRAC ;ASSUME JFN JUST WENT AWAY
MOVEI B,11
BOUT ;ANOTHER TAB
MOVE A,WJFN ;PUT JFN IN A
MOVE B,FSTATS ;GET STATUS
TXNN B,GS%NAM ;JFN STILL IN USE?
JRST JFNRAC ;NO
TXNN B,GS%OPN ;MAKE SURE FILE IS OPEN
TYPE <Not opened >
TXNE B,GS%RDF ;FILE OPEN FOR READING?
TYPE <Read, >
TXNE B,GS%WRF ;WRITING?
TYPE <Write, >
TXNN B,GS%RND ;APPEND?
TYPE <Append, >
CALL DRFPTR ;GET FILE POSITION
JRST JFNRAC ;JFN SLIPPED OUT FROM UNDER US
JUMPGE B,JPAGES ;PRINT PAGES MAPPED IF SO
MOVEM A,FILPOS ;REMEMBER WHERE IN FILE WE ARE
SETZM PAGPOS ;SAY THERE'S NO PAGE POSITION
CALL PDEC ;PRINT FILE POSITION IN DECIMAL
TYPE <.(> ;PUT DECIMAL POINT IN AND OPEN PAREN FOR BYTE SIZE
MOVE A,WJFN ;GET JFN
RFBSZ ;GET BYTE SIZE
ERJMP JFNRAC ;ASSUME JFN WENT AWAY IF FAILS
MOVE A,B
MOVEM A,BSZ ;REMEMBER BYTE SIZE
CALL PDEC ;PRINT BYTE SIZE IN DECIMAL
TYPE <)> ;OMIT DECIMAL POINT JUST LIKE EXEC DOES!
PPER: MOVE A,FSTATS ;GET FILE STATUS
TXNN A,GS%WRF ;IS FILE OPEN FOR WRITING?
JRST PPER0 ;NO, SO NO PROBLEM
;Now we know file is open for writing, so use previous generation for calculating
;how far done we are.
MOVE A,CSBUFP ;POINT TO SOME RANDOM SPACE
MOVE B,WJFN ;GET JFN OF FILESPEC
MOVX C,JMAGIC&^-JS%GEN ;GET ALL BUT GENERATION FIELD
JFNS
ERJMP JFNRAC ;IF THIS FAILS, ASSUME JFN DISAPPEARED
MOVEI B,"." ;PUT DOT AFTER FILE TYPE
IDPB B,A
MOVEM A,FPTR ;REMEMBER POINTER TO END OF FILESPEC
MOVE A,WJFN ;GET HANDLE ON REAL FILE AGAIN
MOVE B,[1,,.FBGEN] ;PREPARE TO GET GENERATION
MOVEI C,B
GTFDB ;GET GENERATION NUMBER
ERJMP JFNRAC ;IF CAN'T JFN MUST HAVE GONE AWAY
LOAD B,FB%GEN,B ;ISOLATE GENERATION NUMBER
MOVE A,FPTR ;POINT TO FILESPEC AGAIN
SOJ B, ;PREPARE TO LOOK UP PREVIOUS GENERATION
MOVX C,5+5 ;DECIMAL
NOUT ;PUT GENERATION NUMBER ON FILESPEC
ERCAL JSBOMB ;SHOULDN'T EVER FAIL
MOVX A,GJ%DELGJ%PHYGJ%SHT!GJ%OLD ;TRY TO GET PREVIOUS GENERATION (GJ%PHY BECAUSE JFNS RETURNED REAL DEVICE)
MOVE B,CSBUFP ;POINT TO FILESPEC OF PREVIOUS GENERATION
GTJFN
ERJMP PPER2 ;IF NO PREVIOUS GENERATION, FORGET IT
MOVEM A,COMJFN
PPER0: MOVE A,COMJFN ;COMPARE WITH INFO FROM FILE
MOVE B,[2,,.FBBYV] ;WE WANT BYTE SIZE AND PAGE COUNT AND BYTES
MOVEI C,C ;READ INFO INTO C AND D
GTFDB ;READ INFO ABOUT FILE
ERJMP JFNRAC ;IF CAN'T JFN PROBABLY DISAPPEARED
MOVEM D,FNBYTS ;REMEMBER NUMBER OF BYTES
LOAD A,FB%BSZ,C ;GET BYTE SIZE OF FILE
MOVEM A,FBSZ ;REMEMBER FILE BYTE SIZE
LOAD A,FB%PGC,C ;GET NUMBER OF PAGES IN FILE
MOVEM A,FPGC ;REMEMBER FILE PAGE COUNT
SKIPE A,PAGPOS ;ARE WE GOING BY PAGES?
JRST [ MOVE B,FPGC ;YES, COMPARE PAGE POSITION WITH NUMBER OF PAGES
JRST PPER1]
MOVEI A,6*6
IDIV A,FBSZ ;SEE HOW MANY FILE BYTES PER WORD
MOVE B,FNBYTS ;GET NUMBER OF BYTES IN FILE
IDIV B,A ;GET NUMBER OF WORDS IN FILE
MOVEI C,6*6 ;GET MAXIMUM BYTES PER WORD
IDIV C,BSZ ;SEE HOW MANY BYTES PER WORD FOR CURRENT OPENING
IMUL B,C ;GET NUMBER OF BYTES FOR CURRENT BYTE SIZE
MOVE A,FILPOS ;GET NUMBER OF BYTES READ SO FAR
PPER1: FLTR A,A ;MAKE FLOATING POINT NUMBERS
FLTR B,B
FDVR A,B ;GET FRACTION THROUGH FILE WE ARE
FMPRI A,(100.0) ;CHANGE TO A PERCENTAGE
FIXR A,A ;GET INTEGER PERCENTAGE
TYPE < [> ;PUT PERCENTAGE IN BRACKETS
CALL PDEC
TYPE <%]>
PPER2: TYPE <
>
NOJFN: MOVE A,COMJFN ;GET POSSIBLE SPECIAL JFN
CAME A,WJFN ;IS THERE ONE?
JRST [ RLJFN ;YES, RELEASE IT
JSERR ;SHOULDN'T FAIL
JRST .+1]
MOVE A,WJFN ;SEE WHICH JFN WE JUST TRIED
CAIGE A,HGHJFN ;JUST DID HIGHEST?
JRST JLUP ;NO
RET ;YES
JPAGES: MOVE D,JFNPAG(B) ;GET LOWEST,,HIGHEST PAGE NUMBER
MOVEM D,SAVED
MOVEM B,SIDX ;REMEMBER INFO
TYPE <Page>
MOVS A,D
CAME A,D ;SEVERAL PAGES?
TYPE <s> ;YES
TYPE < >
HLRZ A,SAVED
CALL POCT ;PRINT PAGE NUMBER IN OCTAL
HLRZ D,SAVED
HRRZ A,SAVED
CAMN A,D ;RANGE?
JRST FPA1 ;NO, ONLY ONE PAGE
TYPE <->
CALL POCT ;PRINT HIGHEST PAGE NUMBER
FPA1: HLRZ A,SAVED ;GET LOW PAGE NUMBER
ADD A,SAVED ;COMPUTE AVERAGE BETWEEN HIGH AND LOW
HRRZ A,A
ASH A,-1
MOVEM A,PAGPOS ;SAVE AVERAGE PAGE NUMBER AS FILE POSITION
SETZM FILPOS ;SAY THERE'S NO FILE POSITION
JRST PPER ;GO PRINT PERCENTAGE THROUGH THE FILE
;ROUTINE TO GET FILE POSTION
;ACCEPTS: A/ JFN
;RETURNS+ +1 ERROR
; +2 SUCCESS. YEY!
; A/ RFPTR VALUE, IFF B HAS -1
; B/ -1 OR INDEX INTO JFNPAG (FOR GETTING LOW,,HIGH PAGE NUMBER)
DRFPTR: STKVAR <DJFN>
MOVEM A,DJFN ;REMEMBER JFN
MOVE B,JFNNN ;GET NUMBER OF JFNS IN LIST
DRF1: SOJL B,DRF2 ;JFN NOT MAPPED IF THIS RUNS OUT
CAME A,JFNLST(B) ;FIND THE JFN WE'RE LOOKING FOR?
JRST DRF1 ;NOT YET
RETSKP ;DONE, INDEX IN B
DRF2: RFPTR ;GET FILE POSITION
ERJMP R ;NON-SKIP IF ERROR
MOVE A,B ;POSITION IN A
HRROI B,-1 ;REMEMBER THAT NO PAGES MAPPED
RETSKP ;RETURN RFPTR DATA
;ROUTINE TO SEARCH ALL FORK'S ADDRESS SPACE FOR MAPPED JFNS. IF A PAGE
;IS MAPPED TO A JFN , THAT PAGE NUMBER
;IS REMEMBERED FOR THAT JFN IF IT'S THE HIGHEST OR LOWEST OBSERVED MAPPED PAGE
PTRELN==3*NUFKS ;ROOM FOR ENTIRE FORK STRUCTURE
JFNINI: STKVAR <FH,SAVIX,PATFLG,PHANDL,FPAGN,JFH,<PTREE,PTRELN>>
SETOM PTREE ;MARK TABLE SO WE'LL KNOW HOW MUCH GFRKS USES
HRLI A,PTREE
HRRI A,1+PTREE
MOVEI B,PTREE
BLT A,PTRELN-1(B) ;FILL TABLE WITH -1'S
SETZM JFNNN ;NO JFNS STORED YET
MOVEI A,.FHSLF ;WE WANT ALL PROCESS AT US AND BELOW
MOVX B,GF%GFH ;WE WANT HANDLES ON THE PROCESSES
HRRI C,PTREE ;GET TREE INTO SOME SPACE
HRLI C,-PTRELN ;SPECIFY HOW MUCH ROOM WE HAVE
GFRKS ;GET FORK HANDLES
ERCAL JSBOMB ;SHOULDN'T EVER FAIL
MOVEI A,400000 ;START WITH SMALLEST FORK HANDLE
MOVEM A,JFH
JFNI1: SETZM FPAGN ;START WITH PAGE 0 OF FORK
SETZM PATFLG ;FIRST ASSUME NOT PAT
MOVE A,JFH ;GET WHICH FORK WE'RE ON
CALL SKPPAT ;SKIP IF COMPATIBLE FORK
JRST JFNI2 ;NO, SO USE COMPLETE PAGE MAP
SETOM PATFLG ;REMEMBER THAT IT'S A COMPATIBLE PROCESS
LSH A,-9 ;COMPATIBLE, GET FIRST PAGE OF PA1050
MOVEM A,FPAGN ;START THERE (ASSUME NO MAPPED PAGES BELOW THAT!)
JFNI2: HRL A,JFH ;GET HANDLE OF FORK WE'RE DOING
HRR A,FPAGN ;GET PAGE NUMBER OF FORK WE'RE EXAMINING
RMAP ;GET INFORMATION ABOUT THE PAGE
ERJMP [ CALL GETERR ;FAILED, SEE WHY
CAIE A,FRKHX2 ;"ILLEGAL TO MANIPULATE SUPERIOR" (SEEMS TO HAPPEN IF FORK BEING KILLED DURING RMAP)
CAIN A,FRKHX1 ;NO SUCH FORK?
JRST JFNI5 ;YES, GO TO NEXT FORK
CAIE A,ARGX06 ;NO SUCH PAGE NUMBER?
CALL JSBOMB ;NO, BAD ERROR
MOVE A,FPAGN ;YES, WE MUST BE IN NONEXISTENT SECTION
IORI A,777 ;PRETEND WE JUST SCANNED ENTIRE SECTION
MOVEM A,FPAGN
JRST JFNI3] ;TRY NEXT SECTION (UNLESS WE'RE DONE!)
JUMPL A,JFNI3 ;SKIP PAGE IF IT BELONGS TO A FORK
TXNN B,RM%PEX ;MAKE SURE PAGE EXISTS
JRST JFNI3 ;NO, GO TO NEXT PAGE
MOVEM A,PHANDL ;REMEMBER PAGE HANDLE
HLRZ A,A ;ISOLATE JFN
MOVE B,JFNNN ;SEE HOW MANY JFNS WE KNOW ABOUT YET
JFNI4: SOJL B,[ AOS B,JFNNN ;THIS ENTRY IS NEW!
CAILE B,JFNZZZ ;DO WE HAVE ROOM FOR ANOTHER JFN?
JRST JFNI3 ;NO, SKIP IT
HRR C,PHANDL ;YES, GET PAGE NUMBER
HRL C,PHANDL ;INITIALIZE SMALLEST AND LARGEST PAGE TO THIS PAGE
MOVEM C,JFNPAG-1(B) ;STORE INITIAL VALUE
MOVEM A,JFNLST-1(B) ;REMEMBER WE'VE GOT A NEW JFN
JRST JFNI3] ;SCAN REST OF PAGES
CAME A,JFNLST(B) ;HAVE WE FOUND THIS JFN IN OUR TABLE?
JRST JFNI4 ;NOT YET
HRRZ C,JFNPAG(B) ;FOUND THIS JFN'S ENTRY, GET HIGHEST PAGE NUMBER SEEN SO FAR
HRRZ A,PHANDL ;GET THIS PAGE NUMBER
CAMLE A,C ;HAVE WE FOUND A NEW HIGHEST PAGE NUMBER?
HRRM A,JFNPAG(B) ;YES, REMEMBER NEW HIGH
HLRZ C,JFNPAG(B) ;GET PREVIOUS LOWEST PAGE NUMBER
CAMGE A,C ;HAVE WE FOUND A NEW LOW?
HRLM A,JFNPAG(B) ;YES, REMEMBER NEW LOW
JFNI3: AOS A,FPAGN ;STEP TO NEXT FORK PAGE NUMBER
SKIPE PATFLG ;COMPATIBLE PROCESS?
JRST [ CAIG A,777 ;YES, ASSUME ONLY SECTION 0 (TO BE EFFICIENT!)
JRST JFNI2 ;NOT DONE WITH SECTION 0 YET
JRST JFNI5] ;DONE WITH SECTION 0, ON TO NEXT FORK.
CAIG A,HGHFPN ;BEYOND HIGHEST POSSIBLE FORK PAGE NUMBER?
JRST JFNI2 ;NO, GO DO THIS PAGE
JFNI5: AOS A,JFH ;GO TO NEXT FORK
TRZ A,400000 ;SEE WHAT FORK NUMBER THIS IS
CAIGE A,NUFKS ;DONE AS MANY FORKS AS CAN POSSIBILY EXIST?
JRST JFNI1 ;NO, GO DO THIS FORK
MOVEI D,PTRELN ;GET LENGTH OF FORK TABLE
JFNI6: JUMPLE D,R ;DONE RELEASING HANDLES
MOVEI A,-2(D) ;GET RELATIVE OFFSET FOR FORK HANDLE
ADDI A,PTREE ;GET REAL ADDRESS OF HANDLE
MOVE A,(A) ;GET FORK HANDLE WORD
AOJE A,JFNI7 ;IGNORE IF HIT A -1 ENTRY
MOVEI A,-1(A) ;ISOLATE THE FORK HANDLE
CAIN A,.FHSLF ;DON'T TRY TO RELEASE HANDLE ON SELF!
JRST JFNI7
MOVEM D,SAVIX
MOVEM A,FH ;PION / PIOFF CLOBBER TEMPS
CALL PIOFF ;DON'T LET EXEC TABLE CHANGE WHILE WE PERUSE IT
MOVE A,FH
MOVSI B,-EFNLEN ;PREPARE TO SCAN TABLE OF EXEC FORKS
JFNL: SKIPN EFNTAB(B) ;IS THIS SLOT IN USE?
JRST JFNL1 ;NO
CAIN A,400000(B) ;YES, IS HANDLE WE WANT TO FLUSH REALLY AN EXEC?
JRST [ CALL PION ;YES, ALLOW INTERRUPTS AGAIN.
JRST JFNI7] ;DON'T TRY TO RELEASE THIS FORK HANDLE
JFNL1: AOBJN B,JFNL ;MAKE SURE FORK DOESN'T MATCH REST OF EXECS
CALL PION ;ALLOW EXEC TABLE TO CHANGE AGAIN
MOVE A,FH
MOVE D,SAVIX
CAME A,XFORK ;DON'T RELEASE HANDLES OF FORKS WE NEED!
CAMN A,TTYFRK
CAIA
JRST [ RFRKH ;RELEASE HANDLE SO WE DON'T USE UP HANDLES
JSERR ;SHOULDN'T FAIL
JRST .+1] ;NOTE THAT USING -1 IN AC1 WOULD LOSE OUR
;SPECIAL HANDLES, IF EXEC ABOVE US ALSO HAD
;HANDLES, AS IT WILL IF USER DOES "INFO PROG"!
JFNI7: SUBI D,3 ;STEP DOWN TO NEXT ENTRY
JRST JFNI6
;SKPPAT SKIPS IF PROCESS IS USING THE COMPATIBILITY PACKAGE
;
;ACCEPTS: A/ PROCESS HANDLE
;
;RETURNS: +1: PROCESS NOT USING COMPATIBILITY
; +2: IS USING IT, FIRST ADDRESS OF PACKAGE IS IN A
SKPPAT: GCVEC ;GET COMPATIBILITY ENTRY VECTOR
ERJMP R ;IF NO SUCH PROCESS, THEN IT'S NOT USING COMPATIBILITY PACKAGE
AOJE B,R ;IF WAS -1, PAT NOT AVAILABLE
SOJE B,R ;IF WAS 0, PAT NOT IN USE (NOTE B UNCLOBBERED NOW!)
HRRZ A,B ;ASSUME PAT STARTS AT ENTRY VECTOR
RETSKP
;ROUTINE TO PRINT INFO ABOUT JOBS USING LOTS OF RUNTIME WHEN
;SYSTEM IS SLOW.
SLOHAK: STKVAR <PINLEN,<JINFO,.JIPNM-.JIUNO+1>,PORTIN,LSF>
CALL PIOFF ;DON'T LET ANYONE FIDDLE WITH TOTRUN WHILE WE LOOK
MOVE A,[0.5]
FDVR A,LDAV ;CALCULATE INTERESTING AMOUNT OF MACHINE
MOVEM A,PORTIN ;REMEMBER PORTION TO USE FOR COMPARISON
MOVN P1,JTLEN ;GET LENGTH OF JOB TABLE
HRLZ P1,P1 ;MAKE AOBJN POINTER
SETZM PINLEN ;HAVEN'T PINPOINTED ANY YET
SLO1: FLTR A,JRINTB(P1) ;GET A RUNTIME
FDVR A,TOTRUN ;CALCULATE PORTION THIS JOB HAS USED
CAMGE A,PORTIN ;ENOUGH TO BE INTERESTING?
JRST SLO4 ;NO
AOS A,PINLEN ;YES, COUNT NUMBER WE'VE PINPOINTED
HRRZM P1,HOGTAB-1(A) ;PINPOINT THIS ENTRY
CAML B,JRINTB(P1) ;FOUND A GREATER OR EQUAL RUNTIME YET?
JRST SLO4 ;NO
MOVE B,JRINTB(P1) ;YES, REMEMBER THE BETTER ONE
MOVE C,P1 ;REMEMBER ITS JOB NUMBER
SLO4: AOBJN P1,SLO1 ;SCAN REST OF LIST LOOKING FOR HOGS
SLO8: MOVE P1,PINLEN ;NOW PRINTOUT THE OFFENDERS
SETOM LSF ;INITIALIZE "LARGEST SO FAR"
SLO7: SOJL P1,SLO6 ;LEAVE SEARCH LOOP IF SCANNED ENTIRE TABLE
SKIPGE A,HOGTAB(P1) ;GET JOB NUMBER
JRST SLO7 ;NONENTRY (ALREADY PRINTED)
MOVE A,JRINTB(A) ;GET ITS RUNTIME
CAMGE A,LSF ;MOST INTERESTING ONE NOT YET PRINTED?
JRST SLO7 ;NO
MOVEM A,LSF ;YES, REMEMBER
MOVE D,P1 ;REMEMBER INDEX FOR THIS CANDIDATE
JRST SLO7 ;SCAN REST OF TABLE
SLO6: SKIPGE LSF ;FIND A REAL ENTRY?
CALLRET PION ;NO, UNLOCK TOTRUN AND RETURN
MOVE A,HOGTAB(D) ;GET JOB NUMBER
SETOM HOGTAB(D) ;CLOBBER ENTRY SO DOESN'T GET PRINTED AGAIN
HRLI B,.JIUNO-.JIPNM-1 ;WE WANT USER NUMBER AND PROGRAM NAME
HRRI B,JINFO ;BLOCK INTO WHICH WE'LL READ INFO
MOVEI C,.JIUNO ;USER NUMBER IS FIRST ITEM WANTED
GETJI ;GET THE INFO
ERJMP SLO8 ;IF FAILS, JOB PROBABLY LOGGED OFF
MOVEI A,.PRIOU ;PRINT ON TERMINAL
MOVE B,JINFO ;GET USER NUMBER
DIRST ;PRINT USER NUMBER
JRST NLI ;NOT LOGGED IN
DIRS1: TMSG <-> ;PUT HYPHEN BETWEEN USER NAME AND PROG
MOVE A,.JIPNM-.JIUNO+JINFO ;GET PROGRAM NAME
CALL PSIXN ;PRINT IT
TMSG < >
FLTR A,LSF ;GET RUNTIME
FDVR A,TOTRUN ;CALCULATE PORTION USED
FMPRI A,(100.0) ;MAKE PERCENTAGE
FIX A,A ;MAKE INTEGER
CALL PDEC ;PRINT IN DECIMAL
TMSG <%
>
JRST SLO8 ;PRINT THE REST
NLI: TMSG <Not logged in>
JRST DIRS1
;GET HERE IF JFN DISAPPEARS WHILE WE'RE PRINTING INFO ABOUT IT
JFNRAC: TYPE <...[JFN has just been closed!!]
>
JRST NOJFN ;CONTINUE WITH REST OF JFN'S
;ROUTINE TO STACK ALL THE AC'S. THIS IS USEFUL FOR INTERRUPT
;ROUTINES THAT HAVEN'T THE SLIGHTEST IDEA WHERE THE EXEC WAS WHEN
;THE INTERRUPT OCCURED, SO THE INTERRUPT ROUTINE CALLES SAVACS TO
;SAVE ALL THE AC'S ON THE STACK. THE INTERRUPT ROUTINE MUST CALL
;RESACS BEFORE DISMISSING THE INTERRUPT, IN ORDER TO RESTORE THE
;AC'S.
;THIS ROUTINE DOESN'T SAVE P.
SAVACS: EXCH 0,(P) ;SAVE AC0, GET RETURN ADDRESS
ADJSP P,17 ;ALLOCATE ROOM FOR THE REST OF THE AC'S
MOVEM 0,(P) ;STORE RETURN ADDRESS "AFTER" AC BLOCK
HRRI 0,-16(P) ;PLACE ON STACK TO STORE AC'S
HRLI 0,1 ;STARTING FROM AC1
BLT 0,-1(P) ;SAVE REST OF AC'S
RET ;RETURN TO CALLER
;ROUTINE TO RESTORE AC'S
RESACS: HRLI 0,-16(P) ;GET ADDRESS OF STORED AC'S
HRRI 0,1 ;RESTORE AC'S INTO AC1 ONWARD
BLT 0,16 ;RESTORE 1 THROUGH 16
MOVE 0,(P) ;GET RETURN ADDRESS
EXCH 0,-17(P) ;STORE RETURN ADDRESS, GET ORIGINAL AC0
ADJSP P,-17 ;FREE UP SPACE USED BY RETURN ADDRESS AND 1 THROUGH 16
RET ;RETURN TO CALLER (PHYEW!)
;GET HERE EVERY SO OFTEN TO CHECK FOR SPYERS
TIMINT: CALL SAVACS ;SAVE THE AC'S
CALL DTIMER ;GET READY FOR ANOTHER INTERRUPT
CALL TIM0 ;DO THE WORK
CALL RESACS ;RESTORE ACS
DEBRK ;RETURN (EITHER TO SLEEP OR TO SOME ROUTINE)
;ROUTINE TO TYPE CHARACTER IN A.
CHAR: STKVAR <WHATC>
MOVEM A,WHATC
CALL TTYLCK ;LOCK THE TERMINAL
MOVE A,WHATC
IDPB A,TTYPNT ;PUT CHARACTER IN OUTPUT STREAM
CALLRET TTYULK ;UNLOCK TTY AND RETURN
;INSTANT OCTAL AND DECIMAL NUMBER ROUTINES (SEE DECNUM FOR BUFFERED NUMBER)
POCT: MOVEI B,8 ;SAY OCTAL
CALLRET PNUM
PDEC: MOVEI B,5+5 ;SAY DECIMAL
CALLRET PNUM
PNUM: MOVE C,B ;RADIX IN C FOR NOUT
MOVE B,A ;NUMBER IN B
MOVEI A,.PRIOU ;OUTPUT TO PRIMARY
NOUT ;PRINT NUMBER
JSERR ;FAILED
RET
;TYPE OCTAL NUMBER IN A
OCTNUM: MOVEI B,8 ;RADIX
CALLRET NUM ;DO REGULAR NUMBER
;DECIMAL NUMBER
DECNUM: MOVEI B,5+5 ;RADIX
CALLRET NUM
;GENERAL NUMBER OUTPUT ROUTINE. NUMBER IN A, RADIX IN B
NUM: STKVAR <AMOUNT,BASE>
MOVEM A,AMOUNT
MOVEM B,BASE ;SAVE DATA
CALL TTYLCK ;WAIT TILL BUFFER AVAILABLE
MOVE B,AMOUNT ;NUMBER IN B
MOVE C,BASE ;GET RADIX
MOVE A,TTYPNT ;POINTER TO BUFFER
NOUT ;DO THE NUMBER
ERJMP NOPNM ;GO HANDLE ERROR
MOVEM A,TTYPNT ;UPDATE POINTER
CALLRET TTYULK ;UNLOCK BUFFER
;TTYINI is called once at startup to initialize terminal.
TTYINI: MOVE A,[440700,,BUFFER]
MOVEM A,BPTR ;INITIALIZE OUTPUT BUFFER
MOVEI A,NBCHARS
MOVEM A,BROOM ;SAY THERE'S THIS MUCH ROOM LEFT
MOVX A,GJ%SHT
HRROI B,[ASCIZ /TTY:/]
GTJFN ;GET HANDLE ON TERMINAL
JSHLT
MOVE B,[100000,,OF%WR] ;BINARY CHANNEL FOR SCREEN STUFF
OPENF
JSHLT
MOVEM A,TTYJFN ;SAVE BINARY CHANNEL
RET
;TERCHK should be called whenever you think terminal parameters, such as
;terminal type or height has changed.
TERCHK: MOVE A,TTYJFN ;GET CHANNEL
GTTYP ;GET TERMINAL TYPE
MOVEM B,TRMTYP ;REMEMBER
MOVEI B,.MORLL ;READ LINE LENGTH
MTOPR
MOVEM C,HEIGHT ;REMEMBER IT
MOVEI B,.MORLW ;READ LINE WIDTH
MTOPR
MOVEM C,WIDTH
SETZM SCRNF ;REMEMBER NOT A SCREEN
SKIPE HOMTAB(B) ;A SCREEN?
SETOM SCRNF ;YES, WHAT FUN!!!
RET
;STRING WHOSE POINTER IS IN A...
STRNG: STKVAR <SPTR>
MOVEM A,SPTR ;REMEMBER STRING POINTER
CALL TTYLCK ;LOCK BUFFER
MOVE B,SPTR ;GET POINTER TO STRING
MOVE A,TTYPNT ;POINTER TO OUTPUT BUFFER
MOVEI C,0 ;STOP ON NULL
SOUT ;OUTPUT THE STRING
MOVEM A,TTYPNT ;STORE UPDATED POINTER
CALLRET TTYULK ;UNLOCK BUFFER
;ROUTINE TO PREVENT INTERRUPTS.
PIOFF: MOVEI A,.FHSLF ;OURSELF
DIR ;TURN OFF INTERRUPTS
RET
;TURN INTERRUPTS ON
PION: MOVEI A,.FHSLF ;OURSELF
EIR ;ENABLE INTERRUPTS
RET
;ROUTINE TO LOCK THE BUFFER WHILE IT GETS USED
TTYLCK: CALL BUFOK ;MAKE SURE TTY BUFFER IS O.K.
CALL HANG ;IT'S NOT, WAIT FOR SOME TO EMPTY
TTYLCX: AOSE TTYFLG ;IS OTHER FORK USING THE DATABASE?
CALL HANG ;YES, WAIT FOR IT TO FINISH
CALL PIOFF ;TURN OFF INTERRUPTS SO NOONE ELSE USES TTY DATABASE
RET
BUFOK: HRRZ A,TTYPNT
CAIL A,DEAD ;BUFFER GETTING FULL?
RET ;YES, BUFFER NOT OK
RETSKP ;NO, BUFFER IS OK
;ROUTINE TO UNLOCK BUFFER ONCE WE'RE DONE OUTPUTTING TO IT
TTYULK: AOSE OUTFLG ;GONE FROM NO OUTPUT TO OUTPUT READY?
JRST TTYUL1 ;NO, OUTPUT FORK ALREADY RUNNING
CALL [ DMOVE A,[EXP CR%ACS!CR%CAP,[IOWD TTYPLN,TTYPDL]-17] ;CREATE FORK, SET UP STACK
CFORK ;CREATE OUTPUT FORK
RET ;FAILED
RETSKP] ;SUCCEEDED
CALL HANG ;IF NO FORKS AVAILABLE, WAIT FOR ONE.
MOVEM A,TTYFRK ;REMEMBER HANDLE
MOVSI A,.FHSLF ;LET OURSELF BE SEEN...
HRLZ B,TTYFRK ;BY THE TTY FORK.
MOVX C,PM%CNT!PM%RD!PM%WR!<1+<.RLEND_-9>> ;COUNT, READ, WRITE, ALL OF OUR ADDRESS SPACE
PMAP ;GIVE NECESSARY MEMORY TO TTY FORK
MOVE A,TTYFRK
MOVEI B,SPILL
SFORK ;START UP TTY FORK
TTYUL1: MOVEI A,0
MOVE B,TTYPNT
IDPB A,B ;MAKE SURE WE END BUFFER WITH NULL
SETOM TTYFLG ;SAY ANOTHER FORK CAN NOW USE DATABASE
CALL PION ;ALLOW INTERRUPTS AGAIN
RET
;"CALL HANG" IS LIKE "JRST .-1" BUT DOESN'T LOAD DOWN THE CPU
HANG: MOVEI A,HANGT ;GET SOME TIME TO WASTE
DISMS ;WASTE IT
POP P,A ;THROW AWAY OUR ADDRESS ON STACK
JRST -2(A) ;GO BACK AND SEE IF CONDITION MET YET
TIM0: CALL RUPDAT ;UPDATE RUNTIMES
SKIPN INITF ;EVERYTHING INITIALIZED?
RET ;NO, SO DO NOTHING MORE
CALL UPFILE ;CHECK FOR UPDATED FILES
CALL GRUMPS ;CHECK FOR GRUMPS
CALL BUGX ;CHECK FOR BUGCHKS
CALL NEWMAL ;CHECK FOR NEW MAIL
CALL SPYERS ;CHECK ON SPYERS
SETZM BUSYF ;WE'RE NOT PROCESSING ANYTHING ANYMORE
RET ;DONE
;UPFILE gets called at interrupt level to check if update-checking is
;enabled, and if so, announce any interesting files that have been written
;recently.
UPFILE: TRVAR <REPJFN,REPTIM,REPFTM,REPRTM>
MOVEI Q1,ULEN ;GET NUMBER OF DIRECTORIES TO CHECK
UPF1: SOJL Q1,R ;NO MORE TO CHECK WHEN Q1 REACHES 0
SKIPN A,UDIR(Q1) ;GET NEXT DIRECTORY NUMBER
JRST UPF1 ;SKIP EMPTY SLOTS
GTDAL ;SEE HOW MANY PAGES IN USE
CAMN B,USIZE(Q1) ;DIFFERENT THAN LAST TIME?
JRST UPF1 ;NO, SO ASSUME NOTHING CHANGED (HMMM).
HRROI A,[ASCIZ /Files/]
MOVEM A,BUSYF ;SHOW THAT WE'RE CHECKING FILES
MOVEM B,USIZE(Q1) ;YES, REMEMBER NEW CURRENT SIZE
MOVEI A,UJFNBK ;POINT AT SPECIAL JFN BLOCK
MOVE B,UFPTR(Q1) ;GET POINTER TO FILESPEC STRING FOR THIS DIR
GTJFN ;GET HANDLE ON FIRST FILE IN SET
ERJMP UPF1 ;NONE IN SET, SO GO ON TO NEXT SET
MOVE B,UTIME(Q1) ;GET PREVIOUS TIME FOR THIS SET
CALL REPFLS ;REPORT WHAT HAPPENED IN THIS DIRECTORY
CAMLE A,UTIME(Q1) ;DON'T SHRINK THE TIME
MOVEM A,UTIME(Q1) ;REMEMBER TIME TO USE FOR NEXT CHECK
JRST UPF1 ;LOOP FOR REST OF DIRECTORIES
;REPFLS reports which files have been updated recently.
;
;accepts: A/ JFN (such as SNARK:<4.MONITOR>*.MAC)
; B/ date-and-time for deciding what's recent
;
;returns +1: A/ Most recent time-and-date any file in set was written
;
;The given JFN is stepped through, and for each file match it, if that
;file's write-time is more recent than the time given in B, that file is
;reported.
REPFLS: MOVEM A,REPJFN ;REMEMBER THE JFN
MOVEM B,REPTIM ;REMEMBER WHAT TIME TO USE
SETZM REPRTM ;FORCE AT LEAST SOME TIME TO BE STORED HERE
REPFL1: HRRZ A,REPJFN ;GET THE JFN FOR CURRENT FILE OF SET
MOVE B,[1,,.FBCRE] ;WE WANT ONE WORD, REAL WRITE TIME
MOVEI C,A ;GET FILE'S WRITE TIME
GTFDB
MOVEM A,REPFTM
CAMLE A,REPRTM ;IS THIS THE MOST RECENT TIME SEEN SO FAR?
MOVEM A,REPRTM ;YES, SO REMEMBER IT
CAMG A,REPTIM ;WAS THIS FILE WRITTEN RECENTLY?
JRST REPFL2 ;NO
XTMSG <*[DATE: File >
CALL TTYLCK
MOVE A,TTYPNT ;OUTPUT FILENAME TO TTY BUFFER
HRRZ B,REPJFN ;PRINT THE CURRENT FILE OF THE SET
MOVX C,JMAGIC ;PRINT ALL FIELDS
JFNS
MOVEM A,TTYPNT ;STORE UPDATED POINTER
CALL TTYULK
XTMSG < written by >
CALL TTYLCK
HRR A,REPJFN ;PREPARE TO GET USER NAME
HRLI A,.GFLWR ;WE WANT LAST WRITER
MOVE B,TTYPNT ;POINTER TO WHERE TO WRITE STRING
GFUST ;GET WRITER STRING
MOVEM B,TTYPNT ;REMEMBER UPDATED TTY POINTER
CALL TTYULK
XTMSG < at >
CALL TTYLCK
MOVE A,TTYPNT ;OUTPUT TIME TO TTY BUFFER
MOVE B,REPFTM ;GET THIS FILE'S WRITE TIME
MOVEI C,0 ;STANDARD FORMAT
ODTIM ;OUTPUT THE TIME
MOVEM A,TTYPNT ;REMEMBER UPDATED POINTER
CALL TTYULK
XTMSG <]
>
REPFL2: MOVE A,REPJFN ;GET THE JFN
GNJFN ;STEP TO THE NEXT FILE
CAIA ;IF IT FAILS, ASSUME NO MORE FILES
JRST REPFL1
MOVE A,REPRTM ;RETURN MOST RECENT TIME SEEN
RET
;CHECK FOR GRUMPS...
GRUMPS: SKIPE GRUMPF ;DO NOTHING IF USER NOT LOOKING AT GRUMPS
SKIPE GRERRF ;ERRORS?
RET ;YES, GIVE UP
HRROI A,[ASCIZ /Grumps/]
MOVEM A,BUSYF ;SHOW THAT WE'RE PROCESSING GRUMPS
MOVEI A,GRJFN ;SAY WHERE JFN LIVES
MOVEI B,GRSIZE ;SAY WHERE SIZE LIVES
CALLRET PRE ;DO THE PREVIEWING
;CHECK FOR NEW MAIL
NEWMAL: SKIPE MAILF ;NOTHING TO DO IF USER NOT PREVIEWING MAIL
SKIPE GRERRF ;ERRORS?
RET ;YES, GIVE UP
HRROI A,[ASCIZ /Mail/] ;SAY WE'RE EXAMINING MAIL
MOVEM A,BUSYF
MOVEI A,MALJFN ;CELL FOR MAIL FILE JFN
MOVEI B,MALSIZ ;CELL FOR MAILFILE SIZE
CALL PRE ;SEE IF NEW MAIL
MOVEI A,SMJFN ;DO SYSTEM MAIL IN SAME WAY
MOVEI B,SMSIZ
CALLRET PRE
;ROUTINE TO PREVIEW A FILE. GIVE IT ADDRESS OF WORD HOLDING JFN IN A, AND
;ADDRESS OF WORD HOLDING OLD SIZE IN B.
PRE: TRVAR <DGRMPF,PREJFN,PRESIZ,GRADJ,DMAILF,DSMF>
MOVEM A,PREJFN
MOVEM B,PRESIZ
SETZM DMAILF ;FIRST ASSUME DOING GRUMPS
CAIN A,MALJFN ;DOING MAIL?
SETOM DMAILF ;YES, REMEMBER.
SETZM DSMF ;INITIALLY NOT DOING SYSTEM MAIL
CAIN A,SMJFN ;DOING SYSTEM MAIL?
SETOM DSMF ;YES
SETZM DGRMPF ;INITIALLY NOT DOING GRUMPS
CAIN A,GRJFN ;DOING GRUMPS?
SETOM DGRMPF ;YES, REMEMBER SO
SETZM GEOFDA ;NO SPECIAL EOF ADDRESS YET
SKIPN A,@PREJFN ;HAVE A JFN ON GRUMP FILE YET?
JRST [ HRROI A,[ASCIZ /PS:[REMARKS]GRUMP.LOG/]
SKIPE DMAILF
HRROI A,MALSPC ;DIFFERENT FILENAME FOR MAIL PREVIEWING
SKIPE DSMF ;DOING SYSTEM MAIL?
HRROI A,[ASCIZ /SYSTEM:MAIL.TXT.1/]
CALL GETFSZ ;NO, GET ONE AND ITS SIZE
JRST [ SETZM @PRESIZ ;FILE GONE, CLEAR SIZE SO NEW FILE GETS DISPLAYED
RET]
MOVEM A,@PREJFN ;REMEMBER NEW JFN
JRST PRE1] ;FILE THERE, GO DISPLAY IF JUST CREATED
CALL GETFSZ ;ALREADY HAVE GRUMP JFN, GET ITS SIZE
JRST [ MOVE A,@PREJFN ;FAILED, FILE PROBABLY EXPUNGED.
RLJFN ;SO RELEASE HANDLE ON OLD COPY
JSERR ;REPORT ERROR IF UNEXPECTED RELEASE FAILURE.
SETZM @PREJFN ;CLEAR CELL, SO INITIALIZED AGAIN NEXT TIME
SETZM @PRESIZ ;MAKE SO NEW FILE WILL BE SEEN
RET] ;DONE UNTIL NEXT CYCLE
PRE1: CAMN B,@PRESIZ ;DIFFERENT THAN LAST TIME WE LOOKED?
RET ;NO, NOTHING TO DO
EXCH B,@PRESIZ ;SAVE NEW SIZE, GET OLD SIZE
CAML B,@PRESIZ ;MAKE SURE OLD IS LESS THAN NEW
RET ;FILE SHRUNK, SO DON'T ANNOUNCE ANYTHING NOW
MOVEM B,OGRSIZ ;STORE OLD SIZE
SKIPN DMAILF ;DOING REGULAR MAIL?
JRST PRE2 ;NO, SO DON'T WORRY WHAT USER IS RUNNING
GETNM ;GET CURRENT PROGRAM NAME
CAMN A,[SIXBIT /MS/] ;IS USER READING HER MAIL?
RET ;YES, SO DON'T DISPLAY THIS NEW MESSAGE
MOVE A,@PREJFN ;RESTORE JFN THAT GETNM CLOBBERED
PRE2: MOVX B,OF%RD!OF%PDT ;DON'T MESS UP ACCESS DATES OF MAIL.TXT
OPENF
RET ;FAILED, FILE PROBABLY CLEANED OUT BY OPERATOR.
SETOM GRPGN ;GUARANTEE THAT FIRST PAGE CAUSES A PMAP
FFFFP ;GET NUMBER OF PAGES (FB%PGC MIGHT LIE!)
TRNN A,-1 ;ANY PAGES IN FILE?
JRST GDONE ;NO, RETURN IMMEDIATELY
MOVE B,@PRESIZ ;GET NUMBER OF BYTES
IDIVI B,5000 ;GET NUMBER OF CHARACTERS ON LAST PAGE
CAIN C,0 ;IF REMAINDER IS 0,
MOVEI C,5000 ;THEN LAST PAGE IS COMPLETELY FULL
IDIVI C,5 ;CALCULATE FINAL BYTE POINTER IN FILE
ADD C,BTAB(D)
MOVEM C,EOG ;REMEMBER BYTE POINTER TO END OF GRUMP
HRRZI A,-1(A) ;GET HIGHEST PAGE NUMBER IN A
MOVEM A,LPIG ;REMEMBER LAST PAGE IN GRUMP
SETZM BACKF ;READ FORWARDS
MOVEI A,[ MOVE P,GPP ;CODE FOR EOF, RESTORE STACK
JRST G1] ;FINISH GRUMP
MOVEM A,GEOFDA ;SAY WHERE TO GO ON END OF FILE
MOVEM P,GPP ;REMEMBER STACK LEVEL
SETZM BACKF ;NOW READ GRUMP FORWARD
MOVE A,OGRSIZ ;GET OLD SIZE IN BYTES
IDIVI A,5000 ;FIGURE OUT FIRST PAGE TO LOOK AT
MOVEM B,GRADJ ;REMEMBER ADJUSTMENT FOR PROPER LOCATION
CALL GRMAP ;SET POINTER TO CORRECT SPOT
MOVE A,GRADJ ;GET ADJUSTMENT
ADJBP A,GRPTR ;STEP TO CORRECT PLACE ON PAGE
MOVEM A,GRPTR ;STORE UPDATED POINTER
XTMSG <*> ;MARK BEGINNING
SKIPN DSMF ;FOR SYSTEM MAIL, NOTHING TO LOOK FOR
SKIPE DMAILF ;DOING MAIL-PREVIEWING?
JRST GTYPE ;YES, JUST GO OUTPUT THE MAIL
GNXT: CALL SGBEG ;FIND BEGINNING OF GRUMP
SETZM BACKF ;READ FORWARDS (AGAIN)
XTMSG <[Grump by user >
GRU1: CALL GCHAR ;GET A CHARACTER
CAIN A,12 ;LINEFEED?
JRST GRU2 ;YES, END OF LINE
CALL CHAR ;OUTPUT IT
JRST GRU1
GRU2: CALL CHAR ;FINISH THE LINE
CALL FGRUMP ;FIND THE GRUMP ITSELF
GTYPE: CALL GCHAR ;READ CHARACTER OF GRUMP ITSELF
SKIPE DGRMPF ;DOING A GRUMP?
CAIE A,.CHFFD ;FORM FEED, MARKS END OF GRUMP BUT NOT MAIL
CAIA ;GET REST OF MESSAGE, ASSUME ENDS AT END OF FILE
JRST GNXT ;END OF GRUMP, MAYBE MORE
CALL CHAR ;OUTPUT CHARACTER TO TERMINAL
JRST GTYPE ;LOOP UNTIL END OF MESSAGE
G1: SKIPN DGRMPF ;NO CLOSING BRACKET FOR MAIL
JRST GDONE
XTMSG <]
>
GDONE: HRROI A,-1 ;WE WANT TO CLEAR MAPPED CORE PAGES
MOVE B,[.FHSLF,,GRBPN]
MOVEI C,0 ;DOES C MATTER?
PMAP
MOVE A,@PREJFN
TXO A,CO%NRJ ;WE DON'T WANT TO RELEASE THE JFN!!
CLOSF ;CLOSE THE GRUMP FILE
ERJMP NOGRMP
RET ;ALL DONE
BUGX: SKIPN BUGCHF ;ALLOWED TO CHECK FOR BUGCHKS?
RET ;USER DOESN'T CARE ABOUT BUGCHKS
HRROI A,[ASCIZ /Bugchks/]
MOVEM A,BUSYF ;SHOW WHAT WE'RE DOING
CALL SERINI ;GET JFN ON ERROR.SYS FILE
RET ;NOT THERE YET
CAMN B,SERDAT ;HAS FILE BEEN RECENTLY WRITTEN?
RET ;NO
MOVEM B,SERDAT ;YES, REMEMBER LATEST WRITE-DATE
MOVEI B,2B17/^D<60*60*24> ;TWO SECONDS IN INTERNAL FORMAT
;SYSERR SEEMS TO INSIST ON REPORTING AN ENTRY UNLESS
;YOU ASK IT TO BEGIN TWO SECONDS BEYOND THE ENTRY
ADD B,LSTBUG ;START NEXT PRINTOUT TWO SECONDS BEYOND PREVIOUS
MOVEI A,0 ;SAY WE WANT BUGCHKS
CALL REPBUG ;GO REPORT ANY RECENT BUGCHKS
CAIE A,0 ;DON'T UPDATE IF NO BUGS REPORTED
MOVEM A,LSTBUG ;REMEMBER TIMESTAMP OF LAST ONE DISPLAYED
RET
;GET JFN ON ERROR.SYS
GETSYS: HRROI A,[ASCIZ /SERR:ERROR.SYS/]
CALL WRTDAT
RET ;FAILED
HRLOI C,377777 ;GET PAGE NUMBER GUARANTEED TOO HIGH
MOVEM C,OGPAG ;FORCE NON-GUESS FIRST TIME THROUGH
RETSKP ;SUCCESS
;INITIALIZE STUFF ABOUT ERROR.SYS
SERINI: SKIPN A,SERJFN ;HAVE A HANDLE ON ERROR.SYS YET?
JRST [ CALL GETSYS ;GET JFN
RET ;FAILED
MOVEM B,SERDAT ;REMEMBER INITIAL DATE AND TIME
MOVEM A,SERJFN ;REMEMBER JFN
MOVEM B,LSTBUG ;PRETEND LAST BUG WAS LAST TIME FILE WAS WRITTEN
RET] ;NOTHING TO COMPARE NOW
CALL WRTDAT ;SEE WHEN IT WAS LAST WRITTEN
JRST [ SETZM SERJFN ;IF FAILS, FORCE THE GTJFN TO BE DONE AGAIN
RET] ;BUT NOT TILL NEXT TIME THROUGH!!
RETSKP
;ROUTINE TO EXECUTE CONTENTS OF DATE.CMD ON LOGIN DIRECTORY
NEWCMD: STKVAR <<CMDSPC,100>,CMDJFN,SAVIOJ>
CALL CMDINI ;INITIALIZE FOR COMND JSYS
HRROI A,-1 ;CURRENT JOB
HRROI B,C ;PUT DIRECTORY NUMBER IN C
MOVEI C,.JILNO ;LOGIN DIRECTORY NUMBER
GETJI
ERCAL JSBOMB ;SHOULDN'T FAIL
MOVE B,C ;DIRECTORY NUMBER IN B
MOVEM B,LOGNO ;REMEMBER OUR LOGIN DIRECTORY NUMBER
HRROI A,CMDSPC
DIRST ;START FORMING FILESPEC TO LOGIN DIRECTORY
ERCAL JSBOMB ;SHOULD ALWAYS SUCCEED
HRROI B,[ASCIZ /DATE.CMD/] ;WE WANT DATE.CMD ON LOGIN DIRECTORY
MOVEI C,0 ;STOP ON NULL
SOUT ;FINISH CREATING NAME
HRROI A,CMDSPC ;POINT TO THE FILESPEC
CALL GETFSZ ;GET JFN (IN A SLY WAY!)
RET ;NO DATE.CMD
MOVEM A,CMDJFN ;REMEMBER JFN OF COMMAND FILE
MOVE B,[70000,,OF%RD] ;OPEN FOR READING
OPENF ;OPEN COMMAND FILE
ERJMP [ JSERR ;FAILED, SAY WHY
MOVE A,CMDJFN
RLJFN ;RELEASE JFN
JFCL ;IGNORE FAILURE
RET]
MOVE B,.CMIOJ+SBK ;GET OLD STREAM
HRL A,A ;SET INPUT JFN TO DATE.CMD
HRRI A,377777 ;NO EDITING JFN
MOVEM A,.CMIOJ+SBK ;SAVE NEW STREAM
MOVEM B,SAVIOJ ;REMEMBER OLD STREAM
CMLUP: CALL DOCMD ;DO A COMMAND FROM THE FILE
CAIA ;FAILED
JRST CMLUP ;SUCCEEDED, DO REST
MOVEI A,.FHSLF
GETER ;FAILED, PROBABLY END OF FILE
CAME B,[.FHSLF,,IOX4] ;END OF FILE?
JRST [ CALL CMDER1 ;NO, PRINT ERRR
JRST CMLUP] ;DO REST OF COMMANDS
MOVE A,CMDJFN
CLOSF ;CLOSE IT
JSERR ;SHOULDN'T EVER FAIL
MOVE A,SAVIOJ
MOVEM A,.CMIOJ+SBK ;RESTORE COMMAND JFNS (PROBABLY BACK TO TERMINAL)
RET
;ROUTINE TO REPORT SPYERS
SPYERS: SKIPE SPYF ;DON'T CHECK IF USER SAID NOT TO
SKIPE SPYERF ;ERRORS ALREADY?
RET ;YES SO GIVE UP NOW
HRROI A,[ASCIZ /Spyers/]
MOVEM A,BUSYF ;SAY WHAT WE'RE DOING
CALL GOBSYM ;GET VALUES FOR VARIOUS MONITOR SYMBOLS
JRST NOSPY ;FAILED, TELL USER WHY
CALL GETLIN ;GET OUR LINE NUMBER
CAMN A,[-1] ;DETACHED?
RET ;YES, NOTHING TO REPORT
ADD A,TTACTL ;GET MON ADDRESS HOLDING TTY TABLE ADDRESS
CALL MPEEK ;GET TTY TABLE ADDRESS
JRST NOSPY
ADD B,TTLINK ;GET MON ADDRESS HOLDING LINK DATA
MOVE A,B ;GET ADDRESS IN MONITOR
CALL MPEEK ;SEE WHO'S SPYING
ERCAL JSBOMB ;CAN'T!
CAMN B,OLDSPY ;ANYONE DIFFERENT THAN LAST TIME?
RET ;NO, DONE
MOVE P1,B ;SAVE NEW STATE OF SPYERS
MOVSI P2,-4 ;PREPARE TO COMPARE 4 BYTES
MOVE P3,[441100,,P1] ;POINTER TO NEW STATUS
MOVE P4,[441100,,OLDSPY];POINTER TO OLD STATUS
SLUP: ILDB A,P3 ;GET NEW BYTE
ILDB B,P4 ;GET OLD
CAMN A,B ;A CHANGE?
JRST SLUP1 ;NO
CAIE A,777 ;NEW ONE A NONTERMINAL?
CALL ARRIVE ;NO, IS A TERMINAL!
LDB A,P3 ;GET NEW AGAIN
CAIN A,777 ;IF A NONTERMINAL
CALL LEAVE ;SAY WHO LEFT
SLUP1: AOBJN P2,SLUP ;DO ALL FOUR BYTES
MOVEM P1,OLDSPY ;SAVE STATUS FOR NEXT INTERRUPT
RET
;ROUTINE TO UPDATE JOB RUNTIME TABLE.
RUPDAT: STKVAR <HMJ,HM,JOBPRV,MAXRTM,MAXRJN>
MOVN P1,JTLEN ;GET NEGATIVE OF LENGTH OF TABLE
HRLZ P1,P1 ;MAKE AOBJN POINTER
CALL PIOFF ;LOCK TOTRUN SO ^D DOESN'T PRINT INCONSISTENT DATA
HRROI A,[ASCIZ /Percentages/]
MOVEM A,BUSYF ;SAY WHAT WE'RE DOING
SETZM TOTRUN ;INITIALIZE TOTAL RUNTIME
SETZM MAXRTM ;MAXIMUM RUNTIME INTERVAL SEEN
JUP: HRRZ A,P1 ;GET JOB NUMBER
CALL RUNTIM ;GET ITS TOTAL RUNTIME
EXCH A,OLDRUN(P1) ;SAVE TOTAL RUNTIME, GET OLD TOTAL
SUB A,OLDRUN(P1) ;GET AMOUNT USED IN TIME INT THAT JUST ENDED
MOVNM A,JRINTB(P1) ;REMEMBER HOW MUCH THIS JOB RAN IN LAST INTERVAL
SKIPGE OLDRUN(P1) ;DOES THIS JOB REALLY EXIST??
SETZM JRINTB(P1) ;NO, SO IT HASN'T USED ANY TIME IN LAST INTERVAL
MOVE A,JRINTB(P1) ;GET RUNTIME DURING THIS SECTION
CAML A,MAXRTM ;NEW MAXIMUM RUNTIME?
JRST [ HRRZM P1,MAXRJN ;YES, REMEMBER WHICH JOB HAS MAXIMUM RUNTIME
MOVEM A,MAXRTM ;REMEMBER NEW MAXIMUM RUNTIME
JRST .+1]
ADDM A,TOTRUN ;ACCUMULATE TOTAL
AOBJN P1,JUP ;UPDATE DATA FOR ALL JOBS
FLTR A,TOTRUN ;GET FLOATING VERSION OF TOTAL RUNTIME
MOVEM A,TOTRUN
CALL PION ;UNLOCK TOTRUN
SKIPN HOGERF ;ERRORS DETECTED CHECKING FOR HOGGERS?
SKIPN HOGF ;CHECKING FOR HOGGERS?
RET ;NOT CHECKING, OR ERRORS DETECTED
HRROI A,[ASCIZ /Hoggers/] ;SAY WHAT WE'RE CALCULATING
MOVEM A,BUSYF
CALL GOBSYM ;GET VALUES FOR VARIOUS MONITOR SYMBOLS
JRST [ SETOM HOGERF ;REMEMBER THAT FAILURE REPORTING HOGS
TYPE <
%DATE: Won't be able to check for hoggers - >
CALLRET PERR] ;SAY WHY AND RETURN
MOVEI A,HMX ;PERHAPS THIS JOB HAS ALREADY BEEN ANNOUNCED
CP6: SOJL A,CP7 ;NO IF CAN'T FIND IT
SKIPGE B,HOGLST(A) ;FIND A USED ENTRY?
JRST CP6 ;NO, LOOK AT REST OF TABLE
CAME B,MAXRJN ;YES, IS IT CURRENT JOB?
JRST CP6 ;NO
CP8: SETOM MAXRJN ;YES, ALREADY RECORDED, JUST CHECK FOR UNHOGS
JRST CP2
CP7: MOVE A,MAXRJN ;GET JOB NUMBER
CALL SKPINU ;DO WE CARE ABOUT THIS USER?
JRST CP8 ;NO
MOVE A,MAXRJN ;GET JOB NUMBER
CALL SKPPRI ;CHECK FOR SPECIAL PRIORITY JOB
JRST CP8 ;NO, CHECK FOR UNHOGGERS
MOVEM A,JOBPRV ;REMEMBER PRIVILEGE WORD
LOAD A,LQP1,JOBPRV ;GET ONE PLUS LOW QUEUE
CAILE A,3 ;CRUDE CHECK TO IGNORE "BATCH BACKGROUND"
JRST CP8 ;DON'T CONFUSE BATCH BACKGROUND WITH HIGHLY PRIVILEGED
XTMSG <*Job >
MOVE A,MAXRJN ;GET JOB NUMBER
MOVEI B,5+5 ;PRINT IN DECIMAL
CALL NUM ;ANNOUNCE WHICH JOB
XTMSG <, user >
MOVE A,MAXRJN ;GET JOB NUMBER
CALL PNAME ;PRINT USER NAME
MOVE B,MAXRJN ;GET JOB AGAIN
XTMSG < is hogging the system by >
LOAD A,PERCNT,JOBPRV ;GET PERCENTAGE BEING DEMANDED
CAIN A,0 ;SEE WHICH TYPE OF SERVICE BEING FORCED
JRST [ XTMSG <staying above scheduler queue >
LOAD A,LQP1,JOBPRV ;GET ONE PLUS LOW QUEUE
MOVEI B,5+5 ;PRINT IN DECIMAL
CALL NUM
XTMSG <!
>
JRST CP2]
XTMSG <demanding >
LOAD A,PERCNT,JOBPRV ;GET PERCENTAGE
MOVEI B,5+5 ;PRINT IN DECIMAL
CALL NUM
XTMSG <% of the CPU!
>
CP2: MOVEI A,HMX ;SCAN LIST OF HOGS TO ADD THIS GUY TO LIST
MOVEM A,HM
CP3: SOSGE A,HM ;SCAN LIST
RET ;NO ROOM ON LIST, OR DONE!
SKIPL B,HOGLST(A) ;FREE SLOT?
JRST CP4 ;NO, BUT MAYBE WE CAN FREE IT UP
CP5: MOVE B,MAXRJN ;YES, ADD THIS JOB TO THE LIST
MOVEM B,HOGLST(A)
SETOM MAXRJN ;PREVENT ENTRY FROM BEING MADE TWICE
JRST CP3 ;CONTINUE TO SCAN TO REMOVE NONHOGS
CP4: MOVE A,B ;PUT JOB NUMBER IN A OF OLD HOG
CALL SKPPRI ;IS THIS GUY STILL A HOG?
CAIA ;NO, ANNOUNCE HE'S NOT
JRST CP3 ;YES, CAN'T CLEAR HIS SLOT YET
MOVE B,HM ;GET SLOT OF GUY WHO'S NO LONGER HOGGING
MOVE A,HOGLST(B) ;GET JOB NUMBER
MOVEM A,HMJ ;REMEMBER JOB NUMBER
SETOM HOGLST(B) ;FREE UP THE SLOT
CALL SKPINU ;IS THIS USER INCLUDED?
JRST CP3 ;NO, SO SKIP ANNOUNCEMENT
XTMSG <*Job >
MOVE B,HM ;GET SLOT OF GUY WHO'S NO LONGER HOGGING
MOVE A,HMJ ;GET JOB NUMBER
MOVEI B,5+5 ;PRINT IN DECIMAL
CALL NUM ;BETTER NOT PRINT USER NAME BECAUSE MAY BE DIFFERENT OR NONEXISTENT!
XTMSG < is no longer hogging the system.
>
MOVE A,HM ;GET SLOT WE'RE USING
JRST CP5 ;GO USE THIS SLOT FOR THE NEW GUY
IFG NUFKS-^D35,<printx ?PRINTX: This program won't run with NUFKS .GT. 35.>
;ROUTINE WHICH INVESTIGATES THE JOB WHOSE NUMBER IS IN A TO SEE
;IF IT HAS JUST STARTED OR STOPPED HOGGING THE SYSTEM (A LA JOBBIT IN
;PSB DATABASE)
;THIS ROUTINE SKIPS IF JOB IS HOGGING THE SYSTEM, YIELDING THE PRIVILEGED
;SCHEDULER WORD IN A, AND THE FORK NUMBER IN B. B WILL CONTAIN -1 IF JOBSKD
;IS THE OFFENDER AS OPPOSED TO A PARTICULAR FORK
SKPPRI: TRVAR <WCHJOB,NCFK,PRVWRD>
MOVEM A,WCHJOB ;REMEMBER WHICH JOB WE'RE DOING
SKIPE WCHJOB ;DON'T BITCH ABOUT JOB 0
SKIPN INITF ;DO WE HAVE MONITOR SYMBOLS YET?
RET ;NO, SO CAN'T CHECK FOR HOGS YET
MOVEI A,NUFKS+1 ;NUMBER OF FORKS TO CHECK, +1 FOR JOB WORD TOO
MOVEM A,NCFK
CP1: SOSGE A,NCFK ;STEP TO NEXT FORK OF JOB
RET ;NO MORE FORKS, JOB IS NOT A HOG
CALL GETPRI ;GET PRIVILEGE WORD FOR THIS FORK
JRST CP1 ;FORK DOESN'T EXIST
MOVEM A,PRVWRD ;REMEMBER PRIVILEGE WORD IN CASE THIS IS A HOG
CALL SKPHOG ;SKIP IF THIS FORK IS A HOG
JRST CP1 ;NOT A HOG
MOVE A,PRVWRD ;HE'S A HOG, GET PRIVILEGE WORD
MOVE B,NCFK ;GET FORK NUMBER
CAIN B,NUFKS ;MAIN JOB RATHER THAN SPECIFIC FORK?
HRROI B,-1 ;YES, SO RETURN -1
RETSKP ;SKIP TO ANNOUNCE THIS GUY'S A HOG
;SKPHOG INTERPRETS JOBBIT WORD IN A, AND SKIPS IF THIS JOBBIT WORD
;REPRESENTS ONE FOR A FORK WHICH IS USING SPECIAL SCHEDULER QUEUES
SKPHOG: TXNE A,PERCNT!LQP1 ;CHECK FOR SPECIAL PRIVS
RETSKP ;NON-0 MEANS HE IS
RET ;NO
;GET JOBBIT WORD FOR FORK IN A OF JOB IN WCHJOB
;
;ACCEPTS: A/ FORK NUMBER (0 - NUFKS-1), OR NUFKS TO READ JOBSKD
; WCHJOB/ JOB NUMBER
;
;RETURNS: +1 NO SUCH FORK OR NO SUCH JOB OR OTHER ERROR
; +2 FORK EXISTS, JOBBIT WORD IN A
GETPRI: STKVAR <FN>
MOVEM A,FN ;REMEMBER WHICH FORK
MOVE C,A ;SAY WHICH WORD OF FORK TABLE
MOVEI B,SYSFK ;SAY WHICH TABLE
CAIN A,NUFKS ;READING JOB'S WORD?
JRST [ MOVEI B,JOBSKD ;YES, SPECIFY IT
MOVE A,WCHJOB ;SAY WHICH JOB TO EXAMINE
MOVEI C,0 ;NO OFFSET
CALL REDJOB ;GET JOB'S JOBSKD WORD
RET ;JOB DOESN'T EXIST
RETSKP] ;RETURN JOBSKD WORD
MOVE A,WCHJOB ;SAY WHICH JOB
CALL REDJOB ;READ SYSTEM FORK INDEX
RET ;JOB DOESN'T EXIST, PROBABLY
JUMPL A,R ;NO SUCH FORK IF NEGATIVE
HRRZ A,A ;KEEP ONLY THE FORK NUMBER
MOVEI B,JOBBIT ;NOW WE'LL READ SCHEDULER WORD OF THAT FORK
MOVEI C,0 ;IT'S NOT A TABLE, SO OFFSET OF 0
CALL REDFRK
RET ;FAILED, GIVE NON-SKIP RETURN (NO SUCH FORK)
RETSKP ;SKIP WITH PRIORITY WORD IN A
;REDFRK READS A WORD FROM PSB
;
;ACCEPTS: A/ FORK #
; B/ TABLE
; C/ OFFSET
;RETURNS: +1 FAILURE, NO SUCH FORK OR OTHER FAILURE
; +2 SUCCESS, DATA IN A
REDFRK: MOVEI D,.RDPSB ;SAY TO READ PSB
CALLRET REDDAT
;REDJSB READS A WORD FROM THE JSB
;
;ACCEPTS: A/ JOB #
; B/ WORD IN JSB TO READ
;
;RETURNS: +1 FAILURE, SUCH AS NO SUCH JOB OR MONRD FAILURE
; +2 SUCCESS, WORD CONTENTS IN A
REDJSB: MOVE D,A ;JOB NUMBER IN D FOR MONRD
MOVEI A,.RDJSB ;READ FROM JSB
MOVE C,B ;MONRD WANTS ADDRESS IN C
MOVEI B,0 ;NO SPECIAL SYMBOL
CALL DMONRD ;DO THE MONRD JSYS
RET ;SINGLE RETURN IF ERROR
MOVE A,B ;RETURN DATA IN A
RETSKP ;SKIP IF SUCCESS
;REDJOB READS WORD FROM JSB, WHEN SYMBOL NAME KNOWN
;
;ACCEPTS: A/ JOB #
; B/ TABLE TO READ (MORE EXPLANATION NEEDED HERE!)
; C/ OFFSET
;RETURNS: +1 FAILURE, NO SUCH JOB, OR MONRD DOESN'T EXIST
; +2 SUCCESS, DATA IN A
REDJOB: MOVEI D,.RDJSB ;SAY READING FROM JSB
CALLRET REDDAT ;GO READ DATA
;REDDAT READS DATA FROM JSB OR PSB
;
;ACCEPTS: A/ JOB OR FORK #
; B/ TABLE POINTER
; C/ OFFSET INTO TABLE
; D/ MONRD FUNCTION CODE
;RETURNS +1 FAILURE
; +2 SUCCESS, DATA WORD IN A
REDDAT: STKVAR <JN,TABL,OST,MFC>
MOVEM A,JN
MOVEM B,TABL
MOVEM C,OST
MOVEM D,MFC ;REMEMBER MONRD FUNCTION CODE
MOVE B,[SIXBIT /JSVAR/] ;FIRST ASSUME READING JSB VARIABLE
MOVE D,JSVAR ;GET MONITOR VALUE OF "JSVAR"
MOVE A,MFC ;GET FUNCTION CODE
CAIN A,.RDPSB ;READING FROM PSB??
JRST [ MOVE B,[SIXBIT /PSVAR/] ;YES, DIFFERENT OFFSETS
MOVE D,PSVAR
JRST .+1]
SUB D,@TABL ;GET OFFSET FROM DATABASE TO SYMBOL WE WANT
MOVN C,D ;GET POSITIVE OFFSET
ADD C,OST ;CREATE DESIRED OFFSET INTO TABLE
MOVE D,JN ;SAY WHICH JOB OR FORK WE'RE READING
MOVE A,MFC ;GET FUNCTION CODE
CALL DMONRD ;DO THE MONRD JSYS
RET ;FAILED, TELL CALLER
MOVE A,B ;RETURN DATA IN A
RETSKP
;DMONRD DOES THE MONRD JSYS. IT SKIPS IF SUCCESSFUL
DMONRD: MONRD% ;DO THE MONRD
ERJMP R ;DON'T SKIP IF JSYS FAILS
JUMPE A,RSKP ;SKIP IF SUCCESSFUL
RET
;ROUTINE TO RETURN RUNTIME FOR JOB. GIVE IT JOB NUMBER IN A.
RUNTIM: HRL A,A ;JOB NUMBER IN LEFT HALF
HRRI A,.JOBRT ;SPECIFY THAT WE WANT RUNTIME
GETAB ;GET THE RUNTIME
JSERR
RET
;get here when some jsys critical in the grump checking system
;fails. this routine tests a flag, so we don't get a million
;errors for the same reason.
nogrmp: SETOM GRERRF ;SAY THERE'S BEEN ERRORS
TMSG <
%DATE: Won't be able to type grumps or mail
>
CALLRET PERR ;GO SAY WHY AND RETURN
;ROUTINE TO SEARCH FORWARD THROUGH GRUMP FILE FOR THE GRUMP ITSELF,
;IDENTIFIED BY THE LINE AFTER THE ONE ENDING WITH "INFORMATION:<CRLF>"
FGRUMP: SETZM BACKF ;WE WANT TO SEARCH FORWARDS
FR1: CALL GCHARU ;GET CHARACTER FROM FILE
FG1: CAIE A,"I" ;WHAT WE'RE LOOKING FOR?
JRST FR1 ;NO, CHECK NEXT
CALL GCHARU ;YES, GET NEXT
FG2: CAIE A,"N"
JRST FG1
CALL GCHARU
CAIE A,"F"
JRST FG1
CALL GCHARU
CAIE A,"O"
JRST FG1
CALL GCHARU
CAIE A,"R"
JRST FG1
CALL GCHARU
CAIE A,"M"
JRST FG1
CALL GCHARU
CAIE A,"A"
JRST FG1
CALL GCHARU
CAIE A,"T"
JRST FG1
CALL GCHARU
CAIE A,"I"
JRST FR1 ;DON'T CHECK "I" TWICE!
CALL GCHARU
CAIE A,"O"
JRST FG2 ;MIGHT BE "IN..."
CALL GCHARU
CAIE A,"N"
JRST FG1
CALL GCHARU
CAIE A,":"
JRST FG1
CALL GCHARU
CAIE A,15
JRST FG1
CALL GCHARU
CAIE A,12
JRST FG1
RET ;FOUND "INFORMATION:<CRLF>"
;ROUTINE TO SEARCH THROUGH THE GRUMP FILE, LOOKING FOR
;THE USER NAME WHO SUBMITTED THE GRUMP. IT ASSUMES THAT THE USER NAME
;STARTS WITH THE FIRST NON-SPACE, NON-TAB AFTER THE STRING "FROM:"
SGBEG: CALL GCHAR ;GET A CHARACTER
SG1: CAIE A,"F" ;FOUND F?
JRST SGBEG ;NO, KEEP LOOKING
CALL GCHARU ;YES, CHECK NEXT
CAIE A,"R" ;AN R?
JRST SG1 ;NO, MAYBE F
CALL GCHARU ;YES, LOOK AT NEXT
CAIE A,"O" ;O?
JRST SG1 ;NO, MAYBE F
CALL GCHARU
CAIE A,"M"
JRST SG1
CALL GCHARU
CAIE A,":"
JRST SG1
SG2: CALL GCHAR ;GET CHARACTERS AFTER "FROM:"
CAIE A,11
CAIN A,40
JRST SG2 ;LOOP UNTIL NON-SPACE SEEN
SETOM BACKF ;GO BACKWARDS ONE CHARACTER SO FIRST USER NAME CHARACTER CAN BE REREAD
CALLRET GCHAR ;BACK UP
;ROUTINE TO READ IN PAGE FROM GRUMP FILE. PASS IT PAGE NUMBER IN A.
;THIS ROUTINE USES BACKF TO DECIDE WHETHER TO RESET BYTE POINTER TO
;BEGINNING OR END OF PAGE, ALWAYS SUCH THAT ILDB RETRIEVES NEXT CHARACTER
;DESIRED
GRMAP: CAMN A,GRPGN ;MAYBE PAGE IS ALREADY MAPPED
JRST GRM1 ;YESSIR!
MOVEM A,GRPGN ;REMEMBER WHICH PAGE WE'RE MAPPING IN
HRL A,@PREJFN ;MAKE PAGE HANDLE TO FILE
MOVE B,[.FHSLF,,GRBPN] ;MAP INTO OURSELF, GRUMP BUFFER PAGE NUMBER
MOVX C,PM%CPY ;ALLOW BLT INTO THIS PAGE
PMAP ;MAP IN THE PAGE
GRM1: MOVE A,[100700,,GRBPAG+777] ;POINT TO LAST CHARACTER ON PAGE
SKIPN BACKF
MOVE A,[010700,,GRBPAG-1] ;DIFFERENT POINTER IF READING FORWARD
MOVEM A,GRPTR ;INITIALIZE POINTER TO DATA
RET
;TABLE OF BYTE POINTERS FOR TRANSLATING FROM BYTE ADDRESS TO BYTE POINTER
BTAB: 010700,,GRBPAG-1 ;EXACT MULTIPLE OF FIVE CHARACTERS
350700,,GRBPAG ;ONE LESS THAN MULTIPLE OF FIVE
260700,,GRBPAG
170700,,GRBPAG
100700,,GRBPAG
;ROUTINE TO READ NEXT CHARACTER FROM GRUMP FILE. MAKES ALL LETTERS
;UPPERCASE
;USES BACKF TO DECIDE WHETHER TO READ FORWARD OR BACKWARD.
;IT RETURNS B0 ON IFF END (OR BEGINNING) OF FILE SURPASSED, IF GEOFDA IS 0.
;IF GEOFDA IS NON-0, EOF TRANSFERS TO CONTENTS OF GEOFDA
GCHARU: CALL GCHAR ;GET CHARACTER
CAIL A,141
CAILE A,172
RET
TRZ A,40 ;MAKE UPPERCASE
RET
;SAME AS ABOVE BUT RETURN CHARACTER AS IS (DON'T RAISE)
GCHAR: SKIPE BACKF ;MAKE SURE READING FORWARD
JRST GC1 ;NO, BACKWARD!
MOVE A,GRPTR ;MAKE SURE WE'RE NOT AT END OF PAGE
CAMN A,EOG ;ARE WE AT END OF GRUMP?
JRST GEOF1 ;YES, MAYBE
GC5: CAMN A,[010700,,GRBPAG+777]
JRST GC2 ;WE ARE AT END OF PAGE!
GC3: ILDB A,GRPTR
RET
;HERE WHEN HIT END OF PAGE READING FORWARD
GC2: MOVE A,GRPGN ;STEP TO NEXT PAGE
AOJ A,
CAMLE A,LPIG ;WITHIN RANGE OF PAGES?
JRST GEOF ;NO, SOMEONE PROBABLY GOT "OVER QUOTA" WHILE SENDING A GRUMP!
CALL GRMAP ;MAP PAGE IN
JRST GC3 ;GO BACK AND READ CHARACTER
;HERE WHEN READING BACKWARDS
GC1: MOVE A,GRPTR
CAMN A,[350700,,GRBPAG] ;AT BEGINNING OF PAGE?
JRST GC4 ;YES
MOVNI A,2 ;NO, BACK UP BY TWO BYTES
ADJBP A,GRPTR
MOVEM A,GRPTR ;STORE UPDATED POINTER
JRST GC3 ;GO READ THE CHARACTER
;HERE WHEN HIT BEGINNING OF PAGE READING BACKWARD
GC4: MOVE A,GRPGN ;BACK UP TO PREVIOUS PAGE
SOJL A,GEOF ;IF PAGE HITS 0, WE'VE GOT END OF FILE
CALL GRMAP ;MAP IT IN
JRST GC3 ;GO BACK AND READ CHARACTER
;HERE IF MAYBE END OF FILE WHEN READING FORWARD (BECAUSE BYTE POINTER
;LOOKS SUSPICIOUS)
GEOF1: MOVE B,GRPGN ;SEE WHICH PAGE IS MAPPED
CAMGE B,LPIG ;REACHED LAST?
JRST GC5 ;NO
JRST GEOF ;YES, END OF GRUMP
;HERE ON END OF FILE
GEOF: SKIPE A,GEOFDA ;SPECIAL PLACE TO GO ON END OF FILE?
JRST (A) ;YES, GO THERE
MOVX A,1B0 ;SAY END OF FILE
RET
;HERE TO PRINT WHO JUST STARTED LINKING
ARRIVE: XTMSG <
[Link from >
LDB A,P3 ;GET TERMINAL NUMBER
TRO A,400000 ;MAKE A TERMINAL DESIGNATOR
CALL PNAME ;PRINT USER NAME
XTMSG <, line >
LDB A,P3
CALL OCTNUM ;PRINT LINE NUMBER
XTMSG <]
>
RET
;HERE TO ANNOUNCE END OF LINK
LEAVE: XTMSG <
[Break from >
LDB A,P4 ;GET TERMINAL NUMBER
TRO A,400000 ;MAKE INTO TERMINAL DESIGNATOR
CALL PNAME ;PRINT USER NAME
XTMSG <, line >
LDB A,P4
CALL OCTNUM ;PRINT LINE NUMBER
XTMSG <]
>
RET
;PRINT USER NAME, GIVEN TERMINAL OR JOB NUMBER
;
;ACCEPTS: A/ 400000+TTY
;
; OR
;
; A/ JOB NUMBER
PNAME: STKVAR <TERNUM>
MOVEM A,TERNUM
CALL TTYLCK ;GET HANDLE ON TERMINAL OUTPUT
MOVE A,TERNUM
CALL GUSER ;GET USER NUMBER
JRST NOPNM ;FAILED, PROBABLY LOGGED OUT
MOVE B,A ;PUT IT IN B
MOVE A,TTYPNT ;GET OUTPUT POINTER
DIRST
ERJMP NOPNM
MOVEM A,TTYPNT ;UPDATE TTY OUTPUT POINTER
CALLRET TTYULK ;UNLOCK OUTPUT AND RETURN
NOPNM: CALL TTYULK
XTMSG <?>
RET
;ROUTINE TO DO PEEK JSYS ON ADDRESS SPECIFIED IN A.
MPEEK: HRLI A,1 ;WE ONLY WANT ONE WORD
MOVEI B,B ;WE WANT TO RETURN IT IN B
PEEK ;GET IT
ERJMP R ;CAN'T
RETSKP ;GOT IT
;SKPINU skips iff user is included from hog printout
;
;Accepts: A/ job number
;
;Returns+1: user is NOT being INCLUDED
; +2: user IS being INCLUDED
SKPINU: CALL GUSER ;GET USER NUMBER FOR THIS JOB
RETSKP ;ASSUME INCLUDED IF CAN'T GET IT
MOVE B,A ;PUT USER NUMBER IN B
MOVE A,CSBUFP ;POINT TO SCRATCH SPACE
DIRST ;GET STRING FOR THIS USER NAME
ERJMP RSKP ;ASSUME INCLUDED IF CAN'T
MOVEI A,EXHTAB ;GET TABLE OF ONES BEING EXCLUDED
MOVE B,CSBUFP ;POINT TO ONE IN QUESTION
TBLUK ;SEE IF IT'S EXCLUDED
TXNE B,TL%EXM ;EXACT MATCH SOMEWHERE?
RET ;YES, SO HE'S BEING EXCLUDED
RETSKP ;NO, SO HE'S INCLUDED
;GET USER NUMBER FOR JOB OR TERMINAL IN A. SKIPS IF SUCCESSFUL.
GUSER: HRROI B,A ;WE'LL RETURN USER NUMBER IN A
MOVEI C,.JIUNO ;WE WANT USER NUMBER
GETJI ;GET IT
RET
RETSKP
;ROUTINE TO DO SNOOP TO GET VALUE OF MONITOR SYMBOL IN A.
;PASS MODULE NAME IN B
SYMBOL: MOVE C,B ;PROGRAM NAME IN C
MOVE B,A ;PUT SYMBOL IN B
MOVEI A,.SNPSY ;WE WANT SYMBOL VALUE
SNOOP ;GET IT
ERJMP R ;COULDN'T
RETSKP ;GOT IT
;ROUTINE TO GET CURRENT JOB'S LINE NUMBER
GETLIN: GJINF
MOVE A,D
RET
;ROUTINE TO DO TIMER JSYS
DTIMER: CALL DTX ;MAKE CLOCK ENTRY
CAIA ;FAILED
RET ;DONE
TYPE <%DATE: No system space for clock entry - retrying
>
DTLUP: MOVEI A,^D3000 ;WAIT A SCANT THREE SECONDS
DISMS
CALL DTX ;TRY AGAIN
JRST DTLUP ;STILL FAILED
TYPE <%DATE: TIMER JSYS succeeded
>
RET
DTX: TIME ;REMEMBER WHAT TIME WE POSTED INTERRUPT
MOVEM A,LSTTIM
MOVE A,[400000,,.TIMEL] ;WE WANT INTERRUPTS EVERY SO OFTEN
MOVE B,[TIMEX] ;THIS OFTEN!
MOVEI C,TIMCHN ;SET UP APPROPRIATE CHANNEL
DOTIMR: TIMER
ERJMP [ CAIE A,TIMX7 ;NO SPACE FOR CLOCK?
CAIN A,TIMX8 ;USER CLOCK ALLOCATION EXCEEDED?
RET ;YES, LET CALLER HANDLE
CALL JSBOMB] ;NO, FAILURE
RETSKP ;SUCCEEDED
;ROUTINE TO PRINT SIXBIT WORD IN A.
;THIS ROUTINE GUARANTEES THAT PROGRAM WON'T HANG IF TERMINAL
;IS ^S'ED. USE PSIXN IF IMMEDIATE OUTPUT WANTED.
PSIX: STKVAR <SIXWRD,SIXPTR>
MOVEM A,SIXWRD
MOVE B,[440600,,SIXWRD] ;POINTER TO WORD
MOVEM B,SIXPTR
PSIX1: SKIPN SIXWRD ;ANY MORE CHARACTERS?
JRST PSD ;NO
ILDB A,SIXPTR ;GET SIXBIT CHARACTER
ADDI A,40 ;CHANGE TO ASCII
CALL CHAR ;PRINT CHARACTER
MOVEI A,0 ;MASK CHARACTERS DONE, TO DETECT FINISH
DPB A,SIXPTR
MOVE B,SIXPTR
TLNE B,770000 ;PRINTED 6 YET?
JRST PSIX1 ;NO
PSD: RET
;CHANGE SIXBIT TO ASCII
;ACCEPTS: A/ SIXBIT
; B/ ASCII POINTER
SIXASC: STKVAR <SIX,ASCPTR>
MOVEM A,SIX ;REMEMBER SIXBIT WORD
MOVE A,B ;GET ASCII POINTER
CALL FIXPT ;CHECK FOR -1 IN LEFT HALF
MOVEM A,ASCPTR
MOVE C,SIX ;GET SIXBIT TO BE CONVERTED
SIXA1: JUMPE C,SIXA2 ;LEAVE LOOP IF NO MORE SIXBIT CHARACTERS LEFT
MOVEI B,0 ;CLEAR OUT PREVIOUS JUNK
LSHC B,6 ;THERE ARE CHARACTERS, GET THE NEXT ONE
ADDI B,40 ;CHANGE TO ASCII
IDPB B,ASCPTR ;STORE IN ASCII STRING
JRST SIXA1 ;LOOP FOR REST OF STRING
SIXA2: MOVEI A,.CHNUL ;GET A NULL BYTE
IDPB A,ASCPTR ;GUARANTEE NULL AFTER ASCII
RET
;CHANGE -1,,FOO TO 440700,,FOO
FIXPT: TLC A,-1 ;CHANGE -1 TO 0, OTHER TO OTHER OTHER
TLCN A,-1 ;CHANGE 0 BACK TO -1, FIX OTHER
HRLI A,440700 ;WAS -1, NOW IT'S 440700
RET
;ROUTINE TO PRINT SIXBIT WORD IN A IMMEDIATELY.
PSIXN: STKVAR <SIQWRD,SIQPTR>
MOVEM A,SIQWRD
MOVE B,[440600,,SIQWRD] ;POINTER TO WORD
MOVEM B,SIQPTR
PSIQ1: ILDB A,SIQPTR ;GET SIXBIT CHARACTER
JUMPE A,PXD ;DONE IF NULL
ADDI A,40 ;CHANGE TO ASCII
PBOUT
MOVE B,SIQPTR
TLNE B,770000 ;PRINTED 6 YET?
JRST PSIQ1 ;NO
PXD: RET
;ROUTINE TO PRINT USER NAME FOR USER NUMBER IN A.
PUSR: STKVAR <WHOU>
MOVEM A,WHOU
CALL TTYLCK ;LOCK TERMINAL
MOVE B,WHOU ;PUT NUMBER IN B
MOVE A,TTYPNT ;GET POINTER TO BUFFER
DIRST ;PRINT NAME
ERJMP NOPNM ;COULDN'T
MOVEM A,TTYPNT ;STORE UPDATED OUTPUT POINTER
CALLRET TTYULK
;GET HERE WHEN USER TYPES ^P.
.PUSH: CALL SAVACS
CALL EXEINI ;INITIALIZE AN EXEC
JRST NOFORK ;FAILED
MOVEM A,FORKH ;REMEMBER FORK HANDLE
MOVE B,FORKH ;GET FORK HANDLE
SUBI B,400000 ;MAKE INDEX INTO TABLE
MOVEM A,EFNTAB(B) ;REMEMBER JFN AND SHOW THAT FORK IS IN USE
TMSG <
[Pushing...use POP to get back]
>
MOVE A,FORKH ;GET HANDLE ON EXEC
MOVEI B,0 ;WE WANT STANDARD STARTING ADDRESS
SFRKV ;START IT
PUS1: JRST .DEBRK ;RESTORE AC'S AND DEBRK
;ROUTINE TO INITIALIZE AN EXEC. SKIPS IF SUCCESSFUL
EXEINI: STKVAR <EFRK>
MOVX A,CR%CAP ;GIVE NEW EXEC SAME CAPS AS US
CFORK ;GET NEW FORK
ERJMP R ;CAN'T
MOVEM A,EFRK ;REMEMBER EXEC FORK
MOVX A,GJ%OLD+GJ%SHT ;EXEC MUST EXIST, SHORT FORM GTJFN
HRROI B,[ASCIZ /SYSTEM:NEW-EXEC.EXE/]
GTJFN ;GET HANDLE ON EXEC
ERJMP [ MOVE A,EFRK ;FAILED, SO CANCEL FORK
KFORK
RET] ;ERROR RETURN
HRL A,EFRK ;GET FORK HANDLE
GET ;LOAD THE EXEC
MOVE A,EFRK ;RETURN FORK HANDLE IN A
RETSKP ;SKIP FOR SUCCESS
;IF CAN'T DO ANOTHER PUSH...
NOFORK: TMSG <
?Can't do another PUSH
>
CALL PERR ;PRINT ERROR MESSAGE
JRST PUS1 ;EXIT
;WHEN SOME FORK HALTS (OR GETS CREATED!!!!) WE INTERRUPT TO HERE
;WHEN EXEC HALTS, WE INTERRUPT TO HERE
.POP: CALL SAVACS ;PRESERVE AC'S
MOVSI D,-EFNLEN ;PREPARE TO SCAN TABLE
POP1: SKIPN EFNTAB(D) ;THIS FORK IN USE?
JRST POP2 ;NO
MOVEI A,400000(D) ;YES, MAKE A FORK HANDLE
CALL HALTED ;DID THIS EXEC HALT?
JRST POP2 ;THIS EXEC STILL RUNNING
MOVEI A,400000(D) ;GET HANDLE AGAIN
KFORK ;KILL THE FORK
SETZM EFNTAB(D) ;SHOW THAT THIS SLOT FREE AGAIN
POP2: AOBJN D,POP1 ;LOOP TO CHECK ALL EXEC'S
SKIPE A,TTYFRK ;MAKE SURE TTY FORK STILL ALIVE
CALL HALTED
CAIA ;IT'S O.K.
CALL TTYBAD ;IT HALTED
CALL XCHECK ;MAKE SURE MAIN EXEC IS STILL ALIVE
JRST .DEBRK ;RESTORE AC'S AND RETURN
;CHECK ON MAIN EXEC, AND IF HALTED DUE TO HALTF, RESTART IT. IF
;HALTED DUE TO FATAL ERROR, ASK USER WHETHER TO RESTART IT. NOTE THAT
;THIS MEANS ^EQUIT WON'T GET ONE INTO MINI-EXEC.
XCHECK: MOVE A,XFORK ;GET HANDLE ON EXEC
RFSTS ;GET ITS STATUS
LOAD A,RF%STS,A ;GET STATE
CAIN A,.RFHLT ;HALT?
JRST [ SKIPE SICKF ;ARE WE ALREADY SICK?
JRST SICK1 ;YES, LET EXEC HALT. USER MAY WANT TO PLAY DOCTOR!
TYPE <DATE: No higher exec level
>
JRST XSTART] ;GO RESTART (USER PROBABLY POPPED TOO MANY TIMES)
CAIE A,.RFFPT ;UNEXPECTED HALT?
CAIN A,.RFTRP ;STRANGE JSYS TRAP HALT?
JRST XQUERY ;YES, GO QUERY USER
CAIN A,.RFABK ;UNEXPECTED ADDRESS BREAK HALT?
JRST XQUERY ;YES, QUERY
XOK: RET ;EXEC HOPEFULLY NOT SICK NOW
XSTART: MOVE A,XFORK ;GET HANDLE ON EXEC
MOVEI B,0 ;STANDARD START
SFRKV
RFORK ;IN CASE IT GOT FROZEN, MELT IT
JRST XOK
;EXEC DIED STRANGE DEATH
XQUERY: TYPE <DATE: Your exec has died!
>
PROMPT <Shall we try to revive it? >
MOVEI A,[FLDDB. .CMKEY,CM%SDH,[ 2,,2
T NO,0
T YES,1],<Type YES to try to recover>]
CALL CFIELD ;GET ANSWER
MOVE B,(B) ;GET TABLE WORD
TRNE B,-1 ;USER WANT TO RECOVER?
JRST XSTART ;YES, GO RESTART EXEC
TYPE <DATE: Halting...
>
XHALTF: HALTF ;STOP!
JRST BEG ;RESTART WORLD IF CONTINUE
;QUIT COMMAND COMES HERE
.QUIT: NOISE (COMPLETELY)
CONFRM ;CONFIRM BUT DON'T RESTART EXEC
HALTF ;STOP
CALLRET AFTEOL ;RESUME EXEC IF HE TYPES CONTINUE
;HERE WHEN EXEC HALTS AFTER WE BECAME SICK
SICK1: TYPE <DATE: Your exec has halted and DATE is sick - halting...
>
JRST XHALTF ;REALLY STOP!
;GET HERE IF LOWER FORK FOR TERMINAL DIES
TTYBAD: CAIE A,.RFHLT ;REGULAR HALT IS EXPECTED
JRST TTYBDX ;ALL OTHER IS REAL BAD
MOVE A,TTYFRK ;GET FORK HANDLE
KFORK ;FREE UP THE SYSTEM FORK SLOT
TTYIN: SETZM TTYFRK ;REMEMBER THAT IT DOESN'T EXIST ANYMORE
MOVE A,[440700,,TTYBUF]
MOVEM A,MIDPNT ;INITIAL "MIDPOINT" IS BEGINNING OF BUFFER
MOVEM A,TTYPNT ;INIT END OF BUFFER TO BEGINNING
SETOM OUTFLG ;SAY THERE'S NO MORE OUTPUT
CALLRET TTYUL1 ;UNLOCK OUTPUT SO PROGRAM MAY DO SOME
TTYBDX: TMSG <
?DATE: Terminal output fork died - >
HRL A,TTYFRK
HRRI A,-1 ;MOST RECENT ERROR
CALL PERR1 ;PRINT EXCUSE
JRST FTLWAT ;DO NOTHING MORE
;GET HERE ON UNEXPECTED JSYS FAILURE. TRY TO KEEP GUY'S EXEC RUNNING!
JSBOMB: TMSG <
?DATE: Unexpected JSYS failure at >
HRRZ A,(P) ;GET WHERE WE WERE CALLED FROM
CALL POCT ;PRINT IN OCTAL
TYPE < - >
CALL PERR ;GIVE EXCUSE
JRST FTLWAT ;SLEEP, MERELY SUPPORTING EXEC
;ROUTINE WHICH SKIPS IFF FORK IN A HAS HALTED
;IF HALTED, STATUS GETS RETURNED IN A
HALTED: RFSTS ;SEE WHAT THIS FORK IS DOING
LDB A,[222100,,A] ;ISOLATE THE STATUS
CAIE A,.RFHLT ;IF FORK BOMBED OUT
CAIN A,.RFFPT ;OR HALTED
RETSKP ;FORK HALTED
RET ;FORK STILL RUNNING
;ROUTINE TO COMPUTE DIFFERENCE IN CHARACTERS BETWEEN BYTE POINTERS
;IN A AND B. RETURNS DIFFERENCE IN A.
SUBBP: HRRZ C,A ;COMPUTE 5*(A1-A2)+(P2-P1)/7
SUBI C,0(B)
IMULI C,5 ;COMPUTE NUMBER CHARS IN THOSE WORDS
LDB A,[POINT 6,A,5]
LDB B,[POINT 6,B,5]
SUBM B,A
IDIVI A,7
ADD A,C
RET
;HERE TO DEBRK FROM INTERRUPT FOR WHICH ACS WERE STORED
.DEBRK: CALL RESACS ;RESTORE AC'S
DEBRK ;DISMISS INTERRUPT
;HERE ON STACK OVERFLOW
PDLOV: MOVE P,[IOWD POVLEN,POVSTK] ;SPECIAL STACK
TMSG <
?DATE: stack overflow at PC >
BAD1: TMSG <> ;GET USER'S ATTENTION
HRRZ A,LEV1PC ;GET PC INTERRUPTED FROM
CALL POCT ;PRINT PC IN OCTAL
JRST ICOMN ;COMMON CODE
;SYSTEM RESOURCES EXHAUSTED
ICMSE: TMSG <
?DATE: System resources exhausted at PC >
JRST BAD1
;OVER QUOTA
ICQTA: TMSG <
?DATE: Quota exceeded at PC >
JRST BAD1
;FILE DATA ERROR
ICDAE: TMSG <
?DATE: File data error at PC >
JRST BAD1
;ILLEGAL MEMORY WRITE
ICIWR: TMSG <
?DATE: Illegal memory write at PC >
JRST BAD1
;ILLEGAL MEMORY READ
ICIRD: TMSG <
?DATE: Illegal memory read at PC >
JRST BAD1 ;FINISH LIKE OTHER ERRORS
;GET HERE ON ILLEGAL INSTRUCTION INTERRUPT (UNEXPECTED)
ILL: TMSG <
?DATE: Error at PC >
HRRZ A,LEV1PC+ILLLEV-1 ;GET PC INTERRUPTED FROM
CALL POCT ;PRINT PC IN OCTAL
TMSG < - >
MOVEI A,.PRIOU
MOVE B,[.FHSLF,,-1] ;US, LAST ERROR
MOVEI C,0 ;NO LENGTH LIMIT
ERSTR ;PRINT SYSTEM ERROR REASON
JSHLT
JSHLT
ICOMN: TMSG <
>
JRST FTLWAT ;NOTHING MORE TO DO (BUT USER'S EXEC MAY STILL BE RUNNING!)
;GET HERE WHEN WE HAVE A FATAL ERROR OTHER THAN THE EXEC HALTING. THIS
;PLACE TRIES TO KEEP OURSELF ALIVE JUST ENOUGH TO ALLOW THE USER'S PROGRAMS
;TO CONTINUE RUNNING
FTLWAT: SETOM SICKF ;REMEMBER THAT WE'RE SICK
CALL PIOFF ;TURN OFF PI SYSTEM WHILE WE DISABLE STUFF
MOVEI A,.FHSLF ;OURSELF
HRROI B,-1 ;ALL CHANNELS
DIC ;DISABLE ALL CHANNELS
MOVX B,1B<.ICIFT> ;ONLY RECEIVE EXEC TERMINATION INTERRUPTS
AIC ;ACTIVATE EXEC TERMINATION
CIS ;CLEAR ALL OTHER INTERRUPT LEVELS
CALL PION ;TURN INTERRUPT SYSTEM BACK ON
MOVE A,XFORK ;RESUME EXEC IN CASE WE DIED AFTER FREEZING IT
RFORK
WAIT ;DO NOTHING!
;COME HERE IF USER TYPES ^Y
;USE HIGH CHANNEL FOR READING CTRL/Y AND LOWER CHANNEL FOR EXECUTING COMMAND.
;THIS ALLOWS COMMANDS TO BE ABORTED WITH A SECOND CTRL/Y
.CTRLY: CALL SAVACS ;DON'T CLOBBER AC'S
MOVEI A,.FHSLF ;REQUEST COMMAND STARTUP
MOVX B,1B<CMDCHN>
MOVEI C,UNCMD ;PREPARE TO ABORT INTERRUPTED COMMAND
SKIPE D,INCMDF ;DID WE REALLY INTERRUPT ANOTHER COMMAND?
JRST [ MOVE P,D ;UNWIND STACK FROM INTERRUPTED COMMAND
MOVEM C,LEV1PC+CTYLEV-1 ;CAUSE PREVIOUS COMMAND TO IMMEDIATELY CLEAN UP AND EXIT
IIC ;CAUSE COMMAND EXECUTION AFTER OLD COMMAND CLEAN'S UP
DEBRK] ;LET NEW COMMAND START AFTER CLEAN UP
IIC
JRST .DEBRK ;START NEW COMMAND
COMAND: CALL SAVACS ;DON'T CLOBBER AC'S
CALL SAVCMD ;SAVE COMND IN CASE WE INTERRUPTED OUT OF COMND (HAPPENS IF CTRL/Y WHILE DATE.CMD BEING READ!)
MOVEM P,INCMDF ;NOTE THAT DOING COMMAND AND SAVE STACK POINTER
CALL CMDINI ;DO THIS AFTER SAVCMD TO AVOID OVERFLOWING CMDPDL (SEE CMD.MAC)
MOVE A,XFORK ;GET HANDLE ON OUR EXEC
FFORK ;FREEZE IT SO IT OR ITS PROGRAMS DON'T MIX INPUT WITH US
TMSG <
[DATE: Type EXIT to resume >
GETNM ;GET CURRENT PROGRAM NAME
CALL PSIXN ;TYPE IT
TMSG <]
>
CALL DOCMD ;DO A COMMAND
JRST CMDERR ;FAILED, PRINT ERROR
UNCMD: CALL RESCMD ;RESTORE COMND JSYS STUFF
CALL RESACS ;FIX AC'S
SETZM INCMDF ;SAY NOT IN COMMAND ANYMORE
DEBRK ;DONE WITH INTERRUPT
;ROUTINE TO EXECUTE ONE COMMAND
DOCMD: PROMPT (DATE>)
MOVEI A,[FLDBK. .CMKEY,,COMLST]
CALL RFLDE ;READ KEYWORD AT BEGINNING OF LINE
RET ;FAILED, PROBABLY END OF FILE
MOVE A,(B) ;GET TABLE WORD
CALL (A) ;GO HANDLE SPECIFIC COMMAND
RETSKP ;GOOD COMMAND, SKIP RETURN
;LOGSKP REPORTS ABOUT LOGGING.
;
;RETURNS: +1 LOGGING DISABLED
; +3 ENABLED AND ANNOUNCED ALREADY
LOGSKP: SKIPN LOGGF ;ENABLED?
RET ;NO, SO RETURN TO SAY SO
TMSG <* ENABLE LOGGING (ON FILE) >
MOVEI A,.PRIOU ;OUTPUT TO PRIMARY
MOVE B,LOGJFN ;PRINT FILESPEC
MOVEI C,0 ;STANDARD FORMAT
JFNS
TMSG <
>
JRST R2SKP ;TWO SKIPS TO SAY WE'RE DONE
;LJFNBK CONTAINS DEFAULTS FOR LOGGING FILESPEC
LJFNBK: 0 ;APPEND TO EXISTING FILE IF THERE.
0 ;COMND WILL FILL IN SOURCE/DES JFNS
0 ;NO DEFAULT DEVICE, DIRECTORY
0
-1,,[ASCIZ /DATE/] ;DEFAULT NAME TO DATE.LOG
-1,,[ASCIZ /LOG/]
BLOCK CJFNLN-.+LJFNBK ;LEAVE 0'S IN REST OF BLOCK
;.DLOG DISABLES LOGGING
.DLOG: CALL OURCFM ;GET CONFIRMATION
SKIPN LOGGF ;WERE WE LOGGING?
JRST [ TMSG <% Logging was already disabled
>
RET]
SETZM LOGGF ;SAY WE'RE NOT LOGGING ANYMORE
MOVE A,LOGJFN ;YES, RELEASE JFN
RLJFN
ERJMP .+1 ;IGNORE FAILURE
RET
;.ELOG ENABLES LOGGING ON SPECIFIED FILESPEC
.ELOG: NOISE (ON FILE)
MOVE A,[LJFNBK,,CJFNBK]
BLT A,CJFNBK+CJFNLN-1 ;SET UP OUR GTJFN PARAMETERS
MOVEI A,[FLDDB. .CMFIL,CM%SDH,,<File to receive DATE output>]
CALL OURCFD ;READ JFN
SKIPE LOGGF ;WAS LOGGING ENABLED ON ANOTHER FILE?
JRST [ MOVE A,LOGJFN ;YES, GET RID OF OLD ONE
RLJFN
ERJMP .+1 ;SHOULDN'T FAIL
JRST .+1]
MOVEM B,LOGJFN ;REMEMBER THE JFN
SETOM LOGGF ;REMEMBER THAT WE'RE NOW LOGGING
RET
;UFLSKP REPORTS WHICH FILES ARE BEING CHECKED AND TAKES A DOUBLE SKIP TO
;TELL .SETTI THAT IT DID ALL THE WORK
UFLSKP: MOVEI Q1,ULEN ;SCAN ENTIRE LIST
UFLS1: SOJL Q1,R2SKP ;DONE WHEN COUNT RUNS OUT
SKIPN UDIR(Q1) ;THIS SLOT IN USE?
JRST UFLS1 ;NO
TMSG <* ENABLE UPDATE-FILE-CHECKING >
MOVE A,UFPTR(Q1) ;GET POINTER TO FILESPEC
PSOUT ;PRINT IT
TMSG <
>
JRST UFLS1 ;PRINT THE REST
;DISABLE UPDATE-FILE-CHECKING (FOR FILES)
.DUFIL: STKVAR <EUJFN>
NOISE (FOR FILES)
MOVE A,[UJFNBK,,CJFNBK]
BLT A,CJFNBK+CJFNLN-1 ;SET UP OUR SPECIAL DEFAULTS
MOVEI A,[FLDDB. .CMFIL,CM%SDH,,<File set to check>]
CALL OURCFD ;GET JFN AND CONFIRMATION
TXNE B,GJ%DEV!GJ%UNT!GJ%DIR ;CAN'T ALLOW THESE SINCE GTDAL USED
COMERR <Wildcarding only allowed after directory name>
MOVEM B,EUJFN ;REMEMBER THE JFN
MOVE A,CSBUFP ;POINT TO STRING SPACE
MOVX C,JMAGIC ;BITS TO PRINT ALL FIELDS
JFNS ;GET ALL FIELDS THAT CONTROL WHICH FILES ARE SELECTED
MOVEI Q1,ULEN ;FIND SLOT WITH CORRECT VALUE
EUF1: SOJL Q1,[ TMSG <% No ENABLE UPDATE-FILE-CHECKING was done for that file set
>
RET]
SKIPN UDIR(Q1) ;FIND A USED SLOT?
JRST EUF1 ;NO, KEEP LOOKING
MOVE A,CSBUFP ;POINT TO SPEC BEING REMOVED
MOVE B,UFPTR(Q1) ;POINT TO ONE IN TABLE
STCMP ;COMPARE THEM
JUMPN A,EUF1 ;KEEP LOOKING IF DOESN'T MATCH
MOVE A,UFPTR(Q1) ;MATCHED, GET POINTER TO ONE BEING REMOVED
CALL STREM ;RETURN STRING SPACE TO FREE POOL
SETZM UDIR(Q1) ;MATCHES, SO REMOVE IT
RET
;ENABLE UPDATE-FILE-CHECKING
.EUFIL: STKVAR <EUJFN>
NOISE (FOR FILES)
MOVEI Q1,ULEN ;FIND A FREE SLOT
EUF11: SOJL Q1,[COMERR <Can't check more files - use DISABLE UPDATE-FILE-CHECKING>]
SKIPE UDIR(Q1) ;FIND A FREE SLOT?
JRST EUF11 ;NO, KEEP LOOKING
MOVE A,[UJFNBK,,CJFNBK]
BLT A,CJFNBK+CJFNLN-1 ;SET UP OUR SPECIAL DEFAULTS
MOVEI A,[FLDDB. .CMFIL,CM%SDH,,<File set to check>]
CALL OURCFD ;GET JFN AND CONFIRMATION
TXNE B,GJ%DEV!GJ%UNT!GJ%DIR ;CAN'T ALLOW THESE SINCE GTDAL USED
COMERR <Wildcarding only allowed after directory name>
MOVEM B,EUJFN ;REMEMBER THE JFN
MOVE A,CSBUFP ;POINT TO STRING SPACE
MOVX C,JMAGIC ;GET SPECIAL BITS FOR GETTING ALL FIELDS
JFNS ;ASK MONITOR FOR FILESPEC
MOVEI Q2,ULEN ;MAKE SURE THIS ISN'T A DUPLICATE
EUF2: SOJL Q2,EUF3 ;NOT A DUPLICATE IF CAN'T FIND IT
SKIPN UDIR(Q2) ;FIND AN INTERESTING SLOT?
JRST EUF2 ;NOT YET
MOVE A,CSBUFP ;YES, GET NEW FILESPEC
MOVE B,UFPTR(Q2) ;GET ONE FROM TABLE
STCMP ;COMPARE THEM
JUMPN A,EUF2 ;NO MATCH SO DON'T WORRY
TMSG <% ENABLE UPDATE-FILE-CHECKING for that file set is already in affect
>
JRST EUF4
EUF3: MOVE A,CSBUFP
CALL BUFFS ;BUFFER UP THE FILESPEC STRING
MOVEM A,UFPTR(Q1) ;REMEMBER POINTER TO FILESPEC STRING
HRRZ B,EUJFN ;PREPARE TO GET DIRECTORY NUMBER
MOVX A,RC%EMO ;WE WANT EXACT MATCH
RCDIR ;GET THE DIRECTORY
MOVEM C,UDIR(Q1) ;REMEMBER THE DIRECTORY NUMBER
MOVE A,C
GTDAL ;GET INITIAL ALLOCATION
MOVEM B,USIZE(Q1)
GTAD
MOVEM A,UTIME(Q1) ;FIND UPDATES STARTING NOW
EUF4: HRRZ A,EUJFN
RLJFN ;RELEASE THE JFN
JFCL
RET
;READ-ONLY JFN BLOCK FOR UPDATE-FILE-CHECKING
UJFNBK: GJ%IFG!.GJALL ;ALLOW STARS, DEFAULT TO ALL GENERATIONS
377777,,377777 ;NO MORE INPUT OR OUTPUT NEEDED
0
0 ;NO DEFAULT DEVICE AND DIRECTORY
-1,,[ASCIZ /*/] ;DEFAULT TO ALL FILES IN DIRECTORY
-1,,[ASCIZ /*/] ;DEFAULT TO ALL FILE TYPES
-1,,[ASCIZ /*/] ;DEFAULT TO ALL GENERATIONS
BLOCK CJFNLN-.+UJFNBK
;INSTANT PUSH FEATURE.
.EINST: CALL OURCFM
MOVE A,[IPC,,2] ;PUT ^P ON CHANNEL 2
ATI
RET
;ROUTINE TO SKIP IF INSTANT-PUSH IS ENABLED.
INSSKP: MOVEI A,.FHSLF ;OURSELF
RTIW ;SEE WHICH CHARACTERS ARE ENABLED
TXNE B,1B<IPC> ;IS INSTANT PUSH ENABLED?
RETSKP ;YES
RET ;NO
.DINSTA: CALL OURCFM
MOVEI A,""
DTI ;TURN OFF INSTANT-PUSH
RET
;EXIT FROM PROGRAM
.EXIT: NOISE (BACK TO PROGRAM AND EXEC)
CALLRET OURCFM
;SYMBOL (NAME) NAME
;GIVES VALUE OF SYMBOL
.VALUE: STKVAR <SD0,WHICH>
CALL SYMINI ;GENERATE SYMBOL TABLE
NOISE (OF SYMBOL)
MOVEI A,KEYBLK ;KEY FUNCTION BLOCK
CALL OURCFD
MOVEM B,WHICH
HLRO A,@WHICH ;GET POINTER TO SYMBOL NAME
PSOUT ;TYPE NAME
TMSG < = >
MOVE B,@WHICH ;GET ADDRESS HOLDING VALUE
MOVE D,(B) ;GET VALUE
MOVEM D,SD0
HLRZ A,SD0 ;GET LEFT HALF
CALL POCT ;PRINT IN OCTAL
TMSG <,,>
HRRZ A,SD0
CALL POCT ;RIGHT HALF
TMSG <
>
RET
;VALUE (IN OCTAL)
;TELLS WHAT SYMBOLS MATCH THE VALUE
.SYMBO: STKVAR <MATCHN>
SETZM MATCHN ;NO MATCHES YET
NOISE (WITH VALUE)
MOVEI A,[FLDDB. .CMNUM,,8]
CALL RFIELD
MOVE P1,B ;USE AC FOR VALUE TO SAVE INST IN LOOP
MOVEI A,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /,,/]>,<two commas for halfword format>]]
CALL RFIELD ;GET EITHER COMMAS OR CR
LOAD C,CM%FNC,.CMFNP(C) ;SEE WHAT FUNCTION WAS TYPED
CAIE C,.CMCFM ;CARRIAGE RETURN?
JRST COMMAS ;NO, COMMAS
CALL AFTEOL ;DO END-OF-COMMAND-LINE STUFF
SLUUP: CALL SYMINI ;GENERATE SYMBOL TABLE
HLRZ D,@SYMTAD ;GET NUMBER OF SYMBOLS TO LOOK UP
MOVN D,D
HRLZ D,D ;MAKE AOBJN POINTER
HRR D,SYMTAD ;GET ADDRESS OF TABLE
SLOOP: MOVE A,1(D) ;GET ADDRESS OF VALUE
CAMN P1,(A) ;SKIP IF DOESN'T MATCH
JRST SMATCH ;DOES!
SLOP1: AOBJN D,SLOOP ;LOOP FOR REST OF SYMBOLS
HRROI A,[ASCIZ /
/]
SKIPN MATCHN ;ANY MATCH?
HRROI A,[ASCIZ /No symbols match that value.
/] ;NO
PSOUT
RET
;HERE WHEN N,, SEEN
COMMAS: MOVEI A,[FLDDB. .CMNUM,CM%SDH,8,<Octal value for right half>,0]
CALL OURCFD
HRL P1,P1 ;NUMBER SEEN, SO FIRST ONE IS LEFT HALF
HRR P1,B ;AND THIS ONE IS RIGHT HALF
JRST SLUUP ;JOIN COMMON CODE
SMATCH: AOS MATCHN ;KEEP TRACK OF NUMBER OF MATCHES
MOVEI A,11
PBOUT ;PRINT A TAB
HLRO A,1(D) ;GET POINTER TO SYMBOL NAME
PSOUT ;PRINT IT
JRST SLOP1 ;GO TO NEXT SYMBOL
;LOGTIM prints out last time of login for specified user
LOGTIM: STKVAR <<LLBLK,.CDLLD+1>,LLDIR>
NOISE (for user)
MOVEI A,[FLDDB. .CMUSR]
CALL OURCFD ;GET USER DESIRED
MOVEI A,0 ;NO SPECIAL RCDIR BITS
RCDIR ;GET DIRECTORY NUMBER
ERJMP [COMERR <Unrecognizable user name>]
MOVEM C,LLDIR ;REMEMBER DIRECTORY NUMBER
MOVEI A,1+.CDLLD ;JUST READ ENOUGH TO GET THE TIME AND DATE
MOVEM A,.CDLEN+LLBLK ;TELL GTDIR HOW MUCH TO READ
MOVE A,LLDIR ;DIRECTORY NUMBER IN A
MOVEI B,LLBLK ;SAY WHERE TO PUT INFO
MOVEI C,0 ;WE DON'T NEED PASSWORD
GTDIR ;GET THE INFO
ERJMP [COMERR <Couldn't read last login time for that user>]
SKIPN B,.CDLLD+LLBLK ;GET LAST LOGIN TIME
JRST [ TYPE <That user has never logged in.
>
RET]
TYPE <Last LOGIN >
MOVEI A,.PRIOU ;SEND OUTPUT TO PRIMARY
ODTIM ;PRINT IT
TYPE <
>
RET
;HERE TO PRINT OUT TEXT STRING FOR A BUG
.BUGST: NOISE (For BUG name)
CALL BUGINI ;ENSURE BUG TABLE INITIALIZED
MOVEI A,[FLDBK. (.CMKEY,,BUGTAB)] ;KEYWORD FROM BUG TABLE
CALL OURCFD ;PARSE IT
MOVE Q1,B ;SAVE ADDRESS OF TABLE ENTRY FOUND
TYPE <Text for BUG name (>
HLRO A,(Q1) ;GET POINTER TO BUG NAME
LDB B,[341000,,(A)] ;SEE IF FLAG WORD
CAIN B,1
AOJ A, ;YES, SKIP IT
PSOUT
TYPE <): >
HRRO A,(Q1) ;MAKE POINTER TO TEXT STRING
PSOUT ;OUTPUT IT
TYPE <
> ;FOLLOW BY CARRIAGE RETURN
RET
;HERE TO EXCLUDE A BUGCHK FROM BEING REPORTED (SAME AS IGNORE)
BUGMSK: BRMSK. (KEYB0.,KEYB1.,KEYB2.,KEYB3.,<%*>,<->)
BUGKEY: FLDBK. (.CMKEY,,BUGTAB,,,BUGMSK,BUGFLD)
BUGFLD: FLDBK. (.CMFLD,,,BUG name wildcarded with *'s and %'s,,BUGMSK)
.EXCLU: NOISE (category)
MOVEI A,[FLDDB. .CMKEY,,EXCTAB]
CALL RFIELD ;SEE WHAT'S BEING EXCLUDED
MOVE B,(B)
CALLRET (B) ;HANDLE IT
EXCTAB: EXCN,,EXCN
T BUG,.EXBUG
T HOG,.EXHOG
EXCN==.-EXCTAB-1
;Here to exclude particular hogs
.EXHOG: NOISE (user)
HLRZ A,EXHTAB ;GET NUMBER ALREADY EXCLUDED
CAIL A,EXHGMX ;MAXIMUM ALREADY BEING EXCLUDED?
COMERR <Maximum already being excluded - try INCLUDEing some first>
MOVEI A,[FLDDB. .CMUSR,CM%SDH,,<User name of hog you don't want to hear about>]
CALL OURCFD ;GET USER NAME
CALL BUFFF ;BUFFER THE USER NAME
HRLZ B,A ;MAKE TABLE ENTRY
MOVEI A,EXHTAB ;POINT TO TABLE
TBADD ;ADD THIS ENTRY
ERJMP [ HLRO A,B ;COULDN'T ADD IT, GET BUFFERED STRING
CALL STREM ;RELEASE ITS FREE SPACE
CALL GETERR ;GET REASON FOR FAILURE
CAIN A,TADDX2 ;ALREADY IN TABLE?
TYPE <% That user was already being excluded
>
CAIE A,TADDX2
JSERR ;PRINT JSYS ERROR FOR STRANGE FAILURE
JRST .+1]
RET ;DONE
;Here to include particular hog
.INHOG: STKVAR <ININ>
NOISE (user)
MOVEI A,[FLDDB. .CMUSR,CM%SDH,CM%DWC,<User name, wildcarding O.K., of hog you want to hear about>]
CALL OURCFD ;GET NAME HE WANTS TO HEAR ABOUT
HLRZ A,EXHTAB ;GET NUMBER OF ENTRIES TO SCAN
MOVEM A,ININ
INLP: SOSGE A,ININ ;ANYMORE TO SCAN?
RET ;NO
HLRO C,1+EXHTAB(A) ;YES, GET POINTER TO NEXT ONE
HRROI B,ATMBUF ;POINT TO USER'S TYPED STRING
MOVX A,.WLSTR ;SAY COMPARE STRINGS
WILD% ;COMPARE THE ENTRY
TXNE A,WL%NOM ;IS IT A MATCH?
JRST INLP ;NO, SO LOOP TO NEXT
MOVE A,ININ ;YES, GET INDEX AGAIN
HLRO A,1+EXHTAB(A) ;GET POINTER TO STRING
CALL STREM ;FREE UP SPACE USED BY STRING
MOVE B,ININ
ADDI B,1+EXHTAB ;SAY ADDRESS OF ENTRY BEING DELETED
MOVEI A,EXHTAB ;TELL SYSTEM WHERE TABLE IS
TBDEL ;REMOVE THE ENTRY
JRST INLP ;CHECK REST FOR MORE MATCHES
;Here to exclude particular bugs
.EXBUG: NOISE (name) ;HINT AT WHAT THIS DOES
CALL BUGINI ;INITIALIZE BUGCHK TABLE
MOVEI A,BUGKEY
CALL OURCFD
MOVEI A,(C) ;GET ADDRESS OF FDB PARSED
CAIN A,BUGKEY ;KEYWORD ENTERED?
JRST .EXCL2 ;YES...
;NO..., HAS TO BE FIELD
HLRZ D,BUGTAB ;GET NUMBER OF CURRENT BUGS IN TABLE
ADDI D,1 ;+1 TO LOOP FOR ALL
MOVNS C,D ;MAKE IT NEGATIVE
MOVEI D,BUGTAB ;ADDRESS OF BUG TABLE
HRL D,C ;-COUNT,,ADDR IN D FOR LOOP COUNTER
.EXCL1: AOBJP D,[RET] ;BUMP TO NEXT TABLE ENTRY, RETURN WHEN DONE
HRROI B,ATMBUF ;POINTER TO WILD STRING
HLRO C,(D) ;GET THIS ENTRY, LH HAS ADDR OF KEYWORD
ADDI C,1 ; BYPASS FLAG WORD
MOVX A,<.WLSTR> ;WILD STRING FUNCTION CODE
WILD% ;IS THIS A MATCH?
TXNE A,WL%NOM
JRST .EXCL1 ;NO..., TRY NEXT ENTRY
MOVE B,D
CALL .EXCL2 ;YES..., PUT IT IN TABLE OF IGNORED ENTRIES
JRST .EXCL1 ;TRY NEXT ENTRY
.EXCL2: MOVEI A,BIGTAB ;POINT TO TABLE OF THINGS BEING IGNORED
MOVE B,(B) ;GET ENTRY BEING ADDED
TBADD ;TRY TO ADD NEW ENTRY
ERJMP [CALL GETERR ;SEE WHY FAILED
CAIN A,TADDX1 ;TABLE FULL?
JRST .EXCL3 ;YES
TYPE <%BUG name already excluded
>
RET]
RET
.EXCL3: HRROI A,[ASCIZ /No room to exclude another BUG/]
ESOUT
TMSG <
>
RET
;HERE TO INCLUDE A BUGCHK WHICH HAS ALREADY BEEN EXCLUDED
IBGKEY: FLDBK. (.CMKEY,,BIGTAB,,,BUGMSK,BUGFLD)
.INCLU: NOISE (category)
MOVEI A,[FLDDB. .CMKEY,,INCTAB]
CALL RFIELD ;SEE WHAT'S BEING INCLUDED
MOVE B,(B)
CALLRET (B) ;HANDLE IT
INCTAB: INCN,,INCN
T BUG,.INBUG
T HOG,.INHOG
INCN==.-INCTAB-1
;Here to include bugs in printout
.INBUG: NOISE (name) ;HINT AT WHAT THIS DOES
CALL BUGINI ;INITIALIZE BUGCHK TABLE
MOVEI A,IBGKEY ;FIND WHAT IS TO BE INCLUDED
CALL OURCFD
MOVEI A,(C) ;GET ADDRESS OF FDB PARSED
CAIN A,IBGKEY ;KEYWORD ENTERED?
JRST .INCL2 ;YES...
;NO..., HAS TO BE FIELD
HLRZ D,BIGTAB ;GET NUMBER OF CURRENT BUGS IN TABLE
ADDI D,1 ;+1 TO LOOP FOR ALL
MOVNS C,D ;MAKE IT NEGATIVE
MOVEI D,BIGTAB ;ADDRESS OF BUG TABLE
HRL D,C ;-COUNT,,ADDR IN D FOR LOOP COUNTER
.INCL1: AOBJP D,[RET] ;BUMP TO NEXT TABLE ENTRY, RETURN WHEN DONE
HRROI B,ATMBUF ;POINTER TO WILD STRING
HLRO C,(D) ;GET THIS ENTRY, LH HAS ADDR OF KEYWORD
ADDI C,1 ; BYPASS FLAG WORD
MOVX A,<.WLSTR> ;WILD STRING FUNCTION CODE
WILD% ;IS THIS A MATCH?
TXNE A,WL%NOM
JRST .INCL1 ;NO..., TRY NEXT ENTRY
MOVEI B,(D) ;MAKE B HAVE ADDRESS OF ENTRY
CALL .INCL2 ;YES..., PUT IT IN TABLE OF IGNORED ENTRIES
SUBI D,1 ;ACCOUNT FOR ENTRY REMOVED
JRST .INCL1 ;TRY NEXT ENTRY
.INCL2: HLRZ A,BIGTAB ;GET NUMBER OF ENTRIES IN TABLE
CAIN A,0 ;ANY ENTRIES IN TABLE?
JRST [TYPE <%No BUG's are currently excluded
>
RET]
MOVEI A,BIGTAB ;POINT TO TABLE OF THINGS BEING IGNORED
TBDEL ;TRY TO DELETE ENTRY
ERJMP [HRROI A,[ASCIZ /Could not include BUG: /]
ESOUT
CALL GETERR ;SEE WHY FAILED
HRLI A,.FHSLF
CALL PERR1 ;PRINT ERROR STRING
RET]
RET
;Show which hogs are excluded
INFHOG: STKVAR <NN>
HLRZ A,EXHTAB ;GET NUMBER OF HOGS BEING EXCLUDED
MOVEM A,NN ;REMEMBER HOW MANY TO PRINT OUT
IH1: SOSGE A,NN ;ANYMORE?
RET ;NO, DONE
TYPE < EXCLUDE HOG >
HLRO A,EXHTAB+1(A) ;GET POINTER TO NEXT ONE
PSOUT ;TYPE THE USER NAME
TYPE <
> ;FINISH LINE
JRST IH1 ;LOOP FOR REST
;SHOW WHICH BUGCHKS ARE BEING IGNORED
INFBUG: SKIPN BUGCHF ;DOING BUGCHK REPORTING?
RET ;NO, SO DON'T TELL ABOUT IGNORED BUGCHKS
STKVAR <BIGN>
HLRZ A,BIGTAB ;SEE HOW MANY BEING IGNORED
MOVEM A,BIGN
JUMPE A,R ;IF NONE, RETURN NOW
TYPE <BUG's excluded:>
INFBLP: SOSGE A,BIGN ;SEE WHICH ONE TO PRINT NEXT
JRST [ TYPE <
>
RET] ;PUT END OF LINE AFTER LAST ONE
TRNN A,3 ;START A NEW LINE?
TYPE <
> ;YES, SINCE LIST MAY BE LONG!
TYPE < > ;PUT TAB IN FRONT OF NAME
HLRZ B,BIGTAB ; GET NUMBER OF ENTRIES
MOVEI B,BIGTAB+1(B) ; ADDRESS OF LAST
SUBI B,1(A) ; MINUS CURRENT OFFSET
HLRO A,(B) ;GET ASCII POINTER TO NAME
LDB B,[341000,,(A)] ;SEE IF FLAG WORD
CAIN B,1
AOJ A, ;YES, SKIP IT
PSOUT ;TYPE THE NAME
JRST INFBLP ;DO THE REST.
;ROUTINE TO GET LAST ERROR IN A.
GETERR: MOVEI A,.FHSLF ;OURSELF
GETER ;GET ERROR CODE
HRRZ A,B ;RETURN IN A
RET
;HOG CONTROL
.EHOG: NOISE (CHECK FOR USERS RECEIVING SPECIAL SCHEDULER PRIORITY)
CALL OURCFM
SETOM HOGF
RET
HOGSKP: SKIPN HOGF ;ENABLED?
RET ;NO
TYPE <* ENABLE HOG-CHECKING
>
CALL INFHOG ;SAY WHICH HOGS ARE BEING EXCLUDED
JRST R2SKP
.DHOG: CALL OURCFM
SETZM HOGF
RET
;HERE TO DISABLE GRUMP-CHECKING
.DGRUM: CALL OURCFM
SETZM GRUMPF
RET
GRUSKP: SKIPE GRUMPF
RETSKP ;ENABLED
RET ;DISABLED
.DMAIL: CALL OURCFM
SETZM MAILF
RET
MALSKP: SKIPE MAILF
RETSKP
RET
;HERE TO ENABLE MAIL-PREVIEWING
.EMAIL: CALL OURCFM
SETOM MAILF
HRROI A,MALSPC ;CREATE FILESPEC FOR MAIL FILE
MOVE B,LOGNO
DIRST ;START WITH LOGIN DIRECTORY NAME
HRROI A,MALSPC ;SHOULDN'T FAIL, BUT IF DOES, A IS CLOBBERED!
HRROI B,[ASCIZ /MAIL.TXT.1/]
MOVEI C,0
SOUT ;FINISH SPEC
RET
;HERE TO ENABLE GRUMP-CHECKING
.EGRUM: CALL OURCFM
SETOM GRUMPF
RET
;ENABLE AND DISABLE STATISTICS
.DSTAT: TDZA A,A ;0 MEANS DISABLE
.ESTAT: MOVEI A,1 ;1 MEANS ENABLE
STKVAR <ENAF>
MOVEM A,ENAF ;REMEMBER WHETHER ENABLING OR DISABLING
NOISE (OF)
MOVEI A,[FLDDB. .CMKEY,,[ 1,,1
T ALL-FEATURES,0],,<ALL>,[
FLDDB. .CMKEY,,STALST]]
CALL OURCFD ;SEE WHICH THINGS ARE BEING ENABLED
MOVE B,(B) ;GET TABLE WORD
TRNN B,-1 ;IS IT "ALL"?
JRST ESALL ;YES
MOVE B,(B) ;GET FLAGS TO BE TURNED ON OR OFF
SKIPE ENAF ;ENABLING?
IORM B,STATF ;SET THE SPECIFIED FLAG
SKIPN ENAF
ANDCAM B,STATF ;TURN BIT OFF IF DISABLING
JRST ES1 ;GO MAKE SURE CHARACTER ACTIVATED
ESALL: MOVEI A,STAN ;PREPARE TO SET ALL FLAGS
ES2: SOJL A,ES1 ;GO TEST CHARACTER IF DONE
HRRZ B,STALST+1(A) ;GET ADDRESS OF FLAGS
MOVE B,(B) ;GET FLAGS
SKIPE ENAF
IORM B,STATF ;SET OR CLEAR FLAG
SKIPN ENAF
ANDCAM B,STATF
JRST ES2 ;DO REST OF FLAGS
;TABLE OF WHAT STATISTICAL INFORMATION CAN BE ENABLED
STALST: STAN,,STAN
T FILE-PROGRESS,[IOF]
T TIME-AND-LOAD,[DATEF]
T USAGES,[SHAREF]
STAN==.-STALST-1
;Here after enabling or disabling some statistics feature. If any
;statistics features are still enabled, assign the interrupt character.
;If none are assigned anymore, disable the flag.
ES1: SKIPN A,STATF ;ANY FLAGS ON?
JRST ES3 ;NO, GO DISABLE CHARACTER
MOVE A,[STC,,0]
ATI ;CALL DTIMER FIRST TO SET UP LSTTIM!
RET
;Routine to print what's enabled and what's disabled under STATISTICS.
STASKP: SKIPN A,STATF ;ANY FLAGS SET?
JRST [ TYPE <* DISABLE STATISTICS-REPORTING (OF) ALL-FEATURES
>
JRST R2SKP] ;TELL CALLER WE'VE DONE ALL THE WORK
MOVEI D,STAN ;PREPARE TO SCAN ENTIRE TABLE
STAS1: SOJL D,R2SKP ;DOUBLE SKIP TO SAY WE'VE DONE THE WORK
MOVE B,STALST+1(D) ;GET TABLE WORD
HLRO A,B ;GET POINTER TO STRING
MOVE B,(B) ;GET BIT IN QUESTION
TDNE B,STATF ;DECIDE IF FEATURE IS ENABLED
TYPE <* ENABLE STATISTICS-REPORTING (OF) >
TDNN B,STATF
TYPE < DISABLE STATISTICS-REPORTING (OF) >
PSOUT ;TYPE OF WHAT!
TYPE <
>
JRST STAS1 ;DO REST
ES3: MOVEI A,STC
DTI
RET
;HERE TO CONTROL SPY PROTECTION
.ESPY: CALL OURCFM
SETOM SPYF
RET
SPYSKP: SKIPE SPYF ;SPY CHECKING ENABLED?
RETSKP ;YES
RET ;NO
.DSPY: CALL OURCFM
SETZM SPYF
RET
;HERE TO ENABLE AND DISABLE BUGCHK REPORTING
.EBUGC: CALL OURCFM
SETOM BUGCHF ;SAY WE'RE ALLOWED TO PRINT BUGCHKS
RET
BUGSKP: SKIPE BUGCHF ;DOING BUGCHK REPORTING?
RETSKP ;YES
RET ;NO
.DBUGC: CALL OURCFM
SETZM BUGCHF ;DON'T REPORT BUGCHKS
RET
COMLST: COMLN,,COMLN
T DISABLE ;DISABLE FEATURES
T ENABLE ;ENABLE FEATURES
TA EX ;[NIC] ABBREVIATION
T EXCLUDE ;EXCLUDE SOMETHING FROM PRINTOUT
.EX: T EXIT ;EXIT
T INCLUDE ;INCLUDE SOMETHING IN OUTPUT
T QUIT ;QUIT COMPLETELY
T SET ;SET PARAMETERS
T SHOW
COMLN==.-COMLST-1
SETLST: SETLN,,SETLN
T INTERRUPT-CHARACTER,.INTC ;CHANGE ^Y TO SOMETHING ELSE
SETLN==.-SETLST-1
.INTC: STKVAR <NCHAR,OCHAR>
NOISE (TO)
MOVEI A,[FLDDB. .CMTXT,CM%SDH,,<New character for getting to DATE command level>]
CALL RFIELD ;GET CHARACTER IN ATOM BUFFER
LDB A,[261600,,ATMBUF] ;GET CHARACTER AND TERMINATING NULL
TRNE A,177 ;MAKE SURE ONLY ONE CHARACTER TYPED
COMERR <Only single character allowed>
LSH A,-7 ;GET THE CHARACTER ITSELF
MOVEM A,NCHAR ;REMEMBER NEW CHARACTER
CALL OURCFM ;MAKE SURE HE MEANS IT
MOVE A,ICHAR
MOVEM A,OCHAR ;REMEMBER CHARACTER TO CANCEL
MOVE A,NCHAR ;SET UP CHARACTER AS NEW ONE
CALL SETIC
MOVE A,OCHAR ;CANCEL THE OLD CHARACTER
DTI
MOVX D,1B0
MOVN B,OCHAR ;GET BIT POSITION FOR OLD CHARACTER
LSH D,(B)
MOVX A,RT%DIM!.FHSLF
RTIW ;GET CURRENT SETTINGS
TDZ C,D ;MAKE OLD CHARACTER NOT DEFERRED ANYMORE
STIW
RET
;ROUTINE TO SET UP CHARACTER IN A AS INTERRUPT CHARACTER.
SETIC: HRL A,A ;PUT CHARACTER IN LEFT HALF
HRRI A,CTYCHN ;SAY WHICH CHANNEL TO ASSOCIATE IT WITH
ATI ;TRY TO MAKE THE ASSOCIATION
ERCAL [COMERR <Invalid interrupt control-character>]
HLRZM A,ICHAR ;REMEMBER NEW CHARACTER
MOVX D,1B0 ;SET INTERRUPT CHARACTER TO BE DEFERRED
MOVN B,ICHAR
LSH D,(B) ;GET CORRECT BIT
MOVX A,RT%DIM!.FHSLF ;GET DEFERRED, OURSELF
RTIW ;READ TERMINAL MASK
IOR C,D ;INCLUDE NEW CHARACTER IN MASK OF DEFERRED CHARACTERS
STIW ;TELL THE SYSTEM
RET
SHOLST: SHOLN,,SHOLN
T BUG-STRING,.BUGST ;SHOW TEXT FOR BUG NAME
T BUGHLTS ;SHOW BUGHLTS SINCE PREVIOUS LOGIN
T LOGIN-TIME,LOGTIM ;SHOW TIME USER LAST LOGGED IN
T SETTINGS ;SHOW WHAT'S BEEN SET
T SYMBOLS ;SHOW SYMBOLS MATCHING PARTICULAR VALUE
T VALUE ;SHOW VALUE OF SYMBOL
T WHO'S-USING,.WHO ;SHOW WHO'S USING FILE
SHOLN==.-SHOLST-1
FLBLEN==10 ;LENGTH OF FDB
.WHO: TRVAR <LSTJOB,WJOBZ,<FLBNUM,FLBLEN>,<DEFNUM,3>,NXTWRD,JJFN,ANYFS,JNAM,JTYP,<WHOLE,FILWDS>,WSTK,WJOB,WJCTR,WHLPTR,WJFNZ,WJFN>
NOISE (FILE)
SETZM ANYFS ;COUNT HOW MANY FILESPECS PRINTED
SETOM LSTJOB ;GUARANTEE JOB NUMBER PRINTOUT FIRST TIME
SETZM CJFNBK ;INITIALIZE JFN BLOCK
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1 ;START WITH NOTHING IN THE BLOCK
MOVX A,.GJALL!GJ%IFG!GJ%OFG ;ALL GENERATIONS (DEFAULT), RECOGNIZE UNTIL WILDCARDS SEEN
MOVEM A,.GJGEN+CJFNBK
HRROI A,[ASCIZ /DSK*/] ;MONITOR DEFICIENCY WON'T ALLOW *:
MOVEM A,.GJDEV+CJFNBK ;DEVICE
HRROI A,[ASCIZ /*/] ;DEFAULT ALL FIELDS TO WILD
MOVEM A,.GJDIR+CJFNBK ;DIRECTORY
MOVEM A,.GJNAM+CJFNBK ;NAME
MOVEM A,.GJEXT+CJFNBK ;TYPE
MOVEI A,[FLDDB. .CMFIL]
CALL RFIELD ;GET FILESPEC
MOVEM B,WJFN ;REMEMBER JFN
NOISE (FROM JOB NUMBER)
MOVEI A,[FLDDB. .CMNUM,CM%SDH,5+5,<Job number to start with>,<0>]
CALL RFIELD ;READ STARTING JOB NUMBER
MOVEM B,WJOB ;REMEMBER WHICH JOB TO START WITH
NOISE (THROUGH JOB NUMBER)
HRLI A,[FLDDB. .CMNUM,CM%DPP!CM%SDH,5+5,<Highest job number to search>]
HRRI A,FLBNUM
BLT A,-1+FLBLEN+FLBNUM ;COPY FDB FOR FIXING
HRROI A,DEFNUM ;CREATE DEFAULT FOR SECOND ARG
MOVEM A,.CMDEF+FLBNUM ;STORE DEFAULT POINTER
MOVEI B,JMAXLN-1 ;DEFAULT IS THROUGH ALL POSSIBLE JOBS ON SYSTEM
MOVEI C,5+5 ;DECIMAL NUMBER
NOUT
JSERR
MOVEI A,FLBNUM ;POINT TO OUR CREATED FDB
CALL OURCFD ;READ ENDING JOB NUMBER
MOVEM B,WJOBZ
CALL GOBSYM ;GET SYMBOLS NEEDED
JRST [ HRROI A,[ASCIZ /DATE: Couldn't read monitor symbol definitions/]
ESOUT
RET] ;GIVE UP
MOVEM P,WSTK ;REMEMBER WHERE TO UNWIND STACK TO IF ERROR ON A JFN
WJLUP: MOVE A,WJOB ;SAY WHICH JOB
MOVEI B,MAXJFN ;SEE WHICH JFN IS HIGHEST IN USE FOR JOB
MOVEI C,0 ;NO OFFSET
CALL REDJOB
JRST WJDON ;IF CAN'T, SKIP THIS JOB
MOVEM A,WJFNZ ;REMEMBER HIGHEST JFN IN USE
MOVEI A,1 ;FIRST LEGAL JFN IS 1
MOVEM A,WJCTR
JJLUP: MOVE A,WJCTR ;GET JFN WE'RE ON
CAMLE A,WJFNZ ;MAKE SURE WE HAVEN'T EXCEEDED MAXIMUM JFN IN USE
JRST WJDON ;YES, SO GO ON TO NEXT JOB
MOVE A,FILSTS ;SAY WE WANT STATUS
CALL REDJFN ;READ STATUS FOR THIS JFN
TXNE A,GS%NAM ;IF NO FILESPEC FOR THIS JFN, SKIP IT
TXNE A,GS%AST!GS%ASG ;IF WILDCARD JFN OR BEING ASSIGNED, SKIP IT
JRST WJFD
MOVEI A,WHOLE ;INITIALIZE POINTER TO ENTIRE FILESPEC
HRLI A,440700 ;MAKE LEGAL BYTE POINTER
MOVEM A,WHLPTR
MOVE A,FILDDN
CALL REDJFN ;GET POINTER TO DEVICE NAME
HLRZ A,A ;DEVICE POINTER IS IN LEFT HALF
CALL JSTRING ;GET STRING FOR DEVICE NAME
MOVEI A,":"
IDPB A,WHLPTR ;PUT COLON AFTER DEVICE
MOVEI A,"[" ;START OF DIRECTORY
IDPB A,WHLPTR
MOVE A,FILDNM
CALL REDJFN ;GET POINTER TO DIRECTORY
HLRZ A,A ;POINTER IS IN LEFT HALT
CALL JSTRING
MOVEI A,"]" ;END OF DIRECTORY
IDPB A,WHLPTR
MOVE A,FILNEN
CALL REDJFN ;GET POINTERS TO NAME AND EXTENSION
HLRZM A,JNAM ;STORE POINTER IN JNAM FOR NOW
HRRZM A,JTYP ;STORE POINTER TO TYPE IN JTYPE
MOVE A,JNAM ;GET POINTER TO NAME
CALL JSTRING ;GET NAME
MOVEI A,"."
IDPB A,WHLPTR ;PUT DOT AFTER NAME
MOVE A,JTYP ;GET POINTER TO FILE TYPE
CALL JSTRING
MOVEI A,"."
IDPB A,WHLPTR ;PUT DOT AFTER FILE TYPE
MOVE A,FILVER
CALL REDJFN ;READ VERSION NUMBER
HRRZ B,A ;PUT VERSION WHERE NOUT WANTS IT
MOVE A,WHLPTR ;GET CURRENT POINTER TO ENTIRE STRING
MOVEI C,5+5 ;CREATE DECIMAL VERSION NUMBER
NOUT ;WRITE VERSION NUMBER ONTO FILESPEC
JSERR ;SHOULDN'T FAIL
MOVEM A,WHLPTR ;UPDATE POINTER TO CURRENT END OF ENTIRE FILESPEC
MOVEI A,.CHNUL ;PUT NULL AT END OF FILESPEC
IDPB A,WHLPTR
HRROI B,WHOLE ;GET POINTER TO ENTIRE FILESPEC
MOVX A,GJ%SHT!GJ%OFG ;SHORT FORM GTJFN, PARSE ONLY
GTJFN ;GET A HANDLE ON THE STRING
ERJMP WJFD ;SKIP THIS ONE IF FAILS (WHY SHOULD IT THOUGH?)
MOVEM A,JJFN ;REMEMBER JFN ON THIS FILESPEC
MOVEI A,.WLJFN ;COMPARE THIS JFN WITH ONE THE USER TYPED
MOVE B,WJFN ;GET JFN AND FLAGS THAT USER SUPPLIED
HRRZ C,JJFN ;GET JFN OF FILE THE JOB IS USING (WITHOUT FLAGS)
WILD% ;SEE IF THE FILE MATCHES WHAT WE'RE LOOKING FOR
TXNN A,WL%DEV!WL%DIR!WL%NAM!WL%EXT!WL%GEN ;MAKE SURE ALL FIELDS MATCH
CALL PJFN ;MATCH, SO PRINT OUT THIS ONE
HRRZ A,JJFN ;NO FURTHER NEED FOR JFN ON FILESPEC WE JUST LOOKED AT
RLJFN
JSERR ;SHOULDN'T FAIL CLOSING IT
WJFD: AOS WJCTR ;STEP TO NEXT JFN FOR THIS JOB
JRST JJLUP ;SEE IF THIS JFN IS INTERESTING
WJDON: AOS A,WJOB ;GO ON TO NEXT JOB
CAMG A,WJOBZ ;DONE ALL JOBS YET?
JRST WJLUP ;NO, GO DO THIS JOB
HRRZ A,WJFN ;RELEASE JFN USED FOR COMMAND
RLJFN
JSERR ;SHOULDN'T FAIL
MOVE A,ANYFS ;SAY HOW MANY FILES FOUND
CALL PDEC
TYPE < file>
CAIE B,1
TYPE <s>
TYPE < found.
>
RET ;YES, DONE
;PRINT OUT A GOOD ONE
PJFN: AOS ANYFS ;COUNT FILESPECS
MOVE B,WJOB ;PRINT JOB NUMBER
CAMN B,LSTJOB ;NEW JOB?
JRST PJ1 ;NO, SKIP JOB NUMBER AND NAME
MOVEM B,LSTJOB ;YES, REMEMBER
MOVEI A,.PRIOU ;TO PRIMARY OUTPUT
MOVX C,NO%LFL!FLD(3,NO%COL)!FLD(5+5,NO%RDX) ;LEADING FILLER, 3 COLUMNS, DECIMAL
NOUT
JSERR
TMSG < > ;SPACE
MOVE A,B
CALL GUSER ;GET USER NAME
JRST [ TMSG <?>
JRST PJ1] ;GUY PROBABLY LOGGED OUT
MOVE B,A
MOVEI A,.PRIOU
DIRST ;PRINT USER NAME
TMSG <?> ;TYPE QUESTION MARK IF HE LOGGED OUT
PJ1: MOVEI A,^D25
CALL GETHER ;GET TO COLUMN 25
MOVEI A,.PRIOU ;FAILING DIRST MAY HAVE CLOBBER A
MOVE B,JJFN ;FILESPEC
MOVEI C,0 ;NO SPECIAL BITS
JFNS
HRROI B,[ASCIZ /
/]
SOUT ;END OF LINE
RET
;ROUTINE TO GET TO COLUMN OF TERMINAL LINE SPECIFIED IN A.
GETHER: STKVAR <WHERE2>
MOVEM A,WHERE2 ;REMEMBER WHERE WE'RE GOING
GETH1: MOVEI A,.PRIOU ;PRIMARY OUTPUT
RFPOS ;SEE WHERE WE ARE NOW
HRRZ D,B ;REMEMBER COLUMN IN D
CAMLE D,WHERE2 ;MAKE SURE THERE'S SPACE
JRST [ TMSG <
> ;THERE'S NOT, SO GO TO NEXT LINE
JRST GETH1] ;TRY AGAIN
MOVEI B," "
G2: CAML D,WHERE2 ;MORE TO DO?
RET ;NO, DONE
BOUT ;YES, TYPE A SPACE
AOJA D,G2 ;LOOP UNTIL WE'RE THERE
;HERE WHEN FAILURE DURING A JFN
JJBAD: MOVE P,WSTK ;GET OUT OF SUBROUTINE IN WHICH FAILURE OCCURED
JRST WJFD ;GO ON TO NEXT JFN
;GET CONTENTS OF JFN DATA CELL
REDJFN: MOVE B,WJCTR ;SEE WHICH JFN WE'RE LOOKING AT
IMUL B,MLJFN ;COMPENSATE DUE TO SIZE OF JFN BLOCK
ADD B,A ;GET JSB ADDRESS WE WANT TO READ
MOVE A,WJOB ;SAY WHICH JOB WE WANT TO LOOK AT
CALL REDJSB ;READ WORD FROM JSB
JRST JJBAD ;FORGET THIS JFN IF FAILS
RET
;GET PORTION OF FILESPEC
JSTRING:
MOVEM A,NXTWRD ;REMEMBER ADDRESS OF NEXT WORD OF TEXT
JS1: AOS B,NXTWRD ;GET ADDRESS CONTAINING NEXT PORTION OF STRING
MOVE A,WJOB ;SAY WHICH JOB'S JSB TO READ
CALL REDJSB ;READ WORD FROM JSB
JRST JJBAD ;ASSUME JFN NO GOOD IF FAILS
MOVSI C,-5 ;DO AT MOST 5 CHARACTERS
MOVEI B,.CHCNV ;GET QUOTING CHARACTER
JS2: ROT A,7 ;GET NEXT ASCII CHARACTER
TRNN A,177 ;DONE IF NULL FOUND
JRST JS3
IDPB B,WHLPTR ;PUT IN QUOTE IN CASE FUNNY CHARACTER
IDPB A,WHLPTR ;PUT IN REAL CHARACTER
AOBJN C,JS2 ;LOOP UNLESS ALL FIVE CHARACTERS DONE
JRST JS1 ;NO NULL YET, GO BACK AND GET NEXT WORD
JS3: RET
;SET PARAMETERS
.SET: MOVEI A,[FLDDB. .CMKEY,,SETLST]
JRST SHOW1 ;REST LIKE SHOW
;SHOW VARIOUS THINGS IMMEDIATELY
.SHOW: MOVEI A,[FLDBK. .CMKEY,,SHOLST,,,[BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<'>]]
SHOW1: CALL RFIELD
MOVE B,(B)
CALLRET (B) ;DO WHATEVER
.BUGHL: NOISE (SINCE YOUR PREVIOUS LOGIN)
CALL OURCFM
CALLRET PRTHLT ;DO THE WORK
;TABLE OF ENABLABLE FEATURES
ENALST: ELSTN,,ELSTN
T BUGCHK-REPORTING,[BUGSKP,,.EBUGC]
T GRUMP-CHECKING,[GRUSKP,,.EGRUM]
T HOG-CHECKING,[HOGSKP,,.EHOG]
T INSTANT-PUSH,[INSSKP,,.EINST]
T LOGGING,[LOGSKP,,.ELOG]
T MAIL-PREVIEWING,[MALSKP,,.EMAIL]
T SPY-PROTECTION,[SPYSKP,,.ESPY]
T STATISTICS-REPORTING,[STASKP,,.ESTAT]
T UPDATE-FILE-CHECKING,[UFLSKP,,.EUFIL]
ELSTN==.-ENALST-1
;ROUTINE TO DISPLAY SETTINGS
.SETTI: CALL OURCFM ;MAKE SURE HE MEANS IT
STKVAR <NOI,TRA,ENAS>
HLRZ A,ENALST ;SEE HOW MANY TO DO
MOVEM A,ENAS
SETLUP: SOSGE A,ENAS ;MORE ITEMS TO DISPLAY?
JRST [ CALL INFBUG ;REPORT IGNORED BUGCGHKS
TYPE <---
> ;SEPARATE LIST FROM NEXT LINE ON TERMINAL
RET]
HRRZ B,1+ENALST(A) ;GET ADDRESS CONTAINING CONTROL ADDRESSES
HLRZ B,(B) ;GET TEST ROUTINE ADDRESS
MOVEM B,TRA ;REMEMBER IT
HLRO B,1+ENALST(A) ;GET POINTER TO NAME OF ITEM
MOVEM B,NOI ;REMEMBER IT
CALL @TRA ;SKIP IF ITEM ENABLED
JRST SETDIS ;DISABLED
JRST SETENA ;ENABLED
JRST SETLUP ;THE "SKP" ROUTINE DID ALL THE WORK
SETENA: TYPE <* ENABLE >
JRST SETFLN ;DO REST OF LINE
SETDIS: TYPE < DISABLE >
SETFLN: MOVE A,NOI ;GET NAME OF ITEM
PSOUT ;TYPE IT
TYPE <
>
JRST SETLUP ;LOOP TO SHOW REST OF SETTINGS
;TABLE OF DISABLABLE FEATURES
DISLST: DLSTN,,DLSTN
T BUGCHK-REPORTING,.DBUGC
T GRUMP-CHECKING,.DGRUM
T HOG-CHECKING,.DHOG
T INSTANT-PUSH,.DINST
T LOGGING,.DLOG
T MAIL-PREVIEWING,.DMAIL
T SPY-PROTECTION,.DSPY
T STATISTICS-REPORTING,.DSTAT
T UPDATE-FILE-CHECKING,.DUFIL
DLSTN==.-DISLST-1
;DISABLE THINGS
.DISAB: NOISE (FEATURE)
MOVEI A,[FLDDB. .CMKEY,,DISLST]
CALL RFIELD ;SEE WHAT'S BEING DISABLED
MOVE B,(B) ;GET TABLE WORD
CALLRET (B) ;DISABLE WHAT HE REQUESTED
;ENABLE VARIOUS FEATURES
.ENABL: NOISE (FEATURE)
MOVEI A,[FLDDB. .CMKEY,,ENALST]
CALL RFIELD
MOVE B,(B) ;GET TABLE WORD
MOVE B,(B) ;GET CONTROL WORD
CALLRET (B) ;DO THE ENABLING
;INITIALIZATION ROUTINE WHICH GENERATES ASCII SYMBOL TABLE
SYMINI: TRVAR <BLTPTR,WSYM,NSYMS>
SKIPE SYMF ;HAVE WE ALREADY DONE THIS?
RET ;YES
HLRE A,.JBSYM ;GET NEG NUMBER OF WORDS IN SYMBOL TABLE
ASH A,-1 ;DIVIDE BY 2 TO GET NEGATIVE NUMBER OF SYMBOLS
MOVN A,A ;GET POSITIVE SYMBOLS
HRRZ P1,A ;REMEMBER HOW MANY SYMBOLS TO DO
ADDI A,SYMLST+1 ;CALCULATE FIRST ADDRESS BEYOND TABLE
HRRZM A,SYMEND ;MARK BEGINNING OF TEXT SPACE
MOVEM P1,-1(A) ;START WITH LENGTH 0 TABLE
HRLI A,-1(A) ;MAKE LEFT HALF OF BLT POINTER
SUBI A,2 ;FINISH BLT POINTER
MOVEM A,BLTPTR ;REMEMBER IT FOR INSERTING ENTRIES
MOVEM P1,NSYMS ;REMEMBER NUMBER OF SYMBOLS
MOVEI A,0 ;FIRST DO ALPHABETICS (IDEA IS TO REDUCE TOTAL WORDS MOVED VIA BLT BELOW)
CALL DOSYMS
MOVE P1,NSYMS ;RESTORE NUMBER OF SYMBOLS
MOVEI A,1 ;DO SYMBOLS STARTING WITH FUNNY CHARACTERS
CALL DOSYMS
HLRZ A,BLTPTR ;GET ADDRESS OF ACTUAL TABLE BEGINNING
MOVEM A,SYMTAD ;REMEMBER WHERE TABLE BEGINS
SETOM SYMF ;REMEMBER THAT WE'VE INITIALIZED SYMBOL TABLE
RET ;DONE
DOSYMS: MOVEM A,WSYM ;REMEMBER WHETHER DOING FUNNY SYMBOLS
HRRZ P2,.JBSYM ;GET ADDRESS OF FIRST SYMBOL
SYMLUP: SOJL P1,R ;LEAVE LOOP WHEN ALL SYMBOLS DONE
MOVE A,(P2) ;GET NAME OF SYMBOL IN RADIX-50
TLZ A,740000 ;GET RID OF FLAGS
IDIVI A,50 ;FIND FIRST CHARACTER
JUMPN A,.-1
MOVE A,WSYM ;0 FOR ALPHABETIC, NON-0 FOR FUNNY
CAIL B,45 ;DOES SYMBOL START WITH DOT, PERCENT ETC.?
JUMPE A,SYMLP1 ;YES, SKIP IF DOING ALPHABETIC.
CAIGE B,45 ;ALPHABETIC?
JUMPN A,SYMLP1 ;YES, SKIP IF DOING FUNNY SYMBOLS
MOVE A,(P2) ;DOING THE SYMBOL, GET IT AGAIN
CALL R50TAS ;CHANGE TO ASCII
DMOVEM A,@SYMEND ;STORE THE ASCII
HLRZ A,BLTPTR ;GET CURRENT BEGINNING OF TABLE
HRRO B,SYMEND ;GET POINTER TO NEW STRING
TBLUK ;SEE WHERE IT GOES
TXNE B,TL%EXM ;ALREADY IN TABLE?
JRST SYMLP1 ;YES, SKIP IT.
MOVE D,BLTPTR ;GET BLT POINTER
BLT D,-2(A) ;MAKE ROOM FOR ENTRY
MOVE D,BLTPTR
ADJSP D,-1 ;FIX BLT POINTER FOR NEXT TIME
MOVEM D,BLTPTR
HRL B,SYMEND ;POINTER TO NAME IN LEFT HALF
HRRI B,1(P2) ;ADDRESS OF VALUE IN RIGHT HALF
MOVEM B,-1(A) ;STORE NEW ENTRY IN TABLE
MOVSI B,1 ;CONSTANT TO UPDATE HEADER
ADDM B,1(D) ;FIX HEADER TO ACCOUNT FOR NEW ENTRY
AOS SYMEND
AOS SYMEND ;STEP TO NEXT SLOT FOR NAME
SYMLP1: ADDI P2,2 ;STEP TO NEXT DDT SYMBOL SLOT
JRST SYMLUP ;DO REST OF SYMBOLS
;ROUTINE CHANGING RADIX50 IN A TO ASCIZ IN A AND B
R50TAS: TLZ A,740000 ;CLEAR JUNK PART
MOVE D,[440700,,A] ;MAKE ASCIZ POINTER
CALL R50OUL ;DO THE SYMBOL
MOVEI C,0 ;END WITH NULL
IDPB C,D
RET ;DONE
R50OUL: IDIVI A,50 ;GET A DIGIT SPLIT OFF
JUMPE A,R50FIN ;DONE IF HAVE A ZERO
HRLM B,(P) ;NO, SAVE THIS DIGIT
CALL R50OUL ;AND LOOP
HLRZ B,(P) ;GET BACK SAVED DIGIT
R50FIN: MOVEI C," " ;IF NOTHING ELSE SET FOR SPACE
CAIN B,47 ;CODE FOR PERCENT SIGN?
MOVEI C,"%" ;YES, GET IT
CAIN B,46 ;CODE FOR A DOLLAR SIGN?
MOVEI C,"$" ;YES, GET IT
CAIN B,45 ;CODE FOR A PERIOD?
MOVEI C,"." ;YES, GET IT
CAIL B,13 ;IN RANGE OF A LETTER?
CAILE B,44 ;WELL?
SKIPA ;NO
MOVEI C,"A"-13(B) ;YES, GET IT
CAIGE B,13 ;FINALLY, IN RANGE OF A NUMBER?
MOVEI C,"0"-1(B) ;YES, GET IT
IDPB C,D ;OUTPUT THE CHAR
RET ;AND RETURN
;ROUTINE TO INITIALIZE TABLE OF BUG STRINGS
BUGINI: CALL SAVCMD ;SAVE COMND STATE WHICH WE MAY HAVE INTERRUPTED OUT OF
CALL BUGI0 ;DO THE WORK
CALL RESCMD ;RESTORE COMND STATE
RET
BUGI0: STKVAR <BUGJFN,BUGADD,BUGENT,<BUGPCW,2>>
SKIPE BUGIF ;ALREADY INITIALIZED TABLE?
RET ;YES, NO NEED TO DO ANYTHING NOW
MOVEI A,BUGMAX ;GET MAXIMUM ENTRIES
MOVEM A,BUGTAB ;INITIALIZE TABLE
MOVEI A,BUGSTR ;GET ADDRESS OF STRING AREA
MOVEM A,BUGADD ;INITIALIZE STRING ADDRESS
CALL CMDINI ;INITIALIZE FOR COMND JSYS
MOVEI A,.NULIO ;FORCE ERROR ON INPUT FROM FILE, AND DON'T DO ANY OUTPUT DURING .CMINI
MOVEM A,.CMIOJ+SBK
PROMPT () ;TYPE NULL PROMPT
MOVX A,GJ%OLD+GJ%SHT ;OLD, SHORT FORM
HRROI B,[ASCIZ /SYSTEM:BUGSTRINGS.TXT/]
GTJFN ;GET HANDLE ON BUGCHKS TABLE
JRST NOBUGS ;COULDN'T
MOVEM A,BUGJFN ;REMEMBER THE JFN
MOVE B,[70000,,200000] ;ASCII, READ
OPENF ;OPEN FOR READING
JRST NOBUG1
MOVE B,[2,,.FBBYV] ;WE WANT SIZE PARAMETERS OF FILE
MOVEI C,BUGPCW ;WHERE TO READ DATA INTO
GTFDB
LOAD C,FB%PGC,BUGPCW ;GET PAGE COUNT
CAILE C,BUGBSZ ;HAVE WE ALLOCATED ENOUGH ROOM FOR IT?
JRST [ TYPE <%DATE: Not enough room allocated for complete BUG table
>
MOVEI C,BUGBSZ ;TRIM TO MAXIMUM SIZE WE CAN HANDLE
JRST .+1]
IFE STANSW,<
TXO C,PM%PLD!PM%CNT!PM%RD ;PRELOAD, REPEATE COUNT, READ ACCESS
>;IFE STANSW
IFN STANSW,<
TXO C,PM%PLD!PM%CNT!PM%RD!PM%CPY ;PRELOAD, REPEATE COUNT, READ ACCESS
>;IFN STANSW
MOVE B,[.FHSLF,,BUGBPN]
HRLZ A,A ;START MAPPING FROM PAGE 0
PMAP ;GET THE DATA
LOAD A,FB%BSZ,BUGPCW ;GET BYTE SIZE OF FILE
IMUL A,1+BUGPCW ;MULTIPLY BY NUMBER OF BYTES TO GET NUMBER OF BITS
IDIVI A,7 ;GET NUMBER OF ASCII BYTES
MOVEM A,.CMINC+SBK ;TELL COMND HOW MANY CHARACTERS ARE LEFT TO READ
HRROI A,BUGBUF ;POINT TO BUFFER OF BUGS
MOVEM A,.CMBFP+SBK ;SAY COMMAND BUFFER BEGINS THERE
MOVEM A,.CMPTR+SBK ;NEXT INPUT TO BE PARSED ALSO BEGINS THERE
BUG1: MOVEI A,[FLDDB. .CMFLD] ;PREPARE TO READ BUGCHK NAME
CALL RFLDE ;READ IT, SKIP IF SUCCESSFUL
JRST BUGEOF ;COULDN'T
HRRO A,BUGADD ;MAKE POINTER TO WHERE NEXT NAME GOES
MOVEM A,BUGENT ;REMEMBER THIS ENTRY
MOVX B,CM%FW ;DECLARE FLAG WORD
MOVEM B,(A)
AOJ A, ;LEAVE ROOM FOR FLAG WORD
HRROI B,ATMBUF ;POINTER TO NAME JUST READ
MOVEI C,0 ;STOP ON NULL
SOUT ;WRITE THE BUGCHK NAME
IBP A ;LEAVE NULL AFTER NAME
AOJ A, ;GET ADDRESS OF WHERE NEXT STRING GOES
MOVEM A,BUGADD ;REMEMBER NEXT ADDRESS
MOVEI A,BUGTAB ;POINT TO TABLE
HRL B,BUGENT ;GET ENTRY
TBADD ;ADD IT TO TABLE
MOVEM A,BUGENT ;REMEMBER ADDRESS OF ENTRY
MOVEI A,[FLDBK. .CMFLD,,,,,[BRMSK. FLDB0.,FLDB1.,FLDB2.,FLDB3.,<[]>]]
CALL RFIELD ;READ ITEM OF FORM "[FOO]"
IFN STANSW,<
; I DON'T KNOW WHY THIS IS NECESSARY, BECAUSE .CMTXT SHOULD BE SMART.
; BUT IT ISN'T.
MOVE A,.CMPTR+SBK ;NEXT INPUT TO BE PARSED ALSO BEGINS THERE
BUG699: ILDB B,A ;GET BYTE OF THIS INPUT
JUMPE B,BUG69
CAIE B,.CHCRT
CAIN B,.CHLFD
JRST BUG69
CAIE B,"?" ;SCREW CASE?
JRST BUG699
MOVEI B,"."
DPB B,A
JRST BUG699
BUG69:
>;IFN STANSW
MOVEI A,[FLDDB. .CMTXT]
CALL RFLDE ;READ TEXT OF BUGCHK
JRST NOBUG2 ;COULDN'T
HRRO A,BUGADD ;GET ADDRESS FOR STRING
HRRM A,@BUGENT ;STORE ADDRESS OF TEXT IN RIGHT HALF OF TABLE ENTRY
HRROI B,ATMBUF ;POINT TO TEXT
MOVEI C,0 ;COPY THE STRING
SOUT
IBP A ;KEEP THE NULL
AOJ A, ;GET NEXT STRING ADDRESS
MOVEM A,BUGADD
MOVEI A,[FLDDB. .CMCFM]
CALL RFLDE ;GET TO NEXT LINE FOR NEXT BUG
JRST NOBUG2 ;FAILED (MUST BE OTHER TEXT ON THE LINE!)
JRST BUG1 ;LOOP FOR REST OF BUGCHKS
BUGEOF: HRROI A,-1 ;WE WANT TO CLEAR OUR BUFFER
MOVE B,[.FHSLF,,BUGBPN]
MOVX C,PM%CNT+BUGBSZ ;CLEAR ENTIRE BUFFER (OTHERWISE CLOSF WILL FAIL)
PMAP
MOVE A,BUGJFN ;GET JFN ON BUG FILE
CLOSF ;CLOSE THE FILE
JSERR ;SHOULDN'T FAIL
BUGDON: SETOM BUGIF ;REMEMBER THAT WE'VE BEEN THROUGH HERE
RET
NOBUGS: TYPE <
% DATE: Can't get bugstrings - >
HRLI A,.FHSLF ;OURSELF, ERROR CODE ALREADY IN A
CALL PERR1 ;SAY WHY
JRST BUGDON
NOBUG1: MOVE C,A ;OPENF ERROR CODE IN C
MOVE A,BUGJFN
RLJFN ;RELEASE THE JFN WE COULDN'T OPEN
JFCL ;IGNORE FAILURE
MOVE A,C
JRST NOBUGS ;GO PRINT REASON
NOBUG2: MOVE A,B ;ERROR IN C
JRST NOBUGS
;ROUTINE TO SAVE COMND STATE ON THE STACK - NECESSARY WHEN WE WANT
;TO USE COMND JSYS AT SOME LEVEL DEEPER THAN ONE IN WHICH COMND MAY ALREADY
;BE BEING USED
SAVCMD: POP P,C ;GET RETURN ADDRESS
HRLI A,CMDBEG ;SAVE COMND JSYS DATABASE, SINCE WE MAY HAVE INTERRUPTED OUT OF OTHER COMND STUFF!
HRRI A,1(P)
ADJSP P,CMDLEN ;LEAVE ROOM FOR IT ALL ON THE STACK
MOVEI B,CMDLEN-1(A) ;CALCULATE END OF AREA INTO WHICH STUFF BEING SAVED
BLT A,(B) ;SAVE THE COMND STUFF
JRST (C) ;RETURN
;UNDO THE MESS THAT SAVCMD MADE...
RESCMD: POP P,B ;GET RETURN ADDRESS
HRLI A,1-CMDLEN(P)
HRRI A,CMDBEG
BLT A,CMDBEG+CMDLEN-1 ;RESTORE COMND STORAGE
ADJSP P,-CMDLEN ;RELEASE STACK STORAGE USED FOR COMND
JRST (B) ;RETURN
;ROUTINE TO GET A PTY JFN
;returns: +1 error (probably no PTY's available)
; +2 A/ pty jfn
; B/ terminal designator for pty's terminal
GETPTY: STKVAR <PTYJFN,<DEVNAM,2>,FIRPTY,NUMPTY>
MOVEI A,.PTYPA
GETAB
ERCAL JSBOMB
HRRZM A,FIRPTY ;STORE TTY CORRESPONDENCE FOR PTY'S
HLRZ D,A ;GET NUMBER OF PTY'S
MOVN D,D ;GET # OF PTYS IN SYSTEM
HRLZS D
GETPT1: MOVSI A,600013 ;GET PTY DESIGNATOR
HRRI A,(D) ;TRY TO GET NEXT PTY
DVCHR ;GET CHARACTERISTICS OF THIS PTY
TLNN B,(1B5) ;IS IT AVAILABLE?
JRST GETPT2 ;NO
MOVE B,A
HRROI A,DEVNAM ;TURN IT INTO AN ASCII STRING
DEVST
JRST GETPT2
MOVEI B,":" ;TERMINATED BY A COLON
IDPB B,A
MOVEI B,0
IDPB B,A ;ENDED WITH A 0 BYTE
MOVSI A,1 ;SHORT FORM GTJFN
HRROI B,DEVNAM
GTJFN
JRST GETPT2 ;NOT AVAILABLE
MOVE B,[7B5+1B19+1B20] ;NOW TRY TO OPEN IT
MOVEM A,PTYJFN
OPENF
JRST GETPT3 ;NOT AVAILABLE
ADD D,FIRPTY ;TURN PTY UNIT # INTO TTY #
TRO D,(1B0) ;MAKE LEGAL TERMINAL DESIGNATOR
HRRZ B,D ;RETURN DESIGNATOR IN B
RETSKP
GETPT3: MOVE A,PTYJFN ;RELEASE BAD PTY
RLJFN ;AND RELEASE IT
JSERR
GETPT2: AOBJN D,GETPT1 ;TRY FOR ANOTHER PTY
RET ;FAILURE RETURN
;ROUTINE TO CALL CFIELD AND THEN RESUME EXEC
OURCFD: CALL CFIELD
CALLRET AFTEOL ;RESUME EXEC
;ROUTINE TO FINISH COMMAND, AND RESUME EXEC, SO PROGRAM RUNS WHILE WE
;THINK
OURCFM: CONFRM ;GET COMMAND CONFIRMATION
CALLRET AFTEOL ;RESUME EXEC, ETC.
AFTEOL: SAVEAC <A,B,C,D> ;DON'T CLOBBER WHAT COMND RETURNS
MOVE A,XFORK ;GET HANDLE ON EXEC
RFORK ;RESUME IT
RET
;TABLE WHICH WHEN INDEXED WITH n YIELDS A WORD WITH ONLY BIT n ON.
BITS: %%X==0
REPEAT ^D36,< 1B<%%X>
%%X==%%X+1
>
;ROUTINES TO BUFFER A STRING. GIVE IT POINTER TO STRING IN A.
;ROUTINE RETURNS POINTER TO BUFFERED STRING IN A.
;THE STRING ALWAYS BEGINS ON A WORD BOUNDARY. (SOME CALLERS ASSUME SO!)
BUFFS: MOVEI B,DICT ;SAY WHERE POOL STARTS
CALL READNM ;COPY STRING INTO FREE SPACE
COMERR <String space exhausted>
RET
;BUFFF buffers the atom buffer
;
;Returns +1: A/ pointer to buffered atom
BUFFF: HRROI A,ATMBUF ;POINT TO THE ATOM
CALLRET BUFFS ;BUFFER IT AND RETURN
;ROUTINE TAKING A STRING POINTER IN A. IT COPIES THE STRING TO FREE SPACE
;AND TAKES A SKIP RETURN, YIELDING THE POINTER TO THE STRING IN
;A. IF NO ROOM FOR THE STRING, A NON-SKIP RETURN IS TAKEN AND CONTENTS
;OF A IS INDETERMINATE
;GIVE IT FREE POOL HEADER ADDRESS IN B
READNM: STKVAR <FPA,RPTR,NEWPTR>
MOVEM A,RPTR ;REMEMBER POINTER
MOVEM B,FPA ;REMEMBER FREE POOL ADDRESS
CALL BCOUNT ;HOW MANY WORDS IN THIS STRING?
MOVE B,FPA ;SAY WHICH FREE POOL TO USE
CALL GETMEM ;GET THAT MANY
JRST NOREAD ;COULDN'T, SO TAKE NON-SKIP RETURN
HRLI B,440700 ;MAKE BYTE POINTER TO SPACE OBTAINED
MOVEM B,NEWPTR ;REMEMBER NEW POINTER
MOVE A,B
MOVE B,RPTR ;GET POINTER TO STRING
MOVEI C,0 ;STORE NULL AT END OF STRING
SOUT ;COPY THE STRING
MOVE A,NEWPTR ;GET ADDRESS WHERE STRING GOT PUT
RETSKP ;SUCCESFUL RETURN
NOREAD: RET ;NO ROOM FOR STRING
;ROUTINE TO GET MEMORY BLOCK. RETURNS +1 ALWAYS WITH ADDRESS OF BLOCK
;IN A. GIVE IT NUMBER OF WORDS DESIRED IN A.
GETBUF: MOVEI B,DICT ;USE CORRECT POOL
CALL GETMEM ;GET THE MEMORY
COMERR <DATE free space exhausted>
MOVE A,B ;RETURN ADDRESS IN A
RET
; /GETMEM/ - ROUTINE TO ASSIGN MEMORY AS REQUESTED
; INPUTS: A - CONTAINS NUMBER OF WORDS WANTED
; B - FREE SPACE HEADER ADDRESS
; OUTPUTS: A - NUMBER OF WORDS OBTAINED
; B - CONTAINS ADDRESS OF WORDS GOTTEN
; RETURNS: SKIPS IF SUCCESSFUL, NON-SKIP IF NO ROOM
GETMEM: STKVAR <<SAVSTF,2>,DADR>
MOVEM B,DADR ;REMEMBER HEADER ADDRESS
GETM2: MOVE C,B ;REMEMBER WHO POINTS TO CURRENT
HRRZ B,0(C) ;B IS NOW CURRENT BLOCK
JUMPE B,R ;IF 0, WE HAVE REACHED END OF THE ROAD
HLRZ D,0(B) ;GET SIZE OF CURRENT BLOCK
CAMGE D,A ;IS IT SUFFICIENT FOR REQUEST?
JRST GETM2 ;NO, SO TRY NEXT BLOCK
GETM3: HRL B,0(B) ;GET LINK OF CURRENT BLOCK
HLRM B,0(C) ;MAKE PREV LINK BE WHAT WAS OUR LINK
HRRZS B ;ISOLATE CURRENT BLOCKS ADDRESS
CAMN D,A ;IS THIS AN EXACT MATCH ON SIZE?
RETSKP ;SUCCESS, SKIP RETURN
DMOVEM A,SAVSTF ;SAVE NUMBER OF WORDS AND ADDRESS
ADD B,A ;GET FIRST WORD TO RETURN
SUBM D,A ;NUMBER OF WORDS TO RETURN
MOVE C,DADR ;GET ADDRESS OF CONTROL WORD
CALL RETMEM ;RETURN THE EXTRA WORDS
DMOVE A,SAVSTF ;RESTORE NUMBER OF WORDS AND ADDRESS
RETSKP ;SUCCESS, SKIP RETURN
;STREM ROUTINE TAKES POINTER TO STRING IN A, AND "REMOVES" THE STRING
;FROM THE STRING STORAGE SPACE. THE SPACE WHERE THE STRING WAS IS
;RETURNED TO FREE SPACE
STREM: SAVEAC <A,B,C,D> ; NEED TO BE TRANSPARENT
STKVAR <SPT000>
MOVEM A,SPT000 ;REMEMBER POINTER
CALL BCOUNT ;COUNT NUMBER OF WORDS IN THE STRING
HRRZ B,SPT000 ;GET RID OF BYTE POINTER P AND S
CALLRET RETBUF ;RETURN THE BUFFER
;RETBUF RETURNS A BUFFER TO FREE STORAGE
; A/ SIZE BEING RETURNED
; B/ ADDRESS OF BLOCK BEING RETURNED
RETBUF: MOVEI C,DICT ;SAY WHERE FREE SPACE IS
CALLRET RETMEM ;RETURN THE SPACE TO THE FREE POOL
; /RETMEM/ - ROUTINE TO DE-ALLOCATE MEMORY WHEN WE ARE THROUGH WITH IT
; INPUT: A - CONTAINS SIZE OF BLOCK TO RETURN
; B - CONTAINS ADDRESS OF BLOCK BEING RETURNED
; C - FREE SPACE HEADER ADDRESS
; OUTPUT: NONE
; RETURNS: ALWAYS CPOPJ
;
RETMEM: HRRZ D,0(C) ;GET PREV'S LINK
SKIPE D ;IF CURRENT IS 0 OR
CAIL D,0(B) ; ITS ADDRESS IS PAST ADDR OF RETURN BLK
JRST RETM4 ; THEN RETURN BLOCK HERE
MOVE C,D ;MAKE PREV=CURRENT
JRST RETMEM ;CONTINUE
RETM4: HRRM D,0(B) ;FORWARD PTR OF RETURNED BLOCK
HRRM B,0(C) ;FORWARD PTR OF PREV BLOCK
HRLM A,0(B) ;STORE SIZE OF THIS BLOCK
ADD A,B ;ADD ADDR+SIZE
CAIE A,0(D) ;ARE WE RIGHT UP AGAINST NEXT BLOCK?
JRST RETM5 ;NO, CANT COMBINE
HRRZ A,0(D) ;GET NEXT GUYS FORWARD LINK
HRRM A,0(B) ;MAKE IT OURS. IE POINT PAST HIM
HLRZ A,0(B) ;GET OUR SIZE
HLRZ D,0(D) ;GET HIS SIZE
ADD A,D ;GET OUR NEW COMBINED SIZE
HRLM A,0(B) ;STORE INTO RETURNED BLOCK
HRRZ D,0(B) ;GET LINK OF CURRENT BLOCK
RETM5: HLRZ A,0(C) ;GET PREV BLOCKS SIZE
ADDI A,0(C) ;ADD HIS ADDRESS AND SIZE
CAIE A,0(B) ;DOES HE BUTT RIGHT UP AGAINST US?
RET ;NO, RETURN WITH NO COMBINATION
HRRM D,0(C) ;MAKE PREV POINT TO OUR NEXT
HLRZ A,0(C) ;GET HIS SIZE
HLRZ B,0(B) ;AND OUR SIZE
ADD A,B ;COMBINE THE SIZES
HRLM A,0(C) ;STORE COMBINED SIZE
RET ;RETURN
;ROUTINE TO INITIALIZE FREE SPACE STORAGE.
FREINI: SETZM DICT ;INITIALIZE FREE SPACE SYSTEM
MOVEI A,FRESIZ ;FREE UP THIS MUCH FREE SPACE (ALL OF IT!)
MOVEI B,FREE ;STARTS AT ADDRESS IN B
CALL RETBUF ;FREE IT UP IN STANDARD WAY
MOVEI A,STRSIZ ;ALLOCATE SOME SPACE FOR STRINGS
CALL GETBUF
HRLI A,440700 ;MAKE POINTER TO STRING STORAGE
MOVEM A,CSBUFP ;REMEMBER POINTER TO STRING STORAGE
RET
;BCOUNT MEASURES AN ASCIZ STRING.
;
;ACCEPTS: A/ POINTER (-1,,FOO O.K.!)
;
;RETURNS+1: A/ NUMBER OF WORDS NEEDED IN A
; B/ NUMBER OF CHARACTERS
BCOUNT: CALL FIXPT ;CHANGE -1 TO 440700
MOVEI B,0 ;B WILL ACCUMULATE COUNT OF BYTES
BC1: ILDB C,A ;READ NEXT BYTE
CAIE C,0 ;DONE COUNTING IF NULL SEEN
AOJA B,BC1 ;NOT DONE, KEEP COUNTING
MOVE D,B ;REMEMBER EXACT COUNT IN D
AOJ B, ;LEAVE ROOM FOR NULL
IDIVI B,5 ;GET NUMBER OF WORDS
CAIE C,0 ;EXTRA CHARACTERS?
AOJ B, ;YES, THEY TAKE A WHOLE WORD
MOVE A,B
MOVE B,D ;RETURN BYTE COUNT IN B
RET
;USE R2SKP TO TAKE DOUBLE SKIP RETURN
R2SKP: AOS (P)
RETSKP
;ROUTINE WHICH RUNS AS LOWER FORK TO OUTPUT DATA TO TERMINAL THAT'S
;BEEN BUFFERED UP. IF THE TERMINAL OUTPUT EVER CATCHES UP WITH THE
;OUTPUT BUFFER POINTER, THE POINTER IS RESET TO THE BEGINNING OF THE
;BUFFER
;THE PURPOSE OF USING ANOTHER FORK IS SO THAT WE DON'T LOSE ANY
;INFORMATION DUE TO OUTPUT BEING BLOCKED ON THE TERMINAL
;THIS ROUTINE MUST BE LAST IN THE SOURCE CODE, AND CONTIGUOUSLY FOLLOWED
;BY .REQUIRE SYS:MACREL
SPILL: TRVAR <CHRCNT,CAFTER>
CALL TTYLCX ;DON'T ACCEPT MORE OUTPUT UNTIL WE TALLY.
SPILL1: MOVE A,TTYPNT
MOVE B,MIDPNT ;GET POINTER TO BEGINNING OF OUTPUT
CALL SUBBP ;FIGURE HOW MANY CHARACTERS TO OUTPUT
MOVNM A,CHRCNT ;REMEMBER NEGATIVE NUMBER TO PRINT
CALL TTYUL1 ;DON'T LEAVE TERMINAL LOCKED. MORE OUTPUT MIGHT COME WHILE WE'RE IN ^Q-WAIT
SETZM CAFTER ;NO ESCAPE CODES SEEN YET
SMORE: MOVE A,MIDPNT ;GET POINTER TO DATA
CALL FIXPT ;MAKE SURE IT'S A REAL BYTE POINTER
MOVE B,CHRCNT ;GET NEGATIVE CHARACTER COUNT
SMO1: AOJG B,SMO2 ;LEAVE LOOP IF EVERYTHING SCANNED
ILDB C,A ;AT LEAST ONE MORE CHARACTER, LOOK AT IT
CAIE C,SPLESC ;ESCAPE CODE?
JRST SMO1 ;NO, KEEP LOOKING
AOJG B,SMO2 ;YES, MAKE SURE THERE'S ANOTHER CHARACTER AFTER IT
ILDB C,A ;YES, SEE WHAT THE NEXT CHARACTER IS
CAIE C,"*" ;SPECIAL DIRECTIVE?
JRST SMO1 ;NO, KEEP LOOKING
MOVEM B,CAFTER ;REMEMBER COUNT TO USE AFTER ESCAPE SEQUENCE
SUB B,CHRCNT ;GET NUMBER OF CHARACTERS WE SCANNED
SUBI B,2 ;DON'T PRINT ESCAPE OR CODE
MOVNM B,CHRCNT ;SET UP COUNT FOR FIRST SECTION OF TEXT
SMO2: SKIPN CHRCNT ;ANYTHING TO PRINT
JRST SMO3 ;NO. SOUT GOES BONKERS WITH 0-LENGTH!
SKIPE LOGGF ;LOGGING?
CALL SPLOG ;YES, DO IT.
MOVEI A,.PRIOU ;USE PRIMARY OUTPUT
MOVE B,MIDPNT ;GET PLACE TO START OUTPUTTING FROM
MOVE C,CHRCNT ;GET NEGATIVE NUMBER OF CHARS
DOBE ;TRY NOT TO INTERFERE WITH OTHER OUTPUT
SOUT ;TYPE THEM (MIGHT HANG FOR AWHILE)
MOVEM B,MIDPNT ;SAVE POINTER SHOWING HOW MUCH WE OUTPUT
SMO3: SKIPE A,CAFTER ;IS THERE AN ESCAPE CODE?
JRST [ MOVEM A,CHRCNT ;YES, SET UP NEW COUNT
CALL OURHOM ;DO THE ESCAPE CODE
IBP MIDPNT ;DON'T DISPLAY THE ESCAPE SEQUENCE
IBP MIDPNT
SETZM CAFTER ;NO MORE ESCAPE CODES SEEN YET
JRST SMORE] ;GO CHECK FOR MORE ESCAPE CODES
CALL TTYLCX ;LOCK OUTPUT SO NONE HAPPENS
MOVE A,TTYPNT ;GET POINTER TO LAST CHAR IN BUFFER
CAME A,MIDPNT ;DID MORE COME IN DURING THE SOUT?
JRST SPILL1 ;YES, GO BACK AND CONTINUE EMPTYING BUFFER
SPILL3: HALTF ;HALT TO SIGNAL THAT WE CAN BE FLUSHED NOW
;OURHOM is called to home up during typeout of announcements
;This gives them a chance of being seen even during EMACS editing
OURHOM: CALL TERCHK ;GET CURRENT TERMINAL TYPE
SKIPN A,HEIGHT
JRST OURH1 ;DON'T TRY TO GO TO BOTTOM OF 0-LENGTH SCREEN
MOVEM A,OLDX ;FORCE MOVEMENT
CALL HOLSCN ;CAUSE WHOLE SCREEN TO BE USED
MOVEI A,0 ;FIRST GET TO BOTTOM OF SCREEN INTERNALLY
CALL PPOINT
OURH1:
IFN STANSW,<
MOVEI A,.CHCRT ;DO CR FIRST
CALL TYO
>;IFN STANSW
MOVEI A,.CHLFD ;NOW DO LINEFEED TO GET CLEAN LINE
CALL TYO
CALLRET FORCE ;MAKE SURE OUTPUT GETS SEEN NOW
;SPLOG UPDATES THE LOG FILE IF LOGGING IS ENABLED
SPLOG: MOVE A,LOGJFN ;GET CHANNEL ON LOG FILE
MOVE B,[FLD(7,OF%BSZ)!OF%WR!OF%RD] ;APPEND BUT ALLOW BKJFN
OPENF ;OPEN THE LOG FILE
ERJMP SPLERR ;FAILED, GIVE UP
HRROI B,-1 ;GET TO END OF FILE
SFPTR
ERJMP SPLERC ;FAILED, SO BOMB OUT
MOVE B,MIDPNT ;GET PLACE TO START OUTPUTTING FROM
MOVN C,CHRCNT ;GET POSITIVE COUNT TO CATCH BELL
MOVEI D,.CHBEL ;STOP AFTER BELL
SPSOUT: SOUT ;WRITE THE DATA
ERJMP SPLERC ;FAILED, PROBABLY OVER QUOTA
LDB D,B ;GET LAST CHARACTER OUTPUT
CAIN D,.CHBEL ;WAS IT A BELL?
JRST [ BKJFN ;YES, BACK UP POINTER TO GET RID OF IT
ERJMP SPLERC ;COULDN'T BACK UP, SO DIE
JUMPN C,SPSOUT ;IF MORE TO DO, DO IT
JRST .+1]
TXO A,CO%NRJ ;SUCCESSFUL, SO DON'T RELEASE JFN
CLOSF
ERJMP SPLERR ;WHOOPS, THIS CLOSF IS IMPORTANT.
RET
SPLERC: TXO A,CO%NRJ ;PREVENT RACE OF SOMEONE ELSE GETTING JFN AND THEN WE RLEASE IT!
CLOSF ;CLOSE THE FILE
JFCL ;CLOSF SHOULDN'T FAIL
SPLERR: HRROI A,[ASCIZ /DATE: Logging failure - /]
ESOUT ;START ERROR MESSAGE
CALL PERR ;FINISH ERROR MESSAGE
TMSG <Logging being disabled.
>
SETZM LOGGF ;TURN OFF LOGGING
MOVE A,LOGJFN
RLJFN ;RELEASE THE JFN
ERJMP .+1 ;IGNORE FAILURE.
RET
DEFINE SCREEN (TABLE)
<
MOVE D,TRMTYP
JUMPL D,.+5
CAIL D,TRMLEN
JRST .+3
SKIPE TABLE(D)
CALL @TABLE(D)
>
TRMLEN==50 ;ASSUMED LARGEST NUMBER OF TERMINAL TYPES
DEFINE TERINI (TABNAM)
<
TABNAM: BLOCK TRMLEN
DEFINE TER (TYPE,ADDRES)
<
%%Z==.
RELOC TABNAM+TYPE
ADDRES
RELOC %%Z
>>
;DISPLAY CODE...
ALPHA: CALL TYO
AOS A,OLDX
CAML A,WIDTH
SOS OLDX ;TYPING AT RIGHT MARGIN DOESN'T MOVE CURSOR!
RET
PPOINT: HLRZM A,X
HRRZM A,Y
MOVE A,X
MOVEM A,SX ;REMEMBER IT
MOVE A,Y
CALL NORMY
MOVEM B,SY
MOVE A,OLDX
MOVEM A,OX
MOVE A,OLDY
CALL NORMY
MOVEM B,OY
MOVE A,OLDX ;GET WHERE WE ARE NOW
SUB A,X
JUMPN A,PP2 ;IF NON-0 X DISTANCE, CHECK FOR SPECIAL CASE OF "BACK 2"
MOVE A,Y ;CORRECT COLUMN, GET ROW
SUB A,OLDY
JUMPE A,R ;NOTHING TO DO IF WE'RE AT EXACTLY CORRECT SPOT
AOJN A,PP1 ;DO REGULAR POSITIONING IF LINEFEED ISN'T SUFFICIENT
PP5: MOVEI A,.CHLFD
CALL TYO ;GO DOWN A LINE
CALL FILL ;SOME TERMINALS NEED FILLERS AFTER LINEFEED
JRST PP3 ;GO UPDATE CURRENT POSITION
PP1: MOVE A,X
MOVE B,Y
SCREEN <PNTTAB>
PP3: MOVE A,X
MOVEM A,OLDX ;REMEMBER WHERE WE ARE NOW
MOVE A,Y
MOVEM A,OLDY
RET
PP2: CAIE A,2 ;SPECIAL CASE OF BACKSPACING?
JRST PP4 ;NO, MAYBE DROPPING VERTICALLY
MOVE A,OLDY ;MAYBE, MAKE SURE NOT MOVING VERTICALLY
SUB A,Y
JUMPN A,PP1
MOVEI A,.CHBSP ;YES, JUST BACKSPACE TWO
CALL TYO
CALL TYO
JRST PP3 ;GO UPDATE CURRENT POSITION
PP4: CAIE A,1 ;GOING BACK JUST ONE (LIKE FOR DROPPING!)
JRST PP1 ;NO, DO STANDARD STUFF
MOVE A,OLDY ;YES, SEE IF DROPPING EXACTLY ONE POSITION
SUB A,Y
SOJN A,PP1 ;GO TO PP1 IF NOT
MOVEI A,.CHBSP ;BACKSPACE ONE (DUE TO DISPLAYED CHARACTER)
CALL TYO
JRST PP5 ;FALL INTO CODE THAT DOES LINEFEED
TERINI PNTTAB
TER .TTV05,DCA
TER .TTV50,V50PNT
TER .TTV52,DCA
TER .TT100,V100PT
IFN STANSW,<
TER .TTH19,DCA
>;IFN STANSW
V50PNT: JRST STEPTO
;WHEN STEPPING ACROSS AND DOWN IS BEST...
STEPTO: MOVE A,SY ;WHAT LINE WE WANT?
SUB A,OY ;CALCULATE VERTICAL DROP
CALL V50DWN ;DO DOWN RIGHT NUMBER OF LINES
MOVE A,SX ;GET POSITION WE WANT ON LINE
SUB A,OX ;CALCULATE DISTANCE RIGHT TO MOVE
CALLRET V50RIT ;STEP LEFT APPROPRIATE NUMBER OF SPACES
V50DWN: JUMPE A,R ;IF 0, WE'RE THERE
MOVE B,A
JUMPG A,VDWN ;DOWN IF POSITIVE
ULUP: MOVEI A,33
CALL TYO
MOVEI A,101
CALL TYO
AOJL B,ULUP
RET
VDWN: MOVEI A,33
CALL TYO
MOVEI A,102
CALL TYO
SOJG B,VDWN
RET
V50RIT: JUMPE A,R ;NOTHING TO DO IF 0
JUMPG A,V50R2 ;IF POSITIVE, REALLY RIGHT
MOVE B,A ;SAVE NUMBER OR LEFTS
MOVEI A,10 ;BACKSPACE CHARACTER
LLUP: CALL TYO ;DO A BACKSPACE
AOJL B,LLUP ;FINISH
RET
V50R2: MOVE B,OX ;GET OLD X POSITION
MOVEI A,11 ;GET A TAB
TRZ B,7
MOVEI C,0 ;TAB COUNTER
TABLUP: ADDI B,8 ;SEE WHERE TAB WOULD BRING US
CAMLE B,SX ;ROOM FOR SOME MORE TABS?
JRST CLUP1 ;NO
CALL TYO ;YES, TYPE ONE
AOJA C,TABLUP ;COUNT TABS AND LOOP FOR POSSIBLY ANOTHER
CLUP1: SUBI B,8 ;WE ADDED ONE TOO MANY 8'S
CAIN C,0 ;DID WE TYPE ANY TABS?
MOVE B,OX ;NO, SO START WITH OLD POSITION AGAIN
CLUP: CAML B,SX ;ARE WE WHERE WE WANT TO BE YET?
JRST CLEND ;YES
MOVEI A,33 ;NO, SPACE OVER
CALL TYO
MOVEI A,103
CALL TYO
AOJA B,CLUP
CLEND: RET
;VT100 DIRECT CURSOR ADDRESSING
V100PT: CALL V100XX ;SEND GARBAGE
MOVE A,SY ;SAY WHICH LINE
AOJ A, ;VT100 REGARDS 0 AND 1 BOTH AS TOP LINE
CALL DISNUM ;DISPLAY NUMBER
MOVEI A," ;" ;SEMI-COLON BETWEEN ARGS
CALL TYO
MOVE A,SX ;SAY WHICH COLUMN
CALL DISNUM
MOVEI A,"H" ;FINISH SEQUENCE
CALLRET TYO
;DISNUM displays a number
;
;Accepts: A/ number
DISNUM: STKVAR <DNPTR>
MOVE B,A ;NUMBER INTO B
MOVE A,CSBUFP ;WRITE NUMBER TO SCRATCH SPACE
MOVEI C,5+5 ;DECIMAL
NOUT
JSHLT
MOVE A,CSBUFP ;RESET POINTER TO NUMBER
MOVEM A,DNPTR ;REMEMBER POINTER
DISNLP: ILDB A,DNPTR ;GET NEXT CHARACTER OF NUMBER
JUMPE A,R ;NULL MEANS END OF NUMBER
CALL TYO ;TYPE A DIGIT
JRST DISNLP ;DO REST OF NUMBER
;THIS ROUTINE FOR TERMINALS THAT ARE CAPABLE OF DIRECT CURSOR ADDRESSING
DCA: MOVE A,SY
CALL DISY
MOVE A,SX
CALL DISX
RET
;NORMALIZE POINT FROM QUADRANT 1 TO FUNNY SCREEN SYSTEM (Q4)
NORMY: MOVE B,HEIGHT
SUBI B,1(A)
RET
DEFINE NUM(X,Y)
<
TER X,[ MOVEI C,Y
RET]
>
;DEFAULT NUMBER OF LINES
TERINI DEFLEN
NUM .TTV05,^D20
NUM .TTV50,^D12
NUM .TTV52,^D24
NUM .TT100,^D24
IFN STANSW,<
NUM .TTH19,^D24
>;IFN STANSW
DISX: CALLRET DOX
DOX: ADDI A,40
CALLRET TYO ;GO TO X COORDINATE
DISY: PUSH P,A ;SAVE COORDINATE
CALL ESCAPE ;ESCAPE SEQUENCE
POP P,A ;RESTORE COORDINATE
ADDI A,40
CALL TYO ;GO TO COORDINATE
CALLRET FILL ;PUT IN FILLERS
ESCAPE: SCREEN <ESC1> ;DO APPRORIATE ESCAPE SEQUENCE FOR TERMINAL
RET
TERINI ESC1
TER .TTV05,V05ESC
TER .TTV52,V52ESC
IFN STANSW,<
TER .TTH19,V52ESC
>;IFN STANSW
;ESCAPE SEQUENCE FOR VT52 DIRECT CURSOR ADDRESSING
V52ESC: MOVEI A,33
CALL TYO
MOVEI A,"Y"
CALLRET TYO
;ESCAPE SEQUENCE FOR VT05 DIRECT CURSOR ADDRESSING
V05ESC: MOVEI A,"" ;CURSOR ADDRESSING CHARACTER
CALLRET TYO ;TYPE IT OUT
FILL: SCREEN <FILTAB>
RET
TERINI FILTAB
TER .TTV05,V05FIL
TER .TTG40,G40FIL
V05FIL: MOVEI A,0
CALL TYO
CALL TYO
CALL TYO
CALLRET TYO
;GT40 "SEEMS TO" ONLY NEED ONE FILLER AT 9600 BAUD.
G40FIL: MOVEI A,0
CALLRET TYO
;HOLSCN causes the whole screen to be the scrolling region
HOLSCN: SCREEN <HOLTAB>
RET
V100HL: CALL V100XX ;STANDARD VT100 ESCAPE SEQUENCE
MOVEI A,"r" ;SAY WE'RE SETTING SCROLLING REGION
CALLRET TYO
CLRSCN: CALL HOME ;HOME UP
CALL EOS ;CLEAR TO END OF SCREEN
CALLRET FORCE ;FORCE THE CLEARING TO BE SEEN IMMEDIATELY
HOME: SETZM OLDX
MOVEI A,0 ;SCREEN Y-COORDINATE 0
CALL NORMY
MOVEM B,OLDY
MOVE A,TTYJFN
MOVEI B,0
SFPOS ;TELL SYSTEM WHERE WE ARE
SCREEN <HOMTAB>
RET
V05HOM: MOVEI A," " ;HOMEUP CHARACTER
CALL TYO
CALLRET FILL
V100HM: CALL V100XX
MOVEI A,"H"
CALLRET TYO
V50HOM: MOVEI A,33
CALL TYO
MOVEI A,110
CALLRET TYO
V50EOS: MOVEI A,33
CALL TYO
MOVEI A,112
CALLRET TYO
EOS: SCREEN <EOSTAB> ;DISPATCH TO APPROPRIATE ROUTINE
RET
TERINI EOSTAB
TER .TTV05,V05EOS
TER .TTV50,V50EOS
TER .TTV52,V50EOS
TER .TT100,V100ES
IFN STANSW,<
TER .TTH19,V50EOS
>;IFN STANSW
TERINI HOLTAB ;Make entire screen be scrolling region
TER .TT100,V100HL
TERINI HOMTAB
TER .TTV05,V05HOM
TER .TTV50,V50HOM
TER .TTV52,V50HOM
TER .TT100,V100HM
IFN STANSW,<
TER .TTH19,V50HOM
>;IFN STANSW
V100ES: CALL V100XX
MOVEI A,"J"
CALLRET TYO
V100XX: MOVEI A,""
CALL TYO
MOVEI A,"[" ;SEND VT100 ESCAPE SEQUENCE
CALLRET TYO
V05EOS: MOVEI A," " ;END OF SCREEN CHARACTER
CALL TYO
CALLRET FILL
TYO: SAVEAC <A,B,C> ;DON'T CLOBBER CHARACTER
STKVAR <THECHR>
MOVEM A,THECHR ;SAVE THE CHARACTER
SKIPG BROOM ;ROOM IN BUFFER FOR ANOTHER CHARACTER?
CALL FORCE ;NO, FORCE OUT THE BUFFER
MOVE A,THECHR
IDPB A,BPTR ;STORE CHARACTER IN BUFFER
SOS BROOM ;SAY THERE'S LESS ROOM NOW
RET ;ALL DONE
;ROUTINE TO FORCE BUFFERED OUTPUT OUT
FORCE: MOVE A,TTYJFN ;NO, GET OUTPUT CHANNEL
HRROI B,BUFFER ;POINT TO OUTPUT BUFFER
MOVNI C,NBCHARS ;GET EXACT NUMBER OF CHARACTERS TO SEND
ADD C,BROOM ;ADJUST COUNT FOR EXACTLY WHAT'S IN IN BUFFER
CAIE C,0 ;0 ISN'T 0 TO SOUT!
SOUT ;WRITE THE CHARACTERS AS SO FAR
FRESET: MOVEI C,NBCHARS ;RESET BUFFER COUNT
MOVEM C,BROOM
MOVE A,[440700,,BUFFER]
MOVEM A,BPTR ;RESET BUFFER POINTER
RET
.REQUIRE SYS:MACREL ;MUST BE LAST FOR PMAP OF TTYFRK
END <3,,[ JRST BEG ;START ADDRESS IS BEG
JRST BEG ;NO SPECIAL REENTER, JUST START FOR NOW
%%LH,,%%RH]> ;VERSION NUMBER