Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
logout.mac
There are 3 other files named logout.mac in the archive. Click here to see a list.
TITLE LOGOUT FOR DISK SYSTEM -- V54(46)
SUBTTL /RCC/CMF/RLD/DJB/JSL/LSS/SHP
VLOGO==54
VEDIT==46
VMINOR==0
VCUST==0
;COPYRIGHT (C) 1969, 1971 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD MASS.
.JBVER=137
LOC .JBVER
BYTE (3)VCUST(9)VLOGO(6)VMINOR(18)VEDIT
RELOC
;REVISION HISTORY
;24 FT1975 - ENABLE NEW FORMAT FACT ENTRIES, IN WHICH DATE DOES
; NOT EXPIRE IN 1975
;25 FIX CHKNAC AND ENFQTA SO EMPTY, UNACCESSED UFD'S GET DELETED
; (SPR 11247)
;26 CHECK USER'S ACCESS RIGHTS TO LOG FILE (SPR 10506)
;27 IF CONTROLLED BY PTY, CLRBFI SO COMCON DOESN'T FIND
; A COMMAND LEFT OVER
;30 FIX INCORRECT RUNTIME PRINTING WHEN FACTSW=0 (SPR 9793)
;31 PREVENT RACE WHICH ALLOWS A RELOGIN ATTEMPT WITH INVALID PPN
; BY GETTING PPN DIRECTLY. (SPR 9681)
;32 ENSURE FACT FILES GET ".SYS" PROTECTION (SPR 9870)
;33 TOLERATE "STRUUO FAILURE (0)" (SPR 10084, 10085, 10326)
;34 CLEANUP "SAVED", "DELETED", & "RUNTIME" MESSAGES
;35 COMPENSATE FOR "NON-QUOTA-CHECKED" FILES
;36 MAKE "LOGINU=7" CORRECT INDEX FOR LOG FILE INTERLOCK
;37 DELETE CODE AND CONDITIONAL FOR RESERVED QUOTA
;40 DELETE REFERENCES TO THE USELOG FLAG - IT IS NEARLY USELESS
;41 SET FULL PARAMETER LIST ON LOGIN UUO
;42 FOR SYSTEMS WITHOUT QUEUE, MAKE SURE HISEG
; IS THERE WHEN WE GO TO IT
;43 DELETE TYPEOUT OF (CR)(LF) AT END IF DETACHED
;44 WHEN LOOKING FOR OTHER JOBS USING AN STR, ONLY
; CHECK UP TO MAX JOB # USED, NOT MAX POSSIBLE
;45 FIX QUOTA CHECK RACE ON 1040 SYSTEMS
;46 BEFORE TYPING ANYTHING, MAKE SURE TERMINAL IS AT USER LEVEL
;THIS VERSION OF LOGOUT HAS A CONDITIONAL ASSEMBLY PARAMETER NAMED "FACTSW" WHICH
; CONTROLS WHETHER OR NOT SYSTEM USAGE INFORMATION IS APPENDED TO THE SYSTEM
; ACCOUNTING FILE (FACT.SYS). THOSE INSTALLATIONS WHICH DO NOT WISH THIS FEATURE
; MAY DISABLE IT BY SETTING FACTSW = 0.
IFNDEF FACTSW,< FACTSW==1>
IFNDEF DAEMSW,< DAEMSW==1> ;ENABLES USE OF DAEMON TO WRITE FACT FILE
IFNDEF FTNSFL,< FTNSFL==0> ;ENABLES COUNTING FILES SAVED, BUT TAKES LONGER
IFNDEF FTDSTT,< FTDSTT==0> ;FORCES PRINTING OF DISK BLOCKS READ & WRITTEN
IFNDEF FT1975,< FT1975==1> ;ENABLE NEW FACT FILE ENTRY FORMAT
TWOSEG
IFNDEF PDLEN,<PDLEN==60>
IFL PDLEN-60,<PDLEN==60>
IFNDEF LN.KJL,<LN.KJL=1300> ;HIGHEST LOCATION PRESERVED BY QUEUE
;PARAMETERS FROM COMMOD.MAC
.RBPPN==1
.RBNAM==2
.RBEXT==3
.RBPRV==4
.RBSIZ==5
.RBVER==6
.RBALC==11
.RBMTA==15
.RBDEV==16
.RBSTS==17
RP.LOG==400000 ;LH
RP.DIR==400000 ;RH THIS FILE IS A DIRECTORY
RP.NDL==200000 ;RH DO NOT DELETE BIT
RP.NQC==2000 ;NON-QUOTA-CHECKED FILE
.RBQTF==22
.RBQTO==23
.RBQTR==24
.RBNQC==.RBQTR
.RBUSD==25
.RBAUT==26
;END OF PARAMETERS FROM COMMOD.MAC
; ACCUMULATOR DEFINITIONS
F=0 ;FLAG REGISTER
A=1 ; A THRU D ARE GENERAL PURPOSE...IN PARTICULAR,
B=2 ; LOOKUP'S AND ENTER'S ARE DONE HERE.
C=3
D=4
E=5
CALC=6 ;FOR FACT FILE CALCULATIONS, ETC.
T=7
S=10 ;CONTAINS INDEX IN STRTAB OF CURRENT STR
M=12 ;FOR MESSAGES
N=13 ;FOR NUMBER TYPEOUTS
N1=14 ;DITTO
R=15 ;RADIX FOR RADIX PRINTER
CH=16 ;FOR CHARACTERS
P=17 ;PUSHDOWN LIST POINTER
;DEVICE CHANNEL DEFINITIONS
;*** START AT 6 TO KEEP OUT OF QUEUE'S WAY
UFD==6 ;TO READ THE USER'S UFD
TTY==7
DSK==10 ;TO DELETE FILES, ETC.
LOG==11 ;LOG FILE
USR==12 ;LOOKUP CHANNEL FOR SCNDIR
;TMPCOR FUNCTIONS
TCRRDF==2 ;FUNCTION TO READ AND DELETE A FILE
TCRRDD==5 ;FUNCTION TO READ AND DELETE DIRECTORY
;DAEMON FUNCTIONS
.CLOCK==2 ;SETUP (OR CLEAR) A CLOCK REQUEST
.FACT==3 ;WRITE A FACT FILE ENTRY
;STRUUO FUNCTIONS
.FSDSL==1 ;DEFINE SEARCH LIST
.FSULK==6 ;TEST AND SET UFD INTERLOCK
.FSUCL==7 ;CLEAR UFD INTERLOCK
;GOBSTR WORDS
GOBJOB==0
GOBPPN==1
GOBNAM==2
;DSKCHR WORDS
.DCUFT==1 ; BLOCKS LEFT ON STR FOR USER
.DCSNM==4 ;FILE STRUCTURE NAME
;CLOSE MODIFIER BITS
CL.NMB==20 ;DO NOT DELETE NAME BLOCKS
CL.RST==40 ;DISCARD FILE
;CHKACC CODES
.ACAPP==4 ;APPEND
.ACCRE==7 ;CREATE IN UFD
;GETTAB TABLE CODES
JBTSTS==0 ;JOB STATUS BITS
JBTADR==1 ;PROTECTION AND RELOCATION SETTINGS
PRJPRG==2 ;PROJECT,PROGRAMMER NUMBER
JBTPRG==3 ;LAST PROGRAM NAME USED IN RUN OR GET COMMAND
.GTPRG==3 ;JOB/SEGMENT NAME
TTIME==4 ;TOTAL RUN TIME FOR THIS JOB
JBTKCT==5 ;KILO-CORE-TICS USED BY THIS JOB
JBTPRV==6 ;PRIVILEGE TABLE (NOT YET IMPLEMENTED IN MONITOR 3.27)
JBTSWP==7 ;SWAPPED OUT ADDRESS AND SIZE, IN-CORE PROTECT TIME
CNFTBL==11 ;CONFIGURATION TABLE
SEGPTR==15 ;ENTRY IN CNFTBL FOR NO OF JOBS + NULL JOB
CNFSTS==17 ;ENTRY IN CNFTBL FOR STATES WORD
%CNTIC==44,,11 ;JIFFIES PER SECOND IN CNFTBL [24]
%HGHJB==20,,12 ;[44] HIGHEST JOB IN USE
OPQPTB==16 ;VALUE FOR GETTAB TO GET PPN OF COMMAND AREA
OPQPIN==4 ;INDEX IN TABLE
OPQSTB==16 ;VALUE FOR FILE STRUCTURE FOR COMMANDS
OPQSIN==15 ;INDEX IN TABLE
JBTRCT==17 ;TABLE OF DISK BLOCKS READ BY JOB NUMBER
JBTWCT==20 ;TABLE OF DISK BLOCKS WRITTEN
JBTDCT==777700 ;MASK FOR INCREMENTAL BLOCKS
%LDMFD==0,,16 ;LEVEL D TABLE - PPN FOR UFD'S
%LDSYS==1,,16 ;LEVEL D TABLE - PPN FOR SYS
%LDSSP==22,,16 ;PROTECTION OF ".SYS" FILES
.GTWCH==35 ;JOB'S WATCH BITS
JW.WDY==1B1 ;TIME OF DAY
JW.WRN==1B2 ;RUN TIME
JW.WWT==1B3 ;WAIT TIME
JW.WDR==1B4 ;DISK READS
JW.WDW==1B5 ;DISK WRITES
JW.WVR==1B6 ;VERSIONS
.GTNM1==31 ;USER NAME
.GTNM2==32 ;. . .
.GTCNO==33 ;CHARGE NUMBER
%FTDSK==6,,71 ;[45] DISK FEATURE TEST BIT SETTINGS
F%STR==1B31 ;[45] MULTIPLE STRUCTURE SUPPORT
;FLAG BITS - LEFT HALF OF ACCUMULATOR F
NOPHYU==1 ;SET IF PHYSICAL DEVICE ONLY UUO'S NO IMPLEMENTED
DUPF==2 ;TRUE IF GETPPN SAYS MULTIPLE USERS UNDER THIS [P,P]
NTTYF==4 ;NO TTY AVAILABLE?!
NMSTR==10 ;[45] SET IF MONITOR DOES NOT SUPPORT MULTIPLE STR'S
L.OVRQ==20 ;SET IF ANY STR IS STILL OVER QUOTA OUT
BPAF==40 ;SET IF STOP AT NULL IN SIXBP ROUTINE
RBEONL==400 ;SET IF OK TO LOGOUT IF OVER QUOTA BUT ALL FILES HAVE BAD RIBS
L.NOSP==1000 ;SET IF MONITOR TOO OLD FOR SPOOLING
L.ILKF==2000 ;SET IF COULD NOT GET UFD INTERLOCK ON SOME STR
L.FRCI==4000 ;SET TO FORCE INTERLOCK
L.WATV==10000 ;SET TO WATCH VERSIONS
;FLAGS IN RH OF F, CLEARED ON RETURN FROM QUEUE
R.INQ==400000 ;TIME-STAMPS SHOULD BE L-QUE
;DEFINE SPECIAL CHARACTER CODES
SPACE=40 ;SPACE
LF=12 ;LINE FEED
EXTERN .JBSA,.JBREL,.JBFF
;DEVCHR BITS
DV.TTY==(1B5)
DV.DSK==(1B1)
;MISC PARAMETERS
ASSCON=20000 ;FOR OPR TEST
DVAVL=40 ;DITTO
IO.ERR==740000 ;ERROR STATUS BITS
IO.EOF==20000 ;END-OF-FILE STATUS BIT (FOR STATZ'S AND STATO'S)
.LNFPN==6 ;LENGTH OF LIST FOR FULL PATH NAME
.DVDSK==200000 ;BIT IN DEVCHR SET IF DSK
PHYOPN==400000 ;BIT IN LH OPEN WORD FOR PHYSICAL DEVICE ONLY
PHYUUO==200000 ;BITS IN CALLI UUO'S FOR PHYSICAL DEVICE ONLY
QDSKSR==2 ;VALUE OF DISK SERVICE FIELD IN STATES FOR QUEUE STUFF
RACEY==2 ;VALUE OF DSKSER FOR RACE-CONDITION PREVENTION CODE
TRYILK==^D300 ;TIMES TO TRY FOR UFD INTERLOCK
FBMERR==3 ;ENTER ERROR - FILE BEING MODIFIED
FBMTRY==^D360 ;TIMES TO RETRY IF FILE BEING MODIFIED
BRBERR==6 ;LOOKUP ERR - BAD RIB OR BAD UFD
TT.PTY==400000 ;TTY LINE CHARACTERISTICS BIT=PTY
TTYBUF==26 ;SIZE OF TTY BUFFER TO ALLOCATE
EXLLEN==.RBAUT+1;LEN OF EXTENDED LOOKUP
USRLEN==.RBSTS+1;LEN OF EXT LOOKUP FOR RECOMPUTING BLOCKS USED
PTHLEN==11 ;MAX LEN OF PATH SPECIFIER
CHRLEN==.DCSNM+1;LEN OF DSKCHR BLOCK
MAXFS==^D10 ;MAX NO OF FILE STR'S
;BITS IN FLAG WORD FROM KJOB - LH
LNOQUE==400000 ;SIGN BIT SET IF KJOB CALLED QUEUE
LBSWIT==200000 ;SET IF TRIED BEST TO MAKE QUOTA - OK TO LOGOUT IF ALL FILES RIB ERROR
;BITS IN RH EXT WORD FOR CALL TO QUEUE
Q.PHY==1 ;USE PHYSICAL I/O
Q.SLOG==2 ;SUPPRESS QUEUEING LOG FILE
Q.SLPT==4 ;SUPPRESS QUEUEING *.LPT, ETC.
Q.SLST==10 ;SUPPRESS QUEUEING *.LST
Q.SDFR==20 ;SUPPRESS QUEUEING DEFERRED REQUESTS
Q.DLPT==40 ;DELETE *.LPT
;BITS IN RETURN FROM QUEUE
Q.PLGQ==400000 ;SET IF USE LOGICAL QUE
;WORDS IN QUEUE REQUEST
LOGINU==7 ;IN USE FLAG [36]
;STORAGE MACROS
.ZZ=140
DEFINE U(A)<UU(A,1)>
DEFINE UU(A,B)<
RELOC
A: BLOCK B
RELOC
.ZZ==.ZZ+B>
OPDEF PJRST [JRST]
OPDEF PJSP [JSP]
OPDEF KILLJB [CALLI 17] ;LOGOUT UUO
SUBTTL INITIALIZATION
RELOC 400000
LOGOUT: JFCL ;IN CASE OF CCL ENTRY
RESET ;CCL ENTRY
MOVE P,PDP ;SET UP PUSH DOWN LIST
SETZB F,LOGCAL ;CLEAR FLAGS AND BEGINNING OF COMMUNICATION BLOCK
SETZB A,SVPJPG ;CLEAR A FOR OPEN AND PHYSICAL UUO FLAG
MOVEI B,C ;ADDR OF DSKCHR BLOCK
MOVSI C,(SIXBIT .DSK.);NAME IS DSK
DSKCHR B,PHYUUO ;SEE IF CAN DO PHYSICAL DEVICE ONLY UUOS
TLO F,NOPHYU ;NO, MARK NO PHYSICAL ONLY
TLO A,PHYOPN ;YES, DO PHYSICAL OPEN OF TTY
MOVSI B,(SIXBIT .TTY.)
MOVSI C,TYOB ;NO INPUT NEEDED
OPEN TTY,A ;OPEN TTY
TLO F,NTTYF ;CANT
MOVE A,.JBFF ;FIRST FREE LOCATION
IORI A,1777 ;ROUND UP TO K BOUND
CAMGE A,.JBREL## ;NO SKIP IF USER ASKED FOR MORE CORE
CORE A, ;MIGHT LEAVE NO ROOM FOR QUEUE SO FORBID
JFCL ;OH WELL
PUSH P,.JBFF
MOVEI A,TBUF ;ADDR OF BUFFER IN OUR CORE LEST QUEUE
MOVEM A,.JBFF ;CLOBBER OUR BUFFERS
OUTBUF TTY,1
ADDI A,TTYBUF ;MAXIMUM WE CAN ALLOCATE FOR BUFFERS
CAMGE A,.JBFF ;SKIP IF OK
JRST LTTY ;BUFFERS TOO BIG, MUST NOT BE REAL TTY
POP P,.JBFF ;RESTORE .JBFF
PJOB A, ;GET OUR JOB NO
MOVEM A,THSJOB ;SAVE IT
MOVE A,[XWD LOGCAL,LOGCAL+1]
BLT A,LOGCAL+LNLGBK ;CLEAR COMMUNICATION BLOCK
MOVE A,[XWD TCRRDF,B] ;READ AND DELETE CORE FILE
MOVSI B,(SIXBIT .LGO.)
MOVE C,TCRLST
TMPCOR A, ;IS THERE A CORE FILE?
JRST TRYDSK ;CANT READ FILE, TRY DISK
JRST HAVBUF ;OK, BUFFER IS SET UP
TRYDSK: TLNN F,NOPHYU ;PHYS-ONLY SUPPORTED?
JRST OPNDSK ;YES, TEST IS UNNECESSARY
MOVSI A,'DSK' ;MAKE SURE 'DSK' ASSIGNED TO A DISK
DEVCHR A,
TLNN A,DV.DSK ;IS DSK A DISK?
JRST HAVBUF ;NO, DO NOT ATTEMPT TO GET CCL
OPNDSK: MOVEI A,17 ;DUMP MODE OPEN
TLNN F,NOPHYU
TLO A,PHYOPN ;PHYSICAL ONLY IF POSSIBLE
MOVSI B,'DSK' ;WHERE TO LOOK FOR CCL
SETZ C,
OPEN DSK,A ;INIT DEVICE FOR CCL FILE
JRST HAVBUF ;CANT INIT DSK?
MOVE B,THSJOB ;GET JOB #
PUSHJ P,SIXJBN ;AND CONVERT TO SIXBIT IN LH A
HRRI A,(SIXBIT .LGO.)
MOVSI B,(SIXBIT .TMP.)
SETZB C,D
LOOKUP DSK,A ;LOOKUP CCL FILE ON DSK
JRST HAVBUF ;NOT TODAY
MOVE A,TCRLST ;IOWD TO READ FILE
SETZ B,
INPUT DSK,A ;OK, READ THE FILE
SETZB A,B
RENAME DSK,A ;DELETE CCL FILE
JFCL
;HERE WHEN CCL FILE IN BUFFER
;PREPARE TO CALL QUEUE IF NECESSARY
HAVBUF: MOVE A,[XWD CNFSTS,CNFTBL]
GETTAB A, ;STATES WORD
SETZ A,
LDB A,[POINT 3,A,9] ;GET DISK SERVICE FIELD
MOVEM A,DSKSER
CAIGE A,QDSKSR ;RECENT ENOUGH FOR SPOOLING?
TLO F,L.NOSP ;NO, PREVENT QUEUE CALLS
MOVE A,[XWD LOWCHR,OUCHLO]
BLT A,OUCHLO+LNOUCH ;MOVE CHAR TYPE ROUTINES TO LOW SEG
SETOM LINFLG ;NOTE LOG FILE NOT YET OPEN
MOVE B,[DEVCHR A,]
TLNN F,NOPHYU ;CAN WE DO PHYS ONLY UUO'S?
TRO B,PHYUUO ;YES, REQUEST IT
SKIPE A,LOGDEV ;LOG DEVICE
XCT B ;DEVCHR A,
TLNE A,DV.TTY ;SKIP IF NOT TTY
SETZM LOGFIL ; NO LOG FILE IF TTY [40]
HRROI A,.GTWCH ;SETUP TO GET JOB'S WATCH BITS
GETTAB A,
SETZ A, ;FEATURE OFF, PROBABLY
MOVE B,SVWTCH ;GET BITS PASSED BY KJOB
IORM A,SVWTCH ;INCLUDE THESE
TLNN A,(JW.WVR) ;IF ON NOW, MON HAS PRINTED VERSION
TLNN B,(JW.WVR) ;DID KJOB SEE AND DISABLE VERSION WATCH?
JRST QUECHK ;NO NEED TO SIMULATE
TLO F,L.WATV ;NOTE WATCH SIMULATION DESIRED
PUSHJ P,TYPNSG ;IF SO, FAKE IT
QUECHK: REPEAT 0,< ;[26]
TLNN F,L.NOSP ;DOES MONITOR KNOW ABOUT SPOOLING?
SKIPGE LGOFLG ;DID KJOB CALL QUEUE?
JRST HICALL ;YES, DO NOT REPEAT
SETZM LOGQUE ;CLEAR NAME OF LOG FILE QUEUE REQUEST IN CASE NONE
>;END REPEAT 0 [26]
SKIPN LOGFIL ;SKIP IF LOG FILE SPECIFIED
JRST GETQUE ;NO FILE, DO NOT LOOK UP
;HERE WE MUST LOOKUP LOG FILE (AND CREATE IT IF NECESSARY)
; TO GET A SPECIFIC RATHER THAN GENERIC DEVICE SO THAT COMPARES MADE BY
; QUEUE WILL CORRECTLY IDENTIFY THE LOG FILE
MOVEI A,17
SKIPN B,LOGDEV ;LOG DEVICE
MOVSI B,(SIXBIT .DSK.) ;ELSE DSK IF NONE SPECIFIED
SETZB C,LOOKBF+.RBDEV
SETZM LOOKBF+.RBAUT ;[26]
TLNN F,NOPHYU ;SKIP IF CAN'T SPECIFY PHYSICAL ONLY
TLO A,PHYOPN ;SET PHYSICAL ONLY BIT
OPEN DSK,A ;OPEN LOG DEVICE
JRST NOLOGE
MOVEI A,EXLLEN-1 ;LEN OF LOOKUP BLOCK[26]
MOVEM A,LOOKBF
HRRZI A,LOOKBF ;ADDR OF LOOKUP BUFFER
SKIPN LOGPPN+1 ;SKIP IF PATH MORE THAN JUST UFD[26]
SKIPA B,LOGPPN ;ELSE PICK UP DIR[26]
MOVEI B,LOGPPN ;ADDR OF PATH[26]
SKIPN DSKSER ;SKIP IF LEVEL D
SOSA A ;DONT DO PPN YET IF LEVEL C
PUSH A,B ;STORE PATH ADDR[26]
PUSH A,LOGFIL ;AND FILE NAME
PUSH A,LOGEXT ;AND EXT OF LOG FILE
ADDI A,1 ;BUMP PTR IN CASE LEVEL C
SKIPN DSKSER ;ALL FOR NAUGHT
PUSH A,LOGPPN ;AH HAH!
MOVEI N1,FBMTRY ;TIMES TO RETRY IF FILE BEING MODIFIED
LOOKUP DSK,LOOKBF ;LOOKUP LOG FILE
JRST NOLOGY ;NO LOG FILE YET
PUSHJ P,ACCCHK ;VERIFY THIS USER'S RIGHT TO IT[26]
JRST NOLGE1 ;CAUGHT YOU!![26]
JRST YLOGY ;OK, GOT IT
;HERE TO CHECK USER'S ACCESS RIGHTS TO LOG FILE [26]
ACCCHK: GETPPN D, ;GET THIS JOB'S PPN
TLZ D,400000
MOVE C,LOOKBF+.RBPPN ;GET DIRECTORY
TLNN C,-1 ;IS IT PATH POINTER?
MOVE C,(C) ;YES, GET UFD NAME
CAME D,C ;IS IT IN HIS DIRECTORY?
CAMN D,LOOKBF+.RBAUT ;OR DID HE CREATE IT?
JRST CPOPJ1 ;YES, LET HIM WRITE IT
LDB B,[POINT 9,LOOKBF+.RBPRV,8]
HRLI B,.ACAPP ;CAN HE APPEND?
MOVEI A,B ;POINT TO BLOCK
CHKACC A, ;CHECK ACCESS
SETO A,
JUMPE A,CPOPJ1 ;OK, LET IT GO
SETZM LOGFIL ;NO, PREVENT LOG FILE ACCESS [40]
CLOSE DSK,CL.RST ;DELETE ANYTHING CREATED
POPJ P, ;AND TAKE ERROR RETURN
NOLOGY: MOVE B,LOGPPN ;RESTORE PPN IF LEVEL C
SKIPN DSKSER
MOVEM B,LOOKBF+3
ENTER DSK,LOOKBF ;CREATE LOG FILE
JRST NOLOGE ;CANT CREATE IT
REPEAT 0,< ;[26]
CLOSE DSK,CL.NMB ;GOT IT. TELL FILSER TO KEEP IT
MOVE B,LOGPPN ;RESTORE PPN IF LEVEL C
SKIPN DSKSER
MOVEM B,LOOKBF+3
LOOKUP DSK,LOOKBF ;NOW ABOUT THAT LOG FILE
JRST NOLOGE ;REALLY LOSES TODAY
>;END REPEAT 0 [26]
SETZM LOOKBF+.RBAUT ;WE'RE THE AUTHOR, DON'T CHK THAT [26]
PUSHJ P,ACCCHK ;CHECK RIGHTS [26]
JRST NOLGE1 ;KILL IT [26]
YLOGY: SKIPE A,LOOKBF+.RBDEV ;GET DEVICE ITS ON [26]
MOVEM A,LOGDEV
CLOSE DSK,CL.NMB ;TELL FILSER TO REMEMBER IT
JRST NOLGE1
NOLOGE: HRRZ N,LOOKBF+.RBEXT ;ENTER ERROR CODE
CAIE N,FBMERR ;SKIP IF FILE BEING MODIFIED
JRST NOLGE1 ;NO, GO AHEAD
SOJLE N1,NOLGE1
MOVEI N,1
SLEEP N,
JRST NOLOGY ;TRY AGAIN
NOLGE1: RELEASE DSK, ;RELEASE LOG FILE
GETQUE: TLNN F,L.NOSP ;DOES MONITOR UNDERSTAND SPOOLING?[26]
SKIPGE LGOFLG ;AND DO WE STILL NEED TO DO QUEUEING?[26]
JRST HICALL ;NO TO EITHER[26]
SETZM LOGQUE ;CLEAR NAME OF QUEUE ENTRY[26]
MOVE A,[XWD NEWLOG,QOUCH] ;ROUTINES TO CALL FROM QUEUE
MOVEM A,LOGTYP
MOVEI A,1
MOVEM A,LOGCAL ;NOTE FROM KJOB
MOVE A,[XWD QUECAL,LOCALL]
BLT A,LOCALL+LNQCAL ;COPY GETSEG ROUTINES DOWN
MOVEI A,PHYUUO ;PHYSICAL ONLY BIT
TLNN F,NOPHYU ;WILL IT BE RECOGNIZED?
IORM A,GSUUO ;YES, PUT IT IN THE GETSEG
TRO F,R.INQ ;NOTE IN QUEUE
MOVEM F,SAVEF ;HOLD FLAGS
MOVEM P,SAVEP ;AND STACK POINTER
MOVEI A,RSTART ;WHERE TO GO ON .START COMMAND
MOVEM A,.JBSA
MOVEI A,GSQUE ;POINTER TO QUEUE GETSEG BLOCK
JRST LOCALL ;DO THE GETSEG AND PROCESS QUEUES
SUBTTL STORAGE PRESERVED ACROSS CALL TO QUEUE
TCRLST: IOWD LNLGBK,LOGCAL
U(LOGCAL)
U(LOGDEV)
UU(LOGPPN,.LNFPN)
U(LOGFIL)
U(LOGEXT)
U(SLIM1)
U(SLIM2)
U(LOGPAR)
U(LOGSEQ)
U(LOGTYP)
LGLAST==LOGTYP ;END OF QUEUE COMMUNICATION BLOCK
U(LGOFLG)
U(LOGQUE)
U(LOGQU1)
U(NSFILS)
U(NSBLKS)
U(NDFILS)
U(NDBLKS)
U(SVWTCH)
LNLGBK==SVWTCH-LOGCAL+1 ;END OF KJOB-LOGOUT COMMUNICATION BLOCK
RND4WD==LNLGBK&3 ;ROUND LEN OFF TO 4-WORD BLOCK
IFN RND4WD,<UU(TCHACK,<4-RND4WD>) ;PROTECTION FROM TMPCOR HACK
U(SVPJPG)
U(THSJOB)
U(DSKSER)
U(LOSVER)
U(LOSNAM)
U(LINFLG)
UU(LOB,3)
U(SAVEF)
U(SAVEP)
UU(TBUF,TTYBUF)
UU(TYOB,3)
EOUCHL==400 ;*** MUST BE BIG ENOUGH FOR CHAR TYPE ROUTINES
UU(OUCHLO,EOUCHL)
UU(OBUF,203)
UU(STRBUF,0) ;SHARE UFDBUF
UU(UFDBUF,200)
LOCALL==UFDBUF
UU(PDL,PDLEN) ;DEFINE PUSHDOWN LIST WHERE TOP WILL
;NOT BE DESTROYED BY QUEUE
IFG PDL-LN.KJL,<
PRINTX ?QUEUE WILL OVERWRITE LOW CORE
>
SUBTTL SEGMENT HANDLING ROUTINES
QUECAL:!
PHASE LOCALL
TOLO: JSR NEWSEG ;ALL SET UP, JUST GETSEG QUEUE
JRST NOQUE ;[42] LOSE...
IFN P-17,<
MOVE 17,P >
MOVE 1,QPARM ;POINTER TO QUEUE PARAMETERS
PUSHJ 17,400010 ;INVOKE QUEUE
HLLZS SAVEF ;CLEAR RH FLAGS (R.INQ)
MOVEI A,GSLGO ;GETSEG LIST FOR LOGOUT
JSR NEWSEG ;GET LOGOUT BACK
HALT
JRST HICAL1 ;RESUME LOGOUT
NOQUE: MOVEI A,GSLGO ;[42] GET BACK LOGOUT
JSR NEWSEG ;[42]
HALT ;[42]
JRST HICAL2 ;[42] BACK TO HISEG
NEWSEG: 0
GSUUO: GETSEG A, ;PHYS-ONLY OR-ED IN IF POSSIBLE
JRST @NEWSEG ;RETURN ERROR
MOVE P,SAVEP ;RESTORE STACK
MOVE F,SAVEF ;AND FLAGS
TLNE F,L.WATV ;ARE WE WATCHING VERSIONS?
PUSHJ P,TYPNSG ;YES, TELL USER ABOUT THIS ONE
MOVE A,NEWSEG ;RETURN ADDR
JRST 1(A) ;SKIP RETURN
RSTART: HLLZS SAVEF ;CLEAR RH FLAGS (R.INQ)
MOVEI A,GSLGO ;SETUP TO GET LOGOUT BACK
JSR NEWSEG
HALT
JRST LOGOUT ;RESTART
GSQUE: SIXBIT .SYS. ;GETSEG BLOCK FOR SYS:QUEUE
SIXBIT .QUEUE.
BLOCK 4
GSLGO: SIXBIT .SYS. ;GETSEG BLOCK FOR SYS:LOGOUT
SIXBIT .LOGOUT.
BLOCK 4
QPARM: XWD LGLAST-LOGCAL+1,LOGCAL ;PARAMETER POINTER FOR QUEUE
LNQCAL==.-TOLO
IFG LNQCAL-200,<
PRINTX ?QUE GETSEG RTNS TOO BIG FOR UFDBUF
>
DEPHASE
SUBTTL LOW SEGMENT TTY/LOG OUTPUT ROUTINES
LOWCHR:!
PHASE OUCHLO
QOUCH: EXCH F,SAVEF ;RESTORE F FROM CALL TO QUEUE
IFN P-17,<EXCH P,SAVEP>
PUSHJ P,OUCH ;OUTPUT CHAR
IFN P-17,<EXCH P,SAVEP>
EXCH F,SAVEF ;RESTORE F AND ITS MEMORY
POPJ 17,
NEWLOG: PUSH 17,1 ;SAVE AC 1
PUSH 17,2
SKIPL LINFLG ;SKIP IF LOG FILE WASNT OPEN
CLOSE LOG, ;CLOSE OUT ANY OLD LOG FILE
SETZM LOGDEV ;CLEAR OUT LOG FILE BUFFER
SKIPA 2,.+1
XWD LOGDEV,LOGDEV+1
BLT 2,LOGEXT ;ALL THE WAY TO EXT
HRLZ 2,1 ;AC1=ADDR OF BEGINNING OF NEW LOG FILE NAME
HRRI 2,LOGDEV ;OUR BLOCK
HLRZS 1 ;LENGTH OF BLOCK
CAILE 1,LOGEXT-LOGDEV+1 ;SKIP IF LESS THAN FULL BLOCK
MOVEI 1,LOGEXT-LOGDEV+1 ;THATS ALL WERE INTERESTED IN
BLT 2,LOGDEV-1(1) ;TRANSFER NEW NAME TO OUR BLOCK
SETOM LINFLG ;NOTE MUST OPEN LOG FILE AGAIN
POP 17,2 ;RESTORE AC2
POP 17,1 ;AND 1
POPJ 17,
MSG: HRLI M,(POINT 7,) ;MESSAGE PRINTER
MSG1: ILDB CH,M ;M POINTS TO STRING OF ASCII CHARACTERS
JUMPE CH,CPOPJ ;NULL CHARACTER ENDS STRING--**EXIT**.
PUSHJ P,OUCH ;OUTPUT NEXT CHARACTER...
JRST MSG1
DECPR2: MOVEI CH,"0"
CAIG N,11 ;SKIP IF TWO DIGIT NUMBER
PUSHJ P,OUCH ;OUTPUT A ZERO FOR FIRST NUMBER
DECPRT: MOVEI R,12 ;DECIMAL RADIX
JRST RDXPRT
OCTPRT: MOVEI R,10 ;OCTAL RADIX
RDXPRT: IDIVI N,(R) ;THE USUAL RADIX PRINT ROUTINE.....
HRLM N1,0(P)
SKIPE N
PUSHJ P,RDXPRT
HLRZ CH,0(P)
ADDI CH,"0" ;FALL INTO OUCH
; PJRST OUCH
OUCH: SKIPE LOGFIL ;IF EITHER LOG FILE [40]
SKIPN LOGDEV ; OR DEVICE NOT SPECIFIED, [40]
JRST TYO ; USE TTY [40]
SKIPL LINFLG ;SKIP IF LOG FILE NOT YET OPEN
JRST LOGO ;YES, GO AHEAD
PUSH P,A ;SAVE
PUSH P,B ;AC'S USED
PUSH P,C ;TO CREATE
PUSH P,D ;LOG FILE
PUSH P,D+1
PUSH P,T
SKIPN B,LOGDEV ;SKIP IF DEVICE SPECIFIED
MOVSI B,(SIXBIT .DSK.) ;NO, USE DSK
MOVEM B,LOGDEV
SETZ A,
MOVSI C,LOB
TLNN F,NOPHYU ;SKIP IF CANT DO PHYSICAL ONLY
TLO A,PHYOPN ;DO PHYSICAL ONLY OPEN
OPEN LOG,A
JRST CLSLG4 ;CANT OPEN, USE TTY
SETZB C,LINFLG ;NOTE LOG FILE IS OPEN, NEEDS TIME STAMP
PUSH P,.JBFF ;SAVE CURRENT .JBFF
MOVEI A,OBUF
MOVEM A,.JBFF
OUTBUF LOG,1 ;USE BUFFER WE KNOW WE HAVE
POP P,.JBFF ;AND RESTORE .JBFF
MOVEI D+1,FBMTRY ;TIMES TO RETRY IF FILE BEING MODIFIED
CLSL1A: MOVE A,LOGFIL
HLLZ B,LOGEXT
SKIPE DSKSER ;IF LEVEL C, [26]
SKIPN LOGPPN+1 ;OR PATH=UFD [26]
SKIPA D,LOGPPN ; USE PPN AS PATH [26]
MOVEI D,LOGPPN ;ELSE PASS PATH ADDR[26]
LOOKUP LOG,A
TDZA T,T
HLRE T,D ;T=LENGTH OF FILE
SKIPE DSKSER ;[26]
SKIPN LOGPPN+1 ;[26]
SKIPA D,LOGPPN ;[26]
MOVEI D,LOGPPN ;RESET PPN[26]
ENTER LOG,A ;NOW SET TO UPDATE
JRST CLSLG3 ;CHECK IF FILE BEING MODIFIED
CLSLG2: JUMPGE T,CLSLG1
MOVNS T
ADDI T,177
LSH T,-7 ;T=BLOCKS WRITTEN
CLSLG1: USETO LOG,1(T)
JSR RESTOR ;POP OFF AC'S USED TO GET UPDATE MODE
LOGO: SKIPG LINFLG ;SKIP IF NO TIME STAMP NEEDED
PUSHJ P,TIMSTP ;YES, OUTPUT TIME STAMP
CAIN CH,LF ;SKIP IF NOT LINE FEED
SETZM LINFLG ;IF LINE FEED NEED TIME STAMP NEXT TIME
SOSG LOB+2
OUTPUT LOG,
IDPB CH,LOB+1
POPJ P, ;EXIT
CLSLG4: SETZM LOGFIL ;CANT USE LOG, MUST TRY TTY [40]
JSR RESTOR ;POP OFF AC'S USED
TYO: TLNE F,NTTYF ;TTY OUTPUT IMPOSSIBLE IF NO TTY PRESENT.
POPJ P, ;GIVE UP
SOSG TYOB+2 ;THE USUAL TELETYPE OUTPUT ROUTINE.....
OUTPUT TTY,0
IDPB CH,TYOB+1
CAIN CH,LF ;LINE FEED FORCES OUTPUT
OUTPUT TTY,0
CPOPJ: POPJ P,
CLSLG3: HRRZ D,B ;D=ENTER ERROR CODE
CAIE D,FBMERR ;SKIP IF FILE BEING MODIFIED
JRST CLSLG4 ;NO, GO AHEAD
SOJL D+1,CLSLG4 ;JUMP IF GIVING UP ON FILE BEING MODIFIED
MOVEI D,1
SLEEP D,
JRST CLSL1A ;RETRY THE ENTER
RESTOR: 0
POP P,T ;RESTORE AC'S USED TO UPDATE LOG
POP P,D+1
POP P,D
POP P,C
POP P,B
POP P,A
JRST @RESTOR ;RETURN TO CALLER
;SUBROUTINE TO OUTPUT LINE PREFIX FOR LOG FILE
;SAVES ALL AC'S USED
TIMSTP: AOS LINFLG ;NOTE NO TIME STAMP NEEDED NEXT TIME
PUSH P,M
PUSH P,N
PUSH P,N1
PUSH P,R ;SAVE R
PUSH P,CH ;SAVE CHAR TO BE TYPED
MSTIME N, ;TIME OF DAY IN MILLISEC'S
IDIVI N,^D1000 ;N=SECONDS
IDIVI N,^D3600 ;N=HOURS, N1=MINUTES
PUSHJ P,TIMOUT ;OUTPUT HOURS AND MOVE N1 TO N
IDIVI N,^D60 ;N=MINUTES, N1=SECONDS
PUSHJ P,TIMOUT ;OUTPUT MINUTES AND MOVE N1 TO N
PUSHJ P,DECPR2 ;OUTPUT SECONDS
MOVEI M,LGOUTM ;KJOB HEADER
TRNE F,R.INQ ;SKIP UNLESS IN QUEUE
MOVEI M,QLGTM ;NO, QUEUE HEADER
PUSHJ P,MSG
POP P,CH
POP P,R
POP P,N1
POP P,N
POP P,M
POPJ P,
;SUBROUTINE TO OUTPUT A TWO DIGIT NUMBER AND A COLON
;ARGS N=NUMBER
;VALUES N=OLD N1
TIMOUT: HRLM N1,(P) ;SAVE N1
PUSHJ P,DECPR2 ;OUTPUT TWO DIGITS IN DECIMAL
HLRZ N,(P)
MOVEI CH,":"
PJRST OUCH ;EXIT WITH COLON
LGOUTM: ASCIZ . LGOUT .
QLGTM: ASCIZ . L-QUE .
;SUBROUTINE TO SIMULATE VERSION WATCH
TYPNSG: MOVEI CH,"[" ;BEGIN WITH BRACKET
PUSHJ P,OUCH
HRROI A,.GTPRG ;GET PROGRAM NAME
GETTAB A,
MOVE A,LOSNAM ;MAKE COMPARE WIN
MOVE C,.JBVER ;ALSO GET VERSION
CAMN C,LOSVER ;IF VER DIFFERS
CAME A,LOSNAM ;OR IF NAME DIFFERS,
JRST .+2 ;PREPARE TO TYPE NEW NAME AND VER
JRST TYPNHS ;ELSE LOOK FOR HIGH SEG CHANGE
MOVEM C,LOSVER ;SAVE NEW AS LAST OLD
MOVEM A,LOSNAM ;SAME FOR NAME
PUSHJ P,TYPSEG ;PRINT SEG NAME AND VERSION
TYPNHS: MOVEI A,.GTPRG ;SEGMENT NAME TABLE
HRLI A,-2 ;FOR OUR HIGH SEGMENT
GETTAB A,
JRST TYPCLB ;NO HI SEG, TYPE CLOSE BRACKET
MOVEI M,SPLS ;SPACE, PLUS, SPACE
PUSHJ P,MSG
MOVEI C,.JBHGH## ;ADDR OF HIGH SEG
MOVE C,.JBHVR##(C) ;PICK UP HIGH SEG VERSION
CAMN C,LOSVER ;COMPARE TO LOW SEG
CAME A,LOSNAM ;LOOK FOR DIFFERENT
PUSHJ P,TYPSEG ;YES, TYPE THOSE TOO
TYPCLB: PJSP M,MSG ;CLOSE WITH BRACKET AND CRLF
ASCIZ .]
.
TYPSEG: PUSHJ P,SIXBPA ;PRINT SEGMENT NAME
MOVEI CH,SPACE
PUSHJ P,OUCH ;SEPARATE NAME FROM VERSION
LDB N,MAJVER ;MAJOR VERSION
PUSHJ P,OCTPRT ;THAT'S ALWAYS PRINTED
LDB CH,MINVER ;MINOR VERSION
JUMPE CH,TYPEDT ;THAT'S NOT PRINTED IF ZERO
ADDI CH,"A"-1 ;MAKE INTO A CHARACTER
PUSHJ P,OUCH ;PRINT MINOR VERS
TYPEDT: HRRZI N,(C) ;EDIT #
JUMPE N,TYPWHO ;PRINT NOTHING IF ZERO
MOVEI CH,"(" ;BEGIN EDIT NO FIELD
PUSHJ P,OUCH
PUSHJ P,OCTPRT ;EDIT NO IN OCTAL
MOVEI CH,")" ;END EDIT FIELD
PUSHJ P,OUCH
TYPWHO: LDB N,WHOVER ;WHO DID LAST EDIT
JUMPE N,CPOPJ ;DEC DEVELOPMENT
MOVEI CH,"-"
PUSHJ P,OUCH
MOVEI CH,"0"(N) ;CREATE NUMBER IN CH
PJRST OUCH ;PRINT THAT, AND QUIT
SPLS: ASCIZ . + .
MAJVER: POINT 9,C,11 ;GET MAJOR VERSION # FROM C
MINVER: POINT 6,C,17
WHOVER: POINT 3,C,2
;SIXBIT OUTPUT ROUTINES
SIXBPA: TLOA F,BPAF ;STOP AT FIRST NULL (BLANK)
SIXBP: TLZ F,BPAF ;PRINT ALL 6 CHARS
MOVE B,SIXPNT ;GET SIXBIT BYTES FROM A
SIXBP1: ILDB CH,B
TLNE F,BPAF ;STOP AT NULL?
JUMPE CH,CPOPJ ;YES, EXIT IF SO
ADDI CH,40 ;CONVERT TO ASCII
PUSHJ P,OUCH ;PRINT IT
TLNE B,(77B5) ;HAS BYTE POINTER RUN OUT?
JRST SIXBP1 ;NO, PROCEED
POPJ P, ;YES, STOP
SIXPNT: POINT 6,A
LNOUCH==.-QOUCH
IFG LNOUCH-EOUCHL,<
PRINTX ?INSUFFICIENT ROOM FOR LOW SEG OUTPUT RTNS
>
DEPHASE
SUBTTL QUOTA ENFORCEMENT
;HERE ON RETURN FROM QUEUE (OR IF QUEUE NOT CALLED)
HICAL1: MOVE A,LOGCAL
MOVEM A,LOGQUE
HICAL2: HLLZ F,SAVEF ;RESTORE FLAGS
HICALL: MOVEI M,LOGOUT ;RESET START ADDR
HRRM M,.JBSA
MOVE P,PDP ;SET UP PUSH DOWN PTR
GETPPN A,
TLZA A,400000 ;SKIP AND CLEAR JUNK--NOT A MULTIPLE USER.
TLO F,DUPF ;NOTE MORE THAN ONE USER THIS PPN
MOVEM A,SVPJPG ;SAVE USER'S PROJECT,PROGRAMMER NUMBER.
MOVE A,[%LDMFD] ;PREPARE TO GET MFD PPN
GETTAB A,
MOVE A,[1,,1] ;DEFAULT VALUE
MOVEM A,MFDPP ;SAVE VALUE
SKIPE DSKSER ;IF LEVEL C, THAT'S ALSO SYS
MOVE A,[1,,4] ;DEFAULT SYSPPN FOR LEVEL D
MOVE N,[%LDSYS] ;LEVEL D SYS PPN
GETTAB N, ;GET SYS PPN
MOVE N,A ;USE DEFAULT
MOVEM N,SYSPPN
MOVE A,[%FTDSK] ;[45] GET DISK FEATURE TEST BITS
GETTAB A, ;[45]
JRST .+3 ;[45] NO GETTAB, ASSUME IT DOES
TRNN A,F%STR ;[45] IF NO MULTIPLE STRUCTURES,
TLO F,NMSTR ;[45] REMEMBER IT
MOVE A,[XWD SEGPTR,CNFTBL]
GETTAB A, ;GET NO OF JOBS IN SYSTEM
MOVEI A,100 ;ASSUME 64
MOVNI A,-1(A) ;- NUMBER OF ACTUAL JOBS (NOT COUNTING NULL JOB)
HRLZM A,NOJOBS ;SAVE FOR LATER
;HERE TO BUILD COPY OF THIS JOB'S SEARCH LIST
GETSL: SETO A, ;START WITH FIRST STR
SETZ S, ; AND AT BEGINNING OF TABLE
NXTSTR: MOVE T,[XWD 3,A]
JOBSTR T, ;GET NEXT STR
JRST NOJBST ; TROUBLE!! SNH
JUMPE A,NXTSTR ;IGNORE FENCE
MOVEM A,STRNAM(S) ;SAVE NAME
AOJE A,LOKSTR ;JUMP IF END OF SL
SOJ A, ;RESTORE FOR NEXT JOBSTR
MOVEM B,STRPPN(S) ;SAVE PPN
MOVEM C,STRFLG(S) ; AND FLAGS
SETZM STRSTS(S) ;INIT BOOKKEEPING FLAG
AOJA S,NXTSTR ;THEN GO BACK FOR NEXT
LOKSTR: SETZM STRNAM(S) ;MARK END OF LIST
;HERE TO CHECK QUOTA ON EACH STR IN S.L.
; AND DISMOUNT IT IF OK
TLZ F,L.OVRQ+L.ILKF+L.FRCI
MOVEI A,TRYILK ;TIMES TO TRY FOR INTERLOCK
MOVEM A,ILKTRY ;FORCE THRU WHEN IT RUNS OUT
SETZB S,NSBLKS ;CLEAR TOTAL BLOCKS SAVED
IFN FTNSFL,<
SETZM NSFILS ;CLEAR FILES SAVED
>
STRLUP: SKIPN B,STRNAM(S) ;GET NEXT STR NAME
JRST NOSTRS ;END OF LIST
SKIPE STRSTS(S) ;HAVE WE ALREADY HANDLED THIS ONE?
AOJA S,STRLUP ;YES, GO FOR NEXT
PUSHJ P,SETILK ;SET UFD INTERLOCK TO PREVENT RACES
AOJA S,STRLUP ;CAN'T--GO ON TO NEXT, COME BACK LATER
PUSHJ P,CHKQER ;IS QUOTA ENFORCEMENT REQUIRED?
JRST DSMSTR ; NO, JUST DISMOUNT STR
PUSHJ P,ENFQTA ;YES -- ENFORCE QUOTA
JRST OVRQTA ;OVER QUOTA, DO NOT DISMOUNT
MOVE A,SVBLKS ;GET BLOCKS ALLOCATED ON THIS STR
SUB A,NQCBLK ;LESS THE NQC FILES
ADDM A,NSBLKS ;ADD INTO TOTAL
IFN FTNSFL,<
MOVE A,SVFILS ;GET TOTAL FILES SAVED ON THIS STR
ADDM A,NSFILS ;TOTAL
>
DSMSTR: PUSHJ P,REMSTR ;REMOVE STR FROM S. L.
OVRQTA: TLNN F,NMSTR ;[45] DON'T CLEAR INTERLOCK ON 1040'S
PUSHJ P,CLRILK ;CLEAR INTERLOCK
AOJA S,STRLUP ;PROCEED TO NEXT STR
NOSTRS: TLZN F,L.ILKF ;WERE WE UNABLE TO GET THE INTERLOCK?
JRST SQCHK ;NO, WE GOT IT ALL RIGHT
SOSG A,ILKTRY ;TRIED TOO MANY TIMES ALREADY?
TLO F,L.FRCI ;YES- FORCE THE LOCK
CAIN A,TRYILK-^D30 ;HAS USER BEEN WAITING LONG?
PUSHJ P,ILKMSG ;YES, TELL HIM WHY
MOVEI A,1
SLEEP A, ;REST WHILE THE INTERLOCK IS USED
SETZ S, ;START AGAIN FROM THE BEGINNING
JRST STRLUP
SUBTTL SUMMARY MESSAGES AND FACT FILE UPDATE
SQCHK: TLNE F,L.OVRQ ;IS ANY STR OVER QUOTA?
JRST TOKJOB ;YES--BOUNCE HIM BACK TO KJOB
;NOW IT IS TIME TO PRINT THE LOGGED OFF MESSAGE......
ACCT: SETZB N,N+1 ;FIRST GET RID OF IN-CORE TEMPS
MOVE M,[XWD TCRRDD,N];POINTER TO ZERO DATA
TMPCOR M, ;DELETE IT ALL
JFCL ;IGNORE ERROR RETURN
MOVN A,THSJOB ;[46] GET JOB STATUS
JOBSTS A, ;[46]
JRST ATUSER ;[46] ASSUME USER ON ERROR
TLNN A,(1B2) ;[46] TERMINAL AT MONITOR LEVEL?
JRST ATUSER ;[46] NO, DON'T DO ATTACH
MOVNI A,1 ;[46] GET LINE NUMBER
GETLCH A ;[46]
HRLO A,A ;[46] SET UP FOR ATTACH UUO
TLO A,200000 ;[46]
ATTACH A, ;[46] SET TERMINAL TO USER MODE
JFCL ;[46] IGNORE ERROR RETURNS
ATUSER: MOVEI M,JOBM ;PRINT FIRST LINE OF LOG-OUT MESSAGE.....
PUSHJ P,MSG
MOVE N,THSJOB
PUSHJ P,DECPRT
MOVEI M,USRMG
PUSHJ P,PPMSG ;PRINT USER'S PROJECT, PROGRAMMER NUMBERS
MOVEI M,OFFMSG
PUSHJ P,MSG
GETLIN A, ;GET TTY NAME
TLNN A,-1 ;[43] DETACHED?
SETZ A, ;[43] YES, REMEMBER IT
MOVEM A,THSTTY ;SAVE FOR FACT FILE
JUMPN A,.+2 ;DETACHED ?
MOVE A,[SIXBIT /TTYDET/] ;YES, RANDOM NAME.
PUSHJ P,SIXBP ;PRINT TTY LINE NUMBER
PUSHJ P,PR3SPC ;THREE SPACES
MSTIME A,
IDIV A,[^D1000*^D60*^D60]
MOVE N,A
PUSHJ P,DECPR2 ;PRINT TIME AS HHMM WITHOUT SPACE OR COLON
IDIVI B,^D1000*^D60
MOVE N,B
PUSHJ P,DECPR2
PUSHJ P,PR2SPC ;TWO SPACES
PUSHJ P,DATOUT ;PRINT DATE AS DD-MMM-YY
PUSHJ P,CRLF ;END OF FIRST LINE OF LOG-OUT MESSAGE.
;NOW, AS WE ARE PRINTING FIRST LINE OF LOGGED OUT MESSAGE, WE CAN
; SIMULTANEOUSLY WORK ON UPDATING FACT.SYS......
IFN FACTSW, <
;UPDATE THE SYSTEM ACCOUNTING FILE (FACT.SYS) WHICH RECORDS ALL SIGNIGICANT
; TRANSACTIONS OCCURRING IN THE PDP-10 TIME-SHARING SYSTEM......
SETZ A, ;CLEAR TTY NO ACCUM
SKIPN B,THSTTY ;DO WE HAVE A TTY?
JRST TTYDET ;NO, NOTE DETACHED
HRLZS B ;GET LINE NO IN LEFT HALF
JUMPE B,TTYCTY ;NO NUMBER, NOT DETACHED = CTY
LSH B,3 ;SHIFT OUT "ZONE" BITS
LSHC A,3 ;SHIFT NUMBER INTO A
JUMPN B,.-2 ;IF MORE DIGITS, SHIFT THEM TOO
JRST GOTTTY ;GO STORE IT
TTYCTY: SETO A, ;-1 = CTY
TTYDET: IORI A,-2 ;-2 = DETACHED
GOTTTY: ANDI A,7777 ;HOPEFULLY FEWER THAN 4095 TTY'S
LSH A,6 ;MOVE TO BITS 18-29
HRL A,THSJOB ;JOB # IN BITS 9-17
IOR A,FCTHED ;STICK IN CONSTANT DATA
MOVEM A,FENTRY ;STORE WORD 0
MOVE CALC,SVPJPG
MOVEM CALC,FENTRY+1 ;PROJECT, PROGRAMMER NUMBER IN SECOND WORD
IFE FT1975,< ;[24]
TIMER CALC,
DATE A, ;GET DATE
ROT A,-^D12 ;DATE IN HIGH 12 BITS
IOR CALC,A ;COMBINE DATE WITH TIME
>;END FT1975 OFF [24]
IFN FT1975,< ;[24]
PUSHJ P,GETNOW ;GET NEW FORMAT DATE/TIME [24]
>;END IFN FT1975 [24]
MOVEM CALC,FENTRY+2 ;STORE 3RD WORD
MOVEI CALC,0 ;CURRENT JOB
RUNTIM CALC,
MOVEM CALC,FENTRY+3
MOVEM CALC,JRUNTM ;SAVE FOR MESSAGE PRINTER
HRROI CALC,JBTKCT ;KILO-CORE-TICS IN 5TH WORD
GETTAB CALC,
MOVEI CALC,0 ;NO SKIP RETURN FROM GETTAB
IFN FT1975,< ;JIFFIE DEPENDENCY ILLEGAL IN NEW FORMAT [24]
MOVE A,[%CNTIC] ;[24]
GETTAB A, ;GET JIFFIES/SEC [24]
MOVEI A,^D60 ;[24]
IMULI CALC,^D100 ;CONVERT KCT[24]
IDIV CALC,A ;TO KC<1/100THS> [24]
LSH CALC+1,1 ;[24]
CAIL CALC+1,(A) ;ROUND[24]
ADDI CALC,1 ;[24]
>;END IFN FT1975 [24]
MOVEM CALC,FENTRY+4
HRROI CALC,JBTRCT ;GET JOB'S DISK BLOCKS READ
GETTAB CALC,
SETZ CALC,
TLZ CALC,JBTDCT ;CLEAR OUT INCREMENTAL FIELD
MOVEM CALC,FENTRY+5
MOVEM CALC,JDREAD ;SAVE FOR LOGOUT MESSAGE
HRROI CALC,JBTWCT ;GET JOB'S DISK BLOCKS WRITTEN
GETTAB CALC,
SETZ CALC,
TLZ CALC,JBTDCT ;CLEAR OUT INCREMENTAL FIELD
MOVEM CALC,FENTRY+6
MOVEM CALC,JDWRIT ;SAVE FOR LOGOUT MESSAGE
MOVE CALC,[XWD -7,FENTRY]
PUSHJ P,APPEND ;APPEND ENTRY TO THE CURRENT FACT.SYS FILE.
> ;END OF IFN FACTSW CONDITIONAL
;NOW CONTINUE PRINTING LOGGED OFF MESSAGE....
SKIPN N,NDFILS ;ANY FILES DELETED ?
JRST SAVDAL ;NO, PRINT "SAVED ALL...."
PUSHJ P,FDMSG ;YES, PRINT NUMBER OF FILES DELETED
SKIPN NSBLKS ;ANYTHING SAVED?
PUSHJ P,ALLMSG ;IF NOT, PRINT "ALL"
PUSHJ P,FILSMG
MOVE N,NDBLKS ;PRINT NUMBER OF BLOCKS DELETED.
PUSHJ P,BLKSMG ;END OF SECOND LINE OF LOG-OUT MESSAGE.
SAVDAL: SKIPN NSBLKS ;ANYTHING SAVED?
JRST PRUNTM ;IF NOT, DON'T PRINT THAT LINE.
PUSHJ P,FSMSG
SKIPN NDFILS ;ANY FILES DELETED?
PUSHJ P,ALLMSG ;NO, PRINT "ALL"
IFN FTNSFL,<
MOVE N,NSFILS ;GET NO OF FILES SAVED
>
IFE FTNSFL,<
SETZ N, ;DO NOT PRINT A NUMBER
>
PUSHJ P,FILSMG
MOVE N,NSBLKS ;NUMBER OF BLOCKS SAVED
PUSHJ P,BLKSMG ;PRINT NUMBER OF BLOCKS SAVED.
;END OF 3RD LINE OF LOG-OUT MESSAGE.
PRUNTM: TLNE F,DUPF ;OTHER USER STILL LOGGED IN UNDER THIS [P,P] ?
PUSHJ P,NTHRMG ;IF SO, PRINT REMINDER LINE.
MOVEI M,RNTMSG ;PRINT TOTAL RUN-TIME FOR THIS JOB....
PUSHJ P,MSG
IFN FACTSW,<
MOVE A,JRUNTM
>
IFE FACTSW,<
MOVEI A,0 ;[30]
RUNTIM A, ;GET RUNTIME
>
ADDI A,^D9 ;ROUND-UP TO NEXT HIGHER .01 SECOND.
IDIVI A,^D1000*^D60
SKIPN N,A ;ANY MINUTES [34]
JRST PRUNSC ;NO, JUST SECONDS [34]
PUSHJ P,DECPRT ;MINUTES
MOVEI M,MINMSG
PUSHJ P,MSG ;MINUTES MESSAGE
PRUNSC: IDIVI B,^D1000 ;[34]
MOVE N,B
PUSHJ P,DECPRT ;SECONDS [34]
IDIVI C,^D10
PUSHJ P,PDOT
MOVE N,C ;HUNDREDTHS OF A SECOND
PUSHJ P,DECPR2
MOVEI M,SECMSG ;SECONDS MESSAGE
PUSHJ P,MSG
;HERE TO PRINT DISK BLOCKS READ AND WRITTEN
IFE FTDSTT,< ;IF FEATURE ON, ALWAYS PRINT
MOVE A,SVWTCH ;IF OFF, PRINT ONLY WHEN WATCH SET
TLNN A,(JW.WDR!JW.WDW) ;READ OR WRITE WATCHING ENABLED?
JRST RLSLOG ;NO, CLOSE AND RELEASE LOG FILE
>
IFE FACTSW,<
HRROI N,JBTRCT ;IF FACTSW OFF, MUST GET VALUE
GETTAB N,
JRST RLSLOG ;FEATURE MUST BE OFF IN MONITOR
TLZ N,JBTDCT ;CLEAR INCREMENTAL COUNT
>
IFN FACTSW,<
MOVE N,JDREAD ;GET TOTAL DISK READS REPORTED IN FACT FILE
>
MOVEI M,[ASCIZ .Total of .]
PUSHJ P,MSG ;BEGIN THE MESSAGE
PUSHJ P,DECPRT ;PRINT READ COUNT
MOVEI M,[ASCIZ . disk blocks read, .]
PUSHJ P,MSG
IFE FACTSW,<
HRROI N,JBTWCT ;BLOCKS WRITTEN COUNT
GETTAB N,
SETZ N, ;SNH...
TLZ N,JBTDCT ;CLEAR INCREMENTAL
>
IFN FACTSW,<
MOVE N,JDWRIT
>
PUSHJ P,DECPRT ;PRINT WRITTEN COUNT
MOVEI M,[ASCIZ . written
.]
PUSHJ P,MSG
RLSLOG: SKIPL LINFLG ;SKIP IF LOG FILE NOT YET OPEN
CLOSE LOG,
RELEASE LOG,
SKIPN LOGQUE ;SKIP IF LOG FILE TO WORRY ABOUT
SKIPE LOGQU1 ;SKIP IF BOTH ZERO
SKIPA A,LOGEXT ;GET FLAGS FROM QUEUE
JRST CLSTTY
MOVSI B,(SIXBIT .QUE.);DEVICE QUE
SETZ T,
TRNE A,Q.PLGQ ;SKIP IF DONT USE LOGICAL QUE
JRST RLSLG1 ;NO, USE QUE
MOVE B,[XWD OPQSIN,OPQSTB]
GETTAB B, ;GET NAME OF SYSTEM QUEUE DEVICE
MOVSI B,(SIXBIT .DSK.);SETTLE FOR DSK
MOVE T,[XWD OPQPIN,OPQPTB]
GETTAB T, ;GET QUEUE AREA
MOVE T,[XWD 3,3]
RLSLG1: MOVEI A,17
SETZ C,
TLNN F,NOPHYU ;SKIP IF MAY NOT DO PHYSICAL ONLY
TLO A,PHYOPN ;PHYSICAL OPEN
OPEN LOG,A
JRST CLSTTY ;NOT TODAY
MOVSI N,-2 ;SET FOR TWO POSSIBLE QUEUE REQUESTS
RLSLG2: SKIPN A,LOGQUE(N) ;NAME OF QUEUE REQUEST
JRST RLSLG3 ;NOT THIS ONE
MOVSI B,(SIXBIT .QUE.);EXT QUE
SETZ C,
MOVE D,T
LOOKUP LOG,A ;LOOKUP LOG FILE QUEUE REQUEST
JRST RLSLG3 ;NO SUCH FILE
MOVE D,T ;RESTORE PPN
ENTER LOG,A ;AND SET TO UPDATE
JRST RLSLG3
MOVE A,[IOWD 200,OBUF]
SETZ B,
INPUT LOG,A ;READ QUEUE REQUEST
SETZM OBUF+LOGINU ;CLEAR IN USE FLAG
USETO LOG,1 ;SET TO REWRITE FIRST BLOCK
OUTPUT LOG,A ;AND WRITE IT OUT
CLOSE LOG,
RLSLG3: AOBJN N,RLSLG2 ;LOOP FOR ALL POSSIBLE QUEUE REQUESTS
MOVE A,NOJOBS ;POINTER FOR NUMBER OF JOBS IN SYSTEM
WAKELP: HRLZI B,1(A) ;NEXT JOB TO CHECK
HRRI B,JBTPRG
GETTAB B, ;GET JOB NAME
SETZ B,
CAME B,[SIXBIT .LPTSPL.] ;SKIP IF LPT SPOOLER
JRST WAKEL1 ;NO
MOVEI B,1(A)
WAKE B, ;WAKE UP
JFCL
WAKEL1: AOBJN A,WAKELP ;LOOP FOR ALL POSSIBLE JOBS
CLSTTY: RELEASE LOG,
SETZM LOGFIL ;LOG FILE NO LONGER USEFUL [40]
SETO A,
GETLCH A ;GET LINE CHARACTERISTICS BITS
TLNE A,TT.PTY ;PTY? [27]
CLRBFI ;YES, CLEAR BUFFER [27]
MOVEI M,LASTMG ;LINEFEEDS, EOT
TLNN A,TT.PTY ;SKIP IF OVER PTY
SKIPN THSTTY ;[43] DETACHED?
SKIPA ;[43]
PUSHJ P,MSG ;NO, OUTPUT THE END OF MESSAGE
WAIT TTY, ;LET TTY FINISH
RELEASE TTY,0
MOVE B,STRNAM ;[45]
TLNE F,NMSTR ;[45] ON 1040 SYSTEMS,
PUSHJ P,CLRILK ;[45] CLEAR THE INTERLOCK NOW
KILLJB ;**** END OF JOB ****
SUBTTL FILE-STRUCTURE HANDLING SUBROUTINES
;SUBROUTINE TO DETERMINE WHETHER QUOTA SHOULD BE ENFORCED ON A STR
;CALL WITH STR NAME IN B
;RETURN CPOPJ IF NO ENFORCEMENT REQUIRED
; CPOPJ1 IF REQUIRED
CHKQER: MOVE D,[DSKCHR A,]
TLNN F,NOPHYU ;IS PHYSICAL ONLY SUPPORTED?
TRO D,PHYUUO ;YES, ASK FOR IT
MOVEM B,CHRBUF ;GET STR NAME INTO DSKCHR BUFFER
MOVE A,[XWD CHRLEN,CHRBUF]
XCT D ;GET VALUES THROUGH STR NAME
SETZM CHRBUF+.DCUFT ;PASSING STRANGE!
TLNE F,NOPHYU ;IF NO PHYSICAL ONLY,
CAMN B,CHRBUF+.DCSNM ; CHECK THAT WE HAVE PROPER NAME
JRST CHKNAC ;ONE OR BOTH ARE OK
JRST NLOGNM ;DISALLOW LOGICAL NAMES FOR STR'S
CHKNAC: REPEAT 0,< ;[25]
MOVSI A,400000 ;FILSER'S NO-PREVIOUS-ACCESS CODE
CAMN A,CHRBUF+.DCUFT ;IF NO ACCESSES, QUOTA MUST BE OK
POPJ P,
>;END REPEAT 0 [25]
OTHUSR A, ;ANY OTHER USERS WITH THIS PPN?
JRST NOOTHR ;NO, DON'T BOTHER LOOKING FOR THEM
TLO F,DUPF ;NOTE OTHERS
MOVEM B,EXLBUF+GOBNAM ;YES, PUT STR NAME INTO GOBSTR BUFFER
MOVE A,SVPJPG ;GET USER'S PPN
MOVEM A,EXLBUF+GOBPPN
MOVE C,[%HGHJB] ;[44] CODE TO GET MAX JOB IN USE
GETTAB C, ;[44]
JRST [MOVE C,NOJOBS;[44] ON FAILURE, USE HIGHEST JOB ASSIGNED
JRST CHKOTH] ;[44]
MOVNS C ;[44] BUILD INTO AOBJN WORD
HRLZS C ;[44]
CHKOTH: MOVEI A,1(C) ;DON'T CHECK NULL JOB
CAMN A,THSJOB ;OR THIS JOB
JRST CHKOT1
MOVEM A,EXLBUF+GOBJOB ;OTHERWISE, STORE JOB NO TO TEST
MOVEI A,EXLBUF
GOBSTR A, ;DOES THIS JOB HAVE SAME PPN AND THIS STR?
JRST CHKOT1 ;NO TO EITHER OR BOTH
POPJ P, ;YES, EASY THIS TIME
; WE WILL ENFORCE WHEN HE LOGS OFF
CHKOT1: AOBJN C,CHKOTH ;IF ANY MORE JOBS, CHECK THEM
;HERE WHEN NO OTHER JOBS SAME PPN WITH THIS STR IN THEIR S.L.
NOOTHR: MOVEI A,17 ;PREPARE TO OPEN STR
TLNN F,NOPHYU ;CAN WE DO PHYSICAL ONLY?
TLO A,PHYOPN ;YES, DO IT
SETZ C,
OPEN UFD,A ;OPEN THE STR TO LOOK AT UFD
POPJ P, ;STR MUST NOT EXIST...
MOVEI A,EXLLEN-1 ;LEN OF ARG LIST AFTER LEN WORD
MOVEM A,EXLBUF
MOVE A,MFDPP
MOVEM A,EXLBUF+.RBPPN ;UFD IS IN MFD PPN
MOVE A,SVPJPG ;USER'S PPN IS UFD NAME
MOVEM A,EXLBUF+.RBNAM
MOVSI A,'UFD'
MOVEM A,EXLBUF+.RBEXT
LOOKUP UFD,EXLBUF
JRST NOLOOK ;THIS COULD BE OK
MOVE A,EXLBUF+.RBSTS ;LOOK AT STATUS BITS
TRNN A,RP.NDL ;IS NO DELETE BIT ON?
CPOPJ1: AOS 0(P) ;NO, RENAME WORKS, SO ENFORCE QUOTA
POPJ P, ;YES, CAN'T RENAME UFD, SO QUOTA MEANINGLESS
NOLOOK: HRRZ N,EXLBUF+.RBEXT ;GET LOOKUP ERROR CODE
JUMPE N,CPOPJ ;IF NO UFD, NO FILES, SO QUOTA OK
PJSP M,SYSERR ;OTHERWISE, TELL USER OF TROUBLES
ASCIZ . UFD LOOKUP .
;SUBROUTINE TO MAKE SURE USER IS UNDER QUOTA ON THIS STR
;ENTER WITH STR NAME IN B, UFD CHANNEL OPEN AND UFD LOOKED UP
;RETURN CPOPJ IF OVER QUOTA, L.OVRQ BIT LIT IN F
; CPOPJ1 IF ALL OK
ENFQTA: MOVSI A,400000 ;DOES FILSER KNOW QUOTA?[25]
CAME A,CHRBUF+.DCUFT ;LOOK FOR "NO PREVIOUS ACCESS" [25]
JRST ENFQT1 ;HAS BEEN ACCESSED, CHECK IT [25]
MOVE A,EXLBUF+.RBUSD ;TAKE TOTAL FROM LAST TIME [25]
JRST ENFQT2 ;USE THAT [25]
ENFQT1: MOVE A,EXLBUF+.RBQTF ;FCFS (LOGGED IN) QUOTA
SUB A,CHRBUF+.DCUFT ;LOGGED IN QUOTA - USER FREE = TOTAL USED
MOVEM A,EXLBUF+.RBUSD ;STORE FOR OLD MONITORS -- NORMALLY, WE
;WILL LET FILSER PREVENT RACES
ENFQT2: MOVEM A,SVBLKS ;ALSO SAVE VALUE AS BLOCKS SAVED
JUMPL A,CHKQTA ;IF BLOCKS USED NEG, SOMETHING WRONG
SUB A,EXLBUF+.RBQTO ;BLOCKS USED - LOGGED OUT QUOTA
; GIVES AMOUNT OVER QUOTA
JUMPG A,CHKQTA ;RECOMPUTE BLOCKS USED TO MAKE SURE
SKIPN EXLBUF+.RBSIZ ;IS ANYTHING WRITTEN IN UFD?
JRST DELUFD ;NO, DELETE IT
IFE FTNSFL,<
SETZM RDHED ;MAKE SURE WE DO AN INPUT
EMTLUP: PUSHJ P,RDUFD ;READ UFD
JRST DELUFD ;IF NOTHING BUT ZEROS, DELETE IT
JUMPE T,EMTLUP ;LOOP AS LONG AS NOTHING BUT ZEROS FOUND
>
IFN FTNSFL,<
PUSHJ P,LOKALL ;GO COUNT ALL FILES, INCLUDING THOSE IN SFD'S
JRST SAVUFD ;SOMETHING WRONG, TAKE NO CHANCES
SKIPN SVFILS ;ANY FILES IN UFD?
JRST DELUFD ;NO, DELETE IT
>
;HERE TO RENAME UFD, STORING BLOCKS USED AND CLEARING LOGGED IN BIT
SAVUFD: MOVE A,DSKSER ;GET TYPE OF DISK SERVICE
CAIL A,RACEY ;IS IT SMARTER THAN US?
SETOM EXLBUF+.RBUSD ;YES-USE ITS VALUE FOR BLOCKS USED
RENUFD: MOVSI A,RP.LOG ;LOGGED-IN BIT
ANDCAM A,EXLBUF+.RBSTS ;CLEAR IT
RENAME UFD,EXLBUF ;DO THE RENAME
JRST NORENM ;CAN'T
CLSUFD: RELEAS UFD, ;FREE UP THE CHANNEL
JRST CPOPJ1 ;AND GIVE GOOD RETURN
DELUFD: SETZB A,B ;DELETE UFD
SETZB C,D
RENAME UFD,A
JRST RENUFD ;IF CAN'T DELETE, MARK AS LOGGED OUT
SETZM SVBLKS ;NOTHING SAVED HERE [25]
JRST CLSUFD ;AND GET OUT
NORENM: HRRZ N,EXLBUF+.RBEXT ;GET ERROR CODE
MOVEI M,[ASCIZ . UFD RENAME .]
PUSHJ P,SYSERR ;PRINT FAILURE MESSAGE
JRST CLSUFD
;HERE WHEN FILSER THINKS USER IS OVER QUOTA
CHKQTA: TLNE F,L.FRCI ;DID WE FORCE OUR WAY THROUGH INTERLOCK?
JRST XITOVQ ;YES, DO NOT TEMPT FATE AGAIN
PUSHJ P,LOKALL ;LOOK AT ALL FILES
JRST XITOVQ ;CAN'T -- GIVE UP
MOVE A,NQCBLK ;GET # OF NQC BLOCKS
MOVEM A,EXLBUF+.RBNQC ;AND STORE IT IN THE RIB
MOVE A,SVBLKS ;TOTAL BLOCKS ALLOCATED
MOVEM A,EXLBUF+.RBUSD
JUMPE A,DELUFD ;DELETE UFD IF NO BLOCKS SAVED
SUB A,NQCBLK ;NOW SUBTRACT NQC FILES
CAMG A,EXLBUF+.RBQTO ;IS HE OVER QUOTA?
JRST RENUFD ;NO, RENAME UFD AND LET HIM OUT
XITOVQ: TLO F,L.OVRQ ;LIGHT OVER-QUOTA FLAG
AOS STRSTS(S) ;AND MARK STR AS PROCESSED
MOVEI CH,"?"
PUSHJ P,OUCH ;TELL USER
MOVE A,STRNAM(S)
PUSHJ P,SIXBPA ;PRINT STR NAME
MOVEI M,[ASCIZ . logged out quota .]
PUSHJ P,MSG
MOVE N,EXLBUF+.RBQTO ;TELL HIM HIS QUOTA
PUSHJ P,DECPRT
MOVEI M,[ASCIZ . exceeded by .]
PUSHJ P,MSG
MOVE N,SVBLKS ;TOTAL BLOCKS ALLOCATED
SUB N,EXLBUF+.RBQTO ; MINUS QUOTA = AMOUNT OVER
PUSHJ P,DECPRT
PJSP M,MSG ;FINISH MESSAGE AND GIVE BAD RETURN TO CALLER
ASCIZ . blocks
.
;HERE TO LOOKUP ALL FILES BELONGING TO USER, COUNTING THEM
; AND ADDING UP TOTAL BLOCKS USED
LOKALL: MOVEI A,17
TLNN F,NOPHYU
TLO A,PHYOPN ;DO PHYSICAL-ONLY OPEN IF POSSIBLE
SETZ C,
OPEN DSK,A ;OPEN CHANNEL FOR READING UFD
POPJ P, ;RETURN FAILURE TO CALLER
OPEN USR,A ;OPEN CHANNEL FOR EXTENDED LOOKUPS
POPJ P,
SETZM SVBLKS ;CLEAR BLOCKS-ALLOCATED COUNTER
SETZM NQCBLK ;CLEAR NQC BLOCKS ALLOCATED COUNTER
IFN FTNSFL,<
SETZM SVFILS ;CLEAR FILES-SAVED COUNTER
>
MOVEI A,USRLEN-1 ;LEN OF LOOKUP'S DESIRED
MOVEM A,USRBLK
MOVE A,SVPJPG ;GET USER'S PPN
MOVEM A,USRBLK+.RBPPN ;STORE IN EXT LOOKUP BLOCK
MOVSI B,'UFD'
MOVE D,MFDPP ;GET MFD PPN
MOVEI CALC,CURPTH+1 ;SETUP POINTER TO PATH SPEC
PUSHJ P,SCNDIR ;CALL RECURSIVE DIRECTORY SCANNER
RELEAS DSK,
RELEAS USR, ;CLOSE CHANNELS
JRST CPOPJ1 ;GOOD RETURN
;RECURSIVE DIRECTORY SCANNING ROUTINE
SCNDIR: HLLM B,0(P) ;SAVE EXT IN HANDY HALFWORD
PUSH P,A ;SAVE DIR NAME
PUSH P,D ;AND HIGHER PPN OR PATH POINTER
SETZB N,BLKCNT ;SET TO START READING AT BEGINNING
SCNRST: SETZB C,1(CALC) ;PROCEED FROM HERE AFTER RECURSIVE CALL
LOOKUP DSK,A ;LOOKUP DIRECTORY TO BE READ
JRST DLKERR ;REPORT LOOKUP ERROR AND QUIT
SKIPE T,BLKCNT ;JUST STARTING THIS DIR?
USETI DSK,1(T) ;NO, CONTINUE WHERE WE LEFT OFF
PUSHJ P,DSKINP ;GET APPROPRIATE BLOCK INTO BUFFER
JRST SCNXIT ;EOF, STOP SCAN
JUMPE N,.+2 ;JUST STARTING?
MOVEM N,RDHED ;NO, RESET BUFFER POINTER
PUSH CALC,A ;MOVE DIRECTORY NAME ONTO PATH
SETZM 1(CALC) ;AND TERMINATE THERE
SCNLUP: PUSHJ P,RDDSK ;GET A WORD FROM DIRECTORY
SOJA CALC,SCNXIT ;END OF UFD, POP UP A LEVEL
MOVEM T,USRBLK+.RBNAM ;SAVE FILE NAME
PUSHJ P,RDDSK ;GET EXT WORD
SOJA CALC,SCNXIT
HLLZM T,USRBLK+.RBEXT ;SAVE EXT
SKIPN A,USRBLK+.RBNAM ;NULL NAME?
JRST SCNLUP ;YES, IGNORE IT
LOOKUP USR,USRBLK ;LOOKUP THE FILE
JRST FLKERR ;REPORT LOOKUP ERROR AND CONTINUE
IFN FTNSFLS,<
AOS SVFILS ;COUNT FILES
>
MOVE T,USRBLK+.RBALC ;GET BLOCKS ALLOCATED
ADDM T,SVBLKS ;TOTAL BLOCKS ALLOCATED
EXCH T,USRBLK+.RBSTS ;GET RIBSTS
TRNN T,RP.NQC ;IS IT AN NQC FILE?
CLEARM USRBLK+.RBSTS ;NO, CLEAR BLOCKS ALLOCATED
IFN FTNSFLS,<
TRNE T,RP.NQC ;IS IT AN NQC FILE?
SOS SVFILS ;YES, DECREMENT SVFILS
>
EXCH T,USRBLK+.RBSTS ;SWAP BACK AGAIN
ADDM T,NQCBLK ;AND COUNT NQC FILES
MOVEI T,RP.DIR
TDNN T,USRBLK+.RBSTS ;TEST DIR BIT
JRST SCNLUP ;NOT A DIRECTORY
;FALL THROUGH TO RECURSIVE CALL
;HERE WHEN FILE JUST LOOKED UP IS A DIRECTORY
;A HAS FILE NAME
HLLZ B,USRBLK+.RBEXT ;GET EXT (SFD)
PUSH P,BLKCNT ;SAVE FOR WHEN WE COME BACK
PUSH P,RDHED
PUSH P,USRBLK+.RBPPN ;SAVE DIR POINTER
MOVEI D,CURPTH ;MAKE D A PATH POINTER
MOVEM D,USRBLK+.RBPPN ;MAKE SFD-TYPE PATH POINTER
PUSHJ P,SCNDIR ;AND CALL SELF TO SCAN AGAIN
POP P,USRBLK+.RBPPN ;RESTORE OLD DIR POINTER
POP P,N ;HOLD IOWD WE USED
POP P,BLKCNT
MOVE D,0(P) ;RESTORE THIS DIR LOOKUP BLOCK
MOVE A,-1(P)
HLLZ B,-2(P)
SOJA CALC,SCNRST ;AND SCAN THE REST OF THIS DIR
DLKERR: MOVEM A,USRBLK+.RBNAM ;SAVE DIR NAM FOR TYPFIL
MOVEM B,USRBLK+.RBEXT
MOVEM D,USRBLK+.RBPPN
HRRZI N,(B) ;GET ERROR CODE
MOVEI M,[ASCIZ . Directory LOOKUP .]
PUSHJ P,SYSERR ;REPORT ERROR
PUSHJ P,TYPFIL ;FILL IN MORE INFO
SCNXIT: SUB P,[XWD 2,2] ;POP OFF A & D
POPJ P,
FLKERR: HRRZ N,USRBLK+.RBEXT ;PICK UP ERROR CODE
MOVEI M,[ASCIZ . File LOOKUP .]
PUSHJ P,SYSERR
PUSHJ P,TYPFIL ;PRINT FILE DESCRIPTION
JRST SCNLUP ;GO BACK FOR THE REST
RDDSK: SKIPGE T,RDHED ;SKIP IF NO MORE IN BUFFER
JRST RDDSK1 ;ELSE GET WHAT'S THERE
PUSHJ P,DSKINP ;GET MORE
POPJ P, ;EOF
AOS BLKCNT ;COUNT BLOCKS READ
RDDSK1: AOBJN T,.+1
MOVEM T,RDHED
MOVE T,0(T) ;GET DATA WORD
JRST CPOPJ1
DSKINP: MOVE T,[IOWD 200,UFDBUF]
MOVEM T,RDHED ;SETUP TO READ A BLOCK
SETZM RDHED+1
INPUT DSK,RDHED ;GET IT
STATO DSK,IO.ERR!IO.EOF ;CHECK FOR ERROR OR END OF FILE
JRST CPOPJ1
GETSTS DSK,N ;READ FILE STATUS
TRNE N,IO.EOF ;IS IT JUST END OF FILE?
POPJ P, ;YES, TELL CALLER
ANDI N,IO.ERR ;CLEAR NON-ERROR BITS
PJSP M,SYSERR ;ELSE, TELL USER
ASCIZ . Directory read .
;SUBROUTINE TO PRINT FILE SPEC IN USRBLK
TYPFIL: MOVEI M,[ASCIZ . on .]
PUSHJ P,MSG ;ELABORATE ON SYSERR'S MESSAGE
MOVE A,USRBLK+.RBNAM
PUSHJ P,SIXBPA ;PRINT FILENAME
HLLZ A,USRBLK+.RBEXT ;PICK UP EXT
JUMPE A,.+3 ;PRINT NOTHING IF NOTHING THERE
PUSHJ P,PDOT ;ELSE TYPE DOT FOR EXT
PUSHJ P,SIXBPA ;THEN EXT
SKIPN D,USRBLK+.RBPPN ;PICK UP PATH, MAKE SURE NOT ZERO
POPJ P, ;SNH, BUT SELF PROTECTION
MOVEI CH,"[" ;START PATH
PUSHJ P,OUCH
HLRZ N,D ;PROJECT
JUMPE N,TYPPTH ;JUMP IF POINTER TO PATH SPEC
PUSHJ P,OCTPRT ;PRINT PROJECT NO
PUSHJ P,PCMA ;COMMA
HRRZI N,(D) ;PROGRAMMER NO
PUSHJ P,OCTPRT
PJRST TYPCLB ;FINISH WITH SQUARE BRACKET AND CRLF
TYPPTH: HLRZ N,2(D) ;GET PROJECT FROM PATH
PUSHJ P,OCTPRT ;TYPE IT
PUSHJ P,PCMA ;COMMA
HRRZ N,2(D) ;PROGRAMMER
PUSHJ P,OCTPRT
PTHLUP: SKIPN A,3(D) ;GET SFD NAME, TEST FOR END
PJRST TYPCLB ;CLOSE WITH SQUARE BRACKET AND CRLF
PUSHJ P,PCMA
PUSHJ P,SIXBPA ;PRINT SFD NAME
AOJA D,PTHLUP ;GO TO NEXT SFD
;SUBROUTINE TO REMOVE A STR FROM JOB'S SEARCH LIST (DISMOUNT)
;CALL WITH INDEX OF STR TO REMOVE IN S
REMSTR: SETOM STRSTS(S) ;MARK STR REMOVED
MOVEI A,.FSDSL ;STRUUO FUNC TO DEFINE S.L.
MOVEM A,STRBUF
MOVE A,THSJOB
MOVEM A,STRBUF+1
MOVE A,SVPJPG
MOVEM A,STRBUF+2
MOVEI A,1 ;FLAG TO REMOVE UNNAMED STR'S
MOVEM A,STRBUF+3
MOVEI A,STRBUF+3 ;LAST WORD STORED POINTER
SETZ B, ;INDEX IN STR TABLES
DISLUP: SKIPN C,STRNAM(B) ;GET NAME OF NEXT STR
JRST UNSTR ;THAT'S ALL
SKIPGE STRSTS(B) ;SHOULD WE INCLUDE THIS ONE?
AOJA B,DISLUP ;NO, IT HAS BEEN TAKEN CARE OF
PUSH A,C ;OTHERWISE, INCLUDE IT
PUSH A,STRPPN(B) ;AND THE PPN WORD
PUSH A,STRFLG(B) ;AND THE STATUS FLAGS
AOJA B,DISLUP ;GO TO NEXT STR
UNSTR: MOVEI B,STRBUF ;POINT TO LIST
SUBI A,STRBUF-1
HRLI B,(A) ;WITH LENGTH
STRUUO B, ;DEFINE NEW SEARCH LIST
SKIPN N,B ;GET ERROR CODE IN N [33]
POPJ P, ;EXIT
PJSP M,SYSERR ;NOTE THE PROBLEM
ASCIZ . STRUUO .
;SUBROUTINE TO TEST AND SET THE UFD INTERLOCK
; ON STR WHOSE INDEX IS IN S
;RETURN CPOPJ1 IF MONITOR TOO OLD FOR INTERLOCK, OR L.FRCI BIT SET
; OR IF INTERLOCK WAS AVAILABLE
; CPOPJ IF NONE OF ABOVE, L.ILKF BIT SET
SETILK: MOVE A,DSKSER ;DOES FILSER KNOW HOW TO DO THIS?
CAIGE A,RACEY ;THIS SHOULD TELL
JRST CPOPJ1 ;TOO DUMB -- WE'LL TEMPT FATE
MOVEI A,.FSULK ;CODE TO SET INTERLOCK
MOVEM A,UFDILK ;IN STRUUO BLOCK
MOVE B,STRNAM(S)
MOVEM B,UFDILK+1 ;FILE STR NAME
MOVE A,SVPJPG ;PPN OF INTERLOCKED UFD
MOVEM A,UFDILK+2
MOVE A,[XWD 3,UFDILK]
STRUUO A,
TLNE F,L.FRCI ;CAN'T SET IT. SHOULD WE FORCE?
JRST CPOPJ1 ;GOT IT (OR PRETEND SO BECAUSE OF FORCE)
TLO F,L.ILKF ;NOTE WE COULDN'T GET IT
POPJ P, ;NO, WAIT IT OUT
;SUBROUTINE TO CLEAR THE INTERLOCK
CLRILK: MOVE A,DSKSER ;DISK SERVICE FIELD FROM STATES
CAIGE A,RACEY ;IS FILSER ABLE TO DO INTERLOCK?
POPJ P, ;NO, DON'T BOTHER
MOVEI A,.FSUCL ;CLEAR THE INTERLOCK
MOVEM A,UFDILK
MOVE A,[XWD 3,UFDILK];OTHER THINGS ALREADY SET UP
STRUUO A,
POPJ P,
POPJ P,
SUBTTL FACT FILE UPDATE SUBROUTINE
IFN FACTSW,<
;SUBROUTINE TO APPEND AN ENTRY TO A FILE IN THE ACCOUNTING SYSTEM.
; THIS ROUTINE FIRST ATTEMPTS TO APPEND TO THE FILE NAMED FACT.SYS, BUT IF THIS FILE
; IS UNAVAILABLE, THEN FILES NAMED FACT.X01, FACT.X02,..., FACT.X77 WILL BE ATTEMPTED
; IN THAT ORDER, AND AN ERROR MESSAGE PRINTED ONLY IF ALL SUCH FILES ARE UNAVAILABLE.
;
;CALLING SEQUENCE:
; MOVE CALC,[XWD SIZE,ADDRESS] ;POINTER TO ENTRY TO BE APPENDED.
; PUSHJ P,APPEND
; RETURNS HERE IN ANY EVENT.
APPEND: PUSH P,CALC ;SAVE POINTER TO ENTRY TO BE APPENDED.
IFN DAEMSW,<
HLRE B,CALC ;NEG SIZE IN B
MOVMS B ;MAKE POS
SOJ CALC, ;DECR ADDRESS
HRLI CALC,1(B) ;AND INSERT SIZE+1
MOVEI B,.FACT ;DAEMON FUNCTION TO WRITE THE FACT FILE
MOVEM B,0(CALC) ;STORE FOR DAEMON
DAEMON CALC, ;CALL DAEMON TO WRITE THE ENTRY
JRST .+2 ;DIDN'T MAKE IT, TRY IT OURSELVES
JRST APPXIT ;ALL SET
>;END OF DAEMSW CONDITIONAL
MOVEI B,(SIXBIT /SYS/) ;TRY FACT.SYS FIRST.
APPLUP: PUSH P,B ;SAVE LAST EXTENSION TRIED.
APPLP1: MOVSS B ;SET UP ACCUMULATORS FOR THE APPNDF
MOVE CALC,-1(P) ; SUBROUTINE (WHICH DOES THE ACTUAL APPEND).
PUSHJ P,APPNDF ;TRY TO APPEND ENTRY TO TRANSACTION FILE.
JRST APPERR ;ERROR ON THAT TRANSACTION FILE--TRY NEXT.
JRST APPBZY ;TRANSACTION FILE BUSY--TRY ANOTHER.
POP P,B ;NORMAL EXIT--FILE SUCCESSFULLY UPDATED.
APPXIT: POP P,CALC
POPJ P, ;*** SUBROUTINE EXIT. ***
APPERR: POP P,B ;NON-RECOVERABLE ERROR--TRY NEXT FILE.
CAIN B,(SIXBIT /SYS/) ;WAS .SYS THE LAST EXTENSION ATTEMPTED?
MOVEI B,(SIXBIT /X00/) ;YES, TRY .X01 NEXT.
APPERB: CAIN B,(SIXBIT /X77/) ;NO, TRIED ALL 64 POSSIBLE FILES ?
JRST APPLUZ ;YES, GIVE UP.
ADDI B,1 ;NO, TRY NEXT FILE IN SEQUENCE.
TRNN B,7 ;CARRY INTO SECOND DIGIT ?
ADDI B,100-10 ;YES, CAUSE SIXBIT CARRY.
JRST APPLUP ;TRY AGAIN.
APPBZY: POP P,B ;SPECIFIED FILE WAS BUSY--GET ITS EXTENSION.
CAIE B,(SIXBIT /SYS/) ;WAS IT .SYS ?
JRST APPERB ;NO, GO TRY NEXT FILE IN SEQUENCE.
PUSHJ P,DELAYM ;YES, INFORM USER OF DELAY.
PUSH P,[SIXBIT / X00/] ;TRY .SYS TWICE JUST TO BE SURE.
JRST APPLP1
DELAYM: JSP M,MSG ;TELL USER TO BE PATIENT IF DELAY OCCURS.
ASCIZ /Wait PLS....
/
APPLUZ: MOVEI M,APPLZM ;IN THE UNLIKELY EVENT THAT ALL FACT FILES
PUSHJ P,MSG ; ARE INACCESSIBLE, TELL USER TO GET HELP.
JRST APPXIT
APPLZM: ASCIZ /Accounting system failure....
Call the Operator.
/
;SUBROUTINE TO APPEND A TRANSACTION ENTRY TO THE END OF THE ACCOUNTING FILE
; (NORMALLY, THIS IS THE FILE NAMED FACT.SYS, BUT THE EXTENSION IS A PARAMETER
; SUPPLIED TO THIS SUBROUTINE SO THAT IF FACT.SYS BECOMES FOULED UP, AN ENTRY
; MAY BE APPENDED TO AN ALTERNATE FACT.XXX FILE.)
;CALLING SEQUENCE:
; MOVSI B,(SIXBIT /EXT/) ;DESIRED EXTENSION FOR FACT FILE (NORMALLY .SYS)
; MOVE CALC,[XWD -SIZE,ADDRESS] ;POINTER TO ENTRY TO BE APPENDED
; PUSHJ P,APPNDF
; NON-RECOVERABLE ERROR RETURN -- CAN'T APPEND TO FILE.
; BUSY ERROR RETURN -- FILE HAS BEEN BUSY EVERY HALF-SECOND FOR TEN SECONDS.
; NORMAL RETURN -- ENTRY HAS BEEN SUCCESSFULLY APPENDED TO THE FILE.
;THE FOLLOWING SOFTWARE I/O CHANNEL IS USED:
FCT=6
;**** CAUTION **** THIS NEXT PARAMETER MUST BE SET LARGE ENOUGH FOR THE PARTICULAR
;***************** PROGRAM WHICH CALLS THIS APPNDF SUBROUTINE:
TRANSZ=10 ;MAXIMUM SIZE OF TRANSACTION ENTRY TO BE APPENDED.
APPNDF: MOVEM B,APPEXT ;SAVE REQUESTED EXTENSION FOR FILENAME FACT
MOVEI N,^D20
MOVEM N,TRYCTR ;SET NUMBER OF TIMES TO TRY IF BUSY.
MOVEI A,17 ;DUMP MODE
MOVSI B,(SIXBIT .SYS.) ;DEVICE SYS
SETZ C, ;NO BUFFERS
TLNN F,NOPHYU ;SKIP IF MAY NOT DO PHYSICAL ONLY
TLO A,PHYOPN ;SET PHYSICAL ONLY IF POSSIBLE
OPEN FCT,A ;OPEN SOFTWARE I/O CHANNEL FOR FACT FILE
JSP N,APPNDR ;IMMEDIATE ERROR RETURN IF CAN'T GET DEVICE SYS.
APPNDL: MOVE A,[SIXBIT /FACT/]
MOVE B,APPEXT
MOVEI C,0
MOVE D,FCTPP
LOOKUP FCT,A ;ATTEMPT TO OPEN FACT FILE FOR READING.
JRST APPNDN ;LOOK-UP FAILED--PERHAPS FILE DOESN'T EXIST.
PUSHJ P,APPNDE ;ATTEMPT TO GRAB THE FACT FILE.
HLRE N,D ;THE ENTER SUCCEEDED. PICK UP LENGTH OF FILE.
SKIPLE N ;SKIP IF - WORDS
IMUL N,[-^D128] ;CONVERT + BLKS TO - WDS
SETCA N, ;NEGATE AND SUBTRACT ONE
ROT N,-7
ADDI N,1 ;COMPUTE LAST BLOCK NUMBER WITHIN THE FACT FILE.
HRRZM N,FCTBLK ;SAVE IT FOR USETI AND USETO.
ROT N,7
ANDI N,177 ;N NOW HAS RELATIVE DEPTH (0-127) OF
USETI FCT,@FCTBLK ; LAST WORD IN LAST BLOCK.
MOVE A,[IOWD 200,FCTBUF]
MOVEM A,ILIST ;SET UP IOLIST
SETZM ILIST+1
INPUT FCT,ILIST ;READ LAST BLOCK OF FACT FILE INTO DUMP BUFFER.
STATZ FCT,740000
JSP N,APPNDR ;ERROR OR EOF WILL YIELD ERROR RETURN.
APPNDA: MOVS A,FCTBUF(N) ;GET LAST WORD OF CURRENT FACT FILE.
CAIN A,777000 ;END-OF-FILE ENTRY ?
JRST APPNDB ;YES, THINGS ARE LOOKING GOOD.
SKIPN A ;NO, FACT FILE SCREWED UP! IS LAST WORD NON-ZERO ?
TRNN N,-1 ;OR IS THIS THE FIRST WORD OF A 200-WORD BLOCK ?
JSP N,APPNDR ;YES TO EITHER QUESTION. TAKE ERROR EXIT.
SUB N,[XWD 1,1] ;TRY BACKING UP OVER ZERO WORDS ATTEMPTING TO FIND
JRST APPNDA ; THE END-OF-FILE ENTRY.
APPNDB: TLNN N,-1 ;WAS END-OF-FILE ENTRY WHERE IT WAS SUPPOSED TO BE ?
JRST APPNDC ;YES, PROCEED.
MOVE A,[XWD 377000,1] ;NO, FILL WITH DUMMY ONE-WORD ENTRIES TO
MOVEM A,FCTBUF(N) ; SHOW WHERE DATA LOSS MAY HAVE OCCURED.
AOBJN N,.-1
APPNDC: MOVE A,0(CALC) ;PICK UP ENTRY AS SPECIFIED IN CALLING SEQUENCE.
MOVEM A,FCTBUF(N) ;STORE IN FACT FILE OUTPUT BUFFER.
ADDI N,1
AOBJN CALC,APPNDC
MOVSI A,777000 ;LAY DOWN END-OF-FILE ENTRY AGAIN.
MOVEM A,FCTBUF(N)
SETCA N,0 ;(IN PLACE OF AOS N FOLLOWED BY MOVNS N)
HRLM N,OLIST ;STORE CORRECT NUMBER OF WORDS TO BE WRITTEN.
MOVEI N,FCTBUF-1 ;AND ADDRESS
HRRM N,OLIST
SETZM OLIST+1
USETO FCT,@FCTBLK
OUTPUT FCT,OLIST ;OUTPUT UPDATED FACT FILE.
STATZ FCT,740000
JSP N,APPNDR ;ERROR OR EOF WILL YIELD ERROR EXIT.
AOS 0(P) ;DOUBLE SKIP EXIT
FCTBSY: AOS 0(P) ;SINGLE SKIP EXIT
;NON-SKIP ERROR RETURN IS CALLED BY JSP, SO THAT ERROR PC IS IN ACC N.
APPNDR: RELEASE FCT,0 ;RELEASE FACT FILE'S CHANNEL.
POPJ P, ;*** SUBROUTINE EXIT .***
APPNDE: MOVE A,[SIXBIT /FACT/] ;SHORT SUBROUTINE TO TRY TO DO AN ENTER ON THE
MOVE B,APPEXT ; FACT ACCOUNTING FILE. IN CASE OF FAILURE
; IT WILL SLEEP A HALF-SECOND THEN TRY AGAIN.
MOVE C,[%LDSSP] ;GET ".SYS" PROTECTION [32]
GETTAB C, ;[32]
MOVSI C,(157B8) ;DEFAULT 157 [32]
MOVE D,FCTPP
ENTER FCT,A
JRST .+2
POPJ P, ;**GOOD EXIT. THE FACT FILE IS OPEN FOR WRITING.**
POP P,N ;CORRECT PUSH-DOWN STACK.
HRRZ N,B
CAIE N,3 ;ERROR CODE=3 FROM DSKSER MEANS FILE BEING MODIFIED
JSP N,APPNDR ; BY SOMEONE ELSE. ANY OTHER ERROR CODE LOSES.
MOVEI N,1
SLEEP N, ;TRY AGAIN LATER
SOSG TRYCTR ;TRIED OFTEN ENOUGH ?
JRST FCTBSY ;YES, THE FILE IS BUSY AND HAS BEEN FOR TEN SECONDS.
JRST APPNDL ;NO, TRY AGAIN BEGINNING WITH LOOK-UP. (FILE COULD
; HAVE COME INTO EXISTENCE OR DIED IN THE INTERIM.)
APPNDN: TRNE B,-1 ;ONLY ERROR CODE 0 IS REASONABLE ON LOOKUP FAILURE.
JSP N,APPNDR ;ERROR EXIT ON ANY OTHER LOOKUP FAILURE.
PUSHJ P,APPNDE ;FACT FILE DIDN'T EXIST. TRY TO CREATE IT.
SETZB N,FCTBLK ;SUCCESSFULLY CREATED. SET POINTERS TO
AOS FCTBLK ; BEGINNING OF FILE.
JRST APPNDC ;GO MOVE TRANSACTION ENTRY INTO FILE AND EXIT.
;STORAGE LOCATIONS, BUFFERS, ETC.
U(TRYCTR) ;NUMBER OF TIMES TO TRY IF FACT FILE IS BUSY
U(FCTBLK) ;BLOCK NUMBER FOR USETI AND USETO
U(APPEXT) ;EXTENSION FOR THE FILENAME FACT (NORMALLY .SYS)
UU(ILIST,2) ;DUMP MODE INPUT COMMAND LIST
UU(OLIST,2) ;DUMP MODE OUTPUT COMMAND LIST (WORD COUNT WILL
; BE FILLED IN.)
UU(FCTBUF,200+TRANSZ+1) ;RESERVE BUFFER BIG ENOUGH TO APPEND MAXIMUM SIZE
; TRANSACTION ENTRY TO A FULL 200 WORD BUFFER.
;STILL IN FACTSW COND [24]
SUBTTL DATE CONVERSION
IFN FT1975,< ;[24] THIS WHOLE PAGE
;SUBROUTINE TO CONVERT STANDARD SYSTEM DATE TO INTERNAL FORMAT=DAYS SINCE NOV 13,1857
;THIS IS CONTINUOUS INCREASING BY DATE; SYSTEM DATE IS DISCONTINUOUS AT END OF MONTHS
;VALUE CALC=INTERNAL DATE/TIME
;USES A,B,C,D,E
RADIX 10
DATOFS==38395 ;DATE OFFSET FOR JAN 1, 1964=DAYS SINCE NOV 13, 1857
GETNOW: DATE B, ;GET SYSTEM DATE
IDIVI B,12*31 ;B=YEARS-1964
IDIVI C,31 ;C=MONTHS-JAN, D=DAYS-1
ADD D,DAYTAB(C) ;D=DAYS-JAN 1
MOVEI E,0 ;LEAP YEAR ADDITIVE IF JAN, FEB
CAIL C,2 ;CHECK MONTH
MOVEI E,1 ;ADDITIVE IF MAR-DEC
MOVE A,B ;SAVE YEARS FOR REUSE
ADDI B,3 ;MAKE LEAP YEARS COME OUT RIGHT
IDIVI B,4 ;HANDLE REQULAR LEAP YEARS
CAIE C,3 ;SEE IF THIS IS LEAP YEAR
MOVEI E,0 ;NO--WIPE OUT ADDITIVE
ADDI D,DATOFS(B) ;D=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
MOVE B,A ;RESTORE YEARS SINCE 1964
IMULI B,365 ;DAYS SINCE 1964
ADD D,B ;D=DAYS EXCEPT FOR 100 YR. FUDGE
HRREI B,64-99(A) ;B=YEARS SINCE 2000
JUMPLE B,INTDT1 ;ALL DONE IF NOT YET 2000
IDIVI B,100 ;GET CENTURIES SINCE 2000
SUB D,B ;ALLOW FOR LOST LEAP YEARS
CAIE C,99 ;SEE IF THIS IS A LOST L.Y.
INTDT1: ADD D,E ;ALLOW FOR LEAP YEAR THIS YEAR
;HERE WITH D CONTAINING CORRECT NUMBER OF DAYS
MSTIME B, ;GET TIME IN MILLISECONDS SINCE MIDNITE
MOVEI A,0
ASHC A,18 ;MILLISECONDS*2^18
DIV A,[EXP 1000*60*60*24];COMPUTE FRACTION OF DAY
MOVE CALC,A ;FRACTION *2^18 IN RH
HRL CALC,D ;DAY IN LH
POPJ P,
;STILL IN FT1975
;STILL IN FACTSW
;STILL IN RADIX 10
DAYTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365
RADIX 8 ;BACK TO NORMAL NUMBERS
>;END OF FT1975 COND [24]
>;END OF FACTSW COND
SUBTTL SUBROUTINES
;SUBROUTINE TO CONVERT JOB NUMBER TO SIXBIT IN LH A
;ARGS B=JOB NUMBER
;VALUES A=SIXBIT IN LH
SIXJBN: IDIVI B,^D10
MOVSI D,20(C) ;D=LOW ORDER CHAR
IDIVI B,^D10 ;B=HIGH, C=MIDDLE
MOVSI A,202000
LSH B,^D12+^D18 ;HIGH CHAR INTO LH
LSH C,^D6+^D18 ;MIDDLE CHAR INTO LH
ADD A,B
ADD A,C
ADD A,D
POPJ P,
;ABORT THE LOGOUT PROCESS AND LOG BACK IN.
BACKIN: PUSHJ P,RELOG ;MAKE SURE JLOG GETS ON [31]
EXIT 1,
EXIT ;NO CONTINUES
TOKJOB: TLNE F,NMSTR ;[45] HAVE MULTIPLE STRUCTURE CAPABILITY?
PUSHJ P,CLRILK ;[45] NO, CLEAR THE UFD INTERLOCK
PUSHJ P,RELOG ;LOG JOB BACK IN [31]
MOVE A,[XWD 1,KJOBNM]
MOVE B,[RUN A,]
TLNN F,NOPHYU
TRO B,PHYUUO
XCT B
HALT
KJOBNM: SIXBIT .SYS.
SIXBIT .KJOB.
0
0
0
0
RELOG: GETPPN B, ;GET THIS JOB'S PPN (SVPJPG MAY NOT
TLZ B,400000 ; BE SET UP YET) [31]
MOVEM B,LOGTAB ;[41] PUT INTO LOGIN PARAMETER LIST
HRROI B,JBTPRV ;[41] GET PRIVILEGES
GETTAB B, ;[41]
SETZ B, ;[41]
MOVEM B,LOGTAB+1 ;[41] INTO LOGIN LIST
HRROI B,.GTNM1 ;[41] GET FIRST PART ON NAME
GETTAB B, ;[41]
SETZ B, ;[41]
MOVEM B,LOGTAB+2 ;[41] INTO LOGIN LIST
HRROI B,.GTNM2 ;[41] SECOND PART OF NAME
GETTAB B, ;[41]
SETZ B, ;[41]
MOVEM B,LOGTAB+3 ;[41] INTO LOGIN LIST
HRROI B,.GTCNO ;[41] GET CHARGE NUMBER
GETTAB B, ;[41]
SETZ B, ;[41]
MOVEM B,LOGTAB+4 ;[41] INTO LOGIN LIST
MOVE A,[-5,,LOGTAB] ;[41] LOGIN PARAMETER
LOGIN A, ;GET BACK IN [31]
POPJ P, ;WHAT CAN YOU DO?[31]
POPJ P, ;[31]
UU(LOGTAB,5) ;[41]
IFE FTNSFL,<
RDUFD: SKIPGE T,RDHED
JRST RDUFD1
MOVE T,[IOWD 200,UFDBUF]
MOVEM T,RDHED
SETZM RDHED+1
INPUT UFD,RDHED
STATZ UFD,IO.ERR!IO.EOF
POPJ P, ;EOF OR ERROR READING UFD
RDUFD1: AOBJN T,.+1
MOVEM T,RDHED
MOVE T,(T)
JRST CPOPJ1
>
;HERE TO ASK USER TO DEASSIGN TTY
LTTY: MOVEI M,[ASCIZ .
? Please deassign TTY
.]
OUTSTR (M) ;MAKE SURE GOES TO PHYSICAL TTY
SKIPE LOGFIL ;SKIP IF NO LOG FILE [40]
PUSHJ P,MSG
JRST BACKIN ;AND LOG USER BACK IN
PR3SPC: PUSHJ P,PRSPC ;INSERT 3 SPACES.
PR2SPC: PUSHJ P,PRSPC ;INSERT 2 SPACES.
PRSPC: MOVEI CH,SPACE ;PRINT A SPACE...
JRST OUCH
PCMA: MOVEI CH,"," ;PRINT COMMA
JRST OUCH
PDOT: MOVEI CH,"." ;PRINT DOT
JRST OUCH
CRLF: JSP M,MSG ;PRINT CARRIAGE RETURN, LINE FEED.
ASCIZ /
/
DATOUT: DATE A, ;PRINT THIS DATE
IDIVI A,^D31
MOVEI N,1(B)
PUSHJ P,DECPRT ;DAY OF MONTH
IDIVI A,^D12
MOVE B,MONTAB(B) ;ALPHABETIC MONTH FROM TABLE
MOVEI C,0
MOVEI M,B
PUSHJ P,MSG
MOVEI N,^D64(A) ;YEAR
JRST DECPRT
;THIS MACRO IS TO CREATE TABLE OF ASCII MONTH NAMES
DEFINE MONMAC(A)< IRP A,< ASCII /-A-/>>
MONTAB: MONMAC<Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec>
;SPECIAL MESSAGE PRINTING ROUTINES, MESSAGES, AND STUFF
PPMSG: PUSHJ P,MSG ;PRINT ARBITRARY MESSAGE (SET UP IN M ON ENTRY),
HLRZ N,SVPJPG ; AND THEN PRINT PROJECT, PROGRAMMER NUMBER.
PUSHJ P,OCTPRT
PUSHJ P,PCMA
HRRZ N,SVPJPG
PJRST OCTPRT
NTHRMG: MOVEI M,NTRMSG ;REMIND USER ANOTHER JOB IS USING SAME [P,P].
PUSHJ P,PPMSG
PJRST TYPCLB
NTRMSG: ASCIZ /Another job still logged in under [/
ILKMSG: MOVEI CH,"%"
PUSHJ P,OUCH ;WARNING TYPE MSG
MOVEI M,[ASCIZ /UFD interlock busy
Wait Please...
/]
SETZ S,
ILKMS1: SKIPN A,STRNAM(S) ;NEXT STR NAME
PJRST MSG ;END OF LIST, PRINT TEXT
SKIPE STRSTS(S) ;IS IT STILL WAITING FOR PROCESSING?
AOJA S,ILKMS1 ;NO, EITHER IT'S BEEN REMOVED, OR OVER QUOTA
PUSHJ P,SIXBPA ;PRINT IT
PUSHJ P,PRSPC ;SPACE
AOJA S,ILKMS1 ;LOOK AT ALL STR'S IN S.L.
JOBM: ASCIZ /Job /
USRMG: ASCIZ /, User [/
OFFMSG: ASCIZ /] Logged off /
FDMSG: JSP M,MSG
ASCIZ /Deleted/ ;[34]
FSMSG: JSP M,MSG
ASCIZ /Saved/ ;[34]
ALLMSG: JSP M,MSG
ASCIZ / all/ ;[34]
FILSMG: MOVEI M,[ASCIZ / files (/]
CAIN N,1 ;MAKE SINGULAR IF SO
MOVEI M,[ASCIZ / file (/]
JUMPE N,MSG ;NO PRINT OF ZERO [34]
MOVEI CH,40 ;SPACE BEFORE NUMBER [34]
PUSHJ P,OUCH ;[34]
PUSHJ P,DECPRT ;TELL NO OF FILES
PJRST MSG ;THEN TYPE FILE OR FILES
BLKSMG: PUSHJ P,DECPRT
JSP M,MSG
ASCIZ / blocks)
/
RNTMSG: ASCIZ /Runtime /
MINMSG: ASCIZ / Min, /
SECMSG: ASCIZ / Sec
/
LASTMG: BYTE (7) 12,12,12,12,12,12,12,12,12,12,".",4,0
NOJBST: MOVEI M,[ASCIZ .?JOBSTR failure
.]
PUSHJ P,MSG
JRST ACCT
NLOGNM: JSP M,MSG
NOLOGN: ASCIZ .
May not logout with logical names for File Structures
.
SYSERR: MOVEI CH,"?"
PUSHJ P,OUCH
MOVE A,STRNAM(S)
PUSHJ P,SIXBPA
PUSHJ P,MSG
MOVEI M,[ASCIZ .failure (.]
PUSHJ P,MSG
PUSHJ P,OCTPRT
JSP M,MSG
ASCIZ .)
.
SUBTTL STORAGE AND STUFF
PDP: IOWD PDLEN,PDL ;PUSHDOWN POINTER IS INITIALIZED TO THIS.
CLRCLK: EXP .CLOCK ;BLOCK FOR CLEARING DAEMON CLOCK
EXP 0
XLIST ;LITERALS
LIT
LIST ;LITERALS
IFN FACTSW,<
IFE FT1975,< ;[24]
FCTHED: XWD 140000,7 ;HEADER FOR LOGOUT DATA
>
IFN FT1975,< ;[24]
FCTHED: XWD 141000,7 ;HEADER FOR NEW FORMAT LOGOUT DATA [24]
>
U(JRUNTM) ;THESE VARS ARE KEPT, INSTEAD OF RE-GOTTEN
U(JDREAD) ; TO SAVE UUO'S, AND ALSO TO ENSURE SAME
U(JDWRIT) ; VALUES REPORTED IN FACT.SYS AS AT TERMINAL
;DO NOT SEPARATE THE FOLLOWING TWO LINES ***
U(FCTFUN) ;FUNCTION WORD FOR DAEMON
UU(FENTRY,10) ;STORAGE FOR THE DATA
>
;NOTE--DATA TO BE PRESERVED ACROSS THE CALL TO QUEUE MUST BE DEFINED
; BEFORE PDL TO GUARANTEE SAFETY
U(MFDPP)
U(SYSPPN)
FCTPP==SYSPPN
U(NOJOBS)
U(THSTTY)
U(SVBLKS)
U(NQCBLK)
IFN FTNSFL,<U(SVFILS)>
UU(STRNAM,MAXFS)
UU(STRPPN,MAXFS)
UU(STRFLG,MAXFS)
UU(STRSTS,MAXFS)
U(ILKTRY)
UU(UFDILK,3) ;UFD INTERLOCK BLOCK
UU(CHRBUF,CHRLEN)
UU(LOOKBF,0)
UU(EXLBUF,EXLLEN)
UU(USRBLK,USRLEN)
UU(CURPTH,PTHLEN)
U(BLKCNT)
UU(RDHED,2)
UU(ZZMAX,0)
LGOEND: END LOGOUT