Trailing-Edge
-
PDP-10 Archives
-
BB-Y393H-SM
-
monitor-sources/jsysa.mac
There are 53 other files named jsysa.mac in the archive. Click here to see a list.
;Edit 6732 to JSYSA.MAC by LEACHE on Thu 27-Jun-85, for SPR #17832
; Fix disk-allocation count problem at ENAC0
;Edit 6729 to JSYSA.MAC by SANTIAGO on Tue 18-Jun-85
; Prevent user getting password through address break
;; Fix originally by GLINDELL
;Edit 3188 to JSYSA.MAC by EVANS on Wed 12-Dec-84, for SPR #20023
; Remove edit 1866 - 3185 supersedes it.
;Edit 3182 to JSYSA.MAC by EVANS on Wed 14-Nov-84
; Call to LOGCJM caused writing of 2 session remarks (records)
;; Remove for now until better fix.
;Edit 3174 to JSYSA.MAC by LOMARTIRE on Fri 12-Oct-84, for SPR #18546
; Grant PM%WT in process to file PMAP% to allow section creates
;Edit 3173 to JSYSA.MAC by SHTIL on Fri 12-Oct-84 - REMOVE EDIT 3128
;Edit 3166 to JSYSA.MAC by GLINDELL on Mon 17-Sep-84, for SPR #17637
; ACJKIL must be resident since it is called from the sched cycle
;Edit 3153 to JSYSA.MAC by SHTIL on Mon 27-Aug-84 - Final fix for SPR# 20138
;Edit 3143 to JSYSA.MAC by EVANS on Mon 30-Jul-84, for SPR #20141
; Do not skip over first user account block on a page - this user
;; could never log in; the system never "saw" the account.
;Edit 3138 to JSYSA.MAC by SHTIL on Wed 18-Jul-84 - Final fix for 3137
;Edit 3137 to JSYSA.MAC by SHTIL on Mon 16-Jul-84 - CANCEL EDIT 3128
;Edit 3128 to JSYSA.MAC by SHTIL on Thu 21-Jun-84, for SPR #20108
; Let a user to set a file account regardless whether he is
;; WHEEL or OPR and what account he is presently running
;Edit 3127 to JSYSA.MAC by TBOYLE on Wed 20-Jun-84, for SPR #18961
; Fix session start and end times and checkpointed values
;Edit 3110 to JSYSA.MAC by EVANS on Fri 18-May-84
; ELIMINATE GARBAGE IN ACCOUNTING RECORDS BY GETTING NODE NAME FROM LLSR, NOT LLSR(P1)
;Edit 3078 to JSYSA.MAC by EVANS on Mon 5-Mar-84, for SPR #19898
; Make Attach, Detach, & Set Session Remark write USAGE records.
;Edit 3064 to JSYSA.MAC by CJOHNSON on Tue 3-Jan-84, for SPR #19853
; Make NIN return error if 2**35 or greater is input
;Edit 3041 to JSYSA.MAC by TSANG on Tue 8-Nov-83, for SPR #19555
; Modify Edit #3036
;Edit 3040 to JSYSA.MAC by CJOHNSON on Tue 8-Nov-83, for SPR #18631
; Return DESX2 error if SFCOC tried on another assigned tty
;Edit 3036 to JSYSA.MAC by TSANG on Thur 3-Nov-83, for SPR #19555
; Set the node name in Entry Header Record.
;Edit 3003 to JSYSA.MAC by TBOYLE on Mon 29-Aug-83, for SPR #19182
; Make TMON% leave RH unchnaged with .SFSOK function.
;Edit 3001 to JSYSA.MAC by TBOYLE on Mon 22-Aug-83, for SPR #17558
; Make RESET% cleat ARTHTR (Arithmetic traps)
;EDIT 2923 - PREVENT ILMNRF
; UPD ID= 285, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.13, 13-Jan-83 16:19:48 by MOSER
;EDIT 2899 - ALLOW PMAP DELETE OF PAGES IN NONEXISTANT FILE SECTION
; UPD ID= 271, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.12, 27-Dec-82 16:32:46 by WEETON
;EDIT 2890 - Check privs before doing .USCKI function of USAGE JSYS
; UPD ID= 241, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.11, 11-Nov-82 16:56:15 by MOSER
;EDIT 2858 - PREVENT ILPPT3 FROM RCVOK
; UPD ID= 211, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.10, 14-Oct-82 15:29:18 by MOSER
;EDIT 2836 - PREVENT PTNON0 WHEN USER LOGS IN - ACTLCK TRASHED
; UPD ID= 201, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.9, 6-Oct-82 14:38:42 by MOSER
;EDIT 2831 - PREVENT SPURIOUS RCVTMR BUGCHKS
; UPD ID= 173, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.8, 27-Sep-82 14:22:29 by MOSER
;EDIT 2816 - FIX DISPOSITION FOR REQUESTS AFTER GIVTMR, RCVTMR
; UPD ID= 168, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.7, 14-Sep-82 13:24:26 by MOSER
;EDIT 2814 - USE TPRCYC FOR OFFLINE EXPIRATION IN GTDIR
; UPD ID= 166, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.6, 14-Sep-82 11:42:07 by MOSER
;EDIT 2813 - RCVOK - RETURN -1 AS TERMINAL NUMBER IF DETACHED JOB
; UPD ID= 108, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.5, 27-Jul-82 15:54:42 by MOSER
;EDIT 2635 - INCLUDE NODE NAME IN USAGE RECORDS.
; UPD ID= 44, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.4, 3-Apr-82 17:52:42 by ZIMA
;Edit 2607 - Change ACVAR to use v5 MACSYM.
; UPD ID= 21, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.3, 21-Mar-82 15:55:10 by ZIMA
;Edit 2007 - Reset ARPANET connections in RESET JSYS.
; UPD ID= 14, FARK:<4-1-WORKING-SOURCES.MONITOR>JSYSA.MAC.2, 17-Mar-82 15:56:11 by ZIMA
;Edit 2003 - Fix NULQTA BUGHLTs from PMAP with non-open JFN.
;<4-1-FIELD-IMAGE.MONITOR>JSYSA.MAC.2, 25-Feb-82 20:24:56, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 937, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.15, 6-Jan-82 14:08:02 by MOSER
;EDIT 1971 - More of edit 1970.
; UPD ID= 930, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.14, 14-Dec-81 16:28:13 by MOSER
;EDIT 1970 - ADD ACTBBD BUGCHK FOR BAD ACCOUNT FILE.
; UPD ID= 799, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.13, 15-Sep-81 14:18:46 by SCHMITT
;Edit 1942 - add monitor uptime in UFRSTT record
; UPD ID= 735, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.12, 21-Aug-81 09:31:12 by ZIMA
;Edit 1927 - put edit 1907 in standard form. No code changes.
; UPD ID= 714, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.11, 18-Aug-81 16:37:26 by ZIMA
;Edit 1924 - put edit 1825 in standard form. No code changes.
;Edit 1924 - put edit 1823 in standard form. No code changes.
; UPD ID= 651, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.10, 9-Jul-81 11:51:24 by MOSER
;EDIT 1907 - Subtract 1 from arg block length before using it as a group
; counter in GTDGRP.
; UPD ID= 528, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.9, 12-May-81 17:37:41 by SCHMITT
;Edit 1872 - Lock ACTLCK before reference into HSHPG
; UPD ID= 513, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.8, 5-May-81 17:18:30 by SCHMITT
;Edit 1866 - Check for mounted structure at .DELDF
; UPD ID= 445, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.7, 14-Apr-81 17:23:23 by ZIMA
;Edit 1844 - Fix CFIBF, CFOBF, SFCOC, SFMOD, SFPOS, SOBE for noop conditions
; and LSTERR setting on errors.
; UPD ID= 398, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.6, 13-Feb-81 09:11:52 by DONAHUE
;Edit 1831 - Fix bug which prevented fork from clearing address break for self
; UPD ID= 358, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.5, 6-Jan-81 12:33:12 by SCHMITT
;Edit 1825 - Change call to FRKMAP in RMAP to FKHPTN and add ITERR return
; UPD ID= 347, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.3, 29-Dec-80 16:47:31 by SCHMITT
;Edit 1823 - Change .CACCT to perform USAGE login and logout rather than
; session end
; UPD ID= 311, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.3, 6-Dec-80 17:53:43 by ZIMA
;Edit 1812 - Fix ERSTR to recognize ERJMP/ERCAL better on errors.
; UPD ID= 215, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.2, 24-Sep-80 13:17:06 by ZIMA
;Edit 1787 - Fix USAGE JSYS .USRAS function to return values.
; UPD ID= 188, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.6, 4-Sep-80 11:45:34 by ZIMA
;Edit 1779 - Fix wild addressing problem in RPACS causing system crashes.
; UPD ID= 176, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.5, 2-Sep-80 13:56:34 by ZIMA
; UPD ID= 148, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.4, 26-Aug-80 16:16:34 by ZIMA
;Edit 1766 - fix RMAP to lock fork structure before touching PSBs.
; UPD ID= 138, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.3, 4-Aug-80 12:51:00 by SCHMITT
; UPD ID= 26, FARK:<4-WORKING-SOURCES.MONITOR>JSYSA.MAC.2, 4-Jun-80 11:11:45 by ZIMA
;EDIT 1724 - Fix wrong value for disk quota +infinity near ENAC0:
; UPD ID= 219, SNARK:<4.MONITOR>JSYSA.MAC.254, 24-Jan-80 09:45:52 by GRANT
;TCO 4.2598 - MAKE THE RELEASING OF PRARG'S JSB SPACE A SUBROUTINE (PRARGF)
;<4.MONITOR>JSYSA.MAC.253, 3-Jan-80 08:09:05, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
; UPD ID= 49, SNARK:<4.MONITOR>JSYSA.MAC.252, 29-Nov-79 09:14:40 by GRANT
;TCO 4.2583 - Make GETOK return an error status block
;TCO 4.2584 - Make GETOK correctly store a user-defined function code
;<4.MONITOR>JSYSA.MAC.251, 20-Nov-79 16:19:51, Edit by KONEN
;Allow indexed addresses for USAGE JSYS temporarily
;<4.MONITOR>JSYSA.MAC.250, 3-Nov-79 16:33:49, EDIT BY R.ACE
;BUG DOCUMENTATION
;<4.MONITOR>JSYSA.MAC.249, 3-Nov-79 11:19:35, EDIT BY R.ACE
;SMAP - CHANGE LK%CNT TO PM%CNT
;<4.MONITOR>JSYSA.MAC.248, 1-Nov-79 14:10:29, EDIT BY GRANT
;FIX SAVEAC ARGUMENTS IN SETACJ
;<4.MONITOR>JSYSA.MAC.247, 29-Oct-79 10:16:23, EDIT BY R.ACE
;REMOVE CPYUF1 BUGCHK
;<4.MONITOR>JSYSA.MAC.246, 24-Oct-79 18:13:02, EDIT BY MURPHY
;HANDLE SKIP/NOSKIP FROM SECMAP
;<4.MONITOR>JSYSA.MAC.245, 24-Oct-79 12:52:59, EDIT BY GRANT
;TCO 4.2543 - ADD RCVOK TIMER
;<4.MONITOR>JSYSA.MAC.244, 2-Oct-79 16:37:24, EDIT BY HALL
;SMAP - ALLOW ONLY PRIVATE SECTIONS
;<4.MONITOR>JSYSA.MAC.243, 2-Oct-79 16:33:55, EDIT BY MILLER
;FIX QUEUE HANDLING IN RCVOK TO BE RACE FREE
;<4.MONITOR>JSYSA.MAC.242, 2-Oct-79 09:41:49, Edit by KONEN
;MAKE SCNDNO CHECK ALIAS, RATHER THAN STR NAME
;MAKE CHKSAM AND HSHNAM IGNORE BIT 35
;IMPLEMENT -1 ARGUMENT AS CURRENT USER TO .VACCT
;<4.MONITOR>JSYSA.MAC.241, 1-Oct-79 15:40:21, EDIT BY MILLER
;MAKE SURE IF ACJ CALLED FOR ACCESS THAT SECOND PASS USES SAME FLAGS
; AND TARGET DIRECTORY NUMBER
;<4.MONITOR>JSYSA.MAC.240, 26-Sep-79 16:16:35, EDIT BY HALL
;UFNRAS - CALL BLTMU1 INSTEAD OF BLTMU FOR EXTENDED ADDRESSING
;<4.MONITOR>JSYSA.MAC.239, 26-Sep-79 15:49:46, EDIT BY HALL
;UFNSAS - CALL BLTUM1 INSTEAD OF BLTUM FOR EXTENDED ADDRESSING
;<4.MONITOR>JSYSA.MAC.238, 20-Sep-79 16:26:19, EDIT BY MURPHY
;HANDLE FAILURE OF TTSTI IN .STI
;<4.MONITOR>JSYSA.MAC.237, 20-Sep-79 15:41:54, EDIT BY HALL
;CRJOB,GETOK - CALL BLTUM1 INSTEAD OF BLTUM IN ORDER TO APPLY PCS IF NECESSARY
;RCVOK - CALL BLTMU1 INSTEAD OF BLTMU IN ORDER TO APPLY PCS IF NECESSARY
;<4.MONITOR>JSYSA.MAC.236, 18-Sep-79 16:12:06, EDIT BY HALL
;UFWFET - GET DATA ITEM USING INDEXED REFERENCE INSTEAD OF INDIRECT
;SO THAT ZERO SECTION IS DEFAULTED TO PCS
;<4.MONITOR>JSYSA.MAC.235, 14-Sep-79 15:43:27, EDIT BY MILLER
;TCO 4.2469. ADD .GOACC ACJ FUNCTION
;<4.MONITOR>JSYSA.MAC.234, 12-Sep-79 16:42:12, EDIT BY DBELL
;TCO 4.2462 - RESTORE TRASHED DIRECTORY NUMBER IN GTDIR
;<OSMAN.MON>JSYSA.MAC.1, 10-Sep-79 15:37:42, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>JSYSA.MAC.232, 27-Aug-79 13:51:32, Edit by KONEN
;REMOVE SETTING JOB ENABLED DURING LOGIN
;<4.MONITOR>JSYSA.MAC.231, 23-Aug-79 11:29:41, Edit by KONEN
;TCO 4.2417 - Correct check for "DSK*" for accounts file
;<4.MONITOR>JSYSA.MAC.230, 20-Aug-79 10:27:31, Edit by KONEN
;Allow account on file, if it is current account of user
;<4.MONITOR>JSYSA.MAC.229, 17-Aug-79 10:49:07, EDIT BY HALL
;MAKE RMAP HANDLE FAILURE FROM PTNFKH
;SMAP - HANDLE FAILURE FROM PMAP
;<4.MONITOR>JSYSA.MAC.228, 16-Aug-79 16:55:01, Edit by KONEN
;MAKE SURE LAST WORD OF ACCOUNT IN JSB IS ZEROED AFTER FINAL CHARACTER
; TO CORRECT INVALID ACCOUNT STRINGS WHEN DEFAULTING ACCOUNTS
;<4.MONITOR>JSYSA.MAC.227, 15-Aug-79 13:18:48, EDIT BY R.ACE
;CHANGE CALL TO CK2060 TO CKXADR
;<4.MONITOR>JSYSA.MAC.226, 14-Aug-79 15:05:04, EDIT BY HALL
;SMAP - MOVE PAGING STUFF FROM HERE TO PAGEM, FIX BUGS
;<4.MONITOR>JSYSA.MAC.225, 11-Aug-79 08:23:49, EDIT BY HALL
;SMAP - ALLOW DELETION OF PRIVATE SECTION
;<4.MONITOR>JSYSA.MAC.224, 6-Aug-79 10:34:40, Edit by KONEN
;FIX GETTING 'INVALID ACCOUNT STRING' WHEN RUNNING WITHOUT ACCOUNT
;VALIDATION
;<4.MONITOR>JSYSA.MAC.222, 26-Jul-79 15:37:14, EDIT BY OSMAN
;tco 4.2349 - Put NOINT in UFNSAS to avoid ASGINT
;<4.MONITOR>JSYSA.MAC.221, 26-Jul-79 13:54:28, EDIT BY TOMCZAK
;STDEV - return an error code when checking for initing fork.
;<4.MONITOR>JSYSA.MAC.220, 23-Jul-79 17:01:55, EDIT BY ZIMA
;TCO 4.2337 - Make extra check for possible batch job in USAGE JSYS
;<4.MONITOR>JSYSA.MAC.219, 23-Jul-79 15:40:13, EDIT BY HALL
;ALOCRS - INDEX JOBDIR BY JOB NUMBER
;<4.MONITOR>JSYSA.MAC.218, 13-Jul-79 16:29:41, EDIT BY HALL
;DISOK - LOAD DEFAULT ACTION IN T2 BEFORE TESTING IT
;<4.MONITOR>JSYSA.MAC.217, 13-Jul-79 16:17:31, EDIT BY HALL
;SMAP - CREATE PRIVATE SECTION
;<4.MONITOR>JSYSA.MAC.216, 11-Jul-79 15:22:04, Edit by MCLEAN
;FIX GOKFRE TO USE GOKPSI NOT GOKBIP
;<4.MONITOR>JSYSA.MAC.215, 9-Jul-79 16:39:06, EDIT BY R.ACE
;FIX BAD EDIT TO GETOKM TO GIVE DEFAULT ON RESOURCES-EXHAUSTED
;<4.MONITOR>JSYSA.MAC.214, 3-Jul-79 06:31:54, EDIT BY R.ACE
;FIX RELINT BUGCHKS
;<4.MONITOR>JSYSA.MAC.213, 29-Jun-79 13:57:27, Edit by MCLEAN
;ADD CODE TO MAKE GETOKM NOT FAIL ON RESOURCES FAILURE. MAKE IT TAKE THE DEFAULT PATH
;<4.MONITOR>JSYSA.MAC.212, 15-Jun-79 21:19:51, EDIT BY DBELL
;CHANGE RETBAD IN .GTDIR TO ITERR
;<4.MONITOR>JSYSA.MAC.211, 13-Jun-79 12:38:04, EDIT BY KIRSCHEN
;FIX SETUP OF ACCTSL ON LOGIN
;<4.MONITOR>JSYSA.MAC.210, 7-Jun-79 14:39:51, Edit by KONEN
;REQUIRE REGULATED STRUCTURE TO BE MOUNTED FOR .GTDIR
;<4.MONITOR>JSYSA.MAC.209, 3-Jun-79 13:04:41, EDIT BY KIRSCHEN
;FIX VERIFICATION OF ACCOUNTS USING ACCTSR OR CSHACT IN JSB
; USE ACCSTR ONLY IF VERIFYING ACCOUNT FOR SELF
; USE CSHACT ONLY IF VERIFYING FOR SAME USER AS LAST TIME
;<4.MONITOR>JSYSA.MAC.208, 20-May-79 21:09:32, Edit by LCAMPBELL
; Check JFN for reasonableness at PMAP10 (prevents SECNX BUGHLTs)
;<4.MONITOR>JSYSA.MAC.207, 18-May-79 16:28:02, EDIT BY DBELL
;TCO 4.2253 - FIX VALIDATION OF DIRECTORY GROUP NUMBERS AT SCNDN1
;<4.MONITOR>JSYSA.MAC.206, 28-Apr-79 20:35:39, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.205, 28-Apr-79 20:18:58, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.204, 28-Apr-79 19:35:07, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.203, 28-Apr-79 19:31:21, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.202, 27-Apr-79 13:48:59, Edit by LCAMPBELL
; If non-ARPA monitor, ignore SMON to allow ARPA logins
;<4.MONITOR>JSYSA.MAC.202, 26-Apr-79 23:25:58, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.201, 26-Apr-79 14:17:58, Edit by MCLEAN
;CHANGE GOKMSZ TO BE 80 CHARACTERS
;<4.MONITOR>JSYSA.MAC.200, 23-Apr-79 16:42:57, Edit by KONEN
;<4.MONITOR>JSYSA.MAC.199, 23-Apr-79 12:51:45, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.198, 22-Apr-79 21:32:39, Edit by KONEN
;CHANGE DEVLCK CODE IN STDEV TO CHECKING FOR STR BEING INIT'ED
;<4.MONITOR>JSYSA.MAC.197, 22-Apr-79 13:55:27, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.196, 22-Apr-79 13:41:01, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.195, 22-Apr-79 13:34:31, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.194, 19-Apr-79 16:11:35, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.193, 19-Apr-79 16:05:49, Edit by MCLEAN
;SHORTEN CHECK FOR ACJ JOB/JOB 0
;<4.MONITOR>JSYSA.MAC.192, 18-Apr-79 14:48:32, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.191, 16-Apr-79 23:27:51, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.190, 16-Apr-79 23:18:12, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.189, 16-Apr-79 22:56:11, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.188, 16-Apr-79 22:43:34, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.187, 16-Apr-79 17:21:08, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.186, 16-Apr-79 16:58:02, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.185, 16-Apr-79 16:44:13, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.184, 16-Apr-79 15:53:07, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.183, 15-Apr-79 22:39:55, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.182, 15-Apr-79 22:35:55, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.181, 15-Apr-79 22:13:34, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.180, 15-Apr-79 22:04:10, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.179, 15-Apr-79 22:00:51, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.178, 14-Apr-79 22:44:26, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.177, 14-Apr-79 22:33:50, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.176, 14-Apr-79 21:54:46, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.175, 14-Apr-79 21:51:07, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.174, 14-Apr-79 21:46:17, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.173, 13-Apr-79 10:54:38, EDIT BY MILLER
;REMOVE TCO 4.2224. IT BROKE FILE PAGE DELETING
;<4.MONITOR>JSYSA.MAC.172, 11-Apr-79 13:34:29, Edit by MCLEAN
;ADD NEW GETOK CODE SOME FOR TIMEOUT
;<4.MONITOR>JSYSA.MAC.171, 10-Apr-79 16:35:40, Edit by MCLEAN
;ADD DEFINITONS FOR GTOKPR
;<4.MONITOR>JSYSA.MAC.170, 10-Apr-79 13:21:39, Edit by MCLEAN
;FIX IT SO GETOKM DOES NOT DO GETOK FOR JOB 0 ALSO ADD NEW ARG FOR RCVOK OF NUMBER PASSED
;<4.MONITOR>JSYSA.MAC.169, 9-Apr-79 14:07:00, Edit by MCLEAN
;MAKE GIVOK SUCCEED IF NO SWAP SPACE
;<4.MONITOR>JSYSA.MAC.168, 6-Apr-79 10:35:15, Edit by KONEN
;ADD ELAPSED USE TIME FOR STRUCTURE AND TAPE ACCOUNTING
;<4.MONITOR>JSYSA.MAC.167, 5-Apr-79 16:36:23, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.166, 5-Apr-79 11:11:40, Edit by MCLEAN
;REMOVE 1 ARG FROM GTOKM
;<4.MONITOR>JSYSA.MAC.165, 4-Apr-79 14:27:35, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.164, 4-Apr-79 13:03:41, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.163, 4-Apr-79 12:55:28, Edit by MCLEAN
;FIX GTOKM MACROS FOR RETERR INSTEAD OF RETBAD
;<4.MONITOR>JSYSA.MAC.162, 2-Apr-79 22:34:49, EDIT BY ZIMA
;TCO 4.2225 - Make NOUT recognize following ERJMP/ERCAL on error.
;Also preserve the BOUT error in the ITERR in BOUTA
;<4.MONITOR>JSYSA.MAC.161, 2-Apr-79 21:58:57, EDIT BY ZIMA
;TCO 4.2224 - Prevent PMAP file writes if PM%WR not specified
;<4.MONITOR>JSYSA.MAC.160, 2-Apr-79 16:17:40, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.159, 2-Apr-79 16:02:36, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.158, 2-Apr-79 09:35:20, EDIT BY R.ACE
;ALLOC JSYS - SET DV%ASN FOR DEVICE WHEN GIVING TO USER JOB
;<4.MONITOR>JSYSA.MAC.157, 30-Mar-79 15:56:26, Edit by KONEN
;CORRECT USAGE ENTRIES
;<4.MONITOR>JSYSA.MAC.156, 29-Mar-79 13:40:53, Edit by KONEN
;CORRECT PMAP FOR POSSIBLY UNLOCKING A WRONG JFN
;<4.MONITOR>JSYSA.MAC.155, 27-Mar-79 17:14:37, EDIT BY HALL
;MORE COMMENTS
;<4.MONITOR>JSYSA.MAC.154, 26-Mar-79 17:39:34, EDIT BY HALL
;TYPO
;<4.MONITOR>JSYSA.MAC.153, 26-Mar-79 16:56:22, EDIT BY HALL
;ADD SOME MORE COMMENTS TO GETOK
;<4.MONITOR>JSYSA.MAC.152, 26-Mar-79 13:00:22, EDIT BY MILLER
;FIX UP GETOK0 SO THAT IF SCHEDULER TEST FAILS, REQUEST IS
; PROPERLY TERMINATED.
;<4.MONITOR>JSYSA.MAC.151, 23-Mar-79 17:19:26, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.150, 23-Mar-79 10:01:48, EDIT BY HALL
;MORE COMMENTS
;<4.MONITOR>JSYSA.MAC.149, 23-Mar-79 09:52:32, EDIT BY HALL
;ADD SOME COMMENTS TO GETOK
;<4.MONITOR>JSYSA.MAC.148, 22-Mar-79 21:42:07, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.147, 22-Mar-79 21:36:50, Edit by MCLEAN
;MAKE GETOKM SET REQUESTED FOR TO -1
;<4.MONITOR>JSYSA.MAC.146, 22-Mar-79 17:53:33, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.145, 22-Mar-79 17:41:16, Edit by MCLEAN
;FIX IT SO GETOK DOESN'T USE FIRST WORD OF FREE SPACE
;<4.MONITOR>JSYSA.MAC.144, 22-Mar-79 15:01:33, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.143, 22-Mar-79 14:03:57, Edit by MCLEAN
;FIX IT SO USER FUNCTIONS ALWAYS FAIL IF CHECKING NOT ENABLED
;<4.MONITOR>JSYSA.MAC.142, 21-Mar-79 14:34:42, Edit by MCLEAN
;FIX GOKNOB TO BE NOINT
;<4.MONITOR>JSYSA.MAC.141, 21-Mar-79 10:42:18, EDIT BY BOSACK
;FIX RACE IN OFFUSQ BY MAKING RELSWP CALL NOINT
;<4.MONITOR>JSYSA.MAC.140, 20-Mar-79 14:32:45, Edit by MCLEAN
;FIX STRING ERROR RETURNS IN GETOK
;<4.MONITOR>JSYSA.MAC.139, 20-Mar-79 12:58:44, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.138, 19-Mar-79 10:07:25, EDIT BY KIRSCHEN
;Change [] to () when setting up byte pointer in GIVOK
;<4.MONITOR>JSYSA.MAC.137, 19-Mar-79 10:05:17, EDIT BY KIRSCHEN
;DO NOT CLOBBER BLOCK HEADER IN GOVOK
;<4.MONITOR>JSYSA.MAC.136, 13-Mar-79 17:39:09, Edit by MCLEAN
;FIX DPB TO BE IDPB IN GIVOK
;<4.MONITOR>JSYSA.MAC.135, 13-Mar-79 06:35:27, EDIT BY R.ACE
;TAKE OUT VALIDATION OF .SFTDF WORD IN SMON
;<4.MONITOR>JSYSA.MAC.134, 12-Mar-79 16:19:05, Edit by MCLEAN
;MORE .VACCT FIXES
;<4.MONITOR>JSYSA.MAC.133, 7-Mar-79 19:13:26, Edit by KONEN
;<4.MONITOR>JSYSA.MAC.132, 7-Mar-79 13:25:48, Edit by KONEN
;PREVENT DISMIS WHILE NOSKED
;<4.MONITOR>JSYSA.MAC.131, 7-Mar-79 02:58:12, Edit by MCLEAN
;MAKE GIVOK DO ITERR
;<4.MONITOR>JSYSA.MAC.130, 7-Mar-79 02:40:46, Edit by MCLEAN
;FIX COMMENTS IN GETOK AND FIX ALLOCATION FAILURE LEAVING NOINT
;<4.MONITOR>JSYSA.MAC.129, 5-Mar-79 16:29:05, Edit by MCLEAN
;FIX REGISTER USAGE IN SGOKL
;<4.MONITOR>JSYSA.MAC.128, 5-Mar-79 15:15:42, Edit by MCLEAN
;MORE VACC JSYS FIXES
;<4.MONITOR>JSYSA.MAC.127, 4-Mar-79 17:37:13, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>JSYSA.MAC.126, 2-Mar-79 15:25:20, Edit by MCLEAN
;FIX GETOKM MACROS
;<4.MONITOR>JSYSA.MAC.125, 23-Feb-79 16:53:07, Edit by KONEN
;LOCK DEVICE TABLES DEEPER IN CODE TO AVOID GETTING DEVICE WHILE BEING CHANGED
;<4.MONITOR>JSYSA.MAC.124, 21-Feb-79 11:18:40, EDIT BY MURPHY
;ADD WORKING SET PRELOAD CONTROL TO SMON, TMON - DLM
;<4.MONITOR>JSYSA.MAC.123, 20-Feb-79 15:53:42, Edit by KONEN
;LOCK DEVICE TABLES FOR STDEV TO AVOID GETTING DEVICE WHILE BEING CHANGED
;<4.MONITOR>JSYSA.MAC.122, 9-Feb-79 22:36:18, EDIT BY ZIMA
;TCO 4.2164 - Fix handling of user-defined USAGE entries
;<4.MONITOR>JSYSA.MAC.121, 7-Feb-79 21:19:12, EDIT BY KIRSCHEN
;check for 2060 in smap jsys
;<4.MONITOR>JSYSA.MAC.120, 2-Feb-79 16:31:57, Edit by MCLEAN
;FIX VERACT AND VACCT TO DO CORRECT VALIDATION OF OPERATOR ACCOUNT
;<4.MONITOR>JSYSA.MAC.119, 29-Jan-79 03:55:45, EDIT BY DBELL
;CHANGE REFERENCES TO HSYPAG TO HSYBLK
;<4.MONITOR>JSYSA.MAC.118, 24-Jan-79 13:54:44, Edit by MCLEAN
;FIX BATCH FLAGS FOR OTHER JOBS
;<4.MONITOR>JSYSA.MAC.117, 11-Jan-79 17:29:51, EDIT BY MILLER
;REMOVE CHECK FOR OPERATOR IN VACCT JSYS
;<4.MONITOR>JSYSA.MAC.116, 8-Jan-79 12:29:30, EDIT BY DBELL
;DO OKINT IN NEW SYMBOL TABLE UNMAPPING ROUTINE
;<4.MONITOR>JSYSA.MAC.115, 8-Jan-79 06:47:31, EDIT BY DBELL
;TCO 4.2155 - Implement hidden symbol tables:
; Make the symbol table lookup functions of SNOOP% understand
; hidden symbol tables.
;<4.MONITOR>JSYSA.MAC.114, 29-Dec-78 17:51:35, Edit by MCLEAN
;FIX GOKREL TO DO EVERY ENTRY
;<4.MONITOR>JSYSA.MAC.113, 28-Dec-78 15:33:37, Edit by MCLEAN
;PUT SOME CSKEDS IN GETOK CODE SO LOCK DOESN'T HANG EVERYONE
;<4.MONITOR>JSYSA.MAC.112, 22-Dec-78 15:09:04, Edit by OPERATOR
;MAKE SURE STRING ENTRIES IN USAGE TABLES PRECEED OTHER TYPES
;<4.MONITOR>JSYSA.MAC.111, 21-Dec-78 10:36:02, Edit by KONEN
;ADD TAPE AND STRUCTURE MOUNT TABLES FOR USAGE JSYS
;PREVENT PMAP FROM/TO FILE IF MOUNTED ONLY BY ANOTHER FORK OF JOB
;<4.MONITOR>JSYSA.MAC.110, 20-Dec-78 14:44:33, EDIT BY HURLEY.CALVIN
; Add USAGE entries and table for ARCHIVE/VIRTUAL disk account entries
;<4.MONITOR>JSYSA.MAC.109, 19-Dec-78 09:58:06, EDIT BY OSMAN
;ALLOW .SJLLO FROM REMOTE JOB
;<4.MONITOR>JSYSA.MAC.108, 12-Dec-78 15:39:54, Edit by MCLEAN
;MAKE IT SO SMON FOR GETOK CLEANS UP THE QUEUE ON DISABLE
;<4.MONITOR>JSYSA.MAC.107, 11-Dec-78 14:17:52, Edit by MCLEAN
;DON'T ZERO GOKQED IF COUNT POSITIVE
;<4.MONITOR>JSYSA.MAC.106, 11-Dec-78 14:14:00, Edit by MCLEAN
;FIX GOKQED WHEN ^C IS DONE
;<4.MONITOR>JSYSA.MAC.105, 29-Nov-78 19:56:31, EDIT BY ZIMA
;TCO 4.2101 - SET CONTROLLING TERMINAL TO ACCEPT SYS MESSAGES ON LOGIN
;<4.MONITOR>JSYSA.MAC.105, 29-Nov-78 19:48:41, EDIT BY ZIMA
;TCO 4.2100 - FIX CRJOB WITH CJ%NAM ZERO
;<4.MONITOR>JSYSA.MAC.104, 29-Nov-78 08:24:58, EDIT BY R.ACE
;TCO 4.2088 - ADD TAPE-MOUNT DEFAULTS TO SMON/TMON
;FIX MIXUP IN TMON FUNCTION VECTOR
;<4.MONITOR>JSYSA.MAC.103, 13-Nov-78 11:40:25, EDIT BY MILLER
;MAKE SURE TAPE IS INFORMED WHENEVER AN MT IS DEASSIGNED
;<4.MONITOR>JSYSA.MAC.102, 31-Oct-78 16:08:11, Edit by KONEN
;Teach GTDIR when getting defaults to look at user-requested block size
;<4.MONITOR>JSYSA.MAC.99, 24-Oct-78 16:20:00, EDIT BY OSMAN
;TC0 4.2060 - ADD .SJLLO
;<4.MONITOR>JSYSA.MAC.98, 23-Oct-78 21:09:32, Edit by MCLEAN
;TCO 4.2063 ADD BATCH STREAM NUMBER AND FLAGS TO SETJB
;<KONEN>JSYSA.MAC.8, 23-Jun-78 17:44:17, Edit by KONEN
;ADD CODE TO ACCES JSYS TO REQUIRE PRIOR MOUNT INCREMENT FOR NON-PS STR.
;<CALVIN>JSYSA.MAC.1, 22-Aug-78 06:52:33, EDIT BY CALVIN
; Add code to GTDIR to return default online and offline expirations
;<CALVIN>JSYSA.MAC.1, 17-Aug-78 07:38:24, EDIT BY CALVIN
; Implement SMON & TMON functions for archive/virtual disk system
;[BBN-TENEXD]<3-EONEIL>JSYSA.MAC.2, 1-Jun-78 10:59:59, Ed: EONEIL
; SETJB change for archive system (default retrieval mode)
;<4.MONITOR>JSYSA.MAC.95, 19-Oct-78 08:11:53, EDIT BY MILLER
;<4.MONITOR>JSYSA.MAC.94, 17-Oct-78 14:06:15, Edit by MCLEAN
;ADD COMMENTS TO GETOK AND ADD CHANGES FOR LOGIMS CALLING SEQUENCE
;<4.MONITOR>JSYSA.MAC.93, 17-Oct-78 14:00:32, EDIT BY MILLER
;MOD;<4.MONITOR>JSYSA.MAC.92, 2-Oct-78 10:58:54, EDIT BY MILLER
;FIX BYTE POINTER AT PMCRM2
;<4.MONITOR>JSYSA.MAC.91, 2-Oct-78 10:04:55, EDIT BY R.ACE
;TCO 4.2028 - FIX BUG IN RELD - LOST MESSAGES TO DEVICE ALLOCATOR
;<4.MONITOR>JSYSA.MAC.90, 26-Sep-78 08:45:36, EDIT BY R.ACE
;TCO 4.2022 - MAKE RELD RETURN DEVX6 IF DEVICE IS OPEN
;<4.MONITOR>JSYSA.MAC.89, 21-Sep-78 20:28:22, Edit by MCLEAN
;FIX SOME SPECIAL CASES FOR JOB CLASS IN VERACT AND FIX GTOKM MACROS
;<4.MONITOR>JSYSA.MAC.88, 21-Sep-78 14:13:01, EDIT BY MILLER
;MAKE TRVARS IN RPACS,RMAP AND SPACS MATCH THE ONE IN PMAP
; FIX RPACS TO GIVE SPECIAL ERROR ON NON-EX SECTION
;<4.MONITOR>JSYSA.MAC.87, 16-Sep-78 15:59:09, EDIT BY MILLER
;<4.MONITOR>JSYSA.MAC.86, 16-Sep-78 15:10:58, EDIT BY MILLER
;ADD CALL SKDLOG TO LOGIN CODE
;<4.MONITOR>JSYSA.MAC.85, 16-Sep-78 13:54:57, Edit by MCLEAN
;FIX RCVOK ARGUMENTS
;<4.MONITOR>JSYSA.MAC.84, 8-Sep-78 14:47:48, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.83, 7-Sep-78 00:28:29, Edit by MCLEAN
;FIX STDVP1 FOR NEW DEVICE CHARACTERISTICS
;<2MCLEAN>JSYSA.MAC.79, 5-Sep-78 12:55:38, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.78, 5-Sep-78 00:12:40, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.1, 27-Aug-78 21:52:33, Edit by MCLEAN
;MAKE DEVUNT BE 15 BITS
;<4.MONITOR>JSYSA.MAC.81, 3-Sep-78 23:45:28, Edit by MCLEAN
;FIX RCVOK AND GETOK DATA BASE
;<4.MONITOR>JSYSA.MAC.80, 2-Sep-78 16:37:34, EDIT BY JBORCHEK
;FIX TYPO AT SETACL WHEN CLSSN WAS ADDED
;<4.MONITOR>JSYSA.MAC.79, 2-Sep-78 02:16:08, Edit by MCLEAN
;FIX SGTOK FOR FUNCTION CODE CHECK
;<4.MONITOR>JSYSA.MAC.78, 1-Sep-78 22:52:34, Edit by MCLEAN
;ADD CLSSN TO SETACL TOO...
;<4.MONITOR>JSYSA.MAC.77, 28-Aug-78 08:15:27, EDIT BY MILLER
;CALL FKHPTA FROM RPACS
;<4.MONITOR>JSYSA.MAC.76, 25-Aug-78 14:17:28, EDIT BY MILLER
;MAKE RPACS RETURN A ZERO IF NON-EX SECTION GIVEN
;<4.MONITOR>JSYSA.MAC.75, 24-Aug-78 14:47:03, EDIT BY MILLER
;FIX SCNUNO AND SCNDNO TO RETURN CLASS CORRECTLY
;<4.MONITOR>JSYSA.MAC.74, 24-Aug-78 13:11:37, EDIT BY MILLER
;MAKE SETACT SET PROPER CLASS FOR JOB ON CACCT AND LOGIN
;<4.MONITOR>JSYSA.MAC.73, 24-Aug-78 11:48:25, EDIT BY MILLER
;<4.MONITOR>JSYSA.MAC.72, 24-Aug-78 09:12:13, EDIT BY MILLER
;PROCESS CLASS NUMBER IN ACCOUNTING DATA BASE
;<4.MONITOR>JSYSA.MAC.71, 22-Aug-78 17:48:28, EDIT BY R.ACE
;TCO 1991 - REMOVE SMON/TMON FUNCTION FOR DEFAULT TAPE LABEL TYPE
;<4.MONITOR>JSYSA.MAC.70, 22-Aug-78 15:31:09, EDIT BY JBORCHEK
;MAKE SMON FOR LOCAL HOST CALL STHSTJ (USES NEW FORMAT HOST NUMBER)
;<4.MONITOR>JSYSA.MAC.69, 19-Aug-78 10:46:55, EDIT BY ENGEL
;ADD COMMENTS TO CPMAP:
;<4.MONITOR>JSYSA.MAC.68, 19-Aug-78 10:41:06, EDIT BY ENGEL
;ADD SOME COMMENTS TO .RPACS
;<4.MONITOR>JSYSA.MAC.67, 18-Aug-78 12:50:06, EDIT BY MILLER
;ALLOW SMAP OF FILE SECTION AGAIN. FORK CODE NOW CORRECT
;<4.MONITOR>JSYSA.MAC.66, 17-Aug-78 09:42:09, EDIT BY MILLER
;MORE SMAP CLEAN UP. RETURN BETTER ERROR MESSAGED
;<4.MONITOR>JSYSA.MAC.65, 17-Aug-78 09:39:34, EDIT BY MILLER
;ALLOW ONLY FORK TO FORK MAP FOR SMAP
;<4.MONITOR>JSYSA.MAC.64, 13-Aug-78 12:23:42, EDIT BY MILLER
;RETURN PROPER ERROR CODE IF PMAP VIOALATION IS LNGFX1
;<4.MONITOR>JSYSA.MAC.63, 3-Aug-78 14:12:58, EDIT BY MILLER
;PUT ERJMP AFTER BOUT IN BOUTA
;<4.MONITOR>JSYSA.MAC.62, 31-Jul-78 13:57:50, EDIT BY MILLER
;ALLOW PM%IND IF PMAP DONE FROM MONITOR MODE
;<4.MONITOR>JSYSA.MAC.61, 20-Jul-78 08:28:37, Edit by ENGEL
;CHANGE HRRI AT CRJB5Y: TO A XMOVEI
;<4.MONITOR>JSYSA.MAC.60, 19-Jul-78 00:46:07, Edit by MCLEAN
;FIX GETOK JSYS ARGUMENTS PER SPEC
;<4.MONITOR>JSYSA.MAC.59, 18-Jul-78 14:03:30, Edit by HALL
;<4.MONITOR>JSYSA.MAC.58, 17-Jul-78 13:08:13, Edit by MCLEAN
;GETOK ARGUMENTS CHANGE
;<2MCLEAN>JSYSA.MAC.56, 16-Jul-78 00:10:07, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.55, 15-Jul-78 23:50:06, Edit by MCLEAN
;GETOK FOR LOGIN AND CRJOB
;<4.MONITOR>JSYSA.MAC.56, 16-Jul-78 01:06:58, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.55, 16-Jul-78 00:45:20, Edit by MCLEAN
;TCO 1946 AND TCO 1941 NEW SMON/TMON JSYS FOR MAGTAPE LABELS
;AND READ TIME UPDATE MASK
;<4.MONITOR>JSYSA.MAC.54, 15-Jul-78 22:04:59, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.53, 15-Jul-78 21:53:15, Edit by MCLEAN
;FIX GETOKM SO IT DOESN'T ITRAP UNLESS REQUESTED TO.
;<4.MONITOR>JSYSA.MAC.52, 13-Jul-78 01:04:26, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.51, 12-Jul-78 23:57:02, Edit by MCLEAN
;MORE GETOK STUFF
;<3A.MONITOR>JSYSA.MAC.24, 11-Jul-78 13:40:55, Edit by PORCHER
;TCO 1896 - ADD CODE TO HANDLE ABRBITRARY USAGE ENTRIES 5000-9999
;<4.MONITOR>JSYSA.MAC.49, 8-Jul-78 14:37:28, EDIT BY MILLER
;TCP 1934. ALLOW "ABORT" PMAP
;<4.MONITOR>JSYSA.MAC.47, 29-Jun-78 14:30:09, Edit by MCLEAN
;MORE GETOK
;<4.MONITOR>JSYSA.MAC.46, 28-Jun-78 11:31:10, EDIT BY OSMAN
;ADD SJT20 FUNCTION OF SETJB - TCO # 1927
;<4.MONITOR>JSYSA.MAC.45, 27-Jun-78 21:44:01, EDIT BY JBORCHEK
;FIX TYPO. MOVE CHANGED TO LOAD AT GETOK1+19
;<4.MONITOR>JSYSA.MAC.44, 27-Jun-78 15:59:44, Edit by MCLEAN
;MORE GETOK STUFF
;<4.MONITOR>JSYSA.MAC.43, 27-Jun-78 15:57:27, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.42, 27-Jun-78 15:19:04, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.41, 23-Jun-78 14:29:41, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.40, 23-Jun-78 14:15:44, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.39, 23-Jun-78 07:54:46, EDIT BY MILLER
;FIX PLOCK0 NOT TO CALL FKHPTN
;<4.MONITOR>JSYSA.MAC.38, 21-Jun-78 00:25:28, Edit by MCLEAN
;MORE GETOK
;<4.MONITOR>JSYSA.MAC.37, 20-Jun-78 15:53:28, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.36, 20-Jun-78 15:04:39, Edit by MCLEAN
;<1BOSACK>JSYSA.MAC.1000, 5-Jun-78 18:49:44, EDIT BY BOSACK
;<4.MONITOR>JSYSA.MAC.34, 19-Jun-78 13:44:56, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.33, 19-Jun-78 13:43:56, Edit by MCLEAN
;<4.MONITOR>JSYSA.MAC.32, 19-Jun-78 13:16:02, Edit by HELLIWELL
;ADD SAVEPQ AT PLOCK0
;<4.MONITOR>JSYSA.MAC.31, 19-Jun-78 13:06:07, Edit by MCLEAN
;INSERT GETOK JSYS STUFF
;<4.MONITOR>JSYSA.MAC.30, 14-Jun-78 00:55:37, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.19, 14-Jun-78 00:50:38, Edit by MCLEAN
;<2MCLEAN>JSYSA.MAC.17, 10-May-78 01:18:11, Edit by MCLEAN
;TCO 1908 MAKE GETOK CHANGES FOR SMON AND TMON
;<4.MONITOR>JSYSA.MAC.28, 11-Jun-78 17:18:39, Edit by HELLIWELL
;INCREMENT P2 IN LOOP AT LOCK4 IN PLOCK JSYS
;<3A.MONITOR>JSYSA.MAC.18, 9-Jun-78 14:18:38, EDIT BY MILLER
;FIX UP PMCRPS TO ONLY UPDATE COUNT ON ERROR
;<3A.MONITOR>JSYSA.MAC.17, 8-Jun-78 17:08:35, EDIT BY MILLER
;MORE FIXES FOR NEW PMCTL CODE
;<3A.MONITOR>JSYSA.MAC.16, 8-Jun-78 16:07:10, EDIT BY MILLER
;TCO 1893. ENCHANCE PMCTL FUNCTION TO READ PAGE STATE
;<4.MONITOR>JSYSA.MAC.24, 3-Jun-78 20:25:54, Edit by JBORCHEK
;MOVE SNOOP STORAGE TO STG
;<3A.MONITOR>JSYSA.MAC.15, 26-May-78 16:03:52, Edit by HELLIWELL
;MAKE PLOCK0 SUBR RETURN OKINT ON ERRORS
;<4.MONITOR>JSYSA.MAC.22, 25-May-78 13:43:38, Edit by HELLIWELL
;MAKE PLOCK0 GLOBAL
;<3A.MONITOR>JSYSA.MAC.13, 25-May-78 13:39:55, Edit by HELLIWELL
;MAKE PLOCK0 SUBROUTINE SO VB10 CODE CAN LOCK PAGES
;<4.MONITOR>JSYSA.MAC.20, 23-May-78 13:45:54, EDIT BY MILLER
;CHANGE CALL LODPPG TO CALL LODPPS
;<3A.MONITOR>JSYSA.MAC.11, 23-May-78 11:14:51, EDIT BY MILLER
;MORE FIXES TO PLOCK
;<3A.MONITOR>JSYSA.MAC.10, 23-May-78 10:30:12, EDIT BY MILLER
;FIX TYPEOS
;<3A.MONITOR>JSYSA.MAC.9, 23-May-78 10:25:02, EDIT BY MILLER
;FIX PLOCK TO ALLOW LOCKING OF MULTIPLE PHYSICAL PAGES
;<3A.MONITOR>JSYSA.MAC.8, 18-May-78 12:45:59, EDIT BY MILLER
;TCO 1189. ADD NEW SMON AND TMON FUNCTIONS FOR STATUS REPROTING
;<4.MONITOR>JSYSA.MAC.16, 26-Apr-78 16:39:40, EDIT BY MILLER
;DON'T SCAN DIR BLOCKS IF USER NUMBER GIVEN TO VERACT
;<4.MONITOR>JSYSA.MAC.15, 2-Mar-78 17:50:24, EDIT BY MILLER
;ACCOUNT FOR NEW SKIP RETURN FROM TTDIBE
;<3A.MONITOR>JSYSA.MAC.5, 2-Mar-78 17:02:41, EDIT BY MILLER
;CHANGE CALL TO TTDOBE
;<4.MONITOR>JSYSA.MAC.13, 1-Mar-78 10:52:45, Edit by PORCHER
;Isolate .USSAS and .USRAS functions from USAGE JSYS
;<4.MONITOR>JSYSA.MAC.12, 28-Feb-78 17:13:37, Edit by PORCHER
;Make STAD call NXTASC to recompute next accounting shift change
;<4.MONITOR>JSYSA.MAC.11, 28-Feb-78 13:10:49, Edit by PORCHER
;Add USAGE functions .USCAS,.USSAS,.USRAS for accounting shift changes
;<4.MONITOR>JSYSA.MAC.10, 17-Feb-78 09:02:49, EDIT BY MILLER
;FIX ERROR CODE FOR PMAP TO APPEND FILE
;<4.MONITOR>JSYSA.MAC.9, 16-Feb-78 17:39:28, EDIT BY MILLER
;FIX UP ERROR CODES FOR SMAP JSYS
;<4.MONITOR>JSYSA.MAC.8, 16-Feb-78 17:30:07, EDIT BY MILLER
;ADD SMAP JSYS
;<4.MONITOR>JSYSA.MAC.7, 16-Feb-78 09:22:28, Edit by PORCHER
;<3A.MONITOR>JSYSA.MAC.3, 15-Feb-78 08:12:31, EDIT BY MILLER
;USE SYMBOLIC OFFSETS IN PMCTL ERROR FUNCTION
;<3A.MONITOR>JSYSA.MAC.2, 3-Feb-78 11:31:57, EDIT BY MILLER
;FIXES TO "READ ERROR" FUNCTION OF PMCTL
;<4.MONITOR>JSYSA.MAC.4, 28-Jan-78 15:56:05, Edit by PORCHER
;<4.MONITOR>JSYSA.MAC.3, 28-Jan-78 15:34:19, EDIT BY PORCHER
;Add execute-only checks to ADBRK, PMAP, SPACS and SETER
;<4.MONITOR>JSYSA.MAC.2, 24-Jan-78 10:19:50, EDIT BY MILLER
;MERGE IN 3A CHANGES
;<3A.MONITOR>JSYSA.MAC.1, 23-Jan-78 20:47:32, EDIT BY MILLER
;ADD PLOCK JSYS CODE. FINISH PMCTL- ADD READ ERROR FUNCTION
;<4.MONITOR>JSYSA.MAC.1, 12-Dec-77 11:32:25, EDIT BY CROSSLAND
;FIX TO SET TIME AND DATE ROUTINE FOR REORGANIZATION OF TIMER QUEUES
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG,ACTSYM
TTITLE JSYSA
SWAPCD
;THIS FILE CONTAINS CODE WHICH IMPLEMENTS VARIOUS JSYSES. THIS
;CODE DOES NOT REQUIRE ANY SPECIAL AC DEFINITIONS. SOME JSYSES,
;PARTICULARLY FILE-RELATED ONES, USE THE GTJFN AC DEFINITIONS, AND
;THESE ARE GENERALLY IN FJSYS.
EXTN <HOMSNM,HM1BLK,HM2BLK> ;DEFINED ELSEWHERE
EXTN <MXSTRU>
EXTN <LODPPS,ULDPAG> ;FOR LOCK JSYS ONLY
EXTN <DEQERR> ;IN APRSRV, TO GET ERROR BLOCK
EXTN <SETCLS> ;IN SCHED, SETS CLASS OF JOB
;**;[3036] Add one line YKT NOV-03-83
EXTN <ASZSIX> ;[3036] IN MEXEC
RS(FACTSW) ; Fact switches
RS TADIDT,1 ;INITIAL DAY AND TIME
PPNLH==:4 ;SYSTEM DEFINED PPN LHS
;MACROS TO DEFINE PARALLEL FLAG AND FUNCTION TABLES FOR SETJB
; FLAG TABLE (SJBTBF) VALUES:
; 1 - MEANS ANY JOB CAN SET THE PARAMETER
; 0 - MEANS ONLY THE OWNER JOB CAN SET THE PARAMETER
DEFINE SJTBL <
SJTB1 (1,<CALL SJBDEN>) ;;0 - SET DEFAULT MAGTAPE DENSITY
SJTB1 (1,<STOR T3,JSMTP,(T1)>) ;;1 - SET MAGTAPE DEFAULT PARITY
SJTB1 (1,<CALL SJBDM>) ;;2 - SET MAGTAPE DEFAULT DATA MODE
SJTB1 (1,<STOR T3,JSMTR,(T1)>) ;;3 - SET MAGTAPE DEFAULT RECORD SIZE
SJTB1 (1,<STOR T3,JSDFS,(T1)>) ;;4 - SET DEFERRED SPOOLING
SJTB1 (0,<CALL SJBSRM>) ;;5 - SET SESSION REMARK
SJTB1 (0,<CALL SJBT20>) ;;6 - SET TOPS20 COMMAND LEVEL
SJTB1 (1,<MOVEM T3,ARDFRT>) ;;7 - Set default retrieval mode
SJTB1 (1,<CALL SJBBAT>) ;;10 - SET BATCH STREAM AND FLAGS
SJTB1 (1,<CALL SJBLL>) ;;11 - SET LOGICAL LOCATION
>
DEFINE SJTB1 (FLG,INSTR) <
EXP FLG>
SJBTBF: SJTBL ;GENERATE FLAG TABLE
DEFINE SJTB1 (FLG,INSTR) <
INSTR>
SJBTAB: SJTBL ;GENERATE FUNCTION TABLE
MAXSJF==.-SJBTAB ;MAXIMUM SETJB FUNCTION CODE
SJ%OWN==:1B0 ;IF SET, THEN SETTING PARAMETERS IN OWN JOB
;BIT FOR SETACT (SET ACCOUNT) AND VERACT (VERIFY ACCOUNT)
AC%MCH==:1B1 ;ACCOUNT MATCHES ACCTSR
;ROUTINES USED BY IO CONVERSION JSYSES TO DO LOGICAL BIN AND BOUT.
;REAL BIN AND BOUT IS DONE IF THE SOURCE/DESTINATION IS A JFN.
;IF IT IS A STRING POINTER, WE DO THE ILDB/IDPB HERE IN ORDER
;THAT THE 'PREVIOUS CONTEXT' IS STILL THE JSYS'S CALLER.
;LOCAL BOUT
; A (PREVIOUS CONTEXT)/ JFN OR STRING PTR
; B/ BYTE
; CALL BOUTA
; RETURN +1 ALWAYS
BOUTA:: PUSH P,A
UMOVE A,1 ; Output designator
TLNN A,777777 ; String pointer?
JRST [ BOUT ;NO, CAN DO BOUT
ERJMP [ ITERR(,<MOVE A,LSTERR>)]
POP P,A
RET]
TLC A,777777 ; Yes
TLCN A,777777 ; Lh = -1?
HRLI A,440700 ; Yes. fill in
XCTBU [IDPB B,A]
UMOVEM A,1
PUSH P,B
SETZ B,
XCTBU [IDPB B,A]
POP P,B
POP P,A
RET
;**;[1763] REWRITE BIN1 ROUTINE RAS 4-AUG-80
;LOCAL BIN
;RETURNS +1: ERROR OR EOF
; +2: BYTE IN B
;
; This routine will return a byte from the users address space using
; the contents of the users AC1 as the source designator. CR are eaten
; if they are followed by LFs. Otherwise, the CR is returned.
BIN1:: SAVEAC <T1> ;SAVE THIS AC
UMOVE A,1 ;GET USERS SOURCE DESIGNATOR
CALL BIN2 ;GET ONE BYTE FROM DESIGNATOR
RET ;ERROR OR EOF, RETURN FACT TO CALLER
CAIE T2,.CHCRT ;IS THE BYTE A CARRIAGE RETURN?
RETSKP ;NO, RETURN THE BYTE TO CALLER
CALL BIN2 ;IT IS A CARRIAGE RETURN, GET NEXT BYTE
RETSKP ;ERROR OR EOF, RETURN THE LAST BYTE
CAIN T2,.CHLFD ;IS THIS BYTE A LF?
RETSKP ;YES, RETURN IT AS BYTE
BKJFN ;BYTE IS NOT A LF, PUT IT BACK
SKIPA ;STRANGE ERROR, DON'T UPDATE USERS DESIGNATOR
UMOVEM T1,T1 ;UPDATE USER'S SOURCE DESIGNATOR
MOVEI T2,.CHCRT ;GET BACK THE CARRIAGE RETURN
RETSKP ;AND GIVE THIS BACK TO THE CALLER
;Routine to input one byte from designator in T1. Will return any byte
BIN2: TLNN A,777777 ;DO WE HAVE A STRING POINTER
JRST [ BIN ;NOT STRING PTR, DO REGULAR BIN
ERJMP [RET] ;ERROR OR EOF
RETSKP] ;RETURN BYTE
TLC A,777777 ;DO WE HAVE A -1 IN LH?
TLCN A,777777 ;...
HRLI A,440700 ;YES, MAKE IT A STANDARD BYTE POINTER
XCTBU [ILDB B,A] ;GET BYTE
UMOVEM A,1 ;AND UPDATE USERS POINTER
RETSKP ;AND GIVE BYTE BACK
;PASSWORD CHECK FOR INTERNAL USE
; A/ directory number
; B/ password string ptr
;RETURNS +1: INVALID PASSWORD
; A=0, CALLER MUST DISMS FOR 3 SEC
; A=-1, NO PASSWORD WAS GIVEN, NO NEED FOR 3 SEC WAIT
PASSWC::SE1CAL
PUSH P,B
CALL SETDIR
JRST [ POP P,B
RET]
POP P,B
CALL CHKPSX
CAIA
AOS 0(P)
ULKDIR
RET
CHKPSW: UMOVE B,2
CHKPSX::SAVEQ
JUMPE B,RETO ;IF NO PASSWORD STRING, RETURN
PUSH P,B
MOVE B,DIRORA ;GET ADDRESS OF MAPPED DIR
LOAD B,DRPSW,(B) ;GET ADDRESS OF PASSWORD STRING
JUMPE B,[SUB P,BHC+1
JRST RETZ]
ADD B,DIRORA ;GET ABSOLUTE ADDRESS OF PASSWORD STRING
MOVE C,1(B)
TLNN C,774000
JRST [ SUB P,BHC+1
JRST RETZ] ; Null password never matches
MOVSI A,(POINT 7,0(B),35)
POP P,C
TLC C,-1 ; SEE IF LH = -1
TLCN C,-1
HRLI C,(<POINT 7,0>) ;YES, SET UP BYTE POINTER
MOVEI Q1,MAXLC ;SET UP LIMIT OF CHARACTERS
CHKPS1: XCT CHKPST ;GET NEXT BYTE
CAIL D,"A"+40 ;LOWERCASE?
CAILE D,"Z"+40
SKIPA
SUBI D,40 ;YES, CONVERT IT TO UPPERCASE
ILDB Q3,A
CAME D,Q3
JRST CHKPS2 ;NO MATCH, GO READ REST OF STRING
JUMPE D,RSKP ;MATCH
SOJG Q1,CHKPS1 ;COUNT DOWN MAX STRING LENGTH
JRST RETZ ;STRING TOO LONG
CHKPS2: CAIN Q1,MAXLC ;FIRST CHARACTER?
JUMPE D,RETO ;YES, IF NULL, THEN DONT NEED TO WAIT
CHKPS3: JUMPE D,RETZ ;END OF USER'S STRING?
SOJLE Q1,RETZ ;NO, READ ALL CHARACTERS YET?
XCT CHKPST ;NO, READ WHOLE STRING TO FOUL PAGE
JRST CHKPS3 ; FAULT WATCHERS
CHKPST: XCTBU [ILDB D,C]
; CALL TO ACCESS DIRECTORIES
;
; ACCEPTS IN 1/ FLAGS,, N
; 2/ ADDRESS OF ARGUMENT BLOCK
; ARGBLK: DIRECTORY DESIGNATOR
; POINTER TO PASSWORD STRING
; JOB NUMBER (-1 FOR SELF)
.ACCES::MCENT ;MONITOR CONTEXT ENTRY
CALL ACCES0 ;CALL ROUTINE TO DO THE WORK
ITERR ;ILLEGAL INSTRUCTION TRAP
MRETNG ;SUCCESS RETURN (+1)
;ACCES0 - DOES THE WORK FOR .ACCES
;ACCEPTS: SAME AS .ACCES
;RETURNS +1: FAILED, ERROR CODE IN AC 1
; +2: SUCCEEDED
;REGISTER USAGE:
; Q1/ADDRESS OF ARGUMENT BLOCK IN USER'S SPACE
; Q2/DIRECTORY NUMBER
; Q3/STRUCTURE NUMBER (OFFSET IN STRTAB)
; P1/ADDRESS OF START OF MAPPED DIRECTORY
; P2/FLAG INDICATING WHETHER PRIVILEGE IS SUFFICIENT
; P3/JOB NUMBER FOR WHICH CALLED
; P4/OFFSET IN STRUCTURE TABLES IN JSB FOR THIS STRUCTURE
; P5/STRUCTURE UNIQUE CODE
ACCES0: STKVAR<ACCFLG,ACCDRA,<ACCNAM,MAXLW>,ERRFLG>
SETZM ACCFLG ;NO FLAGS LOADED YET
SETZM ERRFLG ;INIT FLAG TO FIRST PASS
SETZM ACCDRA ;NONE HERE YET EITHER
;CHECK FOR ERRORS
ACES0: UMOVE T1,1 ;GET FLAGS,,LENGTH OF ARGUMENT BLOCK
SKIPE ACCFLG ;SEEN FLAGS YET?
HLL T1,ACCFLG ;YES. USE THE SAME FLAGS THEN
TXNN T1,AC%CON!AC%OWN!AC%REM ;WAS ANY FUNCTION REQUESTED?
RETBAD(ACESX5) ;NO. ERROR
HLLZM T1,ACCFLG ;SAVE FLAGS
HRRZ T2,T1 ;GET LENGTH OF ARGUMENT BLOCK
CAIG T2,.ACJOB ;IS IT LONG ENOUGH FOR ALL ARGUMENTS?
RETBAD (ACESX1) ;NO. RETURN ERROR
MOVE T1,JOBNO ;GET THIS JOB'S NUMBER
HRRZ T2,JOBDIR(T1) ;GET THIS JOB'S DIRECTORY NUMBER
SKIPN T2 ;IS IT LOGGED IN?
RETBAD(CNDIX5) ;NO. ERROR
;GET USER'S LOGGED IN DIRECTORY NAME TO CHECK AGAINST LATER
HRLI T2,USRLH ;MAKE IT A USER NUMBER
MOVEI T1,ACCNAM ;T1/DESTINATION ON STACK
HRLI T1,(POINT 7,0)
DIRST ;CONVERT TO DIRECTORY NAME ON PS:
RETBAD
;GET STRUCTURE UNIQUE CODE, STRUCTURE NUMBER, AND DIRECTORY NUMBER
UMOVE Q1,2 ;GET ADDRESS OF ARGUMENT BLOCK
SKIPE T1,ACCDRA ;ALREADY HAVE DIR INFORMATION?
JRST ACES01 ;YES. USE IT
UMOVE T1,.ACDIR(Q1) ;GET STRUCTURE AND DIRECTORY OR BYTE POINTER
CALL CNVSTD ;GET (STRUCTURE,,DIRECTORY)
RETBAD
MOVEM T1,ACCDRA ;SAVE DIR NUMBER
ACES01: HRRZ Q2,T1 ;SAVE DIRECTORY NUMBER
HLRZ P5,T1 ;SAVE UNIQUE CODE
CALL SETDIR ;MAP THE DIRECTORY AND GO NOINT
RETBAD ;FAILED
MOVE P1,DIRORA ;POINT TO START OF DIRECTORY
LOAD Q3,CURSTR ;GET STRUCTURE NUMBER FOR MAPPED DIRECTORY
;SEE WHAT JOB THIS IS FOR
UMOVE T1,.ACJOB(Q1) ;GET JOB NUMBER FOR WHICH THIS IS TO BE DONE
CAME T1,[-1] ;DID USER SPECIFY 'THIS JOB'?
CAMN T1,JOBNO ; OR JOB NUMBER SAME AS THE USER'S?
SKIPA ;YES
JRST ACCES7 ;NO. GO DO IT SEPARATELY
;FOR THIS JOB. SEE IF USER WANTS TO DO UNACCESS
MOVE T2,ACCFLG ;GET INPUT FLAGS
TXNN T2,AC%REM ;UNACCESS REQUESTED?
JRST ACCES1 ;NO.
LOCK JSSTLK ;LOCK THE JSB STORAGE LOCK
SETZ T1, ;T1/OFFSET TO MAPPED JSB (NONE FOR THIS JOB)
CALL UNACC ;DO IT
JRST [ UNLOCK JSSTLK ;UNLOCK THE JSB
CALL USTDIR ;UNLOCK THE DIRECTORY
RETBAD ] ;RETURN FAILURE
UNLOCK JSSTLK ;UNLOCK THE JSB SPACE
CALL USTDIR ;UNLOCK THE DIRECTORY
RETSKP ;SUCCESS
;NOT UNACCESS. SEE IF USER HAS PRIVILEGES OR CORRECT PASSWORD
ACCES1: MOVE T1,CAPENB ;GET ENABLED CAPABILITIES OF THIS FORK
SKIPN ERRFLG ;SECOND PASS (I.E. ACJ APPROVES?)
TXNE T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
JRST [ SETZM P2 ;YES. INDICATE OK TO DO THIS
JRST ACCES2]
UMOVE T2,.ACPSW(Q1) ;GET POINTER TO PASSWORD IN USER'S SPACE
SKIPN T2 ;IS THERE A PASSWORD?
JRST [ MOVX P2,1B0 ;NO. INDICATE NOT OK TO DO THIS
JRST ACCES2]
CALL CHKPSX ;CHECK THE PASSWORD FROM USER'S ADDRESS SPACE
JRST [ MOVX P2,1B1 ;FAILED. INDICATE NOT OK TO DO THIS
JRST ACCES2]
SETZM P2 ;OK. INDICATE ACCESS OK
;CHECK IF USER IS REQUESTING ACCESS TO PUBLIC STRUCTURE OR PREVIOUSLY
;MOUNTED STRUCTURE
ACCES2: MOVE T1,P5 ;GET UNIQUE STR CODE FOR CHKMNT
SETZ T2, ;JSB IS ALREADY MAPPED
LOCK JSSTLK ;LOCK JSB STRUCTURE INFO LOCK
CALL CHKMNT ;CHECK ACCESS TO STRUCTURE
JRST [ UNLOCK JSSTLK ;USER DIDN'T MOUNT STRUCTURE
CALL USTDIR ;UNLOCK DIRECTORY
RETBAD]
;P2 IS NON-ZERO IF HAVEN'T YET PROVED RIGHT TO DO THIS, 0 IF OK TO DO THIS
;IF NOT OK SO FAR, CHECK FOR SPECIAL CASE WHERE USER'S NAME AND THAT OF
;DIRECTORY BEING REQUESTED MATCH, THE OBJECT DIRECTORY IS ON A DOMESTIC
;STRUCTURE, AND THE OWNER FIELD OF THE DIRECTORY PROTECTION ALLOWS CONNECTING
ACCES3: SKIPN P2 ;IS USER ALLOWED TO DO THIS FUNCTION?
JRST ACCES8 ;YES.
MOVE T1,STRTAB(Q3) ;NO. POINT TO SDB FOR THIS STRUCTURE
MOVE T1,SDBSTS(T1) ;GET STATUS OF THIS STRUCTURE
TXNN T1,MS%DOM ;IS IT MOUNTED DOMESTIC?
JRST ACCES8 ;NO. SPECIAL CASE DOESN'T APPLY
MOVE T1,P1 ;POINT TO START OF DIRECTORY
LOAD T1,DRPOW,(T1) ;GET OWNER PROTECTION BITS
TXNN T1,DP%CN ;SEE IF CONNECT IS SET
JRST ACCES8 ;NO. SPECIAL CASE DOESN'T APPLY
MOVEI T1,ACCNAM ;T1/POINTER TO USER'S NAME AS SET
HRLI T1,(POINT 7,0) ; BY DIRST
MOVE Q1,P1 ;POINT TO START OF DIRECTORY
OPSTR <ADD Q1,>,DRNAM,(Q1) ;GET NAME OF DIRECTORY
AOS Q1 ;POINT BEYOND HEADER TO ACTUAL NAME STRING
MOVE T2,[POINT 7,0(Q1)] ;T2/POINTER TO NAME OF REQUESTED DIRECTORY
CALL STRCMP ;SEE IF USER NAME MATCHES REQUESTED DIRECTORY
JRST ACCES8 ;NO. SPECIAL CASE DOESN'T APPLY
SETZ P2, ;YES. INDICATE OK TO DO THIS
;DECIDE WHAT USER WANTS TO DO
ACCES8: MOVE T1,ACCFLG ;GET FLAGS INDICATING WHAT TO DO
TXNN T1,AC%OWN ;GAIN OWNERSHIP (GROUPS)?
JRST ACCES4 ;NO. GO SEE IF CONN
;USER WANTS TO 'ACCESS' THE DIRECTORY - GAIN ITS GROUPS
MOVE T1,P1 ;POINT TO START OF DIRECTORY THAT IS MAPPED
LOAD T1,DRMOD,(T1) ;GET MODE OF DIRECTORY
TXNE T1,MD%FO ;IS IT FILES-ONLY?
JRST [ MOVEI T1,ACESX7 ;YES. CAN'T ACCESS IT
JRST ACCER2]
SKIPE P2 ;NO. DO WE HAVE ACCESS?
JRST [ MOVEI T1,CNDIX1 ;NO. ASSUME INVALID PASSWORD
TXNE P2,1B0 ;DID USER GIVE A PASSWORD?
MOVEI T1,ACESX3 ;NO. SAY PASSWORD IS REQUIRED
JRST ACCER3]
MOVE T1,P5 ;YES. T1/STRUCTURE UNIQUE CODE
CALL GTSTOF ;GET OFFSET IN JSB FOR THIS STRUCTURE
JRST ACCER2 ;NO ROOM FOR AN ENTRY
MOVEM T2,P4 ;SAVE OFFSET
LOAD T1,JSGRP,(P4) ;GET GROUPS PREVIOUSLY SET UP
SKIPE T1 ;WERE THERE ANY?
CALL RELGRP ;YES. RELEASE THE SPACE USED BY THE LIST
; OF GROUPS
CALL CPYUGP ;COPY THE LIST OF USER GROUPS
SETZ T1, ;NONE THERE. CLEAR POINTER
STOR T1,JSGRP,(P4) ;STORE POINTER IN JSB
STOR Q2,JSADN,(P4) ;SAVE 'ACCESSED' DIRECTORY
;SEE IF USER WANTS TO CONNECT
ACCES4: MOVE T1,ACCFLG ;GET FLAGS INDICATING WHAT TO DO
TXNE T1,AC%CON ;CONNECT
JRST ACCES5 ;YES
UNLOCK JSSTLK ;NO. UNLOCK THE JSB STRUCTURE DATA
CALL USTDIR ;UNMAP THE DIRECTORY
RETSKP ;TAKE SUCCESS RETURN
;USER WANTS TO CONNECT
ACCES5: SKIPN P2 ;WAS PASSWORD OK (OR PRIVILEGE SUFFICIENT)?
JRST ACCES6 ;YES. PROCEED
MOVX T2,DC%CN ;T2/CONNECT ACCESS
CALL DIRCHK ;CHECK FOR ABILITY TO CONNECT TO THIS DIRECTORY
JRST [ MOVEI T1,CNDIX1 ;NO. ASSUME INVALID PASSWORD
TXNE P2,1B0 ;DID USER GIVE A PASSWORD?
MOVEI T1,ACESX3 ;NO. SAY PASSWORD IS REQUIRED
JRST ACCER3]
ACCES6: STOR P5,JSUC ;NO. STORE CONNECTED STRUCTURE UNIQUE CODE
STOR Q2,JSDIR ;STORE CONNECTED DIRECTORY NUMBER
CALL CPYCDN ;GO COPY CONNECTED DIR STRING TO JSB
UNLOCK JSSTLK ;UNLOCK THE STRUCTURE INFO LOCK
CALL USTDIR ;UNLOCK THE DIRECTORY (LOCKED BY SETDIR)
; GO GO OKINT
RETSKP ;TAKE SUCCESS RETURN
;USER WANTS TO CONNECT FOR ANOTHER JOB
ACCES7: MOVEM T1,P3 ;SAVE OBJECT JOB NUMBER
CALL USTDIR ;UNLOCK THE DIRECTORY (LOCKED BY SETDIR)
; AND GO OKINT
SKIPN P3 ;VALID JOB #
RETBAD (ARGX07) ;NO. CAN'T DIDDLE JOB 0
MOVE T1,ACCFLG ;SEE WHAT WE WANT TO DO
TXNN T1,AC%CON ;CONNECT?
RETBAD(ACESX4) ;NO. CAN'T DO THIS FOR ANOTHER JOB
MOVE T1,CAPENB ;GET ENABLED CAPABILITIES
TXNN T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
RETBAD(CAPX1) ;NO. REQUIRED FOR THIS FUNCTION
MOVE T1,P3 ;T1/JOB NUMBER
CALL CKJBLI ;SEE IF VALID AND LOGGED IN
RETBAD ;NO. OBJECT JOB MUST BE LOGGED IN
MOVE T1,P3 ;T1/JOB NUMBER FOR WHICH CONNECTING
CALL SETJSB ;MAP THE OBJECT JOB'S JSB (RETURNS OFFSET IN T1)
MOVEM T1,P1 ;SAVE OFFSETFOR ADDRESSING OBJECT JSB
LOCK JSSTLK(P1) ;LOCK STRUCTURE INFO LOCK
MOVE T2,T1 ;SEND OFFSET TO MAPPED JSB TO CHKMNT
CALL CHKMNT ;CHECK ACCESS TO STRUCTURE
JRST [ UNLOCK JSSTLK(P1) ;USER DID NOT MOUNT STRUCTURE
CALL CLRJSB
RETBAD]
STOR P5,JSUC,(P1) ;STORE CONNECTED STRUCTURE UNIQUE CODE
STOR Q2,JSDIR,(P1) ;STORE CONNECTED DIRECTORY NUMBER
SETZRO JSCDF,(P1) ;MARK THAT THE DIR STRING IN JSB IS NO GOOD
UNLOCK JSSTLK(P1) ;UNLOCK STRUCTURE INFO LOCK
CALL CLRJSB ;UNMAP THE OBJECT JSB
HLRE A,JOBPT(P3) ;GET TTY OF OBJECT JOB
JUMPL A,ACCES9 ;IF DETACHED, SKIP MESSAGE
TXO A,1B18 ;MAKE LINE NUMBER INTO DESIGNATOR
HRROI B,[ASCIZ/
[CONNECTED TO /]
SETZ C,
SOUT ;TYPE OUT CONNECTED MESSAGE
HRL T2,P5 ;GET STRUCTURE UNIQUE CODE
HRR T2,Q2 ;T2/(STRUCTURE UNIQUE CODE,,DIRECTORY)
DIRST ;PRINT STRUCTURE AND DIRECTORY NAMES
JFCL
HRROI B,[ASCIZ/]
/]
SOUT
ACCES9: RETSKP
;FAILURE
;USER GAVE WRONG PASSWORD
ACCER3: TDZA T2,T2 ;REMEMBER ENTRY
ACCER2: SETOM T2 ;REMEMBER THIS ENTRY
MOVEM T1,Q1 ;SAVE ERROR CODE
ULKDIR ;UNLOCK THE DIRECTORY AND STRUCTURE
UNLOCK JSSTLK ;UNLOCK JSB STRUCTURE INFO LOCK
JUMPE T2,[ UMOVE T1,1 ;IF ACJ TO GET INVOLVED
; GET USER ARG FOR ACJ
HRR T2,Q2 ;DIR NUMBER
HRL T2,P5 ;STRUCTURE CODE
OKINT ;ALLOW INTS
GTOKM (.GOACC,<T1,T2>,[NOINT
JRST .+1])
AOS ERRFLG ;IF SUCCESS, INCREMENT RETRY FLAG
JRST ACES0] ;AND TRY AGAIN
CAIN Q1,CNDIX1 ;IS ERROR THAT PASSWORD WAS BAD?
JRST [ MOVEI T1,^D3000 ;YES. WAIT A WHILE TO FOIL PASSWORD THIEVES
DISMS
JRST .+1]
MOVE T1,Q1 ;RESTORE ERROR CODE
OKINT ;SETDIR WENT NOINT
RETBAD ;TAKE ERROR RETURN
;ROUTINE TO COPY THE CONNECTED DIRECTORY NAME INTO THE JSB
CPYCDN: SETZRO JSCDF ;MARK THAT THE CURRENT STRING IS INVALID
LOAD T1,JSCDS ;GET THE CURRENT STRING POINTER
JUMPE T1,[MOVEI T2,MAXLW+1 ;IF NONE, GET SPACE FOR ONE
CALL ASGJFR
RET ;IF NO ROOM, DONT BOTHER
STOR T1,JSCDS ;REMEMBER THE STRING POINTER
JRST .+1]
MOVE T4,DIRORA ;NOW GET THE POINTER TO THE DIR NAME
LOAD T2,DRNAM,(T4) ;FROM CURRENT MAPPED DIR
ADD T2,DIRORA ;GET ABSOLUTE ADDRESS
MOVSI T3,(<POINT 7,0(T2),35>)
HRLI T1,(POINT 7,0,35) ;GET BYTE POINTERS TO BOTH STRINGS
CPYCDL: ILDB T4,T3 ;COPY STRING
IDPB T4,T1 ; FROM DIR HEADER TO JSB
JUMPN T4,CPYCDL ;LOOP BACK TIL NULL FOUND
SETONE JSCDF ;MARK THAT THE STRING IS VALID
RET ;AND RETURN
;UNACC - UNACCESS A DIRECTORY
;ACCEPTS IN T1/ OFFSET TO JSB (0 FOR THIS JOB)
; JSSTLK MUST BE LOCKED BY THE CALLER OF THIS ROUTINE
;RETURNS +1: FAILS
; +2: SUCCESS
;DIRECTORY MUST BE MAPPED
UNACC::
SAVEQ
MOVEM T1,Q3 ;SAVE OFFSET TO MAPPED JSB
MOVE T1,DIRORA ;POINT TO START OF DIRECTORY
LOAD Q1,DRNUM,(T1) ;GET DIRECTORY NUMBER
LOAD Q2,CURUC ;GET UNIQUE CODE FOR MAPPED DIRECTORY
MOVE T1,Q2 ;GET UNIQUE CODE TO LOOK FOR
MOVE T2,Q3 ;GET OFFSET TO MAPPED JSB
CALL FNDSTM ;GET POINTER TO JSB BLOCK FOR THIS STRUCTURE
RETBAD (ACESX6)
LOAD T1,JSADN,(T2) ;GET ACCESSED DIRECTORY
CAME T1,Q1 ;DID USER ACCESS THIS DIRECTORY?
RETBAD (ACESX6)
SETZRO <JSADN>,(T2) ;YES. CLEAR ACCESSED DIRECTORY NUMBER
OPSTR <SKIPE T1,>,JSGRP,(T2) ;WERE THERE ANY GROUPS?
JRST [ JUMPN Q3,.+1 ;IF ANOTHER JSB, DO NOT FREE GROUP SPACE
SETZRO <JSGRP>,(T2) ;YES. CLEAR THE POINTER
CALL RELGRP ;RELEASE FREE SPACE
JRST .+1]
MOVE T1,Q2 ;T1/STRUCTURE UNIQUE CODE
MOVE T2,Q3 ;GET OFFSET TO JSB
CALL FRJSSO ;REMOVE ENTRY IN JSB FOR THIS STRUCTURE IF POSSIBLE
RETSKP ;SUCCESS
;JSYS TO SET/CLEAR ADDRESS BREAK
;CALLING SEQUENCE:
;ACCEPTS IN 1/ FUNCTION CODE,,PROCESS HANDLE
; ADBRK
;RETURNS +1: ALWAYS
;USAGE OF ACS 2 AND 3 ARE DETERMINED BY THE FUNCTION CODE
.ADBRK::MCENT
UMOVE T1,1 ;GET FUN. CODE, FORK HANDLE
HLRZ T2,T1 ;ISOLATE FUNCTION CODE
JUMPL T2,[ITERR (ARGX02)] ;INVALID FUNCTION CODE
CAILE T2,.ABGAD ;IN RANGE?
ITERR (ARGX02) ;NOPE
HRRZ P1,T1 ;PRESERVE FORK HANDLE IN P1
CALL @[ IFIW!ABSET
IFIW!ABRED
IFIW!ABCLR
IFIW!ABGAD](T2) ;DISPATCH ON FUNCTION CODE
ITERR ;ERROR RETURN
MRETNG ;GOOD
;SET USER ADDRESS BREAK
ABSET: CALL BRKAVL ;ADDRESS BREAK AVAILABLE?
RETBAD (ABRKX1) ;NO, MUST BE SM10
UMOVE P2,2 ;GET ADDRESS
UMOVE P3,3 ; AND FLAGS
LSH P3,-<^D35-^L<AB%XCT>> ;RIGHT-JUSTIFY FLAGS (ASSUMES AB%XCT IS
; RIGHTMOST FLAG BIT)
CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CALL SETLFX ;Map process' PSB and check for execute-only
MOVEM P2,ADRBRK(T1) ;STUFF ADDRESS INTO PSB
STOR P3,ABFLG,(T1) ; AND FLAGS TOO
CAIN P1,.FHSLF ;SETTING MY OWN BREAK?
CALL [ DMOVE T1,P2 ;YES, GET ARGS FOR SETBRK
JSP T4,SETBRK ; AND POKE THE CPU
RET]
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK FORK STRUCTURE
RETSKP ;AND RETURN
;READ USER ADDRESS BREAK
ABRED: CALL BRKAVL ;ADDRESS BREAK AVAILABLE?
RETBAD (ABRKX1) ;NO, QUIT NOW
CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CALL SETLFK ;MAP PSB
MOVE T2,ADRBRK(T1) ;GET BREAK INFO
ANDX T2,EXPCBT ;MASK OUT ALL BUT 23-BIT ADDRESS
LOAD T3,ABFLG,(T1) ;GET FLAGS
LSH T3,<^D35-^L<AB%XCT>> ;PUT BITS IN RIGHT PLACE (ASSUMES AB%XCT
; IS RIGHTMOST FLAG BIT)
XCTU [ DMOVEM T2,2] ;RETURN ANSWERS TO USER
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK
RETSKP
;CLEAR USER ADDRESS BREAK
ABCLR: CALL BRKAVL ;BREAK AVAILABLE?
RETBAD (ABRKX1) ;NO, MUST BE SM10
CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CAIN T1,.FHSLF ;CLEARING OUR OWN BREAKS?
CALL [ SETZB T1,T2 ;YES, POKE THE CPU NOW
JSP T4,SETBRK ; ..
;**;[1831] Add 1 line at ABCLR:+7L PED 13-FEB-81
MOVE T1,P1 ;[1831] RESTORE FORK HANDLE
RET]
CALL SETLFX ;Map PSB and check for execute-only
SETZM ADRBRK(T1) ;CLEAR OUT ADDRESS BREAK INFO
CALL CLRLFK ;UNMAP PSB
CALL FUNLK
RETSKP
;READ ADDRESS OF INSTRUCTION WHICH CAUSED LAST ADDRESS BREAK
; (RFSTS GIVES ADDRESS OF NEXT INSTRUCTION TO BE EXECUTED,
; WHICH IS USELESS IF THE ADDRESS BREAK WAS CAUSED BY A
; PC-CHANGING INSTRUCTION)
ABGAD: CALL BRKAVL ;ADDRESS BREAK AVAILABLE?
RETBAD (ABRKX1) ;NO, QUIT
CALL FLOCK ;LOCK FORK STRUCTURE
MOVE T1,P1 ;GET FORK HANDLE
CALL SETLFK ;MAP ITS PSB
MOVE T2,ADRBK1(T1) ;GET ADDR OF BROKEN INSTRUCTION
UMOVEM T2,2 ;RETURN TO USER
CALL CLRLFK ;UNMAP PSB
CALL FUNLK ;UNLOCK FORK STRUCTURE
RETSKP ;GIVE GOOD RETURN
;JSYS TO ALLOCATE DEVICES TO A JOB OR TO THE DEVICE ALLOCATOR POOL
;CALLING SEQUENCE:
;ACCEPTS IN 1/ FUNCTION CODE
; 2/ DEVICE DESIGNATOR
; 3/ JOB NUMBER, -1, OR -2
; ALLOC
;RETURNS +1: ERROR - CODE IN AC 1
; +2: SUCCESSFUL
.ALLOC::MCENT ;ENTER JSYS
UMOVE T1,1 ;GET FUNCTION CODE
CAIE 1,.ALCAL ;IS THIS A LEGAL FUNCTION?
RETERR (ALCX1) ;NO, ILLEGAL FUNCTION CODE
MOVE T1,CAPENB ;THIS FUNCTION REQUIRES PRIVILEGES
TRNN T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
RETERR (ALCX2) ;NO, NOT ENOUGH PRIVILEGES
UMOVE T1,2 ;GET DEVICE DESIGNATOR
CALL CHKDES ;IS THIS A LEGAL DEVICE?
RETERR () ;NO, GIVE USER AN ERROR RETURN
TLNN T3,(DV%AS) ;IS THIS AN ASSIGNABLE TYPE DEVICE?
RETERR (ALCX3) ;NO, MUST BE ASSIGNABLE
CALL LCKDVL ;LOCK UP THE DEVICE LOCK
XCTU [HRRZ T3,3] ;GET ARGUMENT
HLRZ T4,DEVUNT(T2) ;GET OWNER OF THIS DEVICE
CAIN T3,-2 ;REQUESTING DEVICE FOR ALLOC POOL?
JRST ALCAL1 ;YES, GO PERFORM THAT FUNCTION
CAIN T3,-1 ;REQUESTING THAT THIS DEVICE BE FREED?
JRST ALCAL2 ;YES, GO FREE IT UP
CAIGE T3,NJOBS ;LEGAL JOB NUMBER?
SKIPGE JOBRT(T3) ;AND JOB ASSIGNED?
RETERR (ALCX4,<UNLOCK DEVLCK>) ;NO
CAMN T3,T4 ;ALREADY ASSIGNED TO THIS JOB?
JRST ALCAL0 ;YES
CAIE T4,-1 ;IS THIS DEVICE AVAILABLE?
CAIN T4,-2 ;OR IN ALLOCATOR'S POOL?
SKIPA ;YES
RETERR (ALCX5,<UNLOCK DEVLCK>) ;NO
HRLM T3,DEVUNT(T2) ;GIVE THIS DEVICE TO THE JOB SPECIFIED
MOVX T1,DV%ASN
IORM T1,DEVCHR(T2) ;SET DEVICE ASSIGNED TO JOB
ALCAL0: MOVX T1,D1%ALC ;SET THE ALLOCATED FLAG
IORM T1,DEVCH1(T2) ;...
ALCALR: UNLOCK DEVLCK ;RELEASE THE DEVICE LOCK
SMRETN
ALCAL1: MOVX T1,D1%ALC ;SET THE ALLOCATED FLAG
IORM T1,DEVCH1(T2) ;...
CAIE T4,-1 ;IS THE DEVICE FREE?
RETERR (ALCX6,<UNLOCK DEVLCK>) ;NO, TELL CALLER
HRLM T3,DEVUNT(T2) ;YES, GIVE IT TO ALLOCATOR POOL
JRST ALCALR ;GO SET ALLOCATED BIT
ALCAL2: MOVX T1,D1%ALC ;CLEAR THE ALLOCATED FLAG
ANDCAM T1,DEVCH1(T2) ;...
CAIE T4,-2 ;IS DEVICE IN THE POOL NOW?
RETERR (ALCX6,<UNLOCK DEVLCK>) ;NO, TELL CALLER
HRLM T3,DEVUNT(T2) ;YES, PUT IT IN FREE POOL
JRST ALCALR ;GO RETURN
;SET THE DEVICE TABLES LOCK.
;MUST BECOME NOINT SO CONTROL DOESN'T RETURN TO USER WITH LOCK
;SET.
LCKDVL:: NOINT
SE1CAL
AOSN DEVLCK ;ATTEMPT LOCK
RET ;SUCESS
OKINT ;FAILURE, RE-ENABLE INTERRUPTS
CAIA ;SO USER CAN BREAK OUT WITH ^C
JRST LCKDVL ;WAIT SHORT TIME THEN TRY AGAIN
CBLK1 ;THIS RETURNS .-1
; Change account
.CACCT::MCENT
STKVAR <CACUSR>
MOVE A,JOBNO
MOVE B,JOBDIR(A) ;GET LOGIN DIRECTORY NUMBER
TRNN B,777777
RETERR(CACTX2)
HRLI B,USRLH ;MAKE IT A 36-BIT USER NUMBER
MOVEM B,CACUSR ;SAVE IT
;**;[1823] Replace one line at .CACCT+8.L with 7.Lines RAS 29-DEC-80
NOINT ;[1823] NOINT between Accounts
SKIPL T1,LOGDES ;[1823] Setup for logging of change
DOBE ;[1823] Wait till logging device is ready
HRROI T2,[ASCIZ/Changed/] ;[1823] String to head logging with
CALL LOGUSD ;[1823] Log change and set up for USAGE
CALL LOGTUS ;[1823] Perform the Usage logout
MOVE A,CACUSR ;[1823] get back user number
CALL CNVDIR ;CONVERT THIS TO A DIR NUMBER
CALL SETDIR ;MAP IN DIRECTORY
;**;[1823] Change one line at .CACCT+11.L RAS 29-DEC-80
RETERR ( ,<OKINT>) ;[1823] SETDIR FAILURE
UMOVE A,1
MOVE B,CACUSR ;GET BACK USER NUMBER
CALL SETACT
;**;[1924] Change 1823 line at .CACCT +15L JGZ 18-AUG-81
;**;[1823] Change one line and add one at .CACCT: +15L RAS 29-DEC-80
RETERR( ,<CALL USTDIR ;[1823]
OKINT >) ;[1823] Free interrupts again.
CALL USTDIR
;**;[1823] Add comment at .CACCT+17.L RAS 29-DEC-80
CALL LOGCJM ;[1823] Start a session entry for this account
CALL LGTAD ;GET DATE/TIME
MOVEM A,CTIMON ;SAVE IN JSB
;**;[1823] Add one line at .CACCT+20.L RAS 29-DEC-80
OKINT ;[1823] Things are done now
SMRETN
; INTERNAL ROUTINE TO SET AN ACCOUNT
; CALL: A/ POINTER TO AN ACCOUNT STRING OR 5B2+ACCOUNT NUMBER
; B/ 36-BIT USER NUMBER
; CALL SETACT
; RETURNS: +1 ERROR
; +2 SUCCESS
SETACT: TRVAR <<ACTBUF,MAXLW+1>,ACTLN,PTR,USER,CLSSN>
MOVEM B,USER ;SAVE USER NUMBER
MOVEM A,PTR ;SAVE THE POINTER
SETZM ACTBUF
MOVEI A,ACTBUF
HRLS A
AOS A
MOVEI B,ACTBUF
ADDI B,MAXLW
BLT A,0(B) ;CLEAR THE BUFFER
MOVE B,PTR
CAML B,[5B2]
CAMLE B,[6B2-1]
JRST SETAC1 ;NOT A NUMBER
TLZ B,700000 ;NUMBER, CONVERT IT TO A STRING
HRROI A,ACTBUF
AOS A ;STRING STARTS PAST FIRST WORD IN ACTBUF
MOVEI C,12 ;NUMBERS ARE DECIMAL
NOUT ;DO THE CONVERSION
RETBAD () ;FAILED
IBP A ;STEP PAST NULL SO COUNT IS RIGHT
HRRZ B,A ;GET THE LENGTH OF THE STRING
SUBI B,ACTBUF ;IN FULL WORDS ONLY
AOS B ;CORRECT THE COUNT
MOVEM B,ACTLN ;SAVE IT
SOS B
MOVNS B
HRLZ A,B ;MAKE THIS LOOK LIKE A LOOKUP PTR
HRRI A,ACTBUF
JRST SETAC2
SETAC1: MOVEI A,ACTBUF
CALL CPYFU1 ;COPY ACCOUNT STRING
RETBAD (CACTX1) ;SHOULD NEVER RETURN +1
HLRE B,A
MOVNS B
MOVEM B,ACTLN ;STRING LENGTH IN FULL WORDS
SETAC2: MOVE B,A ;B/ POINTER TO STRING
MOVE A,USER ;GET USER NUMBER
CALL VERACT ;VALIDATE THE ACCOUNT
RETBAD () ;ERROR, RETURN
MOVEM A,PTR ;SAVE INFO RETURNED BY VERACT
MOVEM B,USER ; ...
MOVEM C,CLSSN ;SAVE RETURNED CLASS
TXNE A,AC%MCH ;ACCOUNT MATCH ACCTSR?
RETSKP ;YES, RETURN NOW
MOVE B,ACTLN ;GET BACK STRING LENGTH
SETZM ACCTSR(B) ;MAKE SURE LAST WORD IS ZEROED FOR FULL
; WORD COMPARES IN VACCT
ADDI B,2 ;# FULL WORDS PLUS REMAINDER
MOVEM B,ACCTSL ;SET UP COUNT OF WORDS IN ACCOUNT STRING
HRROI A,ACCTSR
MOVEI B,ACTBUF
HRLI B,(<POINT 7,0,35>) ;POINT TO START OF ACCOUNT TEXT STRING
MOVEI C,MAXLC+1
MOVEI D,.CHNUL ;TERMINATE ON NULL BYTE
SOUT ;COPY VALIDATED STRING TO JSB
ERJMP [RETBAD ()]
MOVE A,USER ;GET THIS ACCOUNT'S EXPIRATION DATE
MOVEM A,ACCTSX ;PUT IT IN JSB
MOVE A,CLSSN ;GET CLASS FROM ACCOUNT ENTRY
CALL SETCLS ;SET IT FOR THE JOB
RETSKP ;GIVE GOOD RETURN
;SPECIAL ROUTINE USED BY LOGIN TO FIND AND USE THE DEFAULT
;ACCOUNT FOR THIS LOGIN. DIRECTORY MUST BE MAPPED AND LOCKED.
SETACL: TRVAR <<ACTBUF,MAXLW+1>,ACTLN,PTR,USER,CLSSN>
SETZB D,1+ACTBUF ;INIT COUNTS AND STRING
SETZ A,
MOVEM B,USER ;SAVE USER NUMBER
MOVE C,DIRORA ;GET DIR BASE ADDRESS
LOAD B,DRACT,(C) ;GET DEFAULT ACCOUNT STRING
JUMPE B,SETAL1 ;IF NONE, GO ON
ADD B,DIRORA ;GET POINTER TO BLOCK
HRRZ A,0(B) ;GET SIZE OF BLOCK
SOS A ;COUNT OF WORDS IN ACCOUNT STRING
MOVE D,A ;SAVE COUNT
AOS B ;POINT TO START OF STRING
MOVEI C,1+ACTBUF ;POINT TO WHERE IT WILL GO
CALL XBLTA ;MOVE STRING TO STACK
MOVEI A,-1(D) ;STORE COUNT CONSISTENT WITH COUNT FROM CPYFU1
SETAL1: MOVEM A,ACTLN ;SAVE SIZE OF STRING
MOVNI D,-1(D) ;GET -NWORDS+1
MOVSI A,0(D) ;TO LH OF A
HRRI A,ACTBUF ;FORM LOOKUP POINTER
CALLRET SETAC2 ;AND CONTINUE IN MAIN ROUTINE
; Clear input buffer
.CFIBF::MCENT
;**;[1844] Change and add two lines at .CFIBF: +1L JGZ 13-APR-81
CALL CHKTTR ;[1844] IS THIS A TERMINAL?
MRETNG ;[1844] NO, THEN THIS IS A NOOP
CALL CHKTTY ;[1844] CAN WE GET THE TERMINAL?
ITERR () ;[1844] NO, RETURN ERROR
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;FAIL IF NOT ACTIVE
CALL TTCIB0
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
; Clear file output buffer
.CFOBF::MCENT
;**;[1844] Change and add two lines at .CFOBF: +1L JGZ 13-APR-81
CALL CHKTTR ;[1844] IS THIS A TERMINAL?
MRETNG ;[1844] NO, THEN THIS IS A NOOP
CALL CHKTTY ;[1844] CAN WE GET THE TERMINAL?
ITERR () ;[1844] NO, RETURN ERROR
CALL LCKTTY ;POINT TO DYNAMIC DATA, ALLOW DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
CALL TTCOBF
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
; Connect to directory
; Call: 1 ; Directory number
; ;B0 - CHECK PSWD ONLY AND DON'T CONNECT
; ;B1 - DON'T CONNECT
; 2 ; String pointer to password
; CNDIR
; Return
; +1 ; Error
; +2 ; Ok
.CNDIR::MCENT
ITERR (CNDIX7) ;CNDIR WAS REPLACED BY ACCES
;CRJOB -- CREATE A JOB OTHER THAN THIS ONE
;CALL: 1 ;FLAG BITS
; 2 ;POINTER TO ARGUMENT BLOCK
; CRJOB
;RETURNS:
; +1 ;ERROR
; +2 ;SUCCESS
; IN 1 ;JOB NUMBER OF NEWLY CREATED JOB
;
;FLAGS IN AC1:
;B0 CJ%LOG ;ON - TRY TO LOG THE NEW JOB IN
; ;OFF - CREATE AN UN-LOGGED-IN JOB
;B1 CJ%NAM ;ON - USE NAME AND PASSWORD IN ARG BLOCK
; ;OFF - LOG IN AS SAME USER AS EXECUTOR OF CRJOB
;B2-3 CJ%ACT ;ACCOUNT FIELD. 0 - USE CURRENT ACCOUNT
; ;1 - USE ACCOUNT SUPPLIED IN ARG BLOCK
; ;2 - USE DEFAULT ACCOUNT OF NEW JOB'S USER
;B4 CJ%ETF ;ON - PUT EXEC IN TOP FORK OF NEW JOB
; ;OFF - FILE REQUESTED BY B5 IS IN TOP FORK
;B5 CJ%FIL ;ON - FILENAME IN ARG BLOCK SHOULD BE GET'ED
; ;OFF - JUST AN EXEC. NO FILE.
;B6 CJ%ACS ;ON - IF B5 IS ON, PUT AC'S FROM ARG INTO FORK
; ; WHICH HAS THE FILE GET'ED INTO IT
;B7 CJ%OWN ;ON - MAINTAIN OWNERSHIP OF THE NEW JOB
; ;OFF - DISOWN THE NEW JOB
;B8 CJ%WTA ;ON - WAIT TILL ATTACHED BEFORE RUNNING NEW JOB
;B9 CJ%NPW ;ON - NO PASSWORD CHECK IN NEW JOB LOGIN
; ; (REQUIRES WHEEL/OPER, OR B1 OFF)
;B10 CJ%NUD ;ON - NO UPDATE OF LAST-LOGIN DATE.
;B11 CJ%SPJ ;ON - DO SPJFN WITH ARG IN ARG BLOCK
;B12 CJ%CAP ;ON - SET NEW JOB'S CAPMSK RH TO MY CURRENT
; ; CAPENB RH, UNTIL IT LOGS IN.
;B13 CJ%CAM ;CAPABILITY MASK AFTER LOGIN
;B14 CJ%SLO ;SIGNAL THE SUPPLIED PID AT LOGOUT TIME
;B17 CJ%DSN ;ON - DISOWN EXISTING JOB (IF IT'S MINE), JOB
; ; NUMBER IS IN AC 3
;IN PARAMETER BLOCK:
;WD0 .CJNAM ;STRING POINTER TO NAME FOR LOGIN
;WD1 .CJPSW ;STRING POINTER TO PASSWORD FOR LOGIN
;WD2 .CJACT ;ACCOUNT DESIGNATOR/STRING POINTER FOR LOGIN
;WD3 .CJFIL ;STRING POINTER TO FILENAME TO GET
;WD4 .CJSFV ;SFRKV OFFSET TO START FILE
;WD5 .CJTTY ;TTY DESIGNATOR, OR NULL DESIGNATOR, FOR CTTY
;WD6 .CJTIM ;TIME LIMIT (NOT IMPLEMENTED)
;WD7 .CJACS ;POINTER TO 16 WORDS OF AC'S FOR FORK
;WD8 .CJEXF ;EXEC FLAGS, FOR AC1 OF STARTED EXEC
;WD9 .CJPRI ;PRIMARY JFN'S FOR SPJFN IN NEW JOB
;WD10 .CJCPU ;CPU LIMIT (ZERO MEANS NONE)
;WD11 .CJCAM ;CAPABILITY MASK
;WD12 .CJSLO ;PID TO SEND LOGOUT MSG TO
.CRJOB::MCENT ;CREATE JOB JSYS
GTOKM (.GOCJB,,[RETERR ()]) ;GETOK FOR .CRJOB AND ITRAP IF ERROR
CRJOB1: NOINT ;PROTECT THE CRJLCK RESOURCE
LOCK (CRJLCK,<JRST CRJLKF>)
SETZM CRJANS ;CLEAR THE RESULT COMMUNICATION WD
MOVE T1,JOBNO ;GET MY JOB NUMBER
MOVEM T1,CRJONJ ;FOR CREATEE TO SEE
MOVE T1,CAPENB ;AND MY CAPS
MOVEM T1,CRJOJC ; ..
UMOVE Q1,1 ;FLAGS FROM CALLER
MOVEM Q1,CRJAC1 ;STORE THEM FOR NEW JOB
TXNE Q1,CJ%DSN ;REQUEST TO DISOWN A JOB?
JRST CRJDSN ;YES.
TXNN T1,SC%WHL+SC%OPR ;IS THIS A PRIVILEGED JOB?
TXNE Q1,CJ%LOG+CJ%ETF ;NO. MUST HAVE EXEC IN TOP FK, OR LOGIN
SKIPA ;OK.
JRST CRJILG ;NO GOOD. GIVE ILLEG COMBINATION ERROR.
UMOVE Q2,2 ;OK, GET POINTER TO ARG BLOCK
SETOM CRJTTY ;ASSUME DETACHED NEW JOB
UMOVE T1,.CJTTY(Q2) ;GET THE TTY DESIGNATOR
CAIN T1,.NULIO ;NUL DESIGNATOR?
JRST CRJB1A ;YES. OK.
CAIL T1,400000 ;NO, SEE IF IT'S A VALID TTY
CAIL T1,400000+NLINES ; ..
JRST CRJTTX ;NOT A LEGAL TTY NUMBER
MOVE T2,T1 ;GET TTY DESIGNATOR IN T2
SUBI T2,400000 ;TTY NUMBER IS A REAL TTY.
NOSKED ;CHECK TO SEE IF IT'S AVAILABLE.
CALL GTCJOB ;STABLE STATE OF TTFORK...
JRST CRJOTX ;TTY NOT ASSIGNED
CAMN T3,JOBNO ;IS THE TTY ASSIGNED TO ME?
CAMN T2,CTRLTT ;AND NOT MY CONTROLLING TERMINAL?
CRJOTX: JRST [ OKSKED ;NOT A VALID TTY FOR THIS USE
JRST CRJTTX] ;FAIL.
PUSHJ P,CHKDEV ;SEE IF IT'S ASSIGNED TO ME
JRST CRJOTX ;IT'S NOT.
TXNN T3,DV%ASN ;ASSIGNED?
JRST CRJOTX ;NO.
UMOVE Q1,T1 ;RESTORE AC'S CLOBBERED ABOVE
UMOVE Q2,T2
UMOVE T1,.CJTTY(Q2) ;GET TTY DESIGNATOR AGAIN
ANDI T1,377777 ;JUST THE LINE NUMBER
MOVEM T1,CRJTTY ;STORE THE TTY TO START JOB ON
OKSKED ;LET TTFORK CHANGE NOW
TRO T1,400000 ;AND NOW RELEASE IT FROM THIS JOB
RELD
JFCL
;FALL THRU
;FALLS THRU FROM ABOVE
CRJB1A: JE CJ%LOG,Q1,CRJOB4 ;JUMP IF NOT LOGGING IN
TXNN Q1,CJ%NAM ;USING SUPPLIED PASSWORD AND NAME?
JRST CRJOB2 ;NO, USE MINE.
UMOVE T2,.CJNAM(Q2) ;GET THE SUPPLIED NAME STRING
MOVEI T1,CRJUSR-1 ;WHERE TO PUT THE TEXT
PUSHJ P,CPYFU1 ;COPY THE STRING
JRST CRJCPX ;FAILED?
UMOVE T2,.CJPSW(Q2) ;COPY THE PASSWORD
MOVEI T1,CRJPSW-1 ;TO HERE
PUSHJ P,CPYFU1 ; ..
JRST CRJCPX ;CAN'T?
JRST CRJOB4 ;OK, HAVE NAME AND PASSWORD NOW
;HERE'S THE FAIL PATH ON THE LOCK MACRO ABOVE.
CRJLKF: OKINT
MOVEI T1,CRJLCK ;WAIT, INTERRUPTABLE, FOR THE LOCK
PUSHJ P,DISL
JRST CRJOB1 ;AND GO GRAB IT NOW.
;HERE TO COPY MY OWN NAME AND PASSWORD FOR NEW JOB. ACTUALLY,
; JUST PUT MY NAME IN, AND CAUSE LOGIN TO NOT CHECK PASSWORD.
CRJOB2: HRRZ T2,JOBNO ;THIS JOB NUMBER
HRRZ T2,JOBDIR(T2) ;HERE IS MY LOGGED IN USER NUMBER
HRLI T2,USRLH ;MAKE A USER NUMBER
HRROI T1,CRJUSR ;PUT THE NAMESTRING HERE
DIRST ;CONVERT TO STRING
JRST CRJXXX ;FAILED
MOVX T1,CJ%NPW ;SET THE BIT SO THAT LOGIN
IORM T1,CRJAC1 ; WILL NOT CHECK PASSWORD
;FALL THRU TO ACCOUNT HANDLING
;FALLS THRU FROM ABOVE
;NOW GET THE ACCOUNT FOR NEW JOB
CRJOB4: SETZM CRJACT ;DEFENSIVE CHECKS ON ACCOUNT.
LOAD T1,CJ%ACT,Q1 ;SEE WHERE TO GET ACCOUNT FROM
TRNE T1,.CJUDA ;WANT DEFAULT ACCOUNT?
JRST CRJB5Z ;YES. NOTHING TO SET UP.
TRNE T1,.CJUAA ;NO, MINE, OR SUPPLIED?
JRST CRJOB5 ;SUPPLIED.
;GET STRING ACCOUNT FOR CURRENT JOB
CRJB4A: MOVE T1,[XWD ACCTSR,CRJACT+1]
BLT T1,CRJACT+10 ;COPY THE ACCOUNT STRING
JRST CRJB5S ;DONE WITH THE ACCOUNT
;HERE IF ACCOUNT WAS SUPPLIED IN ARG BLOCK.
CRJOB5: UMOVE T2,.CJACT(Q2) ;GET ACCT NUMBER/POINTER FROM BLOCK
MOVE T1,T2 ;SEE IF NUMERIC OR STRING
TLC T1,(5B2) ; ..
TLNE T1,(7B2) ; ..
JRST CRJB5A ;STRING.
MOVEM T2,CRJACT ;NUMERIC.
JRST CRJB5Z ;DONE WITH ACCOUNT
CRJB5A: MOVEI T1,CRJACT ;COPY STRING TO HERE + 1
PUSHJ P,CPYFU1 ; ..
JRST CRJCPX ;CAN'T COPY IT?
CRJB5S: MOVE T1,[000700,,CRJACT] ;MUST BE POSITIVE NUMBER
MOVEM T1,CRJACT ;POINTER TO THE ACCOUNT
CRJB5Z: JRST CRJB5I ;DONE WITH ACCOUNT. GO LOOK FOR INFERIOR
;MORE CRJOB. HERE TO DEAL WITH INFERIOR FORK
CRJB5I: UMOVE T2,.CJEXF(Q2) ;GET FLAGS FOR EXEC, IN CASE NEEDED
MOVEM T2,CRJEXF ;SAVE FOR LATER
UMOVE T2,.CJSFV(Q2) ;START FORK VECTOR OFFSET
HRRZM T2,CRJEVO ;SAVE THAT TOO
UMOVE T2,.CJPRI(Q2) ;AND PRIMARY JFN'S, MAYBE NEEDED TOO
MOVEM T2,CRJPJF ; ..
TXNN Q1,CJ%FIL ;IS THERE A FILE TO RUN?
JRST CRJB5Y ;NO.
MOVEI T1,CRJFIL-1 ;YES, GET ITS FILE NAME
UMOVE T2,.CJFIL(Q2) ;FROM HERE IN ARG BLOCK
MOVEI T3,<5*40>-1 ;CHARACTERS THAT CAN FIT IN STORAGE BLK
PUSHJ P,CPYFU2 ;COPY THE STRING
JRST CRJCPX ;CAN'T?
TXNN Q1,CJ%ACS ;WANT THE AC'S SET UP?
JRST CRJB5C ;NO
MOVEI T1,20 ; Length of AC block
UMOVE T2,.CJACS(Q2) ;YES. GET THE POINTER TO THEM
XMOVEI T3,CRJFAC ; Place to store user's
CALL BLTUM1 ;COPY AC'S, ADDING PCS IF NECESSARY
CRJB5C:
CRJB5Y: ;END OF CODE DEALING WITH THE INFERIOR FORK TO RUN
UMOVE T2,.CJCAM(Q2) ;CAPABILITIES MASK FOR LOGIN
TXNN Q1,CJ%CAM ;SUPPLIED?
SETO T2,0 ;NO, ASSUME ALL BITS ALLOWED
MOVEM T2,CRJCAM ;SAVE TO MASK AT LOGIN TIME
UMOVE T2,.CJSLO(Q2) ;A PID TO SIGNAL AT LOGOUT TIME
TXNN Q1,CJ%SLO ;UNLESS NOT TO USE ONE
MOVEI T2,0 ;IN WHICH CASE, USE ZERO
MOVEM T2,CRJSLO ;SAVE IT
UMOVE T2,.CJCPU(Q2) ;CPU LIMIT TO APPLY (ZERO IF NONE)
MOVEM T2,CRJCPU ; ..
;FALL THRU
;FALLS THRU FROM ABOVE
;HERE TO ACTUALLY PUT IN THE REQUEST FOR SCHEDULER TO START THE JOB
MOVSI T1,-2 ;FLAG OF -2 FOR JOBSRT MEANS CRJOB
HRRI T1,JOBSRT ;AND SCHED LEVEL CODE ADDR
CALL SCDRQ7 ;REQUEST IT.
MOVEI T1,CRJANS ;NOW WAIT FOR AN ANSWER.
CALL DISN ; ..
MOVE T1,CRJANS ;WHAT HAPPENED?
JUMPGE T1,CRJXXX ;IF PLUS, IT FAILED.
HLRZ T1,CRJONJ ;IT SUCCEEDED. GET THE JOB NUMBER
UMOVEM T1,1 ;RETURN IT TO THE CALLER.
CRJXIT: UNLOCK CRJLCK ;RELEASE THE STORAGE LOCK
SMRETN ;SUCCESS RETURN.
CRJDSN: UMOVE T1,3 ;GET JOB NUMBER TO DISOWN
CAIL T1,0 ;A LEGAL JOB NUMBER?
CAIL T1,NJOBS ; ..
JRST CRJILG ;NO. ILLEGAL ARG FAILURE
NOSKED ;FREEZE THE OWNERSHIP TABLE
HRRZ T2,JOBONT(T1) ;GET THE JOB'S OWNER
CAMN T2,JOBNO ;IS IT ME?
SETOM JOBONT(T1) ;YES. I GIVE IT UP.
OKSKED ;FREE THE TABLE
CAME T2,JOBNO ;WAS IT OK?
JRST CRJILG ;NO. FAIL.
JRST CRJXIT ;YES. GIVE SUCCESS RETURN.
CRJCPX: ;COPY OF USER STUFF FAILED
CRJILG: MOVEI T1,CRJBX1 ;ILLEGAL PARAMETER OR BIT COMBINATION
JRST CRJXXX
CRJTTX: MOVEI T1,CRJBX4 ;BAD TTY REQUESTED
CRJXXX: UNLOCK CRJLCK ;FREE THE STORAGE BLOCK
OKINT
JRST MRETNE ;RETURN FAIL, ERROR NUMBER IN 1
; Delete deleted files
; 1/ DD%DTF (B0) = DELETE ;T FILES ALSO
; 2/ DIRECTORY NUMBER
.DELDF::MCENT
STKVAR <DELDSD> ;DIRECTORY NUMBER SPECIFIED
UMOVE A,2 ;GET THE DIRECTORY NUMBER
MOVEM A,DELDSD ;SAVE THE STRUCTURE/DIRECTORY NUMBER
;**;[1866] Add 4 lines at .DELDF: +4L RAS 5-MAY-81
;**;[3188] Remove 4 lines at .DELDF+4L DEE 12-DEC-84
CALL SETDIR
ITERR(DELDX2) ;NO SUCH USER
MOVX B,DC%CN ;REQUIRES OWNER ACCESS
CALL DIRCHK ;SEE IF USER CAN CONNECT (AND THUS OWN DIRECTORY)
JRST [ ULKDIR ;UNLOCK DIR
ITERR(DELDX1)] ;ERROR
DELDF1: CALL USTDIR
MOVE A,DELDSD ;GET THE DIRECTORY NUMBER
XCTU [HLLZ F,A] ;GET FLAGS
TXZ F,1B17 ;DON'T ALLOW DELETE ALL
CALL DELDEL
ITERR () ;ERROR OCCURED DURING EXPUNGE
JRST MRETN
; Device to string
; Call: 1 ; Destination designator
; 2 ; Device designator
; DEVST
; Return
; +1 ; Ok
.DEVST::MCENT
UMOVE A,2
CALL CHKDEV
JRST [ CAIE A,DEVX2
RETERR()
JRST .+1]
MOVE C,DEVNAM(B)
CALL DEVST0 ;COPY NAME STRING TO USER SPACE
SMRETN
;ROUTINE TO COPY STR NAME TO USER STRING
;ACCEPTS IN C/ SIXBIT STR NAME
DEVST0: SETZ B,
LSHC B,6 ;GET NEXT BYTE
JUMPE B,DEVST1
ADDI B,40
CALL BOUTA
JRST DEVST0
DEVST1: RET
; Dismiss until input buffer is empty
.DIBE:: MCENT
DIBE1: UMOVE T1,1 ;GET DESIGNATOR
CALL CHKTTR
JRST MRETN
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
CALL TTDIBE
JRST DIBE1 ;TRY AGAIN
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
; Directory number to string conversion
; Call: 1 ; Sink designator
; 2 ; Directory number
; DIRST
; Return
; +1 ; Error
; +2 ; Ok
.DIRST::MCENT
UMOVE A,2 ;GET DIR NUMBER
CALL DIRST0 ;DO THE WORK
RETERR () ;FAILED
SMRETN ;SUCCESSFUL
DIRST0: STKVAR <<DIRSTN,MAXLW>,DIRSTR>
MOVEM A,DIRSTR ;SAVE THE DIRECTORY NUMBER
CALL GDIRST ;GET POINTER TO NAME STRING INTO A
RETBAD ()
XMOVEI B,1(A) ;COPY NAME STRING TO STACK
XMOVEI C,DIRSTN
LOAD A,NMLEN,(A) ;GET NUMBER OF WORDS
SOS A
CALL XBLTA
LOAD B,CURSTR ;GET CURRENT STR #
MOVE C,DEVNAM+DVXST0(B) ;GET SIXBIT STR DEVICE NAME
CALL USTDIR ;UNLOCK THE DIR
HLRZ A,DIRSTR ;GET DIR NUMBER BACK AGAIN
CAIN A,USRLH ;IS THIS A USER NUMBER?
JRST DIRST1 ;YES, DONT PUT ON THE PUNCTUATION
CALL DEVST0 ;OUTPUT THE STR NAME TO THE USER
MOVEI B,":" ;NOW SOME PUNCTUATION
CALL BOUTA
MOVEI B,"<" ;AND THE DIR DELIMITER
CALL BOUTA
DIRST1: MOVEI A,DIRSTN ;GET POINTER TO STRING
SOS A ;ADR-1
CALL JFNSSD ;NOW OUTPUT THE DIR NAME
MOVEI B,">" ;AND CLOSE WITH CLOSE BRACKET
HLRZ A,DIRSTR ;GET STRUCTURE NUMBER AGAIN
CAIE A,USRLH ;USER NUMBER?
CALL BOUTA ;NO, OUTPUT THE CLOSE BRACKET
RETSKP
; Dismiss until output buffer is empty
.DOBE:: MCENT
DOBE1: UMOVE T1,1 ;GET DESIGNATOR
CALL CHKTTR
JRST MRETN
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
CALL TTDOBE
JRST DOBE1 ;NEED TO RETRY
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
; Enter fact file
; Call: LH(1) ; Minus entry size
; RH(1) ; Location of entry
; EFACT
; Return
; +1 ; Error
; +2 ; Ok
.EFACT::MCENT
MOVE B,CAPENB
MOVE C,0(P) ;GET CALLER'S PC
TXNE C,UMODF ;CALLED FROM MONITOR?
TXNE B,SC%WHL!SC%OPR ;NO, PRIVILEGED?
SKIPA B,FACTSW ;YES, OK SO FAR
RETERR(EFCTX1)
TLNN B,(SF%FAC)
SMRETN ; Fact file not on
HLRO B,A ; Get size
CAMG B,[-^D64]
RETERR(EFCTX2) ; Too big
NOINT
PUSH P,CAPENB ; Save current caps
MOVEI A,SC%WHL+SC%OPR ; Set bits to ensure access to
IORM A,CAPENB ; Accounts directory and fact file
MOVEI C,^D30
EFACT2: HRROI B,FCTFIL ;GET POINTER TO NAME OF FACT FILE
MOVSI A,(GJ%PHY!GJ%SHT)
GTJFN
JRST EFACT3
PUSH P,1
MOVE 2,[XWD 440000,20000]
OPENF ; Open for append
JRST EFACT4
EFACT6: POP P,1
UMOVE C,1
UMOVE B,(C)
HLRE D,C
MOVNS D
DPB D,[POINT 6,B,35]
JRST .+2
EFACT1: UMOVE B,(C)
BOUT
ERJMP [HRRZ B,LSTERR ;GET ERROR CODE FOR BUGCHK
BUG(EFACF3,<<B,ERRCOD>>)
JRST EFCT1A]
AOBJN C,EFACT1
EFCT1A: CLOSF
BUG(EFACF1,<<A,ERRCOD>>)
POP P,CAPENB ; Restore caps
SMRETN
EFACT4: CAIE A,OPNX9
SETZ C,
POP P,1
RLJFN
JFCL
SOJLE C,EFACT3
MOVEI A,^D4000
DISMS
JRST EFACT2
EFACT3: HRROI 2,FCTFIL ;GET POINTER TO NAME OF FACT FILE
MOVSI 1,(GJ%FOU!GJ%PHY!GJ%SHT)
GTJFN
JRST EFACT9
MOVEI C,^D30
EFACT8: PUSH P,1
MOVE 2,[XWD 440000,20000]
OPENF
JRST EFACT5
JRST EFACT6
EFACT5: CAIE A,OPNX9
JRST EFACT7
SOJLE C,EFACT7
MOVEI A,^D4000
DISMS
POP P,1
JRST EFACT8
EFACT7: POP P,1
RLJFN
JFCL
EFACT9: POP P,CAPENB ; Restore caps
RETERR(EFCTX3)
; Error number to string
; Call: 1 ; Output designator
; 2 ; Error number
; 3 ; -NCHARS,,CTRL BITS
; ERSTR
.ERSTR::MCENT
CALL FLOCK ;LOCK FORK STRUCTURE
HLRZ 1,2
CALL SETLFK ; Map psb of the fork
UMOVE B,3
HRLZI C,ERRSAV(1)
HRRI C,4
TRNN B,1B19
BLT C,10
XCTU [HRRZ C,2]
CAIN C,777777
MOVE C,LSTERR(1)
CALL [ SAVET ;UNLOCK AND UNMAP PSB HERE
CALL CLRLFK ;BUT PRESERVE ACS
CALLRET FUNLK]
MOVE A,C ;SEE IF THIS IS A LEGAL ERROR CODE
TRZ A,77777 ;MASK OFF LOW ORDER BITS
CAIE A,.ERBAS ;IS THIS LEGAL
;**;[1812] Change one line at .ERSTR: +18L JGZ 5-DEC-80
JRST EMRET1 ;[1812] NO, MUST HAVE CORRECT BASE ADDRESS
ANDI C,077777 ;FLUSH NON-SIGNIFICANT BITS
;**;[1812] Change one line at .ERSTR: +20L JGZ 5-DEC-80
JUMPE C,EMRET1 ;[1812] ZERO IS ILLEGAL ERROR CODE
; We now have error number in c, parameters in 4-10, bits and count in b
PUSH P,B
HRROI 2,[ASCIZ /SYSTEM:ERRMES.BIN/]
MOVSI 1,(GJ%OLD!GJ%PHY!GJ%SHT)
GTJFN ; Get jfn for error mnemonics
JRST NOFIL
MOVE 2,[XWD 440000,200000]
PUSH P,1
OPENF
JRST [ POP P,1
RLJFN
JFCL
JRST NOFIL]
POP P,1
BIN ;GET FIRST WORD WHICH IS MAX ERR NUM
ERJMP NOFIL2 ;IF END OF FILE, FAIL
CAMLE C,B ;THIS ONE WITHIN RANGE?
JRST NOFIL2 ;NO, FAIL
; ..
;ERSTR...
RIN ; Read byte number of message
ERJMP NOFIL2 ; IF ERROR, FAIL
JUMPE 2,NOFIL2
PUSH P,2
MOVEI 2,7
SFBSZ
RETERR()
POP P,2
SFPTR ; Start reading here
JRST NOFIL2
POP P,C
HLRES C
MOVMS C ;ALLOW + OR - NCHARS
SKIPE C
AOS C
CPYER1: BIN
ERJMP ERSTDN ;IF EOF, THEN DONE
CAIN 2,"@"
JRST ERSTDN
CAIN 2,"_"
JRST EXPND
CALL ERST9
JRST ERSTDS
JRST CPYER1
NOFIL: POP P,B
MOVE D,[POINT 7,[ASCIZ /CANNOT FIND ERROR MESSAGE FILE/]]
NOFILL: ILDB B,D
;**;[1812] Change one line at NOFILL: +1L JGZ 5-DEC-80
JUMPE B,EMRET1 ;[1812] RETURN AT END OF STRING
CALL ERST9
;**;[1812] Change one line at NOFILL: +3L JGZ 5-DEC-80
JRST EMRET1 ;[1812] ERROR RETURN PRESERVING LSTERR
JRST NOFILL
EXPND: MOVEI D,0
BIN
ERJMP ERSTDN
CAIN B,"_"
JRST CPYER1
EXPND1: CAIG 2,"9"
CAIGE 2,"0"
JRST EXPNDD
IMULI D,^D10
ADDI D,-60(B)
BIN
ERJMP ERSTDN
JRST EXPND1
;ERSTR...
EXPNDD: CAIN B,"E"
JRST EXPEXP
CAIL D,5
JRST EXPND
CAIN B,"A"
JRST EXPASC
CAIN B,"O"
JRST EXPOCT
CAIN B,"D"
JRST EXPDEC
CAIN B,"H"
JRST EXPHLF
CAIN B,"F"
JRST EXPFLT
CAIN B,"L"
JRST EXPLOC
CAIN B,"N"
JRST EXPJFN
CAIE B,"@"
JRST EXPND
JRST ERSTDN
EXPEXP: JRST EXPND
EXPASC: MOVE B,ERRSAV(D)
CALL ERST9
JRST ERSTD0
JRST EXPND
EXPOCT: MOVE B,ERRSAV(D)
MOVEI D,10
CALL ERNOUT
JRST ERSTD0
JRST EXPND
EXPDEC: MOVE B,ERRSAV(D)
MOVEI D,12
CALL ERNOUT
JRST ERSTD0
JRST EXPND
;ERSTR...
ERNOUT: PUSH P,A
MOVE A,B
CALL ERNOU1
SOS -1(P)
POP P,A
RETSKP
ERNOU1: IDIV A,D
HRLM B,(P)
JUMPE A,.+3
CALL ERNOU1
RET
HLRZ B,(P)
ADDI B,"0"
JRST ERST9
EXPHLF: MOVE D,ERRSAV(D)
PUSH P,D
HLRZ B,D
MOVEI D,10
CALL ERNOUT
JRST ERSTD1
POP P,D
MOVEI B,","
CALL ERST9
JRST ERSTD0
CALL ERST9
JRST ERSTD0
HRRZ B,D
MOVEI D,10
CALL ERNOUT
JRST ERSTD0
JRST EXPND
EXPFLT:
EXPLOC:
EXPJFN: JRST EXPND
ERSTD1: POP P,D
JRST ERSTD0
ERSTDN: AOS -1(P)
ERSTDS: AOS -1(P)
;**;[1812] Change two lines at ERSTD0: +0L JGZ 5-DEC-80
ERSTD0: CLOSF ;[1812] CLOSE THE FILE
JFCL
JRST MRETN
;**;[1812] Change 3 lines at NOFIL1: +0L JGZ 5-DEC-80
NOFIL2: CLOSF ;[1812] CLOSE THE FILE
JFCL ;[1812] IGNORE ERRORS
JRST EMRET1 ;[1812] AND ERROR RETURN PRESERVING LSTERR
; GET ACCOUNT
;
; CALL: 1/ JOB NUMBER OR -1 FOR SELF
; 2/ POINTER TO E TO WHERE TO STORE STRING (IF ANY)
; GACCT
; RETURNS
; +1 ALWAYS, 2/ 5B2+NUMERIC ACCOUNT #, OR
; UPDATED POINTER TO ACCOUNT STRING AT E
.GACCT::MCENT ;MONITOR CODE ENTRY
UMOVE T1,1 ;GET JOB NUMBER
CAMN T1,[-1] ;SELF SPECIFIED ?
MOVE T1,JOBNO ;YES, GET JOB NUMBER
CAIL T1,0 ;NOT SELF - WAS JOB NUMBER REQUEST
CAIL T1,NJOBS ; A LEGAL JOB NUMBER ?
ITERR (GACCX1) ;NO - INVALID JOB NUMBER SPECIFIED
; CHECK PRIVILEGES IF NOT THIS JOB
CAMN T1,JOBNO ;THIS JOB ?
JRST GACC10 ;YES, DO NOT CHECK CAPABILITY
MOVE T2,CAPENB ;GET CAPABILITIES
TXNN T2,SC%CNF!SC%WHL!SC%OPR ;HAVE CONFIDENTIAL INFORMATION ACCESS ?
ITERR (GACCX3) ;NO, CONFIDENTIAL INFORMATION ACCESS REQUIRED
; SEE IF REQUESTED JOB EXISTS AND MAP JSB
GACC10: CALL MAPJSB ;GO MAP JSB FOR REQUESTED JOB
ITERR (GACCX2) ;NO SUCH JOB
MOVEM T1,P1 ;SAVE OFFSET TO JSB
; HERE FOR ALPHANUMERIC ACCOUNTS
GACC20: UMOVE T1,2 ;GET POINTER TO USER'S STRING BUFFER
MOVEI T2,ACCTSL(P1) ;POINT TO STRING
CALL CPYTUS ;COPY ACCOUNT STRING TO USER SPACE
; UNMAP JSB AND RETURN
GACC30: CALL CLRJSB ;UNMAP THE JSB
JRST MRETN ;SUCCESS RETURN
; Get last error
; Call: 1 ; Fork designator
; GETER
.GETER::MCENT
CALL FLOCK
CALL SETLFK
MOVE B,LSTERR(1)
XCTU [HRL B,1]
UMOVEM B,2
CALL CLRLFK
CALL FUNLK
JRST MRETN
; DATA STRUCTURES DEFINITIONS FOR GETOK/GIVOK/RCVOK
;THESE DEFSTRS DESCRIBE A BLOCK OF RESIDENT FREE SPACE. GETOK
;OBTAINS ONE FOR EACH REQUEST AND KEEPS IT UNTIL THE REQUEST IS
;ACCEPTED OR REJECTED. ITS LENGTH IS ENOUGH FOR A FIXED-LENGTH
;HEADER PLUS THE USER'S FUNCTION-DEPENDENT ARGUMENTS.
;*** DO NOT CHANGE THE FOLLOWING TWO DEFSTR'S BECAUSE OF
;THE LINK POINTERS
DEFSTR (GOKFP,0,35,36) ;LINK POINTER
DEFSTR (GOKST,1,35,36) ;REQUEST STATUS
; 0=REQUEST QUEUED
; -1=REQUEST IN PROGRESS
; +1=REQUEST COMPLETE, SUCCESS
; +2=REQUEST COMPLETE, FAILED
DEFSTR (GOKBAD,2,35,36) ;ADDRESS OF SWAP BLOCK CONTAINING ERROR MSG
DEFSTR (GOKPSI,3,35,18) ;PSI (MONITOR) OF THIS REQUEST
DEFSTR (GOKFKN,3,17,18) ;FORK NUMBER
DEFSTR (GIVTMO,4,35,36) ;GIVOK TIMEOUT
DEFSTR (GOKBSZ,5,17,18) ;LENGTH OF FUNCTION-DEPENDENT ARGUMENTS
DEFSTR (GOKTSZ,5,35,18) ;THIS TABLE LENGTH
GOKIDZ==:6 ;SIZE OF HIDDEN DATA
;WARNING: DO NOT REARRANGE THE DEFINITIONS FROM HERE TO THE END OF THIS
;BLOCK! THE BLOCK IS BLT'ED TO THE USER IN RCVOK
DEFSTR (GOKFUN,6,17,18) ;FUNCTION CODE
DEFSTR (GOKJBN,6,35,18) ;JOB NUMBER OF REQUESTOR
DEFSTR (GOKCDR,7,35,36) ;USER NUMBER
DEFSTR (GOKJDR,10,35,36) ;CONNECTED DIRECTORY
DEFSTR (GOKRN,11,35,36) ;REQUEST NUMBER
DEFSTR (GOKURA,12,17,18) ;NUMBER OF ARGS PASSED
DEFSTR (GOKUAN,12,35,18) ;NUMBER OF USER SUPPLIED ARGUMENTS
DEFSTR (GOKUSA,13,35,36) ;ADDRESS OF USER SUPPLIED ARGUMENTS
DEFSTR (GOKCAP,14,35,36) ;CAPABILITIES ENABLED
DEFSTR (GOKETN,14,35,36) ;ERROR NUMBER
;**;[2813]CHANGE 1 LINE AT DEFSTR (GOKTRM...)+0L TAM 14-SEP-82
DEFSTR (GOKTRM,15,35,36) ;[2813] TERMINAL NUMBER
DEFSTR (GOKRJB,16,35,36) ;REQUESTED JOB #
GOKHDL==:^D15 ;COUNT OF ABOVE WORDS
;THE REMAINDER OF THIS BLOCK IS A COPY OF THE USER'S FUNCTION-DEPENDENT
;DATA
DEFSTR (GOKERB,17,35,36) ;ERROR BLOCK POINTER
DEFSTR (GOKFN1,20,35,36) ;FIRST FUNCTION WORD
; DEFINITIONS FOR ERROR BLOCK AS PROVIDED BY THE USER
GOKESZ==0 ;ERROR SIZE
GOKENU==1 ;ERROR NUMBER
GOKEBP==2 ;BYTE POINTER
GOKEZ==3 ;STRING SIZE
GOKMSZ==^D80 ;COUNT OF MAX CHARACTERS FOR ERROR STRING
GOKSFZ==GOKMSZ/5+1 ;SIZE OF BUFFER TO ALLOCATE FOR ERROR STRING
; INCLUDES 1 WORD OF HEADER FOR FREE BLOCK
;DEFINITIONS FOR GTOKPR
GT%ENB==:77B5 ;ENABLES
GT%DEF==77B11 ;DEFAULTS
GT%PRM==777777B35 ;PARAMETERS
DEFSTR (GTENB,0,5,6) ;ENABLES (CURRENTLY USED FUNCTIONS)
DEFSTR (GTDEF,0,11,6) ;DEFAULT (SAVED PARAMETERS)
DEFSTR (GTPRM,0,35,18) ;PARAMETERS
; GETOK JSYS
;
; T1 - FUNCTION CODE
; T2 - ADDRESS OF ARGUMENT BLOCK
; T3 - SIZE OF ARGUMENT BLOCK
; T4 - JOB NUMBER FOR WHICH REQUEST IS MADE
.GETOK::MCENT ;JSYS
SKIPN T1 ;LEGAL?
ITERR (GOKER1) ;NO
TRNE T1,400000 ;USER FUNCTION?
SETZ T1,0 ;YES USE FUNCTION 0
CAIL T1,MXGOKF ;CHECK FOR MAX
ITERR (GOKER1) ;ILLEGAL FUNCTION CODE
SKIPGE Q1,GTOKPR(T1) ;CHECKING ENABLED?
JRST GETOK2 ;OK TO CHECK
TLNE Q1,(SF%DOK) ;NO. IS DEFAULT TO ALLOW IT?
MRETNG ;YES -- ACCEPT
ITERR (GOKER2) ;NO REJECT REQUEST
;HERE IF PROGRAM IS CONTROLLING ACCESS FOR THIS FUNCTION.
;GET A BLOCK OF FREE SPACE TO SAVE THE INFORMATION IN.
GETOK2: UMOVE Q1,T1 ;GET USER'S FUNCTION CODE
MOVE Q2,T2 ;GET USER'S ARGUMENT BLOCK ADDRESS
MOVE Q3,T3 ;GET SIZE OF USER'S ARGUMENT BLOCK
CAILE T3,.GOKMZ ;GET MAX SIZE
ITERR (ARGX05) ;ARGUMENT BLOCK TOO LONG
CALL ALOCRS ;ALLOCATE SOME SPACE
ITERR () ;ITRAP ERROR
UMOVE T2,T4 ;GET REQUESTED FOR JOB #
STOR T2,GOKRJB,(T4) ;SAVE IN BLOCK
MOVE T2,Q2 ;GET ADDRESS OF USER'S ARGUMENT BLOCK (SOURCE)
MOVE Q3,T4 ;SAVE BLOCK ADDRESS
SKIPE T3 ;DON'T BLT IF NO ARGS
CALL BLTUM1 ;COPY DATA FROM USER TO MONITOR BLOCK
SETZM T2 ;NO ROUTINE TO CALL IF BLOCKING
CALL GETOK0 ;DO THE GETOK
ITERR () ;ITRAP ON ERROR
MRETNG ;RETURN OK
;ALOCRS - ALLOCATE RESIDENT FREE SPACE FOR A GETOK REQUEST
;ACCEPTS:
; T3/ LENGTH OF USER'S FUNCTION-DEPENDENT ARGUMENT BLOCK
; Q3/ LENGTH OF USER'S FUNCTION-DEPENDENT ARGUMENT BLOCK
; CALL ALOCRS
;RETURNS +1: FAILURE
; T1/ ERROR CODE
; +2: SUCCESS, NOINT
; T4/ ADDRESS OF BLOCK ACQUIRED
; T3/ POINTS TO PLACE FOR USER ARGS
; Q3/ PRESERVED
;THIS ROUTINE GETS A BLOCK OF FREE SPACE AND INITIALIZES IT
ALOCRS: SKIPGE T3 ;CHECK FOR LEGAL SIZE
RETBAD (ARGX04) ;ILLEGAL SIZE
ADDI T3,GOKHDL ;ADD HEADER LENGTH
NOINT ;DISABLE USER FROM INTERRUPTING US
HRLI T1,.RESP3 ;SET PRIORITY TO LOWEST
HRR T1,T3 ;SET LENGTH
MOVEI T2,.RESGP ;SET GENERAL GROUP
CALL ASGRES ;ASSIGN RESIDENT SPACE
RETBAD (MONX01,<OKINT>) ;NO SPACE
STOR Q1,GOKFUN,(T1) ;STORE FUNCTION CODE
MOVE T2,TODCLK ;GET THE CURRENT TIME
ADD T2,[GIVTIM] ;GIVOK TIMER
STOR T2,GIVTMO,(T1) ;SET GIVOK TIMER
MOVE T2,Q3 ;GET LENGTH
STOR T2,GOKUAN,(T1) ;STORE LENGTH
ADDI T2,GOKHDL ;SAVE TABLE LENGTH
STOR T2,GOKTSZ,(T1)
AOS T2,GOKNRQ ;UPDATE REQUEST NUMBER
STOR T2,GOKRN,(T1)
MOVE T2,JOBNO ;SAVE JOB NUMBER OF REQUESTOR
STOR T2,GOKJBN,(T1)
MOVE T2,JOBDIR(T2) ;GET LOGGED IN DIRECTORY
HRLI T2,USRLH ;MAKE USER NUMBER
STOR T2,GOKCDR,(T1)
HRRZ T2,FORKX ;GET FORK NUMBER OF REQUESTOR
STOR T2,GOKFKN,(T1)
MOVE T2,JSBSDN ;GET CONNECTED DIRECTORY
STOR T2,GOKJDR,(T1)
HLLZ T2,PSIBIP ;GET PRI LEVEL
JFFO T2,.+1 ;RECORD CURRENT LEVEL
STOR T3,GOKPSI,(T1)
MOVE T2,CAPENB ;CAPABILITIES ENABLED
STOR T2,GOKCAP,(T1)
MOVE T2,CTRLTT ;CONTROLLING TTY
STOR T2,GOKTRM,(T1)
SETONE GOKRJB,(T1) ;SAY THAT REQUEST IS FOR THIS JOB
STOR Q3,GOKBSZ,(T1) ;STORE LENGTH
MOVE T4,T1 ;SAVE BLOCK POINTER
ADDI T1,GOKHDL ;ADDI HEADER SO IT POINTS TO USER DATA BLOCK
MOVE T3,T1 ;SET UP TO ADDRESS
STOR T3,GOKUSA,(T4) ;STORE ADDRESS IN DATA BLOCK
MOVE T1,Q3 ;GET LENGTH BACK FOR RETURN
RETSKP ;RETURN
;GETOKM - MONITOR ENTRY POINT FOR GETOK JSYS
; THIS ENTRY POINT IS SUPPOSED TO BE USED INPLACE OF A JSYS ENTRY
; WHEN GETOK IS REQUIRED BY THE MONITOR
; CALLED WITH SAME PARAMETERS AS .GETOK BUT
; IT DOES NOT ITRAP
; T1/ FUNCTION CODE
; T2/ ARGUMENT BLOCK POINTER
; T3/ ARGUMENT BLOCK SIZE
; T4/ ROUTINE TO CALL WHEN BLOCKING (OR 0 IF NONE)
; RETURNS +1 ON FAILURE WITH T1= ERROR CODE
; RETURNS +2 ON SUCCESS
;PRESERVES ALL PERM REGS SO THAT CALLER CAN SET UP BLOCKING COROUTINE
;FROM THE FILE SYSTEM
;NOTE: THE ARGUMENT BLOCK POINTER MUST BE 0 HERE, BECAUSE THE CODE
;(IN GETOK3) THAT COPIES THE ERROR BLOCK BACK TO THE USER USES UMOVEM'S.
;FOR THE MONITOR THIS WILL STORE IN THE WRONG PLACE
GETOKM::SAVEQ ;SAVE REGISTERS
SKIPE Q1,JOBNO ;GET JOB NUMBER
CAMN Q1,ACJJN ;CHECK FOR ACJ JOB ALSO
RETSKP ;RETURN GOOD IF JOB 0 OR ACJ
CAIL T1,MXGOKF ;CHECK FOR MAX FUNCTION
JRST [ BUG(ILGOKM,<<T1,GOKFCN>>)
RETBAD (GOKER1)]
SKIPGE Q1,GTOKPR(T1) ;CHECKING ENABLED?
JRST GOKMA ;YES PROCEED
GETOKZ: TLNE Q1,(SF%DOK) ;NO. IS DEFAULT TO ALLOW IT?
RETSKP ;YES RETURN GOOD
RETBAD (GOKER2) ;NO REJECT REQUEST
;HERE WHEN ACCESS CONTROL JOB IS CHECKING THIS FUNCTION
GOKMA: STKVAR <BLKADR> ;SAVE ROUTINE TO CALL IF BLOCKING
MOVEM T4,BLKADR ;SAVE BLOCK ADDRESS
DMOVE Q1,T1 ;SAVE ARGUMENTS
MOVE Q3,T3
CALL ALOCRS ;ALLOCATE AND CREATE BLOCK
JRST [ CAIE T1,MONX01 ;CHECK FOR NO RESOURCES
RETBAD ()
MOVE T1,GTOKPR(Q1) ;GET DEFAULTS
LOAD Q1,GT%DEF,T1 ;GET DEFAULT ARGUMENTS
STOR Q1,GT%ENB,Q1 ;JUSTIFY THEM TO "ENABLED" FIELD
JRST GETOKZ]
MOVE Q3,T4 ;SAVE BLOCK POINTER
MOVE T2,Q2 ;GET FROM ADDRESS
CALL XBLTA ;TRANSFER DEPENDENT DATA
MOVE T2,BLKADR ;GET BLOCK ADDRESS
CALL GETOK0 ;ENTER IN Q AND DO FUNCTION
RETBAD () ;ERROR RETURN ERROR IN T1
RETSKP ;RETURN TO CALLER ALL OK
;GETOK0 - COMMON ROUTINE TO DO GETOK WORK FOR BOTH JSYS AND
;INTERNAL CALL
;ACCEPTS:
; T2/ ROUTINE TO CALL IF NEED TO BLOCK (0 IF NONE)
; Q3/ ADDRESS OF RESIDENT BLOCK DESCRIBING THIS FUNCTION
; CALL GETOK0
;RETURNS +1: REQUEST REJECTED
; T1/ ERROR CODE
; +2: REQUEST ACCEPTED
;CALLER MUST BE NOINT (ALOCRS RETURNS NOINT)
;IF T2 IS NON-ZERO, THIS ROUTINE CALLS 0(T2) WHEN IT NEEDS TO
;WAIT FOR THE ACCESS CONTROL JOB. IT SETS UP A SCHEDULER TEST
;WORD IN T1 BEFORE CALLING THE COROUTINE. IF T2 IS ZERO, THIS
;ROUTINE DISMISSES UNTIL A RESPONSE COMES IN.
;IF THE COROUTINE FAILS, THIS CODE ASSUMES THE SCHEDULER WAIT
;HAS BEEN SATISFIED.
GETOK0: STKVAR <BLKADR> ;SAVE BLOCK ADDRESS HERE
MOVEM T2,BLKADR ;SAVE IT
CSKED ;CRITICAL CODE
LOCK GOKLCK ;STOP EVERYTHING
;If this is to be the first GETOK in the queue, start the RCVOK timer
SKIPN T2,GOKQED ;IS THIS THE FIRST GETOK?
JRST [MOVE T2,TODCLK ;YES, GET CURRENT TIME
ADDI T2,RCVTIM ;ADD THE RCVOK TIMER VALUE
MOVEM T2,RCVTMO ;SET THE TIMEOUT TIME
JRST .+1]
;ADD THIS ENTRY TO THE END OF THE QUEUE
MOVEI T2,GETOKF ;ENTER IN Q
GETOK1: MOVE T3,T2 ;SAVE ADDRESS
SKIPE T2,0(T2) ;LOOK FOR A 0 ENTRY
JRST GETOK1 ;NOPE KEEP TRYING
MOVEM Q3,0(T3) ;FOUND ONE ENTER ON END OF LIST
SETZM 0(Q3) ;MAKE FORWARD POINTER 0
AOS GOKQED ;INDICATE SOMETHING QUEUE'D
UNLOCK GOKLCK ;FREE LOCK
ECSKED ;NO LONGER CRITICAL
OKINT ;CALLER WAS NOINT. ALLOW INTERRUPTS WHILE WAITING
;WAIT FOR A RESPONSE, EITHER HERE OR IN THE COROUTINE
MOVEI T1,1(Q3) ;POINT TO SCHEDULER WORD
HRLI T1,DISOK ;YES. SET UP OUR OWN TEST
MOVSS T1 ;MAKE HALF WORDS PROPER
SKIPE T2,BLKADR ;HAVE SPECIAL BLOCK ADDRESS?
JRST [ CALL 0(T2) ;GO DO THE DISMISS
JRST [ MOVEM T1,LSTERR ;SAVE ERROR
CALL GETOK3 ;PROCESS BLOCK
NOP ;WHO CARES?
MOVE T1,LSTERR ;RETRIEVE ERROR CODE
RETBAD ()] ;ERROR
CALLRET GETOK3] ;AND PROCEED
MDISMS ;WAIT FOR REQUEST TO COMPLETE
; CALLRET GETOK3 ;DUMMY SUBROUTINE CALL
;GETOK3 - PROCESS A RESPONSE FROM THE ACCESS CONTROL JOB
;THIS IS A SUBROUTINE SINCE IT IS NEEDED TO COMPLETE THE REQUEST
;EVEN IF THE SCHEDULER TEST "FAILS". IN THIS UNLIKELY EVENT,
;THE STATE OF THE GETOK REQUEST IS IMMATERIAL.
;ACCEPTS:
; Q3/ ADDRESS OF DATA BLOCK
; CALL GETOK3
;RETURNS: +1 REQUEST DENIED OR PROCESSING ERROR.
; +2 SUCCESS. ALLOW REQUEST
GETOK3: LOAD T2,GOKBAD,(Q3) ;GET ADDRESS OF ERROR MESSAGE
JUMPE T2,GOKNBS ;NO BUFFER SUPPLIED
LOAD T3,GOKERB,(Q3) ;GET ERROR BLOCK ADDRESS
JUMPE T3,GOKNOB ;NONE
;GIVOK PROVIDED AN ERROR STRING. COPY IT TO THE USER
UMOVE T1,GOKESZ(T3) ;GET BLOCK SIZE
ERJMP GOKNOB ;FAULT IF ERROR
SUBI T1,2 ;CHECK FOR MIN SIZE
JUMPL T1,GOKNOB ;NO BUFFER
LOAD T4,GOKETN,(Q3) ;GET ERROR NUMBER
UMOVEM T4,GOKENU(T3) ;STORE ERROR NUMBER
ERJMP GOKNOB ;QUIT IF WE FAULT
SUBI T1,2 ;CHECK FOR NEXT SET OF ARGS
JUMPL T1,GOKNOB ;NO MORE
UMOVE T1,GOKEZ(T3) ;GET STRING SIZE
ERJMP GOKNOB ;QUIT
JUMPL T1,GOKNOB ;FORGET IT TOO SMALL
CAIL T1,GOKMSZ ;CHECK STRING SIZE
MOVEI T1,GOKMSZ ;SET SIZE
UMOVE T3,GOKEBP(T3) ;GET BYTE POINTER
ERJMP GOKNOB ;QUIT IF ERROR
TLC T3,-1 ;SEE IF LH -1
TLCN T3,-1
HRLI T3,(POINT 7,0) ;SET -1 TO LEGAL POINTER
HRLI T2,(POINT 7,0,35)
GOKMVL: SOJL T1,GOKNOM ;CHECK FOR END OF BUFFER
ILDB T4,T2 ;GET CHARACTER
XCTBU [IDPB T4,T3] ;STORE CHARACTER
ERJMP GOKNOB ;QUIT IF FAULT
SKIPE T4 ;QUIT ON ZERO
JRST GOKMVL ;AND DO NEXT ONE
GOKNOM: LOAD T2,GOKERB,(Q3) ;GET ERROR BLOCK ADDRESS AGAIN
UMOVEM T3,GOKEBP(T2) ;STORE UPDATED STRING
AOS T1 ;UPDATE COUNT TO CORRECT NUMBER
UMOVEM T1,GOKEZ(T2) ;AND BYTE COUNT
;HERE WHEN ERROR STRING HAS BEEN COPIED. RELEASE THE SWAPPABLE FREE
;SPACE THAT HELD THE ERROR STRING
GOKNOB: NOINT ;NOINT UNTIL FREE SPACE IS RETURNED
LOAD T1,GOKBAD,(Q3) ;RELEASE THE MESSAGE BUFFER
MOVEI T2,GOKSFZ ;GOKSFZ WORDS
CALL RELSWP ;RELEASE SPACE
SETZRO GOKBAD,(Q3) ;SAY BUFFER RELEASED
OKINT ;ENABLE INTERRUPTS
;REMOVE THIS ENTRY FROM THE QUEUE AND RETURN THE RESIDENT
;FREE SPACE. RETURN SUCCESS OR FAILURE TO THE USER.
GOKNBS: CALL GOKFR ;FREE ENTRY
CAIE Q1,2 ;WAS THE REQUEST DONE A REFUSAL?
RETSKP ;NO ALL OK
RETBAD (GOKER2) ;YES ITRAP
; DISGOK -ROUTINE TO DISMIS FOR GETOK COMPLETE
; ALSO DOES TIMEOOUT CHECK
RESCD
DISOK::SKIPLE 0(T1) ;DONE?
JRST 1(T4) ;YES CONTINUE
MOVE T2,3(T1) ;GET TIMEOUT TIME
CAML T2,TODCLK ;TIME UP YET?
JRST 0(T4) ;NO CONTINUE WAITING
SKIPN 0(T1) ;FIX QUEUE'D COUNT
SOS GOKQED ;UPDATE COUNTER
SOS T1 ;BACK T1 UP SO IT IS IN A NICE PLACE
LOAD T2,GOKFUN,(T1) ;GET FUNCTION CODE
BUG(GIVTMR,<<T2,FUNC>>)
TRZ T2,400000 ;NO USER FUNCTION CODE NEEDED
ADDI T2,GTOKPR ;POINT TO FUNCTION
LOAD T2,GTDEF,(T2) ;GET THE DEFAULT ACTION
MOVEI T3,1 ;ASSUME SUCCESS
;**;[2816] CHANGE 1 LINE AT DISOK:+14L TAM 27-SEP-82
TRNN T2,20 ;[2816] CHECK FOR OK
AOS T3 ;SET FAILURE
STOR T3,GOKST,(T1) ;SET SUCCESS/FAILURE
JRST 1(T4) ;WAKEUP
SWAPCD
;GOKFR - REMOVE A GETOK ENTRY FROM THE QUEUE AND RETURN ITS
;FREE SPACE TO THE POOL
;ACCEPTS:
; Q3/ ADDRESS OF RESIDENT BLOCK
; CALL GOKFR
;RETURNS +1: ALWAYS
; Q1/ STATUS OF THIS REQUEST
GOKFR: MOVE T1,Q3 ;GET BLOCK ADDRESS
NOINT ;DISABLE INTERRUPTS
CSKED ;DON'T STOP SCHEDULER
LOCK GOKLCK ;LOCK GETOK LIST
MOVEI T2,GETOKF ;GET FORWARD POINTER
GOKREL: MOVE T3,0(T2) ;GET A FORWARD POINTER
CAMN T3,T1 ;IS THIS THE ONE?
JRST GOKFND ;YUP
MOVE T2,T3 ;GET ANOTHER ENTRY
JRST GOKREL ;AND TRY AGAIN
;HERE WHEN BLOCK HAS BEEN FOUND. REMOVE IT FROM THE CHAIN
;AND RETURN IT TO THE FREE POOL.
GOKFND: MOVE T4,0(T3) ;REMOVE IT
MOVEM T4,0(T2)
LOAD Q1,GOKST,(T1) ;GET SUCCESS/FAILURE STATUS
UNLOCK GOKLCK
ECSKED ;END CSKED
CALL RELRES ;RELEASE FREE STORAGE
OKINT ;GAVE IT BACK NOW ENABLE INTERRUPTS
RET ;AND GO TO CALLER
;
; RCVOK JSYS
; T1 - POINTER TO BUFFER FOR ARGUMENTS
; T2 - SIZE OF BUFFER
.RCVOK::MCENT ;DO MONITOR STUFF
RCVA1: MOVE T4,CAPENB ;CHECK FOR ENABLED CAPABILITIES
TXNN T4,SC%OPR!SC%WHL ;CHECK FOR WHEEL AND OPR
ITERR (CAPX1) ;NOPE CAN'T DO THIS FUNCTION
MOVE T4,FORKX ;CHECK FOR CORRECT FORK
CAME T4,ACJFN
ITERR (GOKER3) ;ILLEGAL FOR OTHER FORKS
;WAIT HERE IF THERE ARE NO PENDING REQUESTS
CSKED ;BE UNINTERRUPTABLE
LOCK GOKLCK ;LOCK UP THE GETOK STRUCTURE
MOVEI T1,GOKQED ;GO LOOK FOR AN ENTRY TO DO
SKIPN 0(T1) ;CHECK IF ONE ALREADY THERE
;**;[2831] ADD 1 LINE AT RCVA1:+13L TAM 6-OCT-82
JRST [ SETZM RCVTMO ;[2831] INSURE THAT TIMER OFF
UNLOCK GOKLCK ;FREE LOCK
ECSKED ;BE INTERRUPTABLE
CALL DISN ;WAIT HERE FOR A WHILE
JRST RCVA1] ;AND TRY AGAIN
;AN ENTRY EXISTS. FIND IT AND TURN OFF OR RESTART RCVOK TIMER
SOSN GOKQED ;UPDATE GETOK COUNT, ARE THERE ANY LEFT?
JRST [SETZM RCVTMO ;NO, TURN OFF RCVOK TIMER
JRST RCVA2]
MOVE T2,TODCLK ;YES, GET CURRENT TIME
ADDI T2,RCVTIM ;ADD RCVOK TIMER VALUE
MOVEM T2,RCVTMO ;SET THE TIMEOUT TIME
RCVA2: SKIPA T2,GETOKF ;GET FIRST ENTRY IN Q
RCVGLP: MOVE T2,0(T2) ;GET NEXT ENTRY
JUMPE T2,[SKIPE GOKQED ;SEE IF SOMETHING STRANGE HAPPENED
BUG(RCVNOE) ;QUEUE EMPTY BUT COUNT NOT = 0
SETZM GOKQED ;INSURE COUNT IS 0
UNLOCK GOKLCK ;UNLOCK
ECSKED ;OK TO SCHEDULE
JRST RCVA1] ;AND CONTINUE WAITING
SKIPE 1(T2) ;LOOK FOR AN ENTRY THAT HASN'T BEEN USED YET
JRST RCVGLP ;TRY NEXT ONE
;FOUND AN ENTRY THAT HADN'T BEEN PROCESSED. MARK IT AS BEING
;PROCESSED AND COPY THE ARGUMENT BLOCK AND FUNCTION-DEPENDENT
;DATA TO THE USER. FUNCTION-DEPENDENT DATA ALWAYS GOES IMMEDIATELY
;AFTER THE COMMON DATA
SOS 1(T2) ;MAKE IT LOOK BUSY
LOAD T3,GOKTSZ,(T2) ;GET SIZE OF TABLE
SUBI T3,GOKIDZ ;SUBTRACT INTERNAL DATA SIZE
MOVE T4,T3 ;SAVE SIZE
UMOVE T1,T2 ;GET BUFFER SIZE
;**;[2858]ADD 2 LINES AT RCVGLP:+20L TAM 11-NOV-82
SKIPG T1 ;[2858]NON NEGATIVE?
ITERR (ARGX17) ;[2858]NO
CAILE T1,0(T4) ;USE SMALLER SIZE
MOVE T1,T4
SUBI T4,GOKHDL-GOKIDZ ;GET CORRECT SIZE OF NEW ARGS
SKIPG T4 ;SET Z IF NONE
SETZ T4,0
STOR T4,GOKURA,(T2) ;STORE ARGUMENTS PASSED
UMOVE T3,T1 ;GET TO ADDRESS
ADDI T3,GOKHDL-GOKIDZ ;POINT TO USER SUPPLIED WORDS
STOR T3,GOKUSA,(T2)
ADDI T2,GOKIDZ ;POINT PAST INTERNAL DATA (FOR SOURCE)
UMOVE T3,T1 ;GET DESTINATION ADDRESS
CALL BLTMU1 ;SEND TO USER, APPLY PCS IF NECESSARY
UNLOCK GOKLCK ;RELEASE LOCK
ECSKED ;OK TO SCHED
MRETNG ;END IT ALL
;RCVOK TIMEOUT CHECK - CALLED EVERY 20 MS FROM SCHEDULER
RESCD
RCVCH7::SKIPE T1,RCVTMO ;HAS THE TIMER BEEN STARTED?
CAMLE T1,TODCLK ;YES, HAS IT GONE OFF?
RET ;NO
CALL ACJKIL ;DON'T ASK THE ACJ ANYMORE
SETZM RCVTMO ;TURN OFF RCVOK TIMER
BUG (RCVTMR) ;SAY RCVOK TIMEOUT OCCURRED
RET
;
; GIVOK JSYS
; T1 - REQUEST NUMBER
; T2 - 0 REQUEST OK
; T2 - 0,,400000+ERROR NUMBER REQUEST FAILED
; T3 - ASCIZ STRING POINTER (OR 0 IF NONE)
SWAPCD
.GIVOK::MCENT ;DO MONITOR STUFF
MOVE T4,CAPENB ;CHECK FOR ENABLED CAPABILITIES
TXNN T4,SC%OPR!SC%WHL ;WHEEL AND OPERATOR ONLY
ITERR (CAPX1) ;NO ILLEGAL FUNCTION
MOVE T4,FORKX ;CHECK FOR CORRECT FORK
CAME T4,ACJFN
ITERR (GOKER3) ;ILLEGAL FOR OTHER FORKS
MOVEI Q1,GETOKF ;GET FRONT OF LIST
NOINT
CSKED ;DON'T STOP
LOCK GOKLCK ;LOCK THE Q
;STEP THROUGH THE QUEUE LOOKING FOR THIS ENTRY
GOKGLP: SKIPN Q1,0(Q1) ;GET NEXT ENTRY
JRST GIVOK1 ;QUIT NOT FOUND (NOT AN ERROR BECAUSE USER CAN QUIT EARLY)
OPSTR <CAME T1,>,GOKRN,(Q1)
JRST GOKGLP ;NOT FOUND TRY ANOTHER
;FOUND THE ENTRY. RECORD THE USER'S RESPONSE TO THIS REQUEST.
MOVEI P6,1 ;SET REQUEST DONE OK
TRNE T2,400000 ;CHECK FOR SUCCESS
AOS P6 ;NO SET FAILURE
STOR T2,GOKETN,(Q1) ;SAVE THE ERROR NUMBER
SETZRO GOKBAD,(Q1) ;ZERO POINTER TO STRING (ASSUME NONE SUPPLIED)
SKIPN T3 ;ONE SUPPLIED?
JRST GIVOK2 ;NO ALL DONE
;USER PROVIDED AN ERROR STRING. COPY IT INTO SWAPPABLE FREE SPACE.
MOVEI T1,GOKSFZ ;YES REQUEST SOME SPACE
CALL ASGSWP ;ASSIGN SWAP SACE
JRST GIVOK2 ;CAN'T GET SPACE FINISH UP
MOVEI T2,GOKMSZ ;MAX 40 CHARACTERS
STOR T1,GOKBAD,(Q1) ;SAVE BUFFER ADDRESS
HRLI T1,(POINT 7,0,35) ;SET UP DESTINATION BYTE POINTER
UMOVE T3,T3 ;GET SOURCE BYTE POINTER
MOVEI T4,440700 ;CONVERT -1,,N TO BYTE POINTER
TLC T3,-1 ; IF NECESSARY
TLCN T3,-1
XCTU [HRLM T4,T3] ;SET BYTEPOINTER TO USER CORRECTLY
GOKBLP: XCTBUU [ILDB Q2,T3] ;GET A CHARACTER
IDPB Q2,T1 ;STORE IN BUFFER
SKIPE Q2 ;QUIT IF NULL
SOJG T2,GOKBLP ;CONTINUE UNTIL COUNT EXCEEDED
GIVOK2: STOR P6,GOKST,(Q1) ;STORE REQUEST DONE
GIVOK1: UNLOCK GOKLCK ;RESTART SKED
ECSKED ;START SCHEDULING AGAIN
OKINT
MRETNG ;RETURN
; GOKFRE -- ROUTINE TO REMOVE GETOK ENTRIES WHEN FORK GOES AWAY OR IS INTERRUPTED
;ACCEPTS:
; T1/ SYSTEM-WIDE FORK HANDLE
; T2/ PRIORITY LEVEL (OR 0 FOR ALL)
; CALL GOKFRE
;RETURNS +1: ALWAYS
;THIS CODE FLUSHES ALL OUTSTANDING GETOK REQUESTS FOR THE
;SPECIFIED FORK. IF PRIORITY LEVEL IS NON-ZERO, IT FLUSHES ONLY
;THOSE REQUESTS THAT WERE MADE AT THE SPECIFIED LEVEL
RESCD ;RESIDENT
GOKFRE::SKIPN GETOKF ;CHECK FOR ANY ENTRIES AT ALL
RET ;NOPE QUIT QUICK
SAVET ;SAVE TEMP'S
STKVAR <GOKBIP,GOKHND,GOKCAD>
MOVEM T2,GOKBIP ;SAVE PRIORITY
MOVEM T1,GOKHND ;SAVE FORK HANDLE
MOVEI T4,GETOKF ;FIND FORWARD POINTER
NOINT ;DISABLE INTERRUPTS
CSKED ;DON'T STOP THIS JOB
LOCK GOKLCK ;LOCK LOCK
;LOOK FOR AN ENTRY FOR THIS FORK
SKIPA
GOKFL1: MOVE T4,GOKCAD ;GET FORWARD POINTER
SKIPN T3,0(T4) ;GET AN ENTRY
JRST GOKFUL ;DONE
MOVEM T3,GOKCAD ;SAVE NEW FORWARD POINTER
LOAD T1,GOKFKN,(T3) ;GET FORK NUMBER
CAME T1,GOKHND ;IS IT THE CORRECT ONE?
JRST GOKFL1 ;NO TRY NEXT ENTRY
;FOUND ONE. SEE IF THE PRIORITIES MATCH UNLESS DOING ALL PRIORITIES
MOVE T1,GOKBIP ;GET THE PRIORITY REQUESTED
JFFO T1,GOKONE ;OTHER THAN 0?
JRST GOKALL ;NO DO ALL
GOKONE: LOAD T1,GOKPSI,(T3) ;GET THE PRIORITY OF THIS ONE
CAMLE T1,T2 ;IS IT ONE TO GET?
JRST GOKFL1 ;NO TRY NEXT ONE
;REMOVE THIS ENTRY FROM THE CHAIN. RELEASE FREE SPACE ASSOCIATED WITH IT.
GOKALL: MOVEM T4,GOKCAD ;SET OLD FORWARD POINTER AS NEW ONE
SKIPN 1(T3) ;IN USE YET?
SOS GOKQED ;NO UPDATE COUNT OF QUEUE'D
LOAD T1,GOKBAD,(T3) ;GET THE ERROR BLOCK ADDRESS
MOVEI T2,GOKSFZ ;SIZE OF BLOCK
PUSH P,T3 ;SAVE T3
SKIPE T1 ;CHECK FOR AN ERROR BLOCK ADDRESS
CALL RELSWP ;RELEASE FREE SPACE
POP P,T3 ;RESTORE
MOVE T4,GOKCAD ;GET THE BLOCK ADDRESS BACK
MOVE T1,0(T3) ;UPDATE POINTERS
MOVEM T1,0(T4)
MOVE T1,T3 ;RELEASE BLOCK
CALL RELRES
JRST GOKFL1
GOKFUL: UNLOCK GOKLCK ;UNLOCK
ECSKED ;NOW WE CAN STOP
OKINT
RET ;QUIT
;**;[3166] Change 1 line at GOKFUL:+4L GPL 16-Sep-1984
RESCD ;[3166] Must be resident
;ACJKIL -ROUTINE TO KILL THE ACJ FORK AND CLEANUP
ACJKIL::SAVET ;SAVE TEMPS
SETZ T1,
NOINT ;DISABLE INTERRUPTS
CSKED ;CRIT SKED
LOCK GOKLCK ;LOCK UP THE QUEUE
ACJKLP: MOVE T3,T1 ;GET FUNCTION
ADDI T3,GTOKPR
LOAD T2,GTDEF,(T3) ;GET DEFAULT
CAIE T2,77 ;ALREADY SETUP?
STOR T2,GTENB,(T3) ;SET AS NEW ENABLE
SETONE GTDEF,(T3) ;SET NO DEFAULT
AOS T1 ;DO NEXT FUNCTION
CAIGE T1,MXGOKF ;CHECK FOR MAX FUNCTION
JRST ACJKLP ;TRY NEXT ONE
MOVEI T1,GETOKF ;EMPTY THE QUEUE
ACJKL: SKIPN T1,0(T1) ;GET AN ENTRY
JRST ACJDON ;DONE
LOAD T3,GOKFKN,(T1) ;GET FUNCTION
TRZ T3,400000 ;REMOVE USER FUNCTION BITS
SKIPN 1(T1) ;LOOK AT THE PICKED COUNT
SOS GOKQED ;GET THE QUEUE'D COUNT UPDATES
;**;[2816] CHANGE 2 LINES AT ACJKL:+6L TAM 27-SEP-82
MOVEI T2,1 ;[2816] ASSUME ALL OK
MOVEM T2,1(T1) ;[2816] SET IN DONE FLAG
MOVSI T2,(SF%DOK) ;CHECK FOR 0K
TDNN T2,GTOKPR(T3)
AOS 1(T1) ;SET FAILURE
JRST ACJKL ;AND TRY NEXT ONE
ACJDON: SETZM ACJFN ;SET NO ACJ FORK
SETZM ACJJN ;SET NO JOB NUMBER
UNLOCK GOKLCK ;UNLOCK
ECSKED ;ALLOW SCHEDULING
OKINT ;ALLOW INTERRUPTS
RET ;RETURN
;**;[3166] Add 1 line at ACJDON:+6L GPL 16-Sep-1984
SWAPCD ;Back to swappable code
; Get tab settings
.GTABS::MCENT
CALL CHKTTR
JRST [ XCTU [SETZB A,2]
UMOVEM A,3
UMOVEM A,4
JRST MRETN]
CALL TTGTBS
UMOVEM 1,2
UMOVEM 3,3
UMOVEM 4,4
JRST MRETN
; Read time and date
; Call: RTAD
; Return
; +1
; 1 ; Current date and time or -1 if not set
.GTAD:: MCENT
CALL LGTAD ;DO THE WORK
UMOVEM A,1
JRST MRETN
; Get directory info
; Call: 1 ; Directory number
; 2 ; Pointer to parameter block
; 3 ; String pointer for password
; GTDIR
.GTDIR::MCENT
UMOVE Q3,2 ;GET POINTER TO PARAMETER BLOCK
XCTU [SKIPG Q2,.CDLEN(Q3)] ;GET LENGTH OF ARGUMENT BLOCK
MOVEI Q2,.CDDGP+1 ;IF NONE SET UP, USE THIS ONE
;MAKE GTDIR RETURN DIR GROUP INFO IF FIRST WORD OF ARG BLOCK = 0
SETZ P1, ;INITIALIZE PRIVILEGE FLAG
UMOVE A,1 ;GET DIRECTORY NUMBER
JUMPE A,GTDIR2 ;IF 0, THEN GO GET DEFAULTS
STKVAR <GTDINO>
MOVEM A,GTDINO ;SAVE DIRECTORY NUMBER
HLRZS A ;GET STRUCTURE UNIQUE CODE IN RIGHT HALF
CALL CHKMNO ;SEE IF OK TO ACCESS THIS STRUCTURE
ITERR () ;NO, MUST INCREMENT MOUNT COUNT FIRST
MOVE A,GTDINO ;GET BACK DIRECTORY NUMBER
MOVX B,DC%CN ;SEE IF USER HAS CONNECT PRIVILEGES
CALL SUPCHK ;SEE IF HAVE ACCESS TO SUPERIOR
JRST GTDIR6 ;FAILED.
MOVE A,GTDINO ;SUCCEEDED. GET DIRECTORY NUMBER
CALL SETDIR ;MAP THE DIRECTORY
ITERR () ;FAILED. RETURN ERROR
JRST GTDIR3 ;GO GET THE INFO
GTDIR6: MOVE A,GTDINO ;A/ DIRECTORY NUMBER
CALL SETDIR ;MAP IN THE DIRECTORY
ITERR() ;FAILED
MOVE B,CAPENB
TRNE B,SC%WHL!SC%OPR
JRST GTDIR3 ; WHEEL OR OPERATOR
MOVX B,DC%CN ;SEE IF USER HAS OWNER ACCESS TO DIR
CALL DIRCHK ;...
JRST [ UMOVE B,3 ;SEE IF USER HAS GIVEN THE PASSWORD
CALL CHKPSX
ITERR(GTDIX1,<ULKDIR
MOVE T2,T1
MOVEI T1,^D3000 ;WAIT 3 SECS
SKIPN T2 ;UNLESS NO PASSWORD GIVEN
DISMS>) ;ILLEGAL PASSWORD GIVEN
JRST .+1] ;USER GAVE THE CORRECT PASSWORD
SETO P1, ;MARK ONLY LIMITED ACCESS
GTDIR3: MOVE A,DIRORA ; GET BASE OF MAPPED DIR AREA
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
JUMPN P1,GTDIR4 ;IF NOT PRIVILEGED, DONT GIVE PASSWORD
UMOVE C,3
TLC C,-1 ;SEE IF LH = -1
TLCN C,-1
HRLI C,(<POINT 7,0>) ;YES, SET UP BYTE POINTER
GTDIR1: LOAD B,DRPSW,(A) ;GET POINTER TO NAME STRING
ADD B,DIRORA ;MAKE IT ABSOLUTE
MOVSI Q1,(POINT 7,0(B),35) ;SET UP STRING POINTER TO NAME STR
UMOVEM C,.CDPSW(Q3) ;SAVE STARTING BYTE POINTER TO PSW
GTDIR0: UMOVEM C,3 ;SAVE UPDATED BYTE POINTER FOR USER
ILDB D,Q1 ;GET NEXT CHARACTER OF PASSWORD
XCTBU [IDPB D,C] ;STORE CHAR IN USER SPACE
JUMPN D,GTDIR0 ;LOOP BACK TIL NULL IS SEEN
GTDIR4: SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRLIQ,(A) ;GET LOGGED IN QUOTA
UMOVEM D,.CDLIQ(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRPRV,(A) ;GET PRIVILEGE BITS
UMOVEM D,.CDPRV(Q3) ;GIVE PRIVILEGE BITS TO USER
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRMOD,(A) ;MODE BITS
TXO D,MD%SA ;ALWAYS SET STRING ACCOUNTS ALLOWED BIT
UMOVEM D,.CDMOD(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRLOQ,(A) ;MAX DISK ALLOCATION ALLOWED
UMOVEM D,.CDLOQ(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRNUM,(A) ;DIRECTORY NUMBER
UMOVEM D,.CDNUM(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRDPW,(A) ;DEFAULT FILE PROTECTION WORD
UMOVEM D,.CDFPT(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRPRT,(A) ;DIRECTORY PROTECTION
UMOVEM D,.CDDPT(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRDBK,(A) ;BACKUP SPEC, (# OF GEN'S TO KEEP)
TLZ D,(7B2) ;DONT RETURN THE 5B2 BITS
UMOVEM D,.CDRET(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD D,DRDAT,(A) ;TIME AND DATE OF LAST LOGIN
UMOVEM D,.CDLLD(Q3)
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD A,DRUGP,(A) ;USER GROUPS
UMOVE B,.CDUGP(Q3) ;GET POINTER TO BLOCK TO RECEIVE LIST
CALL GTDGRP ;GET BITS FROM LIST
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
MOVE A,DIRORA
LOAD A,DRDGP,(A) ;DIRECTORY GROUPS
UMOVE B,.CDDGP(Q3) ;GET POINTER TO USER BLOCK
CALL GTDGRP ;GET 36 BIT WORD
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
MOVE A,DIRORA ;GET DIR BASE ADDR
LOAD B,DRSDM,(A) ;GET SUBDIR QUOTA
UMOVEM B,.CDSDQ(Q3) ;RETURN TO USER
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
LOAD A,DRCUG,(A) ;GET POINTER TO CREATABLE USER GRPS
UMOVE B,.CDCUG(Q3) ;GET POINTER TO USERS BLOCK
CALL GTDGRP ;RETURN GROUPS
SOJLE Q2,GTDIR5 ;RUN OUT OF ARGUMENT BLOCK YET?
MOVE B,DIRORA
LOAD B,DRACT,(B) ;NO, GET POINTER TO DEFAULT DIR ACCOUNT
JUMPE B,[MOVEI B,[0]-1 ;RETURN A NULL IF NO DEFAULT ACT SET UP
JRST GTDIR7]
ADD B,DIRORA ;GET ABS ADR OF ACCOUNT IN DIR
GTDIR7: MOVEI C,.CDDAC(Q3) ;PLACE TO PUT USER7'S UPDATED PTR
UMOVE A,.CDDAC(Q3) ;POINTER TO BLOCK TO RECEIVE ACCOUNT
CALL CPYTU1 ;RETURN ACCOUNT TO USER
SOJLE Q2,GTDIR5 ; Run out of arg blk yet?
MOVE A,DIRORA
LOAD B,DRDNE,(A) ; Get default online expiration date/interval
UMOVEM B,.CDDNE(Q3) ; Return to user
SOJLE Q2,GTDIR5 ; Run out of arg blk yet?
LOAD B,DRDFE,(A) ; Get default offline exp date/interval
UMOVEM B,.CDDFE(Q3) ; Return to user
GTDIR5: ULKDIR
JRST MRETN
GTDIR2: MOVE T1,[5B2+.STDFP] ;GET DEFAULT FILE PROTECTION
CAILE Q2,.CDFPT ;SKIP IF LARGER THAN BLOCK SIZE
UMOVEM T1,.CDFPT(Q3) ;RETURN VALUE TO USER BLOCK
MOVE T1,[5B2+.STDDP] ;GET DEFAULT DIR PROTECTION
CAILE Q2,.CDDPT
UMOVEM T1,.CDDPT(Q3)
MOVE T1,[.STDBS] ;GET DEFAULT BACKUP SPECIFICATION
CAILE Q2,.CDRET
UMOVEM T1,.CDRET(Q3)
MOVEI T1,.STDMX ;GET DEFAULT DISK QUOTAS
CAILE Q2,.CDLIQ
UMOVEM T1,.CDLIQ(Q3) ;LOGGED IN QUOTA
CAILE Q2,.CDLOQ
UMOVEM T1,.CDLOQ(Q3) ;LOGGED OUT QUOTA
MOVEI T1,.STDSD ;GET DEFAULT SUBDIR QUOTA
CAILE Q2,.CDSDQ
UMOVEM T1,.CDSDQ(Q3) ;RETURN IT
MOVEI T1,.STDNE ; Default online expiration
CAILE Q2,.CDDNE
UMOVEM T1,.CDDNE(Q3)
;**;[2814] ADD 1 LINE AT GTDIR2:+20L TAM 14-SEP-82
SKIPG T1,TPRCYC ;[2814] USE TAPE RECYCLE PERIOD IF ONE SET
MOVEI T1,.STDFE ; Default offline expiration
;**;[2814] DELETE 2 LINES AT GTDIR2:+22L TAM 14-SEP-82
; CAMLE T1,TPRCYC ;[2814] Greater than system max?
; MOVE T1,TPRCYC ;[2814] Yes, then use spec'd max
CAILE Q2,.CDDFE
UMOVEM T1,.CDDFE(Q3)
JRST MRETN ;EXIT
;ROUTINE TO STORE GROUP LIST IN USER SPACE
;ACCEPTS IN A/ RELATIVE ADR OF LIST IN DIRECTORY
; B/ ADDRESS OF USER BLOCK TO RECEIVE LIST
; CALL GTDGRP
;RETURNS +1: ALWAYS
GTDGRP: JUMPE B,R ;DO NOTHING IF USER DOESNT WANT LIST
UMOVE C,0(B) ;GET LENGTH OF LIST AREA
;**;[1927] Change 1907 lines at GTDGRP: +2L JGZ 21-AUG-81
;**;[1907] REPLACE 2 LINES WITH 1 LINE AT GTDGRP: + 2L TAM 9-JUL-81
SOJLE C,R ;[1907] MAX NUMBER OF GROUPS, RET IF NONE
JUMPE A,[MOVEI A,1 ;IF NO GROUPS,
UMOVEM A,0(B) ;RETURN CORRECT # IN BLOCK
RET]
SAVEQ
MOVE Q3,B ;SAVE ADDRESS OF LIST AREA
MOVEI Q2,1 ;INIT COUNT TO HEADER COUNT
ADD A,DIRORA ;GET ABS ADR OF LIST IN DIR
LOAD D,BLKTYP,(A) ;CHECK LEGALITY OF BLOCK
CAIE D,.TYGDB ;GROUP DESCRIPTOR BLOCK?
JRST GTDGR4 ;NO, RETURN NOTHING
LOAD D,BLKLEN,(A) ;GET # OF GROUPS IN LIST
GTDGR2: SOJLE D,GTDGR4 ;CHECK IF DONE YET
HLRZ Q1,1(A) ;GET FIRST GROUP NUMBER
JUMPE Q1,GTDGR3 ;IGNORE 0'S
UMOVEM Q1,1(B) ;RETURN IT TO THE USER
AOS Q2 ;COUNT # OF GROUPS
AOS B ;STEP USER LIST
SOJLE C,GTDGR4 ;ANY MORE ROOM IN USER BUFFER?
GTDGR3: HRRZ Q1,1(A) ;GET NEXT GROUP NUMBER
AOS A ;STEP POINTER TO DIR LIST
JUMPE Q1,GTDGR2 ;IGNORE ZEROES
UMOVEM Q1,1(B) ;GIVE IT TO USER
AOS Q2 ;COUNT UP NUMBER OF GROUPS STORED
SOJLE C,GTDGR4 ;IF NO MORE ROOM, RETURN
AOJA B,GTDGR2 ;LOOP BACK FOR REST OF GROUPS
GTDGR4: UMOVEM Q2,0(Q3) ;SAVE COUNT OF GROUPS STORED
RET
;LOCK
;T1/ PHYSICAL PAGE(IF LK%PHY ON) OR -1 TO UNLOCK
;T2/ FKH,,PN ;NOW LIMITED TO .FHSLF
;T3/ FLAGS,,OPTIONAL REPEAT COUNT
; LK%CNT - USE REPEAT COUNT IN RH(3)
; LK%PHY - USE PHYSICAL PAGE IN 1 (IGNORED IF C(1) = -1)
; LK%NCH - UNCACHE PAGES (IF LOCKING)
; LK%AOL - ALLOW LOCKING IN OFFLINE MEMORY (IF LOCKING)
;RETURNS+1(ALWAYS):
; PAGES LOCKED/UNLOCKED AS REQUESTED
;ITRAPS ON ERRORS
DEFSTR (LKOST,0,5,5) ;OLD PAGE STATE
DEFSTR (LKPGN,0,35,23) ;PAGE NUMBER
DEFSTR (LKUSE,0,0,1) ;ENTRY IN USE BIT
;Q1,2,3 ARE COPIES OF THE USERS ARGUMENTS
.PLOCK::MCENT
MOVX T1,SC%WHL!SC%OPR!SC%MNT ;CHECK SPECIAL CAPABILITIES
TDNN T1,CAPENB ; ...
ITERR(CAPX2) ;NOT ENOUGH
UMOVE Q1,1 ;GET ARGUMENTS
UMOVE Q2,2 ; ...
UMOVE Q3,3 ; ...
CALL PLOCK0 ;DO THE WORK
ITERR() ;ERROR, TRAP
JRST MRETN ;SUCCESS, RETURN TO USER
;ENTER HERE WITH:
;Q1/ PHYSICAL PAGE(IF LK%PHY ON) OR -1 TO UNLOCK
;Q2/ FKH,,PN ;NOW LIMITED TO .FHSLF
;Q3/ FLAGS,,OPTIONAL REPEAT COUNT
; LK%CNT - USE REPEAT COUNT IN RH(3)
; LK%PHY - USE PHYSICAL PAGE IN 1 (IGNORED IF C(1) = -1)
; LK%NCH - UNCACHE PAGES (IF LOCKING)
; LK%AOL - ALLOW LOCKING IN OFFLINE MEMORY (IF LOCKING)
PLOCK0::SAVEPQ
HLRZ T1,Q2 ;CHECK FOR THIS FORK ONLY
CAIE T1,.FHSLF ; ...
RETBAD (ARGX12) ;ERROR
MOVE T1,FORKX ;GET INDEX OF THIS PROCESS
HLL Q2,FKPGS(T1) ;GET SPTN OF PAGE TABLE
TXNN Q3,LK%CNT ;USE USER SUPPLIED COUNT?
HRRI Q3,1 ;NO - USE 1
HRRZ T1,Q3 ;CHANGE OPERATION COUNT INTO
SOSGE T1 ;VERIFY REPEAT COUNT
RETBAD (ILLX04) ;NO
SETZM P4 ;NO FREE SPACE BLOCK YET
JUMPL Q1,LOCK0 ;IF UNMAP, DON'T CHECK PHYSICAL PAGE
TXNN Q3,LK%PHY ;USER GIVE PHYSICAL ADDRESS?
JRST LOCK0 ;NO
ADD T1,Q1 ;YES. COMPUTE LAST PAGE USED THEN
CAMLE T1,NHIPG ;WITHIN BOUNDS?
RETBAD (ILLX04) ;NO. CAN'T HAVE IT THEN
LOCK0: HRRZ T1,Q3 ;REPEAT COUNT AGAIN
ADDI T1,(Q2) ;CHECK END OF GROUP
CAILE T1,PGSIZ ; ...
RETBAD (ILLX04) ;BEYOND PT
NOINT ;NO INTERRUPTIONS FROM NOW ON
; ..
;VERIFIED ALL ARGS. NOW DO LOADING
SKIPL Q1 ;DOING SOME FORM OF LOCKING?
TXNN Q3,LK%PHY ;USER GIVING ADDRESSES?
JRST LOCK2 ;NO. GO ON TO FREE CHOICE
MOVEI T2,1(Q3) ;GET SIZE OF BLOCK NEEDED
CALL ASGJFR ;GET SOME FREE SPACE
RETBAD (MONX01,<OKINT>) ;CAN'T
MOVE P4,T1 ;SAVE BASE ADDRESS HERE
MOVEI P2,1(P4) ;SET UP AT FIRST WORD
;HAVE FREE BLOCK. NOW ACQUIRE EACH PHYSICAL PAGE
MOVE P1,Q1 ;FIRST PHYSCIAL PAGE TO GET
HRRZ P3,Q3 ;COUNT TO GET
LOCK4: MOVE T1,P1 ;PAGE
MOVEI T2,.MCPSO ;GET IT OFF-LINE
CALL SETPST ;DO IT
JRST LCKERR ;CAN'T DO IT
TXNN Q3,LK%AOL ;ALLOWING OFF-LINE?
CAIN T1,.MCPSA ;NO. PAGE WAS ON-LINE?
SKIPA ;YES. OKAY THEN
JRST [ MOVEI T1,LOCKX1 ;NO
JRST LCKERR] ;AND DONE
STOR P1,LKPGN,(P2) ;SAVE PAGE NUMBER
STOR T1,LKOST,(P2) ;SAVE OLD STATE
SETONE LKUSE,(P2) ;SAY IN USE
ADDI P1,1 ;NEXT PHYSICAL ADDRESS
ADDI P2,1 ;NEXT ENTRY IN JSB BLOCK
SOJG P3,LOCK4 ;GET THEM ALL
;ALL REQUESTED PHYSICAL PAGES NOW OFF-LINE. DO THE MAPPING
TXO Q3,LK%AOL ;ALLOW OFF-LINE STORAGE
; ..
LOCK2: HRRZ P1,Q3 ;GET COUNT
SKIPE P2,P4 ;HAVE A FREE BLOCK?
ADDI P2,1 ;YES. USE IT THEN
LOCKLD: JUMPL Q1,[MOVE T1,Q2 ;IF UNMAP. GET I.D.
CALL ULDPAG ;UNLOAD IT IF NECESSARY
JFCL ;WILL GO
JRST LOCKL1] ;AND PROCEED
MOVE T2,Q1 ;GET PHYSICAL PAGE NUMBER
MOVE T1,Q2 ;GET I.D.
HLL T2,Q3 ;COPY FLAGS
SKIPN P2 ;HAVE A BLOCK?
TXOA T3,1B0 ;NO. NO SPECIAL STATE THEN
LOAD T3,LKOST,(P2) ;YES. GET OLD STATE
CALL LODPPS ;LOAD IT
JRST [ PUSH P,T1 ;FAILED. SAVE ERROR CODE
SETOM T1 ;DO UNLOAD
UMOVE T2,2
UMOVE T3,3
PLOCK ;DO IT
POP P,T1 ;GET BACK ERROR CODE
JRST LCKERR] ;AND GO CLEAN UP IF NECESSARY
JUMPN P2,[ADDI Q1,1 ;NEXT PHYSICAL PAGE
SETZM 0(P2) ;DID THAT ENTRY
ADDI P2,1 ;NEXT ENTRY
JRST .+1] ;PROCEED
LOCKL1: ADDI Q2,1 ;NEXT PROCESS PAGE
SOJG P1,LOCKLD ;DO ALL PAGES
MOVEI T1,JSBFRE
SKIPE T2,P4 ;HAVE A BLOCK?
CALL RELFRE ;YES. FREE IT
RETSKP
;ERROR IN LOCKING PAGES.
; T1/ ERROR CODE
LCKERR: SKIPN P3,P4 ;HAVE A BLOCK?
RETBAD (,<OKINT>) ;NO. ALL DONE THEN
PUSH P,T1 ;SAVE ERROR CODE
ADDI P3,1 ;START HERE
HRRZ P2,Q3 ;COUNT
LCKER1: SKIPN 0(P3) ;HAVE ANYTHING HERE?
JRST LCKER2 ;NO
LOAD T2,LKOST,(P3) ;YES. GET PREVIOUS STATE
LOAD T1,LKPGN,(P3) ;GET PAGE NUMBER
CALL SETPST ;PUT IT BACK
JFCL
LCKER2: ADDI P3,1 ;NEXT ENTRY
SOJG P2,LCKER1 ;DO THEM ALL
;ALL PAGES RESTORED. FINISH UP
MOVEI T1,JSBFRE ;POOL NAME
MOVE T2,P4 ;ADDRESS
CALL RELFRE ;RELEASE BLOCK
POP P,T1 ;GET BACK ERROR CODE
RETBAD (,<OKINT>) ;AND DONE
; Login
;ACCEPTS:
; T1/USER NUMBER
; T2/POINTER TO PASSWORD STRING
; T3/5B2+ACCOUNT NUMBER
; OR
; POINTER TO ACCOUNT STRING
; LOGIN
;RETURNS +1: FAILURE
; T1/ERROR CODE
; +2: SUCCESS
; T1/DATE AND TIME OF LAST LOGIN
; T2/UPDATED STRING POINTER
; T3/UPDATED STRING POINTER (IF APPLICABLE)
;PSI OFF THROUGHOUT BECAUSE OF CALL SETDIR
.LOGIN::MCENT
GTOKM (.GOLOG,<T1>,[RETERR ()]) ;GETOK AND RETERR IF ILLEGAL
STKVAR <LOGUSR>
MOVE A,JOBNO
MOVEI B,777777
TDNE B,JOBDIR(A) ; Is this job currently logged in?
RETERR(LGINX5)
SKIPN FREJOB ;ANY JOB SLOTS LEFT (1 NEEDED FOR ATTACH'ES)
RETERR (LGINX6) ;NO, DO NOT ALLOW LOGINS.
UMOVE A,1 ;GET THE USER NUMBER
MOVEM A,LOGUSR ;SAVE IT
CALL CNVDIR ;CONVERT THIS NUMBER TO A DIRECTORY #
MOVEM A,P1 ;SAVE (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
CALL SETDIR ; MAP IN THIS DIRECTORY AND GO NOINT
RETERR(LGINX3)
MOVE Q1,DIRORA ; GET BASE ADR OF MAPPED DIR
CALL CPYUGP ;GET A COPY OF USER GROUPS INTO JSB
MOVEI A,0 ;NO GROUPS FOR THIS USER
MOVEM A,Q2 ;SAVE POINTER
LOCK JSSTLK ;LOCK JSB STRUCTURE DATA
HLRZ A,P1 ;GET UNIQUE CODE FOR STRUCTURE
CALL GTSTOF ;GET OFFSET IN JSB FOR THIS STRUCTURE
JRST [ UNLOCK JSSTLK ;NO SPACE. UNLOCK JSB STRUCTURE DATA
CALL USTDIR ;UNLOCK DIRECTORY AND STRUCTURE LOCKED
RETERR] ; BY SETDIR AND GO OKINT
STOR Q2,JSGRP,(B) ;SAVE POINTER TO GROUPS
HRRZ A,P1 ;GET DIRECTORY NUMBER ON PS
STOR A,JSADN,(B) ;INDICATE USER HAS ACCESSED THIS DIRECTORY
UNLOCK JSSTLK ;UNLOCK THE JSB STRUCTURE DATA
LOAD B,DRMOD,(Q1) ; GET MODE BITS
MOVEM B,MODES
TXNE B,MD%FO ;FILES ONLY DIRECTORY?
RETERR(LGINX2,<ULKDIR>) ;CAN'T LOGIN TO FILES-ONLY DIRECTORY
;PASSWORD IS NOT REQUIRED IF CONTROLLING TTY IS A PTY AND EITHER:
; 1. THIS JOB BEING LOGGED IN AS SAME USER, OR
; 2. USER IS A SC%WHL OR SC%OPR
;CHECK FOR THESE CONDITIONS
MOVE A,CTRLTT ;CTRL TTY OF THIS JOB
CALL PTGETJ ;GET JOB NO. OF JOB OWNING PTY OR -1
MOVE B,A
JUMPL B,LOGI2 ;JUMP IF NOT A PTY
HRRZ D,JOBDIR(B) ;GET "WHO" OF CONTROLLING JOB
XCTU [HRRZ C,1] ;GET "WHO" TRYING TO LOGIN HERE
CAMN C,D ;SAME?
JRST LOGI1 ;YES, NO PASSWORD CHECK
MOVE A,B ;CONTROLLING JOB NUMBER FOR CALL
CALL GJCAPS ;GET CAPABILITIES OF CONTROLLING JOB
MOVE B,A
TXNE B,SC%WHL+SC%OPR ;CONTROLLING JOB HAS CAPABILITIES?
JRST LOGI1 ;YES, NO PASSWORD CHECK
;ALSO BYPASS PASSWORD CHECK IF IN THE MIDST OF CRJOB AND THE
;CREATOR OF THIS JOB ASKED FOR PASSWORD TO BE BYPASSED AND THE
;CREATOR WAS AN ENABLED WHEEL/OPERATOR.
LOGI2: SKIPE T2,CRJFLG ;IS THIS A CRJOB INTERNAL LOGIN?
TRNN T2,1 ;YES. REQUESTED TO BYPASS PSWD CHK?
SKIPA ;NO. SO CHECK IT.
JRST LOGI1 ;YES. BYPASS CHECKING PASSWORD.
CALL CHKPSW
JRST LOGI3 ;INCORRECT PASSWORD
; ..
; ..
LOGI1: SETZM D ;ASSUME WE HAVE AN ACCOUNT STRING
XCTU [SKIPN A,3] ;GET ACCOUNT STRING
MOVEI D,1 ;NONE THERE
MOVE B,LOGUSR ;GET USER NUMBER
XCT [ CALL SETACT
CALL SETACL](D) ;EXECUTE PROPER ROUTINE
RETERR (,<ULKDIR>) ;UNLOCK DIR
CALL LGTAD ;DO LOCAL GTAD
LOAD T2,DRDAT,(Q1) ;PICK UP LAST LOGIN D&T
MOVEM T2,LSTLGN ;SAVE IT FOR GETJI
JUMPL A,LOGI4 ;DONT SET LOGIN TIME IF DAYTIME NOT SET
;DO NOT UPDATE LAST-LOGIN DATE IF REQUESTOR OF A PRIVILEGED CRJOB
;SAID NOT TO. THIS IS FOR SERVER LOGINS, SUCH AS FILE TRANSFER.
SKIPE T3,CRJFLG ;IS IT A CRJOB?
TRNN T3,2 ;YES. NO-UPDATE BIT ON?
SKIPA ;NO, SO UPDATE AS NORMAL
JRST LOGI4 ;YES. BYPASS THE UPDATE.
STOR A,DRDAT,(Q1) ;UPDATE TIME
LOGI4: XCTU [EXCH B,1] ;GET DIRECTORY TO LOG INTO
MOVE A,JOBNO ;GET THIS JOB'S NUMBER
HRRZM B,JOBDIR(A) ;SAVE AS LOGGED IN DIRECTORY
MOVE A,STRTAB ;GET SDB ADDRESS OF STRUCTURE 0 (PUBLIC)
LOAD A,STRUC,(A) ;GET ITS UNIQUE STRUCTURE CODE
STOR A,JSUC ;SAVE AS CONNECTED STRUCTURE CODE
STOR B,JSDIR ;MAKE THIS THE CONNECTED DIRECTORY
CALL CPYCDN ;COPY THE CONNECTED DIR NAME TO JSB
MOVE B,DIRORA ;POINTER TO DIRECTORY
OPSTR <ADD B,>,DRNAM,(B) ;GET PNTR TO NAME STRING
;COPY NAME STRING TO
MOVEI C,USRNAM+1 ; JSB STORAGE
LOAD A,NMLEN,(B) ;GET NUMBER OF WORDS IN STRING
AOS B ;UPDATE POINTER TO STRING
HRRZM A,USRNAM ;SAVE LENGTH OF STRING
SOS A ;COPY ALL BUT THE HEADER WORD
CALL XBLTA ;COPY STRING
REPEAT 0,<
CALL TTWHOK ;IS IT OK TO BE A WHEEL ON THIS TTY?
JRST [ MOVEI T2,0 ;NO. SO CLEAR RH CAPS.
JRST LOGI1A] ; ..
>
LOAD T2,DRPRV,(Q1) ;GET PRIVILEGE BITS
LOGI1A: HRRM T2,CAPMSK ;SETUP RH CAPS - LH SETUP AT JBFINI
ULKDIR
MOVEI T1,SPIDTB+.SPQSR ;PID OF QUASAR
CALL LOGIMS ; SEND A LOGIN MESSAGE TO QUASAR
JFCL ; NO QUASAR
CALL SKDLOG ;GET CLASS ASSIGNMENT IF NECESSARY
;**;[3127]REMOVE 1 LINE AT LOGI1A + 6L 20-JUN-84 TAB
;[3127] CALL LOGONM ; Type logon message
MOVE A,TODCLK ;UPTIME
MOVEM A,CONSTO
CALL LGTAD
MOVEM A,CTIMON ;SAVE TIME ON
;**;[3127]ADD 1 LINE AT LOGI1A+ 11L 20-JUN-84 TAB
CALL LOGONM ;[3127]TYPE LOGIN MESSAGE AND DO USAGE
MOVE T2,CTRLTT ;GET CONTROLLING TERMINAL LINE NUMBER
MOVEI T3,.MOSMY ;ACCEPT SYSTEM MESSAGE CODE
SKIPL T2 ;SKIP IF DETACHED...
CALL TTSNTS ;SET TERMINAL TO ACCEPT SYSTEM MESSAGES
BP$020: ;(MOVE A,JOBNO): BREAKPOINT FOR CREATE MAIN FORK
;ASSUMES FORKX HAS FORK INDEX, GETS JOB INDEX FORM FKJOB(FORKINDEX)
MOVE A,JOBNO
SETZM JOBRT(A)
SETZM CAPENB
SMRETN
;HERE IF INCORRECT PASSWORD
LOGI3: ULKDIR
MOVE B,A ;SAVE FLAG FROM CHKPSX
MOVEI A,^D3000 ;WAIT 3 SEC TO FOIL PASSWORD THIEVES
SKIPN B ;DISMS ONLY IF NEEDED
DISMS
RETERR(LGINX4)
; Number input
; Call: 1 ; Source designator
; NIN
; Return
; +1 ; Error
; +2 OK
; 2 NUMBER
.NIN:: MCENT
CAILE 3,1
CAILE 3,^D10
JRST [ MOVEI A,IFIXX1 ; Illegal radix
UMOVEM A,3
JRST EMRET0] ;STORE ERROR CODE AND MRETN
MOVEI C,0
SETZ P1, ;OVERFLOW FLAG
PLIN0: CALL BIN1
JRST NINEOF ;END OF FILE
JUMPE B,NINXX2 ;IF B=0, END OF INPUT
CAIN B,40
JRST PLIN0 ; Skip leading spaces
CAIN B,"-"
JRST MININ
CAIN B,"+"
JRST [ CALL BIN1
JRST NINEOF ;END OF FILE REACHED
JRST .+1]
CALL DIGIN1
JRST NINXX2 ;NO DIGITS SEEN
PLIN: CALL NIN9
PLIN1: UMOVEM C,2
SKIPE P1 ;FOUND AN OVERFLOW?
JRST [ MOVEI A,IFIXX3 ;YES
JRST NINERR]
SMRETN ;DONE
MININ: CALL NIN91
MOVNS C
JRST PLIN1
;NO DIGITS SEEN
NINXX2: MOVEI A,IFIXX2
JRST NINERR
NINEOF: MOVEI A,IOX4 ;EOF SEEN
NINERR: UMOVEM A,3 ;RETURN ERROR CODE TO USER
EMRETN ;GO STORE ERROR IN LSTERR AND TAKE ERROR RETURN
NIN9: XCTU [MUL C,3]
SKIPE C ;GOT SOME LOST BITS?
SETOM P1 ;YES. REMEMBER THE OVERFLOW
LSH C,^D35 ;GET READY TO ADJUST FOR LOSSAGE
ADD D,C ;COMPLETE MULTIPLY
EXCH C,D ;PRODUCT TO PROPER PLACES
ADD D,D ;ADJUST SIGN
;**;[3064] Add 1 line at NIN9: +7L CRJ 3-Jan-84
JFCL 17,.+1 ;[3064] Clear PC flags
ADD C,B ; Add in digit
;**;[3064] Add 2 lines at NIN9: +7L CRJ 3-Jan-84
JCRY [SETOM P1 ;[3064] Remember the overflow
JRST .+1] ;[3064] Rejoin code
NIN91: CALL DIGIN
RET
JRST NIN9
DIGIN: CALL BIN1
RET ;EOF REACHED
DIGIN1: SUBI 2,60
JUMPL 2,CPOPJ
CAILE 2,^D9
JRST [ CAIL 2,"A"-60
CAILE 2,"Z"-60
RET
SUBI 2,"A"-"9"-1
JRST .+1]
XCTU [CAMGE 2,3]
RETSKP
RET
; Fixed point number output
; Call: 1 ; Destination designator
; 2 ; Number to be output
; RH(3) ; Radix
; 3(0) ; 1 to treat number as 36 bit magnitude
; 3(1) ; 1 to always print some kind of sign
; 3(2) ; Right justify the number
; 3(3) ; Print leading zeros if any
; 3(4) ; Print something on errors
; 3(5) ; Print * on errors rather than whole number
; 3(11-17) ; Field width, 0 means large enough to hold all
; NOUT
; Return
; +1 ; Error, bad radix, or number too big for field
; +2 ; Successful
.NOUT:: MCENT
CALL NOUTX
JRST [ MOVE A,LSTERR
UMOVEM A,3
EMRETN] ; Take error return
SMRETN
NOUTX:: HRRZ D,C ; Get radix
CAIL D,2
CAILE D,^D10+^D26 ; Must be 2 - 36
JRST [ MOVEI A,NOUTX1
MOVEM A,LSTERR
RET]
HLL D,C ; Save flags in d too
LDB F,[POINT 8,D,17] ; Extract column width
MOVEI Q3,1 ; Initilize digit counter
TLNN D,(1B0) ; Magnitude printout?
CAIL B,0 ; Or positive number?
TLZA D,(1B6) ; Yes, remember not minus sign
TLO D,(1B6+1B1) ; No, remember minus sign
TLNE D,(1B6) ; - sign to be printed?
MOVMS B ; Yes complement number
TLNE D,(1B1) ; A sign of some sort to be printed?
NOUT1: AOS Q3 ; Yes, count as digit
LSHC B,-^D35 ; Make into double
LSH C,-1 ; Length dividend
DIVI B,(D) ; Produce a digit
PUSH P,C ; Save on stack
JUMPN B,NOUT1 ; Repeat until all digits generated
CAIN F,0 ; Zero field width specified?
MOVE F,Q3 ; Yes, make it same as number of digits
TLNE D,(1B2) ; Right justify number?
NOUT2: CAML Q3,F ; And filler needed?
JRST NOUT3 ; No
TLNE D,(1B3) ; Yes. leading 0's?
CALL SGNOUT ; Yes, output sign now
MOVEI B," " ; Get a space
TLNE D,(1B3) ; Unless 0's wanted
MOVEI B,"0" ; Then get a 0
CALL BOUTA ; Call bout so strings will work
SOJA F,NOUT2 ; Decrease remaining width and loop
NOUT3: CAML F,Q3 ; Sufficient room?
JRST NOUT4 ; Yes
MOVEI B,NOUTX2 ; Error
MOVEM B,LSTERR
TLNN D,(1B4) ; Print something anyway?
JRST NOUT7 ; No, go away
TLNN D,(1B5) ; Asterisks?
JRST NOUT4 ; No, print the whole number
MOVEI B,"*" ; Yes,
NOUT6: SOJL F,NOUT7 ; Column filled
CALL BOUTA
JRST NOUT6
NOUT7: TLNE D,(1B1) ; If one position reserved for -,
SOS Q3 ; One less thing on stack
NOUT71: SOJL Q3,CPOPJ
POP P,B
JRST NOUT71
NOUT4: CALL SGNOUT ; Output sign before number
NOUT5: SOJL Q3,NOUT8 ; Any digits left?
POP P,B ; Yes, get one
ADDI B,"0"
CAILE B,"9"
ADDI B,"A"-"9"-1
CALL BOUTA ; Print it
SOJA F,NOUT5 ; Decrease field width
NOUT8: SKIPL F
AOS (P) ; Skip if no error
MOVEI B," "
JRST NOUT6 ; Insert trailing blanks if necessary
SGNOUT: TLZN D,(1B1) ; Sign still needed?
RET ; No, return immediately
MOVEI B,"-"
TLNN D,(1B6)
MOVEI B,"+"
CALL BOUTA
SOS Q3 ; Decrement digit count
SOS F ; Decrement remaining field width
RET
; Pmap jsys
; Call: 1 ; Page ident (frk.pn or jfn.pn)
; 2 ; Page ident
; 3 ; Bits 2,3,4 to set page table access
; ;1B0 + COUNT TO DO MULTIPLE PAGES
; PMAP
.PMAP:: MCENT
TRVAR <SID,DID,CNT,JF1,PMTS,PMTA,PMTD,PMTL,PMTC>
;***NOTE*** THE ABOVE TRVAR MUST MATCH THE TRVAR'S IN RPACS,
;RMAP AND SPACS. DON'T ADD ANY DEFS BEFORE JF1.
;****
;SID - CURRENT SOURCE IDENT ;DID - CURRENT DEST IDENT
;CNT - CURRENT REMAINING COUNT ;JF1 - JFN WHICH HAS STRUCTURE LOCK
;PMTS - INTERLOOP SOURCE ID ;PMTA - INTERLOOP ACCESS
;PMTD - INTERLOOP DEST ID ;PMTL - LOCAL DEST ID
;PMTC - COUNT FOR PMAPCL
SETZM JF1 ;NO LOCK YET
DMOVEM A,SID ;SAVE ARGS
SKIPL A ;IS SOURCE A FILE?
JRST PMAP10 ;YES
SKIPGE A,B ;IS DESTINATION A FILE?
JRST PMAP11 ;NO
PMAP10: MOVEM C,CNT ;SAVE ACCESS AND COUNT
HLRZS A ;GET JFN
CAML A,MAXJFN ;reasonable value?
JRST [ MOVEI A,DESX1 ;no, return invalid s/d designator
JRST PMAPER] ; ..
IMULI A,MLJFN ;MAKE IT AN INTERNAL VALUE
;**;[2003] Add 3 lines at PMAP10: +6L JGZ 17-MAR-82
MOVE B,FILSTS(A) ;[2003] GET THE JFN STATUS BITS
TXNN B,OPNF ;[2003] IS JFN OPEN?
JRST PMPER4 ;[2003] NO...GENERATE ERROR
LOAD A,FILUC,(A) ;GET STRUCTURE UNIQUE CODE FOR FILE
TLO A,400000 ;ALLOW FORK-ONLY MOUNT
CALL CHKMNO ;CHECK IF USER HAS MOUNTED STRUCTURE
JRST PMAPER ;NO, FAIL
MOVE C,CNT ;RESTORE COUNT
PMAP11: MOVEI Q2,1 ;ASSUME COUNT IS 1
TXNE C,1B0 ;UNLESS B0 SET
HRRZ Q2,C ;IN WHICH CASE COUNT IS IN 3
JUMPE Q2,MRETN ;REJECT 0 COUNT
CAIN Q2,1 ;ONE PAGE PMAP?
JRST [ CALL PMAP0 ;YES, GET RIGHT TO IT
JRST MRETN]
MOVEM Q2,CNT ;SAVE TOTAL COUNT
;SEE IF SOURCE OR DESTINATION WILL GO OFF END OF PAGE TABLE
;WHILE DOING COUNT. IF SO, DO IN PARTS WHICH INVOLVE ONLY
;ONE PAGE TABLE
PMAPC3: MOVE A,SID ;GET SOURCE IDENT
CAMN A,[-1] ;DELETE?
JRST PMAPC4 ;YES
ANDI A,777 ;GET PAGE NUMBER WITHIN PAGE TABLE
MOVN A,A ;COMPUTE 1000-PAGENO TO SEE
ADDI A,1000 ; HOW MANY PAGES CAN BE DONE IN THIS PT
CAMGE A,Q2 ;MORE THAN REQUIRED BY COUNT?
MOVE Q2,A ;NO, REDUCE COUNT
PMAPC4: MOVE A,DID ;GET DESTINATION
ANDI A,777 ;GET PAGE NUMBER WITHIN PAGE TABLE
MOVN A,A ;COMPUTE 1000-PAGENO TO SEE
ADDI A,1000 ; HOW MANY PAGES CAN BE DONE IN THIS PT
CAMGE A,Q2 ;MORE THAN REQUIRED BY COUNT?
MOVE Q2,A ;NO, REDUCE COUNT
CAMN Q2,CNT ;WAS COUNT REDUCED?
JRST [ CALL PMAP0 ;DO ALL OF CNT
JRST MRETN]
CALL PMAP0 ;DO THIS GROUP
MOVE A,SID ;GET SOURCE
CAME A,[-1] ;IF DELETE DON'T UPDATE IT
ADDM Q2,SID ;UPDATE IDENTIFIERS FOR PAGES JUST DONE
ADDM Q2,DID
MOVN Q2,Q2 ;UPDATE TOTAL COUNT FOR PAGES JUST DONE
ADDB Q2,CNT
JUMPLE Q2,MRETN ;ANY MORE TO DO?
MOVEI A,-1 ;YES. CHECK FOR OVERLFOW OF PAGE NUMBER
TDNE A,SID ;DID THIS ONE OVERFLOW?
TDNN A,DID ;NO. HOW ABOUT THIS ONE?
ITERR (ARGX06) ;YES TO ONE OF THEM
JRST PMAPC3 ;NO. GO ON THEN
;PMAP...
;THE FOLLOWING DOES ALL THE WORK, ASSUMING THAT THE COUNT
;DOES NOT CAUSE EITHER IDENTIFIER TO GO OFF THE END OF A PAGE TABLE
PMAP0: SETZM JF1 ;NONE HERE
MOVE A,DID ;GET DESTINATION IDENT
;**;[3174] Change 1 line at PMAP0:+2 DML 11-Oct-84
SKIPL B,SID ;[3174] IS SOURCE IDENT A FILE?
JUMPGE A,[MOVEI A,PMAPX2 ;NO, IF DEST NOT A FILE THEN ERROR
JRST PMAPER]
;**;[3174] Replace 1 line with 9 at PMAP0:+5 DML 11-Oct-84
CAMN B,[-1] ;[3174] Delete only?
IFSKP. ;[3174] No, not delete only
UMOVE B,3 ;[3174] Get user requested access
MOVX C,PM%WT ;[3174] Get write access bit
SKIPL A ;[3174] Is the destination a file?
IORM C,B ;[3174] Yes, grant PM%WT for all sections
ELSE. ;[3174]
TDZ B,B ;[3174] Yes delete only, so no section creates
ENDIF. ;[3174]
CALL CPMAPX ; Convert to ptn.pn and get access
; also check for execute-only
MOVEM D,JF1 ;RETURNS LOCKED JFN
;**;[2899]REPLACE 1 LINE WITH 5 AT PMAP0:+12L TAM 11-JAN-83
JUMPE A,[MOVE A,SID ;[2899] IF ZERO COULDN'T GET IT. CHECK FOR DELETE
CAIN D,LNGFX1 ;[2899] COULDN'T GET BECAUSE OF NONEX PT?
CAME A,[-1] ;[2899] AND DELETING?
JRST PMPER2 ;[2899] SOME OTHER ERROR OR NOT DELETING
JRST PMAP7] ;[2899] DELETING AND NON-X PT OK. DO NEXT GROUP
TLNN C,(PM%WT)
JRST PMPER1 ; MUST BE ABLE TO WRITE DESTINATION
MOVEM A,PMTD ; Save destination ptn.pn
MOVE A,SID ; Get source designator
CAMN A,[-1] ; Delete wanted?
JRST [ SETZB A,C ;YES, 0 IDENT AND ACCESS
JRST PMAP1] ; Then skip the following
UMOVE B,3 ;GET USER REQUESTED ACCESS
CALL CPMAPX ; Convert source and get it's access
; also check for execute-only
JRST [ MOVEM D,JF1 ;SAVE LOCKED JFN
TXNN B,READF ;HAVE READ ACCESS TO THE FILE?
JRST PMPER1 ;NO. ERROR
JRST .+1] ;YES. ALLOW THE MAP THEN
JUMPE A,PMPER2 ;COULDN'T GET IT
PMAP1: MOVEM C,PMTA ;SAVE ACCESS
MOVEM A,PMTS ;AND PTN.PN
SKIPGE DID ; Is "to" a file?
JRST PMAP2 ; No, ok to do
; ..
; ..
;DESTINATION IS FILE, SO ACCESS OF EACH FILE PAGE TO BE AFFECTED
;MUST BE CHECKED. THE FILE PAGE MUST BE PRIVATE. THIS
;LOOP USES MSCANP WHICH SCANS FOR A NON-0 PAGE AND RETURNS ITS
;ACCESS. THIS MAKES FOR MINIMUM OVERHEAD WHEN MAPPING INTO
;PAGES WHICH ARE ALREADY EMPTY.
MOVE A,PMTD ;GET DESTINATION IDENT
MOVE Q1,Q2 ;GET COUNT FOR LOOP
PMAPC1: MOVEM A,PMTL ;SAVE IDENT
MOVE B,Q1 ;GET REMAINING COUNT FOR CALL
CALL MSCANP ;FIND NON-EMPTY PAGE AND RETURN ACCESS
JUMPE B,PMAPC6 ;NONE
EXCH B,Q1 ;SAVE UPDATED COUNT, GET ORIG COUNT
SUB B,Q1 ;COMPUTE NUMBER OF PAGES SKIPPED
ADDM B,PMTL ;UPDATE IDENT FOR PAGES SKIPPED
TLNN A,(PA%PRV) ; Better be private
JUMPN A,[MOVEI A,PMAPX2; Or empty
JRST PMAPER] ; Else error
MOVE A,PMTL ;RECOVER IDENT
ADDI A,1 ;GO TO NEXT PAGE
SOJG Q1,PMAPC1 ;DO ALL PAGES
;EACH SOURCE PAGE MUST ALSO BE CHECKED. SOURCE PAGE MUST BE
;PRIVATE (I.E. OWNED BY FORK) BECAUSE OWNERSHIP WILL BE TRANSFERRED
;TO FILE.
PMAPC6: MOVE A,PMTS ;GET SOURCE IDENT
JUMPE A,PMAP55 ;IF DELETING, NO FURTHER CHECK NEEDED
MOVE Q1,Q2 ;GET COUNT FOR LOOP
PMAPC5: MOVEM A,PMTL ;SAVE IDENT
MOVE B,Q1 ;GET REMAINING COUNT FOR CALL
CALL MSCANP ;FIND NON-EMPTY PAGE AND RETURN ACCESS
JUMPE B,PMAP55 ;NONE
EXCH B,Q1 ;SAVE UPDATED COUNT, GET ORIG COUNT
SUB B,Q1 ;COMPUTE NUMBER OF PAGES SKIPPED
ADDM B,PMTL ;UPDATE IDENT FOR PAGES SKIPPED
TLNN A,(PA%PRV) ;PRIVATE?
JUMPN A,[MOVEI A,PMAPX2 ;NO, IF NOT EMPTY THEN ERROR
JRST PMAPER]
MOVE A,PMTL ;RECOVER IDENT
ADDI A,1 ;GO TO NEXT PAGE
SOJG Q1,PMAPC5 ;DO ALL PAGES
PMAP55: NOINT ;MUST BE NOINT AT PMAP5
JRST PMAP5
;DESTINATION IS FORK. PRESENT CONTENTS OF EACH PAGE WILL BE
;REMOVED, SO IT IS NECESSARY TO UPDATE MAP COUNT FOR FILES WHOSE
;PAGES ARE UNMAPPED. FOR EFFICIENCY IN THE CASE WHERE FORK MAP
;IS EMPTY, MSCANP IS USED TO SCAN FOR NON-EMPTY PAGES.
PMAP2: SKIPGE A,SID ;IS FROM A FILE?
JRST PMAP4 ; No.
HLRZS A ; Yes, get jfn
IMULI A,MLJFN ; CONVERT TO INTERNAL INDEX
MOVSI B,0(Q2) ;UPDATE MAP COUNT BY NUMBER OF PAGES
ASH B,1 ; IN REQUEST
ADDM B,FILLFW(A) ; Increment count of reasons for opening
PMAP4: NOINT ;MUST BE NOINT WHEN DIDDLING MAP COUNTS
MOVE Q1,Q2 ;GET COUNT FOR PAGE SCAN LOOP
SETO Q3, ;INIT OFN/JFN ASSOCIATION TO NIL
SETZM PMTC ;INIT PMAPCL COUNT
MOVE A,PMTD ;GET DESTINATION IDENT
PMAPC2: MOVEM A,PMTL ;SAVE IDENT
MOVE B,Q1 ;GET REMAINING COUNT FOR CALL
CALL MSCANP ;FIND NON-0 PAGE AND GET ACCESS
JUMPE B,PMAP5 ;NONE
EXCH B,Q1 ;SAVE UPDATED COUNT
SUB B,Q1 ;COMPUTE NUMBER OF PAGES SKIPPED
ADDM B,PMTL ;UPDATE IDENT FOR PAGES SKIPPED
JUMPE A,PMAP3 ; Jump if empty
TLNE A,(PA%PRV)
JRST PMAP3 ; Or if private
MOVE A,PMTL ; Is indirect or share
CALL MRPT ; Get it's id
JRST PMAP3 ; Not file
HLRZ B,A ;GET OFN
CAIN B,0(Q3) ;QUICK CHECK - SAME AS LAST ONE?
JRST [ HLLZ A,Q3 ;YES, GET SAME JFN AS LAST ONE
JRST PMAP6]
MOVE Q3,B ;NOT SAME OFN, REMEMBER THIS ONE
CALL OFNJFX ; Convert to jfn
JRST [ SETO Q3, ;NO JFN, FORGET OFN TOO
JRST PMAP3]
HLL Q3,A ;REMEMBER JFN/OFN ASSOCIATION
PMAP6: HLRZ A,A ;GET JFN OF PAGE
IMULI A,MLJFN ;CONVERT TO INTERNAL INDEX
HLRZ C,FILLFW(A) ;GET JFN SHARE COUNT
SUBI C,2 ;REDUCE FOR PAGE BEING REMOVED
JUMPE C,[MOVE B,PMTD ; COUNT NOW 0. GET DEST IDENT
CALL PMAPCL ;MUST REMOVE PAGES BEFORE COUNT GOES
MOVX B,FRKF ; TO 0. UNRESTRICT JFN SO NEXT CLZFF
ANDCAM B,FILSTS(A) ; GETS IT
SETO Q3, ;FORGET THIS JFN
JRST .+1] ;NOW OK TO REDUCE COUNT
HRLM C,FILLFW(A) ;SET REDUCED COUNT
PMAP3: MOVE A,PMTL ;RECOVER IDENT
ADDI A,1 ;GO TO NEXT PAGE
SOJG Q1,PMAPC2 ;DO ALL PAGES
; ..
; ..
;NOW CALL KERNAL ROUTINE TO CHANGE THE ACTUAL MAPS
PMAP5: MOVE A,PMTS
MOVE C,PMTA
MOVE B,PMTD
TXO C,PM%TPU+PM%CPY+PM%ABT ;RETAIN CERTAIN BITS
CALL CKMMOD ;CHECK FOR MONITOR CALL
SKIPA ;NOT. IS USER
TXO C,PM%IND ;IT IS. ALLOW INDIRECT POINTERS
XCTU [AND C,3]
MOVE 4,Q2 ;GET COUNT
CALL MSETPT ;DO MULTIPLE PT SET
OKINT ;NOW MAP AND JFN MAP COUNTS MUST AGREE
MOVE A,PMTD ;GET IDENTIFIER FOR DESTINAITION
SKIPL DID ;DESTINATION MUST BE A PROCESS
JRST PMAP7 ;IF NOT, CAN'T PRELOAD PAGES
MOVE B,Q2 ;GET REPEAT COUNT
UMOVE C,C ;GET USER'S FLAGS
TXNE C,PM%PLD ;WANT TO PRELOAD ALL OF THESE PAGES?
CALL PREPG ;YES. REQUEST SWAP IN THEN
JFCL ;DON'T CARE
PMAP7: CALL PMAPRL ;RELEASE FILE LOCKS
RET
;ERROR RETURN FROM PMAP
;**;[2003] Add 2 lines at PMPER2: +0L JGZ 17-MAR-82
PMPER4: MOVEI A,DESX5 ;[2003] GET ERROR CODE
JRST PMAPER ;[2003] AND JOIN REGULAR ERROR CODE
PMPER2: SKIPN A,D ;GET ERROR CODE
PMPER1: MOVEI A,PMAPX1 ;CONVENIENT ERROR PLACE
PMAPER: MOVEM A,LSTERR
MOVEM B,ERRSAV
CALL PMAPRL ;GO RELEASE ANY FILE LOCKS
JRST ITRAP
;ROUTINE TO RELEASE ANY ACCUMULATED FILE LOCKS
PMAPRL: SKIPE A,JF1 ;HAVE ONE HERE?
CALL LUNLK0 ;YES. UNLOCK IT THEN
RET ;DONE
;ACCEPTS: A/PROCESS HANDLE OR JFN
; B/TYPE OF ACCESS REQUESTED
;RETURNS: +1,IF THE PAGE IS IN A FILE
; +2,IF THE PAGE IS IN A PROCESS
;GET IDENT AND ACCESS
; CPMAP - normal entry
; CPMAPX - disallow execute-only processes if process ident
CPMAPX: JUMPL A,FRKMPX ;If B0 set, then must be process handle
CPMAP: JUMPL A,FRKMAP
PUSH P,A ;SAVE THE JFN
TXNN B,PM%WT ;DID USER WANT WRITE?
SETZ B, ;NO. PREVENT PT CREATES
CALL JFNOF4 ;GET OFN AND STATUS
JRST [ SUB P,BHC+1
CAIE A,LNGFX1 ;COULDN'T CREATE PT?
JRST PMAPER ;NO. GENERAL ERROR
MOVE D,A ;SAVE ERROR CODE
SETZ A, ;YES. RETURN CONDITION
RETSKP] ;SAYING IT IS A PROCESS
EXCH A,0(P) ;SAVE OFN, GET BACK JFN
HLRZS A ;JFN ONLY
IMULI A,MLJFN ;MAKE IT AN INTERNAL VALUE
CALL STRDMO ;VERIFY AND LOCK UP STRUCTURE
JRST [ SUB P,BHC+1 ;CLEAN UP STACK
JRST PMAPER] ;AND GIVE PROPER ERROR
MOVE D,A ;REMEMBER THIS JFN HAS STRUCTURE LOCK
POP P,A ;GET BACK ID
TXNN B,<RNDF> ;OPENED FOR APPEND MODE?
JRST [ MOVE A,D ;GET BACK JFN
CALL LUNLK0 ;FREE STRUCTURE LOCK
MOVEI A,PMAPX2 ;THIS IS NOT ALLOWED
JRST PMAPER]
MOVSI C,(PM%RWX) ;GIVE ALL ACCESS
TXNN B,WRTF ;UNLESS FILE NOT OPEN FOR WRITE
TLZ C,(PM%WT) ;IN WHICH CASE DISALLOW WRITE
RET
FRKMPX: CALL FKHPTX ;Convert FRK.PN to PTN.PN
; and check for execute-only
JRST PMAPER ;Error-- Release any locks and give error
JRST FRKMP1 ;Continue below . . .
FRKMAP: CALL FKHPTN
JRST PMAPER ;Error-- Release any locks and give error
FRKMP1: MOVSI C,(PM%RWX)
RETSKP ;SAY IS A FORK HANDLE
;REMOVE PAGES FROM PAGE TABLE AS FAR AS IT HAS BEEN SCANNED.
;DONE BECAUSE CANNOT WAIT UNTIL END OF SCAN WHEN JFN COUNT GOES
;TO 0.
; B/ DEST IDENT
; Q2/ ORIGINAL PAGE COUNT
; Q1/ CURRENT PAGE COUNT (PAGES LEFT TO SCAN)
; CALL PMAPCL
; RETURN +1, PRESERVED ALL AC'S.
PMAPCL: SAVET
MOVEI A,0 ;SAY CLEAR MAP
ADD B,PMTC ;UPDATE ID BY NUMBER ALREADY CLEARED
MOVEI D,1(Q2) ;COMPUTE NUMBER OF PAGES SCANNED
SUB D,Q1
SUB D,PMTC ;LESS THOSE ALREADY DONE
ADDM D,PMTC ;UPDATE RUNNING COUNT
MOVX C,PM%ABT ;ALLOW ONLY ABORT BIT
XCTU [AND C,3] ; IF SPECIFIED BY CALLER
CALLRET MSETPT ;CLEAR THEM
;JSYS TO CONVERT PPN (TOPS10) TO STRING
;ACCEPTS IN T1/ OUTPUT DESIGNATOR
; T2/ PPN (MUST BE 4,,#)
; T3/ POINTER TO DEVICE/STR NAME
; PPNST
;RETURNS +1 ALWAYS T3/ UPDATED POINTER
.PPNST::MCENT
XCTU [HLRZ T1,2] ;GET LHS OF PPN
CAIE T1,PPNLH ;VALID PPN?
ITERR (PPNX1) ;NO
UMOVE T1,3 ;GET STRING PNTR
CALL STDEV0 ;CONVERT TO DEVICE DESIGNATOR
ITERR () ;RETURN ERROR
HLRZ T2,T1 ;CHECK DEVICE TYPE
CAIE T2,.DVDES+.DVDSK ;GRNTEE DISK!
ITERR (PPNX2) ;VALID FOR DISK/STR ONLY
HRRZS T1 ;STR UNIQUE CODE ONLY
CAIN T1,-1 ;WAS IT DSK:
LOAD T1,JSUC ;YES - GET CONNECTED STR
HRLZS T1 ;NOW MAKE INTO 36-BIT DIR #
XCTU [HRR T1,2] ;GET RHS OF PPN
CALL DIRST0 ;CONVERT TO STRING
ITERR () ;PROBLEM WITH DIR?
JRST MRETN ;GIVE RETURN
;JSYS TO PERFORM VARIOUS CONTROL/STATUS OPERATIONS ON PHYSICAL MEMORY
;1/ FLAGS(FUTURE),,FUNCTION CODE
;2/ +ARGLIST LENGTH
;3/ ARGLIST ADDRESS
; PMCTL
;RETURNS+1:
; FUNCTION PERFORMED/INFORMATION RETURNED
;ITRAPS ON ASSORTED ERRORS
;AC USAGE WITHIN PMCTL:
;Q1/ FUNCTION CODE
;Q2/ ARGLIST LENGTH
;Q3/ ARGLIST
;THE VALUES IN Q1-3 ARE VALIDATED IN THE ENTRY SEQUENCE
.PMCTL::MCENT
MOVE T1,CAPENB ;GET ENABLED SPECIAL CAPABILITIES
TXNN T1,SC%WHL!SC%OPR!SC%MNT ;APPROPRIATE CAPABILITIES?
ITERR (CAPX2) ;NO
UMOVE Q1,1 ;GET FUNCTION CODE
JUMPL Q1,PMCILF ;CHECK IF VALID
CAILE Q1,PMCMXF ; ...
PMCILF: ITERR (ARGX02) ;INVALID FUNCTION
UMOVE Q2,2 ;GET ARGLIST LENGTH
HLRZ T1,PMCDSP(Q1) ;GET MINIMUM REQUIRED
CAMLE T1,Q2 ;GREATER THAN REQUIRED?
ITERR (ARGX04) ;NO - TOO SMALL
UMOVE Q3,3 ;GET ARGUMENT LIST ADDRESS
HRRZ T1,PMCDSP(Q1) ;GET FUNCTION DISPATCH
JRST (T1) ;AND DO IT
;FUNCTION TABLE - ENTRIES ARE XWD MIN ARGLIST,FUNCTION
PMCDSP: XWD 1,PMCRCE ;READ CACHE ENABLE
XWD 1,PMCSCE ;SET CACHE ENABLE
XWD 2,PMCRPS ;READ SPECIAL PAGE STATUS
XWD 2,PMCSPS ;SET SPECIAL PAGE STATUS
XWD 12,PMCRME ;READ MEMORY ERROR INFORMATION
PMCMXF==.-PMCDSP-1 ;MAXIMUM FUNCTION CODE
;HERE TO RETURN THE STATE OF THE CACHE ENABLES
PMCRCE: SKIPE T1,CASHF ;ZERO IF OFF
MOVX T1,MC%CEN ;NONZERO IF ON
UMOVEM T1,.MCCST(Q3) ;STORE RESULT
MRETNG
;HERE TO SET THE CACHE ENABLES. IF THE CURRENT STATE IS THE SAME AS
;THE REQUESTED STATE, NOTHING IS DONE (PREVENTING USELESS UNLOADS)
PMCSCE: UMOVE T1,.MCCST(Q3) ;GET USERS REQUESTED STATE
TXNN T1,MC%CEN ;WANT CACHE ON?
JRST PMCSC1 ;NO.
SKIPN CASHF ;YES - IS IT ALREADY ON?
CALL CASHON ;MUST TURN IT ON NOW
MRETNG
PMCSC1: SKIPE CASHF ;WANT CACHE OFF, IS IT?
CALL CASHOF ;NO - DO IT NOW
MRETNG
;HERE TO READ THE SPECIAL PAGE STATUS OF A PHYSICAL PAGE
PMCRPS: UMOVE T1,.MCPPN(Q3) ;GET USER'S ARGS
HLRE T2,T1 ;GET REPEAT COUNT OF PAGES
MOVMS T2 ;GET COUNT GIVEN BY USER
CAIGE Q2,1(T2) ;ENOUGH ROOM FOR ARGS?
ITERR (ARGX04) ;NO. GIVE ERROR THEN
MOVE Q2,T1 ;YES. PROCEED
MOVE P1,Q3 ;COPY ARG
PMCRP1: HRRZ T1,Q2 ;GET PAGE NUMBER
CALL GETPST ;CALL KERNAL ROUTINE
ITERR(ARGX06,<UMOVEM Q2,.MCPPN(Q3)>) ;INVALID PAGE NUMBER
UMOVEM T2,.MCPST(P1) ;STORE RESULT
ADDI P1,1 ;NEXT OFFSET
AOBJN Q2,PMCRP1 ;DO ALL REQUESTED PAGES
MRETNG
;HERE TO SET THE SPECIAL PAGE STATUS OF A PHYSICAL PAGE
PMCSPS: UMOVE T1,.MCPPN(Q3) ;GET USERS PAGE NUMBER
UMOVE T2,.MCPST(Q3) ;GET NEW SPECIAL PAGE STATE
CALL SETPST ;CALL KERNAL ROUTINE
ITERR () ;ERROR CODE IN T1
MRETNG ;SUCCESS
;HERE TO READ INFORMATION ABOUT SYSTEM MEMORY ERRORS
PMCRME: SETZM P1 ;NO ENTRIES FOUND YET
PMCRM1: MOVEI T1,.PMMER ;GET A MEMORY ERROR ENTRY
CALL DEQERR ;GET IT
JRST [ JUMPN P1,PMCRM0 ;IF FOUND SOME, NOW DONE
ITERR (PMCLX4)] ;OTHERSWISE, ERROR
LOAD T2,SBSCN,(T1) ;GET CONTROLLER
HRLI T2,<.PMMER_^D9>+12 ;TYPE AND COUNT
UMOVEM T2,.PMMTP(Q3) ;STORE IN USER SPACE
MOVE T2,SBSERA(T1) ;GET ERG
UMOVEM T2,.PMMRG(Q3) ;STORE IT
LOAD T2,SBSSY,(T1) ;SYNDROME
UMOVEM T2,.PMMSY(Q3)
LOAD T2,SBSBN,(T1) ;BLOCK NUMBER
UMOVEM T2,.PMMBN(Q3)
LOAD T2,SBSSB,(T1) ;SPARE BIT NUMBER
UMOVEM T2,.PMMSB(Q3)
MOVE T2,SBSEAD(T1) ;ERROR ADDRESS
UMOVEM T2,.PMMEA(Q3)
PUSH P,T1 ;SAVE BLOCK NUMBER
XMOVEI T2,SBSSER(T1) ;FIRST SERIAL NUMBER
MOVEI T3,.PMMSN(Q3) ;USER ADDRESS
MOVEI T4,.PMMNS ;REPEAT COUNT
PMCRM2: LDB T1,[POINT ^D32,0(T2),31] ;GET SERIAL NUMBER
UMOVEM T1,0(T3) ;STORE IN USER SPACE
ADDI T3,1 ;NEXT USER ADDRESS
ADDI T2,1 ;NEXT SERIAL NUMBER
SOJG T4,PMCRM2 ;DO ALL SERIAL NUMBER
POP P,T1 ;BLOCK ADDRESS
CALL RELRES ;FREE IT
SUBI Q2,12 ;USED THIS MANY WORDS
ADDI Q3,12 ;AND NOW POINT HERE
CAIL Q2,12 ;ROOM FOR ANOTHER?
AOJA P1,PMCRM1 ;YES. GET IT
PMCRM0: UMOVEM Q2,2 ;UPDATED COUNT
UMOVEM Q3,3 ;UPDATED POINTER
MRETNG ;DONE
;JSYS TO SET AND READ ARGUMENTS FOR A PROCESS
;ACCEPTS IN 1/ FUNCTION CODE ,, FORK HANDLE
; 2/ ADR OF ARG BLOCK
; 3/ LENGTH OF ARG BLOCK
; PRARG
;RETURNS +1: ALWAYS
; 3/ COUNT OF WORDS IN ARGUMENT BLOCK
.PRARG::MCENT
CALL FLOCK ;LOCK THE FORK STRUCTURE
UMOVE Q2,2 ;GET ADR OF ARG BLOCK
XCTU [HRRZ Q3,3] ;GET LENGTH OF BLOCK
XCTU [HRRZ T1,1] ;GET FORK HANDLE
CALL SETLFK ;MAP IN PSB OF THIS FORK
MOVE Q1,T1 ;SAVE INDEX FOR LATER
XCTU [HLRZ T1,1] ;GET FUNCTION CODE
CAIN T1,.PRARD ;READ?
JRST PRARGR ;YES, GO RETURN BLOCK
CAIE T1,.PRAST ;SET?
ITERR (PRAX1,<CALL CLRLFK
CALL FUNLK>) ;NO, GIVE ERROR RETURN
MOVE T2,PRARGP(Q1) ;IS THERE AN EXISTING BLOCK?
JUMPE T2,PRARG1 ;NO IF ZERO
SETZM PRARGP(Q1) ;ZERO THE OLD POINTER
CALL PRARGF ;RELEASE OLD SPACE
PRARG1: JUMPE Q3,PRARGC ;JUST CLEARING THE ARG BLOCK?
MOVE T2,Q3 ;NO, GET SOME SPACE FOR NEW BLOCK
CAILE T2,PRAMAX ;IS THIS A LEGAL SIZE?
ITERR (PRAX3,<CALL CLRLFK
CALL FUNLK>) ;NO, PRARG BLOCK TOO LARGE
AOS T2 ;ADD ONE FOR HEADER
CALL ASGJFR ;GET SPACE IN JSB
ITERR (PRAX2,<CALL CLRLFK
CALL FUNLK>) ;NOT ENOUGH ROOM FOR THIS SIZE BLK
MOVEM T1,PRARGP(Q1) ;STORE ADR OF BLOCK IN PSB
PRARSL: UMOVE T3,0(Q2) ;GET FIRST WORD OF BLOCK
AOS T1 ;STEP POINTER TO FREE BLOCK
AOS Q2 ;AND POINTER TO USER BLOCK
MOVEM T3,0(T1) ;STORE WORD IN BLOCK
SOJG Q3,PRARSL ;LOOP UNTIL ALL WORDS STORED
PRARGC: CALL CLRLFK ;UNMAP PSB
CALL FUNLK
JRST MRETN ;AND EXIT
;RELEASE PRARG'S JSB BLOCK (CALLER MUST BE NOINT)
;
; 2/ POINTER TO THE BLOCK
PRARGF::MOVEI T1,JSBFRE ;GET FREE SPACE HEADER
CALLRET RELFRE ;RELEASE THE SPACE
;READ ARGUMENT BLOCK
PRARGR: XCTU [SETZM 3] ;ASSUME NO DATA AVAILABLE
SKIPN T1,PRARGP(Q1) ;GET POINTER TO BLOCK IF ANY
JRST PRARRD ;NONE, GO RETURN 0
HRRZ T2,0(T1) ;GET LENGTH OF BLOCK
SOJLE T2,PRARRD ;SKIP HEADER WORD
UMOVEM T2,3 ;STORE COUNT OF WORDS AVAILABLE
PRARRL: SOJL Q3,PRARRD ;ANY MORE TO DO?
MOVE T3,1(T1) ;YES, GET NEXT WORD
UMOVEM T3,0(Q2) ;STORE WORD IN USER BLOCK
AOS T1 ;STEP POINTER TO JSB BLOCK
SOSLE T2 ;ANY MORE WORDS IN BLOCK?
AOJA Q2,PRARRL ;YES, GO STORE THEM
PRARRD: CALL CLRLFK ;UNMAP PSB
CALL FUNLK
JRST MRETN ;AND RETURN
; Release device
; 1/ DEVICE DESIGNATOR, OR -1 TO RELEASE ALL DEVICES
; RELD
; Returns
; +1 ; Error, bad designator or not assigned to this job
; +2 ; Ok.
.RELD:: MCENT
STKVAR <RELDSV,RELDIX>
MOVEM T1,RELDSV ;SAVE DEVICE DESIGNATOR
RELD1: CALL LCKDVL ;LOCK DEVICE LOCK, GO NOINT
CAMN 1,[-1] ;ALL ASSIGNED DEVICES?
JRST RELDAL ;YES. GO DO THEM
CALL CHKDEV ;DO WE HAVE ACCESS TO THIS DEVICE?
RETERR(,<UNLOCK DEVLCK>) ;NO.
MOVEM T2,RELDIX ;SAVE INDEX TO DEVICE TABLES
HLRZ T1,DEVUNT(T2) ;GET OWNING JOB
CAIN T1,-1 ;IS THERE ONE?
JRST RELD2 ;NO. DON'T BOTHER TO DEASSIGN IT
CALL RELDEV ;GO RELEASE THIS DEVICE
JRST RELDWT ;FAILED
;**;REMOVE 1 LINE AT RELD1:+11L TAM 3-MAR-83
;[2923] HRRZ P3,P4 ;DEVICE ONLY
MOVE T2,RELDIX ;T2/ INDEX TO DEVICE TABLES
CALL DSMNT0 ;AND DISMOUNT DEVICE
JFCL
RELD2: UNLOCK DEVLCK
OKINT
SMRETN
;RELEASING ALL DEVICES ASSIGNED TO THIS JOB
RELDAL:
MOVSI Q1,-NDEV ;SET UP AOBJN POINTER
RELDA3: MOVE B,Q1 ;SET UP FOR CALL TO RELDEV
HLRZ A,DEVUNT(B) ;GET OWNING JOB
CAME A,JOBNO ;THIS JOB?
JRST RELDA4 ;NO. ON TO NEXT DEVICE
CALL RELDEV ;YES. RELEASE IT
JRST RELDWT ;FAILED. GO WAIT UNTIL IT CAN SUCCEED
;**;[2923]REPLACE 1 LINE AT RELDA3:+6L TAM 3-MAR-83
;[2923] HRRZ P3,P4 ;ADDRESS ONLY
HRRZ T2,Q1 ;[2923] GET INDEX AGAIN
CALL DSMNT0 ;AND DISMOUNT DEVICE
JFCL
RELDA4: AOBJN Q1,RELDA3
JRST RELD2 ;GO UNLOCK AND EXIT
;FAILED TO RELEASE THE DEVICE. WAIT IF NECESSARY
RELDWT: TXZN T1,1B0 ;NEED TO WAIT?
RETERR (,<UNLOCK DEVLCK
OKINT>) ;NO. FAIL
UNLOCK DEVLCK ;YES. UNLOCK DEVICE TABLES
OKINT ;LET USER CTRL/C OUT
HRL T1,T2 ;T1/ (LINE NUMBER,,ADDRESS)
MDISMS ;WAIT UNTIL IT'S POSSIBLE
MOVE T1,RELDSV ;RESTORE DEVICE DESIGNATOR
JRST RELD1 ;GO TRY AGAIN
;RELDEV - RELEASE DEVICE AND SEND MESSAGE TO ALLOCATOR IF NECESSARY
;ACCEPTS:
; T2/ INDEX TO DEVICE TABLES
; CALL RELDEV
;RETURNS +1: FAILED
; T1/ ERROR CODE
; OR
; 1B0 + ADDRESS OF SCHEDULER ROUTINE FOR DISMS
; +2: SUCCEEDED
RELDEV::STKVAR <RELDIX>
LDB D,[POINT 9,DEVCHR(B),17] ;GET DEVICE TYPE NUMBER
MOVX C,DV%OPN
TDNE C,DEVCHR(B) ;IS DEVICE OPENED?
RETBAD (DEVX6) ;TCO 4.2022 YES, RETURN ERROR
HRRZ C,DEVUNT(B) ;GET THE UNIT NUMBER
ANDI C,DV%UNT ;MASK UNIT
CAIN C,DV%UNT ;CHECK FOR -1
MOVEI C,-1 ;SET -1
CAIN D,.DVTTY ;IS THIS A TTY?
JRST RELDD3 ;YES. GO DO SPECIAL PROCESSING
RELDD0: HRRZ C,DEVDSP(B) ;GET TYPE OF THIS DEVICE
CAIN C,MTDTB ;IS THIS AN MT DEVICE?
CALL RELDMT ;YES. DO PROPER CLEAN UP THEN
MOVX C,DV%ASN ;INDICATE NO LONGER ASSIGNED
ANDCAM C,DEVCHR(B)
MOVE D,DEVCH1(B) ;GET CHARACTERISTICS WORD
MOVEI C,-1 ;SET UP TO RETURN DEVICE TO FREE POOL
TLNE D,(D1%ALC) ;IS THIS DEVICE AN ALLOCATED DEVICE
MOVEI C,-2 ;YES, RETURN IT TO ALLOCATOR
HRLM C,DEVUNT(B) ;MARK THAT DEVICE IS FREE
TLNN D,(D1%ALC) ;ALLOCATED DEVICE?
JRST RELDD1 ;NO, DONT PUT IN MESSAGE
MOVE A,DEVCHR(B) ;SET UP DEVICE DESIGNATOR
TLZ A,777000
TLO A,.DVDES
HRR A,DEVUNT(B) ;GET UNIT NUMBER
CALL ALCMES
JFCL
RELDD1: RETSKP
RELDD3: CAMN C,CTRLTT ;YES. IS IT THIS JOB'S CONTROLLING TTY?
RETSKP ;YES. DON'T DEASSIGN IT
MOVEM B,RELDIX ;SAVE INDEX TO DEVICE TABLES
MOVE B,C ;B/ TERMINAL NUMBER
CALL TTYDEA ;DEALLOCATE ITS DYNAMIC DATA
RETBAD ;FAILED. RETURN FAILURE
RELDD4: MOVE B,RELDIX ;RESTORE INDEX TO DEVICE TABLES
JRST RELDD0 ;FINISH PROCESSING
; Reset jsys
; Call: RESET
; Closes all files, resets tty status etc
.RESET::MCENT
MOVNI A,4
KFORK ; Kill all inferior forks
MOVE A,FORKX ; GET FORK NUMBER OF THIS FORK
CALL PIDRFK ; GO DELETE TEMPORARY PIDS OF THIS FORK
MOVE A,FORKX
CALL ENQFKR ; DEQ ALL ENQ'D REQUESTS FOR THIS FORK
SKIPE SNPPGS ; THIS FORK HAVE ANY BREAK POINTS IN?
CALL SNPREL ; YES, GO RELEASE THEM
SKIPGE CTRLTT
JRST RSTFK ; Skip tty reset if not ctrltt
MOVEI A,101
MOVE B,NORMTF ; Normal modes
SFMOD
RSTFK: MOVEI A,400000
CIS
DIR
SETZB T2,T3 ;ZERO BOTH INTERRUPT AND DEFERRED WORD MASK
STIW
MOVNI 2,1
DIC
;**;[3001] Add one line at RSTFK: + 7L TAB 22-AUG-83
SETZM ARTHTR ;[3001]CLEAR ARITH TRAP SET BY SWTRP%
MOVE 1,[CZ%ABT+400000] ;SAY DELETE NONX FILES
CLZFF
RWSET ;RELEASE WORKING SET
SKIPL PATADR ;FORCED NON-COMPATIBILITY?
SETZM PATADR ;NO, CLEAR COMPAT ENTRY VECTOR
MOVNI A,1 ;SET UP TO RELEASE ALL HANDLES
RFRKH ;FREE FORK HANDLES
JFCL ;?
SETZM JTTRW ;CLEAR JSYS TRAP WORD
MOVEI T1,77 ;UNASSIGNED CHANNEL
STOR T1,JTMCN ;TO JSYS TRAP PSI CHANNEL
SETOM JTLCK ;CLEAR JSYS TRAP LOCK
;**;[2007] Add 1 and change 1 line at RSTFK: +19L JGZ 21-MAR-82
CALL NETKFK ;[2007] RESET ARPANET CONNECTIONS
MRETNG ;[2007] DONE
; Read control character output control
.RFCOC::MCENT
CALL CHKTTR
JRST RFCOC1
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
CALL TTRCOC
UMOVEM 1,2
UMOVEM 3,3
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
RFCOC1: MOVE A,[BYTE (2)2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
UMOVEM A,2
UMOVEM A,3
JRST MRETN
;RFMOD JSYS - Read TERMINAL mode
;ACCEPTS:
; T1/ SOURCE DESIGNATOR
; RFMOD
;RETURNS +1: ALWAYS,
; T2/ JFN MODE WORD
;NOTE: IF T1 POINTS TO A NON-TERMINAL, CERTAIN DEFAULTS ARE RETURNED
;IN PARTICULAR, WHEN CHKTTR FAILS, AC 'STS' HAS, IN BITS 32-35
;THE MODE BITS FROM THE OPENF. SINCE STS=P1, THIS CODE RETURNS BITS 32-35 IN P1
.RFMOD::MCENT
SETZ P1, ;INITIALIZE P1 TO 0
CALL CHKTTR
JRST RFMOD1
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAILED
CALL TTRMOD
UMOVEM 1,2
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
RFMOD1: MOVE A,P1
ANDI A,17
ADD A,[^D66B10+^D72B17+^D7B3]
UMOVEM A,2
JRST MRETN
; Read file position
.RFPOS::MCENT
CALL CHKTTR
JRST [ XCTU [SETZM 2]
JRST MRETN]
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAILED
CALL TTRPOS
CALL ULKTTY ;ALLOW DEALLOCATION
UMOVEM 1,2
JRST MRETN
; Read map
; Call: LH(1) ; Fork handle
; RH(1) ; Page number
; RMAP
; Retrn
; +1
; LH(1) ; Jfn
; RH(1) ; Page number
; 2 ; Access read, write,execute,nonexistent in bits 2-5
.RMAP:: MCENT
TRVAR <<DUMMY,3>,JF1> ;MUST MATCH TRAVR IN PMAP
SETZM JF1
;**;[1766] Add one line at .RMAP: +3L JGZ 26-AUG-80
CALL FLOCKN ;[1766] LOCK THE FORK LOCK
;**;[1924] Change 1825 lines at .RMAP: +4L JGZ 18-AUG-81
;**;[1825] Change two lines at .RMAP: +4L RAS 6-JAN-81
CALL FKHPTN ;[1825] Convert frk.pn to ptn.pn
ITERR (,<CALL FUNLK>) ;[1825] FAILED, FREE FORK LOCK.
CALL MRPT ; Call map routine
JRST RMAPFK
PUSH P,B
CALL OFNJFN
RMAP0: SETO A, ; Unidentifiable
RMAP1: POP P,B
UMOVEM A,1
UMOVEM B,2
;**;[1766] Change at RMAP1: +3L JGZ 26-AUG-80
CALL FUNLK ;[1766] FREE THE FORK STRUCTURE LOCK
MRETNG ;[1766] RETURN
RMAPFK: PUSH P,B
JUMPE A,RMAP0
CALL PTNFKH
;**;[1766] Change one line at RMAPFK: +3L JGZ 26-AUG-80
ITERR (,<CALL FUNLK>) ;[1766] FAILED, FREE FORK LOCK.
JRST RMAP1
; Read accessiblity of page
; Call: LH(A) ; Fork or file handle
; RH(A) ; Page number
; RPACS
.RPACS::MCENT
TRNE 1,777000 ;DOES THE PAGE NUMBER SAY "LONG FILE"?
SKIPGE 1 ;IS THIS FORK HANDLE?
JRST RPACS1 ;YES - THEN SHORT FILE IS ASSUMED
HLRZS A ;NO - USER ASKING FOR LONG FILE
;**;[1779] Add two lines at .RPACS: +5L JGZ 4-SEP-80
CAML T1,MAXJFN ;[1779] COULD IT BE A GOOD JFN?
ITERR (DESX3) ;[1779] NO WAY
IMULI A,MLJFN ; CONVERT TO INTERNAL INDEX
MOVE A,FILSTS(A)
TXNN A,LONGF ;IS FILE LONG?
RPACS0: JRST [ XCTU [SETZM 2] ;NO - File not long
JRST MRETN]
UMOVE 1,1 ;YES - RESTORE USER AC1
RPACS1: TRVAR <<DUMMY,3>,JF1> ;MUST MATCH TRVAR IN PMAP
SETZM JF1 ;NO STR LOCK YET
SETZ B, ;NO PT CREATES PLEASE
REPEAT 0,< ;DON'T USE THIS NOW
JUMPL T1,[CALL CHKADR ;CHECK ON THE ADDRESS
ITERR (ARGX06) ;NOT WITHIN RANGE
CALL FKHPTA ;GET I.D. OF PAGE
JRST RPACS0 ;NON-EX SECTION
JRST RPACS2] ;PROCEED
> ;END OF REPEAT 0
CALL CPMAP ;GET PAGE IDENT AND ACCESS
MOVEM D,JF1 ;PAGE IN DISK FILE - MUST RELEASE THIS STR LOCK
RPACS2: SKIPE T1 ;FOUND A MATCH?
CALL MRPACS ;READ THE PAGE ACCESSIBILITY
UMOVEM 1,2
SKIPE A,JF1 ;SEE IF A STR LOCK TO RELEASE
CALL LUNLK0 ;YES. GO DO IT
JRST MRETN
;LOCAL ROUTINE TO CHECK VALIDITY OF PROCESS PAGE
; T1/ FH.PTN
CHKADR: LDB T2,[POINT 9,T1,26] ;GET PAGE NUMBER
CAILE T2,(VSECNO) ;A VALID SECTION?
RET ;NO
RETSKP ;YES
; Set last error
; Accepts 1: Flags,,fork designator
; 2: Error code
; 4-10: For ERRSAV if B0 of 1 is on
; Returns
; +1 Always
.SETER::MCENT
CALL FLOCK ; Lock things down
MOVE P1,T1 ; Flags,,fork
MOVE P2,T2 ; Error code
HRRZS T1 ; Just fork handle
CALL STJFKR ; Get job fork index
ITERR FRKHX1,<CALL FUNLK> ; Bad handle
CALL SKIIF ; Must be self or lower
ITERR FRKHX2,<CALL FUNLK>
CALL CHKNXS ; Make sure not execute-only unless SELF
MOVE P3,T1 ; Save fork's job index
CALL SETLF1 ; Map PSB
MOVE Q1,T1 ; Save offset to PSB of fork
TLNE P1,(1B0) ; Not setting ERRSAV?
CAMN P3,FORKN ; Or me?
JRST SETE1 ; Yes
MOVES PSBPGA(Q1) ; Touch it, going NOSKED
NOSKED
HRRZ 7,SYSFK(P3) ; Get FORKX (7 is Q3 or FX)
CALL CHKWT ; Must not be running
JRST SETE3 ; Which he is
SETE1: MOVEM P2,LSTERR(Q1) ; Save into PSB
TLNN P1,(1B0) ; Doing ERRSAV?
JRST SETE2 ; No
MOVEI T1,10-4 ; # of words to copy
MOVEI T2,4 ; From user acs
MOVEI T3,ERRSAV(Q1)
CALL BLTUM
CAMN P3,FORKN ; Me?
JRST SETE2 ; Yes
OKSKED
SETE2: CALL CLRLFK ; Unmap PSB
CALL FUNLK
MRETNG
SETE3: OKSKED
CALL CLRLFK
ITERR FRKHX4,<CALL FUNLK> ; Moving violation
; SET JOB PARAMETERS
;ACCEPTS IN 1/ JOB NUMBER
; 2/ FUNCTION CODE
; 3/ VALUE OR POINTER TO ARG BLOCK
; SETJB
;RETURNS +1: ALWAYS
.SETJB::MCENT
SETZ T4, ;LOCAL FLAG AC
UMOVE T1,1 ;GET JOB NUMBER
CAMN T1,[-1] ;SELF?
MOVE T1,JOBNO ;YES, GET OWN JOB NUMBER
SKIPL T1 ;CHECK FOR LEGALITY
CAIL T1,NJOBS
ITERR (SJBX4) ;ILLGEAL JOB NUMBER
SKIPGE JOBRT(T1) ;JOB LOGGED IN?
ITERR (SJBX5) ;NO, JOB NOT LOGGED IN
CAME T1,JOBNO ;OUR OWN JOB?
JRST [ MOVE T2,CAPENB ;NO, CHECK FOR PROPER PRIVILEGES
TXNN T2,SC%WHL!SC%OPR
ITERR (SJBX6) ;NOT PRIVILEGED
JRST STJB1] ;OK
TXO T4,SJ%OWN ;SETTING PARAMETERS IN OUR OWN JOB
STJB1: CALL SETJSB ;MAP IN JSB OF JOB
MOVEM T1,P1 ;SAVE JSB OFFSET
XCTU [HRRZ T2,2] ;GET FUNCTION CODE
UMOVE T3,3 ;GET VALUE
CAIL T2,MAXSJF ;LEGAL FUNCTION CODE?
ITERR (SJBX1,<CALL CLRJSB>) ;ILLEGAL FUNCTION CODE
TXNN T4,SJ%OWN ;OUR OWN JOB?
CALL SJBCHK ;NO, SEE IF JOB CAN DO THIS FUNCTION
XCT SJBTAB(T2) ;PERFORM THE FUNCTION
CALL CLRJSB ;UNMAP JSB
JRST MRETN ;SUCCESSFUL
SJBCHK: SKIPN SJBTBF(T2) ;CAN THE JOB PERFORM THIS FUNCTION?
ITERR (SJBX8,<CALL CLRJSB>) ;NO
RET ;YES, GO DO IT
SJBDEN: SKIPL T3 ;NEGATIVE VALUE IS ILLEGAL
CAILE T3,MTMXDN ;LEGAL DENSITY?
ITERR (SJBX2,<CALL CLRJSB>) ;ILLEGAL DENSITY
STOR T3,JSMTD,(T1) ;STORE DENSITY
RET
;SET TOPS20 COMMAND LEVEL
SJBT20: JUMPE T3,SJBT1 ;IF 0, IT'S O.K.
CAME T3,[-1] ;IF -1, IT'S O.K.
ITERR (SJBX1) ;OTHERWISE "INVALID FUNCTION"
SJBT1: STOR T3,JBT20,(T1) ;STORE NEW VALUE
RET
SJBDM: SKIPL T3 ;DONT ALLOW NEGATIVE VALUES
CAILE T3,MTMXDM ;LEGAL DATA MODE?
ITERR (SJBX3,<CALL CLRJSB>) ;ILLEGAL DATA MODE
STOR T3,JSMTM,(T1) ;YES, SAVE DATA MODE
RET
;SET JOB LOGICAL LOCATION
SJBLL: STKVAR <<SJNAM,WPN>,UNP>
MOVEM C,UNP ;REMEMBER USER POINTER TO NODE NAME
MOVE A,C ;GET USER POINTER TO NAME
MOVEI B,SJNAM ;WE'LL READ PARSED NODE NAME INTO THIS BUFFER
CALL PARNDU ;VERIFY THAT NAME IS KOSHER
ITERR ;IT'S NOT, GIVE REASON TO CALLER
UMOVEM A,C ;GIVE USER UPDATED POINTER
MOVEI A,WPN ;TRANSFER MAXIMUM WORDS ALLOWED PER NODE NAME
MOVEI B,SJNAM ;TRANSFER FROM OUR BUFFER
MOVEI C,LLSR(P1) ;TO APPROPRIATE JOB'S BUFFER IN JSB
CALLRET XBLTA ;TRANSFER THE DATA
; SET JOB SESSION REMARK
SJBSRM: MOVE T1,T3 ;USER'S POINTER TO STRING
CALL CPYFUS ;GET THE STRING
ITERR (MONX02,<CALL CLRJSB>)
UMOVEM T3,3 ;RETURN USER'S UPDATED POINTER
HRRZ T2,T1 ;POINTER TO STRING
MOVE T4,T1 ;SAVE IT IN T4 FOR NOW
MOVEI T1,MAXLW+1 ;STRING LENGTH
MOVEI T3,JSSRM(P1) ;SAY WHERE TO PUT REMARK
CALL XBLTA ;PUT STRING IN THE JSB
MOVEI T1,JSBFRE
MOVE T2,T4 ;FREE UP JSB FREE SPACE FOR STRING
CALL RELFRE
OKINT ;CPYFUS WENT NOINT
;**;[3078] Add 1 line at SJBSRM+13 DEE 5-MAR-84
;**;[3182] Remove previous edit DEE 14-NOV-84
RET
;
; SET JOB BATCH STREAM NUMBER AND FLAGS
;
SJBBAT: MOVX T1,SC%OPR!SC%WHL ;WHEEL AND OPR ONLY
TDNN T1,CAPENB
ITERR (SJBX6) ;NOT ENOUGH CAPS
MOVEM T3,BATSTF(P1) ;SAVE NEW FLAGS
RET ;RETURN OK
; Set control character output control
.SFCOC::MCENT
;**;[1844] Replace two lines and revamp at .SFCOC: +1L JGZ 14-APR-81
CALL CHKTTR ;[1844] IS THIS A TERMINAL?
MRETNG ;[1844] NO, THEN THIS IS A NOOP
CALL CHKTTY ;[1844] CAN WE ACCESS THE TERMINAL?
;**;[3040] Replace one line at .SFCOC:+4L CRJ 8-Nov-83
ITERR (DESX2) ;[1844][3040] No, return proper error
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
UMOVE 1,2
UMOVE 3,3
CALL TTSCOC
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
; Set file modes
;
.SFMOD::MCENT
;**;[1844] Replace two lines and revamp at .SFMOD: +1L JGZ 14-APR-81
CALL CHKTTR ;[1844] IS THIS A TERMINAL?
MRETNG ;[1844] NO, THEN THIS IS A NOOP
CALL CHKTTY ;[1844] CAN WE ACCESS THE TERMINAL?
EMRETN () ;[1844] NO, SO RETURN ERROR
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
UMOVE 1,2
CALL TTSMOD
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
; Set file position
.SFPOS::MCENT
;**;[1844] Replace two lines and revamp at .SFPOS: +1L JGZ 14-APR-81
CALL CHKTTR ;[1844] IS THIS A TERMINAL?
MRETNG ;[1844] NO, THEN THIS IS A NOOP
CALL CHKTTY ;[1844] CAN WE ACCESS THE TERMINAL?
EMRETN () ;[1844] NO, SO RETURN ERROR
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
ITERR (TTYX01,<CALL ULKTTY>) ;NOT ACTIVE. FAIL
UMOVE 1,2
CALL TTSPOS
CALL ULKTTY ;ALLOW DEALLOCATION
JRST MRETN
;SMAP JSYS - SET USER SECTION MAP
;ACCEPTS:
; T1/ SOURCE I.D.
; (FORK HANDLE,,SECTION NUMBER) TO MAP A FORK'S SECTION
; (JFN,,SECTION NUMBER) TO MAP A FILE'S SECTION
; 0 TO CREATE A PRIVATE SECTION
; -1 TO DELETE A SECTION
; T2/ FORK HANDLE,,SECN OF DESTINATION
; T3/ ACCESS,,COUNT
; SMAP
;RETURNS +1: ALWAYS
;ILLEGAL INSTRUCTION TRAP ON ERROR
;RIGHT HALF OF T2 MUST BE NON-ZERO
;IF T1 IS (FORK HANDLE,,SECTION NUMBER), SECTION NUMBER MUST BE ZERO
;AND COUNT MUST BE 1
;THIS CODE CLEARS THE MAP BEFORE CHECKING THE NEW SOURCE. THEREFORE
;ONE MAY GET AN ERROR AND HAVE THE MAP CLEARED
;USE OF AC'S:
; P3/ NUMBER OF SECTIONS (DECREMENTED IN LOOP)
; P4/ DESTINATION (SPT INDEX OF PSB,,SECTION NO) (INCREMENTED IN LOOP)
; P5/ (JFN,,OFN) OR 0
; Q1/ SECTION NUMBER FOR SOURCE
; Q2/ DESTINATION ID (SPT INDEX OF PSB,,SECTION NO.)
; Q3/ ACCESS,,COUNT FROM USER'S AC 3
;NOTE: FOR RELEASE 4, ONLY CREATION AND DELETION OF PRIVATE SECTION
;ARE SUPPORTED. CODE FOR FORK-TO-FORK (SECTION 0 ONLY) AND FORK-TO-FILE
;MAPPING EXISTS BUT IS NOT GUARANTEED TO WORK.
.SMAP:: MCENT
CALL CKXADR ;EXT ADDRESSING SUPPORTED?
iterr () ;no - return error to user
SKIPE T1 ;ALLOW CREATION OF PRIVATE SECTION
CAMN T1,[-1] ;ALLOW UNMAP
SKIPA
ITERR (ARGX23) ;DON'T ALLOW OTHERS
DMOVE Q2,T2 ;SAVE DESTINATION AND ACCESS
HRRZ Q1,T1 ;SAVE SECTION # OF SOURCE
;CHECK ARGUMENTS
HRRZS T2 ;GET SECTION # ONLY
SKIPG T2 ;NON-ZERO SECTION?
ITERR (ARGX23) ;NO. ILLEGAL THEN
TRNN T3,-1 ;NON-ZERO COUNT?
ITERR (ARGX24) ;NO. CAN'T DO IT THEN
ADDI T2,-1(T3) ;COMPUTE LAST SECTION USED
CAILE T2,MXSECN ;VALID?
ITERR (ARGX23) ;NO.
;VERIFY DESTINATION PROCESS AND GET SPT INDEX FOR PSB
HLRZ T1,Q2 ;GET FORK HANDLE FOR DESTINATION
CALL FLOCKN ;LOCK THE FORK STRUCTURE, ALLOW NESTING
CALL STJFKR ;GET JOB-WIDE HANDLE
ITERR (,<CALL FUNLK>) ;ERROR
HRRZ T1,SYSFK(T1) ;GET SYSTEM-WIDE HANDLE
HRL Q2,FKPGS(T1) ;SAVE PSB I.D.
;..
;DELETE THE CURRENT ENTRIES FOR THESE SECTIONS (IF ANY)
; Q2/ SPT INDEX FOR PSB,,SECTION NUMBER
; Q3/ ACCESS,,COUNT
;..
HRRZ P3,Q3 ;ISOLATE COUNT
MOVE P4,Q2 ;GET PSB,,SECTION NO.
SETZM P5 ;INIT FILE REG
SMAP0: MOVE T1,P4 ;GET PSB,,SEC
CALL CHKMAP ;SEE IF A PRIVATE SECTION
JRST [ JUMPE T1,SMAP5 ;IF NO ENTRY, JUMP OFF
SETOM T1 ;PRIVATE SECTION. INDICATE UNMAP
HRRZ T2,P4 ;GET SECTION NUMBER
LSH T2,PGSFT ;MAKE IT PAGE 0 OF THIS SECTION
XCTU [HLL T2,T2] ;GET FORK HANDLE AGAIN
MOVE T3,[PM%CNT+1000] ;THE WHOLE SECTION
PMAP ;CLEAR THE MAP
ERJMP .+1 ;CLEAR THE SECTION POINTER ANYWAY
JRST .+1]
MOVE T1,P4 ;GET BACK ARG AGAIN
CALL SECJFN ;SEE IF A JFN
JRST SMAP2 ;NOT
MOVE P5,T1 ;SAVE OFN
HRL P5,T2 ;SAVE JFN
;SECTION IS MAPPED TO ANOTHER PROCESS OR A FILE
;P5/ (JFN,,OFN) OR 0 IF NOT A FILE
SMAP2: SETZM T1 ;SAY DELETE
MOVE T2,P4 ;GET (PSB INDEX,,SECTION NO.)
CALL SECMAP ;CLEAR SECTION
ITERR (,<CALL FUNLK>) ;STILL SHARED
JUMPE P5,SMAP5 ;A FILE?
HRRZ T1,P5 ;YES. GET OFN THEN
CALL RELOFN ;FREE IT
HLRZ T1,P5 ;GET JFN
MOVX T2,<-2>B17 ;GET DECREMENTER
IMULI T1,MLJFN ;GET INDEX INTO JSB
ADDM T2,FILLFW(T1) ;DISCOUNT THIS MAPPING
SETZM P5 ;AND INIT REGISTER FOR NEXT TRY
SMAP5: ADDI P4,1 ;NEXT I.D.
SOJG P3,SMAP0 ;DO ALL SECTION
JRST SMAP8
;ALL SECTIONS CLEAR. DO NEW MAPPING
SMAP8: TXZ Q3,<<-1B17>^!<PM%RD!PM%WT>> ;ONLY ALLOW READ AND WRITE
UMOVE T1,1 ;GET USER'S SOURCE ARGUMENT
CAMN T1,[-1] ;DELETE ONLY?
JRST SMAP9 ;DONE. SUCCESS
;NOT A DELETE. SEE WHAT WE ARE TRYING TO SMAP TO
JUMPE T1,[ SETOM T1 ;INDICATE PRIVATE SECTION
DMOVE T2,Q2 ;GET ARGUMENTS
HLLZS T3 ;ACCESS BITS ONLY
CALL SECMAP ;CREATE PRIVATE SECTION
ITERR (,<CALL FUNLK>)
JRST SMAP9]
JUMPG T1,[ CALL SMFILE ;IF FILE. GO DO IT
ITERR (,<CALL FUNLK>) ;ERROR
JRST SMAP9] ;DONE
;SOURCE IS A FORK. MUST BE SECTION 0 ONLY.
CAIN Q1,0 ;FROM SECTION 0?
TRNE Q3,777776 ;YES. AND ONE SECTION ONLY?
ITERR (ARGX24,<CALL FUNLK>) ;NO. ERROR THEN
HLRZS T1 ;GET SOURCE HANDLE
CALL STJFKR ;CONVERT TO JOB-WIDE HANDLE
ITERR (,<CALL FUNLK>) ;ERROR
HRRZ T1,SYSFK(T1) ;GET SYSTEM-WIDE HANDLE
HLRZ T1,FKPGS(T1) ;GET PT I.D.
DMOVE T2,Q2 ;GET OTHER ARGS
HLLZS T3 ;ISOLATE ACCESS
CALL SECMAP ;MAP IT
ITERR (,<CALL FUNLK>)
SMAP9: CALL FUNLK ;DID IT
MRETNG ;AND RETURN
; Set fact switch
;ACCEPTS IN 1/ FUNCTION CODE
; 2/ NEW SETTING
; SMON
; Traps if process hasn't wheel/operator privilege
.SMON:: MCENT
MOVE C,CAPENB
TXNN C,SC%WHL!SC%OPR
ITERR (SMONX1)
UMOVE T1,1 ;GET FLAG TO BE SET
CAIN T1,.SFRMT ;SETTING REMOTE LOGIN STATUS?
CALL [ SAVET ;YES
XCTU [SKIPE 2] ;DOING ENABLE?
CALLRET DTRMEN ;YES. TELL FE
CALLRET DTRMDS] ;NO. TELL FE
JUMPL T1,SMONER ;FUNCTION CODE MUST BE POSITIVE
CAIL T1,^D36 ;IS IT A BIT IN FACTSW?
JRST SMON2 ;NO, GO CHECK FUNCTION CODE
CAIE T1,.SFNVT ; yes, setting ARPANET logins allowed?
JRST SMON1 ; no, skip this
SETZ T1, ; yes, try ARPA-only JSYS
GTHST ; ..
ERJMP MRETN ; failed, must be non-ARPA monitor
MOVEI T1,.SFNVT ; restore function code
SMON1: IDIVI T1,^D36 ;GET BIT POSITION
MOVX T1,1B0 ;SET UP TO BUILD MASK
MOVNS T2
LSH T1,0(T2) ;GET MASK
XCTU [SKIPE 2] ;SETTING THE BIT?
JRST [ IORM T1,FACTSW ;YES, DO SO
JRST MRETN]
ANDCAM T1,FACTSW ;NO, CLEAR IT
JRST MRETN
SMON2: CAILE T1,^D35+NSMON2 ;IS IT TOO BIG A CODE?
SMONER: ITERR(SMONX2) ;YES, RETURN FAILURE
SUBI T1,^D36 ;SHIFT CODE DOWN BY 36 FOR TABLE
LSH T1,1 ;DOUBLE THE CODE
UMOVE T2,2 ;GET USER'S VALUE FOR THE FUNCTION
SKIPE T2 ;IF ZERO, DO EVEN DISPATCH
TRO T1,1 ;IF NONZERO, DO ODD DISPATCH
XCT SMON2T(T1) ;DO THE FUNCTION
JRST MRETN
;TABLE FOR SMON FUNCTION CODES .GE. 36
SMON2T: SETZM NETON ;CODE 44, VALUE 0
SETOM NETON ;CODE 44, VALUE NON-ZERO
JFCL ;CODE 45, VALUE ZERO
AOS IMPDRQ ;CODE 45, VALUE NON-ZERO
JFCL ;CODE 46, VALUE ZERO
CALL HSTINJ ;CODE 46, VALUE NON-ZERO
MOVEM T2,TIMZON ;CODE 47, VALUE ZERO
MOVEM T2,TIMZON ;CODE 47, VALUE NON-ZERO
CALL STHSTJ ;CODE 50, VALUE ZERO
CALL STHSTJ ;CODE 50, VALUE NON-ZERO
SETZM AVALON ;CODE 51, VALUE ZERO
SETOM AVALON ;CODE 51, VALUE NON-ZERO
CALL UNGEN ;CODE 52, ZERO. TURN OFF STATUS REPROTING
CALL GENGEN ;CODE 52, NON-ZERO. ENABLE REPORTING
CALL SGTOK ;CODE 53, VALUE ZERO
CALL SGTOK ;CODE 53, VALUE NON-ZERO
MOVEM T2,TPRCYC ;Code 54, set tape recycle period
MOVEM T2,TPRCYC
MOVEM T2,DIRRDU ;CODE 55, VALUE ZERO SET DIR READ MASK
MOVEM T2,DIRRDU ;CODE 55, NON-ZERO. SET DIR READ MASK
MOVEM T2,ARRCYC ;Code 56, set archive tape recycle period
MOVEM T2,ARRCYC
SETZM NRTWTS ;Code 57, Retrieval waits ok (val 0)
SETOM NRTWTS ;Code 57, no retrieval waits (val non-0)
MOVEM T2,TPMTDF ;CODE 60, SET TAPE-MOUNT DEFAULTS
MOVEM T2,TPMTDF
SETZM PRELDF ;CODE 61, WORKING SET PRELOADING: OFF, ON
SETOM PRELDF
NSMON2==<.-SMON2T>/2 ;MAXIMUM CODE VALUE LESS 36
HSTINJ: CALL HSTINI ;JACKET ROUTINE FOR HSTINI
JFCL ; WHICH HAS A SKIP RETURN
RET
SETZON: MOVEM T2,TIMZON ;STORE VALUE (OR 0)
CALLRET DTTIME ;SEND NEW INFO TO FE
SGTOK: HRRZ T1,T2 ;GET FUNCTION CODE
SKIPN T1 ;CHECK FOR LEGAL
ITERR (SMONX2) ;ILLEGAL FUNCTION
CAIN T1,400000 ;CHECK FOR USER FUNCTION
SETZ T1,0 ;FORCE FUNCTION 0
CAIL T1,MXGOKF ;CHECK FOR LEGAL FUNCTION
ITERR (SMONX2) ;FATAL ERROR ILLEGAL FUNCTION
JUMPGE T2,SGTDIS ;CHECK FOR DISABLE
SKIPN T3,ACJFN ;CHECK FOR ACJ FORK
JRST [ NOINT ;DISABLE INTERRUPTS
MOVE T3,JOBNO ;SAVE JOB NUMBER
MOVEM T3,ACJJN
MOVE T3,FORKX ;SAVE FORK NUMBER
MOVEM T3,ACJFN
CALL SETACJ ;SET ACJ'S SCHEDULING PRIORITY
JRST SGSET]
CAME T3,FORKX ;THIS THE CORRECT FORK?
ITERR (GOKER3) ;NO YOU CAN'T DO THIS
NOINT ;DISABLE INTERRUPTS
SGSET: LOAD T3,GT%ENB,T2 ;GET THE ENABLES
ADDI T1,GTOKPR
LOAD T4,GTDEF,(T1) ;CHECK FOR ALREADY SETUP
CAIE T4,77
ITERR (SMONX2) ;ILLEGAL FUNCTION
STOR T3,GTENB,(T1)
ANDI T3,37 ;SET DISABLE DEFAULT
STOR T3,GTDEF,(T1)
OKINT
RET ;QUIT
SETACJ: SAVEAC <T1,T2> ;PRESERVE T1,T2
MOVEI T1,.FHSLF ;THE ACJ FORK
MOVEI T2,MFRKWD ;GET THE PRIORITY
SPRIW ;SET IT
RET
SGTDIS: SKIPN T3,ACJFN ;CHECK FOR ACJ FORK
JRST SGNOAC ;NO ACJ FORK ALL OK
CAME T3,FORKX ;CHECK FOR MATCHING FORK
ITERR (GOKER3) ;ILLEGAL FUNCTION
SGNOAC: NOINT ;THEN WE MUST CLEAN QUEUE
CSKED ;DON'T RESCHED
LOCK GOKLCK ;LOCK THE Q
MOVE T3,T1 ;SAVE FUNCTION
ADDI T3,GTOKPR
LOAD T4,GT%ENB,T2 ;GET DISABLES
STOR T4,GTENB,(T3) ;SET NEW DEFAULT
SETONE GTDEF,(T3) ;SET DISABLED DEFAULT
SGTDAB: MOVEI T4,GETOKF ;POINTER TO BEGINNING OF LIST
SGOKL: SKIPN T4,0(T4) ;GET AN ENTRY
JRST SGOKD ;DONE
LOAD T3,GOKFKN,(T4) ;CHECK FUNCTION
TRZ T3,400000 ;REMOVE USER BITS
CAME T3,T1 ;IS IT THIS ONE?
JRST SGOKL ;NO TRY NEXT ONE
SKIPN 1(T4) ;LOOK AT THE PICKED COUNT
SOS GOKQED ;GET QUEUE'D COUNT
MOVEI T3,1 ;ASSUME ALL OK
MOVEM T3,1(T4) ;SET IN DONE FLAG
TLNN T2,(SF%DOK) ;WAS REQUEST OK?
AOS 1(T4) ;NO MAKE IT A FAILURE
JRST SGOKL ;AND TRY NEXT ENTRY
SGOKD: SETZ T1,0 ;START WITH FUNCTION 0
SGOKDL: SKIPGE GTOKPR(T1) ;ANY ENABLED?
JRST SGOKDN
AOS T1
CAIGE T1,MXGOKF ;CHECK FOR MAX FUNCTION
JRST SGOKDL ;NOT DONE YET
SETZM ACJFN ;SET NO ACJ FORK
SETZM ACJJN ;SET NO ACJ JOB NUMBER
SGOKDN: UNLOCK GOKLCK ;UNLOCK THE LOCK
ECSKED ;ALLOW SCHEDULING
OKINT ;ENABLE INTERRUPTS
RET ;AND RETURN
NR (TPMTDF,1) ;TAPE-MOUNT CONTROLS WORD
;THE SNOOP JSYS
;ACCEPTS IN AC1/ FUNCTION CODE
; AC2-AC4/ FUNCTION DEPENDENT ARGUMENTS
; SNOOP
;RETURNS +1: ERROR - ERROR CODE IN T1
; +2: SUCCESSFUL
;SNOOP DATA BASE
REPEAT 0,<
SNPBPP:
+--------------------+--------------------+
!SNPBN: !SNPBL: !
! BREAK POINT # ! LINK TO NEXT BP !
+--------------------+--------------------+
!SNPBTI: !
! INSTRUCTION TO TRANSFER TO BP ROUTINE !
+-----------------------------------------+
!SNPBRI: !
! REPLACED INSTRUCTION FROM MONITOR !
+-----------------------------------------+
!SNPB1: !
! JRST MONADR+1 !
+-----------------------------------------+
!SNPB2: !
! JRST MONADR+2 !
+-----------------------------------------+
+--------------------+--------------------+
SNPPGS: !SNPPC: !SNPPA: !
! # OF PAGES LOCKED ! ADR OF FIRST PAGE !
+--------------------+--------------------+
+--------------------+--------------------+
SNPLST: !SNPFLG: !SNPLNK: !
! BREAK POINT FLAGS ! LINK TO FIRST BP !
+--------------------+--------------------+
>
;SNOOP DATA STRUCTURE DEFINITIONS
DEFSTR (SNPBN,0,17,18) ;BREAK POINT NUMBER
DEFSTR (SNPBL,0,35,18) ;LINK TO NEXT BREAK POINT OF FORK
SNPBP==1 ;WHERE TO JUMP TO ON A BREAK POINT
SNPBII==SNPBP+1 ;INDEX OF REPLACED INSTRUCTION
DEFSTR (SNPBTI,SNPBP,35,36) ;TRANSFER INSTRUCTION TO BP ROUTINE
DEFSTR (SNPBRI,SNPBP+1,35,36) ;REPLACED INSTRUCTION
DEFSTR (SNPB1,SNPBP+2,35,36) ;JRST MONADR+1
DEFSTR (SNPB2,SNPBP+3,35,36) ;JRST MONADR+2
SNPBSZ==5 ;LENGTH OF A BREAK POINT BLOCK
DEFSTR (SNPPC,SNPPGS,17,18) ;COUNT OF SNOOP PAGES LOCKED DOWN
DEFSTR (SNPPA,SNPPGS,35,18) ;ADDRESS OF FIRST PAGE LOCKED DOWN
DEFSTR (SNPFLG,SNPLST,17,18) ;BREAK POINT FLAGS FOR THIS FORK
DEFSTR (SNPLNK,SNPLST,35,18) ;LINK TO FIRST BREAK POINT FOR FORK
;BREAK POINT FLAGS IN SNPFLG
SN.BRK==1 ;BREAK POINTS HAVE BEEN INSERTED
SN.SML==2 ;SWAPPABLE MONITOR IS LOCKED DOWN
NR (SNPFTB,1) ;FREE PAGES TABLE *** UP TO 36. PAGES ONLY!
NR (SNPBPC,1) ;COUNT OF USERS USING SNOOP FACILITY
NR (SNPLOK,1) ;LOCK FOR SNOOP DATA BASE
NR (SNPFRE,1) ;FREE LIST FOR BREAK POINTS
RS (SNPCNT,1) ;# OF BREAK POINTS CURRENTLY INSERTED
;SNOOP JSYS DISPATCH ROUTINE
.SNOOP::MCENT ;ENTER THE JSYS
MOVE T2,CAPENB ;GET ENABLED CAPABILITIES
XCTU [HRRZ T1,1] ;GET FUNCTION CODE
CAIN T1,.SNPSY ;IS THIS A SYMBOL LOOKUP?
JRST SNPFN6 ;YES, DONT LOCK UP DATA BASE
CAIN T1,.SNPAD ;IS THIS AN ADDRESS LOOKUP?
JRST SNPFN7 ;YES, GO LOOK IT UP
TRNN T2,SC%WHL!SC%OPR ;IS THE USER PROPERLY PRIVILEGED?
RETERR (SNOPX1) ;NO, GIVE ERROR RETURN
CAIL T1,SNPDTL ;IS THIS A LEGAL FUNCTION
RETERR (SNOPX2) ;NO, GIVE ERROR RETURN
SKIPN SNPPGS ;PAGES ALREADY LOCKED DOWN?
SKIPL SNPDTB(T1) ;NO, SHOULD THEY BE LOCKED DOWN?
SKIPA ;ALL OK
RETERR (SNOPX3) ;PAGES NOT LOCKED AND SHOULD BE!
HRRZ T1,SNPDTB(T1) ;FIND TRANSFER ADDRESS
NOINT ;LOCK UP THE DATA BASE
LOCK SNPLOK ;...
CALL (T1) ;GO DO THE FUNCTION
JRST [ UNLOCK SNPLOK ;ERROR DURING FUNCTION
OKINT ;UNLOCK LOCKS
RETERR ()] ;AND GIVE ERROR RETURN TO USER
UNLOCK SNPLOK ;OK RETURN
OKINT ;UNLOCK
SMRETN ;GIVE USER THE SKIP RETURN
SNPDTB: SNPFN0 ;DECLARE CODE AND LOCK INTO MONITOR
400000,,SNPFN1 ;LOCK DOWN SWAPPABLE MONITOR
400000,,SNPFN2 ;DEFINE A BREAK POINT
400000,,SNPFN3 ;INSERT ALL BREAK POINTS
400000,,SNPFN4 ;REMOVE ALL BREAK POINTS
SNPFN5 ;REMOVE ALL BP'S AND UNLOCK EVERYTHING
SNPDTL==.-SNPDTB
;SNOOP JSYS FUNCTION 0 - DECLARE CODE AND LOCK INTO MONITOR VIRT MEMORY
SNPFN0: STKVAR <SNPF0C,SNPF0S,SNPF0D>
SKIPE SNPPGS ;USER ALREADY LOCKED DOWN SOME PAGES?
RETBAD (SNOPX4) ;YES, THEN THIS IS ILLEGAL
MOVE T1,FORKX ;GET OUR FORK NUMBER
HLL T1,FKPGS(T1) ;GET PTN OF FORK
XCTU [HRR T1,3] ;GET PAGE NUMBER OF DATA
TRNE T1,777000 ;IS THIS A LEGAL PAGE #?
RETBAD (SNOPX5) ;NO
MOVEM T1,SNPF0S ;SAVE SOURCE IDENTIFIER
XCTU [HRRZ T2,2] ;GET COUNT OF PAGES TO BE LOCKED
JUMPE T2,[RETBAD (SNOPX6)] ;ZERO PAGES IS NOT ALLOWED
MOVEM T2,SNPF0C ;SAVE IT FOR LATER
CALL VALPAG ;VALIDATE THAT PAGES ARE PRIVATE
RET ;ILLEGAL PAGE ACCESS
MOVE T1,SNPF0C ;GET COUNT OF PAGES DESIRED
CALL SNPFFP ;FIND A CONSEQUTIVE BLOCK OF FREE PAGES
RET ;NOT ENOUGH FREE PAGES
STOR T1,SNPPA ;STORE START ADR OF LOCKED PAGES
MOVE T2,SNPF0C ;GET NUMBER OF PAGES TO BE LOCKED
STOR T2,SNPPC ;REMEMBER HOW MANY WERE LOCKED
CALL SNPASP ;ASSIGN THESE PAGES FOR US
LOAD T2,SNPPA ;GET MONITOR VIRTUAL PAGE NUMBER AGAIN
MOVEM T2,SNPF0D ;SAVE DESTINATION IDENTIFIER
MOVE T1,SNPF0S ;GET SOURCE IDENTIFIER
XCTU [HRRZM T2,2] ;RETURN MONITOR ADDRESS TO USER
SNPF0A: TRZ T1,777000 ;GUARANTEE A LEGAL PAGE #
LSH T2,PGSFT ;GET ADDRESS FROM PAGE #
HRLI T2,(PM%RD!PM%WT!PM%EX)
CALL SETIOP ;LOCK IT INTO MONITOR
BUG(SNPLKF)
AOS T1,SNPF0S ;GET NEXT SOURCE IDENTIFIER
AOS T2,SNPF0D ;GET NEXT DESTINATION IDENTIFIER
SOSLE SNPF0C ;ANY MORE TO BE DONE?
JRST SNPF0A ;YES, GO LOCK OTHER PAGES
AOSE SNPBPC ;IS BREAK POINT PAGE LOCKED DOWN YET?
RETSKP ;YES, DONT LOCK AGAIN
MOVEI T1,SNPBPP ;GET PAGE ADDRESS OF BREAK POINT PAGE
LSH T1,-PGSFT ;GET PAGE NUMBER
HRL T1,MMSPTN ;SET UP PTN,,PN FOR LOCKING
CALL MLKPG ;LOCK DOWN BREAK POINT PAGE
RETSKP ;GIVE OK RETURN TO USER
;ROUTINE TO VALIDATE THAT ALL PAGES TO BE LOCKED ARE PRIVATE OR CPW
;ACCEPTS IN T1/ IDENTIFIER FOR USER PAGES
; T2/ COUNT OF PAGES
; CALL VALPAG
;RETURNS +1: ILLEGAL PAGE TYPE
; +2: OK
VALPAG: STKVAR <VALPGI,VALPGC>
MOVEM T1,VALPGI ;SAVE IDENTIFIER
MOVEM T2,VALPGC ;AND COUNT
VALPG1: MOVE T1,VALPGI ;GET IDENTIFIER OF NEXT PAGE
CALL MRPACS ;GET PAGE ACCESS BITS
TLNN T1,(1B9!1B10) ;PRIVATE OR COPY ON WRITE?
RETBAD (SNOP18) ;NO, GIVE ERROR RETURN TO USER
HRRZ T1,VALPGI ;GET ADDRESS OF PAGE
HRRI T2,1(T1) ;STEP TO NEXT PAGE
HRRM T2,VALPGI ;...
LSH T1,PGSFT ;MAKE PAGE # INTO ADDRESS
XCTU [MOVES 0(T1)] ;WRITE INTO PAGE TO MAKE IT PRIVATE
SOSLE VALPGC ;ANY MORE TO BE DONE?
JRST VALPG1 ;YES, GO TEST OTHER PAGES
RETSKP ;NO, ALL DONE
;SNOOP JSYS FUNCTION 1 - LOCK DOWN THE SWAPPABLE MONITOR
SNPFN1: LOAD T1,SNPFLG ;GET FLAGS FOR THIS FORK
TROE T1,SN.SML ;IS IT ALREADY LOCKED DOWN?
RETSKP ;YES, DONT DO IT AGAIN
STOR T1,SNPFLG ;NO, STORE UPDATED FLAGS
CALL SWPMLK ;LOCK DOWN SWAPPABLE MONITOR
RETSKP ;GIVE OK RETURN
;SNOOP JSYS FUNCTION 2 - DEFINE A BREAK POINT
SNPFN2: STKVAR <SNPF2N,SNPF2I,SNPF2A>
LOAD T1,SNPFLG ;GET SNOOP FLAGS FOR THIS FORK
TRNE T1,SN.BRK ;ARE THE BREAK POINTS INSERTED?
RETBAD (SNOPX7) ;YES, GIVE ERROR RETURN
UMOVE T1,2 ;GET BREAK POINT NUMBER
MOVEM T1,SNPF2N ;SAVE BREAK POINT NUMBER
CALL SNPBPR ;RELEASE THIS BREAK POINT
UMOVE T4,4 ;GET TRANSFER INSTRUCTION FROM USER
JUMPE T4,RSKP ;IF NO INST, THEN EXIT
MOVEM T4,SNPF2I ;SAVE INSTRUCTION FOR LATER
UMOVE T4,3 ;GET ADDRESS IN MONITOR
MOVEM T4,SNPF2A ;SAVE ADDRESS FOR LATER ALSO
MOVE T1,0(T4) ;GET INSTRUCTION
MOVE T2,1(T4) ;AND INSTRUCTION+1
TLNE T1,777000 ;IS THIS INST 0?
TLNN T2,777000 ;OR THIS ONE?
RETBAD (SNOPX8) ;YES, THIS IS NOT LEGAL PLACE FOR BP
MOVEI T1,SNPBPP ;NOW CHECK IF A BP ALREADY ON THIS LOC
MOVEI T2,SNPBPS/SNPBSZ ;GET # OF POSSIBLE BP'S
SNPF2L: LOAD T3,SNPB1,(T1) ;GET ADDRESS OF BP
JUMPE T3,SNPF2D ;IF 0, THEN NO BP DEFINED HERE
HRRZI T3,-1(T3) ;GET ADDRESS OF BP IN MONITOR
CAIN T3,0(T4) ;SAME AS ONE BEING DEFINED?
RETBAD (SNOP17) ;YES, 2 BP'S ON SAME ADR IS ILLEGAL
SNPF2D: MOVEI T1,SNPBSZ(T1) ;STEP TO NEXT BP
SOJG T2,SNPF2L ;LOOP BACK UNTIL ALL BP'S ARE CHECKED
HRRZ T1,SNPFRE ;GET POINTER TO FIRST FREE BP
JUMPE T1,[RETBAD (SNOPX9)] ;IF 0, THEN NONE LEFT
LOAD T2,SNPBL,(T1) ;GET POINTER TO SECOND FREE BP
HRRM T2,SNPFRE ;MAKE FREE LIST POINT TO 2ND BP
MOVE T3,SNPF2N ;GET BREAK POINT NUMBER
STOR T3,SNPBN,(T1) ;SAVE BREAK POINT NUMBER
LOAD T3,SNPLNK ;GET POINTER TO USER'S 1ST BP
STOR T3,SNPBL,(T1) ;PUT NEW BP AT START OF LIST
STOR T1,SNPLNK ;...
MOVE T2,SNPF2A ;GET ADDRESS TO BE PATCHED AGAIN
MOVE T3,0(T2) ;GET INSTRUCTION BEING REPLACED
STOR T3,SNPBRI,(T1) ;AND REPLACED INSTRUCTION
MOVE T4,SNPF2I ;GET BACK INSTRUCTION FROM USER
STOR T4,SNPBTI,(T1) ;STORE TRANSFER INSTRUCTION
MOVSI T3,(JRST) ;SET UP JRST .+1
HRRI T3,1(T2) ;...
STOR T3,SNPB1,(T1) ;STORE JRST .+1 INSTRUCTION INTO BLOCK
HRRI T3,2(T2) ;SET UP JRST .+2
STOR T3,SNPB2,(T1) ;STORE IT IN BP BLOCK ALSO
RETSKP ;GIVE OK RETURN
;ROUTINE TO RETURN A BREAK POINT TO FREE POOL
;ACCEPTS IN T1/ BREAK POINT NUMBER OR -1 FOR ALL BREAK POINTS
; CALL SNPBPR
;RETURNS +1: ALWAYS
SNPBPR: MOVEI T2,SNPLST ;SET UP TO GET FIRST BP ON LIST
SNPBR1: MOVE T4,T2 ;SAVE LAST POINTER
LOAD T2,SNPBL,(T2) ;GET NEXT BP ON LIST
JUMPE T2,R ;IF 0, BP WAS NOT FOUND
LOAD T3,SNPBN,(T2) ;GET NUMBER OF THIS BP
CAME T1,T3 ;A MATCH?
JUMPG T1,SNPBR1 ;NO, LOOP BACK TIL ONE FOUND
LOAD T3,SNPBL,(T2) ;GET FORWARD POINTER
STOR T3,SNPBL,(T4) ;PUT IT IN LAST BP FORWARD POINTER
HRRZ T3,SNPFRE ;GET FIRST FREE BP
HRRM T2,SNPFRE ;PUT THIS BP ON FREE LIST
STOR T3,SNPBL,(T2) ;MAKE THIS BP POINT TO OTHER FREE BP'S
MOVEI T3,0 ;CLEAR OUT JRST A+1 WORD
STOR T3,SNPB1,(T2) ; TO FLAG THAT BP IS ON FREE LIST
JRST SNPBPR ;LOOP BACK UNTIL ALL BP'S SCANNED
;SNOOP JSYS FUNCTION 3 - INSERT BREAK POINTS
SNPFN3: LOAD T1,SNPFLG ;GET FLAGS
TROE T1,SN.BRK ;BREAK POINTS INSERTED YET?
RETBAD (SNOP10) ;YES, ERROR
STOR T1,SNPFLG ;NO, STORE UPDATED FLAGS
CALL SWPMWE ;WRITE ENABLE THE SWAPPABLE MONITOR
LOAD T1,SNPLNK ;GET POINTER TO FIRST BP OF USER
SNPF3A: JUMPE T1,SNPF3B ;0 MEANS AT END OF BP LIST
LOAD T2,SNPB1,(T1) ;GET ADDRESS+1 OF WHERE TO PUT BP
HRRZS T2
MOVE T3,-1(T2) ;GET INSTRUCTION BEING REPLACED
CAME T3,SNPBII(T1) ;IS IT SAME AS ORIGINAL
BUG(SNPIC)
MOVSI T3,(JRST) ;SET UP JRST BP INSTRUCTION
HRRI T3,SNPBP(T1) ;GET ADDRESS OF BP CODE
MOVEM T3,-1(T2) ;INSERT THE BREAK POINT
AOS SNPCNT ;COUNT UP # OF BP'S INSERTED
LOAD T1,SNPBL,(T1) ;GET POINTER TO NEXT BP
JRST SNPF3A ;LOOP BACK TIL ALL BP'S ARE INSERTED
SNPF3B: CALL SWPMWP ;WRITE PROTECT THE SWAPPABLE MONITOR
RETSKP ;GIVE OK RETURN
;SNOOP JSYS FUNCTION 4 - REMOVE ALL BREAK POINTS
SNPFN4: LOAD T1,SNPFLG ;GET FLAGS
TRZN T1,SN.BRK ;WERE BP'S INSERTED
RETBAD (SNOP11) ;NO, GIVE ERROR RETURN
STOR T1,SNPFLG ;STORE UPDATED FLAGS
CALL SWPMWE ;WRITE ENABLE SWAPPABLE MONITOR
LOAD T1,SNPLNK ;GET LINK TO FIRST BP
SNPF4A: JUMPE T1,SNPF4B ;0 MEANS END OF LIST
LOAD T2,SNPBRI,(T1) ;GET REPLACED INSTRUCTION
LOAD T3,SNPB1,(T1) ;GET ADRRESS+1 OF BP
HRRZS T3
MOVEM T2,-1(T3) ;PUT BACK INSTRUCTION
SOSGE SNPCNT ;COUNT DOWN # OF BP'S INSERTED
JRST SNPF4C ;OVERLY DECREMENTED
SNPF4D: LOAD T1,SNPBL,(T1) ;GET POINTER TO NEXT BP IN LIST
JRST SNPF4A ;LOOP BACK TIL ALL BP'S ARE REMOVED
SNPF4B: CALL SWPMWP ;WRITE PROTECT THE SWAPPABLE MON AGAIN
RETSKP ;AND EXIT
SNPF4C: BUG(SNPODB)
SETZM SNPCNT ;FIX UP COUNT
JRST SNPF4D ;AND CONTINUE ON
;SNOOP JSYS FUNCTION 5 - RELEASE ALL STORAGE
SNPFN5: STKVAR <SNPF5C,SNPF5D>
SKIPN SNPPGS ;PAGES LOCKED DOWN?
RETSKP ;NO, THEN NOTHING TO DO
LOAD T1,SNPFLG ;GET FLAGS
TRNE T1,SN.BRK ;BREAK POINTS IN?
CALL SNPFN4 ;YES, REMOVE THEM
JFCL
SETO T1, ;RELEASE ALL BREAK POINTS
CALL SNPBPR ; BACK TO FREE POOL
LOAD T1,SNPPC ;GET NUMBER OF PAGES TO UNLOCK
MOVEM T1,SNPF5C ;SAVE COUNT
LOAD T2,SNPPA ;GET MONITOR VIRTUAL PAGE NUMBER
MOVEM T2,SNPF5D ;SAVE DESTINATION IDENTIFIER
JUMPLE T1,SNPF5B ;IF NONE LOCKED, DONT UNLOCK ANY
SNPF5A: MOVEI T1,0 ;0 MEANS UNLOCK
LSH T2,PGSFT ;CREATE AN ADDRESS FROM THE PAGE #
HRLI T2,(PM%RD!PM%WT!PM%EX)
CALL SETIOP ;UNLOCK PAGES
BUG(SNPUNL)
AOS T2,SNPF5D ;UPDATE DESTINATION
SOSLE SNPF5C ;ANY MORE PAGES TO BE DONE?
JRST SNPF5A ;LOOP BACK FOR ALL PAGES
LOAD T1,SNPPA ;NOW RELEASE SNOOP DATA PAGES
LOAD T2,SNPPC
CALL SNPRLP ;FOR OTHERS TO USE
SNPF5B: SETZM SNPPGS ;FLAG THAT NO PAGES ARE LOCKED
LOAD T1,SNPFLG ;GET FLAGS BACK
TRNE T1,SN.SML ;DID THIS USER LOCK SWAPPABLE MONITOR?
CALL SWPMUL ;YES, UNLOCK IT
SOSL SNPBPC ;ANY OTHER USERS OF SNOOP?
RETSKP ;NO
MOVEI T1,SNPBPP ;GET ADR OF SNOOP BP PAGE
LSH T1,-PGSFT ;MAKE IT A PAGE NUMBER
HRL T1,MMSPTN ;GET PTN OF MONITOR MAP
CALL MULKPG ;UNLOCK THE BP PAGE
RETSKP ;AND EXIT
;SNOOP JSYS FUNCTIONS 6 AND 7 - SYMBOL TABLE LOOKUPS. AC USAGE:
; Q1 - VALUE OF A SYMBOL THAT SEARCH FOUND
; Q2 - NUMBER-1 OF MATCHES FOUND
; Q3 - QUANTITY TO SEARCH FOR (SYMBOL OR VALUE)
; P1 - VALUE OF A SYMBOL RETURNED BY NXTSYM
; P2 - FLAG FOR WHAT WE ARE SEARCHING FOR
; P3 - SYMBOL WHOSE VALUE IS IN Q1
SNPFN7: TDZA P2,P2 ;REMEMBER WE ARE TO FIND SYMBOL FOR VALUE
SNPFN6: MOVEI P2,1 ;REMEMBER WE ARE TO FIND VALUE OF SYMBOL
TRNN T2,SC%WHL!SC%OPR!SC%MNT ;HAVE PRIVILEGES?
RETERR (SNOPX1) ;NO, LOSE
SKIPE HSYBLK ;SYMBOLS IN ALTERNATE ADDRESS SPACE?
SKIPA P3,HSYPTR ;YES, GET ITS SYMBOL TABLE POINTER
MOVE P3,.JBSYM ;NO, GET NORMAL POINTER
SKIPL P3 ;MAKE SURE IT LOOKS REASONABLE
RETERR (SNOP14) ;NO, SAY NO SUCH SYMBOL
TRVAR <SYMPAG,SYMOFF,SYMCNT> ;ALLOCATE STORAGE
SETO Q2, ;INITIALIZE COUNT OF MATCHES
UMOVE Q3,2 ;GET USER'S ARGUMENT
HLRO T1,P3 ;GET LENGTH OF SYMBOL TABLE
MOVMS T2,T1 ;MAKE POSITIVE IN BOTH ACS
LSH T1,-1 ;CONVERT TO NUMBER OF SYMBOLS
MOVEM T1,SYMCNT ;SET COUNT
HRRZ T1,P3 ;GET FIRST LOCATION OF SYMBOLS
ADD T1,T2 ;ADD TO GET LAST SYMBOL ADDRESS + 1
MOVEM T1,SYMOFF ;INITIALIZE SYMOFF
SKIPN HSYBLK ;ARE THE SYMBOLS IN OUR ADDRESS SPACE?
JRST SNPD67 ;YES, NO FANCY MAPPING NEEDED
IDIVI T1,PGSIZ ;SPLIT INTO PAGE AND OFFSET
PUSH P,T2 ;SAVE OFFSET
ADDI T1,1 ;COMPENSATE FOR SOS DONE IN MAPSYM
MOVEM T1,SYMPAG ;ACT LIKE WE WERE AT THAT PAGE
NOINT ;MUST BE NOINT TO MAP SYMBOL PAGES
CALL MAPSYM ;MAP IN FIRST SYMBOL PAGE
POP P,SYMOFF ;REINITIALIZE OFFSET INTO PAGE
SNPD67: XCTU [SKIPE Q1,3] ;DID HE SUPPLY A PROGRAM NAME?
CALL NAMSRC ;YES, RESET STUFF TO ONLY LOOK THERE
CALL @[ IFIW FNDSYM ;CALL RETURN A SYMBOL ROUTINE
IFIW FNDVAL](P2) ;OR CALL RETURN A VALUE ROUTINE
CALL SYMUMP ;UNMAP THE SYMBOL TABLE
SMRETN ;SKIP RETURN
;HERE TO SEARCH FOR THE RIGHT MODULE NAME, AND RESTRICT OUR SEARCH
;TO ONLY THAT MODULE. NAME IS IN AC Q1.
NAMSRC: TLNE Q1,740000 ;MAKE SURE THIS IS A MODULE NAME
RETERR(SNOP12,<CALL SYMUMP>) ;ERROR IF NOT
NAMSRL: CALL NXTSYM ;GET NEXT SYMBOL PAIR
RETERR (SNOP13,<CALL SYMUMP>) ;NO MORE, PROGRAM NAME NOT FOUND
TLNE T1,740000 ;IS THIS A PROGRAM NAME?
JRST NAMSRL ;NO, SOMEBODY IS CONFUSED, KEEP GOING
HLRE T2,P1 ;GET NEGATIVE LENGTH OF THIS SYMBOL MODULE
CAMN T1,Q1 ;HAVE WE FOUND THE RIGHT NAME YET?
JRST NAMSDN ;YES, GO FINISH UP
JUMPE T2,NAMSRL ;IF NO LENGTH KEEP LOOKING
ADDI T2,2 ;ACCOUNT FOR MODULE NAME ENTRY
ADDM T2,SYMOFF ;DECREMENT OFFSET BY SIZE OF MODULE
ASH T2,-1 ;GET HOW MANY SYMBOLS THAT IS
ADDM T2,SYMCNT ;UPDATE NUMBER OF SYMBOLS LEFT
JRST NAMSRL ;LOOK AT NEXT PROGRAM NAME
NAMSDN: JUMPE T2,R ;IF LAST MODULE SEARCH REST OF TABLE
ADDI T2,2 ;ACCOUNT FOR MODULE NAME
MOVM T2,T2 ;GET POSITIVE SIZE OF MODULE
LSH T2,-1 ;CONVERT TO NUMBER OF SYMBOLS
CAMGE T2,SYMCNT ;FEWER SYMBOLS THAN REST OF SYMBOL TABLE?
MOVEM T2,SYMCNT ;YES, ONLY SEARCH THE MODULE
RET ;RETURN
;HERE TO DO THE WORK OF SEARCHING FOR A SYMBOL, AND RETURNING ITS VALUE.
FNDVAL: TLZ Q3,740000 ;CLEAR TYPE BITS FROM SYMBOL
FNDVLL: CALL NXTSYM ;READ NEXT SYMBOL PAIR
JRST FNDVDN ;NO MORE SYMBOLS
TLZE T1,740000 ;SEE IF PROGRAM NAME AND CLEAR TYPE BITS
CAME T1,Q3 ;THE SYMBOL WE ARE LOOKING FOR?
JRST FNDVLL ;NO, LOOK SOME MORE
EXCH P1,Q1 ;SAVE VALUE
AOJE Q2,FNDVLL ;IF FIRST MATCH, LOOK SOME MORE
CAME P1,Q1 ;ANOTHER MATCH, SAME VALUE?
RETERR (SNOP16,<CALL SYMUMP>) ;NO, MULTIPLY DEFINED SYMBOL
JRST FNDVLL ;SAME VALUE, THAT IS OK
FNDVDN: SKIPGE Q2 ;FIND THE SYMBOL?
RETERR (SNOP14,<CALL SYMUMP>) ;NOT FOUND
UMOVEM Q1,2 ;YES, RETURN THE VALUE
RET ;RETURN
;HERE TO DO THE WORK OF SEARCHING FOR A VALUE, AND RETURNING A SYMBOL.
FNDSYM: MOVSI Q1,400000 ;INITIALIZE TO MOST NEGATIVE NUMBER
FNDSYL: CALL NXTSYM ;READ NEXT SYMBOL PAIR
JRST FNDSDN ;NO MORE
CAMG P1,Q3 ;IS SYMBOL VALUE LESS THAN GIVEN ONE?
CAMGE P1,Q1 ;AND CLOSER THAN OLD BEST?
JRST FNDSYL ;NO, KEEP LOOKING
TLNE T1,740000 ;IS THIS A PROGRAM NAME?
TLNE T1,(1B0) ;OR IS THE SYMBOL SUPPRESSED?
JRST FNDSYL ;YES, DON'T CONSIDER IT
MOVE P3,T1 ;SAVE BETTER SYMBOL
MOVE Q1,P1 ;AND ITS VALUE
AOJA Q2,FNDSYL ;KEEP LOOKING
FNDSDN: SKIPGE Q2 ;FIND ANY SYMBOL?
RETERR (SNOP14,<CALL SYMUMP>) ;NONE FOUND
UMOVEM P3,2 ;YES, GIVE USER THE SYMBOL NAME
SUB Q3,Q1 ;GET DIFFERENCE FROM GIVEN VALUE
UMOVEM Q3,3 ;STORE OFFSET TOO
RET ;RETURN
;ROUTINE TO RETURN THE NEXT SYMBOL PAIR FROM THE SYMBOL TABLE.
;RETURNS +1: NO MORE SYMBOLS
; +2: SYMBOL IN T1, VALUE IN P1
NXTSYM: SOSGE SYMCNT ;MORE SYMBOLS?
RET ;NO, NON-SKIP RETURN
SKIPN HSYBLK ;SYMBOL TABLE IN NORMAL ADDRESS SPACE?
JRST [ SOS T1,SYMOFF ;YES, JUST DECREMENT OFFSET
MOVE P1,(T1) ;GET VALUE OF SYMBOL
SOS T1,SYMOFF ;DECREMENT AGAIN
MOVE T1,(T1) ;GET SYMBOL NAME
RETSKP] ;AND SKIP
SOSGE T1,SYMOFF ;DECREMENT OFFSET INTO PAGE
CALL MAPSYM ;WENT OFF PAGE, MAP IN NEW ONE
MOVE P1,FPG1A(T1) ;GET VALUE OF SYMBOL
SOSGE T1,SYMOFF ;DECREMENT OFFSET AGAIN
CALL MAPSYM ;WENT OFF PAGE, MAP IN NEW ONE
MOVE T1,FPG1A(T1) ;GET SYMBOL NAME
RETSKP ;GOOD RETURN
MAPSYM: MOVEI T1,PGSIZ ;GET WORDS IN A PAGE
ADDB T1,SYMOFF ;ADD TO THE OFFSET WHICH WENT NEGATIVE
SOS T2,SYMPAG ;BACK UP TO PREVIOUS PAGE
JUMPL T1,MAPSYM ;CONTINUE IF STILL NEGATIVE
MOVEI T1,.IMMAP ;FUNCTION TO MAP SYMBOL PAGE
MOVEI T3,FPG1 ;PAGE WHERE MAPPING IS GOING
MOVEI T4,1 ;ONE PAGE
CALL .IMOPR ;GET THE PAGE OF SYMBOLS
BUG(SYMNOM) ;FAILED
MOVE T1,SYMOFF ;RESTORE OFFSET
RET ;AND RETURN
;ROUTINE TO UNMAP THE SYMBOL TABLE.
SYMUMP: SKIPN HSYBLK ;SYMBOLS IN OUR ADDRESS SPACE?
RET ;YES, NOTHING TO UNMAP
MOVEI T1,.IMUMP ;FUNCTION TO UNMAP SYMBOLS
MOVEI T2,FPG1 ;PAGE WHERE SYMBOLS WERE MAPPED
MOVEI T3,1 ;ONE PAGE
CALL .IMOPR ;UNMAP THE SYMBOLS
BUG(SYMNOU)
OKINT ;INTERRUPTS OK NOW
RET ;RETURN
;SNOOP JSYS UTILITY ROUTINES
;ROUTINE TO RELEASE ALL SNOOP RESOURCES ON A RESET JSYS
; CALL SNPREL
;RETURNS +1 ALWAYS
SNPREL::NOINT ;LOCK UP THE LOCKS
LOCK SNPLOK ;...
CALL SNPFN5 ;GO RELEASE ALL RESOURCES
JFCL
UNLOCK SNPLOK ;UNLOCK THE DATA BASE
OKINT
RET ;AND RETURN
;ROUTINE TO FIND CONSECUTIVE FREE PAGES FOR USER CODE TO BE LOCKED INTO
;ACCEPTS IN T1/ COUNT OF PAGES DESIRED
; CALL SNPFFP
;RETURNS +1: NO FREE SPACE LEFT, ERROR CODE IN T1
; +2: SUCCESSFUL - PAGE # OF FIRST PAGE IN T1
SNPFFP: STKVAR <SNPFFC,SNPFFM>
MOVEM T1,SNPFFC ;SAVE COUNT
CAILE T1,SNPDPC ;IS THIS REQUEST REASONABLE?
JRST SNPFF4 ;NO, NOT ENOUGH SNOOP PAGES
MOVEI T1,SNPDAT ;GET START OF DATA AREA
LSH T1,-PGSFT ;TURN IT INTO A PAGE NUMBER
MOVEI T2,SNPDPC(T1) ;GET END OF DATA AREA+1
SUB T2,SNPFFC ;CALCULATE END OF SEARCH VALUE
MOVEM T2,SNPFFM ;SAVE CUT OFF POINT
SETZB T3,T4 ;INITIALIZE ACS FOR SEARCH
MOVSI T2,400000 ;START AT BIT 0 OF FIRST WORD IN TABLE
SNPFF1: AOS T4 ;KEEP TRACK OF PAGES SCANNED
TDNN T2,SNPFTB(T3) ;IS THIS PAGE AVAILABLE?
JRST SNPFF3 ;NO, GO INIT COUNTERS
CAML T4,SNPFFC ;SEEN ENOUGH FREE PAGES YET?
RETSKP ;YES, RETURN TO CALLER
SNPFF2: ROT T2,-1 ;SHIFT BIT TO NEXT POSITION
JUMPG T2,SNPFF1 ;LOOP BACK FOR REST OF COUNT
AOJA T3,SNPFF1 ;JUST MOVED TO NEXT WORD, INC INDEX
SNPFF3: ADD T1,T4 ;UPDATE POINTER TO FIRST FREE PAGE
SETZ T4, ;START COUNTER OVER AT 0
CAMG T1,SNPFFM ;IS THE SEARCH FINISHED?
JRST SNPFF2 ;NO, GO SEARCH SOME MORE
SNPFF4: RETBAD (SNOP15) ;YES, NO ROOM TO LOCK PAGES INTO
;ROUTINE TO ASSIGN AND RELEASE PAGES IN SNOOP POOL
;ACCEPTS IN T1/ PAGE NUMBER OF FIRST PAGE IN GROUP
; T2/ NUMBER OF PAGES IN GROUP
; CALL SNPASP OR SNPRLP
;RETURNS +1: ALWAYS
SNPASP: SKIPA T4,[ANDCAM T3,SNPFTB(T1)]
SNPRLP: MOVE T4,[IORM T3,SNPFTB(T1)]
STKVAR <SNPARC>
MOVEM T2,SNPARC ;SAVE NUMBER OF PAGES IN GROUP
MOVEI T2,SNPDAT ;GET START OF DATA AREA
LSH T2,-PGSFT ;TURN IT INTO A PAGE NUMBER
SUB T1,T2 ;GET A RELATIVE PAGE NUMBER
IDIVI T1,^D36 ;GET INDEX INTO TABLE
MOVNS T2 ;GET NEGATIVE BIT POSITION FOR SHIFT
MOVSI T3,400000 ;START AT BIT 0
LSH T3,0(T2) ;GET FIRST BIT TO BE SET OR CLEARED
SNPAR1: XCT T4 ;SET OR CLEAR THE BIT
ROT T3,-1 ;MOVE TO NEXT BIT
SKIPG T3 ;TIME TO INCREMENT INDEX?
AOS T1 ;YES
SOSLE SNPARC ;DECREMENT COUNT
JRST SNPAR1 ;LOOP BACK FOR ALL BITS
RET ;ALL DONE
;ROUTINE TO INITIALIZE THE SNOOP FUNCTION AND DATA BASE
; CALL SNPINI
;RETURNS +1 ALWAYS
SNPINI::SETZM SNPBPP ;ZERO BREAK POINT PAGE
MOVE T1,[SNPBPP,,SNPBPP+1]
BLT T1,SNPBPP+SNPBPS-1
MOVEI T1,SNPBPP ;GET POINTER TO FIRST BP BLOCK
MOVEM T1,SNPFRE ;SET UP FREE LIST
MOVEI T2,SNPBPS/SNPBSZ ;GET MAX NUMBER OF BREAK POINTS
SNPIN1: MOVEI T3,SNPBSZ(T1) ;GET ADDRESS OF NEXT BREAK POINT
MOVEM T3,0(T1) ;MAKE THIS BP POINT TO NEXT BP
MOVE T1,T3 ;STEP TO NEXT BP
SOJG T2,SNPIN1 ;LOOP TIL ALL BP'S LINKED
SETZM -SNPBSZ(T1) ;PUT A ZERO AT END OF LIST
SETOM SNPFTB ;NOW INIT FREE PAGES TABLE
MOVE T1,[SNPFTB,,SNPFTB+1]
MOVEI T2,<<SNPDPC+^D35>/^D36>
CAILE T2,1 ;ONLY ONE WORD TABLE?
BLT T1,SNPFTB-1+<<SNPDPC+^D35>/^D36>
SETOM SNPBPC ;INIT COUNT OF SNOOP USERS
SETZM SNPCNT ;INITIALIZE COUNT OF INSERTED BP'S
SETOM SNPLOK ;INIT SNOOP DATA BASE LOCK
RET ;AND EXIT
;SOBE - Skip if output buffer is empty
;ACCEPTS:
; DEVICE DESIGNATOR
; SOBE
;RETURNS +1: OUTPUT BUFFER IS NOT EMPTY
; T2/ NUMBER OF BYTES IN BUFFER
; +2: ERROR OR OUTPUT BUFFER IS EMPTY
; T2/ 0 IF EMPTY
; OR
; ERROR CODE IF ERROR
.SOBE:: MCENT
CALL CHKTTR
JRST SOBE1
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
JRST [ CALL ULKTTY ;NOT ACTIVE. ALLOW DEALLOCATION
MOVEI A,TTYX01 ;SET ERROR TO 'LINE IS NOT ACTIVE'
JRST SOBE1] ;GO RETURN ERROR CODE
CALL TTSOBE
JRST [ UMOVEM A,B
CALL ULKTTY ;ALLOW DEALLOCATION
JRST EMRET1]
CALL ULKTTY ;ALLOW DEALLOCATION
;**;[1844] Delete one line and revamp at .SOBE: +12L JGZ 14-APR-81
TDZA T1,T1 ;[1844] INDICATE NO CHARACTERS IN BUFFER
SOBE1: MOVEM T1,LSTERR ;[1844] SAVE ERRORS IN LSTERR
UMOVEM A,B ;[1844] RETURN ERROR CODE OR 0
SMRETN
; Skip if output buffer full
;ACCEPTS:
; DEVICE DESIGNATOR
; SOBF
;RETURNS +1: OUTPUT BUFFER IS NOT FULL OR ERROR
; T2/ NUMBER OF BYTES IN BUFFER
; OR
; 0 IF ERROR
; +2: ERROR OR OUTPUT BUFFER IS FULL
; T2/ COUNT IF NO ERROR
.SOBF:: MCENT
CALL CHKTTR
JRST [ SETZ A, ;NOT A TERMINAL. RETURN COUNT OF 0
JRST SOBF1]
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
JRST [ CALL ULKTTY ;NOT ACTIVE. ALLOW DEALLOCATION
SETZ A, ;SET COUNT TO 0
JRST SOBF1]
CALL TTSOBF ;GO TEST BUFFER COUNT
JRST [ CALL ULKTTY ;NOT FULL. ALLOW DEALLOCATION
JRST SOBF1] ;RETURN +1 WITH COUNT
UMOVEM 1,2 ;FULL. Return count of bytes in buffer
CALL ULKTTY ;ALLOW DEALLOCATION
SMRETN
SOBF1: UMOVEM 1,2 ; Return count of bytes in buffer
JRST MRETN
; Set accessibility of a page
; Call: LH(A) ; Fork or file handle
; RH(A) ; Page number
; SPACS
.SPACS::MCENT
TRVAR <<DUMMY,3>,JFHDL> ;MUST MATCH TRVAR IN PMAP
SETZM JFHDL ;ASSUME NO STR LOCK TO RELEASE
SETZ B, ;NO PT CREATES
CALL CPMAPX ; Convert to ptn.pn
MOVEM D,JFHDL ;REMEMBER STR LOCK
JUMPE A,SPACER ;IF NO MATCH,ERROR
XCTU [SKIPGE 1] ;FORK HANDLE?
JRST SPACFK ;YES
TXNN B,WRTF ; MUST BE ABLE TO WRITE
SPACER: JRST [ MOVEI A,SPACX1
MOVEM A,LSTERR
SKIPE A,JFHDL ;LOCKED A STR?
CALL LUNLK0 ;YES. UNLOCK IT
JRST ITRAP]
MOVSI C,160000
JRST SPAC1
;FORK HANDLE WAS SPECIFIED
SPACFK: PUSH P,A ; Save page handle
CALL MRPACS ; Get access of page
TLNN A,(1B5)
JRST SPACER ; Non-existent page
TLNE A,(1B10)
JRST SPACPR ; Private page
PUSH P,A ; Save access
MOVE A,-1(P) ; Get back the page handle
CALL MRPT ; Get map contents
JRST SPACP1 ; Indirect or shared to fork
CALL OFNJFN ; Convert to jfn.pn
JRST SPACCF ; Closed file
SETZ B, ;NO PT CREATES
CALL CPMAPX ; Get allowable access
MOVEM D,JFHDL ;REMEMBER STR LOCK
SUB P,BHC+1
JRST SPAC2
SPACCF: POP P,C
AND C,[XWD 160000,0]
JRST SPAC2
SPACP1: SUB P,BHC+1
SPACPR: MOVSI C,160000
SPAC2: TLO C,1400
POP P,A
SPAC1: UMOVE B,2
AND B,C
CALL MSPACS
SKIPE A,JFHDL ;HAVE A STR LOCK TO RELEASE?
CALL LUNLK0 ;YES. FREE IT
JRST MRETN
;SPOOL JSYS
;ACCEPTS IN 1/ LENGTH ,, FUNCTION CODE
; 2/ LOCATION OF ARGUMENT BLOCK
; SPOOL
;RETURNS +1: ERROR - ERROR CODE IN AC 1
; +2: SUCCESSFUL
.SPOOL::MCENT ;ENTER JSYS
XCTU [HRRZ T1,1] ;GET FUNCTION CODE
CAILE T1,.SPLRD ;LEGAL FUNCTION?
RETERR (SPLX1) ;NO
XCTU [HLRZ T2,1] ;GET LENGTH
HLRZ T3,SPLTAB(T1) ;GET DESIRED LENGTH
CAMGE T2,T3 ;USER SUPPLY ENOUGH ARGS?
RETERR (SPLX2) ;NO, ILLEGAL LENGTH
UMOVE Q1,2 ;GET ADDRESS OF ARG BLOCK
HRRZ T1,SPLTAB(T1) ;GET ADDRESS OF ROUTINE TO CALL
JRST 0(T1) ;DISPATCH
SPLTAB: 3,,SPOOL0 ;(0) DEFINE INPUT SPOOLING SET
2,,SPOOL1 ;(1) SET SPOOL DIRECTORY FOR A DEVICE
2,,SPOOL2 ;(2) READ SPOOL DIRECTORY FOR A DEVICE
SPOOL0: UMOVE T1,0(Q1) ;GET DEVICE DESIGNATOR
CAME T1,[600000+.DVCDR,,-1]
RETERR (SPLX3) ;ILLEGAL DEVICE DESIGNATOR
MOVEI T1,JSBFRE ;PREPARE TO RELEASE OLD STRING IF ANY
HRRZ T2,JSCDR ;GET OLD STRING POINTER
JUMPN T2,[NOINT ;WAS THERE AN OLD STRING?
CALL RELFRE ;YES, RELEASE IT
OKINT
JRST .+1]
UMOVE T1,1(Q1) ;GET STRING POINTER
CALL CPYFU0 ;COPY STRING INTO JSB
RETERR () ;ERROR
HRRZM T1,JSCDR ;STORE STRING ADDRESS
XCTU [HRRZ T1,2(Q1)] ;GET VERSION NUMBER OF FIRST FILE
JUMPE T1,[RETERR (SPLX5)] ;0 IS ILLEGAL
SOS T1 ;IT GET INCREMENTED BEFORE BEING USED
HRLM T1,JSCDR ;STORE IT IN JSB
SMRETN ;GIVE OK RETURN
SPOOL1: MOVE T1,CAPENB ;CHANGING DIR # IS PRIVILEGED
TRNN T1,SC%WHL!SC%OPR ;WHEEL OR OPER?
RETERR (SPLX4) ;NO, MUST BE PRIVILEGED
UMOVE T1,0(Q1) ;GET DEVICE DESIGNATOR
CALL CHKDES ;CHECK THIS DESIGNATOR
RETERR ;NO, ILLEGAL DESIGNATOR
UMOVE T4,1(Q1) ;GET DIR NUMBER
HLL T1,DEVCHR(T2) ;SET UP DESIGNATOR
TLZ T1,777000 ;...
MOVSI T2,-NDEV ;SET UP TO LOOP THRU DEVICES
SPOL1L: HLL T3,DEVCHR(T2) ;SET UP DESIGNATOR
TLZ T3,777000 ;...
HRR T3,DEVUNT(T2) ;GET UNIT NUMBER
ANDI T3,DV%UNT ;MASK TO UNIT NUMBER
CAIN T3,DV%UNT ;CHECK FOR -1
MOVEI T3,-1 ;SET -1
CAMN T1,T3 ;IS THIS THE CORRECT DEVICE?
MOVEM T4,DEVCH2(T2) ;YES, STORE NEW DIR #
AOBJN T2,SPOL1L ;LOOP FOR ALL DEVICES
SMRETN ;AND EXIT
SPOOL2: UMOVE T1,0(Q1) ;GET DEVICE DESIGNATOR
CALL CHKDES ;CHECK ITS LEGALITY
RETERR ;BAD DESIGNATOR
MOVE T3,DEVCH2(T2) ;GET DIR NUMBER
JUMPN T3,SPOL2A ;IF SET, RETURN VALUE
MOVX T1,RC%EMO ;EXACT MATCH ONLY
HRROI T2,[ASCIZ/PS:<SPOOL>/] ;GET DEFAULT VALUE
RCDIR ;GET THE DIRECTORY NUMBER
TXNE T1,RC%NOM!RC%AMB ;NO MATCH OR AMBIGUOUS?
RETERR (SPLX6) ;YES
SPOL2A: UMOVEM T3,1(Q1) ;STORE ANSWER
SMRETN
; Set tab stops
.STABS::MCENT
CALL CHKTTY
JRST MRETN
UMOVE 1,2
UMOVE 3,3
UMOVE 4,4
CALL TTSTBS
JRST MRETN
; Set time and date
; Call: 1 ; Date and time in standard format
; STAD
; Return
; +1 ; Can't set because not wheel or opr
; +2 ; Ok
.STAD:: MCENT
MOVE B,CAPENB
TRNN B,SC%WHL!SC%OPR
SKIPGE TADIDT
JRST STAD1
MOVEI A,STADX1
RETERR()
STAD1: CALL LGTAD ;GET CURRENT DATE/TIME
MOVEM A,CKPDTL ;SAVE AS LAST DATE/TIME
UMOVE A,1 ;RE-FETCH USER ARG
MOVE B,TODPWL ;JIFFIES SINCE STARTUP (BY POWERLINE)
MUL B,[1B17] ;SHIFT BINARY POINT
DIV B,JFDAY ;COMPUTE DAYS AND FRACTION SINCE STARTUP
CAML C,JFDAY2 ;ROUND
AOS B
SUB A,B ;COMPUTE ACTUAL SYSTEM STARTUP TAD
MOVEM A,TADIDT ;SAVE IT
CALL TIMZDT ;CAUSE TIMER QUEUE TO BE RESCHEDULED
CALL NXTASC ;Recompute next automatic accounting shift change
SKIPN JOBNO ;IS THIS OTHER THAN JOB 0?
SMRETN
CALL DTTIME ;YES. SEND TIME TO ALL 11'S
MOVEI T1,.USENT ;WRITE ENTRY FUNCTION
MOVEI T2,TADLST ;ARG LIST
USAGE ;LOG THIS FACT
SMRETN
TADLST: USENT. (.UTTAD,1,1) ;DATE-TIME CHANGE
USDTL. (CKPDTL) ;OLD DATE/TIME
0 ;END OF LIST
; String to device
; Call: 1 ; Device designator
; STDEV
; Return
; +1 ; Error
; +2 ; Ok
; 2 ; Device designator
.STDEV::MCENT
UMOVE A,1
CALL STDEV0 ;DO THE WORK
JRST [ UMOVEM A,2 ;RETURN ERROR CODE IN 2
EMRETN ()] ;GIVE ERROR RETURN
UMOVEM A,2 ;RETURN DEVICE DESIGNATOR
JRST SKMRTN ;GIVE SKIP RETURN
STDEV0: CALL CPYFUS
RETBAD (GJFX22) ;JSB FULL
MOVEI D,0 ;SEE IF TERMINATED WITH A COLON
MOVE B,A ;GET POINTER TO STRING
HRLI B,(POINT 7,0,34) ;MAKE IT INTO A BYTE POINTER
STDEV1: ILDB C,B ;SCAN FOR A COLON
CAIE C,":" ;FOUND THE END OF THE DEVICE STRING?
CAIN C," " ;EITHER COLON OR SPACE IS A TERMINATOR
SKIPA ;YES, FOUND A TERMINATOR
JUMPN C,STDEV1 ;NO, AT END OF STRING?
DPB D,B ;YES, PUT A NULL IN ON TOP OF COLON
PUSH P,A
SETZ B, ;INDICATE NO DIRECTORY SEARCH
CALL CHKLND ; GO CHECK FOR A LOGICAL NAME FIRST
CALL STDEVP ; GO SEE ABOUT A PHYSICAL DEVICE
JRST STDEV2 ; ERROR CODE IN A
HLRZ B,A ;GET DEVICE DESIGNATOR
HRRZ C,A ;GET UNIT NUMBER
CAIE C,-1 ;IS IT SPECIAL?
CAIE B,.DVDES+.DVDSK ;NO, IS IT A STRUCTURE?
JRST [ AOS -1(P) ;NO, GIVE SKIP RETURN
JRST STDEV2]
LDB B,[POINT STRNS,A,35] ;GET STRUCTURE INDEX
MOVE B,STRTAB(B) ;GET SDB ADDRESS
LOAD B,STRJB,(B) ;GET FORK INIT'ING STRUCTURE
SKIPE B ;SKIP IF NOT BEING INIT'ED
JRST [ CAMN B,FORKX ;Are we the fork doing it?
JRST .+1 ;Yes, so that's ok
MOVEI T1,STDVX1 ;No, say "No such device",
JRST STDEV2] ;and give error return
AOS -1(P) ;YES, GIVE SKIP RETURN
STDEV2: EXCH A,0(P) ;SAVE ANSWER, RESTORE PNTR
MOVE B,A ; TO B
MOVEI A,JSBFRE ;SAY JSB FREE SPACE
CALL RELFRE ;RELEASE IT
POP P,A ;RESTORE ANSWER (OR ERROR)
RET ;RETURN
;ROUTINE TO GET PHYSICAL DEVICE DESIGNATOR
;ACCEPTS IN A/ STRING POINTER TO DEVICE NAME
; CALL STDEVP
;RETURNS +1: ERROR - ERROR CODE IN A
; +2: OK, DEVICE DESIGNATOR IN A
STDEVP::CALL DEVLUX ; Look up the device name
JRST [ CAIE A,GJFX16
JRST .+1
MOVEI A,STDVX1
RET] ; NO SUCH DEVICE
HRRZ A,DEVUNT(B)
ANDI A,DV%UNT ;MASK TO UNIT
CAIN A,DV%UNT ;CHECK FOR -1
MOVEI A,-1 ;YES SET IT -1
HLRZ D,DEVCHR(B) ;GET DEVICE TYPE
TRZ D,777000 ;...
CAIE A,-1 ;SPECIAL CASE OF UNIT #
CAIE D,.DVDSK ;CHECK FOR DISK (STR)
JRST STDVP1 ;NOT STRUCTURE - GO ON
HRRZ A,C ;GET UNIQUE CODE
HRLI A,.DVDES+.DVDSK ;RETURN STR DESIGNATOR
RETSKP
STDVP1: HRRZ A,DEVUNT(B) ;GET DEVICE AGAIN
HRL A,D ;SET DEVICE TYPE
TLO A,.DVDES ; SET DEVICE DESIGNATOR CODE
RETSKP
; Simulate teletype input
; A/ DESIGNATOR (SHOULD BE TTY)
; B/ CHARACTER
.STI:: MCENT
CALL CHKTTR ;MAKE SURE WE'RE DEALING WITH A TERMINAL
ITERR (TTYX1) ;NOT A TERMINAL OR NO SUCH TERMINAL
MOVE T3,CAPENB ;WHEEL OR OPERATOR CAN DO IT
TXNE T3,SC%WHL!SC%OPR
JRST STI2
MOVEM T2,Q1 ;SAVE LINE NUMBER
NOSKED ;GO NOSKED WHILE LOOKING AT LINE DATA
CALL STADYN ;POINT TO DYNAMIC DATA
ITERR (TTYX01,<OKSKED>) ;NOT ACTIVE. ONLY PRIVILEGED CAN SEND TO IT
CALL TTCKAD ;ACCEPTING ADVICE?
JRST [ CALL CHKTTY ;DO WE HAVE ACCESS?
ITERR (DESX2,<OKSKED>) ;NO. RETURN ERROR
JRST .+1] ;YES. PROCEED
OKSKED
MOVE T2,Q1 ;GET LINE NUMBER
STI2: UMOVE T1,T2 ;GET CHARACTER
CALL TTSTI ;PUT CHARACTER IN INPUT BUFFER
ITERR ()
JRST MRETN
; Read fact switch
;ACCEPTS IN 1/ FUNCTION TO BE TESTED
; TMON
;RETURNS +1: ALWAYS - VALUE IN AC 2
.TMON:: MCENT
UMOVE T1,1
JUMPL T1,TMONER ;CODE MUST BE POSITIVE
CAIL T1,^D36 ;DOES IT FIT IN FLAG WORD?
JRST TMON2 ;NO, SEE IF OTHER CODE IS VALID
MOVNS T1 ;GET MASK
MOVX T2,1B0
LSH T2,0(T1)
TDNN T2,FACTSW ;TEST BIT
TMONZ: TDZA T1,T1 ;BIT NOT SET
TMONO: MOVEI T1,1 ;BIT IS SET
TMONV: UMOVEM T1,2 ;RETURN VALUE
JRST MRETN ;RETURN TO USER
TMON2: CAIL T1,^D36+NTMON2 ;LEGAL CODE FOR TMON?
TMONER: ITERR (TMONX1) ;NO
XCT TMON2T-^D36(T1) ;YES, GET THE VALUE
JRST TMONV ;NON-SKIP RETURNS A VALUE
JUMPE T1,TMONZ ;SKIPS RETURN 0 OR 1 ONLY
JRST TMONO ;RETURN A ONE
;TABLE OF TMON FUNCTIONS
TMON2T: SKIPA T1,NETON ;44 - IS NETWORK ON?
JRST TMONER ;45 IS WRITE-ONLY
JRST TMONER ;46 IS WRITE-ONLY
MOVE T1,TIMZON ;47-RETURN LOCAL TIME ZONE
MOVE T1,NLHOST ;50-RETURN LOCAL ARPANET HOST NUMBER
MOVE T1,AVALON ;51-RETURN ACCOUNT VALIDATION STATUS
MOVE T1,STSBLK ;52-RETURN VALUE OF STATUS REPORTING
CALL TGTOK ;53-RETURN STATE OF THIS GETOK FUNCTION
MOVE T1,TPRCYC ;54-RETURN TAPE RECYCLE TIME
MOVE T1,DIRRDU ;55-RETURN VALUE OF DIR READ MASK
MOVE T1,ARRCYC ;56-RETURN ARCHIVE TAPE RECYCLE TIME
SKIPA T1,NRTWTS ;57-WAIT FOR RETRIEVALS?
MOVE T1,TPMTDF ;60-TAPE MOUNT CONTROLS
SKIPA T1,PRELDF ;61-WORKING SET PRELOADING
NTMON2==.-TMON2T ;NUMBER OF LEGAL CODES OVER 35
TGTOK: TRNE T2,400000 ;CHECK FOR USER FUNCTION CODE
TDZA T1,T1 ;FORCE FOR USER FUNCTION
SKIPE T1,T2 ;GET FUNCTION CODE
CAIL T1,MXGOKF ;CHECK FOR LEGAL FUNCTION
ITERR (TMONX1)
HLL T1,GTOKPR(T1) ;GET FLAGS
;**;[3003]Add 1 line at TGTOK: + 6L TAB 29-AUG-83
HRR T1,T2 ;[3003]PUT ORGINAL VALUE BACK IN RH
RET ;RETURN FLAGS,,FUNCTION TO USER
;USAGE JSYS
; 1/ FLAGS,,FUNCTION
; 2/ ADDRS OF PARAMETERS
.USAGE::
HRRZ T3,T1 ;Get function
CAIE T3,.USSAS ;Set or
CAIN T3,.USRAS ; read accounting shifts?
JRST USG001 ;Yes-- OK if USAGE not enabled
MOVE T3,FACTSW ;SEE IF ENABLED
TXNN T3,SF%USG ;???
JRST MRETN ;NO - JUST RETURN
USG001:
HRRZ T3,T1 ;GET FUNCTION
CAILE T3,MXUFN ;VALID?
ITERR (ARGX02)
CALL @UFCNTB(T3) ;DISPATCH
ITERR () ;RETURN ERROR
JRST MRETN ;RETURN
;USAGE FUNCTION TABLE
UFCNTB: DTBDSP (UFNENT) ; 0 - MAKE ENTRY
DTBDSP (UFNCLS) ; 1 - CLOSE OUT FILE
DTBDSP (UFNCKP) ; 2 - PERFORM CHECKPOINT
DTBDSP (UFNLGI) ; 3 - LOGIN
DTBDSP (UFNLGO) ; 4 - LOGOUT
DTBDSP (UFNCHG) ; 5 - SESSION CHANGE
DTBDSP (UFNCKI) ; 6 - SET CHECKPOINT INTERVAL (MINS)
DTBDSP (UFNENA) ; 7 - ENABLE ACCOUNT VALIDATION
DTBDSP (UFNCAS) ; 10 - Change accounting shift
DTBDSP (UFNSAS) ; 11 - Set accounting shifts
DTBDSP (UFNRAS) ; 12 - Read accounting shifts
MXUFN==.-UFCNTB-1
;ROUTINE TO CHECK FOR PRIVS
USGPRV: MOVE T2,CAPENB ;GET CAP'S
MOVE T3,MPP ;LOOK BACK TO CALLERS PC
MOVE T3,0(T3) ; FLAGS
TXNE T3,UMODF ;CALLED FROM MONITOR?
TXNE T2,SC%WHL!SC%OPR ; OR PRIV.
RETSKP ;OK TO GO ON
RETBAD (CAPX1) ;NEITHER - FAIL
;DEFINITIONS OF INTERNAL FORMAT OF SYSTEM-DATA FILE
;WORDS 0 & 1 ARE QUEUE HEADERS
DEFSTR (UHTYP,UQDAT+0,17,18) ;TYPE CODE
DEFSTR (UHLEN,UQDAT+0,35,18) ;ENTRY LENGTH
DEFSTR (UHTAD,UQDAT+1,35,36) ;ENTRY DATE/TIME
DEFSTR (UHDRV,UQDAT+2,5,6) ;DEC REVISION #
DEFSTR (UHCRV,UQDAT+2,11,6) ;CUST REVISION #
DEFSTR (UHTMT,UQDAT+2,17,6) ;TERMINAL TYPE CODE
DEFSTR (UHJNO,UQDAT+2,35,18) ;JOB #
DEFSTR (UHPNM,UQDAT+3,35,36) ;PROGRAM NAME (SIXBIT)
DEFSTR (UHPVR,UQDAT+4,35,36) ;PROGRAM VERSION NUMBER (STD FORM)
DEFSTR (UHMVR,UQDAT+5,35,36) ;MONITOR VERSION NUMBER (STD FORM)
DEFSTR (UHJTS,UQDAT+6,0,1) ;BATCH := 1 , T/S := 0
DEFSTR (UHULN,UQDAT+6,5,5) ;USER NAME STRING LEN
DEFSTR (UHSL1,UQDAT+6,11,6) ;STRING LENGTH #1 (ACCOUNT)
DEFSTR (UHSL2,UQDAT+6,17,6) ;STRING LENGTH #2 (SESSION REMARK)
DEFSTR (UHLNO,UQDAT+6,35,18) ;LINE NUMBER
DEFSTR (UHNOD,UQDAT+7,35,36) ;NODE NAME (SIXBIT)
UHNAM==UQDAT+10 ;LOC OF FIRST WORD OF USER NAME
UHMIN==UQDAT+20 ;MINIMUM ENTRY SIZE (FOR ASGSWP)
USQMAX==^D20 ;MAX USAGE QUEUE LENGTH
;RECORD LENGTH TABLE
RECLTB: 0 ;0 - ILLEGAL
MOVEI T1,UHMIN+^D16 ;1 - MONITOR RESTART
MOVEI T1,UHMIN+^D22 ;2 - SESSION RECORD
0 ;3 - ILLEGAL
0 ;4 - ILLEGAL
MOVEI T1,UHMIN+^D2 ;5 - DATE/TIME CHANGE
0 ;6 - BATCH PROCESSOR
MOVEI T1,UHMIN+^D27 ;7 - INPUT SPOOLER
MOVEI T1,UHMIN+^D30 ;8 - OUTPUT SPOOLER
CALL UGETDL ;9 - DISK STORAGE USAGE
0 ;10 - DISK SPINDLE USAGE
MOVEI T1,UHMIN+^D29 ;11 - STRUCTURE MOUNT
MOVEI T1,UHMIN+^D35 ;12 - MAGTAPE MOUNT
0 ;13 - DECTAPE MOUNT (TOPS10)
0 ;14 - FILE COMMAND (TOPS10)
MOVEI T1,UHMIN+^D29 ;15 - FILE RETRIEVED
MOVEI T1,UHMIN+^D29 ;16 - FILE ARCHIVED
MOVEI T1,UHMIN+^D29 ;17 - FILE MIGRATED
MOVEI T1,UHMIN+^D29 ;18 - FILE COLLECTED
MXRCTP==.-RECLTB-1
;FORMAT TABLE INDEXED BY RECORD TYPE
UFNFRM: 0 ;0 - ILLEGAL
-UFRSTL,,UFRSTT ;1 - RESTART RECORD
-UFLOGL,,UFLOGT ;2 - SESSION RECORD
0 ;3 - ILLEGAL
0 ;4 - ILLEGAL
-UFTADL,,UFTADT ;5 - DATA/TIME CHANGE
0 ;6 - BATCH PROCESSOR
-UFINPL,,UFINPT ;7 - INPUT SPOOLER
-UFOUTL,,UFOUTT ;8 - OUTPUT SPOOLER
-UFDSKL,,UFDSKT ;9 - DISK STORAGE USAGE
0 ;10 - DISK SPINDLE USAGE
-UFSTRL,,UFSTRM ;11 - STRUCTURE MOUNT
-UFMTAL,,UFMTAM ;12 - MAGTAPE MOUNT
0 ;13 - DECTAPE MOUNT (TOPS10)
0 ;14 - FILE COMMAND (TOPS10)
-UFRETL,,UFRETT ;15 - FILE RETRIEVE
-UFRETL,,UFRETT ;16 - FILE ARCHIVED
-UFRETL,,UFRETT ;17 - FILE MIGRATED
-UFRETL,,UFRETT ;18 - FILE COLLECTED
;TABLE FOR DATE/TIME CHANGE FORM
UFTADT: [-1],,.USDTL ;DATE/TIME BEFORE CHANGE (MANDATORY)
UFTADL==.-UFTADT
;TABLE FOR SYSTEM RESTART FORM
UFRSTT: [0,,SVN],,.USSNM ;SYSTEM NAME
[EXP SVNM],,.USMVR ;MONITOR VERSION NUMBER
SYSTAD,,.USMBD ;MONITOR BUILD DATE/TIME
;**;[1942] Add one line at UFRSTT: +3L RAS 15-SEP-81
USGMUP,,.USMUP ;[1942] MONITOR UPTIME (IN SECONDS)
APRSER,,.USCP0 ;SERIAL NUMBER (CPU0)
[-1],,.USLCK ;DATE/TIME LAST CHECKPOINT (MAND.)
UFRSTL==.-UFRSTT
;TABLE OF SESSION RECORD ITEMS
UFLOGT: [0,,ACCTSR],,.USACT ;ACCOUNT STRING
[0,,JSSRM+1],,.USCOM ;SESSION REMARK
CTIMON,,.USSST ;SESSION START TIME
CONCON,,.USCCT ;CONSOLE CONNECT TIME
JBRUNT,,.USRTM ;RUNTIME
JBBNAM,,.USBJN ;BATCH JOB NAME
JBBSEQ,,.USBSN ;BATCH SEQUENCE NUMBER
UFLOGL==.-UFLOGT ;LENGTH OF TABLE
CKOFF==:-UFLOGL+2 ;OFFSET FROM END OF DATA FOR
;BEGINNING OF CHECKPOINT DATA
CKITMS==:3 ;NUMBER OF CHECKPOINT ITEMS
;TABLE FOR DISK USAGE STATISTICS
UFDSKT: [-1],,.USSTR ;STRUCTURE NAME
[-1],,.USDIR ;DIRECTORY NAME
[-1],,.USNRF ;NUMBER OF ACCOUNTS
[-1],,.USTUS ;TOTAL SPACE USED
[-1],,.USTNF ;TOTAL NUMBER OF FILES
[-1],,.USLIQ ;LOGGED IN QUOTA
[-1],,.USLOQ ;LOGGED OUT QUOTA
[-1],,.USLLI ;DATE/TIME LAST LOGIN
[-1],,.USDSX ;STRUCTURE/DIRECTORY INFO WORD (SPECIAL)
[-1],,.USDST ;DISK STATISTICS TABLE
UFDSKL==.-UFDSKT
;TABLE FOR INPUT SPOOLER RECORD (NO DEFAULTS)
UFINPT: [-1],,.USACT ;ACCOUNT STRING
[-1],,.USTXT ;SYSTEM/OPERATOR TEXT
[-1],,.USSRT ;SPOOLER RUNTIME
[-1],,.USSDR ;DISK READS
[-1],,.USSDW ;DISK WRITES
[-1],,.USJNM ;JOB NAME
[-1],,.USQNM ;QUEUE NAME
[-1],,.USSDV ;ACTUAL INPUT DEVICE
[-1],,.USSSN ;SEQUENCE NUMBER
[-1],,.USSUN ;SPOOLER UNITS (CARDS)
[-1],,.USCRT ;DATE/TIME OF REQUEST
[-1],,.USDSP ;DISPOSITION
[-1],,.USPRI ;PRIORITY
UFINPL==.-UFINPT
;TABLE FOR OUTPUT SPOOLER RECORD (NO DEFAULTS)
UFOUTT: [-1],,.USACT ;ACCOUNT STRING
[-1],,.USTXT ;SYSTEM/OPERATOR TEXT
[-1],,.USSRT ;SPOOLER RUNTIME
[-1],,.USSDR ;DISK READS
[-1],,.USSDW ;DISK WRITES
[-1],,.USJNM ;JOB NAME
[-1],,.USQNM ;QUEUE NAME
[-1],,.USSDV ;ACTUAL OUTPUT DEVICE
[-1],,.USSSN ;SEQUENCE NUMBER
[-1],,.USSUN ;SPOOLER UNITS (OUTPUT)
[-1],,.USCRT ;DATE/TIME OF REQUEST
[-1],,.USDSP ;DISPOSITION
[-1],,.USPRI ;PRIORITY
[-1],,.USSNF ;NUMBER OF FILES PROCESSED
[-1],,.USSCD ;SCHEDULED DATE/TIME
[-1],,.USFRM ;FORMS TYPE
UFOUTL==.-UFOUTT
;TABLE FOR STRUCTURE MOUNT RECORD (NO DEFAULTS)
UFSTRM: [-1],,.USACT ;ACCOUNT STRING
[-1],,.USTXT ;SYSTEM/OPERATOR TEXT
[-1],,.USSSI ;STRUCTURE ID
[-1],,.USSTP ;STRUCTURE TYPE CODE
[-1],,.USTNP ;TOTAL NUMBER OF PACKS
[-1],,.USKTP ;CONTROLLER TYPE
[-1],,.USDTP ;DEVICE TYPE
[-1],,.USDSP ;DISPOSITION
[-1],,.USCRT ;DATE/TIME OF REQUEST
[-1],,.USSCD ;SCHEDULED DATE/TIME
[-1],,.USSRV ;SERVICED DATE/TIME
[-1],,.USMCT ;MOUNT COUNT BEFORE MOUNT
[-1],,.USDCT ;MOUNT COUNT AFTER DISMOUNT
[-1],,.USATP ;ACCESS TYPE
[-1],,.USEUT ;ELASPED USE TIME
UFSTRL==.-UFSTRM
;TABLE FOR MAGTAPE MOUNT RECORD (NO DEFAULTS)
UFMTAM: [-1],,.USACT ;ACCOUNT STRING
[-1],,.USTXT ;SYSTEM/OPERATOR TEXT
[-1],,.USVID ;VOLUME IDENTIFIER
[-1],,.USVSN ;VISUAL SERIAL NUMBER
[-1],,.USMRF ;THOUSANDS OF FRAMES READ
[-1],,.USMWF ;THOUSANDS OF FRAMES WRITTEN
[-1],,.USDSP ;DISPOSITION
[-1],,.USCRT ;DATE/TIME OF REQUEST CREATION
[-1],,.USSCD ;SCHEDULED DATE/TIME
[-1],,.USSRV ;SERVICED DATE/TIME
[-1],,.USKTP ;TYPE OF CONTROLLER
[-1],,.USMLT ;LABEL TYPE
[-1],,.USMLS ;LABEL STATE
[-1],,.USMRD ;NUMBER OF PHYSICAL RECORDS READ
[-1],,.USMWR ;NUMBER OF PHYSICAL RECORDS WRITTEN
[-1],,.USFSI ;FILE SET IDENTIFIER
[-1],,.USSRE ;NUMBER OF SOFT READ ERRORS
[-1],,.USSWE ;NUMBER OF SOFT WRITE ERRORS
[-1],,.USHRE ;NUMBER OF HARD READ ERRORS
[-1],,.USHWE ;NUMBER OF HARD WRITE ERRORS
[-1],,.USEUT ;ELAPSED USE TIME
UFMTAL==.-UFMTAM
UFRETT: [-1],,.USACT ; Account of file or retrieve requestor
[-1],,.USDIR ; Directory of file
[-1],,.USSSI ; SIXBIT STRUCTURE ID
[-1],,.USUSG ; # pages involved
[-1],,.USTP1 ; Tape 1 ID
[-1],,.USTS1 ; Saveset # for tape 1
[-1],,.USTF1 ; Tape file # for tape 1
[-1],,.USTP2 ; Tape 2 ID
[-1],,.USTS2 ; Saveset for tape 2
[-1],,.USTF2 ; Tape file # for tape 2
[-1],,.USRSN ; Reason file moved offline
UFRETL==.-UFRETT
;PASS SPECIAL FUNCTION TO JOB 0 AND WAIT
UFNCAS: ;Change accounting shift
UFNCLS: ;Close checkpoint file
UFNCKP: ;Checkpoint all jobs
CALL USGPRV ;VALIDATE PRIVS
RETBAD ()
UFNCK1: NOINT ;BEST TO BE NOINT
MOVEI T1,2 ;GET 2 WORDS
CALL ASGSWP ;FROM SWAPPABLE FREE SPACE
JRST [ CALL ASGWAT ;WAIT FOR STORAGE
JRST UFNCK1] ;TRY AGAIN
XCTU [HRRZ T2,1] ;RE-FETCH USER FUNCTION
STOR T2,UQFCN,(T1) ;SAVE IN BLOCK
LOCK (USGLOK) ;WANT DATA BASE LOCKED FOR THIS FCN
CALL ONUSQ ;QUEUE UP MESSAGE
OKINT
AOS JB0FLG ;POKE JOB 0 FOR THESE
MOVEI T1,USGWAT ;WAIT TILL FUNCTION DONE!
MDISMS ;DISMISS
RETSKP ;GOOD RETURN
;RESIDENT SCHEDULAR TEST TO WAIT FOR JOB 0 TO DO FUNCTION
RESCD
USGWAT: SKIPL USGLOK ;UNLOCKED?
JRST 0(4) ;NO - WAIT SOME MORE
JRST 1(4) ;YES - WAKEUP
SWAPCD
;JACKET ROUTINE TO ENABLE ACCOUNT VALIDATION
UFNENA: MOVE T1,CAPENB ;GET ENABLED CAPABILITIES
TXNN T1,SC%WHL!SC%OPR ;WHOPER DOING THIS?
ITERR (CAPX1) ;NO, RETURN ERROR
CALL ENACT ;GO DO THE WORK
RETBAD ()
RETSKP ;GIVE SUCCESSFUL RETURN
;ROUTINE TO SET CHECKPOINT INTERVAL
;**;[2890]Add two line at UFNCKI: +0L RWW 21-DEC-82
UFNCKI: CALL USGPRV ;[2890]CHECK PRIVS
RETBAD() ;[2890]no privs, return an error
UMOVE T1,2 ;GET USER ARGUMENT
IMULI T1,^D60000 ;CONVERT TO MS
MOVEM T1,CKPINV ;SET INTERVAL
RETSKP ;GOOD RETURN
;WRITE ENTRY INTO USAGE FILE
UFNENT: CALL UFNINI ;BUILD HEADER
RETBAD () ;ERROR
LOAD T1,UHTYP,(Q1) ;GET ENTRY TYPE CODE
UFNEN0: CAIL T1,.UTUSR ;USER-DEFINED ENTRY TYPE?
JRST [ CALL UFNFAR ;YES-- FILL ARBITRARY RECORD BLOCK
JRST UFNINX ;ERROR-- RETURN TO USER
JRST UFNEN1] ;ENTRY ALL FINISHED-- PUT ON QUEUE
MOVE T1,UFNFRM(T1) ;GET FORM POINTER
CALL UFNFIL ;FILL IN FORM
JRST UFNINX ;MISSING ITEM
UFNEN1: MOVE T1,Q1 ;POINT TO RECORD FOR QUEUE
CALL ONUSQ ;ENQUE MESSAGE
OKINT ;DONE
RETSKP ;...
;COMMON ROUTINE TO HANDLE ALL JOB LOGGING
UFNLGI:
UFNLGO:
UFNCHG: SKIPN JOBNO ;IGNORE FOR JOB 0
RETSKP
CALL UFNINI ;INIT BLOCK
RETBAD () ;PASS ERROR UP
MOVEI T1,.UTSEN ;SESSION ENTRY TYPE CODE
CALLRET UFNEN0 ;FILL IN REMAINDER AND QUEUE IT
;ROUTINE TO FILL RECORD FROM TABLE SPECIFIED
;CALL: T1/ -LEN,,TABLE-BEG
; Q1/ POINTER TO BEGINNING OF BUFFER
; Q2/ POINTER TO USER'S RECORD DESCRIPTOR BLOCK
; Q3/ POINTER TO FIRST FREE DATA ITEM
;
;COPY DATA INTO BUFFER AND UPDATE HEADER TO SHOW LENGTH
;RETURN WITH Q3 UPDATED TO END OF BLOCK
UFNFIL: TRVAR <UFCHI,STRLX>
SETOM STRLX ;INIT INDEX
MOVE T4,T1 ;COPY TO T4
UFNFL1: MOVEM T4,UFCHI ;SAVE INDEX
HRRZ T1,0(T4) ;FETCH ITEM CODE
HLRZ T2,0(T4) ;ADDRS OF DEFAULT ITEM
MOVE T2,0(T2) ;SETUP DEFAULT
CALL UFWFET ;GET WORD
RETBAD () ;PASS UP ERROR
LDB T3,[POINTR (T1,US%TYP)] ;GET DATA TYPE
CAILE T3,MXUITP ;MAX USAGE ITEM TYPE?
RETBAD (USGX03) ;ILLEGAL USAGE ITEM TYPE
CALL @UTYPTB(T3) ;FILL IN DATA ITEM
RETBAD () ;PASS ERROR UP
MOVE T4,UFCHI ;RESTORE INDEX
AOBJN T4,UFNFL1 ;LOOP TILL ALL DONE
;HERE WHEN ALL DONE FILLING THE ENTRY
UFNFIE: MOVE T1,Q3 ;COPY POINTER
SUBI T1,1(Q1) ;ACTUAL DATA LENGTH
STOR T1,UHLEN,(Q1) ;STORE IN RECORD
MOVE T1,UQDAT(Q1) ;COPY HEADER
MOVEM T1,0(Q3) ;TO LAST WORD
RETSKP
;STRING LENGTH TABLE
STRLNT: STOR T2,UHSL1,(Q1) ;STORE IN STRING LEN #1
STOR T2,UHSL2,(Q1) ;STORE IN STRING LEN #2
;USAGE ITEM TYPE TABLE
UTYPTB: DTBDSP (UFLASC) ;0 - STRING
DTBDSP (UFLSIX) ;1 - SIXBIT WORD
DTBDSP (UFLOCT) ;2 - OCTAL WORD
DTBDSP (UFLDEC) ;3 - DECIMAL WORD
DTBDSP (UFLDAT) ;4 - DATE/TIME WORD
DTBDSP (UFLTAB) ;5 - TABLE (SPECIAL)
DTBDSP (UFLVER) ;6 - VERSION NUMBER
DTBSKP ;7 - SPACE FILL (SKIP)
MXUITP==.-UTYPTB-1
;ROUTINE TO STORE FULL WORDS
;T2 / DATA WORD
UFLVER:
UFLOCT:
UFLDEC:
UFLDAT: MOVEM T2,0(Q3) ;SAVE WORD IN BUFFER
AOJA Q3,RSKP ;ADVANCE POINTER AND RETURN
;ROUTINE TO STORE STRING
;T2 / STRING POINTER
UFLASC: TLCE T2,-1 ;CHECK FOR 0,,ADDRS
TLC T2,-1 ;NO - MUST BE BPNTR
CALL UFCPY0 ;COPY STRING INTO BLOCK
RET
AOS T1,STRLX ;STEP INDEX
XCT STRLNT(T1) ;STORE LENGTH
RETSKP ;GOOD RETURN
;ROUTINE TO FILL IN TABLE INFO
;T2 / TABLE BASE ADDRS
;**;[2607] Change one line at UFLTAB: +0L JGZ 3-APR-82
UFLTAB: SAVEAC <Q1,Q2> ;[2607] SAVE Q1,Q2
STKVAR <TBLCNT,TBLSTO>
MOVE Q2,T2 ;SAVE BASE ADDRS
UMOVE T1,0(Q2) ;FETCH TABLE HEADER
HRRZ T2,T1 ;GET LENGTH OF ADDITIONAL ITEMS
MOVNM T2,TBLCNT ;SAVE NEG COUNT
HLRZ Q1,T1 ;GET LENGTH OF TABLE
UFLTB1: MOVEM Q3,TBLSTO ;SAVE ADDRS OF STRING LENGTH
AOS Q3 ;STEP TO NEXT LOC
UMOVE T3,1(Q2) ;FETCH WORD FROM TABLE
HRRZ T2,T3 ;ADDRESS OF DATA ITEMS
HRL T2,TBLCNT ;FORM -N,,ADDRS
UFLTB2: UMOVE T1,0(T2) ;GET ITEM
MOVEM T1,0(Q3) ;STORE IN BUFFER
AOS Q3 ;ADVANCE TO NEXT LOC
AOBJN T2,UFLTB2 ;LOOP OVER ALL ITEMS
HLRO T2,T3 ;GET POINTER TO STRING
CALL UFCPY0 ;COPY TO BUFFER
JFCL
HRRZM T2,@TBLSTO ;STASH LENGTH
AOS Q2 ;STEP TO NEXT LOC
SOJG Q1,UFLTB1 ;LOOP OVER TABLE
RETSKP ;DONE
;ROUTINE TO GET SIXBIT ARGUMENT, MAY BE POINTER TO AN ASCIZ STRING
UFLSIX: HLRZ T1,T2 ;CHECK FOR POINTER
CAIE T1,-1
CAIN T1,(POINT 7,,)
JRST UFLSX0 ;STRING - COPY IT FIRST
UFLSXX: MOVEM T2,0(Q3) ;STORE WORD
AOJA Q3,RSKP ;AND GIVE GOOD RETURN
;ASCIZ STRING POINTER - CONVERT TO SIXBIT
UFLSX0: STKVAR <SIXBP>
MOVE T1,T2 ;COPY POINTER
HRLI T1,(POINT 7,,)
MOVEI T4,6 ;MAX 6 CHARS
SETZ T2, ;CLEAR ANSWER
MOVE T3,[POINT 6,T2]
MOVEM T3,SIXBP ;INIT OUTPUT BP
UFLSX1: XCTBU [ILDB T3,T1] ;FETCH A CHAR
JUMPE T3,UFLSXX ;DONE IF NULL
SUBI T3,40 ;CONVERT TO SIXBIT
IDPB T3,SIXBP ;SAVE IN RESULT
SOJG T4,UFLSX1 ;LOOP TILL DONE
JRST UFLSXX ;STORE RESULT
; UFNFAR -- FILL ARBITRARY RECORD FOR USER ENTRY TYPE
;
; CALL:
; Q1/ POINTER TO BEGINNING OF BUFFER
; Q2/ POINTER TO USER'S RECORD DESCRIPTOR BLOCK
; Q3/ POINTER TO FIRST FREE DATA ITEM
;
; RETURNS:
; +1: ERROR, CODE IN T1
; +2: SUCCESS, ENTRY READY TO PUT ON QUEUE
;
; DESTROYS T1-T4, Q3
UFNFAR: CALL UFNFNA ;FIND THE "ARBITRARY RECORD TYPE" ITEM
; RETURNS USER ADDRESS IN T3
;FORM AOBJN POINTER TO REMAINING DATA BLOCK IN Q3
LOAD T1,UQLEN,(Q1) ;GET LENGTH OF DATA BLOCK
ADD T1,Q1 ;FIND END OF BLOCK
SUBM Q3,T1 ;GET -VE WORDS LEFT TO FILL IN T1
HRL Q3,T1 ;FORM AOBJN POINTER IN Q3
;LOOP THROUGH THE USER'S RECORD DESCRIPTOR BLOCK (T3) FOR ALL ITEMS
; AND STORE THEM IN DATA BLOCK (Q3)
UFNFA1: UMOVE T1,0(T3) ;GET ITEM TYPE WORD
JUMPE T1,UFNFIE ;END-- ALL DONE, COMPUTE LENGTH AND RETURN +2 FROM UFNFAR
JUMPGE Q3,[RETBAD (ARGX05)] ;IF NO ROOM-- RDB MUST HAVE GROWN!!
MOVEM T1,0(Q3) ;STORE THE ITEM TYPE WORD IN THE DATA BLOCK
AOBJN Q3,.+1 ;COUNT THAT WORD IN DATA BLOCK
ADDI T3,2 ;POINT TO NEXT USER ENTRY NOW
LDB T4,[POINTR (T1,US%TYP)] ;EXTRACT ITEM TYPE
CAIN T4,.USSPC ;SPACE FILL?
JRST UFNFA1 ;YES-- NO DATA FOR THIS
UMOVE T2,-1(T3) ;GET USER'S DATA WORD OR POINTER
CAMN T2,[EXP -1] ;USER WANT DEFAULT VALUE FOR THIS ITEM?
RETBAD (USGX03) ;YES-- THERE ARE NO DEFAULTS IN ARBITRARY ENTRIES
CAIN T4,.USASC ;ASCII STRING?
JRST UFNFA5 ;YES-- MUST COPY WHOLE STRING
;ALL OTHER DATA TYPES ARE EXACTLY ONE WORD-- GET THE WORD AND PUT IT AWAY
TXNE T1,US%IMM ;IMMEDIATE MODE DATA ITEM?
JRST UFNFA3 ;YES-- WE HAVE THE DATA ITEM IN T2
MOVX T2,<MOVE T2,@0> ;NO-- MUST PERFORM INDIRECT FETCH
HRRI T2,-1(T3) ; VIA THE USER'S DATA WORD POINTER
XCTUU T2 ;FETCH USER'S DATA WORD TO T2
UFNFA3: JUMPGE Q3,[RETBAD (ARGX05)] ;IF NO ROOM-- RDB MUST HAVE GROWN!!
MOVEM T2,0(Q3) ;STORE THE USER'S DATA WORD IN DATA BLOCK
AOBJN Q3,.+1 ;COUNT THAT WORD IN DATA BLOCK
JRST UFNFA1 ;LOOP FOR ALL ITEMS
;ASCII STRING ITEM-- COPY THE ENTIRE STRING TO THE DATA BLOCK
UFNFA5: LDB T1,[POINTR (T1,US%LEN)] ;GET LENGTH OF STRING IN BYTES
ADDI T1,4 ;ROUND UP
IDIVI T1,5 ; TO FULL WORDS
UMOVE T2,-1(T3) ;GET ADDRESS OF STRING
UFNFA6: JUMPLE T1,UFNFA1 ;DONE IF NO MORE USER WORDS LEFT, GET NEXT ITEM
UMOVE T4,0(T2) ;GET WORD FROM USER'S STRING
ADDI T2,1 ;BUMP USER STRING ADDRESS
JUMPGE Q3,[RETBAD (ARGX05)] ;IF NO ROOM-- RDB MUST HAVE GROWN!!
MOVEM T4,0(Q3) ;STORE IT IN DATA BLOCK
AOBJN Q3,.+1 ;COUNT THAT WORD IN DATA BLOCK
SOJA T1,UFNFA6 ;COUNT DOWN WORD COUNT, LOOP FOR ENTIRE STRING
;ROUTINE TO SETUP BLOCK OF STORAGE AND FILL IN HEADER INFO
;RETURNS: +1 ERROR CODE IN T1
; +2 NOINT
; Q1/ STORAGE BLOCK FROM ASGSWP
; Q2/ POINTER TO USER'S ARGLST
; Q3/ POINTER TO FIRST FREE WORD IN BLOCK
UFNINI: CALL USGPRV ;CHECK PRIVS
RETBAD ()
UFNIN0: UMOVE Q2,2 ;GET CALLER ARGS
XCTU [HRRZ T2,0(Q2)] ;GET RECORD TYPE CODE
CAIG T2,MXRCTP ;VALIDATE
SKIPN T1,RECLTB(T2) ;SKIP IF VALID TYPE CODE
JRST [ CAIL T2,.UTUSR ;MAYBE IT'S A USER ENTRY 5000-9999
CAILE T2,^D9999 ; . . ?
RETBAD (USGX01) ;NO-- REALLY INVALID ENTRY TYPE
CALL UFNINS ;USER ENTRY TYPE-- COMPUTE LENGTH
JRST UFNI01] ;LENGTH OF USER ENTRY NOW IN T1
XCT T1 ;RETURNS LENGTH IN T1
UFNI01: NOINT ;BEST BE NOINT
MOVE T2,USQCNT ;SEE IF OVER QUEUE QUOTA
CAIGE T2,USQMAX ;...
CALL ASGSWP ;ALLOCATE STORAGE
JRST [ CALL ASGWAT ;WAIT FOR SOME
JRST UFNIN0] ;START OVER
MOVE Q1,T1 ;SAVE POINTER TO BLOCK
XCTU [HRRZ T1,1] ;GET USER FUNCTION AGAIN
STOR T1,UQFCN,(Q1) ;STORE IN QUEUE HEADER
UMOVE T2,0(Q2) ;GET ARG HEADER
STOR T2,UHTYP,(Q1) ;STORE TYPE IN BLOCK
LDB T1,[POINT 9,T2,8] ;GET DEC REV
STOR T1,UHDRV,(Q1)
LDB T1,[POINT 9,T2,17] ;GET CUST REV
STOR T1,UHCRV,(Q1)
GTAD ;CURRENT DATE/TIME
STOR T1,UHTAD,(Q1)
MOVE T1,JOBNO ;JOB NUMBER
STOR T1,UHJNO,(Q1)
;**;[3036] Add 5 lines at UFNI01+22L YKT NOV-03-83
; SETZRO UHNOD,(Q1) ;[3036] NODE (ZERO FOR NOW)
;**;[3110] Change 1 line at UFNI01+23L DEE 18-MAY-84
MOVEI T1,LLSR ;[3036][3110] REMOVE INDEX REGISTER P1 - LLSR HAS NODE NAME
HRLI T1,440700 ;[3036]
CALL ASZSIX ;[3036]
;**;[3041] Modify one line YKT NOV-08-83
; JFCL ;[3041][3036]
SETZM T1 ;[3041]
STOR T1,UHNOD,(Q1) ;[3036]
MOVE T1,[EXP SVNM] ;MONITOR VERSION NUMBER
STOR T1,UHMVR,(Q1)
MOVEI Q3,0 ;INIT TO ZERO
STOR Q3,UHJTS,(Q1)
MOVE T1,CTRLTT ;CONTROLLING TERMINAL
STOR T1,UHLNO,(Q1) ;SAVE
JUMPL T1,[MOVEI Q3,'D' ;SAY DETACHED
MOVX T1,OB%BSS ;GET BATCH STREAM SET FLAG
TDNN T1,BATSTF ;DETACHED BATCH JOB?
TDZA T1,T1 ; NO, MARK TIMESHARING
SETOM T1 ; YES, REMEMBER
JRST UFNI02] ;AND GO STORE FLAG
CAMN T1,CTYLNO ;CTY?
MOVEI Q3,'C' ;YES
CAMGE T1,CTYLNO ;REAL TTY
MOVEI Q3,'T' ;YES
CALL PTYGBB ;SEE IF PTY
JRST [ SKIPN Q3 ;ANYTHING?
MOVEI Q3,'U' ;NO - UNKNOWN
JRST UFNIN1] ;PROCEDE
MOVEI Q3,'P' ;SAY ITS A PTY
UFNI02: STOR T1,UHJTS,(Q1) ;STORE BATCH/TS FLAG
;..
;..
UFNIN1: STOR Q3,UHTMT,(Q1) ;STORE TERMINAL TYPE CODE
;**;[2635]ADD 7 LINES AT UFNIN1:+1L TAM 28-JUL-82
MOVEI T1,.USNOD ;[2635]NODE TYPE CODE
LOAD T2,UHNOD,(Q1) ;[2635]DEFAULT
CALL UFWFET ;[2635]ONE SUPPLIED?
JRST [CAIE T1,USGX02 ;[2635]NONE?
JRST UFNINX ;[2635]SOME OTHER ERROR
JRST .+1] ;[2635]USE DEFAULT
STOR T2,UHNOD,(Q1) ;[2635]SAVE IT
MOVEI T1,.USJTY ;JOB TYPE CODE
LOAD T2,UHJTS,(Q1) ;USE DEFAULT
CALL UFWFET ;GET ARG IF SUPPLIED
JRST [ CAIE T1,USGX02 ; USE DEFAULT IF ITEM NOT FOUND
JRST UFNINX ; ELSE ERROR
JRST .+1]
STOR T2,UHJTS,(Q1) ;NOW STORE ACTUAL WANTED
MOVEI T1,.USPNM ;CALLING PROGRAM NAME
MOVE T2,JOBNO ;DEFALUT TO SYSTEM NAME
MOVE T2,JOBPNM(T2) ;...
CALL UFWFET ;FIND ENTRY & FETCH
JRST [ CAIE T1,USGX02 ;USE DEFAULT IF ITEM NOT FOUND
JRST UFNINX ;ERROR EXIT
JRST .+1]
STOR T2,UHPNM,(Q1) ;STORE
MOVEI T1,.USPVR ;PROGRAM VERSION
MOVEI T2,0 ;DEFAULT NONE
CALL UFWFET
JRST [ CAIE T1,USGX02 ;USE DEFAULT IF ITEM NOT FOUND
JRST UFNINX ;ERROR EXIT
JRST .+1]
STOR T2,UHPVR,(Q1) ;STORE
MOVEI T1,.USNM2 ;USER NAME
MOVEI T2,USRNAM+1 ;DEFAULT
MOVEI Q3,UHNAM(Q1) ;POINT TO NAME STRING ADDRS
CALL UFCPYU ;COPY STRING
JRST [ CAIE T1,USGX02 ;USE DEFAULT IF ITEM NOT FOUND
JRST UFNINX ;ERROR EXIT
CALL UFCPY0 ;USE DEFAULT (IN T2)
JFCL ;WONT HAPPEN
JRST .+1]
STOR T2,UHULN,(Q1) ;STORE LENGTH
RETSKP ;RETURN
;ERROR EXIT WITH OKINT (CODE IN T1)
UFNINX: PUSH P,T1 ;SAVE CODE
MOVE T1,Q1 ;POINT TO BLOCK
LOAD T2,UQLEN,(T1) ;SETUP SIZE
CALL RELSWP ;RELEASE SPACE
OKINT ;ALLOW INTS
POP P,T1 ;RESTORE CODE
RETBAD ()
; UFNINS -- COMPUTE DATA BLOCK LENGTH FOR ARBITRARY USER ENTRIES 5000-9999
;
; CALL:
; Q2/ POINTER TO USER'S RECORD DESCRIPTOR BLOCK
;
; RETURNS:
; +1: ALWAYS
; T1/ SIZE OF DATA BLOCK NEEDED (FOR ASGSWP)
;
; DESTROYS T1-T4
UFNINS: CALL UFNFNA ;FIND FIRST ARBITRARY RECORD ITEM, USER ADDRESS IN T3
MOVX T4,UHMIN+1 ;START COUNT WITH REQUIRED PART OF DATA BLOCK
;LOOP THROUGH USER'S RECORD DESCRIPTOR BLOCK AND COUNT THE SIZE OF EACH ENTRY IN T4
UFNIS1: UMOVE T1,0(T3) ;GET ITEM TYPE CODE WORD
JUMPE T1,UFNIS9 ;ZERO MEANS END-- COMPUTE SIZE AND RETURN
ADDI T4,1 ;COUNT THE ITEM TYPE WORD
ADDI T3,2 ;STEP TO NEXT USER ITEM NOW
LDB T2,[POINTR (T1,US%TYP)] ;GET ITEM DATA TYPE
CAIN T2,.USSPC ;SPACE FILL?
JRST UFNIS1 ;YES-- NO DATA WORD FOR THIS
CAIE T2,.USASC ;ASCII STRING?
AOJA T4,UFNIS1 ;NO-- DATA IS EXACTLY ONE WORD, SO COUNT AND GET NEXT ITEM
;ASCII STRING-- SIZE IN WORDS IS ( <LENGTH IN BYTES> + 4 ) / 5
LDB T1,[POINTR (T1,US%LEN)] ;GET LENGTH IN BYTES
ADDI T1,4 ;ROUND UP
IDIVI T1,5 ; TO FULL WORDS
ADD T4,T1 ;COUNT THE STRING LENGTH
JRST UFNIS1 ;LOOP FOR NEXT ITEM
;END OF BLOCK-- RETURN LENGTH IN T1
UFNIS9: MOVE T1,T4 ;COPY LENGTH
RET ;RETURN +1 FROM UFNINS
; UFNFNA -- FIND FIRST ARBITRARY RECORD ENTRY
; CALL: Q2/ POINTER TO USER RECORD DESCRIPTOR BLOCK
; RETURNS:
; +1: T3/ POINTER TO USER'S ARBITRARY RECORD DESCRIPTOR
; DESTROYS T1-T4
UFNFNA: MOVE T3,Q2 ;COPY BEGINNING OF USER REC DESC BLK
UFNFN1: UMOVE T1,1(T3) ;GET AN ITEM CODE WORD--SKIP HEADER
JUMPE T1,UFNFN9 ;ZERO IS END-- RETURN NOW
LDB T2,[POINTR (T1,US%COD)] ;GET ITEM CODE
CAIE T2,.USUAR ;ARBITRARY RECORD DELIMITER?
JRST [ ADDI T3,2 ;NO-- BUMP TO NEXT ITEM
JRST UFNFN1] ; AND GO ON LOOKING
UFNFN9: AOJA T3,R ;YES-- RETURN CORRECT POINTER FROM UFNFNA
;ROUTINE TO COPY STRING ARGUMENT INTO USAGE BLOCK
; CALL: T1/ ITEM CODE
; T2/ DEFAULT STRING PNTR
; Q3/ DEST ADDRS
;
;RETURN +1 ERROR
; +2 LENGTH IN T2, UPDATED ADDRS IN Q3
UFCPYU: CALL UFWFET ;GET WORD (SHOULD BE POINTER)
RETBAD () ;PASS ERROR UP
UFCPY0: MOVEI T1,-1(Q3) ;POINT TO DESTINATION ADDRS
TLNN T2,-1 ;MAYBE 0,,ADDRS
JRST UFCPY2 ;YES - STRING IN MONITOR SPACE
CALL CPYFU1 ;COPY STRING FROM USER SPACE
JFCL ;CANT HAPPEN
UFCPYX: IBP T2 ;ADVANCE TO NULL
MOVEI T1,1(T2) ;POINT TO WORD AFTER STRING
SUBI T2,-1(Q3) ;NUMBER OF FULL WORDS
MOVE Q3,T1 ;RETURN UPDATED POINTER IN Q3
RETSKP ;GOOD RETURN
UFCPY2: HRLI T1,(<POINT 7,,35>) ;DESTINATION BP
HRLI T2,(<POINT 7,,>) ;SOURCE BP
SETZ T3, ;TERMINATE ON NULL
SOUT ;COPY STRING
MOVE T2,T1 ;RETURN UPDATED STRING IN T2
JRST UFCPYX ;COMMON EXIT
;ROUTINE TO FETCH LENGTH OF DISK USAGE BLOCK
UGETDL: MOVEI T1,.USDST ;LOOK FOR THIS ITEM TYPE
SETO T2, ;NO DEFAULT
CALL UFWFET ;...
JRST [ MOVEI T1,UHMIN+^D24
RET] ;RETURN DEFAULT
UMOVE T3,0(T2) ;FETCH TABLE HEADER
HRRZ T1,T3 ;NUMBER OF DATA ITEMS PER ENTRY
ADDI T1,MAXLW+1 ; PLUS MAX STRING LENGTH+1
HLRZS T3 ;NUMBER OF TABLE ENTRIES
IMUL T1,T3 ;TOTAL ITEMS (MAX STORAGE)
ADDI T1,UHMIN+^D24 ; PLUS FIXED AMOUNT
RET ;RETURN
;ROUTINE TO FIND ENTRY IN CALLER'S LIST
; T1/ DESIRED ARG TYPE CODE
;RETURNS: T1/ ITEM DESC
; T2/ DATA ENTRY
; T3/ POINTER TO ENTRY
USFFND: MOVE T3,Q2 ;COPY ARG BLOCK ADDRS
MOVE T4,T1 ;COPY ARG TO T4
USFFN1: UMOVE T1,1(T3) ;FETCH ARG
JUMPE T1,[RETBAD (USGX02)] ;NOT FOUND
ADDI T3,2 ;POINT TO DATUM
LDB T2,[POINTR (T1,US%COD)] ;GET ITEM CODE
CAME T2,T4 ;CHECK MATCH
JRST USFFN1 ;NO - LOOP
UMOVE T2,0(T3) ;RETURN 2ND WORD
CAMN T2,[-1] ;-1 GIVEN
TXO T1,US%IMM ;YES - SET IMMED FLAG
RETSKP ;GOOD RETURN
;ROUTINE TO FETCH WORD ITEM FROM ARGLIST (RETURN IN T2)
; CALL: T1/ ITEM CODE
; T2/ DEFAULT VALUE
UFWFET: STKVAR <DFLT>
MOVEM T2,DFLT ;SAVE DEFAULT VALUE
CALL USFFND ;FIND ITEM
RETBAD (,<MOVE T2,DFLT>)
LDB T4,[POINTR (T1,US%TYP)]
TXNN T1,US%IMM ;IMMEDIATE CODE?
CAIN T4,.USASC ;STRING TYPE?
JRST UFWFT1 ;YES - DONT FETCH WORD
HRLI T3,(<MOVE T2,@0>) ;NO - FORM INDIRECT FETCH
XCTUU T3 ; AND GET ACTUAL VALUE
UFWFT1: CAME T2,[-1] ;WANT DEFAULT?
RETSKP ;NO - GOOD RETURN
MOVE T2,DFLT ;YES - GET IT
CAMN T2,[-1] ;DEFAULT ALLOWED?
RETBAD (USGX03) ;NO RETURN ERROR
RETSKP ;RETURN
;ROUTINE TO WAIT A BIT FOR FREE STORAGE
ASGWAT: OKINT ;ALLOW INTS
AOS JB0FLG ;POKE JOB 0
MOVEI T1,^D1000 ;WAIT 1 SEC
DISMS
RET ;RETURN
;ROUTINE TO QUEUE UP MESSAGE FOR JOB 0
; T1/ ADDRS OF MESSAGE
ONUSQ: NOSKED ;PREVENT RACES
AOS USQCNT ;INCREMENT
SETZRO UQLNK,(T1) ;MARK END OF QUEUE
MOVE T2,USGEND ;GET END POINTER
STOR T1,UQLNK,(T2) ;STORE LINK TO NEXT ITEM
MOVEM T1,USGEND ;NEW POINTER
OKSKED
RET ;RETURN
;ROUTINE TO REMOVE TOP ITEM FROM Q
OFFUSQ::NOINT ;BE NOINT FOR RELFRE
NOSKED ;INTERLOCK
SOS USQCNT ;DECREMENT
SKIPN T1,USGBEG ;ANYTHING ON QUEUE?
JRST [ OKSKED ;NO--
OKINT
RET] ; JUST RETURN
LOAD T2,UQLNK,(T1) ;GET POINTER TO NEXT
MOVEM T2,USGBEG ;STORE NEW HEAD
JUMPN T2,OFFUS1 ;JUMP IF MORE ON LIST
MOVEI T2,USGBEG-1 ;RESET END
MOVEM T2,USGEND ; ...
OFFUS1: OKSKED ;ALLOW SCHED
LOAD T2,UQLEN,(T1) ;GET LENGTH
CALL RELSWP ;RELEASE BLOCK AND RETURN
OKINT
RET
; ENABLE ACCOUNT VALIDATION
; RETURNS: +1 ERROR, ERROR CODE IN AC1
; +2 SUCCESS
ENACT::STKVAR <<ENFDB,3>,ENJFN>
LOCK ACTLCK
MOVE T1,ACTOFN ;ACCOUNT DATA BASE OFN
CAMN T1,[-1] ;IS AN OFN ASSIGNED YET?
JRST ENAC0 ;NO, JUST CONTINUE
SETZ T1, ;UNMAP PAGE WITH HASH TABLE
HRRZI T2,HSHPG
CALL SETMPG
SETZ T1, ;UNMAP ACCOUNT WINDOW PAGE
HRRZI T2,ACTPG
CALL SETMPG
SETOM ACTPGN ;NO ACCT WINDOW PAGE MAPPED IN NOW
MOVE T1,ACTOFN
CALL RELOFN ;RELEASE THE OFN
CAMGE T1,[-1] ;IS THE FILE COMPLETELY CLOSED?
RETBAD (ENACX1,<UNLOCK ACTLCK>) ;NO, ERROR
SETOM ACTOFN ;NOW WE HAVE NO OFN FOR ACCT DATA BASE
ENAC0: MOVX T1,GJ%OLD+GJ%SHT+.GJDEF
HRROI T2,[ASCIZ/PS:<SYSTEM>ACCOUNTS-TABLE.BIN/]
GTJFN ;GET JFN FOR MOST RECENT DATA BASE
RETBAD (ENACX2,<UNLOCK ACTLCK>)
MOVEM T1,ENJFN ;SAVE JFN FOR NOW
MOVX T2,<3,,.FBCTL> ;GET FDB STATUS WORD AND XB DISK ADDRESS
MOVEI T3,ENFDB ;PLACE TO PUT FDB INFO
GTFDB
ERJMP ENACX ;CATCH ANY ERRORS
MOVE T1,ENFDB ;EXAMINE FILE STATUS
TXNE T1,FB%LNG ;IS IT A LONG FILE?
RETBAD (ENACX3,<UNLOCK ACTLCK>)
;**;[6732] Remove edit 1724 and replace one line with 4 EHL 26-june-85
MOVE T1,[540000,,SYSTDN] ;[6732] Get quota remaining
CALL IGTDAL ;[6732] ...
RETBAD (,<UNLOCK ACTLCK>)
MOVE T4,T1 ;[6732] Logged-in quota
SUB T4,T2 ;[6732] minus current usage is quota remaining
MOVEI T1,ENFDB
MOVE T1,2(T1) ;GET XB DISK ADDRESS
MOVEI T2,PSNUM ;AND STRUCTURE # OF PS:
MOVEI T3,SYSTDN ;DIR # OF <SYSTEM>
;**;[1724] Replace one line at ENAC0: +16L JGZ 4-JUN-80
; HRLZI T4,377777 ;[1724]INFINITE REMAINING QUOTA
CALL ASGOFN ;GET AN OFN FOR THE DATA BASE
RETBAD (ENACX4,<UNLOCK ACTLCK>)
MOVEM T1,ACTOFN ;SAVE THE NEW OFN
HRLZS T1 ;OFN,, PAGE ZERO
MOVX T2,PM%RD ;READ ACCESS TO THE HASH PAGE
HRRI T2,HSHPG
CALL SETMPG ;MAP IN THE HASH TABLE AT HSHPG
MOVE T1,ENJFN ;GET JFN FOR FILE
RLJFN ;RELEASE IT
RETBAD ( ,<UNLOCK ACTLCK>)
SETOM ACTPGN ;NO ACCT WINDOW PAGE MAPPED IN NOW
SETOM AVALON ;ACCOUNT VALIDATION NOW TURNED ON
UNLOCK ACTLCK ;ALL DONE FIDDLING WITH THESE PAGES NOW
RETSKP ;GIVE GOOD RETURN
ENACX: RETBAD ( ,<UNLOCK ACTLCK>)
;Set/read automatic accounting shift change table functions
;
; User args:
; AC2/ Table address
;
; Table format:
; XWD actual number of entries, maximum number of entries
; <table entry>
; . . .
; <table entry>
;
; Table entry format:
; LH: Days-of-week entry is applicable, bit n on means
; day-of-week n (0=Monday)
; RH: Time in seconds since midnight when shift change should occur
MAXASC==^D100 ;Maximum number of entries in table
;Set table
UFNSAS: CALL USGPRV ;Check priviledges
RETBAD () ;No luck
UMOVE T2,2 ;Get table address
XCTU [HLRZ Q1,0(T2)] ;Get actual number of enties from table header
CAILE Q1,MAXASC ;Reasonable table size?
RETBAD (ARGX04) ;No-- agument block too long
;Get non-resident dynamic storage for the new table
NOINT ;DON'T ALLOW ^C WHILE FREE SPACE NOT SIGNED OUT
JUMPE Q1,UFNSA2 ;If table is zero length, just remove old one
MOVEI T1,1(Q1) ;Get size of table + 1 (for size word)
CALL ASGSWP ;Get storage
RETBAD () ;None available-- return error
;Form AOBJN pointer to new table in Q1
MOVEI T3,1(T1) ;Get address + 1 in T3 (for BLT)
MOVE T1,Q1 ;Get length (for BLT)
MOVN Q1,Q1 ;Get -ve size
HRLZ Q1,Q1 ; to LH
HRR Q1,T3 ;Form AOBJN pointer
;Copy user's table into monitor space
UMOVE T2,2 ;Get table address
ADDI T2,1 ;Skip header word
CALL BLTUM1 ;Copy table from monitor space
;Set new table, remove old one if any
UFNSA2:
LOCK ASCLOK ;Lock database and pointer
EXCH Q1,ASCPTR ;Store new pointer, get old one
UNLOCK ASCLOK ;Unlock database
JUMPE Q1,UFNSA8 ;All done if no old table
MOVEI T1,-1(Q1) ;Get address of size word
MOVE T2,0(T1) ;Get size of block from size word
CALL RELSWP ;Return the block to free pool
UFNSA8: OKINT
CALL NXTASC ;Compute next accounting shift change
RETSKP ;Return successful from UFNSAS
;Read table
UFNRAS: CALL USGPRV ;Check for privilged user
RETBAD () ;No luck
LOCK ASCLOK ;Lock database and pointer
HLRE T1,ASCPTR ;Get -ve length of table
MOVN T1,T1 ;Compute number of entires
UMOVE T3,2 ;Get user table address
XCTU [HRRZ T2,0(T3)] ;Get max size of user table
CAMGE T2,T1 ;Will monitor table fit in user table?
JRST [ UNLOCK ASCLOK
RETBAD (ARGX05)] ;No-- Argument block too small
XCTU [HRLM T1,0(T3)] ;Yes-- store size of actual table
HRRZ T2,ASCPTR ;Get monitor's table address
ADDI T3,1 ;Skip header word in user table
;**;[1787] Change one line at UFNRAS: +13L JGZ 24-SEP-80
SKIPE T1 ;[1787] Any data to move?
CALL BLTMU1 ;Yes-- copy monitor table to user space
UNLOCK ASCLOK ;Unlock database
RETSKP ;Return successful from UFNRAS
;THE UTEST JSYS - BASIC UNIT TESTING FACILITY
;ACCEPTS IN 1/ FUNCTION CODE ,, LENGTH OF ARGUMENT BLOCK
; 2/ ADDRESS OF ARGUMENT BLOCK
;FUNCTION 0 = START TESTING
; 1 = STOP TESTING
;ARGUMENT BLOCK:
;LOC 0/ ADDRESS OF MONITOR ROUTINE TO TEST
;LOC 1/ NUMBER OF WORDS TO BE TESTED
;LOC 2/ START OF BIT TABLE OF ADDRESSES TO BE TESTED
; BIT = 0 MEANS DO NOT TEST THE CORRESPONDING LOCATION
; BIT = 1 MEANS TEST THIS LOCATION
;ON THE STOP TESTING FUNCTION THE BIT TABLE IS MODIFIED TO CONTAIN:
; BIT = 0 MEANS THIS LOCATION WAS EXECTUTED DURING THE TESTING
; BIT = 1 MEANS THAT THIS LOCATION WAS NOT EXECUTED
.UTEST::MCENT
NOINT ;DO NOT ALLOW INTERRUPTS
MOVE T1,CAPENB ;SEE IF THE CALLER IS PRIVILEGED
TXNN T1,SC%WHL ;MUST BE A WHEEL
ITERR (CAPX3) ;NOT A WHEEL, THIS JSYS IS NOT LEGAL
XCTU [HLRZ T3,1] ;GET THE FUNCTION CODE
CAIL T3,UTABLN ;IS THIS A LEGAL FUNCTION
ITERR (UTSTX1) ;NO, GIVE ERROR
XCTU [HRRZ T4,1] ;GET LENGTH OF ARG BLOCK
UMOVE T1,2 ;GET ADDRESS OF ARG BLOCK
SUBI T4,2 ;GET NUMBER OF WORDS TO TEST
IMULI T4,^D36 ;ONE BIT FOR EACH WORD
SKIPG T4 ;IS THERE AN ARG BLOCK?
TDZA T2,T2 ;NO
UMOVE T2,1(T2) ;GET THE NUMBER OF WORDS FROM ARG BLOCK
CAMG T4,T2 ;TAKE THE SMALLER VALUE
MOVE T2,T4 ;...
MOVE T3,UTAB(T3) ;GET DISPATCH ADDRESS
CALL 0(T3) ;DO THIS FUNCTION
ITERR() ;FAILED
MRETNG ;SUCCESS
UTAB: UTEST0 ;FUNCTION 0 - START TESTING
UTEST1 ;FUNCTION 1 - STOP TESTING
UTABLN==.-UTAB
;ROUTINE TO INSERT THE TEST INSTRUCTION INTO THE ROUTINE TO BE TESTED
;ACCEPTS IN T1/ ADR OF ARG BLOCK
; T2/ # OF BITS IN BIT TABLE
UTEST0: CAIL T2,UTNPG*PGSIZ ;TOO LARGE A REQUEST?
RETBAD (UTSTX2) ;YES, CANNOT DO THIS REQUEST
NOSKED ;NOW SECURE THE INTERLOCK
SKIPL UTLOCK ;IS THIS FEATURE AVAILABLE?
RETBAD (UTSTX3,<OKSKED>) ;NO, ALREADY IN USE
MOVE T3,FORKX ;YES, PUT OUR FORK NUMBER IN UTLOCK
MOVEM T3,UTLOCK ;WE NOW OWN THE FACILITY
OKSKED
MOVSI P3,(<POINT 1,0(P2)>) ;SET UP TO SCAN BIT TABLE
XCTU [HRRZ P1,0(T1)] ;GET ADDRESS OF MONITOR ROUTINE
MOVEM P1,UTBASE ;SAVE FOR EXIT
MOVEI P2,2(T1) ;GET START OF BIT TABLE
MOVE P4,T2 ;GET COUNT OF WORDS TO TEST
MOVEM T2,UTLEN ;SAVE COUNT FOR EXIT
MOVEI Q1,777(T2) ;LOCK DOWN THE BUFFER AREA
LSH Q1,-PGSFT ;GET # OF PAGES NEEDED FOR BUFFER AREA
SETZ Q2,
UT0L1: MOVEI T1,UTPGS(Q2) ;GET ADR OF NEXT PAGE TO LOCK
CALL MLKMA ;LOCK IT DOWN
ADDI Q2,PGSIZ ;STEP TO NEXT PAGE
SOJG Q1,UT0L1 ;LOOP BACK TIL ALL PAGES LOCKED
CALL SWPMWE ;WRITE ENABLE THE MONITOR
MOVE T3,[CALL UTREP] ;GET THE INSTRUCTION TO BE INSERTED
MOVEI T4,UTPGS ;GET START OF BUFFER AREA
UT0L2: XCTBMU [ILDB T1,P3] ;GET NEXT BIT FROM USER BIT TABLE
MOVE T2,(P1) ;GET NEXT INSTRUCTION FROM ROUTINE
MOVEM T2,(T4) ;STORE IT IN THE BUFFER
AOS T4 ;STEP TO NEXT LOCATION IN BUFFER
AND T2,[777000,,0] ;GET INSTRUCTION OPCODE
CAMN T2,[ERJMP] ;IS THIS AN ERJMP OR ERCAL
SETZ T1, ;YES, DO NOT TEST THIS LOCATION
TLCE T2,777000 ;IS THE OPCODE = 0?
TLCN T2,777000 ;OR 777?
SETZ T1, ;YES, DO NOT CHANGE THIS LOCATION
SKIPE T1 ;SHOULD THIS LOCATION BE CHANGED?
MOVEM T3,(P1) ;YES, PUT "CALL REP" IN ITS PLACE
AOS P1 ;STEP TO NEXT WORD IN ROUTINE
SOJG P4,UT0L2 ;LOOP BACK TIL ALL WORDS SET UP
RETSKP ;DONE
;ROUTINE TO REMOVE THE TEST INSTRUCTION AND REPORT RESULTS
;ACCEPTS IN T1/ ADR OF ARG BLOCK
; T2/ # OF BITS IN BIT TABLE
UTEST1: MOVE T3,UTLOCK ;SEE IF WE OWN THIS FACILITY
CAME T3,FORKX ;...
RETBAD (UTSTX3) ;WE DO NOT, SO DO NOT ALLOW THIS
MOVE P1,UTBASE ;GET START ADR OF ROUTINE BEING TESTED
MOVSI P3,(<POINT 1,0(P2)>) ;SET UP BYTE POINTER
MOVEI P2,2(T1) ;GET POINTER TO THE START OF BIT MASK
MOVE P4,T2 ;GET # OF WORDS TO STORE BACK
MOVE P5,UTLEN ;GET # OF WORDS IN ORIGINAL TEST CALL
MOVEI T4,UTPGS ;GET START OF BUFFER
UT1L: MOVE T2,(P1) ;GET INSTRUCTION FROM ROUTINE
MOVE T3,(T4) ;GET ORIGINAL INSTRUCTION FROM BUFFER
MOVEI T1,1 ;START OFF WITH "UNEXECUTED" RESPONSE
CAME T2,[CALL UTREP] ;DID THIS INST GET EXECUTED?
TDZA T1,T1 ;YES, RETURN 0 TO USER
MOVEM T3,(P1) ;STORE ORIGINAL INSTRUCTION BACK
SOSL P4 ;USER WANT ANY MORE?
XCTBMU [IDPB T1,P3] ;YES, STORE THE ANSWER
AOS T4 ;STEP TO NEXT WORD IN BUFFER
AOS P1 ;STEP TO NEXT WORD IN MONITOR
SOJG P5,UT1L ;LOOP TIL ALL INSTRUCTIONS ARE RESTORED
MOVEI P1,777-UTPGS(T4) ;NOW UNLOCK THE PAGES
LSH P1,-PGSFT ;GET COUNT OF PAGES TO BE DONE
UT1LL: MOVEI T1,<UTPGS_-PGSFT>-1(P1) ;GET PAGE #
HRL T1,MMSPTN ;GET PTN OF MONITOR MAP
CALL MULKPG ;UNLOCK THE PAGE
SOJG P1,UT1LL ;LOOP TIL ALL PAGES UNLOCKED
CALL SWPMWP ;WRITE PROTECT THE MONITOR AGAIN
SETOM UTLOCK ;GIVE UP THE FACILITY
RETSKP ;AND EXIT
;ROUTINE TO RELEASE THE UTEST RESOURCES ON A FORK KILL
UTREL:: SETZB T1,T2 ;DO NOT GET ANY RESULTS BACK
CALL UTEST1 ;GO RELEASE THIS FACILITY
JFCL ;IF IT FAILS, WE CAN DO NOTHING
RET ;DONE
;ROUTINE TO RETURN THE ORIGINAL VALUES TO THE TESTED ROUTINE
RESCD
UTREP:: PUSH P,T1 ;SAVE AN AC FOR SCRATCH
SOS -1(P) ;GET ADDRESS OF CALLING INSTRUCTION
HRRZ T1,-1(P) ;...
SUB T1,UTBASE ;GET OFFSET INTO BUFFER
MOVE T1,UTPGS(T1) ;GET THE ORIGINAL INSTRUCTION
MOVEM T1,@-1(P) ;RESTORE THE LOC TO ITS ORIGINAL STATE
POP P,T1 ;RESTORE THE SCRATCH AC
UTREPE::RET ;AND GO DO THE ACTUAL INSTRUCTION
SWAPCD
; VALIDATE ACCOUNT
; CALL: T1/ 36-BIT USER # OR DIRECTORY #
; T2/ POINTER TO ACCOUNT STRING
; VACCT
; RETURNS: +1 ALWAYS
.VACCT::MCENT
STKVAR <VERNO,VERPTR>
UMOVE T1,1 ;GET USER OR DIR #
CAME T1,[-1] ;IS THIS FOR CURRENT USER?
JRST VACCT0 ;NO
MOVE T1,JOBNO ;YES,
MOVE T1,JOBDIR(T1) ;GET LOGGED-IN DIRECTORY
HRLI T1,USRLH ;MAKE IT A USER NUMBER
VACCT0: MOVEM T1,VERNO ;SAVE FOR NOW
HLRZS T1
CAIN T1,USRLH ;IS IT A USER NUMBER?
JRST [ MOVE T1,VERNO ;YES, GET WHOLE NUMBER
CALL CNVDIR ;CONVERT IT TO A DIRECTORY NUMBER
JRST VACCT1] ;AND CONTINUE
MOVE T1,VERNO ;GET DIRECTORY NUMBER
VACCT1: CALL SETDIR ;MAP IN THE DIRECTORY
ITERR () ;ERROR, TELL USER
UMOVE T1,2 ;GET POINTER TO ACCOUNT STRING
CALL CPYFUS ;DRAG IN THE ACCOUNT
ITERR (MONX02) ;ERROR, JSB FULL
MOVEM T1,VERPTR ;SAVE LOOKUP POINTER TO ACCT STRING
UMOVEM T3,2 ;RETURN UPDATED POINTER TO USER
MOVE T1,VERNO ;USER OR DIR #
MOVE T2,VERPTR ;LOOKUP POINTER TO ACCOUNT STRING
CALL VERACJ ;GO VALIDATE THE ACOUNT
JRST VACCTX
VACCT2: MOVEI T1,JSBFRE ;RELEASE CPYFUS'ED STRING
MOVE T2,VERPTR
CALL RELFRE
CALL USTDIR ;UNMAP DIR
OKINT ;CPYFUS WENT NOINT
MRETNG ;SUCCESS RETURN
; CALL TO VERACT FAILED
VACCTX: MOVEM T1,LSTERR ;SAVE ERROR CODE
REPEAT 0,<
MOVE T1,JOBNO
MOVE T1,JOBDIR(T1) ;GET THIS JOB'S LOGIN DIR NO
CAIN T1,OPERDN ;VALIDATING FOR OPERATOR?
JRST VACTX2 ;YES, CHECK FOR SPECIAL OPER ACCOUNT
> ;END OF REPEAT 0
VACTX1: MOVEI T1,JSBFRE ;RELEASE SPACE FOR CPYFUS'ED STRING
MOVE T2,VERPTR
CALL RELFRE
CALL USTDIR ;UNMAP DIRECTORY
OKINT ;CPYFUS WENT NOINT
MOVE T1,LSTERR
ITERR ( ) ;ERROR RETURN
REPEAT 0,<
VACTX2: MOVE T2,VERPTR
AOS T2 ;POINT TO ACCOUNT TO VALIDATE
MOVE T1,[-2,,[ASCIZ/OPERATOR/]]
VACTX3: MOVE T3,0(T1) ;GET NEXT WORD IN ACCT STRING
CAME T3,0(T2) ;ACCOUNTS THE SAME SO FAR?
JRST VACTX1 ;NO, CLEAN UP AND RETURN ERROR
AOS T2
AOBJN T1,VACTX3 ;SCAN SOME MORE
JRST VACCT2 ;USING SPECIAL ACCOUNT, GIVE OK RETURN
> ;END OF REPEAT 0
; INTERNAL ROUTINE TO VALIDATE AN ACCOUNT
; CALL: T1/ 36-BIT USER OR DIRECTORY NUMBER
; T2/ LOOKUP POINTER TO AN ACCOUNT STRING
; CALL VERACT
; RETURNS: +1 FAILED, ERROR CODE IN T1
; +2 SUCCESS, T1/ AC%MCH => ACCOUNT MATCHES ACCTSR
; T2/ ACCOUNT EXPIRATION DATE
; T3/ DEFAULT CLASS FOR ACCOUNT
; -1=> NO DEFAULT CLASS
VR%USR==:1B0 ;MEANS VALIDATING FOR A USER NUMBER
;USED INTERNALLY BY VERACT IN FLAG AC Q1
VERACJ: TDZA T3,T3 ;INDICATE VERACJ ENTRY
VERACT::SETO T3,0 ;INDICATE VERACT ENTRY
SKIPN AVALON ;ACCOUNT VALIDATION RUNNING?
JRST [ SETZB T1,T2 ;NO, GIVE GOOD RETURN IMMEDIATELY
SETZ T3,0 ;CLASS 0
RETSKP]
SAVEQ
TRVAR <STRINX,VERABJ,VERHDR,VERLOC,VERLUK,VERNUM,<VERTMP,2>,VERCLS,VEREPT>
SETZ Q1, ;INITIALIZE FLAG AC
MOVEM T2,VERLUK ;SAVE LOOKUP PTR TO ACCT STRING
MOVEM T1,VERNUM ;SAVE USER OR DIR #
MOVEM T3,VEREPT ;SAVE ENTRY TYPE
HLRZS T1
CAIN T1,USRLH ;IS IT A USER NUMBER?
JRST [ TXO Q1,VR%USR ;NOTE THAT A USER NUMBER WAS PASSED
JRST VERAC1] ;AND CONTINUE
CALL CNVSTR ;IS THIS A DIRECTORY #?
RETBAD ( ) ;ERROR, RETURN
MOVEM T1,STRINX ;SAVE STR: INDEX INTO STRTAB
; ARGUMENTS PASSED TO VERACT ARE OK
; HASH ACCOUNT STRING AND GO SCAN DATABASE
VERAC1: MOVE T1,VERLUK ;LOOKUP PTR TO ACCOUNT STRING
AOJ T1, ;MAKE IT POINT TO START OF ACCT STRING
HLRZ T2,T1
SOJ T2,
HRLM T2,T1 ;T1/ AOBJN PTR TO ACCT STRING
MOVEM T1,VERABJ ;SAVE IT
;**;[2836]ADD 1 LINE AT VERAC1:+6L TAM 14-OCT-82
LOCK ACTLCK ;[2836]LOCK UP DATA BASE
CALL CHKASR ;ACCOUNT MATCH ACCTSR?
JRST VERAC6 ;NO, CONTINUE
TRNE T1,-1 ;MATCH - ACCOUNT EXPIRED?
JRST BADRTE ;YES, GIVE INVALID RETURN
JRST OKRET ;NO, GIVE GOOD RETURN
VERAC6: CALL CHKCSH ;ACCOUNT MATCH CACHED ACCT IN JSB?
JRST VERAC0 ;NO, GO SCAN DATA BASE
TRNE T1,-1 ;ACCOUNT EXPIRED?
JRST BADRTE ;YES, GIVE INVALID RETURN
JRST OKRET ;NO, GIVE GOOD RETURN
; HASH ACCOUNT AND GO SCAN DATA BASE
VERAC0: MOVE T1,VERABJ ;AOBJN POINTER TO ACCOUNT
CALL HSHNAM ;HASH ACCOUNT STRING
CAILE T1,HASHLN ;VALID HASH VALUE?
JRST [BUG (HSHERR)
RETBAD (VACCX0)]
MOVEI T2,HSHPG+1 ;START OF HASH VALUES ON HSHPG
ADD T2,T1 ;HASH VALUE IS INDEX INTO TABLE
;**;[2836]DELETE 1 LINE AT VERAC0:+7L TAM 14-OCT-82
;**;[1872] Add one line at VERAC0: +7L RAS 12-MAY-81
; LOCK ACTLCK ;[1872] LOCK THE DATA BASE
MOVE T2,0(T2) ;GET HASH TABLE ENTRY
JUMPE T2,BADRET ;IF NO ENTRY THERE, ACCOUNT IS INVALID
;**;[1872] Delete one line at VERAC0: +10L RAS 12-MAY-81
VERAC2: IDIVI T2,PGSIZ ;PAGE # WHERE THE ACCT BLK RESIDES IN THE DATA FILE
MOVEM T3,VERLOC ;RELATIVE LOC ON PG WHERE ACCT BLK BEGINS
CAMN T2,ACTPGN ;IS THIS PAGE ALREADY MAPPED IN?
JRST VERAC3 ;YES, JUST CONTINUE
MOVEM T2,T3
SKIPGE ACTPGN ;ANYTHING MAPPED INTO ACTPG YET?
JRST VERAC5 ;NO, JUST GO MAP IN NEW PAGE
SETZ T1, ;UNMAP CURRENT WINDOW PAGE
HRRZI T2,ACTPG ;START OF ACCOUNT WINDOW PAGE
CALL SETMPG
VERAC5: MOVEM T3,ACTPGN ;SAVE NEW PAGE # MAPPED IN
HRRZ T1,T3
;**;[1970] ADD 2 LINES AT VERAC5: + 2L TAM 14-DEC-81
CAILE T1,777 ;[1970] LEGAL PAGE NUMBER
JRST BADREB ;[1970] NO, BUGCHK AND FAIL
HRL T1,ACTOFN ;T1/ OFN,,NEW PAGE #
MOVX T2,PM%RD ;READ ACCESS TO WINDOW PAGE
HRRI T2,ACTPG ;START ADDRESS OF WINDOW
CALL SETMPG ;MAP IN PG CONTAINING ACCT BLOCK
VERAC3: MOVEI T1,ACTPG
ADD T1,VERLOC ;ADDRESS WHERE ACCOUNT BLOCK LIVES
; NOW HAVE PAGE W/ HASHED ACCT BLK MAPPED INTO ACTPG
; SEE IF ACCT STRINGS ARE THE SAME
; IF YES, CONTINUE - IF NO, GET NEXT CHAINED ACCOUNT
MOVEM T1,VERHDR ;SAVE LOC WHERE HEADER BEGINS
HLRO T2,VERABJ ;LENGTH OF ACCT NAME IN WORDS
MOVNS T2 ;MAKE IT POSITIVE
LOAD T3,BKLEN,(T1) ;LENGTH OF THIS ACCOUNT BLOCK
SUBI T3,4 ;LENGTH OF THIS ACCT NAME
CAMN T2,T3 ;LENGTHS THE SAME?
JRST VERAC7 ;YES, SEE IF THIS IS THE DESIRED ACCOUNT
VERAC4: MOVE T1,VERHDR ;GET ADR OF HEADER
LOAD T2,ACPTR,(T1) ;PTR TO NEXT CHAINED ACCT BLK
JUMPE T2,BADRET ;IF NO MORE ACCT BLKS, GIVE LOSING RETURN
JRST VERAC2 ;GO CHECK NEXT ACCOUNT BLOCK
; SEE IF THIS IS THE DESIRED ACCOUNT BLOCK
; IF YES, AND THE USER IS WHOPER, ACCEPT IT AS A VALID ACCOUNT
; IF USER ISN'T WHOPER, GO SCAN DATA BASE TO VALIDATE THE ACCOUNT
VERAC7: MOVE T1,VERABJ ;SEE IF THIS IS THE DESIRED ACCT
MOVE T2,VERHDR
ADDI T2,4 ;POINT TO THIS ACCOUNT NAME
CALL CHKSAM ;IS THIS THE DESIRED ACCOUNT?
JRST VERAC4 ;NO, GO LOOK AT THE NEXT CHAINED ONE
MOVE T2,VERHDR ;THIS IS THE ACCOUNT
CALL CHKEXP ;HAS IT EXPIRED?
JRST BADRTE ;YES, ACCOUNT IS INVALID
MOVE T1,CAPENB ;GET ENABLED CAPABILITIES
TXNN T1,SC%WHL!SC%OPR ;IS USER WHOPER?
JRST VERAC8 ;NO, GO SCAN DATA BASE
MOVE T1,JOBNO
SKIPN VEREPT ;CHECK FOR VACCT JSYS
JRST VERAC8 ;NO, GO SCAN DATA BASE
MOVE T2,VERHDR ;YES, GET EXP DATE OF ACCOUNT
LOAD T3,ACCLS,(T2) ;GET CLASS OF ACCOUNT
LOAD T2,XPDAT,(T2)
CALL CPYCSH ;SAVE ACCOUNT AND EXP DATE IN JSB CACHE
SETZ T1, ;SAY ACCOUNT DOESN'T MATCH ACCTSR
MOVE T2,VERHDR
LOAD T3,ACCLS,(T2) ;GET CLASS AGAIN
LOAD T2,XPDAT,(T2) ;GET EXPIRATION DATE AGAIN
JRST OKRET ;AND GIVE GOOD RETURN
VERAC8: CALL SCNACT ;GO SCAN DATA BASE
JRST BADRT0 ;ACCOUNT INVALID OR EXPIRED
MOVE Q2,T2 ;ACCOUNT VALID, SAVE EXP DATE
MOVEM T3,VERCLS ;SAVE CLASS
CALL CPYCSH ;SAVE ACCT AND EXP DATE IN JSB CACHE
MOVE T2,Q2 ;GET BACK EXPIRATION DATE
MOVE T3,VERCLS ;RESTORE CLASS
SETZ T1, ;ACCOUNT DOESN'T MATCH ACCTSR
JRST OKRET ;GIVE GOOD RETURN
; SEE IF AN ACCOUNT HAS EXPIRED
; CALL: T2/ ADDRESS OF ACCOUNT DATA BLOCK
; CALL CHKEXP
; RETURNS: +1 ENTRY EXPIRED
; +2 ENTRY NOT EXPIRED
CHKEXP: LOAD T2,XPDAT,(T2) ;GET EXPIRATION DATE
CHKEX0: JUMPE T2,RSKP ;IF 0, ENTRY NEVER EXPIRES
GTAD ;GET CURRENT TIME AND DATE
CAMG T2,T1 ;HAS THE ENTRY EXPIRED?
RETBAD (VACCX2) ;YES
RETSKP ;NO, ENTRY STILL VALID
; SEE IF ACCOUNT MATCHES ACCTSR
; CALL CHKASR
; RETURNS: +1 NO MATCH
; +2 MATCH, T1/ AC%MCH => MATCHES ACCTSR
; RH(T1)/ 0 => ACCOUNT NOT EXPIRED
; 1 => ACCOUNT EXPIRED
; T2/ ACCOUNT EXPIRATION DATE
; CLOBBERS T1 THROUGH T4
CHKASR: MOVE T1,JOBNO
SKIPN T4,JOBDIR(T1) ;IS THIS JOB LOGGED IN?
RET ;NO, DON'T CHECK THE JSB
HRRZ T3,VERNUM ;GET USER FOR WHOM ACCOUNT BEING VALIDATED
CAMN T3,T4 ;VALIDATING FOR SELF ?
JRST CHKAS2 ;YES, CONTINUE ON
SKIPN VEREPT ;SETTING ACCOUNT ON A FILE?
RET ;NO, THEN DO NOT USE ACCOUNT IN THE JSB
CHKAS2: MOVE T1,VERABJ ;AOBJN POINTER TO ACCOUNT
HRRZI T2,ACCTSR ;ADDRESS OF ACCOUNT IN JSB
CALL CHKSAM ;ACCOUNTS THE SAME?
RET ;NO, JUST RETURN
MOVE T2,ACCTSX ;SAME - GET EXPIRATION DATE
CALL CHKEX0 ;ACCTSR EXPIRED?
JRST CHKAS1 ;YES
MOVX T1,AC%MCH
RETSKP
CHKAS1: HRRZI T1,1 ;NOTE THAT ACCTSR HAS EXPIRED
TXO T1,AC%MCH
RETSKP ;AND RETURN
; SEE IF ACCOUNT MATCHES CACHED ACCOUNT (CSHACT)
; CALL CHKCSH
; RETURNS: +1 NO MATCH
; +2 MATCH, RH(T1)/ 0 => ACCOUNT NOT EXPIRED
; 1 => ACCOUNT EXPIRED
; T2/ ACCOUNT EXPIRATION DATE
; CLOBBERS T1 THROUGH T4
CHKCSH: MOVE T1,JOBNO
SKIPN JOBDIR(T1) ;JOB LOGGED IN?
RET ;NO, DON'T CHECK THE JSB
MOVE T1,VERNUM ;GET USER NUMBER BEING VERIFIED
CAME T1,CSHUSR ;SAME AS LAST TIME ?
RET ;NO, INVALID ACCOUNT
MOVE T1,VERABJ ;AOBJN POINTER TO ACCOUNT
HRRZI T2,CSHACT ;ADDRESS OF CACHED ACCOUNT
CALL CHKSAM ;ACCOUNTS THE SAME?
RET ;NO, JUST RETURN
MOVE T2,CSHACX ;SAME - GET EXPIRATION DATE
CALL CHKEX0 ;CSHACT EXPIRED?
JRST CHKCS1 ;YES
MOVE T3,CSHCLS ;GET CLASS OF ACCOUNT
SETZ T1, ;NO, SAY ACCOUNT NOT EXPIRED
RETSKP ;AND GIVE GOOD RETURN
CHKCS1: HRRZI T1,1 ;SAY CSHACT EXPIRED
RETSKP ;AND RETURN
; COPY VALID ACCOUNT TO CACHED ACCOUNT SLOT IN JSB
; THE CACHED ACCOUNT IS CURRENTLY USED ONLY BY VERACT
; TO REMEMBER THE MOST RECENTLY VALIDATED ACCOUNT
;
; CALL: T2/ ACCOUNT EXPIRATION DATE
; T3/ CLASS OF ACCOUNT
; CALL CPYCSH
;
; RETURNS: +1 ALWAYS
; CLOBBERS T1, T2, T3
CPYCSH: MOVEM T2,CSHACX ;SAVE EXP DATE OF CACHED ACCOUNT
MOVEM T3,CSHCLS ;SAVE CLASS IN CACHE
MOVE T4,VERNUM ;GET USER FOR WHOM VALIDATION WAS DONE
MOVEM T4,CSHUSR ;SAVE USER FOR WHOM VALIDATION WAS DONE
HLRE T1,VERABJ
MOVNS T1 ;LENGTH OF ACCOUNT
HRRZ T2,VERABJ ;ADDRESS OF VALID ACCOUNT
MOVEI T3,CSHACT ;COPY ACCOUNT TO JSB
CALL XBLTA
RET ;AND RETURN
; SEE IF TWO STRINGS ARE THE SAME
; CALL: T1/ AOBJN POINTER TO A STRING
; T2/ ADDRESS OF ANOTHER STRING IN ACCOUNT WINDOW PAGE
; CALL CHKSAM
; RETURNS: +1 NOT THE SAME
; +2 ACCOUNT STRINGS ARE THE SAME
CHKSAM: MOVE T3,0(T2) ;GET NEXT WORD IN THE STRING
XOR T3,(T1) ;ARE THEY THE SAME SO FAR?
TRZ T3,1B35 ;IGNORE BIT 35
JUMPN T3,R ;NO, RETURN NOW
AOJ T2, ;POINT TO NEXT WORD IN THE STRING
AOBJN T1,CHKSAM ;CONTINUE COMPARING STRINGS
RETSKP ;ALL DONE, STRINGS ARE THE SAME
; HASH AN ACCOUNT STRING
; CALL: T1/ AOBJN POINTER TO ACCOUNT STRING
; CALL HSHNAM
; RETURNS: +1 ALWAYS, T1/ HASH VALUE
HSHNAM: ASUBR <HSH1,HSH2,HSH3,HSH4>
STKVAR <HSHTMP>
HLRZ T4,T1 ;GET STRING LENGTH
CAIN T4,-1 ;IS THE ACCOUNT ONE WORD LONG?
JRST [ MOVE T3,0(T1) ;YES, GET THE STRING
MOVEM T3,HSHTMP
JRST HSHNM2] ;AND CONTINUE
MOVE T3,0(T1) ;GET FIRST WORD OF STRING
MOVEM T3,HSHTMP ;SAVE IT
ADD T1,[1,,1] ;POINT TO NEXT WORD IN STRING
HSHNM1: MOVE T3,0(T1)
XORM T3,HSHTMP
AOBJP T1,HSHNM2
JRST HSHNM1 ;CONTINUE XOR'ING WORDS IN THE STRING
HSHNM2: MOVE T1,HSHTMP ;GET FINAL VALUE
TRZ T1,1B35 ;MAKE HASHING INDEPENDENT OF BIT 35
XOR T1,RANDOM
MUL T1,RANDOM
MOVMS T1
IDIVI T1,HASHLN ;DIVIDE BY # OF POSSIBLE HASH VALUES
MOVE T1,T2 ;REMAINDER IS HASH VALUE
DMOVE T2,HSH2 ;RESTORE ORIGINAL VALUES
MOVE T4,HSH4
RET ;AND RETURN
RANDOM: 5*5*5*5*5*5*5*5*5*5*5*5*5*5*5
; ACCOUNT IS INVALID - CLEAN UP AND RETURN ERROR
;**;[1971] ADD 1 LINE AT BADREB: + 1L TAM 6-JAN-82
;**;[1970] ADD 1 LINE AT BADRET: - 1L TAM 14-DEC-81
BADREB: BUG(ACTBBD) ;[1970] ACCOUNT FILE IS CORRUPT.
SETZM ACTPGN ;[1971] NO PAGE WAS MAPPED.
BADRET: SKIPA T1,[VACCX0] ;INVALID ACCOUNT
BADRTE: MOVEI T1,VACCX2 ;ACCOUNT HAS EXPIRED
BADRT0: MOVE Q2,T1 ;SAVE THE ERROR CODE FOR LATER
HRRZ T1,VERNUM
CAIN T1,OPERDN ;VALIDATING FOR THE OPERATOR?
JRST BADRT2 ;YES, CHECK FOR SPECIAL OPERATOR ACCOUNT
MOVE T2,JOBNO ;SEE IF JOB IS LOGGED IN
SKIPN JOBDIR(T2) ;IS IT LOGGED IN?
CAIE T1,SYSTDN ;NO, IS THIS FOR DIRECTORY <SYSTEM>
SKIPA ;NO
JRST BADRT2 ;YES, GO ALLOW THE USE OF "OPERATOR"
MOVE T3,CAPENB ;GET ENABLED CAPABILITIES
TXNE T3,SC%WHL!SC%OPR ;WHEEL OR OPERATOR ?
SKIPN JOBDIR(T2) ;AND NOT LOGGED IN ?
SKIPA ;YES
JRST BADRT2 ;GO CHECK FOR ACCOUNT "OPERATOR"
BADRT3: TXNE Q1,VR%USR ;VALIDATING FOR A USER NUMBER?
JRST BADRT1 ;YES, PROCEED
MOVE T1,STRINX
CALL ULKSTR ;UNLOCK THE STRUCTURE
BADRT1: UNLOCK ACTLCK ;UNLOCK HASH PAGE AND WINDOW PAGE
MOVE T1,Q2 ;GET BACK THE ERROR CODE
RETBAD ;GIVE FAILURE RETURN
BADRT2: SKIPN VEREPT ;IF VACCT JSYS THEN ERROR
JRST BADRT3
MOVE T2,VERLUK
AOS T2 ;START OF ACCOUNT TO VALIDATE
MOVE T1,[-2,,[ASCIZ/OPERATOR/]]
BADRT4: MOVE T3,0(T1) ;GET NEXT WORD IN STRING
CAME T3,0(T2) ;ACCOUNTS THE SAME SO FAR?
JRST BADRT3 ;NO, CLEAN UP AND RETURN ERROR
AOS T2
AOBJN T1,BADRT4 ;SCAN SOME MORE
SETZB T2,T3 ;OPERATOR ACCOUNT NEVER EXPIRES
CALL CPYCSH ;COPY OPERATOR ACCOUNT AND EXP DATE TO JSB
SETZB T1,T2 ;ACCOUNT MATCHES NOTHING IN THE JSB
; AND OPERATOR ACCOUNT NEVER EXPIRES
JRST OKRET ;USING SPECIAL ACCOUNT, GIVE OK RETURN
; ACCOUNT IS VALID - GIVE GOOD RETURN
OKRET: TXNE Q1,VR%USR ;VALIDATING FOR A USER NO?
JRST OKRT1 ;YES, PROCEED
DMOVEM T1,VERTMP ;SAVE THE ANSWER REGISTERS
MOVEM T3,VERCLS ;SAVE CLASS
MOVE T1,STRINX
CALL ULKSTR ;UNLOCK THE STRUCTURE
DMOVE T1,VERTMP ;RESTORE ANSWER
MOVE T3,VERCLS ;RESTORE CLASS
OKRT1: UNLOCK ACTLCK
SOJA T3,RSKP ;SUCCESSFUL RETURN WITH CLASS
VERACX: BUG(CRSPAG)
RETBAD (VACCX0)
VERAX1: BUG(BADTAB)
RETBAD (VACCX0)
; SCAN DATA BASE FILE FOR A VALID USE OF AN ACCOUNT
; CALL SCNACT
; RETURNS: +1 ACCOUNT NOT VALID FOR THIS USE
; +2 ACCOUNT VALID, T2/ EXPIRATION DATE
; AC USE: Q2/ ADDRESS OF DATA BLOCK CURRENTLY BEING SCANNED
SCNACT: STKVAR <NXTPG,TOTLEN,SCNACE>
SETZM SCNACE ;ASSUME NO VALID ACCOUNTS
MOVEI T1,ACTPG ;START OF ACCOUNT WINDOW PAGE
ADDI T1,PGSIZ
MOVEM T1,NXTPG ;IF DATA BLOCK CONTAINS THIS ADDRESS, BAD ERROR!
MOVE Q2,VERHDR ;ADDRESS OF ACCOUNT HEADER
LOAD T1,DATASZ,(Q2) ;GET LENGTH OF ALL DATA FOR THE ACCOUNT
MOVEM T1,TOTLEN ;SAVE IT
SCNAC0: LOAD T1,BKLEN,(Q2) ;LENGTH OF THIS BLOCK
MOVEM T1,T2
SOJ T1,
ADD T1,Q2 ;ADDRESS OF LAST WORD IN BLOCK
CAML T1,NXTPG ;DOES BLOCK CROSS A PAGE BOUNDARY?
JRST VERACX ;YES, GO BUGCHK
ADD Q2,T2 ;GET START OF NEXT DATA BLOCK
MOVE T1,TOTLEN
SUB T1,T2
MOVEM T1,TOTLEN
SKIPG TOTLEN ;DONE SCANNING ALL BLOCKS?
JRST SCNAC2 ;YES, ACCOUNT NOT VALID FOR THIS USE
CAML Q2,NXTPG ;IS THIS BLOCK ON THE NEXT PAGE?
JRST [ CALL SCNMAP ;YES, MAP IN NEW WINDOW PAGE
;**;[1774] Change one line at SCNAC0: +14L JGZ 2-SEP-80
MOVEI Q2,ACTPG ;[1774] MAKE Q2 POINT TO TOP OF NEW PAGE
JRST .+1] ;AND CONTINUE
;**;[3143] Add label at SCNAC0:+16 DEE 30-JUL-84
;**;[3143] Change 1 line in SCNAC0:+20 DEE 30-JUL-84
SCNAC3: LOAD T1,BKTYP,(Q2) ;[3143]GET BLOCK TYPE
CAIN T1,.TYNUL ;IS THIS A NULL BLOCK?
JRST [ LOAD T2,BKLEN,(Q2) ;YES
MOVE T1,TOTLEN
SUB T1,T2
MOVEM T1,TOTLEN ;ADJUST COUNT OF WORDS SCANNED
CALL SCNMAP ;MAP IN NEXT PAGE
;**;[1774] Change one line at SCNAC0: +23L JGZ 2-SEP-80
MOVEI Q2,ACTPG ;[1774] MAKE Q2 POINT TO FIRST BLOCK ON PAGE
JRST SCNAC3] ;[3143]AND CHECK IT
LOAD T1,BKTYP,(Q2) ;
CAIN T1,.TYWUS ;WILDCARD USER?
JRST SCNUSR ;YES, GO SCAN THE BLOCK
CAILE T1,.TYALU ;SOME KIND OF USER DATA BLOCK?
JRST SCNDIR ;NO, GO SCAN DIRECTORY BLOCKS
CAILE T1,.TYACC ;REALLY A USER BLOCK?
JRST SCNUSR ;YES, GO SCAN IT
CAIE T1,.TYACC ;IS IT AN ACCOUNT BLOCK?
JRST VERAX1 ;NO, BAD BLOCK
SKIPLE TOTLEN ;ALL BLOCKS SCANNED?
JRST SCNAC0 ;NO, GO LOOK AT NEXT BLOCK
SCNAC2: MOVEI T1,VACCX0 ;NO VALID ACCOUNTS
SKIPE SCNACE ;WAS AN EXPIRED ONE FOUND?
MOVEI T1,VACCX2 ;YES, RETURN THIS ERROR CODE
RETBAD
; SCANNING A USER BLOCK FOR A MATCH
SCNUSR: CALL SCNUNO ;GO DO THE WORK
JRST SCNAC1 ;NO MATCH OR ACCOUNT EXPIRED, GO LOOK AT NEXT BLOCK
RETSKP ;MATCH, NOT EXPIRED, OK RETURN
; SCANNING A DIRECTORY BLOCK FOR A MATCH
SCNDIR: TXNE Q1,VR%USR ;USER NUMBER GIVEN?
SKIPA T1,[VACCX0] ;YES. NO MATCH THEN
CALL SCNDNO ;GO DO THE WORK
JRST SCNAC1 ;NO MATCH OR ACOUNT EXPIRED, GO LOOK AT NEXT BLOCK
RETSKP ;MATCH, NOT EXPIRED,GIVE GOOD RETURN
SCNAC1: CAIN T1,VACCX2 ;DID THE ACCOUNT EXPIRE?
SETOM SCNACE ;YES, REMEMBER THAT
JRST SCNAC0 ;LOOP BACK TO SEE IF A VALID ONE EXISTS
; SCANNING USER BLOCKS
; CALL: Q2/ ADDRESS OF DATA BLOCK CURRENTLY BEING SCANNED
; CALL SCNUNO
; RETURNS: +1 NO MATCH OR ACCOUNT EXPIRED
; +2 MATCH, T2/ 0 => ACCOUNT NEVER EXPIRES
; OR T2/ EXPIRATION DATE
;**;[3173] REMOVE EDIT 3128 AGAIN
;**;[3128] Change 1 line at SCNUNO+5 and remove 3 following lines
;**;[3128] (SPR #20108)
;**;[3137] CANCEL 3128
;**;[3153] FINAL FIX SPR# 20108
SCNUNO: LOAD T1,BKTYP,(Q2) ;GET THIS BLOCK TYPE
CAIN T1,.TYALU ;"ALL USERS" BLOCK?
JRST SCNUN0 ;YES, SEE IF IT HAS EXPIRED
CAIN T1,.TYUGP ;USER GROUP BLOCK?
JRST SCNUN1 ;YES, GO SCAN IT
;**;[3173]REMOVE COMMENTED OUT LINES AND WHOLE EDIT
MOVE T2,DIRORA ;ADDRESS OF MAPPED-IN DIR
LOAD T2,DRNAM,(T2) ;START OF LOGGED-IN DIRECTORY NAME
ADD T2,DIRORA ;ADDRESS OF DRNAM BLOCK
AOS T2 ;POINT PAST BLOCK HEADER
CAIN T1,.TYWUS ;WILD CARD STRING?
JRST SCNUN2 ;YES, GO HANDLE IT SPECIALLY
LOAD T1,BKLEN,(Q2) ;BLOCK LENGTH
SUBI T1,2 ;GET USER NAME LENGTH TO COMPARE
MOVNS T1 ;MAKE IT NEGATIVE
HRLZS T1
MOVE T3,Q2
ADDI T3,2 ;ADDRESS OF START OF USER NAME
HRR T1,T3 ;NOW HAVE AOBJN POINTER TO NAME
CALL CHKSAM ;USER NAMES THE SAME?
RETBAD (VACCX0) ;NO
; ...
; ...
SCNUN0: MOVE T2,Q2 ;A MATCH WAS FOUND
CALL CHKEXP ;SEE IF ACCOUNT HAS EXPIRED FOR THIS USE
RETBAD (VACCX2) ;EXPIRED
LOAD T2,XPDAT,(Q2) ;NOT EXPIRED, GET EXP DATE
MOVE T3,VERHDR ;GET ADDRESS OF ACCOUNT HEADER BLOCK
LOAD T3,ACCLS,(T3) ;GET CLASS FOR ACCOUNT
SETZ T1, ;ACCOUNT DOESN'T MATCH ONE IN THE JSB
RETSKP ;GIVE MATCH RETURN
; TRY TO MATCH A USER GROUP NUMBER
SCNUN1: LOAD T1,USRGP,(Q2) ;GET GROUP NUMBER
CALL CHKUGP ;CHECK AGAINST GROUP #'S IN DIRECTORY
RETBAD (VACCX0) ;NO MATCH
JRST SCNUN0 ;MATCH, SEE IF ACCOUNT HAS EXPIRED
;WILD CARD USER NAME STRING
SCNUN2: MOVSI T1,(POINT 7,0(T4)) ;SET UP BYTE POINTER TO NAME STRING
MOVE T4,T2 ;GET POINTER TO FIRST BYTE OF USER NAME
MOVSI T2,(POINT 7,0) ;NOW SET UP A POINTER TO THE MASK STRING
HRRI T2,2(Q2) ;GET ADR OF FIRST WORD OF MASK STRING
CALL CHKWLD ;NOW COMPARE THE STRINGS FOR A MATCH
RETBAD (VACCX0) ;NO MATCH
JRST SCNUN0 ;MATCHED, GO SEE IF EXPIRED
; SCANNING DIRECTORY BLOCKS
; CALL: Q2/ ADDRESS OF DATA BLOCK CURRENTLY BEING SCANNED
; CALL SCNDNO
; RETURNS: +1 NO MATCH OR ACCOUNT EXPIRED
; +2 MATCH, T2/ 0 => ACCOUNT NEVER EXPIRES
; OR T2/ EXPIRATION DATE
SCNDNO: LOAD T1,SXSTR,(Q2) ;GET BLOCK'S STRUCTURE NAME
CAMN T1,[-1] ;ALL STRUCTURES VALID?
JRST SCNDN2 ;YES, PROCEED
MOVE T2,STRINX ;GET STRUCTURE NUMBER
ADDI T2,DVXST0 ;ADD OFFSET TO STR PART OF DEVICE TABLES
CAME T1,DEVNAM(T2) ;STRUCTURE NAME MATCH ALIAS?
RETBAD (VACCX0) ;NO, RETURN IMMEDIATELY
SCNDN2: LOAD T1,BKTYP,(Q2) ;GET BLOCK TYPE
CAIN T1,.TYDGP ;DIRECTORY GROUP BLOCK?
JRST SCNDN1 ;YES, GO CHECK DIRECTORY GROUPS
MOVE T2,DIRORA ;START OF MAPPED-IN DIRECTORY
LOAD T2,DRNAM,(T2)
ADD T2,DIRORA ;ADDRESS OF BLOCK WHERE DRNAM LIVES
AOJ T2, ;POINT PAST BLOCK HEADER
LOAD T1,BKLEN,(Q2) ;GET THIS BLOCK'S LENGTH
SUBI T1,3 ;LENGTH OF DIRECTORY NAME IN WORDS
MOVNS T1 ;MAKE IT NEGATIVE
HRLZS T1
MOVE T3,Q2
ADDI T3,3 ;ADDRESS OF START OF DIRECTORY NAME
MOVE T4,0(T3) ;GET FIRST WORD OF DIR NAME
CAMN T4,[-1] ;ALL DIRECTORIES VALID?
JRST SCNDN0 ;YES, PROCEED
HRR T1,T3 ;NOW HAVE AOBJN PTR TO DIRECTORY NAME
CALL CHKSAM ;DIRECTORY NAMES THE SAME?
RETBAD (VACCX0) ;NO
SCNDN0: CALLRET SCNUN0 ;GET DATA AND RETURN
; TRY TO MATCH A DIRECTORY GROUP NUMBER
SCNDN1: LOAD T1,DIRGP,(Q2) ;GET GROUP NUMBER
CALL CHKDGP ;GROUP NUMBER MATCH ONE IN DIR LIST?
RETBAD (VACCX0) ;NO MATCH
JRST SCNDN0 ;MATCH, CONTINUE
; UNMAP CURRENT ACCOUNT WINDOW PAGE AND MAP IN NEXT SEQUENTIAL PAGE
; CALL SCNMAP
; CLOBBERS T1, T2, T3
SCNMAP: SETZ T1,
HRRZI T2,ACTPG ;ADDRESS OF WINDOW PAGE IN CORE
CALL SETMPG ;UNMAP IT
AOS ACTPGN ;GET SET TO MAP IN NEXT PAGE
HRRZ T1,ACTPGN
HRL T1,ACTOFN ;T1/ OFN,,NEW PAGE NUMBER
MOVX T2,PM%RD ;READ ACCESS TO WINDOW
HRRI T2,ACTPG
CALL SETMPG ;MAP IN THE NEXT PAGE
RET ;AND RETURN
TNXEND
END