github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-28 09:07:42 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/ufdset/ufdset.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

2037 lines
67 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
UNIVERSAL UFDPRM - Parameter file for UFDSET
SUBTTL D. Mastrovito /DPM 26-FEB-86
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1983,1984,1985,1986,1988.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
; Assembly instructions
;
; .COMPILE UFDSET.MAC
;
; Produces UFDPRM.UNV and UFDSET.REL
; Version numbers
;
UFDVER==1 ;MAJOR VERSION
UFDMIN==0 ;MINOR VERSION
UFDEDT==45 ;EDIT LEVEL
UFDWHO==0 ;WHO DID IT
%%UFDS==<BYTE(3)UFDWHO(9)UFDVER(6)UFDMIN(18)UFDEDT>
SUBTTL Edit history
; RCOMP edit History
;
; 1 Initial subroutine to do recomputes for PLRDSK.
;
; 2 Add super mode input to read ribs to speed up things.
;
; 3 Routine FINISH wasn't calling the user supplied typeout subroutine.
;
; 4 Append STR:[PPN] to errors generated by ERRPRC.
;
; 5 Remove extra instruction in routine LOKUFD.
;
; 6 Add routines for search list manipulation and UFD creation.
;
;
; UFDSET edit history
;
;
; 7 Create UFDSET from the remains of RCOMP.
;
; 10 Remove edit 4, it was a bad idea. Enhance text generation code.
;
; 11 Fix bugs in single access code. Remove error code UFCSU% (Can't
; set UFD interlock) and issue a warning instead. We can't wait for
; the interlock since PULSAR shouldn't block. If a program really needs
; this functionality, it should handle the interlock itself and lite
; the UF.NLK bit.
;
; 12 Add functions .UFDASL and .UFRSL plus about a dozen lines of code
; to handle system search list changes.
;
; 13 Fix obscrure PATH block pointer problem caused by 702.
;
; 14 Make sure the job and PPN match for MOUNT and DISMOUNT functions.
;
; 15 Fix off-by-one bug in S/L definition size that showed up only when
; a user dismounted a disk when his S/L was full.
;
; 16 Release any open channels after processing errors at ERRPRC.
;
; 17 Close off UFD channel if create fails to find a UFD.
;
; 20 Don't try to use a released channel when creating UFDs.
;
; 21 Fix up quota checking for zero block logged out quotas.
;
; 22 Enhancementes required for use in LOGIN:
; 1) Clear RP.ERR in the UFD if no error bits found in file RIBs
; during recomputing pass.
; 2) Add functions .UFAJL and .UFRJL to only add and remove structures
; from a job search list. Needed for the SWITCH.INI handling.
; 3) Add functions .UFSUI and .UFCUI to set and clear the UFD interlock.
; 4) Set current date/time in the RIB and return it in .UFCDT
; and .UFCTM words.
;
; 23 Move 'File errors exist' message to the rename code, so if a recomp
; is done and no errors exist, the message won't be generated. Also
; setup PATH block before attempting to a super I/O LOOKUP. This will
; allow the correct filespec typeout to occur if file errors exist.
;
; 24 Clear out LKPFIL @SETFIL to prevent junk dates, protections, etc.
; from being set on ENTERs.
;
; 25 Some files don't get quota checked. MOVX instead of a MOVE.
;
; 26 Fix bad test that allowed anyone to dismount a structure, even
; if they were over quota.
;
; 27 RIBUSD can be zero for a non-empty UFD if the monitor hasn't
; rewritten the RIB yet. Don't blindly try to delete a UFD
; without first doing a DISK. UUO to see if the monitor really
; knows the number of blocks used.
;
; 30 Correct check of "own" job number and fix off by one bug in
; GOBSTR loop when searching for other jobs in the recomp checking
; code. Give UFDSET a real version number too.
;
; 31 Function .UFRDU forgot to LOOKUP the UFD.
;
; 32 Files of the form nnnTEC.TMP print incorrectly.
;
; 33 Fix incorrect block number calculation when doing super I/O on a
; unit whose cluster size does not divide evenly into the unit size.
;
; 34 Correct test for blocks in use before attempting to delete a UFD
; on a dismount.
;
; 35 Only change RIBUSD when recomputing disk usage.
;
; 36 Avoid RENAME error 26 by renaming the UFD before defining the
; search list which could set the structure status to NOWRITE.
;
; 37 A job can go over quota if we mount a structure which is already
; in the job's search list because the previous value in RIBUSD
; gets written back into the RIB instead of the actual number of
; blocks in use. Check UFBTAL.
;
; 40 Do Copyrights.
;
; 41 Add support for UFD operation on not logged-in UFDs. Needed to
; make MX work correctly. This also makes UFDSET usable by SPRINT
; if we ever get ambitious.
;
; 42 If there is another job with the same PPN and the same structure
; in its search list, then don't do quota checking, always set
; RIPLOG in the UFD, and never delete the UFD.
;
; 43 Be more graceful about UFD interlock handling. If we can't get the
; interlock, sleep for a while, then try again. Add parameters LOKINT
; to hold the interval between retries, and LOKLIM as the number of
; minutes to keep retrying for the interlock.
;
; 44 Preserve structure's write protect status if/when redefining file
; structure status in DEFJSL.
;
; 45 Edit 44 went too far: don't set RIPLOG just because there are
; other jobs with the same PPN and the same structure. If UF.IBP
; (in behalf of another PPN) is set and UF.LGI (logging in: set
; RIPLOG) and UF.LGO (logging out: clear RIPLOG) are both clear,
; then do nothing, even for .UFMNT (mount) and .UFDMO (dismount).
; As always, if there are other users with the same PPN using the
; same structure, don't clear RIPLOG for .UFDMO (dismount).
;
;End of edit history
SUBTTL Calling sequence and program interface
; Call: MOVE T1,address of argument block
; PUSHJ P,.UFD##
; <non-skip>
; <skip>
;
; Non-skip: An error has occured. The error code is stored
; in the argument block.
;
; Skip: The requested operations performed and argument
; block updated where necessary.
;
; Argument block
;
RELOC 0
PHASE 0
.UFFLG:! BLOCK 1 ;FLAG WORD
UF.LGI==1B0 ;ALWAYS SET LOGGED IN (TURN ON RIPLOG)
UF.LGO==1B1 ;ALWAYS SET LOGGED OUT (TURN OFF RIPLOG)
UF.NLK==1B2 ;DON'T INTERLOCK THE UFD (CALLER ALREADY DID)
UF.ARD==1B3 ;ALWAYS RECOMPUTE DISK USAGE
UF.NRD==1B4 ;NEVER RECOMPUTE DISK USAGE
UF.PSL==1B5 ;ADD TO PASSIVE SEARCH LIST
UF.SIN==1B6 ;MOUNT SINGLE ACCESS
UF.NOQ==1B7 ;DON'T DO QUOTA CHECKING
UF.TSP==1B8 ;TYPE STRUCTURE AND PPN IN QUOTA MESSAGE
UF.NUE==1B9 ;NO UFD EXISTS (RETURNED BY UFDSET)
UF.WLD==1B10 ;GENERATE A UNIQUE WILD PROGRAMMER NUMBER [10,#]
UF.NDL==1B11 ;RIPNDL IS TURNED ON FOR THIS UFD
UF.AIS==1B12 ;STRUCTURE IS ALREADY IN S/L (FOR LOGIN)
UF.IBP==1B13 ;IN BEHALF OF ANOTHER PPN
UF.FNC==17B35 ;FUNCTION CODE
.UFMNT==1 ;MOUNT
.UFDMO==2 ;DISMOUNT
.UFRDU==3 ;RECOMPUTE
.UFASL==4 ;ADD STR TO SSL
.UFRSL==5 ;REMOVE STR FROM SSL
.UFAJL==6 ;ADD STR TO JSL
.UFRJL==7 ;REMOVE STR FROM JSL
.UFSUI==10 ;SET UFD INTERLOCK
.UFCUI==11 ;CLEAR UFD INTERLOCK
.UFMAX==.UFCUI ;MAXIMUM FUNCTION CODE
.UFSTR:! BLOCK 1 ;SIXBIT STRUCTURE NAME
.UFPPN:! BLOCK 1 ;PPN
.UFJOB:! BLOCK 1 ;JOB NUMBER
.UFPRO:! BLOCK 1 ;UFD PROTECTION TO SET (RIGHT JUSTIFIED)
.UFDED:! BLOCK 1 ;DIRECTORY EXPIRATION DATE TO SET
.UFQTF:! BLOCK 1 ;FCFS LOGGED-IN QUOTA
.UFQTO:! BLOCK 1 ;LOGGED-OUT QUOTA
.UFQTR:! BLOCK 1 ;RESERVED QUOTA
.UFSTS:! BLOCK 1 ;FILE STRUCTURE STATUS BITS (FROM AUXACC)
.UFUSD:! BLOCK 1 ;BLOCKS USED
.UFLOK:! BLOCK 1 ;LH:= # SECS TO WAIT FOR INTERLOCK, RH:= # SECS FOR MSG
.UFCDT:! BLOCK 1 ;UFD CREATION DATE IN 15 BIT FORMAT
.UFCTM:! BLOCK 1 ;UFD CREATION TIME IN MINUTES SINCE MIDNIGHT
.UFERR:! BLOCK 1 ;ERROR CODE RETURNED ON FAILURE
.UFTYO:! BLOCK 1 ;ADDRESS OF TYPE OUT ROUTINE
.UFPFX:! BLOCK 1 ;LH:= SEVERITY CHARACTER, RH:= SIXBIT PREFIX
.UFTXT:! BLOCK 1 ;ADDRESS OF TEXT
.UFSIZ:! ;SIZE OF BLOCK
DEPHASE
RELOC 0
; Error codes
;
UFIDV%==1 ;ILLEGAL DEVICE
UFISN%==2 ;IMPROPER STRUCTURE NAME
UFIOE%==3 ;DIRECTORY I/O ERROR
UFCAD%==4 ;CAN'T ACCESS DIRECTORY TO RECOMPUTE DISK USAGE
UFLFU%==5 ;LOOKUP FAILED FOR UFD DURING UPDATE
UFRFU%==6 ;RENAME FAILED FOR UFD DURING UPDATE
UFCRS%==7 ;CAN'T READ SEARCH LIST
UFIFC%==10 ;ILLEGAL FUNCTION CODE
UFEFU%==11 ;ENTER FAILED FOR UFD
UFCCS%==12 ;CAN'T CHANGE SEARCH LIST
UFCSO%==13 ;CAN'T RESET ORIGINAL S/L AFTER SINGLE ACCESS FAILED
UFCSS%==14 ;CAN'T MOUNT STRUCTURE SINGLE ACCESS
UFSND%==15 ;STRUCTURE NOT DISMOUNTED
UFUBT%==16 ;UFD INTERLOCK IS BUSY FOR TOO LONG
UFUIC%==17 ;UFD INTERLOCK CANNOT BE CLEARED
UFPGF%==20 ;PROGRAMMER NUMBER GENERATION FAILED
PRGEND
TITLE UFDSET - Perform UFD and search list operations
SALL ;FOR CLEAN LISTINGS
.DIRECT FLBLST ;FOR CLEANER LISTINGS
SEARCH JOBDAT ;TOPS-10 JOB DATA LOCATIONS
SEARCH MACTEN ;TOPS-10 MACROS
SEARCH UUOSYM ;TOPS-10 UUO SYMBOLS
SEARCH UFDPRM ;UFDSET SYMBOLS
%%JOBD==%%JOBD ;PUT JOBDAT VERSION IN SYMBOL TABLE
%%MACT==%%MACT ;PUT MACTEN VERSION IN SYMBOL TABLE
%%UUOS==%%UUOS ;PUT UUOSYM VERSION IN SYMBOL TABLE
%%UFDS==%%UFDS ;PUT UFDSET VERSION IN SYMBOL TABLE
.BCOPY
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980,1986,1988. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
.ECOPY
TWOSEG ;MAKE US SHARABLE
RELOC .JBHGH ;START LOADING HIGH SEGMENT HERE
ENTRY .UFD ;ENTRY POINT
SUBTTL Definitions
; Accumulators
;
T1=1 ;4 TEMPORARY ACS
T2=T1+1
T3=T2+1
T4=T3+1
P1=5 ;4 PERMINENT ACS
P2=P1+1
P3=P2+1
P4=P3+1
L=11 ;DIRECTORY LEVEL
BP=12 ;BYTE POINTER
AP=16 ;ARGUMENT BLOCK POINTER
P=17 ;PDL
.AP==T1 ;USER AC THAT POINTS TO ARGUMENT BLOCK
; Assembly parameters
;
SFDMAX==5 ;MAXIMUM NUMBER OF SFDS
DIRLVL==SFDMAX+1 ;MAXIMUM NUMBER OF DIRECTORY LEVELS
BLKSIZ==200 ;SIZE OF A DISK BLOCK IN PAGES
BUFSIZ==<^D132/5>+1 ;TEXT BUFFER SIZE
FOPSIZ==.FOMAX ;LENGTH OF FILOP BLOCK TO USE
RIBSIZ==.RBMAX ;LENGTH OF RIB TO USE
PTHSIZ==.PTMAX ;LENGTH OF PATH BLOCK TO USE
DCHSIZ==.DCMAX ;DSKCHR BLOCK SIZE
STRMAX==^D36+1 ;MAXIMUM NUMBER OF STRS = 36 + FENCE
SLSIZE==.FSDSO+<.DFJBL*STRMAX>+1 ;LENGTH OF A SEARCH LIST
LOKTIM==2 ;# SECS BETWEEN TRIES FOR UFD INTERLOCK
; (USE VALUES THAT DIVIDE EVENLY INTO
; 60, PLEASE)
LOKLIM==5 ;# MINUTES TO KEEP TRYING FOR INTERLOCK
; Macro to make life easier
;
DEFINE $ERR (CODE),<
PUSHJ P,ERRPRC ;;CALL THE ERROR PROCESSOR
CAI UF'CODE'% ;;STORE ERROR CODE HERE
>
SUBTTL Subroutine entry and exit
RELOC .JBHGH
.UFD:: MOVEM 0,USRACS+0 ;SAVE AC 0
MOVE 0,[1,,USRACS+1] ;SET UP BLT
BLT 0,USRACS+17 ;SAVE ACS 1 - 17
MOVE 0,USRACS+0 ;RELOAD AC 0
MOVE AP,.AP ;GET ADDRESS OF USER'S ARGUMENT BLOCK
PUSHJ P,INITIA ;INITIALIZE THE WORLD, GET FUNCT CODE
PUSHJ P,@FNCTAB-1(T1) ;DISPATCH
ERRXIT: MOVE 0,[USRACS+1,,1] ;SET UP BLT
BLT 0,17 ;RESTORE ACS 1 - 17
MOVE 0,USRACS+0 ;RELOAD AC 0
SKIPN .UFERR(.AP) ;DID WE RETURN AN ERROR CODE?
CPOPJ1: AOS (P) ;NO - FORCE SKIP RETURN
CPOPJ: POPJ P, ;RETURN
FNCTAB: EXP $MOUNT ;(01) MOUNT A STRUCTURE
EXP $DISMOUNT ;(02) DISMOUNT A STRUCTURE
EXP $RECOMPUTE ;(03) RECOMPUTE DISK USAGE
EXP $ASSL ;(04) ADD STR TO SSL
EXP $RSSL ;(05) REMOVE STR FROM SSL
EXP $AJSL ;(06) ADD STR TO JSL
EXP $RJSL ;(07) REMOVE STR FROM JSL
EXP $UFDLOK ;(10) SET UFD INTERLOCK
EXP $UFDCLR ;(11) CLEAR UFD INTERLOCK
SUBTTL Mount a structure (function 1)
$MOUNT: PUSHJ P,FIXPPN ;FIX UP THE PPN
PUSHJ P,READSL ;READ THE JOB'S SEARCH LIST
PUSHJ P,CREUFD ;CREATE A UFD IF NECESSARY
PUSHJ P,LOKUFD ;GET UFD INTERLOCK
PUSHJ P,RCPCHK ;SEE IF WE NEED TO RECOMPUTE
JRST MOUN.1 ;NO
PUSHJ P,RCPMSG ;ISSUE RECOMPUTING DISK USAGE MESSAGE
PUSHJ P,COMPRS ;COMPRESS THE UFD
PUSHJ P,SETSUP ;OPEN THINGS FOR SUPER I/O
PUSHJ P,RECOMP ;RECOMPURE DISK USAGE
PUSHJ P,FINSUP ;CLEANUP SUPER I/O CHANNEL
PUSHJ P,QTAMSG ;OUTPUT FINAL QUOTA MESSAGE
MOUN.1: PUSHJ P,ADDJSL ;ADD THE STR TO THE JOB SEARCH LIST
PUSHJ P,RENUFD ;RENAME THE UFD
PUSHJ P,DEFJSL ;DEFINE THE NEW JOB SEARCH LIST
PUSHJ P,CLRUFD ;CLEAR UFD INTERLOCK
PJRST MNTMSG ;ISSUE MOUNT MESSAGE AND RETURN
SUBTTL Dismount a structure (function 2)
$DISMOUNT:
PUSHJ P,FIXPPN ;FIX UP THE PPN
PUSHJ P,READSL ;READ THE JOB'S SEARCH LIST
PUSHJ P,LOKUFD ;GET UFD INTERLOCK
PUSHJ P,REDUFD ;READ QUOTAS FROM THE UFD
PUSHJ P,RCPCHK ;SEE IF WE NEED TO RECOMPUTE
JRST DISM.1 ;NO
PUSHJ P,RCPMSG ;ISSUE RECOMPUTING DISK USAGE MESSAGE
PUSHJ P,COMPRS ;COMPRESS THE UFD
PUSHJ P,SETSUP ;OPEN THINGS FOR SUPER I/O
PUSHJ P,RECOMP ;RECOMPURE DISK USAGE
PUSHJ P,FINSUP ;CLEANUP SUPER I/O CHANNEL
PUSHJ P,QTAMSG ;OUTPUT FINAL QUOTA MESSAGE
DISM.1: PUSHJ P,QTACHK ;CHECK FOR BEING OVER QUOTA
PUSHJ P,DELJSL ;DELETE STR FROM THE JOB SEARCH LIST
PUSHJ P,DEFJSL ;DEFINE THE NEW JOB SEARCH LIST
PUSHJ P,RENUFD ;RENAME (MAYBE DELETE) THE UFD
PUSHJ P,CLRUFD ;CLEAR UFD INTERLOCK
PJRST DMOMSG ;ISSUE DISMOUNT MESSAGE AND RETURN
SUBTTL Recompute disk usage (function 3)
$RECOMPUTE:
PUSHJ P,LOKUFD ;GET UFD INTERLOCK
PUSHJ P,REDUFD ;READ QUOTAS FROM THE UFD
PUSHJ P,RCPCHK ;SEE IF WE NEED TO RECOMPUTE
JRST RECOM1 ;NO
PUSHJ P,COMPRS ;COMPRESS UFD
PUSHJ P,LOKUFD ;SET UFD INTERLOCK
PUSHJ P,SETSUP ;OPEN THINGS FOR SUPER I/O
PUSHJ P,RECOMP ;RECOMPURE DISK USAGE
PUSHJ P,FINSUP ;CLEANUP SUPER I/O CHANNEL
RECOM1: PUSHJ P,RENUFD ;RENAME AND SET QUOTAS IN THE UFD
PUSHJ P,CLRUFD ;CLEAR UFD INTERLOCK
PJRST QTAMSG ;ISSUE QUOTA MESSAGE AND RETURN
SUBTTL Add a structure to the system search list (function 4)
$ASSL: PUSHJ P,READSL ;READ THE SEARCH LIST
PUSHJ P,ADDJSL ;ADD STR TO SEARCH LIST
PUSHJ P,DEFJSL ;DEFINE A NEW SEARCH LIST
PJRST ASLMSG ;ISSUE MESSAGE AND RETURN
SUBTTL Remove a structure from the system search list (function 5)
$RSSL: PUSHJ P,READSL ;READ THE SEARCH LIST
PUSHJ P,DELJSL ;REMOVE STR FROM SEARCH LIST
PUSHJ P,DEFJSL ;DEFINE A NEW SEARCH LIST
PJRST RSLMSG ;ISSUE MESSAGE AND RETURN
SUBTTL Add a structure to a job search list (function 6)
$AJSL: PUSHJ P,READSL ;READ THE SEARCH LIST
PUSHJ P,ADDJSL ;ADD STR TO SEARCH LIST
PUSHJ P,DEFJSL ;DEFINE A NEW SEARCH LIST
PJRST AJLMSG ;ISSUE MESSAGE AND RETURN
SUBTTL Remove a structure from a job search list (function 7)
$RJSL: PUSHJ P,READSL ;READ THE SEARCH LIST
PUSHJ P,DELJSL ;REMOVE STR FROM SEARCH LIST
PUSHJ P,DEFJSL ;DEFINE A NEW SEARCH LIST
PJRST RJLMSG ;ISSUE MESSAGE AND RETURN
SUBTTL Set the UFD interlock (function 10)
$UFDLOK:HLRZ P1,.UFLOK(AP) ;GET TIME TO WAIT FOR INTERLOCK
HRRZ P2,.UFLOK(AP) ;GET TIME TO WAIT FOR MESSAGE
UFDL.1: PUSHJ P,ULOCK ;TRY TO INTERLOCK THE UFD
SKIPA ;CAN'T
POPJ P, ;RETURN
JUMPLE P2,UFDL.2 ;ALREADY OUTPUT THE MESSAGE?
SUBI P2,LOKTIM ;COUNT DOWN TIME UNTIL MESSAGE
JUMPG P2,UFDL.2 ;NOT TIME FOR IT
MOVE T1,["[",,'UIB'] ;GET SEVEREITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |UFD interlock is busy for @A; please wait|]
PUSHJ P,TEXT ;GENERATE TEXT
UFDL.2: SUBI P1,LOKTIM ;COUNT DOWN THE SECONDS
JUMPLE P1,UFDL.3 ;CAN'T GET INTERLOCK
MOVEI T1,LOKTIM ;GET SECONDS TO WAIT BETWEEN TRIES
SLEEP T1, ;ZZZZZZ
JRST UFDL.1 ;TRY IT AGAIN
UFDL.3: $ERR (UBT) ;? UFD INTERLOCK BUSY
SUBTTL Clear the UFD interlock (function 11)
$UFDCLR:PUSHJ P,UNLOCK ;UNLOCK THE UFD
$ERR (UIC) ;? UFD INTERLOCK CANNOT BE CLEARED
POPJ P, ;RETURN
SUBTTL Initialization
INITIA: SETZM ZBEG ;CLEAR A WORD
MOVE T1,[ZBEG,,ZBEG+1] ;SET UP BLT
BLT T1,ZEND-1 ;CLEAR OUR DATA BASE
SETZM .UFUSD(AP) ;CLEAR BLOCKS USED
MOVE T1,[%NSHJB] ;ARGUMENT TO RETURN THE
GETTAB T1, ;HIGHEST JOB NUMBER IN USE
MOVEI T1,^D511 ;SICK MONITOR
MOVEM T1,HGHJOB ;SAVE IT
MOVE T1,[%LDMFD] ;GET THE MFD PPN
GETTAB T1, ;FROM THE MONITOR
MOVE T1,[1,,1] ;BUT IT WON'T TELL US
MOVEM T1,MFDPPN ;REMEMBER IT
MOVE T1,[%LDSYS] ;GET THE SYS PPN
GETTAB T1, ;FROM THE MONITOR
MOVE T1,[1,,4] ;LEVEL D DEFAULT
MOVEM T1,SYSPPN ;SAVE IT
MOVEI T1,TXTBUF ;POINT TO START OF STRING
MOVEM T1,.UFTXT(AP) ;STORE FOR CALLER
MOVE T1,.UFJOB(AP) ;GET TARGET JOB NUMBER
PJOB T2, ;GET OUR JOB NUMBER
CAMN T1,[-1] ;DEFAULTED?
MOVE T1,T2 ;MAKE IT OUR JOB
CAMN T1,T2 ;IS IT US?
SETOM SLFFLG ;YES - REMEMBER FOR LATER
EXCH T1,.UFJOB(AP) ;RESET INCASE IT WAS DEFAULTED
HRLZS T1 ;PUT JOB IN LH
HRRI T1,.GTPPN ;TABLE NUMBER
GETTAB T1, ;GET PPN
MOVNI T1,1 ;CAN'T FAIL
MOVE T2,.UFPPN(AP) ;GET TARGET PPN
CAMN T2,[-1] ;DEFAULTED?
MOVEM T1,.UFPPN(AP) ;RESET IT INCASE IT WAS DEFAULTED
LDB T1,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
CAILE T1,0 ;RANGE
CAILE T1,.UFMAX ; CHECK IT
$ERR (IFC) ;ILLEGAL FUNCTION CODE
MOVE T1,.UFSTR(AP) ;GET STRUCTURE
MOVEM T1,DCHBLK+.DCNAM ;STORE NAME
MOVE T1,[DCHSIZ,,DCHBLK] ;POINT TO DSKCHR BLOCK
DSKCHR T1,UU.PHY ;READ DISK CHARACTERISTICS
$ERR (IDV) ;ILLEGAL DEVICE
LDB T1,[POINTR (T1,DC.TYP)] ;SEE WHAT KINDA JUNK HE GAVE US
CAIE T1,.DCTFS ;ONLY WANT A FULL STRUCTURE NAME
$ERR (ISN) ;IMPROPER STRUCTURE NAME
LDB T1,[POINTR (DCHBLK+.DCUCH,DC.UCC)];GET BLOCKS PER CLUSTER
MOVEM T1,BPC ;SAVE FOR CFP COMPUTATION
PUSHJ P,SETFIL ;SET UP FILE BLOCKS
SETOM LEVEL ;INDICATE NO CHANNELS OPEN
MOVEI L,0 ;POINT TO TOP LEVEL
PUSHJ P,SETBLK ;SET UP SOME BLOCKS
MOVE T1,.UFPPN(AP) ;GET THE PPN
MOVEM T1,LKPBLK+.RBNAM(P2) ;STORE AS THE FILE NAME
MOVE T1,[IOWD BLKSIZ,DSKBUF] ;POINT TO DISK BUFFER
MOVEM T1,IOLIST ;STORE IOWD
LDB T1,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE AGAIN
POPJ P, ;RETURN
SUBTTL PPN fixup
; Here to on MOUNT and DISMOUNT functions to insure the job number
; and the PPN match. They might not, due to races between the user's
; job, QUASAR, and PULSAR. Typically this will happen when some
; Bozo changes his S/L and immediately changes his PPN too. QUASAR
; will get the S/L change message and GETTAB the PPN of the job,
; remembering it forever more. The guy then changes his PPN back
; and types DISMOUNT FOO. PULSAR gets the error return from UFDSET
; (because a STRUUO failed) and starts bitching at the operator.
;
FIXPPN: MOVX T1,UF.WLD!UF.IBP ;MAGIC BITS
TDNE T1,.UFFLG(AP) ;WILD PPN OR IN BEHALF?
POPJ P, ;YES - DO NOTHING FOR NOW
HRLZ T1,.UFJOB(AP) ;GET THE JOB NUMBER
HRRI T1,.GTPPN ;GETTAB TABLE
GETTAB T1, ;READ THE JOB'S PPN
SKIPA ;CAN'T
MOVEM T1,.UFPPN(AP) ;RESET IT
POPJ P, ;RETURN
SUBTTL Directory searching and recomputing logic
RECOMP: CAMG L,LEVEL ;CURRENT LEVEL HAVE A FILE OPEN?
JRST RECO.4 ;YES - PROCEED
AOS LEVEL ;POINT TO NEXT LEVEL
HRRZI T1,FOPBLK(P1) ;GET ADDRESS OF FILOP BLOCK
HRLI T1,FOPSIZ ;GET LENGTH OF BLOCK
FILOP. T1, ;OPEN THE FILE
JRST RECO.2 ;CAN'T - FORGET THIS DIRECTORY
MOVE T1,FOPBLK+.FOFNC(P1) ;GET ORIGINAL FUNCTION WORD
ANDX T1,FO.CHN ;KEEP JUST THE CHANNEL NUMBER
HRRI T1,.FOINP ;LOAD FUNCTION CODE TO READ
MOVEM T1,FUNBLK(L) ;SAVE FUNCTION WORD FOR LATER
MOVE T1,LKPBLK+.RBNAM(P2) ;GET DIRECTORY FILE NAME
MOVEM T1,PTHBLK+.PTPPN(L) ;ADD TO THE END OF THE PATH SPEC
SETZM DIRBLK(L) ;CLEAR DIRECTORY BLOCK NUMBER
JUMPN L,RECO.1 ;CHECK FOR TOP LEVEL
PUSHJ P,UOQINI ;SET UP .UFQ??
SETZM .UFUSD(AP) ;INIT BLOCKS USED COUNTER
JRST RECO.1 ;CONTINUE
RECO.0: SOSA DIRBLK(L) ;ADJUST BLOCK NUMBER FOR RE-READ
RECO.1: SETZM IDXBLK(L) ;CLEAR INDEX INTO BUFFER
MOVE T1,[2,,T2] ;SET UP AC
MOVE T2,FOPBLK+.FOFNC(P1) ;GET FUNCTION WORD
ANDX T2,FO.CHN ;KEEP JUST THE CHANNEL NUMBER
HRRI T2,.FOUSI ;GET USETI FUNCTION
AOS T3,DIRBLK(L) ;GET BLOCK NUMBER
FILOP. T1, ;POSITION FOR INPUT
JRST RECO.A ;CAN'T
MOVE T1,[2,,T2] ;SET UP AC
MOVE T2,FOPBLK+.FOFNC(P1) ;GET FUNCTION WORD
ANDX T2,FO.CHN ;KEEP JUST THE CHANNEL NUMBER
HRRI T2,.FOINP ;GET USETI FUNCTION
MOVEI T3,IOLIST ;POINT TO I/O COMMAND LIST
FILOP. T1, ;READ A BLOCK
SKIPA ;CAN'T - ANALYZE ERROR
JRST RECO.4 ;PROCEED
RECO.A: TXNE T1,IO.EOF ;CHECK FOR ERRORS
JRST RECO.3 ;JUST CLOSE CHANNEL ON EOF
PUSHJ P,DIRIOE ;REPORT DIRECTORY I/O ERROR
SKIPG L ;TOPLEVEL DIRECTORY?
AOS TOPERR ;YES - INDICATE I/O ERROR
JRST RECO.3 ;ONE ERROR IS ENOUGH
RECO.2: PUSHJ P,DIRERR ;REPORT DIRECTORY ERROR
SKIPG L ;TOPLEVEL DIRECTORY?
SOS TOPERR ;YES - INDICATE LOOKUP ERROR
RECO.3: MOVE T1,[1,,T2] ;SET UP AC
MOVE T2,FOPBLK+.FOFNC(P1) ;GET FUNCTION WORD
ANDX T2,FO.CHN ;KEEP JUST THE CHANNEL
HRRI T2,.FOREL ;LOAD RELEASE FUNCTION
FILOP. T1, ;RELEASE THE CHANNEL
JFCL ;IGNORE ERRORS
MOVX T1,FO.CHN ;GET CHANNEL FIELD
ANDCAM T1,FOPBLK+.FOFNC(P1) ;CLEAR FOR NEXT TIME
SETZM PTHBLK+.PTPPN(L) ;TERMINATE PATH PROPERLY
SOS L,LEVEL ;BACKUP A LEVEL
PUSHJ P,SETPTR ;SET UP POINTERS
SKIPN T1,TOPERR ;WAS THERE A TOPLEVEL DIRECTORY ERROR?
JUMPGE L,RECO.0 ;NO - CONTINUE
CAIN T1,1 ;I/O ERROR?
$ERR (IOE) ;YES
CAMN T1,[-1] ;LOOKUP ERROR?
$ERR (CAD) ;YES
POPJ P, ;RETURN
RECO.4: SKIPGE DIRBLK(L) ;NEED TO RE-READ BLOCK?
JRST RECO.0 ;YES
MOVE T4,IDXBLK(L) ;GET INDEX INTO BUFFER
CAIL T4,BLKSIZ ;END OF BUFFER?
JRST RECO.1 ;YES - READ ANOTHER BLOCK
MOVE T1,DSKBUF+0(T4) ;GET FILE NAME
HLLZ T2,DSKBUF+1(T4) ;GET EXTENSION
HRRZ T3,DSKBUF+1(T4) ;GET COMPRESSED FILE POINTER
MOVEI T4,2 ;ACCOUNT FOR TWO WORD ENTRIES
ADDM T4,IDXBLK(L) ;POINT PAST THE WORDS WE JUST READ
JUMPE T1,RECO.4 ;FLUSH NULL ENTRIES
RECO.5: MOVEM T1,LKPFIL+.RBNAM ;STORE FILE NAME
MOVEM T2,LKPFIL+.RBEXT ;STORE EXTENSION
MOVE T1,LKPBLK+.RBNAM(P2) ;GET CURRENT DIRECTORY NAME
MOVEM T1,PTHFIL+.PTPPN(L) ;STORE AT THE END OF THE PATH SPEC
SETZM PTHFIL+.PTSFD(L) ;MAKE SURE PATH IS TERMINATED
MOVE T1,T3 ;COPY CFP
PUSHJ P,RIBSUP ;READ RIB WITH SUPER I/O IF WE CAN
SKIPA T1,[FOPSIZ,,FOPFIL] ;CAN'T - SET UP FILOP
JRST RECO.9 ;SAVE FILSER SOME WORK
FILOP. T1, ;LOOKUP A FILE
JRST RECO.6 ;CAN'T
RECO.9: MOVE T1,LKPFIL+.RBALC ;GET BLOCKS ALLOCATED TO THIS FILE
MOVX T2,RP.NQC ;NON-QUOTA CHECKED FILE BIT
TDNN T2,LKPFIL+.RBSTS ;DO QUOTA CHECKING ON THIS FILE?
ADDM T1,.UFUSD(AP) ;YES - ADD TO TOTAL SO FAR
PUSHJ P,RIBCHK ;CHECK FOR FILE ERRORS
JRST RECO.7 ;ALLS WELL SO FAR
RECO.6: PUSHJ P,FILERR ;REPORT FILE ERRORS
SETZM LKPFIL+.RBEXT ;CLEAR SO WE DON'T DO EXTRA LOOKUP
RECO.7: MOVE T1,[1,,T2] ;SET UP AC
MOVE T2,FOPFIL+.FOFNC ;GET FUNCTION WORD
ANDX T2,FO.CHN ;KEEP JUST THE CHANNEL NUMBER
HRRI T2,.FOREL ;LOAD NEW FUNCTION CODE
FILOP. T1, ;RELEASE THE CHANNEL
JFCL ;IGNORE ERRORS
MOVX T1,FO.PRV!FO.ASC+.FORED ;USE PRIVS/ASSIGN CHANNEL/READ
MOVEM T1,FOPFIL+.FOFNC ;RESET FOR ENXT TIME
HLRZ T1,LKPFIL+.RBEXT ;GET THE EXTENSION
CAIN T1,'SFD' ;LOWER LEVEL DIRECTORY?
AOSA L ;YES - DROP DOWN A LEVEL
JRST RECOMP ;GO BACK AND DO ANOTHER FILE
RECO.8: PUSHJ P,SETBLK ;SET UP BLOCKS AND POINTERS
MOVE T1,LKPFIL+.RBNAM ;GET A DIRECTORY NAME
MOVEM T1,LKPBLK+.RBNAM(P2) ;STORE IT
HLLZ T1,LKPFIL+.RBEXT ;GET IT'S EXTENSION
MOVEM T1,LKPBLK+.RBEXT(P2) ;STORE IT TOO
JRST RECOMP ;GO BACK AND DO ANOTHER FILE
SUBTTL RIBSUP - Read and verify a rib
; Call: T1/ CFP
; error return if not a good rib, normal return if verified
;
; Note: Unit of RIB = (CFP/CPU)
; Block on unit = (CFP - (unit of RIB * CPU)) * BPC
; Block of RIB = (USZ * unit of RIB) + block on unit
;
; CFP - Compressed File Pointer
; CPU - Clusters Per Unit
; BPC - Blocks per cluster
; USZ - Number of blocks on a unit
RIBSUP: MOVE T2,T1 ;COPY CFP FOR LATER
IDIV T2,CPU ;COMPUTE UNIT WE ARE WORKING WITH
MOVE T3,CPU ;GET THE CLUSTERS PER UNIT
IMULI T3,(T2) ;COMPUTE THE NUMBER OF CLUSTERS
; BEFORE THIS UNIT
SUB T1,T3 ;COMPUTE CLUSTER WITHIN UNIT
IMUL T1,BPC ;DETERMINE BLOCK WITHIN UNIT
IMUL T2,USZ ;DETERMINE BLOCKS BEFORE THIS UNIT
ADD T1,T2 ;DETERMINE BLOCK WITHIN STRUCTURE
MOVEM T1,SUPFOP+1 ;STORE ARG
MOVEI T1,.FOUSI ;USETI
DPB T1,[POINTR (SUPFOP+.FOFNC,FO.FNC)];STORE FUNCTION
MOVE T1,[2,,SUPFOP] ;POINT TO FILOP. BLOCK
FILOP. T1, ;SHOOT
POPJ P, ;FAILED
MOVEI T1,.FOINP ;INPUT
DPB T1,[POINTR (SUPFOP+.FOFNC,FO.FNC)];STORE FUNCTION
MOVE T1,[IOWD BLKSIZ,RIBBLK] ;POINT TO A RIB
MOVEI T2,0 ;CLEAR IO LIST
MOVEI T3,T1 ;ADDRESS OF I/O LIST
MOVEM T3,SUPFOP+1 ;STORE
MOVE T3,[2,,SUPFOP] ;POINT TO FILOP. BLOCK
FILOP. T3, ;READ THE RIB
POPJ P, ;CANT
;Now verify RIB
MOVE T1,LKPFIL+.RBNAM ;GET DESIRED NAME
CAME T1,RIBBLK+.RBNAM ;MATCH RIB?
POPJ P, ;NO
HLLZ T1,LKPFIL+.RBEXT ;GET EXTENSION
HLLZ T2,RIBBLK+.RBEXT ;AND FROM RIB
CAME T1,T2 ;MATCH?
POPJ P, ;NO
MOVE T1,PTHBLK+.PTPPN ;GET PPN?
CAME T1,RIBBLK+.RBPPN ;MATCH?
POPJ P, ;NO
;Now copy RIB
PUSH P,LKPFIL+.RBPPN ;SAVE PATH POINTER
PUSH P,LKPFIL+.RBCNT ;SAVE COUNTER
MOVE T1,[RIBBLK,,LKPFIL] ;SETUP BLT
BLT T1,LKPFIL+RIBSIZ ;MOVE THE RIB OVER
POP P,LKPFIL+.RBCNT ;FUDGE THEM BACK
POP P,LKPFIL+.RBPPN ;...
AOS (P) ;SKIP RETURN
POPJ P, ;TO CALLER
SUBTTL SETSUP - Setup for super I/O
SETSUP: MOVE T1,[FO.ASC+.FOSIO] ;SUPER MODE
MOVEM T1,SUPFOP+.FOFNC ;STORE
MOVEI T1,.IODMP ;DUMP MODE
MOVEM T1,SUPFOP+.FOIOS ;STORE
MOVE T1,.UFSTR(AP) ;GET STR
MOVEM T1,SUPFOP+.FODEV ;STORE DEVICE
MOVE T1,[4,,SUPFOP] ;POINT TO BLOCK
FILOP. T1, ;OPEN IT UP
$ERR (IDV) ;??
POPJ P, ;AND RETURN
SUBTTL FINSUP - Finish up super I/O
FINSUP: MOVEI T1,.FOREL ;RELEASE FUNCTION
DPB T1,[POINTR (SUPFOP+.FOFNC,FO.FNC)];STORE
MOVE T1,[1,,SUPFOP] ;POINT TO BLOCK
FILOP. T1, ;RELEASE CHANNEL
JFCL ;OH WELL
POPJ P, ;AND RETURN
SUBTTL Set up .UFQ??
; Here to set up .UFQTF, .UFQTO, .UFQTR and .UFUSD
;
UOQINI: SKIPGE T1,.UFQTF(AP) ;GET QUOTA TO SET
MOVE T1,LKPBLK+.RBQTF(P2) ;GET LOGGED-IN QUOTA
MOVEM T1,.UFQTF(AP) ;STORE IT
SKIPGE T1,.UFQTO(AP) ;GET QUOTA TO SET
MOVE T1,LKPBLK+.RBQTO(P2) ;GET LOGGED-OUT QUOTA
MOVEM T1,.UFQTO(AP) ;STORE IT
SKIPGE T1,.UFQTR(AP) ;SET QUOTA TO SET
MOVE T1,LKPBLK+.RBQTR(P2) ;GET RESERVED QUOTA
MOVEM T1,.UFQTR(AP) ;STORE IT
POPJ P, ;RETURN
SUBTTL Check for file errors
; Here to check for file errors (error bits in RIBSTS)
;
RIBCHK: MOVX T1,RP.ERR ;GET MASK OF ALL FILE ERRORS
TDNN T1,LKPFIL+.RBSTS ;ANY SET
POPJ P, ;NO
AOS RIBERR ;COUNT ERROR BITS
SKIPN .UFTYO(AP) ;CALLING PROGRAM WANT TO SEE MESSAGE?
POPJ P, ;NO
PUSH P,P1 ;SAVE P1
MOVEI P1,0 ;CLEAR INDEX
RIBC.1: HRRZ T1,RIBTAB(P1) ;GET BIT TO TEST
TDNN T1,LKPFIL+.RBSTS ;BIT ON?
JRST RIBC.2 ;NO - TRY ANOTHER
MOVEI T1,FOPFIL ;GET FILOP BLOCK ADDRESS
MOVEM T1,FOPADR ;SAVE IT
HLRZ T1,RIBTAB(P1) ;GET TEXT ADDRESS
MOVEM T1,TXTADR ;SAVE IT
MOVE T1,["%",,'FLE'] ;FLAG AS WARNING
MOVEI T2,[ASCIZ |Error on @J; @K|] ;GET TEXT
PUSHJ P,TEXT ;GENERATE TEXT
RIBC.2: CAIGE P1,RIBMAX-1 ;DONE CHECKING?
AOJA P1,RIBC.1 ;NO - LOOP
POP P,P1 ;RESTORE P1
POPJ P, ;RETURN
; Macro to build RIBTAB
;
DEFINE $RIB (BIT,TXT),<[ASCIZ |TXT|],,RP.'BIT>
; Table of RIB bits and error messages
;
RIBTAB: $RIB (BDA,<file damage>)
$RIB (CRH,<closed after a crash>)
$RIB (BFA,<tape read error restoring file>)
$RIB (FRE,<hard data read error>)
$RIB (FWE,<hard data write error>)
$RIB (FCE,<software detected checksum error>)
RIBMAX==.-RIBTAB
SUBTTL Search list routines -- Read a S/L
; Read a search list
;
READSL: MOVEI T2,.FSDSL ;GET FUNCTION CODE
MOVEM T2,OLDSL+.FSFCN ;SAVE IT
MOVE T1,.UFJOB(AP) ;GET JOB NUMBER
MOVEM T1,OLDSL+.FSDJN ;SAVE IT
MOVEM T1,GOBBLK+.DFGJN ;HERE TOO
MOVE T1,.UFPPN(AP) ;GET PPN
MOVEM T1,OLDSL+.FSDPP ;SAVE IT
SETZM OLDSL+.FSDFL ;CLEAR FLAG WORD
MOVEI T2,OLDSL+.FSDSO ;POINT TO FIRST STR BLOCK
SETZM GOBBLK+.DFGPP ;NO PPN
SETOM GOBBLK+.DFGNM ;START WITH THE FIRST STRUCTURE
READ.1: MOVE T1,[.DFGST+1,,GOBBLK] ;SET UP UUO
MOVE T3,[GOBSTR T1,] ;ASSUME ANY JOB
SKIPN SLFFLG ;OUR JOB?
JRST READ.2 ;NO
MOVE T1,[.DFJBL,,GOBBLK+2] ;ADJUST ARGUMENT
MOVE T3,[JOBSTR T1,] ;FOR OUR JOB
READ.2: XCT T3 ;GET THE NEXT STRUCTURE IN S/L
$ERR (CRS) ;CAN'T READ S/L
MOVSI T1,GOBBLK+.DFGNM ;POINT TO ARGUMENTS RETURNED
HRRI T1,(T2) ;BUILD BLT POINTER
BLT T1,.DFJBL-1(T2) ;COPY THEM
ADDI T2,.DFJBL ;POINT TO NEXT STR BLOCK
MOVE T1,GOBBLK+.DFGNM ;GET LAST STR RETURNED
AOJN T1,READ.1 ;LOOP IF NOT END OF S/L
MOVEI T1,OLDSL ;GET S/L BLOCK ADDRESS
POPJ P, ;RETURN
SUBTTL Search list routines -- Find a structure in a S/L
; Find a search list entry in either OLDSL or NEWSL
; Call: MOVE T1, STR
; PUSHJ P,FINDOS ;OLDSL
; PUSHJ P,FINDNS ;NEWSL
; <NON-SKIP> ;ENTRY NOT FOUND
; <SKIP> ;ENTRY FOUND, T2:= ENTRY ADDRESS
;
FINDOS: SKIPA T2,[OLDSL] ;POINT TO OLD S/L
FINDNS: MOVEI T2,NEWSL ;POINT TO NEW S/L
ADDI T2,.FSDSO ;POINT TO FIRST STRUCTURE
FIND.1: MOVE T3,.DFJNM(T2) ;GET A STRUCTURE FROM THE S/L
CAMN T3,T1 ;FOUND WHAT WE'RE LOOKING FOR?
JRST CPOPJ1 ;YES - RETURN T2:= ADDRESS
AOJE T3,CPOPJ ;CHECK FOR END OF S/L
ADDI T2,.DFJBL ;POINT TO NEXT ENTRY
JRST FIND.1 ;TRY THE NEXT
SUBTTL Search list routines -- Add a structure
ADDJSL: MOVE T1,[OLDSL,,NEWSL] ;SET UP BLT
BLT T1,NEWSL+.FSDFL ;COPY HEADER STUFF
MOVEI P1,OLDSL+.FSDSO ;POINT TO FIRST STR IN OLD S/L
MOVEI P2,NEWSL+.FSDSO ;POINT TO FIRST STR IN NEW S/L
MOVE P3,.UFFLG(AP) ;GET FLAGS
MOVE T1,.UFSTR(AP) ;GET STRUCTURE
PUSHJ P,FINDOS ;FIND IT
JRST ADDJ.1 ;ADD IT SOMEWHERE IN THE S/L
MOVE P4,T2 ;SAVE ADDRESS
MOVEI T1,0 ;FENCE
PUSHJ P,FINDOS ;FIND IT
POPJ P, ;CAN'T HAPPEN
TXNN P3,UF.PSL ;WANT ACTIVE?
CAML P4,T2 ;ALREADY ON THE ACTIVE SIDE?
SKIPA ;NO TO EITHER
JRST ADDJ.2 ;YES - LEAVE IT WHERE IT IS
TXNE P3,UF.PSL ;WANT PASSIVE?
CAMG P4,T2 ;ALREADY ON THE PASSIVE SIDE?
SKIPA ;NO TO EITHER
JRST ADDJ.2 ;YES - THEN LEAVE IT WHERE IT IS
TXNN P3,UF.PSL ;WHERE DO WE WANT IT?
JRST ADDJ.3 ;PUT IN THE ACTIVE S/L
JRST ADDJ.4 ;PUT IN THE PASSIVE S/L
; Here to add a new structure
;
ADDJ.1: TXNN P3,UF.PSL ;WHERE TO WE WANT IT
TDZA T1,T1 ;PUT IN THE ACTIVE S/L
MOVX T1,-1 ;PUT IN THE PASSIVE S/L
PUSHJ P,FINDOS ;FIND THE FENCE OR END
POPJ P, ;SHOULDN'T FAIL
MOVEI T1,(T2) ;COMPUTE WORDS TO MOVE
SUBI T1,(P1) ;FROM BEGINING TO END
PUSHJ P,MOVSTR ;MOVE THEM
PUSHJ P,ADDSTR ;ADD STR TO END OF ACTIVE OR PASSIVE
PUSHJ P,FINSTR ;FINISH COPYING THE S/L
POPJ P, ;RETURN
; Here to copy an existing structure
;
ADDJ.2: MOVEI T1,(P4) ;GET STR ADDRESS
SUBI T1,(P1) ;COMPUTE WORDS TO COPY
PUSHJ P,MOVSTR ;MOVE THEM
PUSHJ P,CPYSTR ;COPY STR TO NEW S/L
PUSHJ P,FINSTR ;FINISH COPYING THE S/L
POPJ P, ;RETURN
; Here to put a structure in the active S/L
;
ADDJ.3: MOVEI T1,0 ;FENCE
PUSHJ P,FINDOS ;FIND IT
POPJ P, ;CAN'T HAPPEN
MOVEI T1,(T2) ;GET ADDRESS OF FENCE
SUBI T1,(P1) ;COMPUTE WORDS TO MOVE
PUSHJ P,MOVSTR ;MOVE THEM
PUSHJ P,ADDSTR ;ADD THE STRUCTURE TO ACTIVE S/L
MOVEI T1,(P4) ;GET STR ADDRESS
SUBI T1,(P1) ;COMPUTE WORDS TO MOVE
PUSHJ P,MOVSTR ;MOVE THEM
ADDI P1,.DFJBL ;POINT BEYOND THE STR
PUSHJ P,FINSTR ;FINISH UP
POPJ P, ;RETURN
; Here to put a structure in the passive S/L
;
ADDJ.4: MOVEI T1,(P4) ;GET POSITION OF STR IN OLD S/L
SUBI T1,(P1) ;COMPUTE WORDS TO COPY
PUSHJ P,MOVSTR ;MOVE THAT MANY WORDS
ADDI P1,.DFJBL ;SKIP OVER THE STR
MOVX T1,-1 ;END OF S/L
PUSHJ P,FINDOS ;FIND IT
POPJ P, ;CAN'T HAPPEN
MOVEI T1,(T2) ;GET ADDRESS OF END OF S/L
SUBI T1,(P1) ;COMPUTE WORDS TO MOVE
PUSHJ P,MOVSTR ;MOVE THAT MANY WORDS
PUSHJ P,ADDSTR ;NOW ADD THE STRUCTURE
PUSHJ P,FINSTR ;FINISH UP
POPJ P, ;RETURN
; Copy a structure block from the old S/L to the new S/L
;
CPYSTR: TDZA T1,T1 ;INDICATE COPY
; Add a new structure block to the new S/L
;
ADDSTR: SKIPA T1,. ;INDICATE ADD
SKIPA T2,.DFJNM(P1) ;GET STR TO COPY
MOVE T2,.UFSTR(AP) ;GET STR TO ADD
MOVEM T2,.DFJNM(P2) ;SAVE STR IN NEW S/L
SETZM .DFJDR(P2) ;CLEAR DIRECTORY
MOVE T2,.UFSTS(AP) ;GET FILE STRUCTURE STATUS BITS
MOVEM T2,.DFJST(P2) ;SAVE THEM
SKIPN T1 ;ADDING?
ADDI P1,.DFJBL ;POINT TO NEXT OLD STR BLOCK IF COPY
ADDI P2,.DFJBL ;POINT TO NEXT NEW STR BLOCK
POPJ P, ;RETURN
; Move structure blocks from the old S/L to the new S/L
;
MOVSTR: SKIPN T1 ;ANYTHING TO MOVE?
POPJ P, ;NO
MOVSI T2,(P1) ;GET OLD S/L ADDRESS
HRRI T2,(P2) ;GET NEW S/L ADDRESS
MOVEI T3,(P2) ;GET CURRENT POSITION
ADDI T3,(T1) ;PLUS THE NUMBER OF WORDS TO MOVE
BLT T2,-1(T3) ;COPY PART OF THE S/L
ADDI P1,(T1) ;INCREMENT OLD S/L POINTER
ADDI P2,(T1) ;INCREMENT NEW S/L POINTER
POPJ P, ;RETURN
; Finish copying structures from the old S/L to the new S/L
;
FINSTR: MOVX T1,-1 ;FENCE
PUSHJ P,FINDOS ;FIND IT
POPJ P, ;CAN'T HAPPEN
CAMN T2,P1 ;ALREADY POINTING AT IT?
ADDI T2,1 ;YES
SUBI T2,(P1) ;GET OFFSET TO END OF OLD S/L
ADDI T2,(P2) ;COMPUTE FINAL BLT ADDRESS
MOVSI T1,(P1) ;GET OLD S/L ADDRESS
HRRI T1,(P2) ;GET NEW S/L ADDRESS
BLT T1,(T2) ;COPY REMANINDER IF S/L
POPJ P, ;RETURN
SUBTTL Search list routines -- Delete a structure
DELJSL: MOVX T1,-1 ;GET END OF S/L INDICATOR
PUSHJ P,FINDOS ;FIND IT
POPJ P, ;CAN'T HAPPEN
MOVEI P1,-OLDSL(T2) ;GET LENGTH IN WORDS
MOVE T1,[OLDSL,,NEWSL] ;SET UP BLT
BLT T1,NEWSL(P1) ;COPY S/L
MOVE T1,.UFSTR(AP) ;GET STR TO REMOVE
PUSHJ P,FINDNS ;FIND IT IN THE NEW SEARCH LIST
POPJ P, ;CAN'T - SAY WE DID IT
SUBI T2,NEWSL ;GET OFFSET
MOVSI T1,OLDSL+.DFJBL(T2) ;GET ADDRESS BEYOND STR BLOCK
HRRI T1,NEWSL(T2) ;POINT TO STR BLOCK IN NEW S/L
BLT T1,NEWSL-.DFJBL(P1) ;SLIDE S/L UP BY ONE STR BLOCK
POPJ P, ;RETURN
SUBTTL Search list routines -- Define a S/L
DEFJSL: MOVX T1,DF.SRM ;GET A BIT
MOVEM T1,NEWSL+.FSDFL ;REMOVE STRS NOT IN NEW S/L
MOVX T1,UF.IBP ;BIT TO TEST
TDNN T1,.UFFLG(AP) ;IN BEHALF OF ANOTHER PPN?
SKIPA T1,.UFPPN(AP) ;GET PPN INCASE WE GENERATED ONE
MOVNI T1,1 ;DON'T CONFUSE MONITOR
MOVEM T1,NEWSL+.FSDPP ;UPDATE IT
MOVX T1,-1 ;GET END OF LIST
PUSHJ P,FINDNS ;FIND IT
$ERR (CCS) ;CAN'T HAPPEN, BUT...
MOVSI T1,-NEWSL(T2) ;GET LENGTH
HRRI T1,NEWSL ;GET ADDRESS
STRUUO T1, ;DEFINE A NEW SEARCH LIST
$ERR (CCS) ;? CAN'T ADD STR TO SEARCH LIST
LDB T1,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
SKIPE .UFJOB(AP) ;SCREWING AROUND WITH THE SSL?
CAIN T1,.UFDMO ;DISMOUNT?
POPJ P, ;YES - THEN NOTHING ELSE TO DO
MOVE T3,[.DCMAX,,DCHBLK] ;SET UP UUO
DSKCHR T3, ;GET UPDATED DISK CHARACTERISTICS
POPJ P, ;STRANGE
HRRZ T1,DCHBLK+.DCSAJ ;GET JOB # THAT MIGHT HAVE STR MOUNTED
CAME T1,.UFJOB(AP) ;IS IT THE JOB WE'RE DOING THINGS FOR?
POPJ P, ;NO - CAN'T CHANGE STATUS
MOVEI T1,.FSRDF ;GET FUNCTION CODE
MOVEM T1,NEWSL+.FSFCN ;SAVE IT
MOVE T1,.UFSTR(AP) ;GET STRUCTURE NAME
MOVEM T1,NEWSL+.FSRNM ;SAVE IT
MOVX T1,UF.SIN ;GET SINGLE ACCESS BIT
TDNN T1,.UFFLG(AP) ;WHAT KIND OF ACCESS DO WE WANT?
TDZA T1,T1 ;MULTI ACCESS
MOVX T1,FS.RSA ;SINGLE ACCESS
TXNE T3,DC.HWP!DC.AWL ;SOME FLAVOR OF WRITE-LOCK?
TXO T1,FS.RWL ;YES, PRESERVE IT
MOVEM T1,NEWSL+.FSRST ;SAVE THE CODE
MOVE T1,[.FSRST+1,,NEWSL] ;SET UP AC
STRUUO T1, ;MAKE STR SINGLE ACCESS
SKIPA T1,[DF.SRM] ;CAN'T - WE'RE IN TROUBLE NOW
POPJ P, ;DONE
MOVEM T1,OLDSL+.FSDFL ;YES - REMOVE STR FROM S/L
MOVX T1,-1 ;FENCE
PUSHJ P,FINDOS ;FIND IT IN THE OLD S/L
$ERR (CSO) ;CAN'T HAPPEN, BUT...
MOVSI T1,-OLDSL(T2) ;GET LENGTH
HRRI T1,OLDSL ;GET ADDRESS
STRUUO T1, ;TRY TO RESET THE ORIGINAL S/L
$ERR (CSO) ;? CANNOT RESET ORIGINAL SEARCH LIST
$ERR (CSS) ;? CANNOT CHANGE STRUCTURE STATUS
SUBTTL Set up file FILOP, LOOKUP, and PATH block
SETFIL: MOVX T1,FO.PRV!FO.ASC+.FORED ;USE PRIVS/ASSIGN CHANNEL/READ
MOVEM T1,FOPFIL+.FOFNC ;STORE IT
MOVX T1,UU.PHS+.IODMP ;PHYSICAL ONLY/DUMP MODE
MOVEM T1,FOPFIL+.FOIOS ;STORE IT
MOVE T1,.UFSTR(AP) ;GET STRUCTURE NAME
MOVEM T1,FOPFIL+.FODEV ;STORE IT
SETZM FOPFIL+.FOBRH ;NO BUFFER RING HEADERS
SETZM FOPFIL+.FONBF ;THEREFORE, NO BUFFERS
SETZM FOPFIL+.FOPAT ;NO NEED FOR A PATH BLOCK
SETZM FOPFIL+.FOPPN ;CLEAR IN-YOUR-BEHALF PPN
MOVEI T1,LKPFIL ;GET ADDRESS OF LOOKUP BLOCK
MOVEM T1,FOPFIL+.FOLEB ;STORE IT
MOVEI T1,RIBSIZ ;GET LOOKUP BLOCK LENGTH
MOVEM T1,LKPFIL+.RBCNT ;STORE IT
MOVEI T1,PTHFIL ;GET ADDRESS OF PATH BLOCK
MOVEM T1,LKPFIL+.RBPPN ;PUT IN THE LOOKUP BLOCK TOO
SETZM LKPFIL+.RBPRV ;CLEAR A WORD
MOVE T1,[LKPFIL+.RBPRV,,LKPFIL+.RBPRV+1] ;SET UP BLT
BLT T1,LKPFIL+RIBSIZ-1 ;CLEAR REMAINDER OF BLOCK
POPJ P, ;RETURN
SUBTTL Set up file FILOP, LOOKUP, and PATH block for a UFD
SETUFD: PUSHJ P,SETFIL ;SET UP THE FILE BLOCKS
MOVE T1,.UFPPN(AP) ;GET FILE NAME (PPN)
MOVEM T1,LKPFIL+.RBNAM ;STORE IT
HRLZI T1,'UFD' ;GET EXTENSION (UFD)
MOVEM T1,LKPFIL+.RBEXT ;STORE IT
MOVE T1,MFDPPN ;GET MFD PPN
MOVEM T1,PTHFIL+.PTPPN ;STORE IT
SETZM PTHFIL+.PTSFD ;TERMINATE PATH
POPJ P, ;RETURN
SUBTTL Set up block pointers
SETPTR: MOVE P1,L ;GET LEVEL
IMULI P1,FOPSIZ ;INDEX INTO FOPBLK
MOVE P2,L ;GET LEVEL
IMULI P2,RIBSIZ ;INDEX INTO LKPBLK
POPJ P, ;RETURN
SUBTTL Set up a directory FILOP, LOOKUP, and PATH blocks
SETBLK: PUSHJ P,SETPTR ;SET UP THE POINTERS
MOVX T1,FO.PRV!FO.ASC+.FORED ;USE PRIVS/ASSIGN CHANNEL/READ
MOVEM T1,FOPBLK+.FOFNC(P1) ;STORE IT
MOVX T1,UU.PHS+.IODMP ;PHYSICAL ONLY/DUMP MODE
MOVEM T1,FOPBLK+.FOIOS(P1) ;STORE IT
MOVE T1,.UFSTR(AP) ;GET STRUCTURE NAME
MOVEM T1,FOPBLK+.FODEV(P1) ;STORE IT
SETZM FOPBLK+.FOBRH(P1) ;NO BUFFER RING HEADERS
SETZM FOPBLK+.FONBF(P1) ;THEREFORE, NO BUFFERS
SETZM FOPBLK+.FOPAT(P1) ;NO NEED FOR A PATH BLOCK
SETZM FOPBLK+.FOPPN(P1) ;CLEAR IN-YOUR-BEHALF PPN
MOVEI T1,RIBSIZ ;GET LENGTH OF LOOKUP BLOCK
MOVEM T1,LKPBLK+.RBCNT(P2) ;STORE IT
MOVEI T1,LKPBLK(P2) ;GET ADDRESS OF LOOKUP BLOCK
MOVEM T1,FOPBLK+.FOLEB(P1) ;STORE IT
MOVEI T1,PTHBLK ;GET ADDRESS OF PATH BLOCK
MOVEM T1,LKPBLK+.RBPPN(P2) ;STORE IN LOOKUP BLOCK
MOVE T1,MFDPPN ;GET THE MFD PPN
SKIPE L ;TOP LEVEL?
MOVE T1,.UFPPN(AP) ;NO - GET THE UFD PPN
MOVEM T1,PTHBLK+.PTPPN ;SET UP A PPN
HRLZI T1,'UFD' ;GET THE UFD EXTENSION
SKIPE L ;TOP LEVEL?
HRLZI T1,'SFD' ;NO - GET A DIFFERENT EXTENSION
MOVEM T1,LKPBLK+.RBEXT(P2) ;STORE IT
POPJ P, ;RETURN
SUBTTL Create a UFD
CREUFD: MOVX T1,UF.WLD ;GET WILD PROGRAMMER NUMBER FLAG
TDNE T1,.UFFLG(AP) ;WANT US TO GENERATE A PPN?
CREU.0: PUSHJ P,CREPRG ;YES
PUSHJ P,SETUFD ;SET UP FOR UFD LOOKUP
MOVE T1,[FOPSIZ,,FOPFIL] ;SET UP UUO
FILOP. T1, ;TRY TO LOOKUP THE UFD
JRST CREU.1 ;CAN'T
MOVX T1,UF.WLD ;GET WILD PROGRAMMER NUMBER FLAG
TDNN T1,.UFFLG(AP) ;WANT US TO GENERATE A PPN?
PJRST REDU.1 ;NO - GO READ UFD QUOTAS, ETC.
PUSHJ P,RELUFD ;CLOSE THE CHANNEL
JRST CREU.0 ;AND TRY AGAIN
CREU.1: PUSH P,T1 ;SAVE T1
PUSHJ P,RELUFD ;CLOSE OF CHANNEL
POP P,T1 ;GET ERROR CODE BACK
CAIE T1,ERFNF% ;FILE NOT FOUND?
$ERR (LFU) ;LOOKUP FAILED FOR UFD
SETZ T1, ;CLEAR AN AC
SKIPL .UFQTF(AP) ;WANT TO SET LOGGED IN QUOTA?
IOR T1,.UFQTF(AP) ;YES
SKIPL .UFQTO(AP) ;WANT TO SET LOGGED OUT QUOTA?
IOR T1,.UFQTO(AP) ;YES
SKIPL .UFQTR(AP) ;WANT TO SET RESERVED QUOTA?
IOR T1,.UFQTR(AP) ;YES
JUMPN T1,CREU.2 ;IF SETTING QUOTAS, THEN CREATE A UFD
MOVX T1,UF.NUE ;GET NO UFD EXISTS BIT
IORM T1,.UFFLG(AP) ;SAVE FOR CURIOUS PROGRAMS
MOVE T1,["%",,'NUC'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |No UFD created on @A|]
PJRST TEXT ;GENERATE TEXT AND RETURN
CREU.2: PUSHJ P,SETUFD ;SET UP FOR UFD ENTER
MOVEI T1,.FOWRT ;GET WRITE FUNCTION CODE
HRRM T1,FOPFIL+.FOFNC ;STORE IT
MOVX T1,RP.DIR ;GET DIRECTORY BIT
MOVEM T1,LKPFIL+.RBSTS ;SAVE FILE STATUS BITS
MOVE T1,[FOPSIZ,,FOPFIL] ;SET UP UUO
FILOP. T1, ;TRY TO LOOKUP THE UFD
$ERR (EFU) ;?ENTER FAILED FOR UFD
MOVEI T1,.FOUSO ;USETO FUNCTION
HRRM T1,FOPFIL+.FOFNC ;SAVE IT
MOVEI T1,2 ;2 BLOCKS
MOVEM T1,FOPFIL+.FOIOS ;ALLOCATE THIS MUCH
MOVE T1,[2,,FOPFIL] ;SET UP UUO
FILOP. T1, ;ALLOCATE SOME BLOCK
JFCL ;IGNORE ERRORS
PJRST RELUFD ;RELEASE CHANNEL AND RETURN
; Here to create a unique programmer number if necessary
;
CREPRG: HRRZ T1,.UFPPN(AP) ;GET PROGRAMMER NUMBER
JUMPN T1,CREP.1 ;FIRST TIME THROUGH?
MSTIME T1, ;GET TIME IN MILLISECONDS
TRZ T1,7B20 ;CLEAR A DIGIT
TROA T1,1B18 ;SET FIRST DIGIT TO 4
CREP.1: ADDI T1,1 ;CHANGE IT
HRRM T1,.UFPPN(AP) ;SAVE NEW PROGRAMMER NUMBER
MOVE T1,.UFPPN(AP) ;GET FULL PPN
CHGPPN T1, ;CHANGE TO THE NEW PPN
$ERR (PGF) ;? PROGRAMMER GENERATION FAILED
GETPPN T1, ;OTHER USERS LOGGED IN WITH NEW PPN?
POPJ P, ;NO - RETURN
JRST CREP.1 ;TRY A DIFFERENT PROGRAMMER NUMBER
SUBTTL Read a UFD
REDUFD: PUSHJ P,SETUFD ;SET UP FOR UFD LOOKUP
MOVE T1,[FOPSIZ,,FOPFIL] ;SET UP UUO
FILOP. T1, ;TRY TO LOOKUP THE UFD
JRST REDU.2 ;CAN'T
REDU.1: SKIPGE T1,.UFQTF(AP) ;DEFAULTING FCFS?
MOVE T1,LKPFIL+.RBQTF ;GET FCFS QUOTA FROM RIB
MOVEM T1,.UFQTF(AP) ;SAVE IT
SKIPGE T1,.UFQTO(AP) ;DEFAULTING LOGGED-OUT QUOTA?
MOVE T1,LKPFIL+.RBQTO ;GET LOGGED-OUT QUOTA FROM RIB
MOVEM T1,.UFQTO(AP) ;SAVE IT
SKIPGE T1,.UFQTR(AP) ;DEFAULTING RESERVED QUOTA?
MOVE T1,LKPFIL+.RBQTR ;GET RESERVED QUOTA FROM RIB
MOVEM T1,.UFQTR(AP) ;SAVE IT
MOVE T1,LKPFIL+.RBUSD ;GET BLOCKS USED FROM RIB
MOVEM T1,.UFUSD(AP) ;SAVE IT
PUSHJ P,GETDTM ;EXTRACT UFD CREATION DATE/TIME
MOVE T1,[.DUFRE,,T2] ;SET UP UUO
MOVE T2,.UFSTR(AP) ;GET STR NAME
MOVE T3,.UFPPN(AP) ;GET PPN
DISK. T1, ;GET UFBTAL
SKIPA ;FAILED??
CAMN T1,[1B0] ;LOGGED IN PPN?
PJRST RELUFD ;NO--USE ASSUMED VALUE
MOVE T2,LKPFIL+.RBQTF ;GET FCFS QUOTA
SUB T2,T1 ;COMPUTE BLOCKED USED
MOVEM T2,LKPFIL+.RBUSD ;UPDATE RIB
PJRST RELUFD ;RELEASE CHANNEL AND RETURN
REDU.2: MOVX T2,UF.NUE ;GET NO UFD EXISTS BIT
IORM T2,.UFFLG(AP) ;SET IT
CAIN T1,ERFNF% ;FILE NOT FOUND?
PJRST RELUFD ;THATS OK
$ERR (LFU) ;LOOKUP FAILED FOR UFD
SUBTTL Rename the UFD
RENUFD: MOVX T1,UF.NUE ;GET THE NO UFD CREATED BIT
TDNE T1,.UFFLG(AP) ;DID WE SET IT?
POPJ P, ;YES - THEN CAN'T RENAME THE UFD
PUSHJ P,SETUFD ;SET UP BLOCKS FOR UFD
MOVE T1,[FOPSIZ,,FOPFIL] ;SET UP AC
FILOP. T1, ;LOOKUP FILE
$ERR (LFU) ;?LOOKUP FAILED FOR UFD
MOVEI T1,.FORNM ;GET REMANE FUNCTION
HRRM T1,FOPFIL+.FOFNC ;STORE IT
MOVE T1,[LKPFIL,,LKPBLK] ;SET UP BLT
BLT T1,LKPBLK+RIBSIZ-1 ;COPY THE ENTIRE RIB
MOVE T1,[PTHFIL,,PTHBLK] ;SET UP BLT
BLT T1,PTHBLK+PTHSIZ-1 ;COPY THE ENTIRE PATH
RENU.1: MOVEI T1,LKPBLK ;GET ADDRESS OF RENAME BLOCK
HRLM T1,FOPFIL+.FOLEB ;STORE IT
MOVEI T1,PTHFIL ;GET ADDRESS OF PATH BLOCK
MOVEM T1,LKPBLK+.RBPPN ;STORE IT
SKIPL T1,.UFPRO(AP) ;GET PROTECTION CODE TO SET
DPB T1,[POINTR (LKPBLK+.RBPRV,RB.PRV)] ;STORE IT
SKIPL T1,.UFQTF(AP) ;GET LOGGED-IN QUOTA
MOVEM T1,LKPBLK+.RBQTF ;STORE IT
SKIPL T1,.UFQTO(AP) ;GET LOGGED IN QUOTA
MOVEM T1,LKPBLK+.RBQTO ;STORE IT
SKIPL T1,.UFQTR(AP) ;GET RESERVED QUOTA
MOVEM T1,LKPBLK+.RBQTR ;STORE IT
MOVE T1,.UFUSD(AP) ;GET BLOCKS USED
MOVEM T1,LKPBLK+.RBUSD ;STORE IT
SKIPL T1,.UFDED(AP) ;GET DIRECTORY EXPIRATION DATE
MOVEM T1,LKPBLK+.RBDED ;STORE IT
MOVE T1,LKPBLK+.RBSTS ;GET STATUS WORD
TXNN T1,RP.NDL ;NO-DELETE TURNED ON?
JRST RENU.2 ;NO
MOVX T2,UF.NDL ;GET THE NDL BIT
IORM T2,.UFFLG(AP) ;SET IT SO THE CALLER KNOWS THIS
PJRST RELUFD ;AND RETURN
RENU.2: MOVE T2,.UFFLG(AP) ;GET FLAG WORD
LDB T3,[POINTR (T2,UF.FNC)] ;GET FUNCTION CODE
TXNE T2,UF.IBP ;IN BEHALF OF ANOTHER PPN?
JRST RENU.3 ;YES - IGNORE THE FUNCTION CODE
CAIN T3,.UFMNT ;MOUNT?
MOVX T2,UF.LGI ;SET RIPLOG
CAIN T3,.UFDMO ;DISMOUNT?
MOVX T2,UF.LGO ;CLEAR RIPLOG
RENU.3: TXNE T2,UF.LGI ;LOGGING IN?
TXO T1,RP.LOG ;YES
SKIPN JSPFLG ;NOT ANOTHER JOB SAME PPN
TXNN T2,UF.LGO ; AND LOGGING OUT?
TRNA ;NO - DON'T CLEAR RIPLOG
TXZ T1,RP.LOG ;YES - CLEAR RIPLOG
SKIPGE RIBERR ;FIND ANY FILES WITH ERROR BITS ON?
TDZ T1,[RP.ERR,,RP.ERR] ;NO - CLEAR ERRORS
MOVEM T1,LKPBLK+.RBSTS ;STORE UPDATED STATUS BITS
TLNN T1,RP.ERR ;ANY FILE ERRORS IN THIS UFD?
JRST RENU.4 ;NOPE
MOVE T1,["%",,'FEE'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |@A file errors exist|]
PUSHJ P,TEXT ;GENERATE TEXT
RENU.4: PUSHJ P,PUTDTM ;SET UFD CREATION DATE/TIME
CAIE T3,.UFDMO ;DISMOUNTING?
JRST RENU.5 ;NOPE
MOVE T1,[.DUFRE,,T2] ;SET UP UUO
MOVE T2,.UFSTR(AP) ;GET STR NAME
MOVE T3,.UFPPN(AP) ;GET PPN
MOVE T4,LKPFIL+.RBQTF ;GET LOGGED IN QUOTA
ADD T4,LKPFIL+.RBQTR ;INCLUDE THE RESERVED QUOTA TOO
SUB T4,LKPFIL+.RBUSD ;COMPUTE BLOCKS FREE IF LOGGED OUT PPN
DISK. T1, ;RETURN FREE SPACE IN THE UFD
SKIPA ;CAN'T
CAMN T1,[1B0] ;LOGGED IN PPN?
MOVE T1,T4 ;NO--USE ASSUMED VALUE
SKIPN JSPFLG ;OTHER JOBS SAME PPN?
CAME T1,LKPFIL+.RBQTF ;REMAINING .NE. FCFS QUOTA?
JRST RENU.5 ;YES - DON'T DELETE THE UFD
MOVEI T1,.FODLT ;GET DELETE FUNCTION
HRRM T1,FOPFIL+.FOFNC ;SET IT
RENU.5: SKIPN RCPFLG ;DID WE RECOMPUTE?
SETOM LKPFIL+.RBUSD ;NO--DON'T CHANGE BLOCKS USED
MOVE T1,[FOPSIZ,,FOPFIL] ;SET UP AC
FILOP. T1, ;RENAME THE UFD
SKIPA ;CAN'T
PJRST RELUFD ;RELEASE THE CHANNEL AND RETURN
MOVEM T1,FOPERR ;SAVE THE ERROR CODE
$ERR (RFU) ;? RENAME FAILED TO UPDATE UFD
SUBTTL Release a UFD channel
RELUFD: MOVE T1,[1,,T2] ;SET UP AC
MOVE T2,FOPFIL+.FOFNC ;GET FUNCTION WORD
ANDX T2,FO.CHN ;KEEP JUST THE CHANNEL NUMBER
HRRI T2,.FOREL ;GET NEW FUNCTION CODE
FILOP. T1, ;RELEASE THE CHANNEL
JFCL ;IGNORE ERRORS
POPJ P, ;RETURN
SUBTTL Compress UFD
; Perform UFD compression
;
COMPRS: PUSHJ P,SETFIL ;SET UP SOME BLOCKS
MOVEI T1,.FOCRE ;CREATE FILE (NEVER SUPERSEDE)
HRRM T1,FOPFIL+.FOFNC ;STORE FUNCTION CODE
MSTIME T1, ;GET TIME IN MILLISECONDS
AND T1,[070707,,070707] ;MAKE IT NUMERIC
TDO T1,[SIXBIT/000000/] ;TURN ON SOME BITS
MOVEM T1,LKPFIL+.RBNAM ;STORE AS THE FILE NAME
HRLZI T1,'TMP' ;A TEMPORARY EXTENSION
MOVEM T1,LKPFIL+.RBEXT ;STORE IT
MOVE T1,.UFPPN(AP) ;GET THE PPN
MOVEM T1,PTHFIL+.PTPPN ;STORE IT
SETZM PTHFIL+.PTSFD ;TERMINATE PATH
MOVE T1,[FOPSIZ,,FOPFIL] ;SET UP AC
FILOP. T1, ;CREATE THE FILE
SKIPA ;CAN'T
JRST COMP.0 ;ONWARD
CAIN T1,ERNRM% ;NO ROOM?
JRST COMP.3 ;WE MUST HAVE JUST CREATED THE UFD
JRST COMP.1 ;ELSE WE HAVE A REAL ERROR
COMP.0: MOVE T1,[.DUUFD,,T2] ;SET UP AC
LDB T2,[POINTR (FOPFIL+.FOFNC,FO.CHN)] ;GET CHANNEL NUMBER
DISK. T1, ;TELL MONITOR UFD COMPRESSION WANTED
JRST COMP.1 ;CAN'T
MOVE T1,[1,,T2] ;SET UP AC
MOVE T2,FOPFIL+.FOFNC ;GET FUNCTION WORD
ANDX T2,FO.CHN ;KEEP JUST THE CHANNEL
HRRI T2,.FOREL ;LOAD FUNCTION CODE
FILOP. T1, ;RELEASE CHANNEL AND COMPRESS UFD
JRST COMP.1 ;CAN'T
JRST COMP.2 ;FINISH UP
COMP.1: MOVE T1,["%",,'CCU'] ;FLAG AS WARNING
MOVEI T2,[ASCIZ |Could not perform UFD compression on @D.UFD|]
PUSHJ P,TEXT ;GENERATE TEXT
COMP.2: MOVE T1,[FO.PRV!FO.ASC+.FODLT] ;GET RENAME FUNCTION
MOVEM T1,FOPFIL+.FOFNC ;STORE IT
MOVEI T1,RENFIL ;POINT TO RENAME BLOCK
HRLM T1,FOPFIL+.FOLEB ;STORE IT
MOVE T1,[FOPSIZ,,FOPFIL] ;SET UP AC
FILOP. T1, ;DELETE THE FILE
JFCL
COMP.3: MOVE T1,[1,,T2] ;SET UP AC
MOVE T2,FOPFIL+.FOFNC ;GET FUNCTION WORD
ANDX T2,FO.CHN ;KEEP JUST THE CHANNEL
HRRI T2,.FOREL ;LOAD FUNCTION CODE
FILOP. T1, ;RELEASE CHANNEL
JFCL ;IGNORE ERRORS
PJRST SETFIL ;RESET FILE BLOCKS AND RETURN
SUBTTL UFD date/time handling
; Get the UFD creation date/time
;
GETDTM: LDB T1,[POINTR (LKPFIL+.RBPRV,RB.CRD)] ;GET LOW DATE
LDB T2,[POINTR (LKPFIL+.RBPRV,RB.CRT)] ;GET TIME
LDB T3,[POINTR (LKPFIL+.RBEXT,RB.CRX)] ;GET HIGH DATE
LSH T3,^D12 ;SHIFT IT OVER
IORI T1,(T3) ;OR INTO RESULT
MOVEM T1,.UFCDT(AP) ;SAVE THE DATE
MOVEM T2,.UFCTM(AP) ;SAVE THE TIME
POPJ P, ;RETURN
; Store the UFD creation date/time
;
PUTDTM: DATE T1, ;GET DATE IN 15 BIT FORMAT
DPB T1,[POINTR (LKPBLK+.RBPRV,RB.CRD)] ;SAVE LOW DATE
LSH T1,-^D12 ;SHIFT OFF 12 BITS
DPB T1,[POINTR (LKPBLK+.RBEXT,RB.CRX)] ;SAVE HIGH DATE
MSTIME T1, ;GET CURRENT TIME IN MILLISECONDS
IDIVI T1,^D60000 ;CONVERT TO MINUTES
DPB T1,[POINTR (LKPBLK+.RBPRV,RB.CRT)] ;SAVE TIME
POPJ P, ;RETURN
SUBTTL Random messages
MNTMSG: MOVE T1,["[",,'MNT'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Structure @A mounted|]
PJRST TEXT ;GENERATE TEXT AND RETURN
DMOMSG: MOVE T1,["[",,'DMO'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Structure @A dismounted|]
PJRST TEXT ;GENERATE TEXT AND RETURN
RCPMSG: MOVE T1,["[",,'RDU'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Recomputing disk usage|]
PJRST TEXT ;GENERATE TEXT AND RETURN
QTAMSG: MOVE T1,.UFFLG(AP) ;GET FLAG WORD
TXNE T1,UF.NUE ;DOES A UFD EXIST?
JRST NUSMSG ;NO UFD ON STRUCTURE
MOVE T1,["[",,'QTA'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |@A@I|] ;GET TEXT
MOVX T3,UF.TSP ;GET A BIT
TDNE T3,.UFFLG(AP) ;WANT BOTH STR AND PPN IN MESSAGE?
MOVEI T2,[ASCIZ |@D@I|] ;YES
PJRST TEXT ;GENERATE TEXT AND RETURN
NUSMSG: MOVE T1,["%",,'NUS'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |No UFD exists on structure @A|]
PJRST TEXT ;GENERATE TEXT AND RETURN
ASLMSG: MOVE T1,["[",,'ASL'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Structure @A added to the system search list|]
PJRST TEXT ;GENERATE TEXT AND RETURN
RSLMSG: MOVE T1,["[",,'RSL'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Structure @A removed from the system search list|]
PJRST TEXT ;GENERATE TEXT AND RETURN
AJLMSG: MOVE T1,["[",,'AJL'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Structure @A added to the search list of job @F|]
PJRST TEXT ;GENERATE TEXT AND RETURN
RJLMSG: MOVE T1,["[",,'RJL'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Structure @A removed from the search list of job @F|]
PJRST TEXT ;GENERATE TEXT AND RETURN
SUBTTL Set and clear UFD interlocks
; Set UFD interlock
;
LOKUFD: MOVX T1,UF.NLK ;WANT TO INTERLOCK THE UFD?
TDNE T1,.UFFLG(AP) ;CHECK
POPJ P, ;NOPE - CALLER SHOULD HAVE DONE IT
PUSHJ P,ULOCK ;INTERLOCK THE UFD
JRST LOKU.1 ;CAN'T -- WE'LL WAIT A BIT
LOKU.0: SETZM LOKCNT ;CLEAR THE WAIT COUNTER
AOS LOKFLG ;REMEMBER UFD INTERLOCKED
POPJ P, ;RETURN
;HERE IF WE FAILED THE FIRST TIME 'ROUND; LETS SET UP FOR A RETRY LOOP
LOKU.1: MOVEI T2,^D60 ;GET NUMBER OF SECONDS IN A MINUTE
IDIVI T2,LOKTIM ;DIVIDE BY RETRY FREQUENCY
IMULI T2,LOKLIM ;MULTIPLY BY NUMBER OF MINUTES TO RETRY
;GIVING TOTAL RETRY COUNT
HRROM T2,LOKCNT ;PUT -1,,COUNT IN A SAFE PLACE
MOVE T1,["[",,'WUI'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Waiting for UFD interlock for structure @D|]
PUSHJ P,TEXT ;GENERATE TEXT
LOKU.2: MOVEI T1,LOKTIM ;GET SLEEP INTERVAL
SLEEP T1, ;SLEEP IT OFF
PUSHJ P,ULOCK ;TRY FOR THE INTERLOCK AGAIN
SKIPA ;CURSES! FOILED AGAIN.
JRST LOKU.0 ;WE DID GET IT--GO BACK TO USER
HRRZ T2,LOKCNT ;GET THE COUNTER - ULOCK TRASHED IT
SOJLE T2,LOKU.3 ;DECREMENT. JUMP IF WE'RE OUT OF CHANCES
HRRM T2,LOKCNT ;PUT COUNT BACK
JRST LOKU.2 ;AND LOOP AROUND
LOKU.3: MOVE T1,["%",,'CSU'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Can't set UFD interlock for @D|]
PJRST TEXT ;GENERATE TEXT AND RETURN
; Clear UFD interlock
;
CLRUFD: SKIPN LOKFLG ;HAVE THE INTERLOCK?
POPJ P, ;NO
PUSHJ P,UNLOCK ;RELEASE THE UFD INTERLOCK
JRST CLRU.1 ;CAN'T
SETZM LOKFLG ;CLEAR INTERLOCK FLAG
POPJ P, ;RETURN
CLRU.1: MOVE T1,["%",,'CCU'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Can't clear UFD interlock for @D|]
PJRST TEXT ;GENERATE TEXT AND RETURN
; Set the UFD interlock (called only by UFDLOK and LOKUFD)
;
ULOCK: MOVE T1,[3,,T2] ;SET UP AC
MOVX T2,.FSULK ;GET FUNCTION CODE
MOVE T3,.UFSTR(AP) ;GET STRUCTURE NAME
MOVX T4,UF.IBP ;BIT TO TEST
TDNN T4,.UFFLG(AP) ;IN BEHALF OF ANOTHER PPN?
SKIPA T4,.UFPPN(AP) ;GET PPN
MOVNI T4,1 ;KEEP IN SYNCH
STRUUO T1, ;SET INTERLOCK
POPJ P, ;RETURN
JRST CPOPJ1 ;RETURN
; Clear the UFD interlock (called only by UFDCLR and CLRUFD)
;
UNLOCK: MOVE T1,[3,,T2] ;SET UP AC
MOVX T2,.FSUCL ;GET FUNCTION CODE
MOVE T3,.UFSTR(AP) ;GET STRUCTURE NAME
MOVX T4,UF.IBP ;BIT TO TEST
TDNN T4,.UFFLG(AP) ;IN BEHALF OF ANOTHER PPN?
SKIPA T4,.UFPPN(AP) ;GET PPN
MOVNI T4,1 ;KEEP IN SYNCH
STRUUO T1, ;CLEAR INTERLOCK
POPJ P, ;CAN'T
JRST CPOPJ1 ;RETURN
SUBTTL Recompute checking
; Here to see if we need to recompute disk usage.
; Call: PUSHJ P,RCPCHK
; <NON-SKIP> ;RECOMPUTING NOT NECESSARY
; <SKIP> ;NEED TO RECOMPUTE
;
RCPCHK: PUSHJ P,JSPCHK ;CHECK FOR OTHER JOBS SAME PPN
MOVE T1,.UFFLG(AP) ;GET FLAG WORD
TXNE T1,UF.NUE ;DOES A UFD EXIST?
POPJ P, ;THEN WE CAN'T RECOMPUTE
TXNE T1,UF.ARD ;ALWAYS RECOMPUTE DISK USAGE?
JRST RCPC.5 ;YES
SKIPN JSPFLG ;OTHER JOBS SAME PPN?
TXNE T1,UF.NRD ;NEVER RECOMPUTE DISK USAGE?
POPJ P, ;THATS RIGHT
TXNE T1,UF.AIS ;STR ALREADY IN S/L?
JRST RCPC.2 ;YES
RCPC.1: MOVE T1,.UFSTR(AP) ;GET STR NAME
LDB T2,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
CAIE T2,.UFRDU ;JUST RECOMPUTING DISK USAGE?
PUSHJ P,FINDOS ;SEE IF IT'S IN OUR SEARCH LIST ALREADY
RCPC.2: SKIPA T1,[RP.LOG] ;IT ISN'T - GET LOGGED IN BIT
SETZ T1, ;SKIP RIPLOG TEST SINCE ALREADY MOUNTED
SKIPGE T2,.UFQTO(AP) ;GET DESIRED LOGGED-OUT QUOTA
MOVE T2,LKPFIL+.RBQTO ;IT'S DEFAULTED - USE WHAT THE RIB HAS
LDB T3,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
CAIN T3,.UFMNT ;TEST RIPLOG ONLY ON A MOUNT
TDNN T1,LKPFIL+.RBSTS ;WAS LAST USE LOGGED-OUT CLEANLY?
SKIPGE T1,LKPFIL+.RBUSD ;GET BLOCKS USED
MOVE T1,[377777,,777777] ;GET +INFINITY TO FORCE RECOMP
CAMG T1,T2 ;USED MORE THAN LOGGED-OUT QUOTA?
POPJ P, ;NO - THEN WE'RE OK
RCPC.5: SETOM RIBERR ;INIT ERROR BIT COUNTER
SETOM RCPFLG ;FLAG RECOMPUTING
JRST CPOPJ1 ;RETURN AND RECOMPUTE DISK USAGE
SUBTTL Check for over quota on dismount
QTACHK: MOVX T1,UF.NUE ;GET THE NO UFD CREATED BIT
TDNN T1,.UFFLG(AP) ;DID WE SET IT?
SKIPE JSPFLG ;OTHER JOBS SAME PPN?
POPJ P, ;YES - DON'T DO QUOTA CHECKING
MOVE T1,[.DUFRE,,T2] ;SET UP UUO
MOVE T2,.UFSTR(AP) ;GET STR NAME
MOVE T3,.UFPPN(AP) ;GET PPN
DISK. T1, ;RETURN FREE SPACE IN THE UFD
POPJ P, ;CAN'T - BYPASS QUOTA CHECK
CAMN T1,[1B0] ;LOGGED IN PPN?
POPJ P, ;NO - BYPASS QUOTA CHECK
MOVNS T1 ;MAKE IT NEGATIVE
ADD T1,.UFQTF(AP) ;BLOCKS USED = FCFS - FREE
; ADD T1,.UFQTR(AP) ;INCLUDE RESERVED BLOCKS
MOVEM T1,.UFUSD(AP) ;SAVE BLOCKS USED
SUB T1,.UFQTO(AP) ;TAKE OFF LOGGED-OUT QUOTA
JUMPLE T1,CPOPJ ;RETURN IF NOT OVER QUOTA
QTAC.1: MOVEM T1,OVRQTA ;SAVE AMOUNT WE'RE OVER QUOTA BY
MOVE T1,["%",,'OVQ'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |Over quota by @H blocks|] ;GET TEXT
PUSHJ P,TEXT ;GENERATE TEXT
MOVX T1,UF.NOQ ;GET NO QUOTA CHECKING BIT
TDNE T1,.UFFLG(AP) ;FORCE DISMOUNT ANYWAY?
POPJ P, ;RETURN
$ERR (SND) ;? STRUCTURE NOT DISMOUNTED
SUBTTL Check for other jobs same PPN
JSPCHK: MOVE T1,.UFSTR(AP) ;GET STR NAME
MOVEM T1,GOBBLK+.DFGNM ;SAVE IT
MOVE T1,.UFPPN(AP) ;GET THE PPN
MOVEM T1,GOBBLK+.DFGPP ;SAVE IT
MOVN T1,HGHJOB ;GET -NUMBER OF JOBS
HRLZS T1 ;MAKE AN AOBJN POINTER
ADDI T1,1 ;START WITH JOB 1
MOVE T2,.UFJOB(AP) ;GET JOB NUMBER
JSPC.1: HRRZM T1,GOBBLK+.DFGJN ;SAVE THE JOB NUMBER
MOVE T3,[.DFGNM+1,,GOBBLK] ;SET UP UUO
CAIE T2,0(T1) ;WANT TO IGNORE THIS JOB?
GOBSTR T3, ;IS THE STR IN THIS JOB'S S/L?
AOBJN T1,JSPC.1 ;NO - ONTO THE NEXT JOB
SKIPGE T1 ;FOUND ANOTHER USER USING THE STR?
SETOM JSPFLG ;YES - SET FLAG
POPJ P, ;RETURN
SUBTTL Directory and File error processing
; Here on a directory I/O error
;
DIRIOE: MOVEM T1,IOS ;SAVE I/O STATUS
MOVEI T1,FOPBLK(P1) ;GET FILOP BLOCK ADDRESS
MOVEM T1,FOPADR ;SAVE IT
MOVE T1,["%",,'IOE'] ;FLAG I/O ERROR AS WARNING
MOVEI T2,[ASCIZ |Directory I/O error @B for @J|]
PJRST TEXT ;GENERATE TEXT AND RETURN
; Here when a file lookup fails
;
FILERR: SKIPA T2,[FOPFIL] ;POINT TO FILOP BLOCK
; Here when a directory lookup fails
;
DIRERR: MOVEI T2,FOPBLK(P1) ;POINT TO FILOP BLOCK
MOVEM T2,FOPADR ;SAVE ADDRESS
MOVEM T1,FOPERR ;SAVE FILOP ERROR CODE
MOVE T1,["%",,'LKP'] ;FLAG LOOKUP ERROR AS A WARNING
MOVEI T2,[ASCIZ |LOOKUP error (@E) for @J|]
PJRST TEXT ;GENERATE TEXT AND RETURN
SUBTTL Text generation routines
; Build a text message
; Call: MOVE T1, severity chr,,prefix
; MOVEI T2, address of ASCIZ text
; PUSHJ P,TEXT
;
TEXT: MOVEM T1,.UFPFX(AP) ;SAVE PREFIX
MOVE T1,[TXTBUF,,TXTBUF+1] ;SET UP BLT
SETZM TXTBUF ;CLEAR THE FIRST WORD
BLT T1,TXTBUF+BUFSIZ-1 ;CLEAR TEH ENTIRE BLOCK
MOVE BP,[POINT 7,TXTBUF] ;SET UP BYTE POINTER
HRLI T2,(POINT 7,) ;MAKE A BYTE POINTER
MOVEM T2,TXTPTR ;SAVE IT
TEXT.1: ILDB T1,TXTPTR ;GET A CHARACTER
JUMPE T1,TEXT.3 ;DONE IF END OF STRING
CAIN T1,"@" ;SPECIAL FLAG CHARACTER?
JRST TEXT.2 ;YES
PUSHJ P,TCHAR ;TYPE NORMAL CHARACTER
JRST TEXT.1 ;LOOP
TEXT.2: ILDB T1,TXTPTR ;GET NEXT CHARACTER
JUMPE T1,TEXT.3 ;SHOULDN'T NEED THIS CHECK
SUBI T1,"A" ;COMPUTE INDEX
PUSHJ P,@TXTTAB(T1) ;PROCESS SPECIAL TYPEOUT
JRST TEXT.1 ;LOOP
TEXT.3: SKIPE .UFTYO(AP) ;WANT TO SEE THIS?
PUSHJ P,@.UFTYO(AP) ;INFORM CALLING PROGRAM
POPJ P, ;RETURN
TXTTAB: EXP TSTRUC ;A - STRUCTURE
EXP TIOS ;B - I/O STATUS
EXP TPPN ;C - PPN
EXP TSTPPN ;D - STR:[PPN]
EXP TFOPER ;E - FILOP ERROR
EXP TJOBN ;F - JOB NUMBER
EXP TFUNCT ;G - FUNCTION CODE
EXP TOVERQ ;H - OVER QUOTA
EXP TQUOTA ;I - QUOTAS
EXP TFILE ;J - FILESPEC
EXP TTEXT ;K - TEXT
; Character output
;
TCHAR: CAME BP,[POINT 7,TXTBUF+BUFSIZ-1,27] ;BUFFER FULL?
IDPB T1,BP ;NO - STORE CHARACTER
POPJ P, ;RETURN
; Sixbit output
;
TSIXW: SKIPN T2,T1 ;PUT IN A BETTER PALCE
POPJ P, ;NOTHING TO OUTPUT
TSIX.1: LSHC T1,6 ;SHIFT IN A CHARACTER
ANDI T1,77 ;STRIP OFF JUNK
ADDI T1," " ;MAKE IT ASCII
PUSHJ P,TCHAR ;STORE IT
JUMPN T2,TSIX.1 ;CONTINUE IF MORE
POPJ P, ;RETURN
; String output routine
;
TSTRG: TXO T1,<POINT 7> ;MAKE A BYTE POINTER
PUSH P,T1 ;SAVE IT
TSTR.1: ILDB T1,(P) ;GET A CHARACTER
JUMPE T1,TSTR.2 ;DONE?
PUSHJ P,TCHAR ;STORE CHARACTER
JRST TSTR.1 ;LOOP
TSTR.2: POP P,T1 ;TRIM STACK
POPJ P, ;RETURN
; Decimal and octal output
;
TDECW: SKIPA T3,[12] ;RADIX 10
TOCTW: MOVEI T3,10 ;RADIX 8
TRDXW: IDIVI T1,(T3) ;DIVIDE BY RADIX
HRLM T2,(P) ;STORE REMAINDER ON STACK
SKIPE T1 ;DONE?
PUSHJ P,TRDXW ;NO - RECURSE
HLRZ T1,(P) ;GET A CHARACTER
ADDI T1,"0" ;MAKE IT ASCII
PJRST TCHAR ;STORE TI AND RETURN
; PPN output
;
TPPNW: PUSH P,T1 ;SAVE PPN
MOVEI T1,"[" ;GET BRACKET
PUSHJ P,TCHAR ;TYPE IT
POP P,T1 ;GET PPN
PUSHJ P,THLFW ;TYPE HALF WORDS
MOVEI T1,"]" ;GET BRACKET
PJRST TCHAR ;TYPE IT AND RETURN
; Type word as half words
;
THLFW: PUSH P,T1 ;SAVE WORD
HLRZS T1 ;GET LH
PUSHJ P,TOCTW ;TYPE IT
MOVEI T1,"," ;SET SEPARATOR
PUSHJ P,TCHAR ;TYPE IT
POP P,T1 ;GET WORD BACK
HRRZS T1 ;GET RH
PJRST TOCTW ;TYPE IT AND RETURN
; Structure output
;
TSTRUC: MOVE T1,.UFSTR(AP) ;GET STR NAME
PJRST TSIXW ;TYPE IT AND RETURN
; Type STR:[PPN]
;
TSTPPN: MOVE T1,.UFSTR(AP) ;GET STRUCTURE NAME
PUSHJ P,TSIXW ;TYPE IT
MOVEI T1,":" ;GET A COLON
PUSHJ P,TCHAR ;SEPARATE FROM PPN
; Type [PPN] from argument block
;
TPPN: MOVE T1,.UFPPN(AP) ;GET PPN
PJRST TPPNW ;TYPE IT AND RETURN
; Type FILOP. UUO error code
;
TFOPER: MOVE T1,FOPERR ;GET FILOP ERROR
PJRST TOCTW ;TYPE IT AND RETURB
; Type job nnn
;
TJOBN: MOVE T1,.UFJOB(AP) ;GET JOB NUMBER
PJRST TDECW ;TYPE IT AND RETURN
; Type function code
;
TFUNCT: LDB T1,[POINTR (.UFFLG(AP),UF.FNC)] ;GET FUNCTION CODE
PJRST TOCTW ;TYPE IT AND RETURN
; Type blocks over quota
;
TOVERQ: MOVE T1,OVRQTA ;GET NUMBER OF BLOCKS
PJRST TDECW ;TYPE IT AND RETURN
; Type quotas
;
TQUOTA: MOVEI T4,0 ;CLEAR COUNTER
TQUO.1: HRRZ T1,QTATAB(T4) ;GET SOME TEXT
PUSHJ P,TSTRG ;TYPE IT
HLRZ T1,QTATAB(T4) ;GET AN INDEX
ADDI T1,(AP) ;OFFSET INTO BLOCK
MOVE T1,(T1) ;GET A NUMBER
CAMN T1,[.INFIN] ;+INFINITY?
JRST TQUO.2 ;YES - MAKE IT PRETTY
PUSHJ P,TDECW ;TYPE IT
JRST TQUO.3 ;SEE IF WE'RE FINISHED
TQUO.2: MOVEI T1,[ASCIZ |infinity|] ;LOOKS BETTER THAN A LARGE NUMBER
PUSHJ P,TSTRG ;TYPE TEXT
TQUO.3: CAIGE T4,QTAMAX ;DONE?
AOJA T4,TQUO.1 ;NO - GO ON
POPJ P, ;RETURN
; Macro to build QTATAB
;
DEFINE $QTA (IDX,TXT),<XWD .UF'IDX,[ASCIZ | 'TXT':|]>
; Table of quota indicies and text strings
;
QTATAB: $QTA (QTF,<In>) ;LOGGED-IN
$QTA (QTO,<Out>) ;LOGGED-OUT
; $QTA (QTR,<Reserved>) ;RESERVED
$QTA (USD,<Used>) ;USED
QTAMAX==.-QTATAB-1 ;LENGTH OF TABLE
; Type text
;
TTEXT: MOVE T1,TXTADR ;GET ADDRESS
PJRST TSTRG ;TYPE IT AND RETURN
; Type I/O status
;
TIOS: MOVEI T1,"(" ;GET LEFT PARENTHESIS
PUSHJ P,TCHAR ;TYPE IT
HRLZ T1,IOS ;GET I/O STATUS WORD
JFFO T1,.+1 ;GET NUMBER OF LEADING ZEROS
IDIVI T2,3 ;GET NUMBER OF LEADING DIGITS
SKIPA T1,["0"] ;MAKE ZERO THE LEADING DIGIT
PUSHJ P,TCHAR ;TYPE A ZERO
SOJGE T2,.-1 ;LOOP
MOVEI T1,")" ;GET RIGHT PARENTHESIS
PJRST TCHAR ;TYPE IT AND RETURN
; Filespec output
;
TFILE: MOVE T4,FOPADR ;COPY FILOP BLOCK ADDRESS
MOVE T1,.UFSTR(AP) ;ALWAYS GET STRUCTURE NAME FROM HERE
PUSHJ P,TSIXW ;TYPE IT
MOVEI T1,":" ;TERMINATE IT PROPERLY
PUSHJ P,TCHAR ;STORE COLON
MOVE T1,.FOLEB(T4) ;POINT TO LOOKUP BLOCK
MOVEI T2,TSIXW ;ASSUME SIXBIT
HLRZ T3,.RBEXT(T1) ;GET EXTENSION
MOVE T1,.RBNAM(T1) ;AND FILE NAME
CAIN T3,'UFD' ;A DIRECTORY?
MOVEI T2,TPPNW ;ITS A PPN
PUSHJ P,(T2) ;TYPE FILE NAME
MOVEI T1,"." ;GET A PERIOD
PUSHJ P,TCHAR ;STORE IT
MOVE T1,.FOLEB(T4) ;POINT TO LOOKUP BLOCK
HLLZ T1,.RBEXT(T1) ;GET EXTENSION
PUSHJ P,TSIXW ;TYPE IT
HLRZ T1,.RBEXT(T1) ;GET EXTENSION AGAIN
CAIN T1,'UFD' ;A UFD?
POPJ P, ;YES - ALL DONE
MOVE T1,.FOLEB(T4) ;POINT TO LOOKUP BLOCK
MOVE T4,.RBPPN(T1) ;POINT TO PATH BLOCK
MOVEI T1,"[" ;GET BRACKET
PUSHJ P,TCHAR ;TYPE IT
MOVE T1,.PTPPN(T4) ;GET PPN
PUSHJ P,THLFW ;TYPE AS HALF WORDS
MOVEI T4,.PTSFD(T4) ;POINT TO START OF SFDS
TFIL.2: SKIPN (T4) ;HAVE AN SFD?
JRST TFIL.3 ;NO - DONE
MOVEI T1,"," ;GET A COMMA
PUSHJ P,TCHAR ;STORE IT
MOVE T1,(T4) ;GET SFD
PUSHJ P,TSIXW ;TYPE IT
AOJA T4,TFIL.2 ;LOOP FOR MORE
TFIL.3: MOVEI T1,"]" ;GET A BRACKET
PJRST TCHAR ;TERMINATE PATH PROPERLY AND RETURN
SUBTTL Error processing
ERRPRC: MOVEI T1,@(P) ;GET CALLER'S PC
HRRZ T1,(T1) ;GET ERROR CODE IN RH
MOVEM T1,.UFERR(AP) ;STORE IN ARGUMENT BLOCK
HLRZ T1,ERRTAB-1(T1) ;GET PERFIX
HRLI T1,"?" ;FLAG IT AS FATAL
MOVE T2,.UFERR(AP) ;GET THE ERROR CODE
HRRZ T2,ERRTAB-1(T2) ;GET ERROR TEXT ADDRESS
PUSHJ P,TEXT ;GENERATE TEXT
PUSHJ P,KILCHN ;KILL OFF ANY OPEN CHANNELS
PUSHJ P,CLRUFD ;CLEAR ANY UFD INTERLOCK WE MIGHT OWN
JRST ERRXIT ;MAKE A QUICK EXIT
; Kill off any open channels the might be left around when
; an error occurs
;
KILCHN: MOVEI T1,FOPBLK ;POINT TO START OF FILOP BLOCKS
MOVEI T2,DIRLVL ;GET DIRECTORY LEVEL COUNT
KILC.1: MOVE T3,[1,,T4] ;SET UP AC
MOVE T4,.FOFNC(T1) ;GET FUNCTION WORD
ANDX T4,FO.CHN ;KEEP JUST THE CHANNEL NUMBER
JUMPE T4,KILC.2 ;WE NEVER USE CHANNEL 0
HRRI T4,.FOREL ;GET NEW FUNCTION CODE
FILOP. T3, ;RELEASE THE CHANNEL
JFCL ;IGNORE ERRORS
KILC.2: ADDI T1,FOPSIZ ;POINT TO NEXT FILOP BLOCK
SOJG T2,KILC.1 ;LOOP
MOVEI T1,FOPFIL ;POINT TO SPECIAL FILOP BLOCK
JUMPE T2,KILC.1 ;RELEASE THAT CHANNEL TOO
POPJ P, ;RETURN
; Macro to build ERRTAB
;
DEFINE $ERRS (PFX,TXT),<''PFX'',,[ASCIZ |TXT|]>
; Table of error strings
;
ERRTAB:
$ERRS (IDV,<Illegal device "@A">) ;(01) UFIDV%
$ERRS (ISN,<Improper structure name "@A">) ;(02) UFISN%
$ERRS (IOE,<Directory I/O error @B>) ;(03) UFIOE%
$ERRS (CAD,<Can't access directory>) ;(04) UFCAD%
$ERRS (LFU,<LOOKUP error (@E) for @D.UFD>) ;(05) UFLFU%
$ERRS (RFU,<RENAME error (@E) for @D.UFD>) ;(06) UFLFU%
$ERRS (CRS,<Can't read search list for job @F>) ;(07) UFCRS%
$ERRS (IFC,<Illegal function code (@G)>) ;(10) UFIFC%
$ERRS (EFU,<ENTER error (@E) for @D.UFD>) ;(11) UFEFU%
$ERRS (CCS,<Can't change search list>) ;(12) UFCCS%
$ERRS (CSO,<Can't reset original search list after structure status change failed>) ;(14) UFCSO%
$ERRS (CSS,<Can't change structure status for @D>) ;(14) UFCSS%
$ERRS (SND,<Structure @A not dismounted>) ;(15) UFSND%
$ERRS (UBT,<UFD interlock for @A is busy too long>) ;(16) UFUBT%
$ERRS (UIC,<UFD interlock for @A cannot be cleared>) ;(17) UFUIC%
$ERRS (PGF,<Programmer number generation failed>) ;(20) UFPGF%
SUBTTL Data storage
LIT
RELOC 0
USRACS: BLOCK 20 ;USER ACS
ZBEG:! ;START OF BLOCK TO CLEAR
MFDPPN: BLOCK 1 ;MFD PPN
SYSPPN: BLOCK 1 ;SYS PPN
HGHJOB: BLOCK 1 ;HIGHEST JOB NUMBER IN USE
SLFFLG: BLOCK 1 ;SELF (OUR JOB)
LOKFLG: BLOCK 1 ;UFD INTERLOCK FLAG
OVRQTA: BLOCK 1 ;BLOCKS OVER QUOTA
RCPFLG: BLOCK 1 ;RECOMPUTING FLAG
JSPFLG: BLOCK 1 ;OTHER JOBS SAME PPN FLAG
RIBERR: BLOCK 1 ;COUNTER OF ERRORS FOUND IN RIBS
TOPERR: BLOCK 1 ;TOPLEVEL DIRECTORY ERROR CODE
LEVEL: BLOCK 1 ;CURRENT LEVEL
FUNBLK: BLOCK DIRLVL ;FILOP FUNCTION WORDS
FOPBLK: BLOCK FOPSIZ*DIRLVL ;FILOP BLOCKS
LKPBLK: BLOCK <RIBSIZ+1>*DIRLVL ;LOOKUP BLOCKS
DIRBLK: BLOCK DIRLVL ;CURRENT DIRECTORY BLOCK NUMBER
IDXBLK: BLOCK DIRLVL ;INDEX INTO BUFFER
PTHBLK: BLOCK PTHSIZ ;PATH BLOCK
DCHBLK: BLOCK DCHSIZ ;DSKCHR BLOCK
IOLIST: BLOCK 2 ;I/O COMMAND LIST
DSKBUF: BLOCK BLKSIZ ;DISK BUFFER
IOS: BLOCK 1 ;I/O STATUS ON INPUT ERRORS
FOPADR: BLOCK 1 ;FILOP BLOCK ADDRESS FOR TYPEOUT
FOPERR: BLOCK 1 ;FILOP ERROR CODE
FOPFIL: BLOCK FOPSIZ ;FILOP BLOCK FOR FILE LOOKUPS
LKPFIL: BLOCK RIBSIZ+1 ;LOOKUP BLOCK FOR FILE LOOKUPS
PTHFIL: BLOCK PTHSIZ ;PATH BLOCK FOR FILE LOOKUPS
RENFIL: BLOCK RIBSIZ+1 ;LOOKUP BLOCK FOR FILE RENAMES
TXTPTR: BLOCK 1 ;TEXT PROCESSOR BYTE POINTER
TXTADR: BLOCK 1 ;ASCIZ TEXT STRING ADDRESS
TXTBUF: BLOCK BUFSIZ ;TEXT BUFFER
BPC: BLOCK 1 ;BLOCKS PER CLUSTER
USZ: BLOCK 1 ;UNIT SIZE
CPU: BLOCK 1 ;CLUSTERS PER UNIT
RIBBLK: BLOCK BLKSIZ ;HOLDS A RIB
SUPFOP: BLOCK FOPSIZ ;FILOP BLOCK FOR SUPER I/O
OLDSL: BLOCK SLSIZE ;OLD SEARCH LIST BLOCK
NEWSL: BLOCK SLSIZE ;NEW SEARCH LIST BLOCK
GOBBLK: BLOCK .DFGST+1 ;GOBSTR UUO BLOCK
LOKCNT: BLOCK 1 ;COUNT OF RETRIES LEFT IF WE ARE
;WAITING FOR A UFD INTERLOCK TO CLEAR
ZEND:! ;END OF BLOCK TO CLEAR
END
Reference in New Issue View Git Blame Copy Permalink