Trailing-Edge
-
PDP-10 Archives
-
ap-c796e-sb
-
kjob.mac
There are no other files named kjob.mac in the archive.
TITLE KJOB - PREPARE FOR LOGOUT - V50A(36) 10 FEB 75
SUBTTL /RCC/CMF/RLD/DJB/JSL/SMM
VKJOB==50
VEDIT==36
VMINOR==1
VCUST==0
;COPYRIGHT (C) 1969, 1971 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD MASS.
;NO # ^Z RECOGNIZED FOR EXIT
;14 ALLOW ONLY SINGLE LETTER AS ANSWER TO CONFIRM:
; ALLOW SWITCH-TYPE ANSWER TO CONFIRM:
; AREAS AFFECTED: GETAN1,TYIGO
;15 USES PROPER VALUE AS RESERVED QUOTA, IF IMPLEMENTED
; AREAS AFFECTED: CHKOVR
;21 MAKE DEFAULT LOG QUEUE PRIORITY 10
; AREAS AFFECTED: KJOB
;22 FOR SYSTEMS WITHOUT QUEUE, MUST BRING BACK KJOB HI SEG
; AREAS AFFECTED: TOLO
;23 READ ALL OF FIRST INPUT BUFFER INTO INTERNAL BUFFER TO ALLOW
; A CONTROLLING JOB (IF ANY) TO RELEASE LOG FILE AND AVOID ANY
; POSSIBLE CONFLICTS.
; AREAS AFFECTED: INTKJO
;24 TRAPS UFD PROTECTION FAILURES DURING AN ATTEMPTED DELETION
; IF THE FAILURE OCCURED DURING A NON-CONTROLLED JOB (I.E.
; NORMAL TIMESHARING USER), AN ERROR MESSAGE IS PRINTED AND KJOB
; EXITS. PRESUMABLY THE USER WILL RENAME HIS UFD TO A USEABLE
; PROTECTION AND TRY TO LOG OFF AGAIN.
; IF THE FAILURE OCCURS DURING A CONTROLLED SUBJOB (I.E. A BATCH
; JOB OR OPSER ATTACHED JOB), KJOB WILL CHANGE THE PROTECTION OF
; THE UFD TO ALLOW REQUIRED DELETIONS AND CHANGE THE PROTECTION
; TO THE ORIGINAL AT THE END OF THE STR PROCESSING.
; AREAS AFFECTED: KJOB,GETSTR,GETSTZ,FILDEL,FILDL3,FILDL2
; ADDED LABELS: GETSTY,OLDPRO,NEWPRO,FILDLA,CLGTRY,CLGTR1
;25 REPLACE CALLI'S WITH NPROPER PSEUDO OP
; AREAS AFFECTED: MANY
;26 CHANGE "ARE YOU SURE?" MESSAGE TO MORE INFORMATIVE
; COMMAND SPECIFIC MESSAGE
; AREAS AFFECTED: MAKSU1,MAKSU2,MAKSUR,MAKSUA,MAKSUB
; MAKSUC,KCOM,DCOM,PCOM,SCOM
;27 MOVE INITIALIZATION CODE TO BE EXECUTED ON CCL ENTRY ALSO
; AREAS AFFECTED: KJOB,INTKJ1
;30 LESSEN RETRY COUNT FOR LOG FILE INTERLOCK
; AREAS AFFECTED: FBMTRY,FILSP4,CLSL1A
;31 MISCELLANEOUS CODE CLEANUP
; AREAS AFFECTED: MANY
;32 FIX DATE75 PROBLEM INTRODUCED BY EDIT 24
; AREA AFFECTED: GETSTZ
;33 DURING "I" OR "U" DIALOGUE, ALTMODES ARE NOT RECOGNIZED AS
; END OF LINE CHARACTERS, AS THEY ARE IN ALL OTHER RESPONSE
; SITUATIONS.
; AREAS AFFECTED: TYIX1
;34 /B ALGORITHM ENFORCES QUOTAS EVEN THOUGH THERE ARE OTHER
; USERS SAME PPN.
; AREAS AFFECTED: BCOM1
;35 GIVE OVER QUOTA MESSAGE DURING /B ALGORITHM.
; AREAS AFFECTED: BJLOOP
;36 MAKE LOG FILE SPECIFICATION CONFORM TO DOCUMENTATION
; ABOUT DSK OR SPOOLED DEVICE.
; AREAS AFFECTED: FILS4A
.JBVER=137
LOC .JBVER
EXP <VCUST>B2+<VKJOB>B11+<VMINOR>B17+<VEDIT>B35
RELOC
TWOSEG
RSRVD==0 ;SET TO 1 WHEN RESERVED QUOTAS IMPLEMENTED
;PARAMETERS FROM COMMOD.MAC
RIBPPN==1
RIBNAM==2
RIBEXT==3
RIBATT==4
OWSPRV==3 ;SIZE OF OWNERS ACCESS CODE FIELD
OWNPRV==2 ;RIGHTMOST BIT OF OWNERS ACCESS CODE FIELD
RIBSIZ==5
RIBVER==6
RIBALC==11
RIBMTA==15
RIBDEV==16
RIBQTF==22
RIBQTO==23
RIBQTR==24
RIBUSD==25
RIBSTS==17
RIPLOG==400000
;END OF PARAMETERS FROM COMMOD.MAC
IFNDEF PDLEN,<PDLEN==34>
IFL PDLEN-34,<PDLEN==34>
IFNDEF ZADEF,<ZADEF==ZLSTZ ;Z VALUE IF NO /Z SPECIFIED - QUEUE ALL>
; NOTE: IF ALL SPOOL BITS ARE ZERO, /Z DEFAULTS TO 0
; 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
BP=6 ;FOR FACT FILE CALCULATIONS, ETC.
T=7
S=10 ;CONTAINS INDEX IN STRTAB OF CURRENT STR
OBP==11 ;OUTPUT BYTE PTR FOR LOG FILE BUFFER
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
CNFTBL==11 ;GETTAB TABLE FOR CONFIGURATION
CNFSTS==17 ;CNFTBL - STATES WORD
NSWTBL==12 ;GETTAB FOR NON-SWAPPING DATA
%NSHJB==20 ;HIGHEST JOB NUMBER CURRENTLY ASSIGNED
JBTSPL==36 ;GETTAB FOR SPOOL BITS
.SPLPT==1B35 ;PRINTER SPOOL
.SPPLT==1B34 ;PLOTTER
.SPPTP==1B33 ;TAPE PUNCH
.SPCDP==1B32 ;CARD PUNCH
.SPCDR==1B31 ;CARD READER
.SPOUT==.SPLPT!.SPPLT!.SPPTP!.SPCDP ;OUTPUT SPOOL BITS
.SPALL==.SPOUT!.SPCDR ;ALL SPOOL BITS
;TEMP CORE FUCTIONS
TCRRDF==2 ;FUNCTION TO READ AND DELETE CORE FILE
TCRWRF==3 ;FUNCTION TO WRITE A FILE
;FLAG BITS - LH F - USED ONLY BEFORE QUEUE CALLED
CCLFLG==1 ;SET IF CCL ENTRY
DOTF==2 ;SET IF DONT SEEN IN FILE DESCRIPTOR
;FLAG BITS - LEFT HALF OF ACCUMULATOR F - USED ONLY AFTER QUEUE CALLED
DUPF=2 ;TRUE IF GETPPN SAYS MULTIPLE USERS UNDER THIS [P,P]
NTTYF=4 ;NO TTY AVAILABLE?!
STRF=10 ;SET IF ANY STR'S LISTED IN CURRENT COMMAND
INCP=20 ;SET IF I COMMAND, NOT IF U
LOGF=40 ;SET IF ANY STR IS STILL OVER QUOTA OUT
LISDEL==100 ;SET IF TO LIST FILES DELETED
LIDLFG==200 ;SET IF ANY ALREADY LISTED
USELOG==400 ;SET IF LOG FILE SPECIFIED
TTYPTY==1000 ;SET IF TTY IS NOT A PTY
NGLOOK=2000 ;LOOK-UP FAILED IN NXTFIL SUBROUTINE
BPAF=NGLOOK ;SET IF STOP AT NULL IN SIXBP ROUTINE
PHYQUE==4000 ;SET IF PHYSICAL CALL TO QUEUE REQUIRED
NOPHYU==10000 ;SET IF PHYSICAL DEVICE UUOS DONT WORK
USEBUF==20000 ;SET IF TO USE BUFFER INSTEAD OF TTY INPUT
BREAK==40000 ;SET IF BREAK CHAR DETECTED IN TTY LINE
CALQUE==100000 ;SET IF MUST CALL QUEUE AGAIN FOR B MODE
QUELOG==CALQUE ;SET IF DONT INCLUDE LOG FILE IN CALL TO QUEUE
NEWSCN==200000 ;SET IF NEW SCANNER SERVICE
NOLOGC==400000 ;SET IF DONT INCLUDE CHARS READ IN LOG FILE
;FLAG BITS - RIGHT HALF OF ACCUMULATOR F
INQUEF==400000 ;SET IF IN QUEUE
;LH FLAGS PASSED TO LOGOUT IN LGOFLG
LNOQUE==400000
LBSWIT==200000 ;SET IF TRIED BEST TO MAKE QUOTAS
;DEFINE SPECIAL CHARACTER CODES
CNTRLC==3 ;CONTROL C
SPACE=40 ;SPACE
CR=15 ;CARRIAGE RETURN
LF=12 ;LINE FEED
CNTRLZ==32 ; CONTROL Z
ALTMOD==33 ;STANDARD ALTMODE
ALTMD=175 ;ALT-MODE
LANGLB=74 ;LEFT ANGLE RACKET
RANGLB=76 ;RIGHT ANGLE BRACKET
;MISC PARAMETERS
.LNFPN==6 ;LENGTH OF LIST FOR FULL PATH NAME
PHYOPN==400000 ;BIT TO SET FOR PHYSICAL ONLY OPEN
PHYUUO==200000 ;BITS TO SET FOR PHYSICAL DEVICE ONLY UUOS
QDSKSR==2 ;DSK SERVICE FIELD IN STATES FOR MONITORS INCLUDING QUEUE CODE
FBMERR==3 ;ENTER ERROR - FILE BEING MODIFIED
FBMTRY==^D10 ;TIMES TO RETRY IF FILE BEING MODIFIED
TTYBUF==26 ;SIZE OF TTY BUFFER TO ALLOCATE
;DSKCHR INDECES
USRTAL==1 ;INDEX IN DSKCHR FOR FREE BLOCKS FOR USER
STRNAM==4 ;REAL NAME OF STR UNIT BELONGS TO
CHRLEN==5 ;LENGTH OF MAXIMUM DSKCHR BLOCK
;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 RH EXT WORD
;400000==400000 ;QUEUE REQUEST IS ON LOGICAL DEVICE QUE
;VALUES FOR DISPOSITION FIELD IN PARAMETER WORD
QDIS.D==3 ;DELETE
QDIS.P==1 ;PRESERVE
QDIS.R==2 ;RENAME
;GETLIN BITS - LH
TT.PTY==400000 ;SET IF TTY IS A PTY
;BITS IN LH STATES WORD
ST.NSC==(1B11) ;SET IF NEW SCANNER SERVICE ROUTINE
;BITS IN STATUS WORD OF SEARCH LISTS
STR.RO==400000 ;READ ONLY BIT
;DEVTYP BITS
TY.SPL==20 ;LH BIT FOR SPOOLED DEVICE
TY.DEV==77 ;RH MASK FOR DEVICE TYPE CODE
.TYDSK==0 ;TYPE CODE FOR DSK
.TYTTY==3 ;TYPE CODE FOR TTY
;DEVCHR BITS
DV.TTY==20
DV.DSK==200000
;STORAGE MACROS
.ZZ=140
DEFINE U(A)<UU(A,1)>
DEFINE UU(A,B)<
RELOC
A: BLOCK B
RELOC
.ZZ==.ZZ+B>
MAXFS==^D14
EXLLEN==26
EXLPPN==RIBPPN
EXLNAM==RIBNAM
EXLEXT==RIBEXT
EXLATT==RIBATT
EXLALC==RIBALC
EXLDEV==RIBDEV
EXLQTR==RIBQTR
EXLQTF==RIBQTF
EXLQTO==RIBQTO
EXLUSD==RIBUSD
EXLSTS==RIBSTS
OPDEF PJRST [JRST]
EXTERN .JBFF,.JBSA,.JBREL
SUBTTL STARTUP
RELOC 400000
KJOB: TDZA F,F ;NORMAL INTERACTIVE ENTRY, CLEAR FLAGS
MOVSI F,CCLFLG!USEBUF ;CCL ENTRY
TLO F,PHYQUE ;ASSUME NOT PHYSICAL CALL TO QUEUE REQUIRED
RESET
MOVE P,PDP ;SET UP PUSH DOWN LIST
SETOM OLDPRO ;INITIALIZE PROTECTION CHANGE SW
SETZ A, ;CLEAR A FOR OPEN
MOVEI B,C ;ADDR OF DSKCHR BLOCK
MOVSI C,(SIXBIT .DSK.) ;NAME IS DSK
DSKCHR B,PHYUUO ;SEE IF CAN DO PHYSICAL ONLY UUOS
TLOA F,NOPHYU ;NO, DONT TRY AGAIN
TLO A,PHYOPN ;YES, OPEN PHYSICAL TTY
MOVSI B,(SIXBIT .TTY.)
MOVE C,[XWD TYOB,TYIB]
OPEN TTY,A ;OPEN TTY
TLOA F,NTTYF ;CANT
PUSHJ P,OUTBFT ;DECLARE IN AND OUT BUFFERS SO WILL BE ASSIGNED IN
; OUR CORE IN CASE QUEUE DOES FIRST OUTPUT
MOVE A,[XWD LOWCHR,OUCHLO]
BLT A,OUCHLO+EOUCHL-1 ;BLT CHAR OUTPUT ROUTINE TO LOW SEG
SETOM LINFLG ;NOTE LOG FILE NOT OPEN YET
SETZB CH,LOGCAL ;IN CASE NO BUFFER FOUND
MOVE S,[XWD LOGCAL,LOGCAL+1]
BLT S,ETLG
MOVEI A,^D10 ; SET QUEUE PRIORITY
DPB A,[POINT 6,LOGPAR,35] ; TO 10
MOVE A,[XWD CNFSTS,CNFTBL]
GETTAB A, ;GET STATES WORD
SETZ A,
TLNE A,ST.NSC ;SKIP IF OLD SCANNER SERVICE
TLO F,NEWSCN ;NOTE NEW SCANNER SERVICE
LDB A,[POINT 3,A,9] ;GET DISK SERVICE FIELD
MOVEM A,DSKSER
MOVSI A,(SIXBIT .LOG.);DEFAULT LOG FILE EXTENSION
HRR A,ZLST+ZADEF ;DEFAULT AMOUNT TO QUEUE IF NO /Z
HRROI B,JBTSPL ;CHECK SPOOL BITS
GETTAB B, ;TO SUPPRESS QUEUE CALL IF NONE
MOVEI B,.SPOUT ;IF FAIL, ASSUME ALL OUTPUT SPOOLED
TRNN B,.SPOUT ;IS ANYTHING SPOOLED?
HRR A,ZLST ;NO, DEFAULT /Z:0
MOVEM A,LOGEXT
MOVE S,[POINT 7,TCRBUF]
TLNN F,CCLFLG ;SKIP IF CCL ENTRY
JRST INTKJO ;NO, GO TO INTERACTIVE PART
MOVE BP,S
MOVE A,[XWD TCRRDF,B] ;READ AND DELETE CORE FILE
MOVSI B,(SIXBIT .KJO.)
MOVE C,TCRLST
TMPCOR A, ;CORE FILE UUO
JRST TRYDSK ;CANT READ FILE, TRY DISK
JRST INTKJ1 ;OK, BUFFER IS SET UP
TRYDSK: INIT DSK,17
SIXBIT .DSK.
0
JRST ETTLIN ;CANT INIT DSK?
PJOB B, ;GET JOB NUMBER
PUSHJ P,SIXJBN ;AND CONVERT TO SIXBIT IN LH A
HRRI A,(SIXBIT .KJO.)
MOVSI B,(SIXBIT .TMP.)
SETZB C,D
LOOKUP DSK,A ;LOOKUP CCL FILE ON DSK
JRST ETTLIN ;NOT TODAY
MOVE A,TCRLST
SETZB B,C
INPUT DSK,A ;OK, READ THE FILE
SETZB A,D
RENAME DSK,A
JFCL
JRST INTKJ1
;HERE FOR INTERACTIVE ENTRY
INTKJO: RESCAN 1 ;SKIP IF NO LINE TO INPUT
SKPINL ;SKIP IF THERE IS A LINE TO INPUT
JRST ETTLIN ;NO, MUST BE FROM CUSP
MOVE BP,[POINT 7,TCRBUF] ;POINT TO INTERNAL BUFFER
INTKOA: SOSG TYIB+2 ;DECR BYTE COUNT
INPUT TTY,0 ;IF 0 OR -, GET NXT BUFFER
ILDB CH,TYIB+1 ;PICK UP BYTE FROM INPUT BUFFER
JUMPE CH,INTKOA ;IGNORE NULLS
IDPB CH,BP ;PUT BYTE TO INTERNAL BUFFER
CAIGE CH,ALTMD ;CHECK FOR BREAK CHARACTERS
CAIG CH,CR ;(CR, LF, STD-ALTMODE, ALTMODE)
CAIGE CH,LF ;IF BREAK CHARACTER AND NOT
CAIN CH,ALTMOD ;CR,FALL THRU
CAIN CH,CR ;IF CR OR NOT BREAK, GO
JRST INTKOA ;READ NEXT CHARACTER
SETZ CH, ;INPUT DONE, SET END OF BUFFER
IDPB CH,BP ;INTO INTERNAL BUFFER
MOVE BP,[POINT 7,TCRBUF] ;RESTORE BYTE POINTER
TLO F,USEBUF ;SET USE INTERNAL BUFFER SWITCH ON
INTKJ1: PUSHJ P,SIXAN ;GET MONITOR COMMAND
TLNE F,BREAK
JRST ETTLIN ;END OF KJOB LINE
PUSHJ P,GETMSK ;GET MASK FOR CHARS TYPED
MOVE B,[SIXBIT .KJOB.]
AND B,C ;CUT DOWN KJOB TO CHARS TYPED
SUB A,B ;NOW COMPARE WITH WHAT WAS TYPED
JUMPE A,INTK3A ;JUMP IF KJOB COMMAND
INTKJ2: PUSHJ P,TYI1 ;ELSE IGNORE REST OF LINE
JRST ETTLIN
TLNN F,BREAK ;SKIP IF END OF LINE
JRST INTKJ2
JRST ETTLIN
INTK3A: TLZ F,PHYQUE ;KJOB COMMAND REQUIRES PHYSICAL CALL TO QUEUE
SETOM FZSW ;INIT SWITCH TO RESOLVE /F /Z CONFLICTS
CAIE CH,"/" ;SKIP IF ALREADY AT SLASH
PUSHJ P,SST ;GET 1ST NON-BLANK CHAR
TLNE F,BREAK
JRST ETTLIN
CAIN CH,"/"
JRST CPYSWC ;DO THE SWITCHES
;; JRST INTKJ5 ;FALL THRU
SUBTTL PARSE LOG FILE DESCRIPTOR
;HERE TO PARSE LOG FILE DESCRIPTOR
INTKJ5: SETZ A,
TLZ F,DOTF
SKIPA B,[POINT 6,A]
FILSP5: PUSHJ P,SST ;GET NEXT NON-SPACE CHAR
PUSHJ P,SIXAN3
JRST FILSP7
FILSPL: PUSHJ P,SIXAN ;NEXT ARG
FILSP7: CAIE CH,":"
JRST FILSP1 ;NOT DEVICE
MOVEM A,LOGDEV ;LOG DEVICE
JRST FILSPL ;LOOK FOR THE REST
FILSP1: CAIE CH,"."
JRST FILSP2
TLO F,DOTF ;NOTE PRESENCE OF DOT FOR EXTENSION COMING
MOVEM A,LOGFIL ;AND WE HAVE A NAME
JRST FILSPL
FILSP2: CAIE CH,"["
JRST FILSP3
TLNE F,DOTF
MOVEM A,LOGEXT
TLNN F,DOTF
MOVEM A,LOGFIL
PUSHJ P,OCTIN
CAIE CH,","
JRST FILSPE
HRLZM A,LOGPPN
PUSHJ P,OCTIN
CAIE CH,"]"
JRST FILSPE
HRRM A,LOGPPN
PUSHJ P,SST
CAIE CH,"="
CAIN CH,"_"
JRST FILSP4
JRST FILSPE
FILSP3: CAIN CH," "
JRST FILSP5
CAIE CH,"="
CAIN CH,"_"
JRST .+2
JRST FILSPE
TLNE F,DOTF
MOVEM A,LOGEXT
TLNN F,DOTF
MOVEM A,LOGFIL
FILSP4: SKIPN B,LOGDEV ;GET LOG FILE DEVICE
MOVSI B,(SIXBIT .DSK.);IF NONE SPEC'D USE DSK
MOVEM B,A ;GET TO A FOR TEST
DEVTYP A, ;GET DEVICE INFORMATION
JRST [MOVEM B,A ;NO DEVTYP UUO, WE'LL USE DEVSHR
DEVCHR A, ;GET DEVICE INFORMATION
TLNN A,DV.TTY!DV.DSK ;IS IT TTY OR DSK?
JRST FILER1 ;NO, ERROR
TLNN A,DV.TTY ;IS IT TTY?
TLO F,USELOG!NOLOGC ;DSK , SET TO USE LOG FILE
JRST FILS4 ;CONTINUE WITH NORMAL PROCESS
]
JUMPE A,FILER1 ;MAKE SURE DEVICE EXISTS
TLNE A,TY.SPL ;OK, IS IT A SPOOLED DEVICE?
SETZ A, ;IF SO, FAKE DEVICE CODE TO DISK
ANDI A,TY.DEV ;SAVE ONLY DEVICE CODE
CAIN A,.TYDSK ;IS IT A DISK?
TLOA F,USELOG!NOLOGC ;YES,SET TO USE LOG FILE AND SKIP NEXT
CAIN A,.TYTTY ;ELSE, IS IT A TTY?
JRST FILS4 ;YES, CONTINUE PROCESSING
FILER1: MOVEI M,[ASCIZ .%LOG file device is not DSK or spooled; will use TTY
.]
PUSHJ P,MSG ;TELL USER HE'S NOT GETTING A LOG FILE
SETZM LOGFIL ;WIPE OUT LOG FILE SPEC
FILS4: SKIPN LOGFIL ;SKIP IF LOG FILE SPECIFIED
JRST FILS4A ;NO, PROCEED
MOVEI A,17
SETZB C,LOOKBF+EXLDEV
OPEN DSK,A ;OPEN LOG DEVICE
JRST ERR1
MOVEI A,EXLDEV
MOVEM A,LOOKBF
HRRZI A,LOOKBF ;ADDR OF LOOKUP BLOCK
SKIPN DSKSER ;SKIP IF LEVEL D
SOSA A ;MOVE BACK PTR 1 LOC AND DONT DO PPN YET FOR C
PUSH A,LOGPPN ;STORE PPN
PUSH A,LOGFIL ;AND FILE NAME
PUSH A,LOGEXT ;AND EXT OF LOG FILE
ADDI A,1 ;BUMP PTR 1 IN CASE LEVEL C
SKIPN DSKSER ;SKIP IF WASTED
PUSH A,LOGPPN ;NO, STORE PPN FOR LEVEL C
MOVEI 14,FBMTRY ;TIMES TO RETRY IF FILE BEING MODIFIED
LOOKUP DSK,LOOKBF ;LOOKUP LOG FILE
JRST NOLOGY ;NOT THERE YET
JRST YLOGY ;OK
NOLOGY: MOVE B,LOGPPN
SKIPN DSKSER ;SKIP IF LEVEL C
MOVEM B,LOOKBF+3 ;NEED TO RESTORE FOR LEVEL C
ENTER DSK,LOOKBF ;TRY TO CREATE IT
JRST NOLOGE ;NOT TODAY
CLOSE DSK,
MOVE B,LOGPPN
SKIPN DSKSER ;SKIP IF LEVEL C
MOVEM B,LOOKBF+3 ;NEED TO RESTORE FOR LEVEL C
LOOKUP DSK,LOOKBF ;NOW ABOUT THAT LOG FILE
JRST NOLOGE ;JUST NOT MAKING IT
YLOGY: SKIPE A,LOOKBF+EXLDEV ;GET DEVICE LOG FILE IS ON
MOVEM A,LOGDEV
JRST FILS4A ;ALL SET
NOLOGE: HRRZ 13,LOOKBF+3 ;ERROR CODE
CAIE 13,FBMERR ;SKIP IF FILE BEING MODIFIED
JRST FILS4A ;NO, CANT HELP IT
SOJLE 14,FILS4A
MOVEI 13,1
SLEEP 13,
JRST NOLOGY
FILS4A: PUSHJ P,SST ;GET 1ST NON-BLANK CHAR
FILSP6: TLNE F,BREAK
JRST ETTLIN
CAIN CH,"/"
JRST CPYSWC
JRST FILSPE
CPYSW4: MOVEI CH,LF ;SET END OF LINE CHARACTER
IDPB CH,S
SUBTTL PARSE SWITCHES
;HERE TO PARSE SWITCHES
CPYSWC: PUSHJ P,SST
TLNE F,BREAK
JRST ETTLIN
CAIE CH,"Z" ;Z IS FOR US NOW
JRST CPYSWA
PUSHJ P,SST ;GET TERMINATOR
SETZB A,FZSW ;ASSUME NO NUMBER COMING, WHICH MEANS 0
CAIN CH,":" ;SKIP IF NO NUMBER FOLLOWING
PUSHJ P,DECIN ;YES, READ DEGREE OF SUPPRESSION REQUIRED
CAIL A,ZLSTL ;SKIP IF LEGAL VALUE
MOVEI A,ZLSTL-1 ;WELL, GIVE HIM ALL WE CAN
HRRZ A,ZLST(A) ;TRANSLATE TO BITS
HRRM A,LOGEXT ;STORE IN RH EXT WORD
JRST CPYLE ;AND MOVE ON TO NEXT SWITCH
ZLST: Q.SLOG!Q.SLPT!Q.SLST!Q.SDFR!Q.DLPT ;SUPPRESS ALL
Q.SLPT!Q.SLST!Q.SDFR!Q.DLPT ;DO LOG FILE
Q.SLST!Q.SDFR ;DO LOG FILE AND *.LPT
Q.SDFR ;DO ALL EXCEPT DFR
0 ;DO ALL
ZLSTZ==2 ;INDEX OF DEFAULT /Z VALUE
ZLSTL==.-ZLST
CPYSWA: CAIE CH,"V" ;V IS FOR US NOW TOO
JRST CPYSWD ;NO, LOOK FOR REGULAR SWITCH
PUSHJ P,SIXAN ;GET REST OF SWITCH
CAIE CH,":" ;TERMINATED BY COLON
JRST CPYSWE ;NO, SOMETHING WRONG
HLLZ B,A ;B=FIRST THREE CHARS
LSH B,-^D12 ;KEEP ONLY FIRST CHAR
PUSHJ P,DECIN ;READ DECIMAL NUMBER FOLLOWING
MOVSI C,-VLSTL
HRR B,VLST(C) ;MAKE RH EQUAL
CAME B,VLST(C) ;SKIP IF MATCH
AOBJN C,.-2
JUMPL C,(B) ;TRANSFER IF FOUND A MATCH
HLLZ A,B ;SET A=CHAR
LSH A,^D12
CPYSWE: LSH A,-6 ;SHIFT SWITCH TO MAKE ROOM FOR V
TLO A,(SIXBIT .V.)
MOVEI M,[ASCIZ .?Illegal switch .]
PUSHJ P,MSG
PUSHJ P,SIXBPA ;TELL WHAT WE ARE COMPLAINING ABOUT
JRST CPYSWF
DEFINE VTM(A)<
IRP A,<XWD ''A'',CPY'A>>
VLST: VTM <C,D,L,P,R,S,T>
VLSTL==.-VLST
DEFINE VDM(A)<
IRP A,<XWD "A",QDIS.'A>>
VDLST: VDM <D,P,R>
VDLSTL==.-VDLST
CPYD: MOVSI A,-VDLSTL ;LENGTH OF RESPONSES TO VD
HLRZ B,VDLST(A) ;NEXT LEGAL RESPONSE
CAIE B,(CH) ;SKIP IF FOUND IT
AOBJN A,.-2 ;NO, KEEP TRYING
JUMPGE A,CPYDE ;NO GOOD
HRRZ A,VDLST(A) ;BITS TO SET
DPB A,[POINT 3,LOGPAR,29] ;STORE IN PARAMETERS TO Q
JRST CPYLE1 ;ON TO NEXT SWITCH
CPYDE: MOVEI M,[ASCIZ .?Illegal switch value .]
PUSH P,CH
PUSHJ P,MSG
POP P,CH ;RESTORE ILLEGAL CHAR
PUSHJ P,OUCH ;OUTPUT IT
JRST CPYSWF ;FINISH LINE AND EXIT
CPYR: CAILE A,77 ;PRIORITY MUST BE LESS THAN 77
MOVEI A,77
DPB A,[POINT 6,LOGPAR,35] ;STORE IN PRIORITY FIELD OF PARAMETER WORD
JRST CPYLE ;CONTINUE ON
CPYS: MOVEM A,LOGSEQ ;SEQUENCE NUMBER
JRST CPYLE ;CONTINUE ON
CPYL: HRLM A,SLIM1
JRST CPYLE
CPYC: HRRM A,SLIM1
JRST CPYLE
CPYT: HRLM A,SLIM2
JRST CPYLE
CPYP: HRRM A,SLIM2
CPYLE: CAIN CH," " ;SKIP IF TERMINATING CHAR NOT SPACE
CPYLE1: PUSHJ P,SST ;GET FIRST NON-BLANK TERMINATOR
JRST FILSP6 ;AND BACK TO THE BEGINNING OF SWITCH PROCESSING
ERR1: MOVEI M,[ASCIZ .?Cant OPEN .]
PUSHJ P,MSG
PUSHJ P,SIXBPA
PUSHJ P,CRLF
EXIT
FILSPE: MOVEI M,[ASCIZ .?Syntax error in Log File name.]
PUSHJ P,MSG
JRST CPYSWF
CPYSWD: CAIE CH,"H" ;SKIP IF HE WANTS HELP
JRST CPYSWG
MOVEI M,HMES2 ;SETUP HELP MESSAGE
PUSHJ P,MSG
EXIT ;WE SHOULD RESTART
CPYSWG: CAIN CH,"F" ;FAST LOGOUT DOESN'T QUE *.LST
HLLM CH,FZSW ;POS IF NO /Z, ZERO OTHERWISE
HRLZI A,-COMLEN ;SETUP FOR SEARCH OF CONFIRM SWITCHES
CPYSWS: MOVS B,CH ;LH B=CHAR
XOR B,COMLST(A)
TLNN B,-1 ;SKIP IF NO MATCH
JRST CPYSWB ;SWITCH IS OK
AOBJN A,CPYSWS
MOVE B,CH ;B=ILLEGAL SWITCH
MOVEI M,[ASCIZ .?Illegal switch .]
PUSHJ P,MSG
MOVE CH,B
PUSHJ P,OUCH
CPYSWF: MOVEI M,[ASCIZ .
Type KJOB /H for help
.]
PUSHJ P,MSG ;TRY AGAIN, FELLA
EXIT
CPYSWB: IDPB CH,S ;STORE SWITCH
PUSHJ P,SST ;GET NEXT CHAR
TLNE F,BREAK ;SKIP IF MORE TO COME
JRST ETTLIN
CAIN CH,"/" ;SKIP IF LIST OF FILE STRUCTURES COMING
JRST CPYSW4 ;NO, END OF THIS SWITCH
MOVEI N," "
IDPB N,S
SETZ N,
SKIPA M,[POINT 6,N]
CPYSW1: PUSHJ P,TYI1
JFCL
CAIE CH,":"
CAIN CH,"/"
JRST CPYSW2
CAIL CH,140
TRZ CH,40
IDPB CH,S
CAIL CH,40
CAIN CH,","
JRST CPYSW2
SUBI CH,40
TLNN M,770000
IDPB CH,M
JRST CPYSW1
CPYSW2: SKIPN B,N
JRST CPYSW3
SETZB A,C
OPEN DSK,A
JRST ERR1
CPYSW3: CAIN CH,"/"
JRST CPYSW4
SETZ N,
MOVE M,[POINT 6,N]
CAIN CH,","
JRST CPYSW1
CAIE CH,":"
CAIL CH,40
JRST CPYSW1
;HERE WHEN BREAK CHAR DETECTED IN KJOB LINE
ETTLIN: IDPB CH,S
CAIE CH,CR ;SKIP IF BREAK CHAR IS CR
JRST ETTLN1 ;NO
PUSHJ P,TYI1 ;YES, GET LF FOLLOWING
JFCL
IDPB CH,S ;STORE THAT TOO
ETTLN1: SETZ CH,
IDPB CH,S ;MAKE SURE THERE IS A NULL AT END OF BUFFER
MOVEI A,Q.SLST ;SUPPRESS *.LST BIT
SKIPLE FZSW ;IF /F AND NOT /Z, SET THE BIT
IORM A,LOGEXT ;IN THE QUE PARAMS
SUBTTL CALL QUEUE
;HERE WHEN INITIAL COMMAND ALL SCANNED AND IN OUR BUFFER
;NOW CALL QUEUE TO UNTANGLE THAT MESS
HAVBUF: TLZ F,NOLOGC ;NOW INCLUDE CHARS READ IN LOG FILE
GETPPN A, ;GET USER'S PPN
JFCL ;IN CASE JACCT HAPPENS TO BE ON
SKIPN LOGPPN ;SKIP IF PPN SPECIFIED
MOVEM A,LOGPPN ;NO, USE USER'S PPN
PJOB A, ;GET JOB NUMBER
MOVEM A,JOBNUM ;SAVE FOR LATER
SETCM A,LOGEXT ;PICK UP SUPPRESSION FLAGS
TRNN A,Q.SLOG!Q.SLPT!Q.SLST!Q.SDFR ;ARE ALL SPOOLS SUPPRESSED?
JRST SUPQUE ;YES, WHY BOTHER CALLING QUEUE?
MOVEI A,Q.PHY ;FLAG PHYSICAL I/O
TLNN F,PHYQUE!NOPHYU ;SKIP IF CANT DO PHYSICAL I/O
IORM A,LOGEXT ;STORE IN BITS IN RH EXT WORD
PUSHJ P,DOQUE ;CALL QUEUE
JRST HICALL ;CONTINUE
SUPQUE: MOVSI A,LNOQUE ;KEEP LOGOUT FROM CALLING Q
IORM A,LGOFLG ;BY SETTING FLAG
; JRST HICALL ;ALL DONE, FALL INTO HICALL
SUBTTL RETURN FROM QUEUE - SET UP FOR CONFIRM
HICALL: MOVE P,PDP
MOVSI N,NOPHYU!PHYQUE!NEWSCN!USELOG!NTTYF
AND F,N ;PRESERVE THOSE BITS
SETO N,
GETLCH N ;GET LINE CHARACTERISTICS FOR OUR TTY
CAME N,[-1] ;SKIP IF DIDN'T LEARN ANYTHING
TLNN N,TT.PTY ;SKIP IF TTY IS A PTY
TLO F,TTYPTY ;OUR TTY IS NOT A PTY
MOVE A,SYSPPX ;LEVEL D DEFAULT SYS PPN
SKIPN DSKSER ;SKIP IF LEVEL D
MOVE A,MFDPP ;LEVEL C DEFAULT SYS PPN IS MFD PPN
MOVSI N,(SIXBIT .SYS.)
DEVPPN N, ;GET PPN FOR SYS:
MOVE N,A
MOVEM N,SYSPPN
;HERE TO COMPILE LIST OF FILE STRUCTURES IN SYSTEM
SETZB M,DELFIL ;0 FILES DELETED
SETO N, ;START JOBSTR AT BEGINNING
SKIPE DSKSER ;SKIP IF LEVEL C
JRST NXTSTR ;LEVEL D
MOVSI T,(SIXBIT .DSK.);ONLY FILE STRUCTURE IS DSK
MOVEM T,STRTAB
SETZM STRTAB+1
JRST LOG1
NXTSTR: MOVEI T,N ;ADDR OF JOBSTR BLOCK
JOBSTR T, ;GET NEXT STR IN JOBS SEARCH LIST
JRST ERR2
JUMPE N,NXTSTR ;IGNORE FENCE
MOVEM N,STRTAB(M)
AOJE N,ERR2 ;-1 IS END
SETZB A,C
TLNN F,NOPHYU
TLO A,PHYOPN
SOS B,N ;COMPENSATE FOR AOJE
OPEN UFD,A ;SEE IF WE CAN OPEN IT
JRST NXTSTR ;NO, PRETEND WE NEVER SAW IT
MOVEM N,LOOKBF
MOVE D,[XWD STRNAM+1,LOOKBF]
MOVE A,[DSKCHR D,]
TLNN F,NOPHYU
TRO A,PHYUUO
XCT A ;DSKCHR
TDZA D,D
MOVE D,LOOKBF+USRTAL
MOVEM D,QUOTAR(M)
TLNN F,NOPHYU ;SKIP IF PHYSICAL ONLY DOESN'T WORK
AOJA M,NXTSTR
MOVE D,LOOKBF+STRNAM ;GET REAL NAME OF STR
CAMN D,LOOKBF ;SKIP IF NOT SAME AS LOGICAL NAME
AOJA M,NXTSTR ;OK
MOVEI M,NOLOGN ;DO NOT ALLOW LOGICAL NAMES
PUSHJ P,MSG
EXIT
ERR2: SETZM STRTAB(M)
LOG1: GETPPN A, ;WHO CALLED LOGOUT?
JRST .+2 ;DONT KNOW IF OTHER USERS, TRY OTHUSR UUO
JRST LOG2 ;JACCT WAS ON - KNOW THERE ARE OTHER USERS
OTHUSR A, ;SKIP IF OTHER USERS
TLZA A,400000 ;SKIP AND CLEAR JUNK--NOT A MULTIPLE USER.
LOG2: TLO F,DUPF ;MARK THE FACT THAT MORE THAN ONE USER
; WITH THIS [P,P] IS PRESENT.
MOVEM A,SVPJPG ;SAVE USER'S PROJECT,PROGRAMMER NUMBER.
SETZB S,DELBLK
;HERE TO SEE IF UFD'S EXIST ON STR'S
NXTQIO: SKIPN B,STRTAB(S)
JRST ENDQIO ;0 NAME IS END OF LIST
MOVEI A,17
TLNN F,NOPHYU ;SKIP IF CANT DO PHYSICAL ONLY
TLO A,PHYOPN
SETZB C,NOACC(S) ;CLEAR NO ACCESS FLAG
OPEN UFD,A
AOJA S,NXTQIO
OPEN DSK,A
AOJA S,NXTQIO
PUSHJ P,LKUFST ;SET UP FOR LOOKUP OF UFD
LOOKUP UFD,LOOKBF
JRST NOUFD
SETOM EXIST(S) ;NOTE THAT A UFD EXISTS
SETZB A,RDHED
SKIPN DSKSER ;SKIP IF LEVEL D
AOJA S,NXTQIO ;NO NEED FOR MORE IF LEVEL C
TLO A,400000 ;A=RESPONSE FROM DSKCHR IF NO MONITOR TABLES
CAMN A,QUOTAR(S) ;NO SKIP IF MONITOR TABLES NOT SET UP
JRST STNOAC ;NO ACCESSES, MONITOR TABLES NOT SET UP
MOVE A,LOOKBF+EXLQTR
MOVEM A,QUOTAR(S) ;RESERVED QUOTA
MOVE A,LOOKBF+EXLQTO
MOVEM A,QUOTAO(S) ;QUOTA OUT
MOVE A,LOOKBF+EXLQTF ;FIRST COME, FIRST SERVED QUOTA
MOVEM A,QUOTAF(S)
AOJA S,NXTQIO ;NO MORE, TO NEXT STR
NOUFD: SETZM EXIST(S) ;NO UFD THIS STR
AOJA S,NXTQIO
STNOAC: SETOM NOACC(S) ;SET NO ACCESSES FLAG (ASSUME STR IS OK)
AOJA S,NXTQIO
SUBTTL CONFIRM DIALOGUE
;HERE WHEN TABLES ALL SET UP, START CONFIRM DIALOGUE
ENDQIO: MOVE BP,[POINT 7,TCRBUF]
TLO F,USEBUF ;START WITH BUFFER
TLNN F,DUPF ;SKIP IF OTHER USERS SAME PPN
JRST CONMS
MOVEI M,OTHUSM ;OTHER USERS SAME PPN MESSAGE
PUSHJ P,MSG
;HERE TO START CONFIRM
CONMS: TLNN F,USEBUF ;SKIP IF STILL USING BUFFER
JRST CONMS1
MOVE M,BP ;COPY BYTE PTR
ILDB M,M ;GET NEXT BYTE
JUMPN M,CONMS2 ;JUMP IF MORE IN BUFFER
TLZ F,USEBUF
CONMS1: MOVEI M,CONFM
PUSHJ P,LTMSG ;TYPE TO BOTH LOG FILE AND TTY
CONMS2: SETOM TSAV ;INITIALIZE FOR GETSTR
SETZM SAVFIL ;CLEAR NUMBER OF FILES SAVED
SETZM SAVBLK ;AND NUMBER OF BLOCKS (IN CASE LEVEL C)
PUSHJ P,GETANS ;GET RESPONSE FROM USER
JRST CONMS1
MOVSI A,-COMLEN
HLRZ B,COMLST(A) ;GET NEXT CHAR ON LIST
CAIE T,(B) ;SKIP IF THIS IS US
AOBJN A,.-2 ;NO, KEEP LOOKING
HRRZ B,COMLST(A) ;GET DISPATCH ADDRESS
MOVE A,T ;SAVE CHAR IN A
JRST (B) ;AND DISPATCH
DEFINE CTM(A)<IRP A,<XWD "A",A'COM>>
COMLST: CTM <B,D,F,H,I,K,L,P,Q,S,U,W,X>
XWD CR,CONMS
XWD LF,CONMS
XWD ALTMOD,CONMS
COMLEN=.-COMLST
HLPMS1
;HERE TO GET RESPONSE TO CONFIRM
GETANS: SETZ T, ;GET RESPONSE FROM USER
TLZ F,STRF ;CLEAR FLAG IN CASE NO STR'S LISTED
GETAN1: PUSHJ P,TYI1 ;GET NEXT CHAR TYPED
POPJ P,
CAIN CH,"/" ; ALLOW FOR SWITCH-TYPE ANSWER
JRST GETAN1 ; IF SO, GET NEXT CHAR
MOVEI T,(CH) ; PUT TO WHERE CONMS EXPECTS
CAIE CH,ALTMOD ; IF THIS CHARACTER IS ALT MODE
CAIN CH,LF ; OR LINE FEED,
JRST CPOPJ1 ; RETURN HAPPY
CAIN CH,CR ; ELSE, IF IT IS <CR>
JRST GETAN4 ; GO CLEAR <LF> BEFORE HAPPY RETURN
PUSHJ P,TYI1 ; GET NEXT CHARACTER
JRST CPOPJ1 ; BREAK, USE WHAT'S THERE
CAIE CH,40 ; ELSE, IS IT BREAK OR ...
CAIN CH,11 ; TAB,DO NEXT IF YES
JRST GTSTRS ; STR LIST SHOULD BE COMMING
GETAN2: PUSHJ P,NOTBRK ; ELSE, CHECK FOR BREAK CHARACTER
JRST GETAN3 ; IF IT IS, JUMP
TLO F,STRF ; NO, SET BORROWED ERROR SWITCH
GETAN4: PUSHJ P,TYI1 ; RUN THROUGH BUFFER
JRST GETAN3 ; JUMP IF END OF BUFFER
JRST GETAN2 ; ELSE, CHECK FOR BREAK
GETAN3: CAIN CH,15 ; IS CHARACTER A <CR>?
PUSHJ P,TYI1 ; YES, CLEAR <LF>
JFCL ; DON'T MUCH CARE ABOUT THIS
TLZE F,STRF ; IS ERROR SWITCH SET?
SKIPN DSKSER ; AND IS THIS LEVEL D?
JRST CPOPJ1 ; NO TO EITHER, RETURN HAPPY
JSP M,MSG ; TELL USER TO TRY AGAIN
ASCIZ .%Response must be single letter, with optional STR list
. ; MESSAGE TO USER
GTSTRS: TLO F,STRF ; SET THAT USER STR LIST USED
SETZB A,STRTB1 ; SETUP USER END OF STR LIST
GETST1: SETZ N,
MOVE M,[POINT 6,N] ;USE M AS BYTE POINTER TO STORE
GETST2: PUSHJ P,TYI1 ;GET NEXT CHAR
POPJ P,
CAIE CH,":"
CAIG CH,40
JRST GETST3 ;COLON OR BREAK CHAR ENDS STR
CAIN CH,","
JRST GETST3 ;AND COMMA
CAIL CH,140 ;CONVERT LOWER TO UPPER CASE
TRZ CH,40
SUBI CH,40 ;AND CONVERT TO SIXBIT
TLNE M,770000
IDPB CH,M
JRST GETST2
GETST3: JUMPE N,GETST4 ;FORGET IT IF NO CHARS FOUND
MOVEM N,STRTB1(A) ;WE HAVE AN STR
ADDI A,1
GETST4: CAIE CH,ALTMOD
CAIN CH,LF
JRST GETST5 ;QUIT AT END OF LINE
JRST GETST1
GETST5: SETZM STRTB1(A) ;END WITH 0
JRST CPOPJ1
;HERE TO PROCESS K COMMAND - DELETE ALL EXCEPT PRESERVED
KCOM: PUSHJ P,MAKSU1 ;ASK ARE YOU SURE IF OTHER USERS OR PROJ 1
JRST CONMS ;NOT SO SURE AFTER ALL
KCOM1: PUSHJ P,GETSTR ;GET NEXT FILE STRUCTURE AND SET UP
JRST NOSTR ;NO MORE FILE STRUCTURES
KNXT: PUSHJ P,LKSET ;SET UP LOOKUP FOR NEXT USER FILE
JRST KCOM1 ;NO MORE FILES THIS STR
LOOKUP DSK,A
JRST KNXT
LSH C,-^D33
SKIPN DSKSER ;SKIP IF LEVEL D
LSH C,-2 ;ANOTHER 2 BITS DOWN IF LEVEL C
JUMPLE C,KNXT1 ;JUMP IF NOT PRESERVED
PUSHJ P,SAVCNT ;COUNT FILES AND BLOCKS SAVED
JRST KNXT
KNXT1: PUSHJ P,FILDEL ;DELETE THE FILE
JRST KNXT
;HERE TO PROCESS P COMMAND - PRESERVE ALL EXCEPT TEMP
PCOM: PUSHJ P,MAKSU1 ;ASK ARE YOU SURE IF OTHER USERS OR PROJ 1
JRST CONMS ;NO SO SURE AFTER ALL
PCOM1: PUSHJ P,GETSTR ;GET NEXT FILE STRUCTURE AND SET UP
JRST NOSTR ;NO MORE
PNXT: PUSHJ P,LKSET ;SET UP FOR LOOKUP OF NEXT USER FILE
JRST PCOM1 ;NO MORE FILES THIS STR
LOOKUP DSK,LOOKBF
JRST PNXT
LDB C,OWNACC
SKIPN DSKSER ;SKIP IF LEVEL D
LDB C,COWNAC ;GET LEVEL C PROTECTION FIELD
JUMPG C,PNXT1
PUSHJ P,TMPDEL ;DELETE IF TEMPORARY FILE
JRST PNXT ;IT WAS
PNXT1: HLRE A,LOOKBF+3 ;GET LENGTH OF FILE IF LEVEL C
PUSHJ P,SAVCN1 ;COUNT FILES AND BLOCKS SAVED
PUSHJ P,FILPRS ;PRESERVE THE FILE
JRST PNXT
;HERE TO PROCESS S COMMAND - SAVE ALL EXCEPT TEMP
SCOM: PUSHJ P,MAKSU1 ;ASK ARE YOU SURE IF OTHER USERS OR PROJ 1
JRST CONMS ;NOT SO SURE AFTER ALL
SCOM1: PUSHJ P,GETSTR ;GET NEXT FILE STRUCTURE AND SET UP
JRST NOSTR ;NO MORE
SNXT: PUSHJ P,LKSET ;SET UP FOR LOOKUP OF NEXT USER FILE
JRST SCOM1 ;NO MORE FILES THIS STR
LOOKUP DSK,A
JRST SNXT
LSH C,-^D33
SKIPN DSKSER ;SKIP IF LEVEL D
LSH C,-2 ;ANOTHER 2 BITS DOWN IN LEVEL C
JUMPG C,SNXT1
PUSHJ P,TMPDEL ;DELETE IF TEMPORARY FILE
JRST SNXT ;IT WAS
SNXT1: PUSHJ P,SAVCNT ;COUNT FILES AND BLOCKS SAVED
JRST SNXT
;HERE TO PROCESS L COMMAND - LIST FILES
LCOM: PUSHJ P,GETSTR ;GET NEXT FILE STRUCTURE AND SET UP
JRST CONMS ;NO MORE - BACK TO CONFIRM
MOVE A,B ;FILE STRUCTURE NAME
PUSHJ P,SIXBPA ;PRINT IT
MOVEI M,[ASCIZ .:
.]
PUSHJ P,MSG
LNXT: PUSHJ P,LKSET ;SET UP FOR LOOKUP OF NEXT USER FILE
JRST LCOM ;NO MORE FILES THIS STR
TLZ F,NGLOOK ;CLEAR IN CASE LOOKUP FAILS
LOOKUP DSK,LOOKBF
TLO F,NGLOOK ;IT DID
PUSHJ P,PRNTFL ;PRINT FILE INFO
PUSHJ P,CRLF
JRST LNXT
;HERE TO PROCESS Q COMMAND - REPORT IF OVER QUOTA
QCOM: SKIPE DSKSER ;DONT DO ANYTHING IF LEVEL C
PUSHJ P,GETSTR ;GET NEXT FILE STRUCTURE AND SET UP
JRST CONMS ;NO MORE - BACK TO CONFIRM
PUSHJ P,QLST ;TYPE MESSAGE IF OVER LOGGED OUT QUOTA
JRST QCOM
FCOM: TLZ F,STRF ;TRY TO LOGOUT NOW
JRST NOSTR ;NO, SEE IF UNDER QUOTAS
;HERE TO PROCESS D COMMAND - DELETE ALL FILES
DCOM: PUSHJ P,MAKSUR ;ASK ARE YOU SURE
JRST CONMS ;FORGET IT
DCOM2: PUSHJ P,GETSTR ;SET UP NEXT FILE STRUCTURE
JRST NOSTR ;NO MORE
DNXT: PUSHJ P,LKSET ;SET UP FOR LOOKUP OF NEXT USER FILE
JRST DCOM2 ;NO MORE FILES THIS STR
LOOKUP DSK,LOOKBF ;LOOKUP THE FILE
JRST DNXT ;CANT GET IT
PUSHJ P,FILDEL ;DELETE THE FILE
JRST DNXT
;HERE TO PROCESS X AND W COMMANDS - COMPLEMENT LIST DELETE FILES FLAG
XCOM: TLZA F,LISDEL ;TURN OFF LISTING FILES DELETED
WCOM: TLO F,LISDEL ;TURN ON LISTING DELETED FILES
JRST CONMS
;HERE TO PROCESS B COMMAND - ALGORITHM TO GET BELOW QUOTA
BCOM: SKIPN DSKSER ;NO NEED FOR THIS FOR LEVEL C
JRST NOSTR ;FORGET IT
PUSH P,BP ;SAVE BP
TLZ F,CALQUE ;CLEAR CALL QUEUE BIT
SETZ D,
SETOB A,UFDBUF
BCOMA: MOVE T,[XWD 3,A]
JOBSTR T,
JRST BCOM1
MOVEM A,UFDBUF+1(D) ;STORE NEXT NAME
AOJE A,BCOMB
MOVEM B,UFDBUF+2(D)
TLZE C,STR.RO ;SKIP IF WAS NOT READ ONLY
SETZM UFDBUF ;NOTE AT LEAST ONE WAS READ ONLY
MOVEM C,UFDBUF+3(D) ;STORE STATUS BITS
ADDI D,3
SOJA A,BCOMA
BCOMB: HRLZI D,1(D)
HRRI D,UFDBUF
SKIPL UFDBUF ;SKIP IF NEED NOT CLEAR ANY READ ONLY
STRUUO D,
JFCL
BCOM1: PUSHJ P,GETSTR ;GET NEXT FILE STRUCTURE AND SET UP
JRST BNOSTR ;NO MORE
MOVE T,[XWD %NSHJB,NSWTBL];LOAD AC FOR, AND
GETTAB T, ;GET HIGHEST JOB NO. NOW ASSIGNED
MOVEI T,^D127
MOVNS T ;SET UP AS NEGATIVE AND
HRLZS T ;MAKE AOBJN PTR
BJLOOP: MOVE C,STRTAB(S) ;NAME OF STR
MOVE B,SVPJPG ;PPN
MOVEI A,1(T) ;JOB NUMBER
MOVEI D,A
CAME A,JOBNUM ;SKIP IF THIS IS OUR JOB
GOBSTR D, ;SKIP IF IN THIS JOBS SEARCH LIST
JRST .+2 ;IF SO IT IS SOME OTHER PPN
JRST BCOM1 ;IN SOMEBODY ELSES SEARCH LIST, OK
AOBJN T,BJLOOP ;LOOP FOR ALL JOBS IF NECESSARY
SETZM OKCNT
PUSHJ P,QLST ;1ST TIME THRU ON STR, TELL USER IF
TLZ F,LIDLFG ; OVER-QUOTA AND SET TO PRINT 'DELETED:' MSG
MOVSI BP,-BLSTL ;PTR TO LIST OF DESCRIPTIONS OF FILES TO DELETE
BNXT: PUSHJ P,CHKOVR ;SEE IF STILL OVER QUOTA
SUB B,OKCNT ;ACCOUNT FOR BLOCKS TO BE RENAMED WHEN QUEUED
JUMPLE B,BCOM1 ;JUMP IF UNDER QUOTA
JRST BNXTF ;START DELETING FILES
BNXTC: PUSHJ P,LKUFST ;SET UP TO LOOKUP UFD
LOOKUP UFD,LOOKBF
JRST BCOM2 ;GIVE UP
SETZM RDHED
BNXTF: PUSHJ P,LKSET ;SET UP TO LOOKUP NEXT USER FILE
AOBJN BP,BNXTC ;NO MORE, TRY NEXT CATEGORY
JUMPGE BP,BCOM1 ;GIVE UP ON THIS STR
LOOKUP DSK,A ;LOOKUP USER FILE
JRST BNXTF ;CANT DO THIS ONE
LSH C,-^D33 ;C=OWNERS PROTECTION
MOVE T,BLST(BP) ;T=PTR TO DESCRIPTION OF TYPE TO DELETE
TLON T,400000 ;SKIP IF ANY PROTECTION MAY BE DELETED
JUMPG C,BNXTF ;NO, SAVE IF PROTECTED
SETZ D,
TLOE T,200000 ;SKIP IF DONT TRY TO QUEUE BEFORE DELETING
TLO D,400000 ;MAKE D NEGATIVE, LOW ORDER THREE BITS=0
BNXTE: MOVE C,(T) ;C=AN EXT
TLNN C,-1 ;SKIP IF SPECIFIC EXT
JRST BNXTE3 ;NO, MATCH ANY EXT
HRR B,C
CAME B,C ;SKIP IF EXT MATCHES
AOBJN T,BNXTE ;NO, TRY NEXT IN LIST
BNXTE2: JUMPL T,BNXTE3 ;JUMP IF MATCH
TRNE C,-1 ;NO MATCH, SKIP IF MEANS KEEP FILE
JRST BNXTE4 ;NO, DELETE FILE
JUMPGE D,BNXTF ;NO, KEEP FILE UNLESS QUEING
MOVE A,LOGPPN ;GET PPN OF LOG FILE
CAME A,SVPJPG ;SKIP IF STILL IN USER'S AREA
JRST BNXTF ;NO, THEN THIS CANNOT BE THE LOG FILE
MOVE A,STRTAB(S) ;LOOK FOR LOG FILE
PUSHJ P,GETMSK ;GET MASK FOR STR NAME
AND C,LOGDEV
SUB A,C ;SEE IF THIS IS LOG FILE DEVICE
JUMPN A,BNXTF ;NO, KEEP FILE
MOVE A,LOGFIL ;LOG FILE NAME
CAME A,LOOKBF+EXLNAM ;SKIP IF LOG FILE NAME MATCHES
JRST BNXTF
HLLZ A,LOGEXT
HLLZ B,LOOKBF+EXLEXT
SUB A,B
JUMPN A,BNXTF ;JUMP IF NOT LOG FILE
BNXTE5: LOOKUP DSK,LOOKBF ;NEED EXTENDED LOOKUP
JRST BNXTE4 ;SOME DAYS YOU CANT WIN
DPB D,OWNACC ;STORE 0 IN PROTECTION FIELD
RENAME DSK,LOOKBF ;RENAME TO UNPROTECTED
JRST BNXTE4 ;SO WILL BE QUEUED
TLO F,CALQUE ;NOTE MUST CALL QUEUE
MOVE A,LOOKBF+EXLALC ;BLOCKS TO BE RENAMED
ADDM A,OKCNT
JRST BNXT ;AND PRETEND WE DELETED THE FILE
BNXTE3: JUMPL D,BNXTE5 ;MATCH, JUMP IF TRY QUEING FIRST
TRNE C,-1 ;SKIP IF MEANS DELETE FILE
JRST BNXTF
BNXTE4: PUSHJ P,FILDEL ;OK, DELETE FILE
JRST BNXT ;AND SEE IF THAT'S ENOUGH
BCOM2: MOVSI A,LBSWIT
ORM A,LGOFLG
JRST BCOM1
DEFINE BLSTM (P,N)<XLIST
IFIDN <P> <QUEUE>,<BYTE (2)3(16)-.'N'L(18).'N>
IFIDN <P> <UNPROT>,<BYTE (2)0(16)-.'N'L(18).'N>
IFIDN <P> <PROT>,<BYTE (2)2(16)-.'N'L(18).'N>
LIST>
DEFINE BELST(A,B)<XLIST
.'A: EXTL <B>
.'A'L==.-.'A
LIST>
DEFINE EXTL(A)<IRP A,<SIXBIT \A\>>
REPEAT 0,<
THIS LIST DEFINES THE ORDER OF DELETING FILES TO GET BELOW QUOTA
FOR THE B COMMAND. ASS SOON AS THE USER IS BELOW QUOTA, THE ALGORITHM EXITS.
IF USER IS OVER QUOTA, HIS AREA IS SEARCHED FOR A FILE IN THE FIRST
CATEGORY TO DELETE. IF SUCH A FILE IS FOUND, IT IS DELETED. IF NO
FILE IS FOUND, THE NEXT CATEGORY IS TRIED, AND SO ON UNTIL A FILE
THAT CAN BE DELETED IS FOUND. THEN THE ALGORITHM STARTS OVER; IF NOW
UNDER QUOTA, EXIT, ELSE CONTINUE WITH SAME CATEGORY.
EACH BLSTM MACRO CALL DEFINES A CATEGORY OF FILES.
THE FIRST ARGUMENT MUST BE UNPROT, PROT, OR QUEUE.
UNPROT SAYS ONLY UNPROTECTED FILES IN THIS CATEGORY MAY BE DELETED
PROT SAYS ANY FILE IN THIS CATEGORY MAY BE DELETED
QUEUE SAYS FILES WILL BE QUEUED AND RENAMED TO QUEUE AREA
(MUST BE FILES QUEUE PROCESSES ON NORMAL KJOB CALL)
THE SECOND ARGUMENT IS THE NAME OF THE CATEGORY. THIS NAME IS ALSO AN
ARGUMENT TO THE BELST MACRO, WHICH SPECIFIES THE NAME AND THE
EXTENSIONS INCLUDED IN THE CATEGORY. EXTENSIONS MUST BE LISTED
WITHIN ANGLE BRACKETS, I.E. <A,B,C>. IF EXTENSIONS IN LIST
HAVE LESS THAN THREE LETTERS, FILES WITH ANY EXTENSION IN THE LIST
MAY BE DELETED. IF EXTENSIONS HAVE MORE THAN THREE LETTERS,
FILES WITH ANY EXTENSION NOT IN THE LIST MAY BE DELETED.
--- -- --- ----
NULL MEANS ANY EXTENSION MATCHES (MUST HAVE A SPACE, I.E. < >)>
BLST: BLSTM UNPROT,TEMP
BLSTM UNPROT,REL
BLSTM UNPROT,BAK
; BLSTM UNPROT,UNK
BLSTM UNPROT,SAV
BLSTM UNPROT,ANY
BLSTM QUEUE,QUE
BLSTM PROT,TEMP
BLSTM PROT,REL
BLSTM PROT,BAK
; BLSTM PROT,UNK
BLSTM PROT,SAV
BLSTM PROT,ANY
BLSTL==.-BLST
BELST (TEMP,<TMP,LST,CRF,TEM>)
BELST (ANY,< >)
BELST (REL,<REL>)
BELST (BAK,<BAK>)
;BELST UNK IS NO LONGER USED, SINCE IT WAS FELT THAT UNKOWN
;EXTENSIONS WERE ALMOST ALWAYS USED FOR SOURCE FILES.
;THE MACRO IS LEFT HERE TO DEMONSTRATE HOW A BELST MACRO WOULD BE
;USED TO SPECIFY AN "EVERYTHING BUT" LIST.
; BELST (UNK,<SAVX,HGHX,LOWX,SHRX,MACX,F4 X,CBLX,RNOX,MANX,ALGX,BASX,BLIX,SFDX>)
BELST (SAV,<SAV,HGH,LOW,SHR>)
BELST (QUE,<LST,MAP,LPT,CDP,PTP,PLT>)
;HERE TO PROCESS I AND U COMMANDS TO INDIVIDUALLY LIST AND GET DISPOSITION
ICOM: TLOA F,INCP ;INCLUDE FILES ALREADY PRESERVED IN LIST
UCOM: TLZ F,INCP ;DONT INCLUDE FILES ALREADY PRESERVED IN LIST
;LIST FILES IN FILE STRUCTURE AND DECIDE THEIR FATE
;HERE TO PROCESS I AND U COMMANDS - INDIVIDUALLY LIST AND GET DISPOSTION
IUCOM: PUSHJ P,GETSTR ;GET NEXT FILE STRUCTURE AND SET UP
JRST NOSTR ;NO MORE
MOVE A,B ;FILE STRUCTURE NAME
PUSHJ P,SIXBPA ;PRINT IT
MOVEI M,[ASCIZ .:
.]
PUSHJ P,MSG
IUNXT: PUSHJ P,LKSET ;SET UP FOR LOOKUP OF NEXT USER FILE
JRST IUCOM ;NO MORE FILES ON THIS STR
LOOKUP DSK,LOOKBF
JRST IUNXT
LDB T,OWNACC ;GET OWNERS ACCESS CODE
SKIPN DSKSER ;SKIP IF LEVEL D
LDB T,COWNAC ;LEVEL C PRESERVE BIT
TLNN F,INCP ;ASK IF I, KEEP IT IF U AND PRESERVED
JUMPG T,SCM1 ;SAVE THE FILE IF U AND PRESERVED
IUN1: CLRBFI ;CLEAR ANY TYPE-AHEAD
PUSHJ P,PRNTFL ;PRINT FILE INFO
MOVEI M,[ASCIZ .: .]
PUSHJ P,MSG
OUTPUT TTY,
PUSHJ P,TYIX ;GET USER RESPONSE
JRST CONMS ;RAN OFF END OF BUFFER
MOVSI M,-CM1LEN
HLRZ CH,CM1LST(M) ;FIND COMMAND ON LIST
CAIE T,(CH)
AOBJN M,.-2
HRRZ CH,CM1LST(M) ;RH IS DISPATCH ADDR
JRST (CH) ;DO IT
DEFINE CTM1(A)<IRP A,<XWD "A",A'CM1>>
CM1LST: CTM1 <E,H,K,P,Q,S>
CM1LEN=.-CM1LST
HLPMS2
HLPMSA: PUSHJ P,TYI1
JRST CONMS1
HLPMS1: CAIE CH,LF
JRST HLPMSA
MOVEI M,ASKHLP
PUSHJ P,MSG
JRST CONMS
HLPMS2: MOVEI M,ASKHLP
PUSHJ P,MSG
JRST IUN1
ASKHLP: ASCIZ .Type H for help
.
;HERE TO GET NEXT FILE STRUCTURE TO PROCESS
GETSTR: MOVE C,OLDPRO ;GET ORIGINAL PROTECTION
CAMN C,NEWPRO ;SEE IF PROTECTION HAS CHANGED
JRST GETSTY ;DIDN'T CHANGE, JUMP TO NORMAL WORK
MOVE A,SVPJPG ;ELSE, GET JOB'S PPN FOR UFD LOOKUP
MOVSI B,(SIXBIT .UFD.);MAKE UFD EXTENSION
MOVE D,MFDPP ;SET TO MFD PPN
RENAME UFD,A ;SET BACK TO OLD PROTECTION
JFCL ;OH WELL . . .
GETSTY: AOS S,TSAV ;GET NEXT STR FROM JOB'S LIST
MOVE B,STRTAB(S)
TLNN F,STRF ;BUT IF STR'S WERE LISTED, FROM LIST
JRST GETSTZ
MOVE B,STRTB1(S)
MOVSI S,-MAXFS
CAME B,STRTAB(S) ;FIND NEXT STR NAMED ON STRTAB
AOBJN S,.-1
JUMPGE S,NOINSL ;JUMP IF NOT IN USER'S SEARCH LIST
HRRZS S ;KEEP S=INDEX IN STRTAB
GETSTZ: JUMPE B,CPOPJ ;NO SKIP RETURN IF NO MORE STR'S
SKIPN EXIST(S) ;SKIP IF WE EXIST ON THIS STR
JRST GETSTR ;ELSE DONT BOTHER
MOVEI A,17
TLNN F,NOPHYU ;SKIP IF CANT DO PHYSICAL ONLY
TLO A,PHYOPN ;DO IT
SETZ C,
OPEN UFD,A
JRST GETSTR
OPEN DSK,A
JRST GETSTR
PUSHJ P,LKUFST
SETZM RDHED ;INITIALIZE FOR RDUFD
LOOKUP UFD,LOOKBF ;AND EXTENDED LOOKUP OF UFD ON UFD
JRST CPOPJ1
MOVE A,LOOKBF+EXLATT ;GET PROTECTION OF UFD
TDZ A,[000777,,777777] ;SAVE ONLY PROTECTION
MOVEM A,OLDPRO ;PUT INTO ORIGINAL PROTECTION
MOVEM A,NEWPRO ;CALL IT NEW PROTECTION ALSO
JRST CPOPJ1 ;SKIP RETURN
NOINSL: MOVEI CH,"?"
PUSHJ P,OUCH
MOVE A,B
PUSHJ P,SIXBPA
MOVEI M,[ASCIZ . No such STR
.]
PJRST MSG
;HERE TO DELETE FILE
KCM1: PUSHJ P,FILDEL ;DELETE THE FILE
JRST IUNXT
;HERE TO PRESERVE FILE
PCM1: PUSHJ P,FILPRS ;PRESERVE THE FILE
SCM1: HLRE A,LOOKBF+3
PUSHJ P,SAVCN1
JRST IUNXT
;HERE TO EXIT STR IF UNDER QUOTA
ECM1: SKIPN DSKSER ;SKIP IF LEVEL D
JRST ECM2 ;DONT BOTHER IF LEVEL C, EXIT NOW
PUSHJ P,QLST ;TYPE MESSAGE IF OVER QUOTA
JUMPLE B,IUCOM ;JUMP IF NOT OVER QUOTA
JRST IUN1 ;OVER QUOTA
JRST IUCOM ;NO, END STR NOW
ECM2: SETZM SAVFIL ;SINCE WE DIDNT FINISH PASS OVER UFD,
SETZM SAVBLK ;PRETEND WE DIDNT TRY
JRST IUCOM
;HERE TO REPORT IF OVER QUOTA
QCM1: SKIPE DSKSER ;DONT DO ANYTHING IF LEVEL C
PUSHJ P,QLST ;TYPE MESSAGE IF OVER LOGGED OUT QUOTA
JRST IUN1 ;DO THIS FILE OVER
;HERE FOR HELP DIALOGUE
HCM1: MOVEI M,HMES1
PUSHJ P,MSG
JRST IUN1
HCOM: MOVEI M,HMES
PUSHJ P,MSG
JRST CONMS
;SUBROUTINE TO COUNT FILES AND BLOCKS SAVED
;ARGS D=E+3 RETURN FROM LOOKUP BLOCK
;VALUES 1 ADDED TO SAVFIL
; LENGTH OF FILE IN BLOCKS ADDED TO SAVBLK
;ENTER AT SAVCN1 WITH A=SIZE AFTER HLRE
SAVCNT: HLRE A,D ;SIZE OF FILE
SAVCN1: PUSHJ P,FILSIZ ;COMPUTE SIZE OF FILE
ADDM A,SAVBLK ;AND ADD TO COUNT OF BLOCKS SAVED
AOS SAVFIL ;COUNT 1 FILE SAVED
POPJ P,
SUBTTL END OF CONFIRM, SEE IF OK TO CALL LOGOUT
;HERE WHEN COMMAND COMPLETE FOR ALL STR'S TO BE PROCESSED FOR COMMAND
BNOSTR: POP P,BP ;RESTORE BP IN CASE STILL IN BUFFER
TLNN F,CALQUE ;SKIP IF MUST CALL QUEUE AGAIN
JRST NOSTR
HRROI A,1 ;0'S FOR POSSIBLE SUPPRESS QUEUEING FLAGS
ANDCAM A,LOGEXT ;MAKE SURE QUEUEING DOEN
MOVEI A,QDIS.R ;DISPOSITION RENAME TO MAKE SURE LOG FILE GOES
DPB A,[POINT 3,LOGPAR,29] ;STORE NEW DISPOSITION
PUSHJ P,DOQUE ;CALL QUEUE
SETOM TSAV ;RESET LIST OF STR'S FOR BCOM
JRST BCOM ;AND START B OVER AGAIN
NOSTR: SKIPN DSKSER ;SKIP IF LEVEL D
JRST NOSTR4 ;OK TO LOGOUT IF LEVEL C
TLNE F,STRF ;IF NO STR'S WERE LISTED, TRY TO LOG OUT
JRST CONMS ;ELSE GO BACK FOR MORE
;HERE WHEN READY TO TRY AND LOG OUT - CHECK QUOTAS AND IF ALL OK,
; NO FURTHER OBJECTIONS
TLNE F,DUPF ;SKIP IF NO OTHER USERS
JRST NOSTR4 ;IF OTHER USERS, DONT CARE ABOUT QUOTAS
TLZ F,LOGF ;THIS COMES ON IF ANY STR IS OVER ITS QUOTA
SETZ S,
NOSTR1: SKIPN STRTAB(S)
JRST NOSTR2
SKIPN EXIST(S) ;SKIP IF UFD EXISTS
AOJA S,NOSTR1 ;NO UFD
PUSHJ P,QLST ;COMPLAIN TO USER IF OVER
CAILE B,0
TLO F,LOGF ;AND RING OUR CHIMES
AOJA S,NOSTR1
;HERE WHEN CHECKED QUOTAS ON ALL STR'S
NOSTR2: TLNE F,LOGF
JRST CONMS ;NO GOOD, MUST DELETE MORE FILES
;HERE IF OK TO PROCEED: EITHER UNDER QUOTA OR OTHER USERS
NOSTR4: SKIPL LINFLG ;SKIP IF LOG FILE NOT OPEN
CLOSE LOG, ;CLOSE LOG FILE
NOSTR3: MOVSI B,(SIXBIT .LGO.)
MOVE C,FPNIOW
HLRE A,C ;A= - LENGTH OF BLOCK TO WRITE
MOVNS A ;+ LENGTH
IFN 0,<HRLI A,0 ;VERSION NUMBER>
MOVEM A,LOGCAL ;STORE IN BLOCK
MOVE A,[XWD TCRWRF,B]
TMPCOR A, ;TRY TO CREATE TMPCOR FILE FOR LOGOUT
JRST WRTDSK ;NO, TRY DSK FILE
JRST GOLGO ;OK
WRTDSK: INIT DSK,17
SIXBIT .DSK.
0
JRST GOLGO
MOVE B,JOBNUM ;GET JOB NUMBER
PUSHJ P,SIXJBN ;CONVERT TO SIXBIT IN LH A
HRRI A,(SIXBIT .LGO.) ;RH=LGO
MOVSI B,(SIXBIT .TMP.)
SETZB C,D
ENTER DSK,A
JRST GOLGO ;STILL CANT DO IT, GIVE UP
MOVE T,FPNIOW
SETZ T+1,
OUTPUT DSK,T
CLOSE DSK,
GOLGO: MOVEI A,LGORBK
MOVE B,[RUN A,]
TLNN F,NOPHYU ;SKIP IF CANT DO PHYSICAL ONLY
TRO B,PHYUUO
XCT B ;RUN UUO TO LOGOUT
HALT
LGORBK: SIXBIT .SYS.
SIXBIT .LOGOUT.
0
0
0
0
SUBTTL SUBROUTINE TO CALL QUEUE
;SUBROUTINE TO CALL QUEUE
;SAVES F,P, AND BP
DOQUE: MOVEM F,SAVEF
MOVEM P,SAVEP
MOVEM BP,SAVEBP
MOVEI A,1 ;VALUE TO STORE IN CALL WORD
MOVEM A,LOGCAL
MOVE A,[XWD TOLO,LOCALL]
BLT A,LOCALL+ETOLO-TOLO ;MOVE CODE TO LOW SEG
MOVE A,[XWD NEWLOG,QOUCH]
MOVEM A,LOGTYP ;PTR TO OUTPUT CHAR ROUTINES
MOVE A,[SIXBIT .QUEUE.] ;NAME OF QUEUE HIGH SEG
MOVEM A,LOCALL+GSNAME-TOLO
MOVEI 13,LOCALL+GSDEV-TOLO
MOVE 14,KJOPTR ;GETSEG 13,
TLNN F,NOPHYU!PHYQUE ;SKIP IF NO PHYSICAL OR NOT PHYSICAL CALL TO QUE
TRO 14,PHYUUO
MOVE 15,DSKSER ;GET VALUE OF DISK SERVICE FIELD
JRST LOCALL ;GO TO LOW SEGMENT TO CALL QUEUE
TOLO: CAIL 15,QDSKSR ;SKIP IF MONITOR DOESNT HAVE QUEUE STUFF
XCT 14 ;GETSEG SYS:QUEUE
TRNA ; SKIP IF NO QUEUE ON SYS:
JRST LOCALL+TOLO1-TOLO ; ELSE, GO DO QUEUE WORK
JSR LOCALL+GETHI-TOLO ; GET KJOB HI SEG BACK
JRST NOQUE
TOLO1: MOVEI 1,RSTART+LOCALL-TOLO ;RESTART ADDR OF CONTROL C START
HRRM 1,.JBSA ;DURING QUEUE
MOVEI 1,INQUEF ;IN QUEUE FLAG
IORM 1,SAVEF ;SET FLAG FOR MESSAGES
MOVE 17,SAVEP ;RESTORE A PUSH DOWN PTR
SKIPA 1,.+1+LOCALL-TOLO
XWD LGLAST-LOGCAL+1,LOGCAL
PUSHJ 17,400010 ;TURN ON QUEUER
MOVE 1,LOGCAL
MOVE F,SAVEF
TLNN F,QUELOG ;SKIP IF SECOND TIME
MOVEM 1,LOGQUE ;NAME OF FIRST QUEUE REQUEST
TLNE F,QUELOG ;SKIP IF FIRST TIME
MOVEM 1,LOGQU1 ;NO, SAVE SECOND QUEUE REQUEST NAME
MOVSI 2,LNOQUE
ORM 2,LGOFLG ;TELL LOGOUT WE CALLED QUEUE
JSR LOCALL+GETHI-TOLO ;GET KJOB HIGH SEG BACK
MOVEI 2,KJOB
HRRM 2,.JBSA ;RESTORE NORMAL START ADDRESS
MOVEI F,INQUEF ;CLEAR IN QUEUE FLAG
ANDCAB F,SAVEF ;AND GET FLAGS IN F
JRST NOQUE1
GSDEV: SIXBIT .SYS.
GSNAME: 0
0
0
0
0
RSTART: TDZA 1,1 ;START AT START ADDR
MOVEI 1,1 ;OR +1 IN CASE OF CCL
ADDI 1,KJOB ;F=START ADDR DESIRED
MOVEM 1,LOCALL
JSR LOCALL+GETHI-TOLO ;GET KJOB HIGH SEG BACK
JRST @LOCALL
;SUBROUTINE TO GET KJOB HIGH SEGMENT
GETHI: 0 ;RETURN ADDRESS
SKIPA 13,LOCALL+.+1-TOLO
KJONAM: SIXBIT .KJOB.
MOVEM 13,LOCALL+GSNAME-TOLO
MOVEI 13,LOCALL+GSDEV-TOLO
SKIPA 14,LOCALL+.+1-TOLO
KJOPTR: GETSEG 13,
MOVE F,SAVEF
TLNN F,NOPHYU!PHYQUE ;SKIP IF DONT DO PHYSICAL CALL
TRO 14,PHYUUO
XCT 14 ;GETSEG SYS:KJOB TO GET OUR HIGH SEG BACK
HALT ;SIGH
ETOLO: JRST @LOCALL+GETHI-TOLO
NOQUE: SETZ 1, ;CLEAR QUEUE REQUEST NAME
TLNN F,QUELOG ;SKIP IF SECOND TIME
MOVEM 1,LOGQUE ;NAME OF FIRST QUEUE REQUEST
TLNE F,QUELOG ;SKIP IF FIRST TIME
MOVEM 1,LOGQU1 ;NO, SAVE SECOND QUEUE REQUEST NAME
NOQUE1: MOVE F,SAVEF
MOVE P,SAVEP
MOVE BP,SAVEBP
POPJ P,
SUBTTL STORAGE PRESERVED OVER CALL TO QUEUE
TCRLST: IOWD 200,TCRBUF
PDP: IOWD PDLEN,PDLIST
UU(TCRBUF,200)
U(TCRZER)
UU(PDLIST,PDLEN)
REPEAT 0,<
LOGCAL THROUGH DELBLK MUST BE THE SAME AS LOGOUT -
THIS IS A COMMUNICATION BLOCK>
U(LOGCAL)
U(LOGDEV)
UU(LOGPPN,.LNFPN)
U(LOGFIL)
U(LOGEXT)
U(SLIM1)
U(SLIM2)
U(LOGPAR)
U(LOGSEQ)
U(LOGTYP)
LGLAST==LOGTYP ;LAST PARAMETER TO BE PASSED TO QUEUE
U(LGOFLG)
U(LOGQUE)
U(LOGQU1)
U(SAVFIL)
U(SAVBLK)
U(DELFIL)
U(DELBLK)
REPEAT 0,<END OF COMMUNICATION BLOCK>
ETLG==DELBLK
U(OLDPRO) ;ORIGINAL UFD PROTECTION
U(NEWPRO) ;NEW PROTECTION ORIGINALLY = OLDPRO
U(DSKSER)
U(JOBNUM)
U(LINFLG)
UU(LOB,3)
UU(OBUF,203)
EOUCHL==316 ;*** MUST BE ENOUGH ROOM FOR TYPE CHAR ROUTINES
UU(OUCHLO,EOUCHL)
U(SAVEF)
U(SAVEBP)
U(SAVEP)
UU(TBUF,TTYBUF*2)
UU(TYIB,3)
UU(TYOB,3)
UU(UFDBUF,200)
IFG ETOLO-TOLO-177,<UU(...ZZ,ETOLO-TOLO-177)>
LOCALL==UFDBUF
FPNIOW: IOWD DELBLK-LOGCAL+1,LOGCAL
LOWCHR:!
PHASE OUCHLO
QOUCH: EXCH F,SAVEF ;RESTORE F FROM CALL TO QUEUE
PUSHJ P,OUCH ;OUTPUT CHAR
EXCH F,SAVEF ;RESTORE F AND ITS MEMORY
POPJ P,
NEWLOG: PUSH P,1 ;SAVE AC 1
PUSH P,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 P,2 ;RESTORE AC2
POP P,1 ;AND 1
POPJ 17,
MSG: HRLI M,440700 ;MESSAGE PRINTING ROUTINE.....
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: PUSH P,A ;SAVE AC'S USED
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,D+1
PUSH P,T
TLNN F,USELOG ;SKIP IF LOG FILE SPECIFIED
JRST TYO ;NO, USE TTY
MOVE A,LOGFIL
OR A,LOGDEV
JUMPE A,TYO ;IF BOTH LOG FILE AND DEV NOT SPECIFIED, USE TTY
SKIPL LINFLG ;SKIP IF LOG FILE NOT YET OPEN
JRST LOGO ;YES, GO AHEAD
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 TYO ;CANT OPEN, USE TTY
SETZB C,LINFLG ;NOTE LOG FILE IS OPEN, NEEDS TIME STAMP
PUSH P,.JBFF ;SAVE CURRENT JOBFF
MOVEI A,OBUF
MOVEM A,.JBFF
OUTBUF LOG,1 ;USE BUFFER WE KNOW WE HAVE
POP P,.JBFF ;AND RESTORE JOBFF
MOVEI D+1,FBMTRY ;TIMES TO RETRY IF FILE BEING MODIFIED
CLSL1A: MOVE A,LOGFIL
HLLZ B,LOGEXT
MOVE D,LOGPPN
LOOKUP LOG,A
TDZA T,T
HLRE T,D ;T=LENGTH OF FILE
MOVE D,LOGPPN ;RESET PPN
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)
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
JRST OUCHX ;EXIT
CLSLG4: TLZ F,USELOG ;DO NOT USE LOG FILE IF CAN'T OPEN
TYO: TLNE F,NTTYF ;TTY OUTPUT IMPOSSIBLE IF NO TTY PRESENT.
JRST OUCHX ;GIVE UP, POPPING EVERYTHING
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
OUCHX: POP P,T
POP P,D+1
POP P,D
POP P,C
POP P,B
POP P,A
CPOPJ: POPJ P,0
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
;SUBROUTINE TO OUTPUT LINE PREFIX FOR LOG FILE
;SAVES ALL AC'S EXCEPT CH
TIMSTP: AOS LINFLG ;NOTE NO TIME STAMP NEEDED NEXT TIME
TLNN F,USELOG ;SKIP IF LOG FILE FOR OUTPUT
POPJ P, ;NO NEED
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 MILLISECONDS
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,KKJOBM ;KJOB HEADER
TRNE F,INQUEF ;SKIP IF NOT IN QUEUE
MOVEI M,QKJOBM ;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
KKJOBM: ASCIZ . KJOB .
QKJOBM: ASCIZ . K-QUE .
IFG .-QOUCH-EOUCHL,<? ;ERROR IF NOT ENOUGH ROOM>
DEPHASE
SUBTTL SUBROUTINES
;SUBROUTINE TO SET UP FOR EXTENDED LOOKUP OF USER'S UFD
;VALUES LOOKBF=EXTENDED LOOKUP BLOCK
LKUFST: MOVE A,MFDPP
SKIPN DSKSER ;SKIP IF LEVEL D
JRST LKUFS1 ;NO, LEVEL C
MOVEM A,LOOKBF+EXLPPN ;PPN OF UFD'S
MOVEI A,EXLLEN-1 ;SET UP FOR EXTENDED LOOKUP OF USER'S UFD
MOVEM A,LOOKBF ;LENGTH OF ARGUMENT LIST
MOVE A,SVPJPG
MOVEM A,LOOKBF+EXLNAM ;USER'S PPN IS FILE NAME
MOVSI A,(SIXBIT .UFD.)
MOVEM A,LOOKBF+EXLEXT ;.UFD IS EXT
POPJ P,
LKUFS1: MOVEM A,LOOKBF+3 ;PPN
MOVE A,SVPJPG ;USER'S PPN IS NAME
MOVEM A,LOOKBF
MOVSI A,(SIXBIT .UFD.);UFD IS EXT
MOVEM A,LOOKBF+1
POPJ P,
;SUBROUTINE TO SET UP FOR LOOKUP OF NEXT USER FILE
;VALUES LOOKBF=EXTENDED LOOKUP BLOCK
; A-D=SHORT LOOKUP BLOCK
LKSET: PUSHJ P,RDUFD ;SET UP FOR LOOKUP OF NEXT USER FILE
POPJ P, ;NO MORE FILES, NON SKIP RETURN
JUMPE T,LKSET1 ;IGNORE IF FILE NAME IS 0
MOVEM T,LOOKBF+EXLNAM
MOVE A,T
PUSHJ P,RDUFD ;READ EXT
POPJ P,
HLLZM T,LOOKBF+EXLEXT
HLLZ B,T
MOVE T,SVPJPG
MOVEM T,LOOKBF+EXLPPN
MOVE D,T
MOVEI T,EXLALC
MOVEM T,LOOKBF
SETZM LOOKBF+EXLALC
SKIPE DSKSER ;SKIP IF LEVEL C
JRST CPOPJ1
MOVEM A,LOOKBF ;SET UP BOTH FOR SHORT LOOKUP FOR LEVEL C
MOVEM B,LOOKBF+1
MOVEM D,LOOKBF+3
JRST CPOPJ1
LKSET1: PUSHJ P,RDUFD ;IGNORE EXT IF 0 FILE NAME
POPJ P,
JRST LKSET
;SUBROUTINE TO READ THE NEXT WORD FROM CURRENT UFD
;ARGS RDHED=PTR TO CURRENT POSITION IN BLOCK
;VALUES T=NEXT WORD READ
RDUFD: SKIPGE T,RDHED
JRST RDUFD1
MOVE T,[IOWD 200,UFDBUF]
MOVEM T,RDHED
SETZM RDHED+1
INPUT UFD,RDHED
STATZ UFD,20000 ;SKIP IF NOT EOF
POPJ P, ;END OF UFD
STATZ UFD,740000 ;SKIP IF READ ERROR
PUSHJ P,UFDRER ;TELL USER ABOUT MESSAGE
RDUFD1: AOBJN T,.+1
MOVEM T,RDHED
MOVE T,(T)
JRST CPOPJ1
UFDRER: GETSTS UFD,N ;GET ERROR STATUS IN N
HRLM N,(P) ;SAVE ERROR BITS
TRZ N,740000 ;CLEAR ERROR BITS FOR SETSTS
HLRZ N,(P) ;RESTORE ERROR STATUS
PUSHJ P,CRLF
MOVEI CH,"?"
PUSHJ P,OUCH
MOVE A,STRTAB(S) ;GET NAME OF STR
TLNE F,STRF ;SKIP UNLESS USER SPECIFIED STRS
MOVE A,STRTB1(S)
PUSHJ P,SIXBPA
MOVEI M,[ASCIZ . UFD READ error, status = .]
PUSHJ P,MSG
PUSHJ P,OCTPRT
PJRST CRLF
;SUBROUTINE TO TYPE MESSAGE IF STR WHOSE INDEX IS IN S IS OVER ITS LOGGED OUT QUOTA
QLST: PUSHJ P,CHKOVR
JUMPLE B,CPOPJ
MOVEI CH,"?"
PUSHJ P,OUCH
PUSH P,B ;SAVE AMOUNT OVER
MOVE A,STRTAB(S) ;GET NAME OF STR
PUSHJ P,SIXBP ;TYPE IT
MOVEI M,[ASCIZ . Logged out quota .]
PUSHJ P,MSG
MOVE N,QUOTAO(S) ;QUOTA OUT
PUSHJ P,DECPRT
MOVEI M,[ASCIZ . exceeded by .]
PUSHJ P,MSG
POP P,N ;AMOUNT OVER
PUSHJ P,DECPRT
MOVEI M,[ASCIZ . blocks.]
PUSHJ P,MSG
PJRST CRLF
CHKOVR: SETZ B,
SKIPN NOACC(S) ;SKIP IF NO ACCESSES, ASSUME OK
SKIPN A,STRTAB(S) ;SKIP IF THIS IS AN STR
POPJ P, ;NO, EXIT
MOVEM A,CHRBUF
MOVE A,[XWD USRTAL+1,CHRBUF]
MOVE N,[DSKCHR A,]
TLNN F,NOPHYU ;SKIP IF CANT DO PHYSICAL ONLY
TRO N,PHYUUO
XCT N ;REAL DSKCHR
POPJ P,
MOVE A,CHRBUF+USRTAL
HRLZI N,400000
CAMN N,A ;SKIP IF ACCESSES TO AREA
POPJ P,
MOVE B,QUOTAF(S)
IFN RSRVD,<ADD B,QUOTAR(S) ; ADD RESERVED QUOTA>
SUB B,QUOTAO(S)
SUB B,A
POPJ P,
;SUBROUTINE TO DELETE A FILE IF IT IS A TEMP FILE
;ARGS LOOKBF=EXTENDED LOOKUP BLOCK
;RETURN POPJ IF FILE WAS DELETED
; CPOPJ1 IF NOT
TMPDEL: MOVSI C,-.TEMPL ;LENGTH OF LIST OF TEMP EXTENSIONS
HLLZ A,B ;EXT
CAMN A,.TEMP(C) ;SKIP IF DOESN'T MATCH A TEMP EXT
JRST FILDEL ;YES, DELETE TEMP FILE
AOBJN C,.-2 ;NO, TRY NEXT TEMP EXT
CPOPJ1: AOS (P)
POPJ P,
FILDEL: AOS DELFIL ;COUNT FILES DELETED
SKIPE A,LOOKBF+EXLALC ;SKIP IF NOT YET DONE EXTENDED LOOKUP
JRST FILDL1 ;YES, A=BLOCKS ALLOCATED FOR FILE
FILDLA: LOOKUP DSK,LOOKBF ;EXTENDED LOOKUP
JFCL
MOVE A,LOOKBF+EXLALC ;BLOCKS ALLOCATED FOR FILE
SKIPE DSKSER ;SKIP IF LEVEL C
JRST FILDL1
HLRE A,LOOKBF+3 ;GET LENGTH OF FILE
PUSHJ P,FILSIZ ;COMPUTE SIZE OF FILE IN BLOCKS
FILDL1: ADDM A,DELBLK ;COUNT BLOCKS DELETED
LDB C,OWNACC ;GET OWNER'S ACCESS CODE IF LEVEL D
SKIPE DSKSER ;DO NOTHING IF LEVEL C
CAIGE C,2 ;SKIP IF CANT DELETE
JRST FILDL3 ;OK, GO AHEAD
MOVEI C,1
DPB C,OWNACC
RENAME DSK,LOOKBF ;RENAME TO SOMETHING DELETEABLE
JFCL
FILDL3: SETZB A,B
SETZB C,D
RENAME DSK,A
JRST CLGTRY ;TRAP UFD PROTECTION FAILURES
TLNN F,LISDEL ;SKIP IF SUPPOSED TO LIST DELETED FILES
POPJ P, ;NO, ALL DONE
TLOE F,LIDLFG ;SKIP IF NO FILES DELETED YET
JRST FILDL2 ;MESSAGE ALREADY OUTPUT
MOVEI M,[ASCIZ .Deleted:
.]
PUSHJ P,MSG
FILDL2: SKIPE C,DSKSER ;SKIP IF LEVEL C AND USE THE 0
MOVEI C,EXLNAM ;OFFSET FOR LEVEL D
MOVE A,LOOKBF(C)
PUSHJ P,SIXBP ;TYPE FILE NAME
MOVEI CH,"."
PUSHJ P,OUCH
HLLZ A,LOOKBF+1(C) ;AND EXT
PUSHJ P,SIXBP
PJRST CRLF
;IF THE DELETE ATTEMPT FAILS DUE TO A PROTECTION FAILURE, IT IS
;PROBABLY DUE TO A STRANGE PROTECTION CODE FOR THE UFD. IF IT IS
;A CONTROLLED SUBJOB, CHANGE THE UFD PROTECTION AND TRY THE DELETE
;AGAIN. ELSE, COMPLAIN AND EXIT.
;
CLGTRY: HRRZS B ;ISOLATE THE ERROR CODE
CAIE B,2 ;IS ERROR A PROTECTION FAILURE?
POPJ P, ;NO, NOTHING TO DO
TLNE F,TTYPTY ;IS THIS A CONTROLLED JOB?
JRST CLGTR1 ;YES, GO DO PROPER RENAMES
MOVEI CH,(SIXBIT .?.) ;SET UP AS FATAL ERROR
PUSHJ P,OUCH ;PRINT ONE CHARACTER "?"
MOVE A,STRTAB(S) ;NO, GET NAME OF THE STR
TLNE F,STRF ;IS STR USER SPECIFIED?
MOVE A,STRTB1(S) ;YES, GET STR FROM APPROPRIATE LIST
PUSHJ P,SIXBPA ;TYPE STR NAME
MOVEI M,[ASCIZ .: apparent UFD protection failure
.]
PUSHJ P,MSG ;TELL USER OF PROBLEM
EXIT ;MAKE HIM TRY AGAIN
CLGTR1: MOVE A,SVPJPG ;GET USER'S PPN
MOVSI B,(SIXBIT .UFD.);MAKE UFD EXTENSION
MOVE D,MFDPP ;GET MFD PPN
MOVE C,OLDPRO ;GET ORIGINAL PROTECTION
TLO C,400000 ;CHANGE TO REASONABLE PROTECTION
RENAME UFD,A ;DO IT
POPJ P, ; CAN'T WIN 'EM ALL
MOVEM C,NEWPRO ;SAVE THE NEW PROTECTION
JRST FILDL3 ;GO AND TRY DELETE AGAIN
;SUBROUTINE TO COMPUTE SIZE OF FILE IN BLOCKS FROM LOOKUP RETURN
;ARGS A=LOOKUP RETURN AFTER HLRE
;VALUES A=LENGTH IN BLOCKS
FILSIZ: JUMPGE A,CPOPJ ;JUMP IF ALREADY BLOCKS
MOVNS A ;MAKE POSITIVE WORDS
ADDI A,177
LSH A,-7 ;CONVERT TO BLOCKS
POPJ P,
FILPRS: LDB T,OWNACC ;GET OWNERS ACCESS CODE
SKIPN DSKSER
LSH T,-2
JUMPG T,CPOPJ ;EXIT IF ALREADY PRESERVED
ADDI T,1 ;PRESERVE, MAKE GT 0
SKIPE DSKSER ;SKIP IF LEVEL C
DPB T,OWNACC ;PRESERVE FILE
SKIPN DSKSER ;SKIP IF LEVEL D
DPB T,COWNAC ;STORE LEVEL C PRESERVE BIT
RENAME DSK,LOOKBF
POPJ P,
POPJ P,
PRNTFL: MOVE A,LOOKBF+EXLNAM ;FILE NAME
SKIPN DSKSER ;SKIP IF LEVEL D
MOVE A,LOOKBF ;LEVEL C NAME
PUSHJ P,SIXBP ;TYPE NAME
HLLZ A,LOOKBF+EXLEXT ;SPACE IF NO EXT
SKIPN DSKSER ;SKIP IF LEVEL D
HLLZ A,LOOKBF+1 ;LEVEL C EXT
MOVEI CH," "
JUMPE A,.+2
MOVEI CH,"." ;PERIOD IF EXT
PUSHJ P,OUCH
PUSHJ P,SIXBP ;TYPE EXT
MOVEI M,LKFLMG ;TELL USER IF LOOKUP FAILED
TLNE F,NGLOOK
PJRST MSG ;IT DID
MOVEI CH,LANGLB ;NO, GO ON WITH PROTECTION
PUSHJ P,OUCH
LDB N,[POINT 9,LOOKBF+EXLATT,8]
SKIPN DSKSER ;SKIP IF LEVEL D
LDB N,[POINT 9,LOOKBF+2,8] ;LEVEL C PROTECTION
PUSHJ P,OCTPR3
MOVEI CH,RANGLB
PUSHJ P,OUCH
PUSHJ P,PR3SPC
MOVE N,LOOKBF+EXLALC ;NUMBER OF BLOCKS ALLOCATED
SKIPE DSKSER ;SKIP IF LEVEL C
JRST PRNTF1 ;ALL SET
HLRE N,LOOKBF+3 ;LENGTH OF FILE
JUMPGE N,PRNTF1 ;JUMP IF ALREADY BLOCKS
MOVNS N
ADDI N,177
LSH N,-7 ;CONVERT TO BLOCKS
PRNTF1: PUSHJ P,DECPRT
MOVEI M,BLKMSG
PJRST MSG
;SUBROUTINE TO HELP PREVENT MISTAKES BY ASKING A QUESTION
;ARGS A=COMMAND (1 ASCII CHAR) THAT FORCED CALL TO THIS ROUTINE
;RETURN CPOPJ IF ANSWER NOT Y
; CPOPJ1 IF ANSWER IS Y
;ENTER AT MAKSU1 IF ONLY ASK IF OTHER USERS OR PROJECT 1
MAKSU1: MOVEI M,[ASCIZ .Project 1
.]
MOVE T,SVPJPG ;PPN
TLNN T,-2 ;SKIP IF NOT PROJECT 1
JRST MAKSU2 ;YES, COMPLAIN ABOUT THIS
MOVEI M,OTHUSM ;OTHER JOBS SAME PPN MESSAGE
TLNN F,DUPF ;SKIP IF OTHER USERS
JRST CPOPJ1 ;OK OF NOT ONE OF THOSE
MAKSU2: TLNE F,USEBUF ;SKIP IF NOT KJOB LINE
JRST MAKSUR ;OK BUT REQUIRE TWO INPUTS
TLNN F,TTYPTY ;SKIP IF NOT PTY
JRST CPOPJ1 ;PTY AND NOT KJOB LINE IS PROBABLY OLD BATCH
PUSHJ P,LTMSG ;TYPE TO BOTH LOG FILE AND TTY
MAKSUR: SETZ T, ;CLEAR AC TO CONTAIN RESPONSE
TLNE F,USEBUF ;SKIP IF NOT KJOB LINE
JRST MAKSUA ;DONT TYPE MESSAGE BUT DO REQUIRE TWO INPUTS
MAKSUB: MOVEI M,[ASCIZ .Delete .]
PUSHJ P,LTMSG ;OUTPUT COMMON DELETE MESSAGE
MOVSI B,-MSGLEN ;GET NUMBER OF DELETION TYPES
HLRZ C,MSGLST(B) ;GET A POSSIBLE REASON FOR MESSAGE
CAIE A,(C) ;IS THIS THE REASON WE'RE HERE?
AOBJN B,.-2 ;NO,GO CHECK FOR MEXT POSSIBILITY
HRRZ M,MSGLST(B) ;YES, GET FILE TYPE MESSAGE
PUSHJ P,LTMSG ;SEND TO USER
MOVEI M,[ASCIZ . files? .]
PUSHJ P,LTMSG ;FINISH QUESTION
MAKSUA: PUSHJ P,TYI1 ;READ RESPONSE
JRST MAKSUB ;BUFFER RAN OUT,ASK USER AT TTY
TLNE F,USEBUF ;SKIP IF ASKING REAL USER
CAIE CH,(A) ;IF FROM BUFFER ACCEPT REPEAT OF CHAR
CAIN CH,"Y" ;IS ANSWER YES?
AOS (P) ;YES, SET UP SKIP, RETURN
MAKSUC: PUSHJ P,NOTBRK ;SCAN TO BREAK CHARACTER
CAIN CH,CR ;SKIP IF NOT <CR>, BUT BREAK CHAR
PUSHJ P,TYI1
POPJ P,
JRST MAKSUC
MSGLST:
XWD "D",SURED
XWD "K",SUREK
XWD "P",SUREP
XWD "S",SURES
MSGLEN=.-MSGLST
SUREW ;INSURES SOME OUTPUT EVEN ON ERROR
SURED: ASCIZ /all/
SUREK: ASCIZ /unpreserved/
SUREP: ;USE SAME MESSAGE AS S
SURES: ASCIZ /temp/
SUREW: ASCIZ /what/
;SUBROUTINE TO TYPE A MESSAGE TO BOTH LOG FILE AND TTY
;ARGS M=ADDR OF MESSAGE
LTMSG: HRLM M,(P) ;SAVE ADDR OF MESSAGE
PUSHJ P,MSG ;TYPE MESSAGE
TLNN F,USELOG ;SKIP IF THAT WENT TO LOG FILE
JRST LTMSG1 ;NO, JUST DO OUTPUT
TLZ F,USELOG ;CLEAR LOG FILE SO WILL GO TO TTY TOO
HLRZ M,(P) ;RESTORE ADDR OF MESSAGE
PUSHJ P,MSG ;TYPE TO USER TOO
TLO F,USELOG ;RESET LOG FILE BIT
LTMSG1: OUTPUT TTY, ;MAKE SURE IT GETS OUT
POPJ P,
;SUBROUTINE TO CREATE A MASK ON ONES IN C FOR CHARS IN A
;ARGS A=SIXBIT CHARS
;VALUES C=MASK
GETMSK: SETZ C, ;ASSUME NO CHARS
JUMPE A,CPOPJ ;WE WERE RIGHT
TLO C,770000 ;NO, MUST BE AT LEAST 1
PUSH P,A ;SAVE A
GETMS1: LSH A,6 ;GET RID OF THE CHAR WE KNOW
JUMPE A,APOPJ ;QUIT NOW IF THATS ALL
ASH C,-6 ;MUST BE AT LEAST ONE MORE, INCREASE MASK
JRST GETMS1
;SUBROUTINE TO DECLARE INBUF AND OUTBUF BUFFER FOR TTY TO MAKE SURE IN OUR CORE
;OTHERWISE QUEUE MIGHT DO THE FIRST OUTPUT AFTER IT HAD TEMPORARILY INCREASED CORE
OUTBFT: PUSH P,.JBFF ;SAVE CURRENT .JBFF
MOVEI A,TBUF ;ADDR OF OUR BUFFER
MOVEM A,.JBFF ;FORCE TTY BUFFERS TO BE WHERE WE WANT THEM
INBUF TTY,1 ;INPUT BUFFER
OUTBUF TTY,1 ;OUTPUT BUFFER
ADDI A,TTYBUF*2 ;MAXIMUM CAN ALLOCATE FOR TTY
CAMGE A,.JBFF ;SKIP IF OK
JRST OUTBFE ;ERROR
POP P,.JBFF ;RESTORE JOBFF
POPJ P,
OUTBFE: MOVEI M,[ASCIZ .
? Please deassign TTY
.]
OUTSTR (M) ;MAKE SURE GOES TO PHYSICAL TTY
TLNE F,USELOG ;SKIP IF NO LOG FILE
PUSHJ P,MSG ;YES, TYPE IN LOG FILE
EXIT
;SUBROUTINE TO INPUT CHARS TO 1ST NON-ALPHANUMERIC
;VALUES A=SIXBIT CHARS
; CH=TERMINATING CHAR (ASCII)
; BREAK BIT IN LH F=1 IF TERM CHAR IS BREAK CHAR
SIXAN: MOVE B,[POINT 6,A]
SETZ A,
PUSHJ P,SST
JRST SIXAN3
SIXAN1: PUSHJ P,TYI1 ;READ NEXT CHAR
TLO F,BREAK
SIXAN3: CAIL CH,"0"
CAILE CH,"9"
JRST .+2
JRST SIXAN2
CAIL CH,"A"
CAILE CH,"Z"
POPJ P,
SIXAN2: SUBI CH,40
TLNE B,770000
IDPB CH,B
JRST SIXAN1
;SUBROUTINE TO SKIP SPACES PRECEEDING AN ARG
;VALUES CH=1ST NON-BLANK CHAR
; BREAK BIT IN LH F=1 IF CH IS BREAK CHAR
SST: PUSHJ P,TYI1 ;READ NEXT CHAR
TLO F,BREAK
CAIE CH," "
CAIN CH," "
JRST SST ;IGNORE SPACES AND TABS
POPJ P,
;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,
;SUBROUTINE TO READ A DECIMAL NUMBER
;VALUES A=DECIMAL NUMBER
DECIN: SETZ A,
DECIN1: PUSHJ P,TYI1
TLO F,BREAK
CAIL CH,"0"
CAILE CH,"9"
POPJ P, ;EXIT IF NOT A NUMBER
IMULI A,^D10
ADDI A,-"0"(CH)
JRST DECIN1
;SUBROUTINE TO READ AN OCTAL NUMBER
;VALUES A=OCTAL NUMBER
OCTIN: SETZ A,
OCTIN1: PUSHJ P,TYI1
TLO F,BREAK
CAIL CH,"0"
CAILE CH,"7"
POPJ P,
LSH A,3
ADDI A,-60(CH)
JRST OCTIN1
TYIX: SETZ T,
TYIX1: PUSHJ P,TYI ;GET NEXT CHAR FROM USER
POPJ P,
CAIE CH,ALTMOD
CAIN CH,LF
JRST CPOPJ1 ;EXIT NOW IF LF OR ALTMODE
CAIN T,0 ;IGNORE IF WE ALREADY HAVE THE FIRST CHAR
CAIG CH,40 ;ALSO BREAK CHARS
JRST TYIX1
MOVE T,CH
JRST TYIX1
TYI1: TLNN F,USEBUF ;SKIP IF USING BUFFER
JRST TYI ;NO, NORMAL TTY INPUT
ILDB CH,BP ;GET NEXT CHAR FROM BUFFER
JUMPN CH,TYIGO ;EXIT IF REAL CHAR
TLZA F,USEBUF ;BUFFER IS NOW EMPTY
APOPJ: POP P,A ;THIS DOESNT REALLY BELONG HERE, BUT ...
POPJ P, ;CLUE THEM IN
TYI: SOSLE TYIB+2 ;STANDARD TELETYPE CHARACTER INPUT ROUTINE.....
JRST TYIOK
INPUT TTY,0
TYIOK: ILDB CH,TYIB+1 ;PICKUP NEXT CHARACTER
JUMPE CH,TYI ;IGNORE NULL CHARACTERS
CAIN CH,177
JRST TYI
TYIGO: CAIL CH,ALTMD
MOVEI CH,ALTMOD
CAIG CH,CR
CAIGE CH,LF
CAIN CH,ALTMOD
TLO F,BREAK
CAIL CH,140
TRZ CH,40
TLNN F,NEWSCN ;SKIP IF NEW SCANNER SERVICE
CAIE CH,ALTMOD ;ALTMODE IS CONTROL C IN OLD
CAIN CH,CNTRLC
EXIT ;CONTROL C IN JACCT HAPPENS TO BE ON
CAIN CH,CNTRLZ ; CHECK FOR CONTROL Z
EXIT ; EXIT IF IT IS
TLNE F,USELOG ;SKIP IF WRITING IN LOG FILE
TLNE F,USEBUF ;SKIP IF NOT READING CHARS FROM BUFFER
JRST CPOPJ1 ;YES, ALREADY TYPED
TLNN F,NOLOGC ;SKIP IF NOT TO INCLUDE IN LOG FILE
PUSHJ P,OUCH ;RECORD INPUT CHARS IN LOG FILE TOO
JRST CPOPJ1
NOTBRK: CAIG CH,CR ; IF CHARACTER IS <CR>...
CAIGE CH,LF ; OR <LF> . . .
CAIN CH,ALTMOD ; OR ALT MODE (ESC)
POPJ P, ; YES, DO ERROR RETURN
JRST CPOPJ1 ; ELSE, TAKE NORMAL RETURN (RTN+1)
;TYPE-OUT ROUTINES FOR NUMBERS, TEXT MESSAGES, ETC.
SIXBPA: TLOA F,BPAF ;STOP AT FIRST NULL
SIXBP: TLZ F,BPAF ;OUTPUT ALL 6 CHARS
MOVE B,[XWD 440600,A];SIXBIT PRINT ROUTINE....
SIXBP1: ILDB CH,B
TLNE F,BPAF
JUMPE CH,CPOPJ
ADDI CH,40 ;CONVERT SIXBIT TO ASCII
PUSHJ P,OUCH
TLNE B,770000
JRST SIXBP1 ;PRINT 6 CHARACTERS FROM ACCUMULATOR A
POPJ P,0
OCTPR3: MOVEI CH,"0" ;PRINT AT LEAST 3 OCTAL DIGITS
CAIG N,77 ; (FORCE ONE OR TWO LEADING ZEROS IF NEEDED)
PUSHJ P,OUCH
CAIG N,7
PUSHJ P,OUCH
JRST OCTPRT ;OCTAL PRINT RTN WILL PRINT AT LEAST ONE DIGIT.
PR3SPC: PUSHJ P,PRSPC ;INSERT 3 SPACES
PR2SPC: PUSHJ P,PRSPC ;INSERT 2 SPACES
PRSPC: MOVEI CH,SPACE ;TYPE A SPACE
PJRST OUCH ;OUTPUT A SPACE
CRLF: JSP M,MSG ;PRINT CARRIAGE RETURN, LINE FEED.
ASCIZ /
/
CONFM: ASCIZ .Confirm: .
LKFLMG: ASCIZ .LOOKUP failed
.
BLKMSG: ASCIZ /. Blks /
OTHUSM: ASCIZ .Other jobs same PPN
.
NOLOGN: ASCIZ .
? May not logout with logical names for File Structures.
SUBTTL HELP TEXTS
HMES1: ASCIZ .
In response to a file name, type
P to preserve it
S to save it
K to delete it
Q to report if over quota for this STR
E to skip to next STR and save this file if
below quota for this STR
H to type this text
.
HMES: ASCIZ \
In response to CONFIRM:,type one of: BDFHIKLPQSUWX
B to perform algorithm to get below quota
D to delete all files
(asks Delete all files?, type Y or <CR>)
F to try fast logout by leaving all files on DSK
H to type this text
I to individually determine what to do with all files
after each file name is typed out, type one of: EKPQS,
or H to get more help
K to delete all unpreserved files
L to list all files
P to preserve all except temp files
Q to report if over quota
S to save all except temp files
U same as I but automatically preserve files already preserved
W to list files when deleted
X to suppress listing deleted files(default)
If a letter is followed by a space and a list of File Structures
only those specified will be affected by the command.
Confirm will be typed again.
Note: file size is no. of blocks allocated which may be larger than the
no. of blocks written (DIRECT command).
A file is preserved if its access code is GE 100
\
HMES2: ASCIZ \
To log off system, type KJOB optionally followed by:
<logdev:file.ext[ppn]>=/<confirm switch><str list>/<queue switch>etc...
If the log file is not specified, or not a disk or spooled device,
TTY is used.
Confirm switches are taken from the set: BDFIKLPQSUWX
Confirm: will be typed. Respond with H<CR>.
Queue switches are:
/Z:n specifies degree of queueing:
0 suppress QUEUE(default if no spool bits set)
1 queue log file only
2 queue log and spooled output(default if any spool bits set)
3 as 2, plus *.LST
4 as 3, plus defered requests
/VL:n page limit for LPT
/VC:n card limit for CDP
/VT:n tape limit (feet) for PTP
/VP:n time limit (minutes) for PLT
/VR:n request priority
/VS:n sequence number for request
/VD:v specifies disposition of log file, where v is:
D delete log after printing
P preserve log
R rename log into QUEUE area and delete after printing(default)
\
SUBTTL STORAGE AND DATA
OWNACC: POINT OWSPRV,LOOKBF+EXLATT,OWNPRV ;BYTE PTR FOR OWNERS ACCESS CODE
COWNAC: POINT 1,LOOKBF+2,0
MFDPP: XWD 1,1
SYSPPX: XWD 1,4
U(BFBKS)
UU(CHRBUF,CHRLEN)
UU(EXIST,MAXFS)
UU(LOOKBF,EXLLEN+1)
UU(NOACC,MAXFS)
U(OKCNT)
UU(QUOTAF,MAXFS)
UU(QUOTAO,MAXFS)
UU(QUOTAR,MAXFS)
UU(RDHED,2)
UU(STRTAB,MAXFS)
UU(STRTB1,MAXFS)
U(SVPJPG)
U(SYSPPN)
U(TSAV)
U(FZSW)
LIT
END KJOB