Trailing-Edge
-
PDP-10 Archives
-
cuspmar86binsrc_2of2_bb-fp63a-sb
-
10,7/ufdset/ufdset.mac
There are 4 other files named ufdset.mac in the archive. Click here to see a list.
UNIVERSAL UFDPRM - Parameter file for UFDSET
SUBTTL D. Mastrovito /DPM 16-AUG-85
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1980,1981,1982,1983,1984,1985,1986.
;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==40 ;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.
;
;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.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 BUTY 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. 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==^D10+1 ;MAXIMUM NUMBER OF STRS = 10 + FENCE
SLSIZE==.FSDSO+<.DFJBL*STRMAX>+1 ;LENGTH OF A SEARCH LIST
LOKTIM==2 ;# SECS BETWEEN TRIES FOR UFD 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
MOVEM T1,.UFJOB(AP) ;RESET INCASE IT WAS DEFAULTED
MOVE T1,.UFPPN(AP) ;GET TARGET PPN
CAMN T1,[-1] ;DEFAULTED?
GETPPN T1, ;MAKE IT OUR PPN
JFCL ;JACCT
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 ;GET WILD PROGRAMMER NUMBER BIT
TDNE T1,.UFFLG(AP) ;WANT US TO GENERATE A PPN?
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
MOVE T1,.UFPPN(AP) ;GET PPN INCASE WE GENERATED ONE
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 T1,[.DCMAX,,DCHBLK] ;SET UP UUO
DSKCHR T1, ;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
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 FD 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
CAIN T3,.UFMNT ;MOUNT?
MOVX T2,UF.LGI ;SET RIPLOG
CAIN T3,.UFDMO ;DISMOUNT?
MOVX T2,UF.LGO ;CLEAR RIPLOG
TXNE T2,UF.LGI ;LOGGING IN?
TXO T1,RP.LOG ;YES
TXNE T2,UF.LGO ;LOGGIN OUT?
TXZ T1,RP.LOG ;YES
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.3 ;NOPE
MOVE T1,["%",,'FEE'] ;GET SEVERITY CHARACTER AND PREFIX
MOVEI T2,[ASCIZ |@A file errors exist|]
PUSHJ P,TEXT ;GENERATE TEXT
RENU.3: PUSHJ P,PUTDTM ;SET UFD CREATION DATE/TIME
CAIE T3,.UFDMO ;DISMOUNTING?
JRST RENU.4 ;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
CAME T1,LKPFIL+.RBQTF ;REMAING = FCFS QUOTA?
JRST RENU.4 ;DON'T ATTEMPT DELETE IF BLOCKS USED
MOVEI T1,.FODLT ;GET DELETE FUNCTION
HRRM T1,FOPFIL+.FOFNC ;SET IT
RENU.4: 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
AOS LOKFLG ;REMEMBER UFD INTERLOCKED
POPJ P, ;RETURN
LOKU.1: 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
MOVE T4,.UFPPN(AP) ;GET PPN
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
MOVE T4,.UFPPN(AP) ;GET PPN
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: 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
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.3: 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
RCPC.4: 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,RCPC.4 ;NO - ONTO THE NEXT JOB
SKIPGE T1 ;FOUND ANOTHER USER USING THE STR?
POPJ P, ;NO
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: 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 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
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
ZEND:! ;END OF BLOCK TO CLEAR
END