Trailing-Edge
-
PDP-10 Archives
-
bb-bt99q-bb
-
filuuo.x23
There is 1 other file named filuuo.x23 in the archive. Click here to see a list.
TITLE FILUUO LEVEL D DISK SERVICE ROUTINE V1217
SUBTTL DESIGNED BY T.HASTINGS,T.WACHS,C.WHITE CODED BY T.WACHS/TW 9-MAY-89
SEARCH F,S,DEVPRM
$RELOC
$HIGH
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1973,1974,1975,1976,1977,1978,1979,1980,1982,1984,1986,1988.
;ALL RIGHTS RESERVED.
.CPYRT<1973,1988>
XP VFILUUO,1217
FILUUO::ENTRY FILUUO
;ASSEMBLY PARAMETER FOR FNDFIL INTERLOCK
ENTRY FILSER
FILSER::
SUBTTL DEFINITIONS
;BITS IN THE ACCESS TABLE STATUS WORD
ACPCRE==:40
ACPSUP==:20
ACPUPD==:10
ACPREN==:200
ACRSUP==:2
ACPNIU==:400000
ACMCNT==:377400
ACPSMU==:4
IOSMON==400000 ;THIS FILE IS CURRENTLY DOING MONITOR IO
IOSAU==200000 ;THIS FILE HAS THE ALTER-UFD RESOURCE
IOSUPR==100000 ;SUPER USETI/USETO DONE ON THIS CHAN
IOSDA==40000 ;THIS FIL HAS DISK ALLOCATION QUEUE
IOSRIB==20000 ;RIB IS IN MONITOR BUFFER
IOSRDC==:10000 ;THIS USER CHANNEL HAS READ COUNT UP FOR FILE
IOSWLK==4000 ;FILE (WHOLE STR) IS SOFTWARE WRITE-=LOCKED
; EITHER FOR ALL JOBS OR FOR THIS JOB ONLY
IOSPBF==2000 ;PARTIAL BUFFER DONE
IOSFIR==1000 ;COMPUTE AND STORE OR CHECK THE CHECKSUM
IOSHMS==IOBEG ;HUNG-DEVICE MESSAGE ALREADY TYPED
IOSRST==IOFST ;RESET (RELEASE) WAS DONE ON A SPOOLED DEVICE
;THE FOLLOWING S BITS ARE DEFINED IN COMMON.MOD
;BECAUSE THEY WANT TO BE IN THE SAME POSITION IN S AS IN RIB STATUS WORD
;IOSHRE=100 ;HARD READ ERROR ENCOUNTERED
;IOSHWE=200 ;HARD WRITE ERROR ENCOUNTERED
;IOSSCE=400 ;SOFTWARE CHECKSUM ERROR ENCOUNTERED OR HARD POSITIONING ERROR
;IOSERR=IOSHRE+IOSHWE+IOSSCE
;IOSMER=-IOSERR
;BITS IN RH OF S
UDSX==:200 ;SUPER USETO IS TO WRITE FORMATS ON THE DISK
IOSFA==:400 ;DDB HAS FA RESOURCE (BUG, SHOULD BE IN LH)
;BITS IN LH(M) USED IN LOOKUP/ENTER/RENAME
UUOMSK==777000 ;MASK FOR ALL POSSIBLE UUO BITS
UUOLUK==400000 ;LOOKUP IN PROGRESS
UUOSFD==:200000 ;SFD FOUND ON SOME STR IN SEARCH LIST
UUOREN==:100000 ;RENAME IN PROGRESS
UUOUFD==:40000 ;AT LEAST 1 UFD FOUND IN SEARCH LIST (FNDFIL)
UUOUPD==20000 ;ENTER IS AN UPDATE
UUO2SF==:UUOUPD ;ON IF JUST SCANNING AT'S FOR AN SFD (2ND PASS)
UUOSF2==:UUOSFD+UUO2SF
UULKRN==:UUOLUK+UUOREN
UUODIR==:10000 ;UUO IS FOR A DIRECTORY
UALASK==4000 ;ALLOCATION REQUESTED ON ENTER
UPARAL==2000 ;BIT ON IF PARTIAL ALLOCATION OR ENTER
UTRTWC==2000 ;TRIED LOOKUP ON MORE THAN 1 SPECIFICATION
EXTUUO==1000 ;BIT ON IN LH(UUO) IF EXTENDED UUO
DEFINE NOSCHEDULE <>
DEFINE SCHEDULE <>
DEFINE CBDBUG(A,B)<>
REPEAT 0,<
THE FOLLOWING IS THE ORDER IN WHICH RESOURCES SHOULD BE OBTAINED:
FIRST GET: THEN GET:
MON BUF CB, DA, OR AU
CB DA
AU CB
>
SUBTTL INTERFACE SUBROUTINES WITH THE REST OF THE MONITOR
;DISPATCH TABLE
POPJ P, ;(-4) DEVOP UUO
JRST DBFSIZ ;(-3) GET BUFFER SIZE
JRST DSKINI ;(-2) INITIALIZE
JRST CPOPJ1## ;(-1) HUNG, LET DSKSEC HANDLE IT
DSKDSP::JRST DSKREL ;(0) RELEASE
JRST CLOSOU ;(1) OUTPUT CLOSE
JRST OUTPT ;(2) OUTPUT
JRST INPT ;(3) INPUT
JRST UENTR ;(4) ENTER
JRST ULOOK ;(5) LOOKUP
JRST DMPOUT ;(6) DUMP-MODE OUTPUT
JRST DMPIN ;(7) DUMP-MODE INPUT
JRST USETO0## ;(10) USETO
JRST USETI0## ;(11) USETI
POPJ P, ;(12) UGETF
JRST RENAM ;(13) RENAME
JRST CLOSIN ;(14) INPUT CLOSE
POPJ P, ;(15) UTPCLR
POPJ P, ;(16) MTAPE
$INIT
DSKINI: SETZM DSKDDB##+DEVIOS ;ZERO THE S WORD IN PROTOTYPE DDB
SETZM SYSPPB## ;INSURE THAT SYSPPB
SETZM SYSDOR## ;AND SYSDOR ARE 0
MOVE T1,STRAOB## ;INITIZE ALL STR DATA BLOCKS
DSKIN1: MOVE T3,TABSTR##(T1) ;SETT2=STR D.B.ADDR.
JUMPE T3,DSKIN2 ; IF 0 THEN NO F.S. FOR THIS #
SETZM STRJOB##(T3) ;CLEAR STRJOB
SETZM STRMNT##(T3) ;SET MOUNT COUNT 0
MOVE P2,SYSSRC## ;IN SYSTEM SEARCH LIST?
PUSHJ P,SLFNA##
JRST DSKIN2 ;NO
AOS STRMNT##(T3) ;YES - BUMP MOUNT COUNT
DSKIN2: AOBJN T1,DSKIN1 ;CHECK ALL STRS
MOVE T1,TIME## ;INIT SPOOL NAME GENERATOR TO RANDOM START
IDIVI T1,^D3600 ;START WITH MINUTES SINCE MIDNIGHT
ADD T1,THSDAT## ;PLUS DATE
MOVEM T1,SPLGEN## ;SAVE FOR FILSER
MOVSI T1,(POPJ P,) ;ONCE ONLY
MOVEM T1,DSKDSP+DINI ;SO DON'T CALL US AGAIN
POPJ P, ;AND RETURN
$HIGH
;SUBROUTINE TO DETERMINE IF A JOB HAS A SHARABLE DISK RESOURCE
;ENTER J=JOB NUMBER
;EXIT CPOPJ IF NO, CPOPJ1 IF YES
;RESPECTS ALL AC'S
FLSDR:: HLL J,JBTSTS##(J) ;JOB STATUS BITS
TLZ J,-1-JXPN ;CLEAR ALL BUT JXPN
TLZE J,JXPN ;RESTORE JOB NUMBER, SKIP IF JXPN CLEAR
POPJ P, ;JOB IS EXPANDING, LIE ABOUT RESOURCES
IFN FTMP,<
CAME J,MCUSER## ;OWN MC? CAN'T SWAP OWNER
>
CAMN J,CBUSER## ;JOB HAVE CB
PJRST CPOPJ1## ;YES
PJRST TSTFAD## ;NO, GO TEST AU, DA, AND FA
;SUBROUTINE TO CLEAN UP THE ACCESS TABLES FOR A JOB AFTER AN ERROR.
; DECREMENTS THE READ-COUNT IF READING, CLEARS THE STATUS BYTE IF WRITING
; AND INCREMENTS THE QUOTA IF CREATE OR SUPERSEDE
SWPCLN::HLRZ F,SWPDDB##+DEVSER ;START AT FIRST DSK
SWPCL1: MOVE T1,DEVMOD(F) ;IS THIS A DISK?
SKIPL DEVSPL(F)
TLNE T1,DVDSK
TDZA T2,T2 ;YES
POPJ P, ;NO MORE DISKS
LDB T1,PJOBN## ;IS IT OURS?
CAME T1,J
JRST SWPCL6 ;NO
HRRZ T1,DEVACC##(F) ;LOC OF A.T.
JUMPE T1,SWPCL6 ;THROUGH IF NONE
MOVE S,DEVIOS(F) ;DECREMENT READ-COUNT IF IT'S UP
TLZE S,IOSRDC
MOVNI T2,ACPCNT##
ADDB T2,ACCCNT##(T1) ;UPDATE COUNT, GET STATUS
MOVEM S,DEVIOS(F)
TRNN T2,ACPUPD+ACPREN+ACPCRE+ACPSUP ;IS THE FILE BEING WRITTEN?
JRST SWPCL4 ;NO
TRNN T2,ACPUPD+ACPREN ;YES, BEING RENAMED OR UPDATED?
JRST SWPCL2 ;NO
TRNN T2,ACMCNT ;YES, IS THE READ-COUNT NOW 0?
JRST SWPCL3 ;YES, CLEAN UP THE A.T.
MOVEI T3,DEPWRT##
TRNN T2,ACPREN ;IS THE FILE BEING RENAMED?
TDNN T3,DEVWRT##(F) ;NO, IS THIS DDB AN UPDATER?
JRST SWPCL5 ;NO, LEAVE A.T. ALONE
LDB T3,ACYWCT## ;HE IS AN UPDATER
SUBI T3,1 ;DECR COUNT OF UPDATERS
DPB T3,ACYWCT## ;DONT CLEAR ACPUPD IF OTHER UPDATERS
JUMPN T3,SWPCL4
JRST SWPCL3 ;CLEAN UP A.T.
SWPCL2: MOVE T2,ACCALC##(T1) ;NUMBER OF BLOCKS ALLOCATED TO THE FILE
HRRZ T3,DEVUFB##(F) ;LOC OF UFB
SKIPE T3
ADDM T2,UFBTAL##(T3) ;UPDATE THE USER'S QUOTA BY THE SIZE OF THE FILE
SWPCL3: MOVEI T2,ACPUPD+ACPREN+ACPSUP+ACPCRE
ANDCAB T2,ACCSTS##(T1) ;CLEAN OUT THE STATUS OF THE A.T.
SWPCL4: PUSH P,F ;SAVE F
SETZ F, ;INDICATE DONT USE CB (ON CLOCK LEVEL)
TRNN T2,ACMCNT ;READ-COUNT NOW 0?
PUSHJ P,ATRMOV## ;GET RID OF A.T.
POP P,F
SWPCL5: HLLZS DEVACC##(F)
SWPCL6: PUSHJ P,NXDDB## ;FIND NEXT DDB
CAMN J,.USJOB ;DON'T DO FUNNY SPACE IF NOT ADDRESSABLE
JUMPN F,SWPCL1 ;DO THIS ONE TOO
POPJ P, ;ALL DONE
;SUBROUTINE TO GET WORD POINTED TO BM FROM USER'S AREA
;RETURNS WORD IN T3, PRESERVES T1 AND T2
GTWDT3: PUSH P,T1 ;SAVE T1
PUSHJ P,GTWST2## ;GET THE WORD INTO T1
MOVE T3,T1 ;RETURN IT IN T3
JRST TPOPJ## ;RESTORE T1 AND RETURN
;ROUTINE FOR TESTING FOR SPECIAL DEVICE NAMES
;ENTER T1=DEVICE NAME
;EXIT CPOPJ IF NOT A SPECIAL DEVICE, WITH T1=NAME
;EXIT CPOPJ1 IF YES, T1=NAME, T2=INDEX IN TABLE (=0 FOR SYS, 1 FOR SXS)
; T3=0 IF JUST 'DEV', T3 =1 IF 'DEVX', AND DSKX EXISTS
; T4=INDEX INTO LOGICAL NAME TABLE IF A LOGICAL NAME
;CALL SDVTS1 TO IGNORE LOGICAL NAMES
;CALL SDVTSP TO IGNORE LOGICAL NAMES IF PT.PHO IS ON IN P1
SDVTSP: TLNN P1,PT.PHO## ;IGNORE LOGICAL NAMES?
SDVTST::PUSHJ P,LNMTST ;IS DEVICE A LOGICAL NAME?
JRST SDVTS1 ;NO, SEE IF IT IS IN TABLE
MOVEI T2,LIBNDX## ;YES, PRETEND IT IS LIB
SETZ T3, ;NOT DEVX
JRST CPOPJ1##
SDVTS1::SETZB T2,T3 ;T2=INDEX T3=0 IF STRAIGHT MATCH
TRNE T1,-1 ;ERSATZ DEVS ARE 3 CHARS
JRST SDVTS4 ; SO A LONGER NAME DOESN'T MATCH
SDVTS2: HLLZ T4,SDVTBL##(T2) ;NAME
CAMN T1,T4 ;MATCH?
JRST SDVTS3 ;EXTRA WORK IF LIB
CAIGE T2,SDVLEN## ;END OF TABLE?
AOJA T2,SDVTS2 ;NO, TRY NEXT
SDVTS4: TRNN T1,7777 ;NO REAL MATCH
TRNN T1,770000 ;IS IT DEVX?
POPJ P, ;NO - NO MATCH
PUSH P,T1 ;YES, SAVE NAME
HRLI T1,'DSK' ;MAKE IT DSKX
HRROI T2,770000 ;SET T2=MASK FOR DSKX
PUSHJ P,UNSRCH## ;LOOK FOR UNIT
PJRST TPOPJ## ;NOT FOUND
HLLZ T1,(P) ;DSKX EXISTS
PUSHJ P,SDVTS1 ;IS DEV A SPECIAL DEVICE?
PJRST TPOPJ## ;NO, NON-SKIP
CAIN T2,LIBNDX##
JRST TPOPJ## ;"LIBX" DOESN'T EXIST
MOVEI T3,1 ;YES, SET T3 NON-0
PJRST TPOPJ1## ;FOUND - SKIP RETURN
SDVTS3: CAIE T2,LIBNDX## ;GOOD RETURN IF NOT LIB:
PJRST CPOPJ1##
;DROP THROUGH TO NEXT PAGE IF LIB
;HERE ON DEVICE "LIB", BUT NO LOGICAL DEVICE BY THAT NAME
;SUBROUTINE TO FIND THE LIB (SPEC WHICH IS SEARCHED ON LOOKUP FAILURE)
;EXIT NON-SKIP IF NONE
;SKIP-RETURN IF FOUND, T4=INDEX
;PRESERVES T1-T3
FNDLB: SETZ T4, ;START AT 1ST LOGICAL NAME
SKIPE .USLNM ;ARE THERE LOG NAMES?
FNDLB1: SKIPN @.USLNM ;YES, AT END?
POPJ P, ;NO LIB
SKIPL @.USLNM ;IS THIS A LIB?
AOJA T4,FNDLB1 ;NO, TRY NEXT
JRST CPOPJ1## ;YES
;HERE TO UPDATE SYSDEV IN LH(F) AFTER ACC SET UP
SDVTSS: TLZ F,SYSDEV ;ASSUME NOT SYS:
MOVE T1,DEVPPN(F) ;PPN WE FOUND FILE IN
CAME T1,SYSPPN## ;IS IT SYS
CAMN T1,NEWPPN## ; OR NEW?
CAIA ;YES, SKIP ON
CAMN T1,OLDPPN## ;LAST CHANCE, IS IT OLD:?
SKIPA T2,DEVACC##(F) ;YES, GET A.T.
POPJ P, ;NO
LDB T1,ACYFSN## ;GET FSN WE FOUND FILE ON
PUSH P,P2
MOVE P2,SYSSRC##
PUSHJ P,SLFND## ;IS FSN IN SYS SEARCH LISTT?
TLZA F,SYSDEV ;NO
TLO F,SYSDEV ;YES, TELL THE WORLD WE FOUND IT ON SYS
POP P,P2
POPJ P, ;RETURN UPDATED SYSDEV BIT
;SUBROUTINE TO FIND A LOGICAL NAME
;ENTER T1=NAME
;EXIT T1=NAME, T3=BITS, T4=INDEX INTO TABLE
;ENTER AT LNMTSN IF F IS NOT POINTING AT A DDB
LNMTST::MOVE T4,DEVPHO##(F)
TLNE T4,DEPPHO## ;PHYSICAL ONLY?
JUMPN F,CPOPJ## ;YES, NO MATCH
LNMTSN::IFN FTXMON,<PUSHJ P,SSEC0##> ;ENTER SECTION ZERO
SETZ T4, ;START AT BEGINNING
CAMN T1,[-1] ;WOULD WE MATCH OLD-STYLE LIB KLUDGERY?
POPJ P, ;YES, HACK, NO MATCH FOR ARGUMENT OF -1
SKIPE .USLNM ;ANY AT ALL?
LNMTS1: SKIPN T3,@.USLNM ;YES, DONE?
POPJ P, ;NO MATCH
CAMN T1,(T3) ;IS THIS THE ONE WE WANT?
JRST CPOPJ1## ;MATCH
AOJA T4,LNMTS1 ;TRY NEXT
;ROUTINE TO SEE IF A LOGICAL NAME IS MAPPED TO NUL:
;CALL: MOVE T1, DEVICE NAME
; PUSHJ P,LNMNUL
; <NON-SKIP> ;NOT DEVICE NUL
; <SKIP> ;DEVICE NUL
LNMNUL::PUSHJ P,SAVT## ;SAVE SOME ACS
PUSHJ P,LNMTSN ;SEE IF A LOGICAL NAME
POPJ P, ;NO
IFN FTXMON,<HRRZS T3> ;CLEAR LH
MOVS T2,LNMDEV##(T3) ;GET DEVICE FROM FIRST COMPONENT
CAIN T2,'NUL' ;IS IT NUL?
AOS (P) ;YES
POPJ P, ;RETURN
;SUBROUTINE TO CHECK FOR DEVICE "NUL"
;RETURNS CPOPJ IF NUL:, ELSE CPOPJ1
NULTST::MOVE T1,DEVMOD(F) ;GET DEVICE BITS
TLNE T1,DVDSK ;A DISK
TLNN T1,DVTTY ;AND A TTY?
AOS (P) ;THEN IT CAN'T BE NUL
POPJ P, ;RETURN
;SUBROUTINE TO GET THE PPN ASSOCIATED WITH SYS:
;RETURNS NON-SKIP IF "SYS" IS A LOGICAL NAME OR A PATH(O)LOGICAL NAME
;SKIP-RETURNS WITH PPN IN T3 OTHERWISE
;RESPECTS ALL ACS EXCEPT T3
SYSNM:: PUSHJ P,SAVT## ;SAVE ACS
MOVE T1,.JDAT+SGAMOD##
TLNE T1,PHONLY ;PHYSICAL ONLY SYS?
JRST SYSNM1 ;YES, GET SYSPPN
SKIPE DEVLOG(F) ;IF F POINTS AT A DDB WITH A LOGICAL NAME
POPJ P, ;THE NAME MUST BE "SYS"
MOVSI T1,'SYS' ;SEE IF WE HAVE A PATH(O)LOGICAL NAME
PUSHJ P,LNMTST ;NO. LOGICAL NAME?
SYSNM1: SKIPA T3,.CPJOB## ;NO, GIVE SYS IS NOT A LOGICAL NAME RETURN
POPJ P, ;HAS SUCH A NAME
MOVE T3,JBTSFD##(T3)
TLNE T3,JBPXSY## ;NEW ENABLED?
SKIPA T3,NEWPPN## ;YES
MOVE T3,SYSPPN## ;NO
MOVEM T3,-3(P) ;WHERE SAVT WILL RESTORE T3 FROM
JRST CPOPJ1##
;SUBROUTINE TO TEST IF THE DEVICE WHOSE NAME IS IN T1 IS A DISK
;ENTER WITH J = JOB NUMBER
;RH(P1) CONTAINING DD%PHO IF PHYSICAL ONLY
;EXIT CPOPJ IF A DISK, WITH F=PROTOTYPE DDB
;EXIT CPOPJ1 IF NOT A DISK, OR A SINGLE-ACCESS DISK NOT FOR THIS JOB
;LIGHTS SYSDEV IN LH(F) IF THE NAME IS SOME FLAVOR OF SYS (EG "SYSB")
;CALLED BY DEVPHY
TSTDSK::JUMPE T1,CPOPJ1## ;"0" IS NOT A DISK
PUSHJ P,SAVT## ;SAVE T2-T4
MOVEI F,DSKDDB## ;SET F FOR PROTOTYPE DDB
PUSHJ P,ALIASD## ;IS NAME AN ALIAS FOR "DSK"?
POPJ P, ;YES. NON-SKIP RETURN
TRNN P1,DD%PHO## ;PHYSICAL ONLY?
PUSHJ P,LNMTST ;NO, LOOK FOR A LOGICAL NAME
CAIA ;NOT FOUND OR PHYSICAL ONLY
POPJ P, ;FOUND A LOGICAL NAME
PUSHJ P,SDVTS1 ;IS IT A SPECIAL DEV?
JRST TSTDS1 ;NO
MOVE T2,@SDVPPN##(T2) ;YES, GET ITS PPN
CAME T2,SYSPPN## ;IF IT IS SYS,
CAMN T2,NEWPPN## ;OR NEW,
CAIA ;YES, IT'S GOLDEN
CAMN T2,OLDPPN## ;NO, OLD IS LAST CHANCE
TLO F,SYSDEV ;YES, LIGHT SYSDEV
POPJ P, ;AND RETURN
TSTDS1: CAMN T1,['NUL '] ;'NUL'
POPJ P, ; IS A DISK
TLNN T1,-1 ;XWD 0,,"A"?
PJRST CPOPJ1## ;YES,NOT A DSK
PUSHJ P,SAVE2## ;S.L. ROUTINES CLOBBER P1 AND P2
PUSH P,U ;SAVE U FOR REST OF MON
PUSHJ P,SRSTR## ;USER SUPPLYING STR NAME?
SKIPA ;NOT AN STR NAME
JRST TSTDS2 ;YES, AN STR
PUSHJ P,MSKUNI## ;SET T2=MASK FOR NAME
MOVEI T4,SRUNI## ;ASSUME NO SECONDARY PORT SEARCH
IFN FTDUAL,<
TRNE P1,DD%ALT## ;ALSO SEARCHING FOR ALTERNATE PORTS
MOVEI T4,SRUNA## ;YES, GET THAT ROUTINE
>
PUSHJ P,(T4) ;IS USER SUPPLYING A UNIT NAME?
JRST UPOPJ1## ;NOT A DISK - SKIP RETURN
JFCL ;PHYSICAL DSK NAME
HRRZ T3,UNISTR(U) ;YES, SET T3 TO STR DB LOC
JUMPN T3,TSTDS2 ;IF UNIT NOT IN A STR
MOVE T1,.PDOBI##(W)
TLNE T1,(JP.OPP) ;DOES JOB HAVE OPR PRIVS?
JRST TSTDS6 ;YES, OK
JRST TSTDS4 ;NO, ONLY IF PRIV'D
TSTDS2: MOVE T4,STRPVS##(T3) ;F.S. IS PRIVATE BIT
TRNN T4,STPPVS## ;IS THIS A PRIVATE F.S.?
JRST TSTDS3 ;NO, ALL IS WELL
PUSHJ P,SLPTR## ;FIND THIS JOBS S.L.
JRST TSTDS4 ;NONE OR EMPTY, LEGAL ONLY IF PRIV'ED
HRRZ T1,STRFSN##(T3) ;F.S. NMBER
PUSHJ P,SLFND## ;IS THIS F.S. IN THE USER'S S.L.
JRST TSTDS4 ;NO, ILLEGAL UNLESS PRIV'ED
TSTDS3: SKIPLE T4,STRJOB##(T3) ;STR SINGLE-ACCESS?
CAIN J,(T4) ;YES. FOR THIS JOB?
JRST TSTDS6 ;YES, OK
TSTDS4: MOVE T1,JBTPPN##(J) ;NO. JOB MUST BE PRIVILEGED TO DO IT
;HERE IF TRYING TO GET A UNIT NOT IN AN STR, OR SINGLE ACCESS STR NOT FOR THIS JOB
;ALLOW IT IS JOB IS PRIVILEGED, OTHERWISE ERROR RETURN
JUMPGE M,TSTDS5 ;IF A COMMAND,
SKIPL DEVJOB(F) ;M NEGATIVE IF FILOP.
CAMN T1,FFAPPN## ; ONLY [1,2] IS LEGAL
TSTDS5: PUSHJ P,PRVJO## ;PRIV'D JOB?
JRST TSTDS7
TSTDS6:
IFE FTMDA,<
MOVE T2,UNIUST(U) ;NO NEW ACCESSES FOR UNIT?
TLNE T2,UNPNNA
> ;END IFE FTMDA
IFN FTMDA,<
PUSHJ P,CHKLOK## ;LOCKED?
> ;END IFN FTMDA
JRST UPOPJ1## ;YES, SAY IT ISNT A DSK
JRST UPOPJ## ;YES. OK RETURN
TSTDS7: CAMN T1,UMDPPN## ;IF USER MODE DIAG
JUMPE T3,UPOPJ## ;OK IF RIGHT PPN
JRST UPOPJ1## ;NOPE, LOSE
;ROUTINE TO WRITE THE SATS OF ALL UNITS WHICH HAVE CHANGED
;ENTER WITH RIB IN MONITOR BUFFER
;ENTER/EXIT WITH U=UNIT THAT HAS DA (IF ANY)
;ALWAYS EXITS WITH DA ON SAME UNIT AS WHEN ENTERED (IF ANY)
RIBSAT::TLNE S,IOSDA ;HAVE DA?
JRST RIBSAD ;YES
PUSHJ P,UPDA## ;NO, GET IT
PJRST RIBSAW ;WRITE CHANGED SATS, RETURNS DA
RIBSAD: PUSH P,U ;SAVE UNIT THAT HAS DA
PUSHJ P,RIBSAW ;WRITE CHANGED SATS
POP P,U ;GET ORIGINAL UNIT BACK
PUSHJ P,STORU## ;STORE IT IN DEVUNI
PJRST UPDA## ;GET DA BACK ON THAT UNIT
;ROUTINE TO WRITE SATS - MUST BE CALLED WITH DA, RETURNS WITHOUT DA
RIBSAW: PUSHJ P,SAVE1## ;SAVE P1
SKIPGE DEVRIB##(F) ;IF IN AN EXTENDED RIB,
PUSHJ P,WTUSAT ; NO UNIT-CHANGE TO EXTENDED RIB
PUSHJ P,DWNDA## ;GIVE UP DA
PUSHJ P,SPTRW## ;GET AOBJN WORD FOR POINTERS
MOVE P1,T1 ;INTO P1
RIBSA2: SKIPN T2,(P1) ;GET A POINTER
POPJ P, ;DONE
TLNE T2,-1 ;UNIT CHANGE?
JRST RIBSA3 ;NO, TRY NEXT
TRZ T2,RIPNUB## ;YES, GET UNIT NUMBER
PUSHJ P,NEWUNI## ;SET U TO THIS UNIT
JRST RIBSA3 ;NO GOOD - DON'T TOUCH SATS
PUSHJ P,UPDA##
PUSHJ P,WTUSAT ;WRITE SAT FOR UNIT IF IT CHANGED
PUSHJ P,DWNDA## ;GIVE UP DA
RIBSA3: AOBJN P1,RIBSA2 ;AND TRY NEXT POINTER
POPJ P, ;DON'T - RETURN
;SUBROUTINE TO WRITE SATS FOR A UNIT
WTUSAT::PUSHJ P,SAVE1## ;SAVE P1
PUSHJ P,SAVR## ;AND R
SE1ENT ;ENTER SECTION 1
LDB P1,UNYSIC## ;NUMBER OF SAB BLOCKS FOR UNIT
SKIPN R,UNISAB(U) ;LOC OF 1ST SAB
POPJ P, ;UNIT HAS NO SAB (OFF-LINE, DOWN, OR STR YANKED)
WTUSA1: SKIPGE SABFIR##(R) ;HAS SAT BEEN MODIFIED?
PUSHJ P,SATWRT## ;YES. WRITE IT
SKIPN UNISAB(U) ;UNIT STILL HAVE SAB?
POPJ P, ;NO, STR YANKED WHILE BLOCKED IN UUOPWQ
MOVE R,SABRNG##(R) ;STEP TO NEXT SAB IN RING
SOJG P1,WTUSA1 ;GO IF IT HASNT BEEN CHECKED
POPJ P, ;RETURN
;SINCE SAT TABLES ARE ALWAYS WRITTEN BEFORE UFD'S, THERE IS NO NEED
;FOR SPECIAL CODE TO WRITE SAT'S ON A 147 RESTART, SO.......
;MAKE DSKSTP BE A POPJ
;FAKE WAIT1 FOR USE DURING RESTART
$INIT
ONCWAT::MOVSI T1,ONCTIM## ;SET UP A HUNG TIMER
ONCWA1: MOVE S,DEVIOS(F)
TRNN S,IOACT ;DONE?
POPJ P, ;YES
PUSHJ P,APRCHK## ;KEEP TIME UP TO DATE
SOJG T1,ONCWA1
MOVE U,DEVUNI##(F) ;TIMED OUT
MOVE J,UDBKDB(U)
PUSHJ P,@KONSTP(J) ;STOP THE DEVICE
JFCL
SETZM UNISTS(U) ;SET UNIT IDLE
MOVSI T1,KOPBSY ;SET KONTROLLER IDLE
ANDCAM T1,KONBSY(J)
SETOM @KDBCHN(J) ;SET CHANNEL IDLE
TRC S,IOACT+IODERR ;CLEAR IOACT, LIGHT DEVICE ERROR
PJRST STOIOS## ; AND RETURN
$HIGH
;HERE ON A LOGOUT, WHEN THERE ARE NO OTHER JOBS LOGGED IN UNDER THIS PPB
;CALLED BY LOGOUT , WITH AC=PPN (DSKLGO UUO)
DSKLGO::MOVEI F,0 ;NO REAL DDB
PUSHJ P,GETCB## ;GET CB RESOURCE
HLRZ T2,SYSPPB## ;%NO. SET TO SEARCH PPB'S
PUSHJ P,LSTSCN## ;%FIND PPB FOR THIS JOB
JUMPLE T2,GVCBJ## ;%NOT THERE - EXIT IF NO CORE BLOCK SET UP
MOVEI T1,PPPNLG## ;%FOUND - SET NLG
ANDCAM T1,PPBNLG##(T2) ;% IN PPB BLOCK
PJRST TSTPP2 ;%AND GO DELETE PPB,UFBS FOR THIS PRJ,PRG
;SUBROUTINE TO BUILD A DISK DEVICE DATA BLOCK
;ENTER WITH T1=DEVICE NAME, F=LOC OF DDB (OR PROTOTYPE DDB)
;IF A SPOOLING DEVICE, P1 CONTAINS DEVMOD, ELSE P1=0
;CALLED BY ASSPRG
;HERE FROM ONCE-ONLY CODE
;RETURNS CPOPJ IF NO MORE DDB SPACE, CPOPJ1 NORMALLY
;PRESERVES T2-T4
SETDDO::PUSH P,DSKDDB## ;SAVE NAME
JRST SETDD3 ;GO CREATE THE DDB
;THIS IS THE NORMAL ENTRY POINT
SETDDB::PUSHJ P,SAVT## ;SAVE T2-T4
HRRZ T3,F ;ADDR. OF THE DDB
CAIE T3,DSKDDB## ;IS IT THE PROTOTYPE?
MOVE T1,DEVNAM(F) ;NO. GET THE PHYSICAL DEVICE NAME
PUSH P,T1 ;SAVE NAME
MOVE T1,DEVMOD(F)
TRNE T1,ASSPRG ;DDB BEEN INITED?
JRST SETDD1 ;YES. HAVE TO COPY PROTOTYPE
CAIE T3,DSKDDB## ;IS IT PROTOTYPE?
JRST SETDD2 ;NO. USE IT
;HERE WHEN WE MUST MAKE A COPY OF THE PROTOTYPE DDB
SETDD1: MOVEI T2,DDBLEN## ;NO OF 4-WORD BLOCKS NEEDED
MOVEI T1,GTFWDU## ;ASSUME NOT A GET/RUN
MOVE T3,J ;COPY/JOB CONTEXT HANDLE
ANDI T3,JOBMSK## ;ISOLATE JOB NUMBER
MOVE T3,JBTSTS##(T3) ;GET JOB STATUS WORD
TRNE T3,JS.ASA
MOVEI T1,GFWDUD## ;ALWAYS WIN FOR GET/RUN
PUSHJ P,(T1) ;GET THE CORE
JRST TPOPJ## ;CANT GET IT - RETURN
SKIPA T2,F ;PRESERVE OLD DDB (SETDDB)
SETDD3: SETZ T2, ;CLEAR OLD DDB (SETDDO)
HRR F,T1 ;LOC OF THE CORE
HRLI T1,DSKDDB## ;FROM THE PROTOTYPE
BLT T1,DEVRB1##-1(F) ;BLT THE NEEDED INFORMATION
JUMPE T2,SETDD6 ;HAVE AN OLD DDB
HRRZ T1,DEVSPM##(T2) ;DOES THE OLD DDB HAVE A
JUMPE T1,SETDD6 ; SPOOLED PARAMETER BLOCK?
PUSH P,T1 ;YES, REMEMBER ADDRESS
MOVEI T2,SPBMAX## ;SIZE OF AN SPB
PUSHJ P,GTFWDC## ;GET CORE
JRST TTPOPJ## ;RAN OUT OF PER-PROCESS FUNNY SPACE
HRRZM T1,DEVSPM##(F) ;STORE NEW SPB ADDRESS IN NEW DDB
MOVEI T2,SPBMAX##(T1) ;COMPUTE END ADDRESS OF BLOCK
POP P,T3 ;GET OLD SPB ADDRESS
HRLI T1,(T3) ;SET UP BLT POINTER
BLT T1,-1(T2) ;COPY SPB
SETDD6: HRRZ T2,F ;GET NEW DDB ADDRESS
CAIG T2,FYSORG+FYSSIZ ;DDB LIVE WITHIN
CAIGE T2,FYSORG ; FUNNY SPACE?
JRST SETDD7 ;NO, LINK AFTER SWPDDB
SKIPN DINITF## ;DISK INITIALIZATION IN PROGRESS?
JRST SETDD4 ;NO, LINK DDB INTO FUNNY SPACE CHAIN
SETDD7: SKIPE .UONCE## ;TWICE?
JRST TPOPJ1## ;YES, GO AWAY
DDBSRL
MOVE T1,SWPDDB##+DEVSER
HLLM T1,DEVSER(F)
HRLM F,SWPDDB##+DEVSER ;LINK PROTOTYPE TO THIS DDB
DDBSRU
JRST SETDD5
SETDD4: MOVE T2,.USLST
HLLM T2,DEVSER(F)
HRLM F,.USLST
;FALL INTO SETDD5
SETDD5: SKIPE P1 ;IF THIS IS A SPOOLING DDB
MOVEM P1,DEVMOD(F) ;SAVE DEVMOD OF REAL DEVICE
MOVEI T1,ASSCON+ASSPRG ;MAKE SURE ASSIGN BITS ARE OFF
ANDCAM T1,DEVMOD(F) ;(1 WILL BE TURNED ON BY ASSPRG)
MOVE T1,(P) ;GET NAME
PUSHJ P,MSKUNI## ;SET UP A MASK
PUSHJ P,UNSRCH## ;FIND THE UNIT (OR STR)
SETZ T3, ;NONE (SHOULDN'T HAPPEN)
HRRM T3,DEVUNI##(F) ;SAVE IN DEVUNI (SO DDB
; WILL BE FOUND ON A REMOVE)
SETDD2: POP P,DEVNAM(F) ;SET NAME INTO DDB
IFN FTMP,<
MOVSI T2,1000 ;MP & QUEUED PROTOCOL 1
HLLM T2,DEVCPU##(F) ;STORE FOR UUOCON
>
MOVE T1,DEVNAM(F) ;GET DEVICE NAME
PUSHJ P,LNMTSN ;SEE IF A LOGICAL NAME
JRST SETDD8 ;NO
IFN FTXMON,<HRRZS T3> ;AVOID POSSIBLE XADDR MESS
SKIPA T3,LNMDEV##(T3) ;DEV NAME FROM FIRST COMPONENT
SETDD8: MOVE T3,DEVNAM(F) ;USE DEVICE NAME FROM DDB
MOVE T2,[XWD -1-TTYATC,177777] ;ASSUME NUL:
CAMN T3,['NUL '] ;IS IT THE NUL DEVICE?
IORM T2,DEVMOD(F) ;YES--SAY IT'S ALL DEVICES
JRST CPOPJ1## ;RETURN
; ROUTINE TO CREATE A SPOOLED PARAMETER BLOCK
; CALL: PUSHJ P,SETSPB
; <ERROR> ;NO FREE CORE
; <SKIP> ;T1 AND DEVSPM SETUP
;
SETSPB::SKIPE T1,DEVSPM##(F) ;IS THERE A SPOOL PARAM BLOCK?
JRST CPOPJ1## ;YES--ALL DONE
MOVEI T2,SPBMAX## ;HOW MUCH CORE WE NEED
PUSHJ P,GTFWDC## ;GET THAT CORE
POPJ P, ;NO FREE CORE
MOVEM T1,DEVSPM##(F) ;REMEMBER WHERE IT IS
HRLZ T2,T1 ;SET ADR,,0
HRRI T2,1(T1) ;ADR,,ADR+1
SETZM 0(T1) ;CLEAR FIRST WORD
BLT T2,SPBMAX##-1(T1) ;CLEAR THE REST
JRST CPOPJ1## ;RETURN
;SUBROUTINE TO COMPUTE THE SIZE OF THE BUFFER
DBFSIZ: TLNN M,.OPLBF ;LARGE BUFFERS?
JRST DBFSZ1 ;NO - GO RESET THE VALUE IN CASE IT CHANGED
SKIPN T1,.PDLBS##(W) ;YES, HAVE DEFAULTS?
MOVEI T1,LBFSIZ##+1 ;NO, USE SYSTEM DEFAULT
TLNE T1,-1 ;SET BY UUO?
HLRZS T1 ;YES, USE THAT SIZE
POPJ P, ;RETURN TELLING UUOCON THE BUFFER SIZE
;HERE TO SET THE BUFFER SIZE FROM THE PROTOTYPE DISK DDB
DBFSZ1: PUSH P,F ;SAVE F FOR A MOMEMT
MOVEI F,DSKDDB## ;POINT AT PROTOTYPE DISK DDB
PUSHJ P,REGSIZ## ;GET THE DEFAULT BUFFER SIZE
JRST FPOPJ## ;RESTORE F AND RETURN
;SUBROUTINE TO CLEAR A DISK DEVICE DATA BLOCK
;ENTER WITH F=LOC OF DDB
;CALLED BY RELEASE CODE
CLRDDB::HRRZ T1,F ;COPY DDB ADDRESS
CAIG T1,FYSORG+FYSSIZ ;DDB LIVE WITHIN
CAIGE T1,FYSORG ; FUNNY SPACE?
SKIPA T1,[SWPDDB##] ;LOW CORE DDB
MOVEI T1,.USLST-DEVSER ;FUNNY SPACE DDB
DDBSRL
CLRDD1: MOVE T2,T1
HLRZ T1,DEVSER(T2) ;GET SUCCESSOR TO THIS DDB
SKIPN T1 ;END?
STOPCD CLRDD2,DEBUG,DNF, ;++ DDB NOT FOUND
CAIE T1,(F) ;NO. IS LINK THE ONE WE WANT?
JRST CLRDD1 ;NO. TRY NEXT
;HERE WITH T2=LOC OF DDB WHOSE LINK IS THE ONE WE WANT
MOVE T3,DEVSER(F) ;LINK OF DDB WE ARE REMOVING
HLLM T3,DEVSER(T2) ;SAVE IN LINK OF PREDECESSOR
CLRDD2: DDBSRU
SKIPE DINITF## ;IN ONCE-ONLY CODE?
POPJ P, ;YES, DON'T GIVE UP CORE
HRRZ T2,DEVSPM##(F) ;A SPOOLING PARAMETER BLOCK?
JUMPE T2,CLRDD3 ;NO, JUST GO ON
MOVEI T1,SPBMAX## ;GET SIZE OF BLOCK
PUSHJ P,GVFWDS## ;AND GIVE IT BACK
CLRDD3: MOVEI T1,DDBLEN## ;NO OF 4-WORD BLOCKS TO RETURN
HRRZ T2,F ;LOC OF DDB TO CLEAR
CAIG T2,FYSORG+FYSSIZ ;DDB LIVE WITHIN
CAIGE T2,FYSORG ; FUNNY SPACE?
PJRST GIVWDS## ;NO, RETURN LOW CORE DDB
PUSHJ P,DMPFZR## ;ZERO F IN DUMP AC'S AND SAVED CONTEXT
PJRST GVFWDS##
;SUBROUTINE TO SET UP A DDB
;EXITS WITH F=LOC OF DDB
;EXIT CPOPJ IF NO FREE CORE, CPOPJ1 IF OK
FAKDDB::MOVEI T2,DDBLEN## ;GET CORE FOR A DDB
PUSHJ P,GETWDS##
POPJ P, ;NONE AVAILABLE - RETURN CPOPJ
FAKDDX::PUSHJ P,SAVE1##
SETZB S,P1 ;SO SETDDB WON'T CHANGE DEVMOD, CLEAR RANDOM BITS IN S
PUSHJ P,SETDDO ;GOT IT - MAKE A DDB FROM THE SPACE
STOPCD .,JOB,SER, ;++SETDDO ERROR RETURN
MOVE J,.CPJOB## ;SET UP J
DPB J,PJCHN## ;STORE IN DDB
PJRST CPOPJ1## ;AND TAKE SKIP-RETURN
;SUBROUTINE TO RETURN THE ACTUAL STR NAME FOR A DDB
;ENTER WITH F=LOC OF DDB
;EXIT CPOPJ IF NOT A DISK OR NO UNIT ASSOCIATED WITH DDB (LOOKUP NOT DONE)
;EXIT CPOPJ1 IF A DISK, WITH T1=NAME OF STR
NAMSTR::MOVE T1,DEVMOD(F) ;IS DEVICE A DISK?
TLNN T1,DVDSK
POPJ P, ;NO, NON-SKIP RETURN
HRRZ T1,DEVFUN##(F) ;YES, GET SOME UNIT IN STR
JUMPE T1,CPOPJ## ;NONE - NO LOOKUP HAS BEEN DONE
MOVE T1,UNISTR(T1) ;GOT ONE. GET STR DATA BLOCK LOC
MOVE T1,STRNAM##(T1) ;NAME OF STR
PJRST CPOPJ1## ;SKIP-RETURN
SUBTTL COMCON - COMMAND DECODER INTERFACE ROUTINES
;SUBROUTINE TO PERFORM "DISK" COMMAND - PRINT DISK ACCESSES
;CALL: MOVE J,JOB NO.
; PUSHJ P,DSKCOM ;CALLED FROM COMCON - COMMAND DECODER
; ALWAYS RETURN
;PRINTS INCREMENTAL READS AND WRITES, TOTAL READS AND WRITES
;TOTAL BLOCKS ALLOCATED, AND KILO-DISK-MIN FOR ALL STRS COMBINED
DSKCOM::PUSHJ P,SAVJW## ;PRESERVE J (W GETS A RIDE)
PUSHJ P,GETJOB## ;GET DECIMAL JOB NO. ARG IF ANY
JRST DSKCM1 ;NO ARG, ASSUME USER'S OWN JOB(AC [=J)
MOVE J,T2 ;NO, SETUP JOB NUMBER
JRST DSKCM2 ;PRINT DATA FOR SPECIFIED JOB
;HERE WHEN USER DID NOT SPECIFY A JOB NUMBER - SO DO HIS WITH INCREMENTAL
DSKCM1: PUSHJ P,INLMES## ;NO, PRINT MESSAGE
ASCIZ /Rd,Wt=/
PUSHJ P,DSKINC ;PRINT INCREMENTAL DISK READS
PUSHJ P,INLMES## ;COMMA
ASCIZ /,/
PUSHJ P,PRTWDW ;PRINT NO OF INCREMENTAL DISK WRITES
PUSHJ P,CRLF## ;PRINT CRLF
;STILL IN FTDSTT
;HERE TO PRINT DATA FOR ANOTHER JOB(IE DO NOT PRINT INCREMENTAL)
DSKCM2: PUSHJ P,INLMES## ;PRINT HEADING
ASCIZ /Rd,Wt=/
LDB T1,JBYRCT## ;TOTAL NO. OF READS FOR JOB SINCE LOG-IN
PUSHJ P,RADX10## ;PRINT DECIMAL
PUSHJ P,INLMES## ;PRINT COMMA
ASCIZ /,/
LDB T1,JBYWCT## ;TOTAL NO. OF WRITES FOR JOB SINCE LOGIN
PUSHJ P,RADX10## ;PRINT DECIMAL
REPEAT 0,< ;ALLOCATION NOT CODED YET
PUSHJ P,INLMES## ;PRINT HEADER
ASCIZ /
Al=/
LDB T1,JBYTDB ;NO. OF BLOCKS ON ALL STRS FOR JOB
PUSHJ P,RADX10## ;PRINT
PUSHJ P,INLMES## ;PRINT HEADER
ASCIZ /
Kilo-dsk-min=/
MOVE T1,JBTTDB(J) ;TOTAL DISK BLOK SEC SO FAR
;***NEED TO RECOMPUTE*** ON COMMAND
IDIVI T1,^D60*^D1000/^D128 ;CONVERT TO J-MIN
PUSHJ P,RADX10## ;PRINT DECIMAL
> ;END REPEAT 0
PJRST CRLF## ;PRINT CRLF AND RETURN
;ROUTINE TO PRINT DISK BLOCK # FOR CONTROL-T
DSKCTT::MOVE S,DEVIOS(F) ;GET I/O STATUS
JUMPL S,DSCTT2 ;JUMP IF IOSMON=1
TLNE S,IOSUPR ;SUPER MODE?
JRST DSCTT1 ;YES -- PRINT BLOCK #
MOVE T1,DEVREL##(F)
CAIG T1,0 ;EARLY BLOCK?
JRST DSCTT2 ;YES -- ASSUME MONITOR I/O
DSCTT1: MOVEI T1,[ASCIZ " block "]
PUSHJ P,CONMES## ;PRINT TITLE
TLNN S,IOSUPR ;SUPER I/O
SKIPA T1,DEVREL##(F) ;NO--GET RELATIVE BLOCK
MOVE T1,DEVBLK##(F) ;YES--GET ABSOLUTE BLOCK #
PJRST RADX10## ;PRINT THE NUMBER
DSCTT2: MOVEI T1,[ASCIZ " (Monitor I/O)"]
PJRST CONMES##
;SUBROUTINE TO PRINT NO OF DISK WRITES (RESULT OF WATCH COMMAND)
;CALL: MOVE J,JOB NO [J=J]
; PUSHJ P,PRTWDW
PRTWDW::ADDI J,JBDIRD## ;INCREASE JOB NO BY DIFF IN READ/WRITE TABLE ORIGINS
PUSHJ P,DSKINC ;PRINT INCREMENTAL DISK WRITES
MOVEI J,MJBDRD##(J) ;DECREASE JOB NO BY DIFF IN TABLE ORIGINS
POPJ P,
;SUBROUTINE TO PRINT INCREMENTAL NO. OF BLOCKS READ OR WRITTEN
;CALL: MOVE J,JOB NO.(J=J)
; PUSHJ P,DSKINC
; ALWAYS RETURN
PRTWDR:: ;PRINT INCREMENTAL NO OF BLOCKS READ
DSKINC: LDB T1,JBYRCT## ;TOTAL NO OF READS(OR WRITES) FOR JOB
LDB T2,JBYIRD## ;INCREMENTAL SETTING(LOW ORDER N BITS
; OR TOTAL NO.)
DPB T1,JBYIRD## ;UPDATE INCREMENTAL SETTING WITH CURRENT TOTAL
SUB T1,T2 ;DIFFERENCE CUR TOTAL-LAST TOTAL
ANDI T1,JBRIRD## ;MASK OUT ALL BITS OUTSIDE INCREMENTAL FIELD
PJRST RADX10## ;PRINT DECIMAL AND RETURN
;COMMAND TO PRINT FILE STRUCTURES IN SYSTEM, AND UNITS NOT IN STRUCTURES
; (RESOURCES COMMAND)
DSKRES::PUSHJ P,SAVE1## ;SAVE P1
HLRZ P1,SYSSTR## ;FIRST STR DATA BLOCK ADDRESS
DSKR1: SKIPE T2,STRNAM##(P1) ;FILE STRUCTURE NAME
PUSHJ P,NAMCOM ;TYPE NAME AND COMMA
HLRZ P1,STRSYS##(P1) ;NEXT STR LOC
JUMPN P1,DSKR1 ;TYPE NAME IF THERE IS ONE
HLRZ P1,SYSUNI## ;ADDR OF 1ST UNIT IN SYSTEM
DSKR2: MOVE T2,UDBNAM(P1) ;PHYSICAL UNIT NAME
EXCH P1,U ;SETUP U FOR UNYUST
LDB T1,UNYUST## ;GET UNIT STATUS
EXCH P1,U ;RESTORE U FOR NAMCOM
CAIN T1,UNVDWN ;DOWN OR DOESN'T EXIST?
JRST DSKR4 ;YES, DON'T PRINT
SKIPN UNILOG(P1) ;NO SKIP IF UNIT IS NOT IN A FILE STRUCTURE
PUSHJ P,NAMCOM ;YES, TYPE ITS NAME
DSKR4: HLRZ P1,UNISYS(P1) ;STEP TO NEXT UNIT IN SYSTEM
JUMPN P1,DSKR2 ;TEST IT IF NOT THE END
POPJ P, ;THROUGH - RETURN
;SUBROUTINE TO TYPE NAME AND COMMA T2=SIXBIT NAME
NAMCOM: PUSHJ P,PRNAME## ;PRINT NAME
JSP T1,CONMES## ;THEN COMMA AND RETURN
ASCIZ /,/
;ROUTINE TO TURN OFF OPR MESSAGES FOR AN OFF-LINE DISK
;ENTER T1=(PHYSICAL) NAME
;NON SKIP-RETURN IF NOT A DISK OR NOT IN OPR WAIT
;SKIP-RETURN IF OK
DSKQUI::CAMN T1,[SIXBIT /RIB/]
JRST DSKQU2
CAMN T1,[SIXBIT /DSKERR/]
JRST DSKQU3
PUSH P,U ;SAVE U
PUSHJ P,MSKUNI## ;GENERATE MASK FOR UNIT
PUSHJ P,SRUNI## ;FIND UNIT
PJRST UPOPJ## ;NO MATCH
PJRST UPOPJ## ;LOGICAL NAME MATCH - NOT GOOD ENOUGH
MOVE T1,UNISTS(U) ;STATUS OF UNIT
CAIE T1,OCOD## ;IS IT OPR WAIT?
PJRST UPOPJ## ;NO, NON-SKIP RETURN
MOVEI T1,O2COD## ;YES
PUSHJ P,BTHSTS## ;STORE IT
PJRST UPOPJ1## ;SKIP RETURN
;HERE TO SET RIB-ERROR THRESHOLD
DSKQU2: PUSHJ P,DECIN1## ;GET THRESHOLD
POPJ P,
POPJ P,
MOVEM T2,RIBECT## ;SAVE
PJRST CPOPJ1## ; AND GOOD-RETURN
;HERE TO SET DSK ERROR THRESHOLD
DSKQU3: PUSHJ P,DECIN1## ;GET THRESHOLD
POPJ P,
POPJ P,
MOVEM T2,HERLIM## ;SAVE
PJRST CPOPJ1## ;AND GOOD RETURN
;SUBROUTINE TO CLEAN UP CORE ON A KJOB COMMAND
;CALLED AT CLOCK LEVEL IF NO CORE, UUO LEVEL IF CORE WHEN JOB IS KILLED
;CALL MOVE J,JOB NUMBER
; PUSHJ P,DSKKJB
DSKKJB::PUSHJ P,SFDPPN ;FIND DEFAULTS FOR JOB
JUMPE T1,DSKKJ1 ;NONE IF T1=0
PUSHJ P,SAVE2## ;SAVE P1-P2
MOVE P1,T4 ;SAVE DEFLT PPN
HLRZ P2,T1 ;SAVE DEFLT LOC (SFD OR PPB)
SKIPE T1,T2 ;IS THERE A DEFAULT SFD?
PUSHJ P,DECALL ;YES, DECR. ALL USE-COUNTS FOR IT
CAMN P1,JBTPPN##(J) ;IS IT JOB'S PPN?
JRST DSKKJ1 ;YES
PUSHJ P,FAKDDB ;NO, SET UP A FAKE DDB FROM FREE CORE
JRST DSKKJ2
MOVE T1,P1 ;GOR ONE, T1=DEFAULT PPN
PUSHJ P,PTHCHG ;DELETE CORE BLOCKS, REWRITE NEW QUOTA INFO
PUSHJ P,CLRDDB ;GIVE UP THE DDB
MOVE J,.CPJOB## ;RESET J
DSKKJ1: HLRZ P2,JBTSFD##(J) ;PPB OF LIB
TRZ P2,CORXTR## ;ZAP THE EXTRA BITS
JUMPE P2,DSKKJ2 ;FORGET IT IF NO LIB
PUSHJ P,FAKDDB ;THERE IS - GET A DDB
JRST DSKKJ2 ;CANT GET ONE, CONTINUE
MOVE T1,PPBNAM##(P2) ;GET PPN OF LIB
PUSHJ P,PTHCHG ;FINISH UP IF NO OTHER JOBS USING
PUSHJ P,CLRDDB ; THE PPN NOW
DSKKJ2: SKIPN .USLNM ;ANY LOGICAL NAMES?
JRST DSKKJ5 ;NO
SETZ T4, ;YES, START AT FIRST
DSKKJ3: SKIPN @.USLNM ;PICK UP NEXT LOGICAL NAME
JRST DSKKJ4 ;DONE
PUSHJ P,PTKUDF ;UNDEFINE IT, RETURN FUNNY SPACE
JFCL
AOJA T4,DSKKJ3 ;AND TRY NEXT
DSKKJ4: MOVEI T1,LNMMAX##+MAXLVL##+1 ;GIVE UP THE LOGICAL NAME TABLE SPACE
HRRZ T2,.USLNM
PUSHJ P,GVFWDS##
SETZM .USLNM
;FALL INTO DSKKJ5
DSKKJ5: MOVE J,.CPJOB## ;RESET J
SETZM JBTSFD##(J) ;CLEAR DEFAULT DIRECTORY
HLRZ T2,.USSWI
JUMPE T2,DSKKJ6
HRRZ T1,SWILEN##(T2) ;FUNNY SPACE WHERE SWITCH.INI IS SAVED
PUSHJ P,GVFWDS## ;RETURN IT
HRRZS .USSWI
DSKKJ6: MOVE T1,JBTPPN##(J) ;GET PPN
PUSHJ P,ONLYTS ;IS THERE ANY JOB USING THIS PPN?
CAIA ;YES
PUSHJ P,DSKLGO ;NO, DELETE DISK 4-WORD CONTROL BLOCKS
SCHEDULE ;TURN SCHEDULING BACK ON
SKIPN .USSBF ;WILL RETURN IT ELSEWHERE IF .UPSBF NON-0
SKIPN T1,.USMBF ;HAVE MON BUFF?
POPJ P, ;NO, THATS ALL
SETZM .USMBF
;SUBROUTINE TO RETURN MONITOR BUFFER
;ENTER WITH T1=LOC OF MON BUF-1
GVMNBF: MOVEI T2,1(T1) ;START ADR OF MON BUF
MOVEI T1,BLKSIZ##
PUSHJ P,GVFWDS## ;RETURN THE MONITOR BUFFER
POPJ P, ;AND EXIT
;SUBROUTINE TO FIX UP DATA BASE WHEN SET DATA/TIME COMMAND
;CALLED WITH T1 INCREMENTAL TIME TO FUDGE
;MUST PRESERVE T1!
FILSDT::
IFN FTMDA,<
HLRZ T2,SYSUNI## ;GET FIRST UNIT IN UDB CHAIN
SDT.1: SKIPE UNILTM(T2) ;LOCK TIME SET?
ADDM T1,UNILTM(T2) ;YES--FIX IT UP
IFN FTDUAL,<
SKIPE T3,UNI2ND(T2) ;DUAL PORTED?
SKIPN UNILTM(T3) ;YES--LOCK TIME SET?
CAIA ;NO
ADDM T1,UNILTM(T3) ;YES--FIX IT UP TOO
>;END IFN FTDUAL
HLRZ T2,UNISYS(T2) ;GET NEXT UDB
JUMPN T2,SDT.1 ;LOOP IF MORE
>;END FTMDA
POPJ P, ;AND RETURN
SUBTTL QUESER - INTERFACE ROUTINES
;FILIRC -- INCREMENT READER COUNT OF FILE
;CALL:
; MOVE T1,ACCESS-TABLE-ADDRESS
; PUSHJ P,FILIRC
; RETURN HERE ALWAYS
FILIRC::PUSH P,T2 ;SAVE T2
MOVEI T2,ACPCNT## ;GET 1 FIELD FOR A.T. READ COUNT
ADDM T2,ACCCNT##(T1) ;INCREMENT READ COUNT SO FILE STAYS
JRST T2POPJ## ;RETURN
;FILDRC -- DECREMENT READER COUNT OF FILE
;CALL:
; MOVE T1,ACCESS-TABLE-ADDRESS
; PUSHJ P,FILDRC
; RETURN HERE ALWAYS
FILDRC::PUSH P,T2 ;SAVE T2
MOVNI T2,ACPCNT## ;-1 IN COUNT FIELD
ADDM T2,ACCCNT##(T1) ;DECREMENT READER COUNT IN A.T.
JRST T2POPJ## ;RETURN
;FILNDR -- SET 'NO DELETE ON RESET' STATUS BIT
;CALL:
; MOVE T1,ACCESS-TABLE-ADDRESS
; PUSHJ P,FILNDR
; RETURN HERE ALWAYS
FILNDR::PUSH P,T2 ;SAVE T2
MOVEI T2,ACPNDR## ;GET NO DELETE ON RESET BIT
IORM T2,ACCSTS##(T1) ;PUT IN STATUS WORD
JRST T2POPJ## ;RETURN
;FILGFC -- CHECK TO SEE IF FILE IS A GHOST FILE
;CALL:
; MOVE T1,ACCESS-TABLE-ADDRESS
; PUSHJ P,FILGFC
; <IF FILE IS A GHOST FILE>
; <IF FILE IS NOT A GHOST FILE>
FILGFC::PUSH P,T2 ;SAVE T2
MOVE T2,ACCSTS##(T1) ;GET A.T. STATUS
TRNE T2,ACPDEL##!ACPSUP!ACPCRE ;GHOST FILE? (BEING CREATED
; OR SUPERSEDED)
JRST T2POPJ## ;YES, RETURN
JRST T2POJ1## ;NOT A GHOST FILE, SKIP RETURN
SUBTTL DISK. UUO - MISC DISK FUNCTIONS
;CALLI AC,DISK.
;LH(AC)=FUNCTION RH(AC)=ADR
DSKUUO::HLRE T2,T1 ;FUNCTION
CAML T2,[-CDULEN] ;LEGAL CUSTOMER FUNCTION?
CAILE T2,DUULEN ;LEGAL?
PJRST RTM1## ;NO, ERROR RETURN
HRR M,T1 ;ADDRESS
SKIPL T2,DUUTBL(T2) ;PRIV'D?
JRST (T2) ;NO, DISPATCH
PUSHJ P,PRVJ## ;YES, CAN THIS JOB DO THE FUNCTION?
JRST (T2) ;YES, DISPATCH
PJRST RTM2## ;NO, RETURN AC=-2
CDUTBL:! ;START OF CUSTOMER DISK. UUO FUNCTIONS
;INSERT CUSTOMER FUNCTIONS HERE
DUUTBL: EXP PRIUUO ;SET DISK PRIORITY
XWD 400000,SETCPT## ;(1) SET 10/11 COMPATABILITY MODE
XWD 400000,CLRCPT## ;(2) CLEAR 10/11 COMPATABILITY MODE
XWD 400000,UNLOAD## ;(3) UNLOAD A DRIVE (RP04)
XWD 400000,SOONDN## ;(4) TAKE CHAN/KONTROLLER OFF LINE SOON
XWD 400000,NOWDWN## ;(5) TAKE CHAN/KONTROLLER OFF LINE NOW
XWD 400000,NOWUP## ;(6) PUT CHAN/KONTROLLER BACK ON LINE
XWD 0,CMPRSS ;(7) SET TO CALL UFD COMPRESSOR
XWD 400000,REMSWP## ;(10) REMOVE A SWAPPING UNIT
XWD 400000,ADDSWP## ;(11) ADD A SWAPPING UNIT
XWD 400000,SDLADD ;(12) ADD STRUCTURE TO SYSTEM DUMP LIST
XWD 400000,SDLREM ;(13) REMOVE STRUCTURE FROM SYSTEM DUMP LIST
XWD 0,LENGTH ;(14) TELL LENGTH OF FILE
IFN FTMDA,<
XWD 400000,CLRMDA## ;(15) CLEAR A DISK UNIT FROM MDA
>
IFE FTMDA,<
XWD 400000,CPOPJ1## ;(15) FEATURE TEST OFF
>
XWD 0,GGUFBT## ;(16) GET UFBTAL FOR STR:[P,PN]
DUULEN==.-DUUTBL-1
CDULEN==DUUTBL-CDUTBL ;MAXIMUM LEGAL CUSTOMER FUNCTION
;ERROR CODES RETURNED BY DISK. UUO FUNCTIONS 12 AND 13
DUDND%==1 ;NO SUCH STRUCTURE
DUDNC%==2 ;NO CRASH SPACE ON STRUCTURE
DUDAD%==3 ;STRUCTURE ALREADY IN SYSTEM DUMP LIST
DUDDF%==4 ;SYSTEM DUMP LIST FULL
DUDNS%==1 ;STRUCTURE NOT IN SYSTEM DUMP LIST
ERCODE DSUNSS,DUDND%
ERCODE DSUNKC,DUDNC%
ERCODE DSUADL,DUDAD%
ERCODE DSUDLF,DUDDF%
ERCODE DSUNDL,DUDNS%
; DISK. UUO FUNCTION 12 - ADD A STRUCTURE TO THE SDL
SDLADD: PUSHJ P,SAVE1## ;SAVE P1
PUSHJ P,GETWDU## ;GET THE SIXBIT STR NAME
PUSHJ P,SRSTR## ;FIND STR DATA BLOCK
JRST DSUNSS ;NO SUCH STRUCTURE
MOVE P1,T3 ;COPY TO A SAFE PLACE
HRRZ T1,STRK4C##(P1) ;GET K FOR CRASH
JUMPE T1,DSUNKC ;NO CRASH SPACE
SKIPL STRSDL##(P1) ;ALREADY IN THE SDL?
JRST DSUADL ;YES--ERROR
PUSHJ P,SDLFRE ;FIND THE FIRST FREE ENTRY
JRST DSUDLF ;ERROR IF SDL IS FULL
MOVEM T2,STRSDL##(P1) ;STORE POSITION IN THE STR DB
PUSHJ P,SDLBLD## ;REBUILD THE PRESERVED SDL
JFCL ;BOOTSTRAP NOT AVAILBLE
PUSHJ P,FRCCPY## ;COPY ANY UNPROCESSED DUMP ON THIS STR
JRST CPOPJ1## ;RETURN
; DISK. UUO FUNCTION 13 - REMOVE A STRUCTURE FROM THE SDL
SDLREM: PUSHJ P,GETWDU## ;GET SIXBIT STRUCTURE NAME
PUSHJ P,SDLCHK ;SEE IF IT'S IN THE SDL
JRST DSUNDL ;IT'S NOT
SETOM STRSDL##(T3) ;REMOVE FROM THE SDL
PUSHJ P,SDLBLD## ;REBUILD THE PRESERVED SDL
JRST DSUNDL ;NO BOOTSTRAP
JRST CPOPJ1## ;RETURN
; CHECK FOR A STR IN THE SDL
SDLCHK: PUSHJ P,SRSTR## ;FIND THE STR WITH THIS NAME
POPJ P, ;NOT IN SDL IF DOESN'T EXIST
SKIPL STRSDL##(T3) ;IF STR IS IN SDL,
AOS (P) ;THEN SKIP
POPJ P, ;RETURN
; FIND THE FIRST FREE POSITION IN THE SDL
SDLFRE: SETZ T1, ;INIT MASK
MOVEI T2,DIFSTR## ;GET PRDECESSOR OF SYSSTR
SDLFR1: HLRZ T2,STRSYS##(T2) ;GET NEXT STR IN SYSTEM
JUMPE T2,SDLFR2 ;DONE SEARCHING IF NO MORE
SKIPGE T3,STRSDL##(T2) ;GET STR'S POSITION IN THE SDL
JRST SDLFR1 ;NOT IN THE SDL
ANDI T3,77 ;PARANOIA
IOR T1,BITTBL##(T3) ;INCLUDE THIS BIT
JRST SDLFR1 ;LOOP OVER ALL STR DB'S
SDLFR2: SETCA T1, ;FLIP BITS
JFFO T1,CPOPJ1## ;RETURN FIRST FREE POSITION
POPJ P, ;NON-SKIP IF FULL
CMPRSS: PUSHJ P,SAVE1##
PUSHJ P,GETWDU## ;GET CHAN
MOVE P1,T1 ;WHERE WE EXPECT CHAN
PUSHJ P,VALUUO## ;SET UP F
POPJ P, ;NO OPEN DISK ON THAT CHAN
HRRZ T1,DEVUFB##(F)
JUMPE T1,CPOPJ1## ;FORGET IT IF NO OPEN FILE
MOVSI T2,UFPZRB## ;LIGHT A BIT TO CALL
IORM T2,UFBZRB##(T1) ;COMPRESSOR AT NOTOLD
JRST CPOPJ1## ;AND RETURN
;FUNCTION TO RETURN LENGTH OF A FILE
LENGTH: PUSHJ P,GETWDU## ;CHAN
PUSHJ P,SAVE1##
MOVE P1,T1
PUSHJ P,VALUUO## ;SET UP F
PJRST ECOD2## ;NOT A DISK
HRRZ T1,DEVACC##(F)
JUMPE T1,ECOD1## ;NO OPEN FILE
MOVE T1,ACCWRT##(T1) ;SIZE OF FILE
AOS (P)
PJRST STOTAC## ;TELL USER AND RETURN
PRIUUO: HRR M,T1 ;LOC OF ARGUMENT
PUSHJ P,GETWDU## ;GET IT
HRRE T2,T1 ;PRIORITY HE'S TRYING TO SET
PUSHJ P,PRCHK ;LEGAL?
PJRST ECOD1## ;NO, NON-SKIP
PUSHJ P,SAVE1##
MOVSI T3,DVDSK
HLRE T1,T1 ;YES, GET CHAN NUMBER
TRO T2,DEPUUO ;LIGHT THE SET-BY-UUO BIT
JUMPL T1,PRIUU1 ;IS IT A REAL CHAN?
MOVE P1,T1 ;YES, LEGAL?
PUSHJ P,SETUF## ;YES, IS A FILE OPEN ON THE CHAN?
PJRST ECOD2## ;NO, NON-SKIP RETURN
PUSHJ P,PRIDEP ;YES, SAVE NEW PRIORITY IN DDB
PJRST CPOPJ1## ;AND RETURN
;HERE IF CHAN IS NEGATIVE
PRIUU1: AOJE T1,PRIUU3 ;GO IF LH(ADR)=-1
AOJN T1,ECOD3## ;ERROR IF LH NOT=-2
PRIUU2: DPB T2,JBYPRI## ;-2, SET JOB'S DISK PRIORITY
PJRST CPOPJ1## ;AND GOOD RETURN
;HERE IF SETTING PRIORITY FOR ALL OPEN CHANS
PRIUU3: SETZ P1, ;NO OF OPEN CHANS
PRIUU4: PUSHJ P,NXTCH## ;THIS CHAN OPEN?
JRST CPOPJ1##
MOVE F,T1
PUSHJ P,PRIDEP ;YES, SET PRIORITY IN DDB
JRST PRIUU4 ;LOOP FOR ALL CHANS
PRICOM::PUSHJ P,PRCHK ;HERE ON COMMAND. LEGAL?
POPJ P, ;NO
JRST PRIUU2 ;YES, SET JOB'S PRIORITY AND EXIT
;SUBROUTINE TO DETERMINE IF SETTING DISK PRIORITY IS LEGAL
;ENTER T2=DESIRED PRIORITY
;EXIT CPOPJ IF NO, CPOPJ1 IF YES
;PRESERVES T1
PRCHK: LDB T3,JBZPRI## ;MAX PRIORITY JOB CAN SET
CAMLE T2,T3 ;TRYING TO SET HIGHER?
POPJ P, ;YES, ERROR RETURN
JUMPGE T2,CPOPJ1## ;NO, OK IF POSITIVE
MOVMS T2 ;NEGATIVE. GET +N
CAILE T2,3 ;TO LOW?
MOVEI T2,3 ;YES, SET MAX NEGATIVE VALUE
TRO T2,MINDPR ;SET THE NEGATIVE-BIT
PJRST CPOPJ1## ;AND TAKE GOOD RETURN
;SUBROUTINE TO SET DISK PRIORITY
PRIDEP: TDNE T3,DEVMOD(F) ;IS IT A DISK?
DPB T2,DEXPRI## ;YES, SET PRIORITY
POPJ P,
SUBTTL INPUT/OUTPUT UUO'S
;BUFFERRED MODE INPUT
INPT: PUSHJ P,NULTST ;IF NULL DEVICE,
JRST SETION ; RETURN EOF
PUSHJ P,SPTSTI ;SEE IF 1ST SPOOLED INPUT
PJRST SETION ;YES, AND NO FILE - SET IOEND
TLNE S,IOSUPR ;SUPER USETI DONE?
JRST INPSW9 ;YES
TLNN F,LOOKB ;LOOKUP BEEN DONE?
PJRST SETIMP ;NO, LIGHT IOIMPM AND RETURN
INPSW9: TLZ S,IO ;NO. INDICATE INPUT
MOVEM S,DEVIOS(F) ;SAVE S
PUSHJ P,SAVE2## ;SAVE SOME ACS
PUSHJ P,UUOSET## ;SET DDB PNTRS FOR THIS BLOCK
JRST INPT1 ;EOF. LIGHT A BIT
MOVE T1,DEVFIL(F)
HLRZ T2,DEVEXT(F)
CAMN T1,[SIXBIT /SWITCH/]
CAIE T2,'INI' ;READING SWITCH.INI?
PJRST UUOPWR## ;NO. GO QUEUE REQUEST
MOVE T4,.CPJOB## ;YES, READING THIS JOB'S SWITCH.INI?
MOVE T4,JBTPPN##(T4)
SKIPN DEVSFD##(F)
CAME T4,DEVPPN(F)
JRST UUOPWR## ;NO, GO DO NORMAL STUFF
;HERE WHEN USER IS READING SWITCH.INI. WORRY ABOUT IN-CORE COPY
PUSHJ P,SAVE3##
HLRZ P1,.USSWI ;LOC OF FUNNY-SPACE SWITCH.INI
HRRZ P2,DEVACC##(F) ;AT FOR ONE WE JUST LOOKED UP
MOVE T2,P2
LDB T1,ACYLBS## ;SIZE OF LOOKED-UP COPY
MOVE P3,ACCWRT##(P2)
SUBI P3,1
LSH P3,BLKLSH## ;SIZE IN WORDS OF SWITCH.INI
ADD P3,T1
HRL P3,ACCUN1##(P2) ;UNIT OF LOOKED-UP COPY
JUMPE P1,INPSW1 ;GO IF NO FUNNY-SPACE COPY
MOVE T1,ACCPRV##(P2) ;PRIVS/CREATION DATE,TIME
CAME T1,SWIPRV##(P1) ;MATCH?
JRST INPSW1 ;NO, READ NEW ONE INTO FUNNY SPACE
MOVE T1,ACCPT1##(P2) ;1ST PNTR OF FUNNY-SPACE COPY
CAMN T1,SWIPT1##(P1) ;ARE THEY THE SAME?
CAME P3,SWIUN1##(P1)
INPSW1: SKIPA T1,DEVREL##(F) ;NO, SET TO COPY TO FUNNY SPACE
JRST INPSW7 ;YES, GIVE FUNNY COPY TO USER
SOJN T1,UUOPWR## ;JUST READ FILE IF NOT 1ST BLOCK (TOO LARGE)
JUMPE P1,INPSW3 ;GO IF DON'T ALREADY HAVE ONE
PUSHJ P,GETNMB ;ALREADY HAVE ONE IN FUNNY SPACE
HLRZ T1,NMBACC##(T1)
INPSW2: CAIE T1,(P2) ;LOOK FOR AN A.T.
SKIPE ACCDOR##(T1) ;IF NOT OURS AND NOT DORMANT
SKIPA T2,P1
JRST UUOPWR## ; WE CAN'T GET RID OF THIS COPY
HLRZ T1,ACCNMB##(T1)
TRNN T1,DIFNAL## ;LOOK FOR ANOTHER A.T.
JRST INPSW2
HRRZ T1,SWILEN##(P1) ;YES, RETURN IT
PUSHJ P,GVFWDS##
HRRZS .USSWI ;CLEAR POINTER TO IT
;FALL INTO INPSW3
INPSW3: MOVE T2,ACCWRT##(P2) ;SIZE OF CURRENT SWITCH.INI
CAILE T2,3 ;TOO LARGE TO FIT?
PJRST UUOPWQ## ;YES, JUST PLAIN READ INTO USER SPACE
LSH T2,BLKLSH## ;FITS FINE. COMPUTE NO OF WORDS WE NEED
ADDI T2,SWIDAT##
MOVE P1,T2 ;SAVE LENGTH
PUSHJ P,GTFWDC## ;GET SPACE FOR IT
PJRST UUOPWQ## ;OH WELL, JUST READ INTO USER SPACE
EXCH P1,T1 ;SAVE LOC, GET LENGTH
HRLM P1,.USSWI ;SAVE LOC IN UPMP
MOVEM P3,SWIUN1##(P1) ;SAVE UN1,,NO OF WORDS
MOVEM T1,SWILEN##(P1) ;SAVE NUMBER OF FUNNY-SPACE WORDS WE HAVE
MOVE T1,ACCPT1##(P2)
MOVEM T1,SWIPT1##(P1) ;SAVE RETIREVAL POINTER
MOVE T1,ACCPRV##(P2) ;SAVE CREATION DATE,TIME
MOVEM T1,SWIPRV##(P1)
PUSHJ P,GTMNBF## ;NOW READ SWITCH.INI INTO FUNNY SPACE
INPSW4: MOVE T2,DEVBLK##(F) ;READ A BLOCK
PUSHJ P,MONRDU## ;READ NOT FROM DISK CACHE
JUMPN T3,INPSW5 ;LOSE IF IO ERROR
MOVE T2,DEVREL##(F) ;RELATIVE BLOCK OF FILE
LSH T2,BLKLSH## ;COMPUTE WHERE IT GOES IN FUNNY SPACE
CAMLE T2,SWILEN##(P1) ;IF ABOVE TOP
JRST INPSW5 ; SOME OTHER JOB IS MAKEING IT LARGER
ADDI T2,SWIDAT##-BLKSIZ##(P1)
HRLI T2,1(T1)
MOVE T1,T2 ;SAVE IT IN USER'S SPACE
BLT T2,BLKSIZ##-1(T1)
AOS DEVREL##(F) ;POINT TO NEXT BLOCK OF FILE
AOS DEVBLK##(F)
SOS DEVLFT##(F)
PUSHJ P,UUOSET## ;SET TO READ NEXT BLOCK
JRST INPSW6 ;EOF
MOVE T1,.USMBF ;NEXT BLOCK IS THERE - GO READ IT
JRST INPSW4
;HERE ON IO ERROR READING SWITCH.INI
INPSW5: PUSHJ P,INPSW8 ;RESET DDB TO POINT AT 1ST BLOCK
HRRZ T2,P1
HRRZ T1,SWILEN##(P1)
PUSHJ P,GVFWDS## ;RETURN THE FUNNY SPACE
HRRZS .USSWI
PJRST UUOPWQ## ; AND READ INTO USER'S AREA
;HERE WHEN ALL OF SWITCH.INI IS IN CORE
INPSW6: TRNE S,IOIMPM+IOBKTL+IODTER+IODERR ;ANY ERRORS?
JRST INPSW5 ;YES
PUSHJ P,INPSW8 ;RESET DDB TO POINT AT 1ST BLOCK OF FILE
;HERE TO READ FIRST (OR NEXT) BLOCK OF SWITCH.INI
INPSW7: SKIPN T3,DEVREL##(F)
PJRST UUOPWQ## ;READING RIB (DIRECT) IF 0
SUBI T3,1 ;CONVERT BLOCK NUMBER
LSH T3,BLKLSH## ;TO WORD COUNT
HRRZ T4,SWIUN1##(P1) ;TOTAL LENGTH OF FILE
SUB T4,T3 ;NUMBER OF WORDS LEFT TO READ
HRRZ T2,DEVIAD(F) ;GET THE USER'S BUFFER ADDRESS
EXCTXU <HLRZ T1,(T2)> ;GET THE BUFFER SIZE
ADDI T2,2 ;POINT TO THE BUFFER DATA
SUBI T1,1 ;GET RID OF OVERHEAD
CAMLE T4,T1 ;READING LAST BLOCK?
MOVE T4,T1 ;NO. READ A WHOLE BUFFER
EXCTXU <MOVEM T4,-1(T2)> ;STORE AS WORDCOUNT OF FILE
ADDI T4,BLKSIZ##-1 ;ROUND UP TO THE
ANDI T4,MBLKSZ## ; NUMBER OF BLOCKS THIS IS
ADDI T3,SWIDAT##(P1) ;POINT TO THE SOURCE OF THE DATA
HRL T2,T3 ;SET UP BLT POINTER
HRRZ T1,T2 ;COPY THE BUFFER POINTER
ADDI T1,-1(T4) ;COMPUTE LAST WORD TO WRITE
EXCTXU <BLT T2,(T1)> ;COPY CURRENT BLOCK TO USER SPACE
LSH T4,-BLKLSH## ;CONVERT WORD COUNT TO BLOCK COUNT
ADDM T4,DEVBLK##(F) ;POINT DDB AT NEXT BLOCK
ADDM T4,DEVREL##(F)
MOVNS T4 ;NEGATE BLOCK COUNT
ADDM T4,DEVLFT##(F)
PUSHJ P,ADVBFF## ;TELL UUOCON THE BUFFER IS FULL
JFCL
JRST CPOPJ1## ;AND GO AWAY HAPPY
;SUBROUTINE TO RESET TO READ 1ST BLOCK OF SWITCH.INI
INPSW8::HRRZ T3,DEVACC##(F) ;POINT TO ACCESS TABLE
PUSHJ P,AT2DDB## ;RESET TO FIRST BLOCK
JFCL ;ALLOW IT TO PROPAGATE
PJRST CPZPTR## ;AND COPY
;HERE ON EOF (KEEP GOING IF CONTINUED DIRECTORY)
INPTU: PUSHJ P,UUOSET##
INPT1: TLOA S,IOEND ;LIGHT EOF BIT
PJRST UUOPWR##
;IF THE FILE BEING READ IS A DIRECTORY, NO EOF TILL ALL STR'S LOOKED AT
MOVE T1,DEVACC##(F) ;LOC OF A.T.
MOVE T1,ACCDIR##(T1)
TRNE T1,ACPDIR## ;A DIRECTORY?
PUSHJ P,SETSRC## ;YES. GET SEARCH LIST
PJRST STOIOS## ;NO. REAL EOF
PUSH P,T1 ;SAVE SL PTR
SETZ P1, ;COUNT NUMBER OF STRS IN SL
MOVE P2,T1
UFDSR5: PUSHJ P,SLITA##
SKIPA P2,(P) ;RESET SL PTR
AOJA P1,UFDSR5
SOJE P1,UFDSR3 ;ONLY ONE STR, LEAVE THINGS ALONE
;HERE WITH P1 NON-0
HRRZ T2,DEVACC##(F) ;LOC OF A.T.
LDB T1,ACYFSN## ;CURRENT STR NUMBER
PUSHJ P,SLFNA## ;FIND IT IN SEARCH LIST
JRST UFDSR3 ;DONE IF NOT THERE
;P2 NOW HAS PREDECREMENTED PTR TO NEXT STR (FOR CALL TO FNDFIL BELOW)
PUSHJ P,SFDUP ;BUMP PPBCNT AND NMBCNT
HRRZ T1,DEVSFD##(F) ;BUMP ALL ACC'S
SKIPE T1
PUSHJ P,INCALL
PUSHJ P,CLOSIN ;CLOSE CURRENT A.T.
UFDSR6: TLZ M,UUOMSK ;SET UUO TO LOOK LIKE A LOOKUP
TLO M,UUOLUK
MOVEI T2,0 ;FORCE RECOMPUTING
DPB T2,DEYFNC##
MOVE T2,P2 ;SEARCH LIST INTO T2
PUSHJ P,FNDFLA## ;LOOK FOR UFD ON NEXT STR'S IN SYSTEM
JRST UFDSR4 ;NO DIRECTORY ON NEXT STRS
;STILL IN FTSTR CONDITIONAL
PUSHJ P,DECMST ;DECR ALL BUT THE RIGHT ACC
POP P,P2 ;RETURN POSSIBLE TEMP SL. (SETSRC CALL)
PUSHJ P,SLGVT##
TLO F,LOOKB ;FOUND ONE. SET F AS IF LOOKUP HAPPENED
HRRZ T3,DEVACC##(F) ;LOC OF A.T.
PUSHJ P,AT2DDB## ;COPY DATA FROM A.T. TO DDB
JRST STOIOS## ;A.T. DATA IS VERY WRONG
JUMPE P1,STOIOS## ;JUST RE-OPENED 1ST STR, GIVE EOF RETURN
TLZ S,IOEND ;IT ISN'T REALLY AN EOF YET
PJRST INPTU ;DO 1ST INPUT ON NEW DIRECTORY FILE
;HERE WHEN SL IS EXHAUSTED
UFDSR4: MOVE P2,(P) ;RESET SL PTR TO BEGINING
TRZE P1,-1 ;1ST TIME HERE?
JRST UFDSR6 ;YES, RE-OPEN 1ST STR (SO REWIND WORKS)
PUSHJ P,JDAADR## ;2ND TIME (STR YANKED)
HLLM F,(T1) ;CLEAR LOOKB IN USRJDA
SETZM DEVUNI##(F) ;FILE IS LEFT CLOSED SO USETI UUO
;WOULD BE INTERPRETED AS SUPER USETI.
;ZERO DEVUNI TO MAKE USETI FAIL.
PUSHJ P,DECSFD ;DECR ALL ACC'S
PUSHJ P,SFDDEC ;DECR PPBCNT AND NMBCNT
PUSHJ P,TSTPPB ;DELETE CORE BLOCKS FOR THE PPN
;AND FALL INTO UFDSR3
UFDSR3: POP P,P2 ;RETURN TEMP SL. (IF ANY)
PUSHJ P,SLGVT##
PJRST STOIOS## ;AND RETURN NO MORE UFDS
;BUFFERRED MODE OUTPUT
OUTPT: PUSHJ P,NULTST ;IF NUL:,
JRST OUTPT1 ; EAT OUTPUT
PUSHJ P,SPTSTO ;SEE IF 1ST SPOOLED OUTPUT
PJRST SETIMP ;YES, AND ERROR ON ENTER - SET IOIMP
TLNE F,ENTRB ;ENTER BEEN DONE?
TLNE S,IOSWLK+IOSUPR ;YES. STR WRITE-LOCKED?
JRST SETIMP ;YES. SET IOIMPM
SKIPG DEVREL##(F) ;TRYING TO WRITE A RIB (USETI 0 OR -N/OUTPUT)
JRST SETBTL ;YES. LIGHT IOBKTL AND RETURN
PUSHJ P,TSTSFD ;MAKE SURE NOT DOING OUTPUT TO AN SFD OR UFD
JRST SETIMP ; (CAN'T ENTER *.SFD IF FTSFD=0)
HRRZ U,DEVUNI##(F)
PUSHJ P,WTRBIC## ;REWRITE RIB IF CHANGED, USER WANTS IT
; (FROM A PREVIOUS OUTPUT)
TLO S,IO ;NO. INDICATE OUTPUT
MOVEM S,DEVIOS(F) ;SAVE S
PUSHJ P,UUOSET## ;SET DDB PNTRS FOR THIS OPERATION
JRST SETBTL ;QUOTA EXHAUSTED
PUSHJ P,CHKLBK ;CHECK FOR LAST BLOCK OF APPEND-ONLY
JRST SETBTL ;NOT ALLOWED
PJRST UUOPWQ## ;OK, GO QUEUE REQUEST
POPJ P, ;ALREADY DONE
OUTPT1: PUSHJ P,ADVBFE## ;NULL DEVICE-EAT THE BUFFER
JFCL
POPJ P, ;AND RETURN
;DUMP MODE INPUT
DMPIN: PUSHJ P,NULTST ;IF NUL:,
JRST SETION ; RETURN EOF
PUSHJ P,SPTSTI ;SEE IF 1ST INPUT IN SPOOL MODE
PJRST SETION ;YES, AND NO FILE - SET IOEND
TLNE S,IOSUPR ;SUPER USETI DONE?
JRST DMPIN1 ;YES. DON'T CHECK POINTERS
TLNN F,LOOKB ;LOOUP BEEN DONE?
PJRST SETIMP ;NO. LIGHT IOIMPM AND RETURN
DMPIN1: TLZ S,IO ;NO. INDICATE INPUT
JRST DUMPST ;AND CONTINUE
;SUBROUTINE TO MAKE SURE AN OUTPUT UUO ISNT BEING DONE TO AN SFD OR UFD
TSTSFD: HLRZ T1,DEVEXT(F)
CAIE T1,(SIXBIT .SFD.) ;AN SFD?
CAIN T1,(SIXBIT /UFD/) ;OR UFD?
SOS (P) ;YES, YOU LOSE
PJRST CPOPJ1##
;DUMP MODE OUTPUT
DMPOUT: PUSHJ P,NULTST ;IF NUL,
POPJ P, ; DONT WRITE ANYTHING
PUSHJ P,SPTSTO ;SEE IF 1ST OUTPUT IN SPOOL MODE
PJRST SETIMP ;YES, AND ERROR ON ENTER - SET IOIMPM
TLNE S,IOSUPR ;SUPER USETO DONE?
JRST [SKIPE U,DEVUNI##(F) ;IF UNIT ISNT IN AN STR
SKIPE UNILOG(U) ; THEN WRITE HEADERS IS LEGAL
TRZN S,UDSX ;IF IN AN STR,
JRST DMPOU1
JRST SETIMP] ;WRITE HEADERS IS A NO-NO
TLNE F,ENTRB ;ENTER BEEN DONE?
TLNE S,IOSWLK ;YES. STR WRITE LOCKED?
JRST SETIMP ;YES. SET IOIMPM
SKIPG DEVREL##(F) ;NO. TRYING TO WRITE A RIB (USETI 0 OR -N/OUTPUT)
JRST SETBTL ;YES. LIGHT IOBKTL AND RETURN
PUSHJ P,TSTSFD ;MAKE SURE NOT OUTPUTTING TO AN SFD
JRST SETIMP ;YES WE ARE, ILLEGAL
DMPOU1: TLO S,IO ;NO. INDICATE OUTPUT
DUMPST: PUSHJ P,SAVE1##
DUMPGO: MOVEM S,DEVIOS(F) ;SAVE S
PUSH P,S ;FILSER ALWAYS RETURNS TO UUO
;LEVEL FOR EACH IOWD. HENCE WE DO
;NOT SAVE THE LIMITS OR FLAG, AND WE
PUSHJ P,COMCHK## ;RECOMPUTE THE LIMITS. COMCHK RETURNS
;HERE WITH S=0 IF OK,-1 IF ERROR
;P AND P1 CONTAIN THE LIMITS, BUT WE
JUMPE S,DUMPG1 ;THROW THEM AWAY. JUMP IF NO ERROR
POP P,S ;THERE WAS AN ERROR
TRZ S,UDSX ;MAKE SURE FORMAT-SWITCH IS OFF
MOVEM S,DEVIOS(F)
JRST ADRERR## ;RESTORE S AND GO REPORT IT
;HERE WHEN THE IO LIST HAS BEEN CHECKED, M POINTS TO LIST
DUMPG1: POP P,S ;RESTORE S WHEN NO ERROR
MOVE P1,T1 ;SAVE UNRELOCATED IOWD
JUMPN T1,DUMPG3 ;IF IOWD GO ON TO DO IT
SETZM DEVDMP##(F) ;THROUGH - ZERO DEVDMP
TRZ S,UDSX ;MAKE SURE WRITE-FORMAT OFF
PUSHJ P,WTRBIC## ;REWRITE RIB IF CHANGED, USER WANTS IT
PJRST STOIOS## ;AND RETURN TO USER
;HERE TO DO A RETRY AT UUO LEVEL
DUMPG9:
IFN FTXMON,<
SETZ T1, ;CLEAR CARRY BETWEEN SECTIONS FOR MAPIO
DPB T1,DEYISN## ;SINCE WE'RE BACKING UP THE I/O
>
HLRZ T1,DEVUVA##(F) ;REBUILD THE IOWD
SUBI T1,(P1)
HRLS T1
ADD T1,P1
DUMPG3: HLLZM T1,DEVDMP##(F) ;STORE -NO OF WORDS LEFT, CORE ADR=0
;RH GETS SET BELOW AT DUMPG5
PUSHJ P,UUOSET## ;SET DDB POINTERS FOR THIS OPERATION
JRST DUMPG8 ;EOF OR QUOTA EXHAUSTED
HLRE T2,P1 ;-NO OF WORDS LEFT TO GO IN THIS IOWD
HLRE T1,DEVDMP##(F) ;-NO OF WDS TOTAL IN THIS IOWD
SUBM T2,T1 ;-NO OF WDS DONE SO FAR IN THIS IOWD
MOVNS T1 ;+NO OF WDS DONE SO FAR IN THIS IOWD
HRLS T1 ;SET TO UPDATE ORIGINAL IOWD
ADD T1,P1 ;INCREMENT BOTH HALVES BY TOTAL SO FAR
HRRM T1,DEVDMP##(F) ;STORE ABS ADR FOR DATA TRANSFER
; (RH ALREADY SET -IGNORE OVERFLOW FROM LH)
HRLM T1,DEVUVA##(F) ;SAVE FOR COMPUTING THE CHECKSUM
PUSHJ P,CHKLBK ;CHECK FOR LAST BLOCK OF APPEND ONLY
JRST SETBTL
PUSHJ P,UUOPWQ## ;OK - GO QUEUE REQUEST
PUSHJ P,PWAIT1## ;WAIT FOR IO TO FINISH
TLZE S,IOSTBL ;TROUBLE?
JRST DUMPG9 ;YES, RETRY AT UUO LEVEL
MOVE T1,DEVDMP##(F) ;THIS COMMAND DONE?
TLNE T1,-1
JRST DUMPG3 ;NO. CONTINUE WITH THIS IOWD
MOVEM P1,DEVDMP##(F) ;PUT ORIGINAL IOWD BACK
TLC S,IO!IOSUPR ;SUPER OUTPUT
TLCN S,IO!IOSUPR ;?
PUSHJ P,CSDELI## ;YES--DELETE THIS IOWD FROM CACHE
HRRZ T1,DEVACC##(F) ;GET LOC OF A.T.
JUMPE T1,DUMPG7 ;GO ON IF NO A.T.
MOVE T1,ACCWRT##(T1) ;NO OF BLOCKS WRITTEN
CAMGE T1,DEVREL##(F) ;IS THIS THE LAST BLOCK OF THE FILE?
TLNN S,IO ;YES, WRITING?
DUMPG7: AOJA M,DUMPGO ;NO. GO GET NEXT IOWD AND CHECK IT
HLRE T1,P1 ;YES. GET WORDCOUNT OF IOWD
MOVNS T1 ;+N
TRNE T1,BLKSIZ##-1 ;AN EVEN MULTIPLE OF BLKSIZ WORDS?
TRZA T1,BLKSIZ## ;NO. MAKE SURE COUNT LT 200
MOVEI T1,BLKSIZ## ;YES. MAKE SURE ONLY BLKSIZ IS ON
HRRZ T2,DEVACC##(F) ;LOC OF A.T.
DPB T1,ACYLBS## ;SAVE WORDCOUNT OF LAST BLOCK
AOJA M,DUMPGO ; GO GET NEXT IOWD AND CHECK IT
;HERE ON AN ERROR RETURN FROM UUOSET
DUMPG8: TLNE S,IO ;INPUT?
JRST SETBTL ;NO, QUOTA EXHAUSTED, DISK FULL
SETION: TDO S,[XWD IOEND,IODEND] ;YES. EOF
PJRST STOIOS## ;SAVE S AND RETURN TO CALLER
;HERE ON AN OUTPUT REQUEST TO RELATIVE BLOCK 0 OF THE FILE
;(OCCURS AFTER USETI/USETO 0)
SETBTL: TROA S,IOBKTL ;LIGHT IOBKTL
;HERE ON AN OUTPUT REQUEST TO A WRITE-LOCKED STR
SETIMP::TRO S,IOIMPM ;LIGHT WRITE-LOCK ERROR BIT
PJRST STOIOS## ;SAVE S AND RETURN TO CALLER
;ROUTINE TO CHECK IF WRITING LAST BLOCK OF APPEND ONLY FILE.
;DO NOT ALLOW THE USER TO ALTER THE PORTION OF THE BLOCK
;WHICH WAS PREVIOUSLY WRITTEN.
;READ THE LAST BLOCK INTO A MONITOR BUFFER, AND COPY
;THE FIRST PORTION INTO THE USER'S BUFFER. THUS IF THE
;USER IS ATTEMPTING TO ALTER THE FIRST PORTION, HIS DATA WILL
;BE OVERWRITTEN WITH THE CORRECT VALUES.
;RETURN CPOPJ IF TRANSFER IS NOT TO BE ALLOWED.
;I.E. NEW BUFFER IS SMALLER THAN OLD.
;RETURN CPOPJ1 IF IT'S OK TO LET HIM DO THE TRANSFER
;RETURN CPOPJ2 IF TRANSFER IS ALREADY DONE (CAN ONLY HAPPEN IN BUFFERED).
CHKLBK: TLNE S,IO ;WRITING?
TLNE S,IOSUPR ;AND NOT SUPER?
JRST CPOPJ1 ;NO, OK
LDB T1,DEYFNC## ;PROTECTION OF FILE
HRRZ T2,DEVACC##(F) ;ADDR OF ACC
MOVE T3,ACCWRT##(T2) ;NUMBER OF BLOCKS WRITTEN
CAMN T3,DEVREL##(F) ;LAST BLOCK?
CAIE T1,FNCAPP## ;AND APPEND-ONLY?
JRST CPOPJ1## ;NO, OK
PUSHJ P,SAVE2## ;SAVE P1,P2
LDB P1,ACYLBS## ;SIZE OF LAST BLOCK
JUMPE P1,CPOPJ1## ;IF EMPTY LET HIM DO IT
CAIL P1,BLKSIZ## ;LAST BLOCK HAVE ROOM?
POPJ P, ;NO, DON'T LET HIM
LDB T1,PIOMOD## ;MODE OF FILE
CAIL T1,SD ;DUMP MODE OR BUFFERED?
JRST CHKLB1 ;DUMP
HRRZ P2,DEVOAD(F) ;BUFFERED, GET ADDR OF BUFFER
EXCTUX <MOVE T1,1(P2)> ;GET SIZE
ADDI P2,2
JRST CHKLB4
;HERE IF DUMP MODE
CHKLB1: HLRE T1,DEVDMP##(F) ;GET SIZE OF USER BUFFER
MOVNS T1
HLRZ P2,DEVUVA##(F) ;GET ADDR OF USER BUFFER
ADDI P2,1
;HERE WITH:
;T1=SIZE OF USER BUFFER
;P1=SIZE OF LAST BLOCK
;P2=ADDR OF USER BUFFER
CHKLB4: CAMGE T1,P1 ;NEW SIZE MUST BE BIGGER THAN OLD
POPJ P,
PUSHJ P,GTMNBF## ;GET A MON-BUF
MOVE T2,DEVBLK##(F) ;NUMBER OF LAST BLOCK
PUSHJ P,MONRDU## ;READ IT
PJUMPN T3,CPOPJ## ;RETURN IF ERRORS DETECTED IN MONRED
HRLZI T1,1(T1) ;FROM
HRR T1,P2 ;TO
ADDI P2,-1(P1) ;STOP AT
EXCTXU <BLT T1,(P2)> ;COPY FIRST PORTION OF BLOCK
LDB T1,PIOMOD## ;MODE OF FILE
CAIL T1,SD ;DUMP MODE OR BUFFERED?
JRST CPOPJ1 ;DUMP
PUSHJ P,UUOPWQ## ;BUFFERED, START THE TRANSFER
PUSHJ P,WSYNC## ;WAIT FOR COMPLETION (EVEN IF NON-BLOCKING)
; WE DON'T WANT TO GIVE CONTROL BACK TO
; THE USER UNTIL THE TRANSFER IS COMPLETE.
; ELSE A MALICIOUS USER MIGHT ALTER THE BUFFER.
AOS -3(P) ;EXIT CPOPJ2 FROM SAVE2
JRST CPOPJ1##
;TEST FOR 1ST SPOOL-MODE INPUT. IF IT IS, DO THE LOOKUP
SPTSTI: SKIPL DEVSPL(F) ;IS THIS A SPOOLING DDB?
JRST CPOPJ1## ;NO, RETURN
MOVE T1,DEVMOD(F) ;YES, GET DEVMOD
TLNN T1,DVIN ;CAN DEVICE DO INPUT?
JRST ILLINP## ;NO, ERROR
SKIPE DEVPPN(F) ;YES. ALREADY SET UP FILE?
PJRST CPOPJ1## ;YES, RETURN
LDB J,PJOBN## ;NO. GET THE JOB NUMBER
HLRZ T2,JBTSPL##(J) ;INPUT FILE-NAME
SKIPN T2 ;IF NOT SET UP
MOVEI T2,'QAA' ; START AT QAA.CDR
MOVSM T2,DEVFIL(F) ;SAVE NAME IN DECFIL
MOVEI T2,'CDR' ;EXTENSION
MOVSM T2,DEVEXT(F) ;INTO DEVEXT
PUSHJ P,SFDPPN ;GET DEFAULT PPN
MOVEM T4,DEVPPN(F) ;INTO DDB
TLZ M,UUOMSK ;SET UP UUO
PUSHJ P,SLPTJ## ;SET T1= SL. PTR.
POPJ P, ;NO S.L.
PUSHJ P,ULOOK3 ;DO THE LOOKUP
PJRST SETBTL ;NOT FOUND- IMMEDIATE RETURN
HLRZ T1,DEVFIL(F) ;FOUND. GET THE FILE NAME
AOS T1 ;AND INCREMENT BY 1
SPTST2: LDB T2,[POINT 6,T1,35] ; SO IF NO NEW SET IS DONE,
CAIG T2,'Z' ; THE NEXT FILE WILL BE READ
JRST SPTST3
SUBI T1,'Z'-'A'+1 ;RESET TO 'A'
ROT T1,-6 ;GET THE NEXT CHAR
TRNE T1,-1 ;IS THERE ONE?
AOJA T1,SPTST2 ;YES, INCREMENT IT
ROT T1,6 ;DONE - SET UP IN RH AGAIN
SPTST3: TLNE T1,-1 ;COMPLETELY IN RH?
JRST .-2 ;NO, GET NEXT CHAR
LDB J,PJOBN## ;JOB NUMBER
HRLM T1,JBTSPL##(J) ;SAVE NEXT FILE-NAME IN JBTSPL
TLO F,LOOKB ;INDICATE LOOKUP DONE
PUSHJ P,JDAADR##
HLLM F,(T1) ;SAVE BITS IN USRJDA
PJRST CPOPJ1## ;AND TAKE GOOD RETURN
;STILL IN FTSPL CONDITIONAL
;TEST FOR 1ST SPOOL-MODE OUTPUT
SPTSTO: MOVE T1,DEVMOD(F) ;DEVMOD OF REAL DEVICE
TLNN T1,DVOUT ;CAN IT DO OUTPUT?
JRST SPTST9 ;NO, GIVE ERROR
SKIPGE DEVSPL(F) ;SPOOLING DDB?
SKIPE DEVPPN(F) ;YES, ALREADY SET UP?
PJRST CPOPJ1## ;YES, RETURN
TLNE S,IOSRST ;DOING A RESET UUO?
PJRST CPOPJ1## ;YES, DON'T ENTER ANYTHING
SPTSTR: PUSHJ P,SAVE2## ;NO. SAVE P1,P2
MOVEI T2,4 ;GET 1 4-WORD BLOCK
PUSHJ P,GETWDS## ;ALLOCATE CORE
POPJ P, ;NONE AT ALL- CANT FAKE THE ENTER
MOVE P1,T1 ;GOT ONE - SAVE ITS LOC IN P1
HRLI T1,.JDAT+140 ;SINCE GETWRD WANTS M TO POINT TO A USER'S AREA,
BLT T1,3(P1) ; SAVE USER'S 140-143,
; USE THESE LOCS FOR THE FAKED ENTER
MOVE T1,DATE## ;GET DATE
MOVEM T1,SPLGEN## ;SAVE IT
SPTSO1: AOS T1,SPLGEN## ;INCR AND LOAD
IDIV T1,[44*44*44*44*44] ;DIVIDE BY 36^5
MOVE T1,[POINT 6,.JDAT+140] ;POINT TO FILENAME
SETZM .JDAT+140
MOVEI T3,'Q' ;LOAD FIRST LETTER
IDPB T3,T1 ;STORE IT
PUSHJ P,SPTSO2 ;MAKE A NAME
MOVEI T1,'SPL' ;RELEASE 4 EXTENSION
SKIPN %SIOPR## ;IS ORION RUNNING
HLRZ T1,DEVNAM(F) ;NO, GET INIT'ED DEVICE
CAIE T1,'LL ' ;LOWER
CAIN T1,'LU ' ;UPPER
MOVEI T1,'LPT' ;SOME FLAVOR OF LPT
HRLZM T1,.JDAT+141 ;STORE
SKIPE T1,%SIQSR##
MOVE T1,SPLPPN## ;GET PPN
MOVEM T1,.JDAT+143 ;SAVE IT
JRST SPTSO3
SPTSO2: IDIVI T2,^D36 ;DIVIDE BY 36
PUSH P,T3 ;SAVE RESIDUE
SKIPE T2 ;SKIP IF DONE
PUSHJ P,SPTSO2 ;ELSE RECURSE
POP P,T2 ;GET A CHAR
ADDI T2,'0' ;MAKE IT SIXBIT
CAILE T2,'9' ;IF NOT A DIGIT
ADDI T2,'A'-'9'-1 ;MAKE IT ALPHA
IDPB T2,T1 ;DEPOSIT
POPJ P, ;UNWIND
SPTSO3: JUMPN T1,SPTS5A ;DON'T CHANGE NAME IF QUASAR RUNNING
MOVE T1,DEVNAM(F) ;GET DEVICE USER INITED
HLRZ T3,T1 ;GET LEFT HALF
CAIE T3,'LL ' ;IS IT LL?
CAIN T3,'LU ' ;OR LU?
MOVSI T1,'LPT' ;MAKE IT LPT
HLLZM T1,.JDAT+141 ;AND STORE IT
IFN FTNET,<
TRNE T1,-1 ;IS THERE A RIGHT HALF?
JRST SPTST4 ;YES
LDB T2,PJOBN## ;NO, JOB NUMBER
MOVE T1,JBTLOC##(T2) ;WHERE THE JOB IS
PUSHJ P,CVTSBT## ;CONVERT TO SIXBIT
LSH T1,-^D24 ;INTO RH(T1)
TRO T1,'S ' ;'S' FOR STATION
CAIN T3,'LL ' ;IS IT LL?
TRC T1,370000 ;YES MAKE 'S' INTO 'L'
CAIN T3,'LU ' ;IS IT LU?
TRC T1,060000 ;YES MAKE 'S' INTO 'U'
> ;END IFN FTNET
SPTST4: HRRM T1,.JDAT+140 ;SAVE RH OF FILE NAME IN ENTER BLOCK
MOVEI T1,^D640 ;THERE ARE 36**2 LEGAL NAMES STARTING WITH "Q",
HRRM T1,.JDAT+141 ; SO SET A LIMIT OF HALF THAT
AOS T1,SPLGEN## ;START WHERE LEFT OFF LAST
IDIVI T1,^D46655 ; ENSURE .LT. 36^3
IDIVI T2,^D36 ; CONVERT TO NUMBER
ADDI T3,20 ;TO "SIXBIT
CAILE T3,31
ADDI T3,7 ; LETTER
LSHC T3,-6 ;SAVE THE CHAR
IDIVI T2,^D36 ;SECOND CHAR
ADDI T3,20
CAILE T3,31
ADDI T3,7
LSHC T3,6 ;2 CHARS IN T3
TRO T3,'Q ' ;+ 'Q'
ADDI T2,20
MOVE T1,.JDAT+141 ;COUNT OF TRIES
TRNE T1,-1 ;TRIED (AND LOST) ENOUGH?
SOSA .JDAT+141 ;NO
DPB T2,[POINT 6,T3,23] ;YES, 1ST CHAR = RANDOM
HRLM T3,.JDAT+140 ;SAVE NAME
SETZM .JDAT+143 ;ZERO PPN
SPTS5A:
PUSH P,M ;SAVE M
HRRI M,140 ;POINT M TO THE FAKED ENTER-BLOCK
MOVE T2,SPLPRT## ;PROTECTION FOR SPOOLED FILES
MOVEM T2,.JDAT+142
MOVEI P2,UENT4
SKIPL DEVSPL(F)
HRROI P2,RECLSD
IFN FTKL10&FTMP,<
PUSH P,DEVNBF(F) ;WE'LL CHANGE THIS NUMBER DOING THE ENTER
>
PUSHJ P,(P2) ;FAKE AN ENTER
JRST SPTST6 ;DID NOT WIN
SKIPL P2
TLO F,ENTRB ;OK - TURN ON ENTRB
IFE FTKL10&FTMP,<
AOSA T1,-1(P) ;SET FOR SKIP-RETURN
>
IFN FTKL10&FTMP,<
AOSA T1,-2(P)
>
SPTST6: TLZ F,ENTRB ;MAKE SURE ENTRB OFF ON FAILURE
IFN FTKL10&FTMP,<
POP P,DEVNBF(F)
>
POP P,M ;RESTORE UUO
PUSH P,T1 ;GET CHAN NUM
PUSHJ P,JDAADR##
HLLM F,(T1) ;SAVE BITS IN USRJDA
POP P,T1
TLZ T1,-1
CAIE T1,FBMERR ;FILE BEING MODIFIED?
CAIN T1,AEFERR ;OR SUPERSEDE ERROR?
JRST SPTSO1 ;YES, TRY AGAIN
HRLZ T2,P1 ;LOC OF 4-WORD BLOCK
HRRI T2,.JDAT+140 ;SET TO RESTORE USER'S 0-3
BLT T2,.JDAT+143 ;BACK AS GOOD AS NEW
MOVEI T1,4 ;DONE - GIVE UP CORE BLOCK
HRRZ T2,P1 ;CORE ADDRESS
PJRST GIVWDS## ;RETURN BLOCK AND EXIT
SPTST9: TLNE S,IOSRST ;FORGET IT IF RELEASE (PROBABLY A COMMAND)
POPJ P, ;COMMAND - ALLOW IT TO FINISH
PJRST ILLOUT## ;UUO - ERROR MESSAGE
;END FTSPL CONDITIONAL
SUBTTL CLOSE
;WHEN RENAME CALLS CLOSE, IT MAY ALREADY HAVE THE MONITOR BUFFER, AND THE RIB
;MAY BE IN IT. IF SO, DEPRIB IS ON IN S
;INPUT CLOSE
CLOSIN: TLZE F,LOOKB ;LOOKUP IN FORCE?
TLZN S,IOSRDC ;YES, READ COUNT UP FOR CHAN?
PJRST STOIOS## ;NO. RETURN
CLOSRN: PUSHJ P,SAVE2## ;SAVE P1,P2
PUSHJ P,SETU## ;WAS F/S YANKED?
POPJ P, ;YES, RETURN
HLRZ U,DEVUNI##(F) ;SET U TO UNIT OF RIB
PUSHJ P,TSTRDR ;IS ANYONE ELSE READING FILE?
JUMPE T1,STOIOS## ;RETURN IF NO AT
MOVE P2,T1 ;SET RH(P2)=LOC OF NMB
CLOSR1: HLRZ P2,ACCNMB##(P2)
SKIPN P2
STOPCD UACLX,JOB,ALW, ;++ACCESS TABLE LINKED WRONG.
;IT'S PROBABLY ON THE FREE LIST.
;PROBABLE CAUSE: USE COUNT IS
;WRONG.
TRZN P2,DIFNAL##
JRST CLOSR1 ;LOOP
MOVSI T4,DEPRAD## ;DONT DECR PPB COUNT
TDNN T4,DEVRAD##(F) ; IF RENAME ACROSS DIRS
HRL P2,ACCPPB##(T1) ;AND LH(P2)=LOC OF PPB
ANDCAM T4,DEVRAD##(F) ;NO LONGER RENAMING ACCROSS DINS
TRNE T2,ACMCNM## ;NOT IF READ COUNT=1
JRST CLSIN2 ;YES. RESET ACCESS DATE AND EXIT
MOVEI T4,ACPSBC##
ANDCAM T4,ACCSBC##(T1)
TRNN T2,ACPREN ;FILE BEING RENAMED (BY SOME OTHER JOB)?
; CANT BE FOR THIS JOB SINCE ACPREN IS A VERY
; TRANSIENT BIT - RENAME CALLS CLOSE WHICH CLEARS IT
TRNN T2,ACPDEL## ;NO, FILE MARKED FOR DELETION?
JRST CLSIN2 ;NO
;HERE, CALLED FROM CLRSTS, IF THERE WAS A RENAMER, WHEN HE FINISHES
;NEEDED SINCE DELETE CODE CANT ACTUALLY DO ANYTHING EVEN IF READ-COUNT =0
;WHEN THERE IS A RENAME IN PROGRESS BY SOME OTHER JOB
CLOSR2: PUSHJ P,CLSNAM ;SET T1=LOC OF NMB, RESET DEVFIL, DEVEXT
MOVE P1,T1 ;P1=LOC OF NMB (FOR DELNAM)
MOVE T2,ACCSTS##(T2) ;STATUS OF FILE
TRNE T2,ACPNIU ;HAS FILE BEEN REMOVED FROM UFD?
JRST CLSIN1 ;GO DELETE BLOCKS OF FILE
PUSHJ P,UPAU## ;GET AU (ALTER UFD) RESOURCE
TLZ S,IOSRIB ;RIB IS NOT IN MON BUF ANY MOR
PUSHJ P,DELNAM ;FIND FILE NAME AND DELETE IT FROM UFD
JRST FREACC ;FILE NAME NOT FOUND IN UFD
CLSIN1: TLO F,RENMB ;SO RIBCHK WON'T CHECK RIBDIR
PUSHJ P,REDRIB## ;GO READ THE RIB INTO CORE
JRST FREAC1 ;RIB ERROR, DON'T COUNT ON THE DATA
TLZ F,RENMB
PUSHJ P,SPTRW## ;SET UP AN AOBJN WORD FOR POINTERS
MOVE P1,T1 ;AOBJN WORD INTO P1
PUSHJ P,DELRIB ;GO DELETE THE BLOCKS OF THE FILE
STOPCD .+1,DEBUG,DNS, ;++DELRIB NON-SKIP RETURN
PUSHJ P,LOGTST ;RECOMPUTE RIBUSD IF PPN NOT LOGGED IN
PUSHJ P,SFDDEC ;DECR PPBCNT, NMBCNT
PUSHJ P,DECUSA ;DECREMENT USE-COUNTS OF THE FATHER SFD AT'S
JRST FREAC1 ;FINISH UP
;HERE WHEN THE FILE NAME WAS NOT FOUND IN THE UFD.
FREACC: PUSHJ P,DWNAU## ;GIVE UP AU RESOURCE
FREAC1: TLZ F,RENMB ;TURN OFF RENMB SO CLOSE OUTPUT WONT DO ANYTHING
PUSHJ P,GETCB## ;GET CB RESOURCE
HRRZ T1,DEVACC##(F) ;%LOC OF A.T.
CBDBUG (Y,Y);
SETZM DEVFIL(F) ;FOR SET WATCH FILE
HLRZ T2,NMBRNG##(P2) ;%IS THE FILE AN SFD?
TRNN T2,NMPUPT## ;%DOES THE SFD HAVE CHILDREN?
JUMPN T2,CLSIN8 ;%YES, RETURN ACC, LEAVE NMB
JRST CLSIN7 ;%RETURN NMB IF POSSIBLE
;HERE WHEN FILE IS NOT MARKED FOR DELETION
CLSIN2: TRNE M,CLSOUT ;SUPPRESSING OUTPUT CLOSE?
JRST CLSIN3 ;YES, CHECK (POSSIBLY UPDATE) ACCESS DATE
TLNE F,ENTRB+RENMB ;NO, ENTER OR RENAME DONE?(IF SO CLSOUT WILL BE CALLED)
JRST CLSXIT ;YES. DECREMENT COUNT AND EXIT
CLSIN3: JUMPE T1,TSTPPB ;DEVACC=0 IF F/S WAS JERKED OUT
TLNN S,IOSERR## ;UPDATE BAT BLOCK IF ERROR
TRNN M,CLSACC ;NO. SUPPRESS UPDATING ACCESS DATE?
TRNE T2,ACPREN+ACPUPD;OR RENAME OR UPDATE HAPPENING (BY A DIFFERENT JOB)?
JRST CLSIN5 ;YES, DON'T WRITE RIB
TLNN S,IOSWLK ;FILE WRITE LOCKED?
TLNN F,INPB ;NO. ANY INPUTS DONE?
JRST CLSIN5 ;NO. DON'T CHANGE ACCESS DATE
TLNE S,IOSERR## ;ANY ERRORS ENCOUNTERED?
TDZA T4,T4 ;YES. FORCE WRITING OF RIB
LDB T4,[POINT 15,ACCADT##(T1),17] ;ACCESS DATE
CAMN T4,THSDAT## ;NO. AC. DATE=TODAY?
JRST CLSIN5 ;YES. JUST SET A.T. DORMANT
MOVE T4,THSDAT## ;NO. SET ACCESS DATE=TODAY
DPB T4,[POINT 15,ACCADT##(T1),17] ;IN ACC
PUSHJ P,CLSNAM ;UPDATE DEVFIL, DEVEXT
PUSHJ P,BUFRIB## ;GET MON BUF, READ RIB INTO IT
JRST CLSIN5 ;RIB ERR - DON'T REWRITE IT
TRNE M,CLSACC
JRST CLSIN4
MOVE T1,.USMBF ;LOC OF BUF (-1)
MOVE T2,THSDAT## ;GET TODAYS DATE
DPB T2,[POINT 15,RIBEXT##+1(T1),35]
PUSHJ P,STORU##
CLSIN4: PUSHJ P,TSTBAD ;SET RIBELB IF ERROR
MOVE T2,RIBSLF##+1(T1) ;BLOCK NO. OF RIB
PUSHJ P,MONWRT## ;REWRITE THE RIB WITH NEW AC. DATE
PUSHJ P,ERRFIN ;WRITE BAT BLOCK IF THERE WAS AN ERROR
CLSIN5: TLNE F,ENTRB+RENMB ;ENTER OR RENAME DONE?
JRST CLSXIT ;YES, EXIT (UPDATE SUPPRESSING OUTPUT CLOSE)
PUSHJ P,CLSNAM ;UPDATE DDB IN CASE SOMEBODY RENAMED THE FILE
IFN FTFDAE,<
MOVSI T1,DEPFDA## ;CALL FILE DAEMON ON CLOSE BIT
TDNN T1,DEVFDA##(F) ;SHOULD THE FILE DAEMON BE CALLED?
JRST CLSIN6 ;NO
ANDCAM T1,DEVFDA##(F) ;YES, CLEAR THE BIT
MOVEI T1,.FDCLI ;INDICATE INPUT CLOSE
PUSHJ P,SNDFMG## ;TELL THE FILE DAEMON THAT
JFCL ;DON'T CARE
CLSIN6:>
PUSHJ P,SFDDEC ;DECR NMBCNT,PPBCNT FOR SFD
PUSHJ P,DECUSA ;DECREMENT USE-COUNTS OF THE FATHER SFD AT'S
PUSHJ P,DECRDR ;NO, DECREMENT COUNT
SETZ T1, ;%READ COUNT NOT 0
PUSHJ P,UACLX ;%RESET A.T. LOC AND UFB LOC IN DDB
JUMPE T1,CLSI13 ;%EXIT IF READ-COUNT NON-0
TRNE T2,ACPREN ;%RENAME IN PROGRESS (BY ANOTHER JOB)?
JRST CLSI13 ;%YES, LEAVE THE A.T. ALONE
TRNN M,CLSDAT ;%CNT=0. WANT A.T. TO GO AWAY?
TLNN F,INPB ;%NO, ANY INPUTS BEEN DONE?
TRNE M,CLSNMB ;%YES. USER WANT CORE BLOCKS TO STAY AROUND ANYWAY?
JRST CLSI14 ;%YES, JUST MAKE A.T. DORMANT
HLRZ T2,NMBRNG##(P2) ;%IS THE FILE AN SFD?
JUMPE T2,CLSIN7 ;%GO IF NOT SFD
MOVE T4,NMBCNT##(P2) ;%IS SOMEBODY INSIDE FNDFIL?
CAIG T4,1
TRNN T2,NMPUPT## ;%DOES THE SFD HAVE CHILDREN?
JRST CLSI14 ;%YES, JUST MAKE ACC DORMANT
CLSIN7: MOVE T4,NMBCNT##(P2)
SOJLE T4,CLSIN9 ;%LEAVE NMB IF ANOTHER READING
CLSIN8: PUSHJ P,ATNLNK## ;%ANOTHER USER OF NMB EXISTS
JRST CLSI10 ;% RETURN AT, LEAVE NMB
CLSIN9: HRL P1,ACCPPB##(T1) ;%DELETE ALL CORE BLOCKS FOR FILE(IF POSSIBLE)
PUSHJ P,ATNLNK## ;%UNLINK A.T. FROM NMB RING
TRZE T2,DIFNAL## ;%PREDECESSOR A NAME BLOCK?
TRZN T3,DIFNAL## ;%YES. SUCCESSOR AN NMB?
CLSI10: TDZA P1,P1 ;%NO. THERE ARE OTHER A.T.S IN RING
HRR P1,T2 ;%YES, SAVE LOC OF NMB
PUSH P,F ;%SAVE F
SKIPE P1 ;%IF WE'RE GOING TO REMOVE THE NMB,
SETZ F, ;%ZERO F SO ATSDRA WONT GIVE UP CB
PUSHJ P,ATSFR0## ;%PUT THIS A.T. ON FREE CORE LIST
POP P,F ;%RESTORE DDB LOC
HLLZS DEVACC##(F) ;%MAKE SURE THE A.T. ISN'T REUSED
JUMPE P1,CLSI15 ;%EXIT IF NMB STILL IN USE
;HERE IF NMB NOW HAS NO A.T.S IN ITS RING
HLRZ T2,P1 ;%LOC OF PPB FOR FILE
PUSHJ P,SET1NM ;%SET T2 TO 1ST NMB IN LIST
JUMPE T2,CLSI13 ;%GO IF NONE (SYSTEM ERROR?)
CLSI11: CAIN T2,(P1) ;%THIS THE RIGHT NMB?
JRST CLSI12 ;%YES. HAVE PRED IN T3
MOVE T3,T2 ;%NO. NEW PREDECESSOR
HLRZ T2,NMBPPB##(T2) ;%STEP TO NEXT NMB IN RING
TRNN T2,NMPUPT## ;%UPWARD PNTR (NOT SAME LIST) IF ON
JUMPN T2,CLSI11 ;%GO TEST IT
JRST CLSI13 ;%CANT FIND THE PREDECESSOR (SYSTEM ERROR?)
;HERE WITH T3=LOC OF PREDECESSOR NMB TO THE ONE WE WANT TO DELETE
CLSI12: MOVE T1,NMBPPB##(P1) ;%NMB'S LINK
HLLM T1,NMBPPB##(T3) ;%SAVE IN LINK OF PRED
MOVE T1,SYSCOR## ;%PREVIOUS 1ST FREE CORE BLOCK
HRLM P1,SYSCOR## ;%THIS NMB IS NEW 1ST FREE
HLLM T1,CORLNK##(P1) ;%LINK PREVIOUS 1ST FREE TO THIS ONE
HLLZS P2 ;NO NMB USE-COUNT TO DECR
CLSI13: PUSHJ P,GVCBJ1## ;%GIVE UP CB AND SKIP
CLSI14: PUSHJ P,ATSDRA## ;%MAKE A.T. DORMANT
CLSI15: SETZM DEVUNI##(F) ;THIS FILE NO LONGER OPEN (SO ENTER WILL TEST UNIT)
PUSHJ P,CLRLIB
PJRST TSTPPB ;TEST IF PPB LOGGED IN, AND EXIT
;HERE TO DECREMENT READ-COUNT, EXIT
CLSXIT: PUSHJ P,DECRDR ;%COUNT DOWN BY 1
JFCL ;%READ COUNT NON-0
CBDBUG (Y,Y);
PUSHJ P,GVCBJ##
;TURN OFF DEPLIB
CLRLIB: MOVSI T1,DEPLIB## ;CLEAR FILE-FROM-LIB
ANDCAM T1,DEVLIB##(F) ;SO UPDATE WILL WIN
;FALL INTO DECUC
;SUBROUTINE TO DECREMENT USE-COUNTS
;ENTER P2=PPB,,NMB
;PRESERVES ALL ACS EXCEPT P2, WHICH IT CHANGES
DECUC: TRNN P2,-1 ;IF FROM CLRSTS, COUNTS ALREADY DECR'D
JRST DECUC1
SOSL NMBCNT##(P2) ;DECREMENT NMB COUNT
JRST DECUC1
;STOPCD .+1,DEBUG,NUN, ;++NMB USE-COUNT NEGATIVE
SETZM NMBCNT##(P2) ;RESET COUNT
PUSH P,T1 ;SAVE SOME DEBUGGING INFO
AOS NUNCNT ;COUNT OF "NUN STOPCDS"
MOVE T1,PPBNAM##(P2)
MOVEM T1,NUNSFD
HLRZ T1,NMBACC##(P2)
TRZE T1,DIFNAL##
JRST .+3
MOVE T1,ACCPPB##(T1)
MOVE T1,PPBNAM##(T1)
MOVEM T1,NUNPPN
POP P,T1
DECUC1: HLRZS P2
JUMPE P2,CPOPJ## ;NO PPB TO DECR IF 0
SOSL PPBCNT##(P2) ;DECREMENT PPB COUNT
POPJ P,
;STOPCD .+1,DEBUG,PUN, ;++PPB USE-COUNT NEGATIVE
SETZM PPBCNT##(P2)
AOS PUNCNT ;COUNT OF "PUN STOPCDS"
PUSH P,PPBNAM##(P2)
POP P,PUNPPN
POPJ P, ;EXIT
$LOW
PUNCNT: 0
PUNPPN: 0
NUNCNT: 0
NUNPPN: 0
NUNSFD: 0
$HIGH
;SUBROUTINE TO SET UP P2 FOR DECUC
;RETURNS T1=L(AT), P2 CHANGED
DECSU: PUSHJ P,GETNMB ;GET LOC OF NMB,AT
EXCH T1,T2 ;T1=LOC OF AT
MOVE P2,T2 ;P2=NMB
HRL P2,ACCPPB##(T1) ;P2=PPB,,NMB
POPJ P, ;RETURN
;SUBROUTINE TO DECREMENT NMB,PPB COUNTS IF FILE IS IN AN SFD
;PRESERVES T1,T2
SFDEC:
SFDDEC: SKIPA T4,[-1] ;SET TO COUNT DOWN
SFDUP: MOVEI T4,1 ;SET TO COUNT UP
HRRZ T3,DEVSFD##(F) ;LOC OF SFD
JUMPE T3,CPOPJ## ;RETURN IF NONE
ADDM T4,NMBCNT##(T3) ;CHANGE NMBCNT
HLRZ T3,NMBACC##(T3)
TRNE T3,DIFNAL## ;POINT AT A.T.
POPJ P, ;NO A.T., RETURN
MOVE T3,ACCPPB##(T3) ;POINT AT PPB
ADDM T4,PPBCNT##(T3) ;COUNT PPBCNT UP OR DOWN
POPJ P, ;AND RETURN
;SUBROUTINE TO FIND THE ACCESS-TABLE FOR A FILE, GET THE STATUS
; IN T2
;ALWAYS RETURNS CPOPJ WITH T2=STATUS=READ COUNT
TSTRDR: TDZA T2,T2 ;DECREMENT COUNT BY 0
;AND FALL INTO DECRDR
;SUBROUTINE TO DECREMENT THE NUMBER OF READERS OF A FILE
;EXIT CPOPJ IF THERE ARE OTHER READERS, CPOPJ1 IF THE READ COUNT HAS GONE TO 0
;EXITS WITH THE COUNT (=STATUS) WORD IN T2, WITH CB RESOURCE, AND T1=A.T. LOC (OR 0).
DECRDR::MOVNI T2,ACPCNT## ;SET TO DECREASE READ COUNT
HRRZ T1,DEVACC##(F) ;LOC OF A.T.
JUMPE T1,CPOPJ## ;SYSTEM ERROR (?) IF 0
SKIPE T2 ;IF CHANGING THE READ-COUNT,
PUSHJ P,GETCB## ; GET CB RESOURCE
ADDB T2,ACCCNT##(T1) ;%1 LESS JOB IS READING FILE
MOVEM S,DEVIOS(F) ;%SAVE S (IOSRDC NOW OFF)
; SO REDOING CLOSE WON'T DECREMENT
; AGAIN (EG ON ADR ERR ON CLOSE)
TRNE T2,ACMCNT+ACPREN+ACPUPD ;%ANYONE USING FILE AT ALL?
POPJ P, ;%YES, NON-SKIP
PJRST CPOPJ1## ;%NO, SKIP-RETURN
;SUBROUTINE TO GET THE LOC OF THE NMB FROM THE DDB
;GETNMB GETS/GIVES CB RESOURCE IF NECESSARY, GTNM1 EXPECTS CALLER
;ALREADY OBTAINED THE CB RESOURCE.
;RETURNS T1=LOC OF NMB, T2=LOC OF A.T.
;ENTER AT GTNM1 WITH LOC OF A.T. IN T1; T,T2,T3 RESPECTED
GETNMB::PUSHJ P,UPCB## ;GET THE CB RESOURCE IF WE DON'T ALREADY OWN IT
HRRZ T2,DEVACC##(F) ;%LOC OF A.T.
SKIPN T1,T2 ;%IS THERE ONE?
JRST GTNM2 ;%NO, BAD NEWS
GTNM1:: JUMPE T1,S..NNF ;%IF A.T. RING RUNS OUT, DIE
HLRZ T1,ACCNMB##(T1) ;%STEP TO NEXT IN RING
TRZN T1,DIFNAL## ;%IS IT AN NMB?
JRST GTNM1 ;%NO. TRY NEXT
POPJ P, ;%YES. RETURN
GTNM2: SKIPN DEVUNI##(F)
POPJ P,
STOPCD CPOPJ##,STOP,NNF, ;++NMB NOT FOUND
;SUBROUTINE TO SET UP DEVFIL AND DEVEXT FROM NMB
; CALLED BY CLOSE INPUT (SINCE ANOTHER JOB MIGHT HAVE RENAMED THE FILE
; THIS JOB WAS USING, SWITCHING THE A.T. TO A NEW NMB)
;RETURNS T1=LOC OF NMB T2=LOC OF A.T.
CLSNM:: PUSHJ P,GETNMB ;SET T1=NMB, T2=A.T.
MOVE T3,NMBNAM##(T1) ;NAME
MOVEM T3,DEVFIL(F) ;INTO DDB
HRLZ T4,NMBEXT##(T1) ;GET EXTENSION
HLLM T4,DEVEXT(F) ;INTO DDB
POPJ P, ;RETURN
;ROUTINE TO FIX DEVFIL, DEVEXT, DEVPPN, DEVSFD, AND DEVUFB
CLSNAM::PUSHJ P,CLSNM ;FIX DEVFIL AND DEVEXT
PUSHJ P,SAVT## ;RETURN AC'S LIKE THIS
CLSNM1: HLRZ T1,NMBPPB##(T1) ;FIND NMB OF PARENT SFD
TRZN T1,DIFNAL##
JUMPN T1,CLSNM1
MOVEM T1,DEVSFD##(F) ;STORE NEW SFD
MOVE T3,ACCPPB##(T2) ;ADDR OF NEW PPB
MOVE T4,PPBNAM##(T3) ;NEW PPN
CAMN T4,DEVPPN(F) ;HAS IT CHANGED?
POPJ P, ;NO
MOVEM T4,DEVPPN(F) ;YES, SAVE NEW PPN
LDB T1,ACYFSN## ;GET FILE STR
HLRZ T2,PPBUFB##(T3) ;ADDR OF 1ST UFB
PUSHJ P,BYTSCA## ;FIND THE RIGHT UFB
HRRM T2,DEVUFB##(F) ;SHOULD NEVER SKIP, SAVE IT
POPJ P,
;ROUTINE TO COMPUTE THE CURRENT LEVEL OF SFD NESTING
;T1 RETURNS LEVEL (E.G. UFD=0)
CNTLVL: HRRZ T2,DEVSFD##(F) ;CURRENT SFD
CNTLV0: SETZ T1, ;INITIALIZE COUNT
CNTLV1: JUMPE T2,CPOPJ ;QUIT IF TOP LEVEL
CNTLV2: HLRZ T2,NMBPPB##(T2) ;FIND PARENT SFD
TRZN T2,DIFNAL##
JUMPN T2,CNTLV2
AOJA T1,CNTLV1 ;BUMP COUNT AND DO NEXT LEVEL
;SUBROUTINE TO SET THE ADR OF THE 1ST NMB IN THE LIST
;ENTER WITH T2=LOC OF PPB
;EXIT T3=LOC OF PREDECESSOR, T2= 1ST NMB IN LIST
;IF AN SFD, RETURNS T4= LOC OF FATHER SFD NMB
SET1NM::HRRZ T4,DEVSFD##(F)
JUMPE T4,SETIN1 ;IN AN SFD?
HLRZ T2,NMBRNG##(T4) ;YES, GET 1ST NMB IN LIST
MOVEI T3,DIFNMC##(T4) ;AND PREDECESSOR
POPJ P,
SETIN1: MOVEI T3,DIFPNL##(T2) ;PRESET PRED
HLRZ T2,PPBNMB##(T2) ;1ST NMB IN PPB-LIST
POPJ P, ;AND RETURN
;SUBROUTINE TO DELETE A FILE NAME FROM A UFD
;ENTER WITH NAME TO BE DELETED IN DEVNAM,DEVEXT; UFD SPECIFIED BY DEVUFB
;AND P1=LOC OF NMB
;JOB MUST HAVE AU RESOURCE BEFORE CALLING DELNAM
;EXIT CPOPJ IF NAME NOT FOUND (STILL WITH AU RESOURCE)
;EXIT CPOPJ1 IF FOUND, WITH CFP IN T1, AND AU RES GIVEN UP
; THE UFD WILL HAVE BEEN REWRITTEN WITHOUT THE FILE NAME ON GOOD RETURN
; AND THE NMB WILL BE ADJUSTED (NMBYES=0 FOR THE STR)
DELNAM: HLRZ U,DEVUNI##(F) ;SET U TO UNIT OF RIB
PUSHJ P,UFDSRC## ;SEARCH UFD
POPJ P, ;TAKE NOT-FOUND RETURN
PUSH P,T1 ;FOUND MATCH - SAVE CFP
HRLI T1,2(T3) ;BLT REST OF NAMES IN UFD DOWN
HRRI T1,(T3) ; BY 2 (OVERWRITE THIS NAME)
HLRE T4,T3 ;DISTANCE FROM NAME TO END OF BLOCK
MOVNS T4
ADD T3,T4 ;ADDR ONE PAST END OF BUF
CAIE T4,2 ;DON'T DO BLT IF LAST ENTRY
BLT T1,-3(T3) ;SLIDE EVERYTHING DOWN
SETZM -2(T3) ;ZERO LAST SLOT IN UFD BLOCK
SETZM -1(T3)
PUSHJ P,WRTDIR ;GO WRITE THE UPDATED UFD
PUSHJ P,DWNAU## ;GIVE UP AU RESOURCE
JUMPE P1,TPOPJ1## ;DON'T CHANGE NMB IF P1=0
PUSHJ P,GETCB## ;CHANGE NMB - GET CB RESOURCE
HRRZ T2,DEVUFB##(F) ;%LOC OF UFB
LDB T1,UFYFSN## ;%GET FSN
PUSHJ P,FSNPS2## ;%SET A BIT FOR NMBYES
ORM T2,NMBKNO##(P1) ;%YES WE KNOW ABOUT FILE
ANDCAM T2,NMBYES##(P1) ;%NO IT IS NOT IN THIS STR
POP P,T1 ;%RESTORE CFP TO T1
PJRST GVCBJ1## ;%GIVE UP CB AND SKIP RETURN
;SUBROUTINE TO TO SEE IF A BAD BLOCK (OR REGION) WAS ENCOUNTERED
;IF SO, SET RIBELB,RIBEUN,RIBNBB,RIBSTS. DO NOT WRITE RIB,AS THIS IS DONE BY CALLING ROUTINE
;EXIT WITH T1=C(.UPMBF)
TSTBAD: MOVE T1,.USMBF ;POINT AT RIB
HLRZ T3,S ;LH STATUS BITS
ANDI T3,IOSERR## ;MASK OUT ALL BUT ERROR BITS
JUMPE T3,CPOPJ## ;RETURN IF NONE
MOVEI T2,RIPABC## ;SET TO TEST FOR ALWAYS BAD CHECKSUM
TDNN T2,RIBSTS##+1(T1) ;ALWAYS BAD CHECKSUM?
ORM T3,RIBSTS##+1(T1) ;NO, SAVE ERROR BITS IN RH(RIBSTS)
SKIPN T2,DEVELB##(F) ;SHOULD A REGION BE MARKED IN BAT.SYS?
POPJ P, ;NO. RETURN
;HERE WITH T2=1ST BLOCK OF A REGION TO MARK IN BAT.SYS
MOVEM T2,RIBELB##+1(T1) ;SAVE 1ST BLOCK NO IN RIB
LDB T3,DEYEUN## ;UNIT (WITHIN STR) OF ERROR
MOVSM T3,RIBEUN##+1(T1) ;SAVE IN LH OF RIBEUN
PUSHJ P,SAVE2## ;SAVE P1
PUSH P,U ;SAVE U
MOVE T2,T3 ;UNIT NUMBER WITHIN F/S
PUSHJ P,NEWUNI## ;SET U TO RIGHT UNIT
MOVE U,(P) ;BAD NUMBER - ASSUME ORIGINAL U IS RIGHT
MOVEI P1,1 ;P1 WILL COUNT # OF BLOCKS IN BAD REGION
IFN FTCIDSK,<
SETZ P2, ;ASSUME WE WON'T NEED A BUFFER
LDB T2,UNYKTP## ;GET KONTROLLER TYPE
CAIE T2,TYPRA ;CI DISK?
JRST TSTBD1 ;NO
MOVEI T2,BLKSIZ## ;SIZE OF A BLOCK
PUSHJ P,GFWDCD## ;GET A BUFFER TO SCAN THE BAD BLOCK/REGION
STOPCD TSTBD5,DEBUG,CGB, ;++CAN'T GET BUFFER TO READ BAD BLOCK
SOS P2,T1 ;GET ADDRESS -1
TLOA T1,MBLKSZ## ;IOWD TO READ 1 BLOCK, AND STORE DATA
>; END IFN FTCIDSK
TSTBD1: MOVSI T1,MBLKSZ## ;IOWD TO READ 1 BLOCK, BUT NOT STORE DATA
LDB T2,DEYELB## ;BAD BLOCK NUMBER
PUSH P,DEVISN##(F) ;SAVE USER'S SECTION #
SETZM DEVISN##(F) ;MAKE SURE MAPIO IGNORES SECTION #
TSTBD2: ADDI T2,1 ;STEP TO NEXT BLOCK IN REGION
CAIGE P1,BAFNUM## ;ALREADY READ AS MANY BLOCKS AS WILL FIT IN 1 PNTR?
CAMLE T2,UNIBPU(U) ;NO, PAST TOP OF UNIT?
JRST TSTBD3 ;YES, ALL FINISHED READING BAD BLOCKS
PUSHJ P,MONRDU## ;NO, READ IT
TRNE T3,IODTER+IODERR ;IS IT BAD?
AOJA P1,TSTBD2 ;YES. COUNT AND TRY NEXT BLOCK
TSTBD3:
IFN FTCIDSK,<
JUMPE P2,TSTBD4 ;JUMP IF NO BUFFER TO RETURN
MOVEI T2,1(P2) ;GET ADDRESS OF BUFFER
MOVEI T1,BLKSIZ## ;SIZE OF A BLOCK
PUSHJ P,GVFWDS## ;RETURN THE SPACE
>; END IFN FTCIDSK
TSTBD4: MOVE T1,.USMBF ;LOC OF MON BUF (AND RIB)
HRRM P1,RIBNBB##+1(T1) ;SAVE COUNT IN RIB
POP P,DEVISN##(F) ;RESTORE SECTION #
TSTBD5: POP P,U ;RESTORE ORIGINAL U
PJRST STORU## ;SAVE IN DDB AND RETURN
;SUBROUTINE TO FINISH UP IF AN ERROR OCCURRED
;UPDATE BATBLK, LH(RIBSTS) IN THE UFD RIB
ERRFIN: TLNN S,IOSERR## ;ANY ERROR?
POPJ P, ;NO. RETURN
PUSHJ P,SAVE2## ;YES. SAVE P1,P2
MOVE T1,.USMBF ;LOC OF RIB
MOVE P1,RIBELB##+1(T1) ;REGION TO WRITE IN BAT.SYS?
TLZ P1,BATMSK## ;JUST BLOCK NO.
JUMPE P1,ERFIN5 ;NOT IF 0
HLRZ T2,RIBEUN##+1(T1) ;YES. BAD UNIT IN STR
HRRZ T3,UNISTR(U) ;LOC OF STR DATA BLOCK
JUMPE T3,ERFIN0 ;DON'T GO TO NEWUNI IF NOT IN A F/S
;(FROM RELEASE AFTER SUPER USETI/O)
PUSHJ P,NEWUNI## ;SET U TO DATA BLOCK
JRST ERFN4A ;BAD UNIT NUMBER - IGNORE BAT BLOCK
ERFIN0: PUSHJ P,SUPDA## ;GET DA RESOURCE IF DONT ALREADY HAVE IT (SIM UPDATE)
MOVE T1,.USMBF ;LOC OF RIB
HRRZ P2,RIBNBB##+1(T1) ;LENGTH OF BAD REGION
ADD P2,P1 ;TOP BLOCK(+1) OF BAD REGION
PUSHJ P,REDBAT## ;READ AND VERIGY BAT BLOCKS
PJRST DWNDA## ;BOTH BLOCKS BAD, DON'T UPDATE
MOVEI T2,1(T1) ;1ST REAL WORD OF BAT
ADD T2,BAFFIR##(T2) ;COMPUTE AOBJN WORD FOR BAT REGIONS
ERFIN1: MOVE T3,BAFELB##(T2) ;1ST BLOCK OF A BAD REGION
TLZ T3,BATMSK##
JUMPE T3,ERFIN3 ;IF 0 DONE, THIS IS A NEW REGION
MOVEI T4,BAPNTP## ;OLD STYLE?
TDNN T4,BAFAPN##(T2)
HRRZS T3 ;YES, ONLY 18 BITS OF BLOCK NUMBER
LDB T4,BAYNBB## ;NO OF BLOCKS IN REGION-1
ADD T4,T3 ; TOP BLOCK OF BAD REGION
ADDI T4,1 ; TOP BLOCK +1
CAML P2,T3 ;DOES NEW REGION OVERLAP THIS REGION?
CAMLE P1,T4
JRST SCNBAD ;NO. LOOK AT NEXT REGION IN BAT
CAMLE P1,T3 ;YES. NEW 1ST BLOCK LT OLD 1ST BLOCK?
MOVE P1,T3 ;NO. SET P1=LOWEST BLOCK
CAMGE P2,T4 ;NEW TOP BLOCK GT OLD TOP BLOCK?
MOVE P2,T4 ;SET P2=HIGHEST BLOCK
LDB T3,BAYAPN## ;SERIAL NO OF APR WHICH 1ST SAW BAD REGION
CAME T3,SERIAL## ;WAS IT THIS APR?
JRST ERFIN2 ;NO.
LDB T3,BAYKNM## ;YES. KONTROLLER NO. WHICH 1ST SAW REGION
LDB T4,UNYKNM## ;THIS KONTROLLER NUMBER
CAMN T3,T4 ;SAME?
JRST STOPUB ; YES. STORE NEW LIMITS OF REGION
;HERE IF A DIFFERENT APR OR KONTROLLER SAW THIS REGION BEFORE
ERFIN2: MOVSI T3,BAPOTH## ;SET A FLAG FOR MULTIPLE KONTROLLERS
ORB T3,BAFOTH##(T2) ; IN THIS BAT REGION
JRST WRTBAT ;ABD WRITE BAT (DON'T MARK THIS UNIT IN BAFPUB)
SCNBAD: AOBJN T2,.+1 ;2 WORDS PER BAT ENTRY
AOBJN T2,ERFIN1 ;GO TEST NEXT BAT ENTRY
JRST ERFIN4 ;NO ROOM TO ENTER REGION - CANT DO ANYTHING WITH BAT
;HERE TO STORE A BAT ENTRY THE 1ST TIME
ERFIN3: MOVE T3,SERIAL## ;SERIAL NO OF APR
TRO T3,BAPNTP## ;NEW-STYLE ENTRY
MOVEM T3,BAFAPN##(T2)
LDB T3,UNYKNM## ;KONTROLLER NUMBER
DPB T3,BAYKNM## ;SAVE IT
AOS BAFCNT##+1(T1) ;INCREMENT COUNT OF BAT ENTRIES
;HERE TO MARK THE UNIT WHICH SAW THE ERROR
STOPUB: MOVSI T3,BARPUB## ;BIT FOR UNIT 0
MOVE T4,UDBPDN(U) ;PHYSICAL DRIVE NUMBER
ANDI T4,7 ;MODULUS 8
LSH T3,(T4) ;POSITION BIT FOR THIS UNIT
ORB T3,BAFPUB##(T2) ;MARK IN TALLY OF UNITS WHICH SAW BAD REGION
;HERE WITH P1,P2=NEW LIMITS FOR THE BAD REGION WHOSE INDEX IS IN T2
WRTBAT: SUBI P2,1(P1) ;LENGTH OF BAD REGION+1
DPB P2,BAYNBB## ;SAVE IN BAT ENTRY(NO. BAD BLKS-1)
MOVEM P1,BAFELB##(T2) ;SAVE 1ST BLOCK OF REGION
HLLZ P1,DEVELB##(F) ;GET ERROR CODE
TLZ P1,MBTMSK##
TRNE T3,BAPNTP##
IORM P1,BAFELB##(T2) ;SAVE THEM IN BAT
HRRZ T2,UNIHOM(U) ;LOC OF 1ST HOME BLOCK
ADDI T2,LBOBAT## ;LOC OF 1ST BAT BLOCK
PUSHJ P,MONWRS## ;WRITE IT
HLRZ T2,UNIHOM(U) ;LOC OF 2ND HOME BLOCK
ADDI T2,LBOBAT## ;LOC OF 2ND BAT BLOCK
PUSHJ P,MONWRS## ;WRITE IT
MOVEI T3,1(T1) ;POINT TO BAT
LDB T4,BAYNBR## ;NO OF SLOTS THE MAPPER FOUND
ADD T4,BAFCNT##(T3) ;+ NO THE MONITOR FOUND
HLRE T3,BAFFIR##(T3)
ASH T3,-1 ;2 WORDS PER ENTRY
ADD T3,T4 ;-TOTAL NUMBER
MOVNS T3 ;=-(NO OF SLOTS LEFT IN BAT)
DPB T3,UNYBCT##
ERFIN4: PUSHJ P,DWNDA## ;GIVE UP DA RESOURCE
JRST ERFIN5
;HERE IF A BAD RIBEUN IN RIB
ERFN4A: HRRZ U,DEVUNI##(F) ;RESET U
;HERE AFTER BAT BLOCK IS WRITTEN
ERFIN5: HRRZ P1,DEVUFB##(F) ;LOC OF UFB
JUMPE P1,CPOPJ## ;NO UFB IF SUPER IO
PUSHJ P,UPAU## ;GET AU RESOURCE
MOVE T1,UFBUN1##(P1) ;UNIT OF UFD
LDB T2,UN1PTR## ;NUMBER (IN STR) OF UNIT
PUSHJ P,NEWUNI## ;SET U TO UNIT DB
STOPCD DWNAU##,DEBUG,IUN, ;++INVALID UNIT NUMBER
SKIPE T2,UFBPT1##(P1) ;1ST RETRIEVAL POINTER OF UFD
PUSHJ P,CNVPTR## ;GET ADDRESS
JFCL ;BAD UNIT-CHANGE PNTR!!!
PJRST DWNAU## ;UFB WAS DELETED - GIVE UP AU AND RETURN
MOVE T1,.USMBF ;IOWD FOR MON BUFFER
MOVE T2,DEVBLK##(F) ;BLOCK NUMBER OF UFD
PUSHJ P,MONRED## ;READ UFD RIB
PJUMPN T3,DWNAU## ;ERROR ON READ-GIVE UP AU AND RETURN
HLLZ T3,S
TLZ T3,IOSMER## ;ERROR BITS
IORB T3,RIBSTS##+1(T1) ;MARK IN LH(RIBSTS)
TRNN T3,RIPNDL## ;DON'T WRITE UNCLEARABLE BITS
PUSHJ P,MONWRT## ;WRITE UFD RIB
PJRST DWNAU## ;GIVE UP AU AND RETURN
;CLOSE OUTPUT
CHNDIR==1 ;BIT ON IN M IF CHANGE DIRECTORY ON A CLOSE
CLOSOU: PUSHJ P,SPTSTO ;TEST FOR SPOOL-MODE FIRST OUTPUT
JRST SETIMP ;IT WAS, AND ERROR ON ENTER - SET IOIMP
TLNN F,ENTRB+RENMB ;ENTER OR RENAME DONE?
POPJ P, ;NO. RETURN
HRRZ T1,DEVACC##(F) ;LOC OF ACCESS TABLE
JUMPE T1,CPOPJ## ;RETURN IF NONE
PUSHJ P,SAVE4## ;SAVE SOME ACS
TLZN S,IOSWLK ;STR WRITE-LOCKED?
JRST CLSOU1 ;NO
HRRZ U,DEVFUN##(F) ;SET U IN CASE WRITE-LOCKED, NOT LOGGED-IN
JRST CLRSTS ;AND FINISH UP (WITHOUT WRITING ON THE DISK)
CLSOU1: TLNN S,IOSRST ;RESET OF A SPOOLED OUTPUT DEV?
TLNN F,ENTRB ;NO, RENAME ONLY?
JRST NOOUTP ;YES, DON'T FIDDLE WITH BUFFERS
TLO F,OCLOSB ;TURN ON OCLOSB (SPTSTO MIGHT HAVE ZEROED IT)
LDB T2,PIOMOD## ;MODE OF FILE
CAIGE T2,SD ;BUFFERRED MODE?
TLNE F,RESETB ;YES. FROM RESET UUO?
JRST NOOUTP ;YES. DON'T WORRY ABOUT LAST BUFFER
HLRZ T2,DEVBUF(F) ;OUTPUT LAST BUFFER LOC OF HEADER
JUMPE T2,NOOUTP
EXCTUX <SKIPG T3,@T2> ;VIRGIN RING?
JRST NOOUTP ;YES. NOTHING TO OUTPUT
AOS T2 ;NO. POINT TO POINTER WORD
EXCTUX <HRRZ T4,@T2> ;LAST WORD FILLED
SKIPE T4 ;IGNORE IT IF 0
SUBI T4,1(T3) ;-1ST WORD=LENGTH OF LAST BUFFER
TRNN S,IOWC ;USER COMPUTING OWN WORD COUNT?
JRST CLSOU2 ;NO, SKIP ON
HLL T3,T2 ;SET TO RELOCATE BUFFER POINTER
AOS T1,T3 ;GET ADDR OF USER WORD COUNT IN T1,T3
PUSHJ P,UADRCK## ;MAKE SURE LEGAL, NO RETURN IF NOT
EXCTUX <HRRZ T4,@T3> ;GET USER WORD COUNT
CLSOU2: JUMPE T4,NOOUTP ;DON'T OUTPUT IF LENGTH .LE. 0
TLZA S,IOSRIB ;RIB IS NO LONGER IN MON BUF
;(OUTPUT MAY READ RIB BACK)
CLSOU3: IORM T1,DEVADV(F) ;MAKE SURE UUOCON DOESN'T ADVANCE BUFFERS
PUSHJ P,OUT## ;WRITE THE LAST BUFFER
PUSHJ P,PWAIT1## ;WAIT FOR IT
MOVEI T1,DEPOND
TLNE S,IOSTBL ;CLOSE HAVE A PARTIAL BUFFER LEFT?
JRST CLSOU3 ;YES, TRY ONCE MORE TO GET LAST BUFFER OUT
ANDCAM T1,DEVADV(F) ;CAN ADVANCE BUFFERS ONCE AGAIN
TLO F,OUTPB ;REMEMBER AN OUTPUT WAS DONE
MOVSI T1,DEPFFA ;FILOP. UPDATE RIB BIT
MOVEI T2,UP.MLB ;THE MERGE LAST BLOCK BIT
TDNE T1,DEVJOB(F) ;ARE WE INSIDE FOP.UR?
IORM T2,.USBTS ;YES - REMEMBER WE DID OUTPUT
;HERE WHEN THE FILE IS COMPLETELY WRITTEN
NOOUTP: SKIPL DEVSPL(F) ;SPOOLING DDB?
JRST NOOUT0 ;NO, CONTINUE ON
TLNE F,OUTPB ;ANY OUTPUTS DONE?
TRZA M,CLSRST ;YES, NEVER DO RESET
TRO M,CLSRST ;NO, DON'T CREATE NULL FILE
NOOUT0: TRNE M,CLSRST ;CLOSE-RESET?
TLO F,RESETB ;YUP!
PUSHJ P,SETU## ;SET UP U FROM DDB
POPJ P, ;A.T. WAS FIXED IF STR WAS YANKED
TLNN F,OCLOSB ;OUTPUT FILE BEEN CLOSED?
TLNN F,ENTRB ;NO. HAS AN ENTER BEEN DONE?
SKIPA T2,DEVACC##(F) ;NO. JUST GET LOC OF A.T.
PUSHJ P,CLSNAM ;YES. RESET DEVFIL, DEVEXT
;(ELSE ENTER, RENAME WITH NO CLOSE LOSES)
MOVE T2,ACCSTS##(T2) ;STATUS OF FILE
TRNE T2,ACPUPD+ACPPAL## ;UPDATING OR PRE-ALLOCATED?
TLZ F,RESETB ;YES. MAKE SURE FILE ISNT DELETED
MOVE T1,DEVACC##(F) ;IF THIS IS A SIMULTANEOUS UPDATE FILE
MOVE T1,ACCSMU##(T1) ; GET THE FA RESOURCE AS A GUARD AGAINST
TRNE T1,ACPSMU ; RACE CONDITIONS INVOLVING RIBS
PUSHJ P,UPFA## ;GET FA BEFORE READING THE RIB
TLOE S,IOSRIB ;PRIME RIB IN CORE?
JRST NOOUT1 ;YES, NO REASON TO READ
PUSHJ P,RIBCUR## ;NO. READ THE RIB
JUMPE T3,NOOUT1 ;GO IF NO RIB ERROR
PUSHJ P,DWNIFA## ;RETURN FA IF WE HAVE IT (SIM UPDATE)
JRST NOOUT2 ;AND CONTINUE
NOOUT1: PUSHJ P,SPTRW## ;SET AN AOBJN WORD FOR THE RETRIEVAL PNTRS
MOVE P1,T1 ;SAVE POINTER IN P1
PUSHJ P,DD2MN## ;COPY LAST DDB POINTERS TO MON BUF
JFCL ;MAY OVERFLOW FROM LAST 0'S IN DDB
SKIPGE DEVRIB##(F) ;EXTENDED RIB?
PUSHJ P,WRTRIB## ;YES WRITE IT NOW
;PRIME RIB WILL GET WRITTEN LATER
TLZN F,RESETB ;RESET BEING PERFORMED?
JRST CLSOU4 ;NO. CONTINUE
SKIPL DEVRIB##(F) ;IN EXTENDED RIB?
JRST NOUT1A ;NO
PUSHJ P,REDRIB## ;READ PRIME RIB
JRST CLRSTS ;ERROR READING RIB
NOUT1A: PUSHJ P,DECSU ;SET P2 TO DECR
PUSHJ P,ATRMOV## ;GET RID OF A.T.
PUSHJ P,DECUC ;DECREMENT USE-COUNTS
PUSHJ P,DECUSA ;DECREMENT USE-COUNT OF SFD A.T.
PUSHJ P,SFDDEC ;DECREMENT NMB/PPB COUNT OF SFD
SETZM DEVSFD##(F) ;WIPE THE POINTER
HLLZS DEVACC##(F) ;YES. SET DEVACC=0
HLRZ U,DEVUNI##(F) ;SET U TO UNIT OF (1ST) RIB
JRST CLSDL1 ;AND DELETE THE FILE
;HERE ON A RIB ERROR TRYING TO CLOSE THE FILE
;DON'T DESTROY OLD VERSION IF SUPERSEDE, ENTER FILE IN UFD ANYWAY
;IF CREATE (DAMAGE ASSESMENT MAY MAKE SOME SENSE OUT OF IT LATER)
NOOUT2: HRRZ T1,DEVACC##(F) ;LOC OF A.T.
JUMPE T1,CLRSTS ;GO IF UNIT WAS YANKED
HRLZ T2,ACCSTS##(T1) ;STATUS
HLRZ U,DEVUNI##(F) ;MAKE SURE U IS OK (MAY NOT BE IF UFD CFP ERR)
MOVE P3,U ;SET UP P3 FOR SETCFP
TLNE T2,ACPUPD ;UPDATE?
DPB T2,ACZFSN## ;YES, DON'T USE THIS A.T. AGAIN
TLNN F,RESETB ;CLOSE ACTING LIKE RESET?
TLNN T2,ACPCRE ;CREATE?
JRST CLRSTS ;NO, DON'T TOUCH OLD FILE
JRST CLSR11 ;YES, ENTER NAME IN UFD
;HERE WITH THE RIB IN CORE, AND ALL PNTRS IN THE RIB
CLSOU4: MOVE T1,DEVACC##(F) ;IF THIS IS AN UPDATE FILE
MOVE T2,ACCSTS##(T1)
TRNN T2,ACPUPD
JRST CLSSIM
LDB T2,ACYWCT## ;IF SIM-UPD FILE
SOJLE T2,CLSSIM
TLZ M,400000 ;INDICATE NOT A DIRECTORY TO CLSRI5
SKIPL DEVRIB##(F) ;NOT LAST WRITER - IN PRIME RIB?
JRST CLSRI5 ;YES, JUST UPDATE DATES
PUSHJ P,REDRIB## ;READ PRIME RIB
JRST NOOUT2 ;RIB ERR
JRST CLSRI5 ;AND GO UPDATE DATE/TIME
CLSSIM: PUSHJ P,DWNIFA## ;LAST WRITER - GIVE UP FA
MOVE T1,P1 ;AOBJN WORD FOR POINTERS
CLSLUP: HRRZ T4,DEVACC##(F) ;LOC OF ACC
MOVE T3,ACCWRT##(T4) ;HIGHEST WRITTEN BLOCK OF FILE
MOVE T4,.USMBF ;IOWD FOR MONITOR BUFFER
MOVE T2,RIBFLR##+1(T4) ;GET FIRST BLOCK NUMBER IN RIB
SKIPL DEVRIB##(F) ;EXTENDED RIB?
SETZ T2, ;NO, ZERO STARTING BLOCK IN CASE OLD FILE
PUSHJ P,SCNPTR## ;GET THE POINTER FOR THIS BLOCK
JRST CLSOU6 ;NOT IN THIS RIB, LOOK IN NEXT
MOVE P1,T1 ;AOBJN WORD STARTING AT LAST POINTER USED
AOS DEVBLK##(F) ;POINT TO 1ST BLOCK AFTER LAST WRITTEN
AOS DEVREL##(F) ;POINT TO LAST RELATIVE BLOCK DESIRED
AOBJN T1,.+2 ;IF IN LAST POINTER,
AOSA T1,DEVLFT##(F) ; DEVLFT HAS BEEN ADJUSTED
HRRZ T1,DEVLFT##(F) ;NUMBER OF BLOCKS LEFT IN THIS PNTR
SOJN T1,CLSRIB ;GO IF THERE IS A BLOCK IN PNTR FOR LAST RIB
CLSOU5: AOBJP P1,CLSOU8 ;STEP TO NEXT POINTER SLOT
SKIPE T2,(P1) ;IS THERE ONE?
JRST CLSO12 ;YES. USE IT
SUB P1,[XWD 1,1] ;NO. BACK UP P1 TO LAST PNTR
;HERE WHEN WE HAVE TO ALLOCATE 1 MORE CLUSTER TO WRITE THE LAST RIB OF THE FILE
HRRM P1,DEVRET##(F) ;SET DEVRET TO POINT TO LAST PNTR
MOVEI T2,1 ;WE WANT TO ALLOCATE 1 BLOCK
PUSHJ P,CHKADD## ;CAN WE ADD TO CURRENT POINTER?
JUMPE T2,CLSOU9 ;IF T2=0 CANT ADD
MOVE T1,DEVBLK##(F) ;1ST BLOCK AFTER HIGHEST WRITTEN BLOCK
PUSHJ P,TAKBLK## ;TRY TO GET 1 CLUSTER STARTING THERE
JRST CLSOU9 ;CANT GET IT THERE - TRY ANYWHERE
PUSHJ P,ADDPTR## ;GOT IT. ADD TO CURRENT POINTER
JRST CLSRIB ;AND CONTINUE
;HERE TO LOOK FOR THE LAST WRITTEN BLOCK IN THE NEXT RIB
CLSOU6: SKIPLE DEVRIB##(F) ;PRIME RIB IN CORE?
PUSHJ P,WRTRIB## ;YES, WRITE IT (MIGHT HAVE CHANGED)
PUSHJ P,PTRNXT## ;GET THE NEXT RIB INTO CORE
JRST CLSOU7 ;EITHER ERROR OR NONE
PUSHJ P,SPTRW## ;PUT AOBJN WORD TO POINTERS IN T1
JRST CLSLUP ;GO SCAN THIS RIB
CLSOU7: JUMPN T3,NOOUT2 ;IF T3 NON-ZERO, ERROR
STOPCD NOOUT2,DEBUG,NER, ;++NO EXTENDED RIB
;HERE WHEN POINTERS RAN OUT, WE KNOW THERE IS ONE MORE BLOCK IN THE LAST POINTER
CLSOU8: SUB P1,[XWD 1,1] ;BACK UP TO LAST POINTER
AOJA T1,CLSRIB ;FORCE DEVLFT TO BE 1
;HERE WHEN WE HAVE TO CREATE A NEW POINTER TO ALLOCATE THE LAST BLOCK
CLSOU9: AOBJP P1,CLSFUL ;STEP TO NEXT POINTER SLOT
HRRM U,DEVUNI##(F)
CLSO10: PUSHJ P,SUPDA##
HRRM P1,DEVRET##(F) ;SAVE LOC OF NEW POINTER (IN MON BUF)
SKIPLE UNITAL(U) ;UNIT HAVE ANY SPACE LEFT?
JRST CLSO11 ;YES
PUSHJ P,DWNDA##
PUSHJ P,NEXTUN## ;NO. STEP TO NEXT UNIT
JRST CLSFUL ;NO UNIT IN STR HAS SPACE!
AOBJN P1,CLSO10 ;FOUND. STEP TO NEXT PNTR LOC IF ROOM IN RIB
SETZM @DEVRET##(F) ;NO ROOM IN RIB - ZERO UNIT-CHANGE
HRRZ U,DEVUNI##(F) ;RESET U TO LAST UNIT IN RIB
;AND FALL INTO CLSFUL
;HERE WHEN THERE IS NO SPACE IN STR, OR ALL POINTER SLOTS ARE TAKEN
CLSFUL: TRO S,IOBKTL ;LIGHT ERROR BIT
HRRZ T2,DEVACC##(F) ;LOC OF ACC
SOSGE ACCWRT##(T2) ;DECREASE AMOUNT WRITTEN BY 1
JRST CLSFL2 ;NOTHING WRITTEN
SOS DEVREL##(F) ;POINT TO LAST RELATIVE BLOCK DESIRED
SOS DEVBLK##(F) ;POINT TO LAST DATA BLOCK
HRRI M,CLSDLL ;INDICATE DON'T DELETE ANYTHING ON CLOSE
HRRZ U,DEVUNI##(F) ;SET U TO UNIT WITH LAST DATA
MOVEI T1,BLKSIZ## ;REINITIALIZE COUNT
DPB T1,ACYLBS##
JRST CLSRI1 ;GO WRITE LAST RIB OVER LAST DATA BLOCK
;HERE WHEN NO ROOM IN STR, AND ACCWRT = 0
;DELETE THE FILE (WHICH IS JUST THE 1ST RIB)
CLSFL2: SUB P1,[XWD 1,1] ;SET P1 = AOBJN WORD
PUSHJ P,DELRIB ;GIVE BACK THE BLOCK
STOPCD .+1,DEBUG,DER, ;++DELRIB ERROR RETURN
PJRST CLRSTS ;FINISH UP (DON'T WRITE UFD)
;HERE WHEN A UNIT HAS BEEN FOUND WITH SPACE ON IT
CLSO11: MOVEI T2,1 ;WE WANT 1 BLOCK
SETZ T1, ;ANYWHERE ON THE UNIT
PUSHJ P,TAKBLK## ;GET A CLUSTER
STOPCD .,STOP,UFI, ;++UNIT FREE-COUNT INCONSISTENT
MOVEM T2,(P1) ;SAVE THE PNTR IN THE MON BUF
HRRZ T1,DEVACC##(F) ;LOC OF A.T.
MOVEI T3,ACP1PT## ;TURN OFF 1PT BIT IN A.T.
ANDCAM T3,ACC1PT##(T1)
CLSO12: PUSHJ P,CNVPTR## ;CONVERT POINTER TO COUNT, ADDRESS
JRST NOOUT2 ;BAD UNIT-CHANGE PNTR
JRST CLSOU5 ;UNIT CHANGE - TRY NEXT POINTER
;HERE WITH DEVBLK,DEVREL,DEVLFT SET TO REDUNDANT LAST RIB BLOCK
CLSRIB: HRRM T1,DEVLFT##(F) ;SAVE COUNT OF BLOCKS LEFT IN PNTR
CLSRI1: MOVE T1,DEVRIB##(F) ;GET DEVRIB INTO T1 IN CASE NOT GO TO UPDGIV
TRNE M,CLSDLL ;DELETE UNWRITTEN BLOCKS FROM FILE?
JRST CLSRI2 ;NO
PUSH P,DEVRIB##(F) ;SAVE POINTER TO CURRENT RIB
MOVE P2,DEVBLK##(F) ;YES. SAVE BLOCK OF RIB
MOVE P3,DEVREL##(F) ;SAVE DEVREL IN CASE UPDGIV CHANGES IT
PUSHJ P,UPDGIV ;GIVE UP THE UNWRITTEN BLOCKS OF THE FILE
STOPCD .+1,DEBUG,SBT, ;++SHOULDN'T BE TRUNCATING
MOVEM P3,DEVREL##(F) ;RESTORE TO DDB
MOVEM P2,DEVBLK##(F) ;RESTORE BLOCK NO. OF LAST RIB
POP P,T1 ;RESTORE PREVIOUS CURRENT RIB TO T1
CLSRI2: SKIPL DEVRIB##(F) ;SKIP IF NOT IN PRIME RIB
JRST CLSRI4 ;PRIME RIB, GO WRITE REDUNDANT
CAME T1,DEVRIB##(F) ;ARE WE STILL IN THE SAME EXTENDED RIB?
JRST CLSRI3 ;NO, GET PRIME
PUSHJ P,WRTRIB## ;WRITE OUT THE CURRENT RIB
CLSRI3: PUSHJ P,REDRIB## ;GET THE PRIME RIB INTO CORE
JRST NOOUT2 ;ERROR READING RIB
CLSRI4: TLZ M,400000
HLRZ T1,DEVEXT(F) ;EXTENSION OF FILE
CAIN T1,(SIXBIT .SFD.) ;AN SFD?
TLOA M,400000 ;YES, LIGHT SIGN BIT, DON'T CHANGE UFB
CAIE T1,(SIXBIT .UFD.) ;A UFD?
JRST CLSRI5 ;NO
TLO M,400000 ;INDICATE FILE IS A DIRECTORY
PUSHJ P,FNDUFB ;YES. FIND UFB FOR FILE
JRST CLSRI5 ;NOT THERE - CONTINUE
PUSHJ P,SPTRW## ;%FOUND - SET AOBJN WORD FOR PNTRS
MOVE T3,(T1) ;%UNIT OF UFD
DPB T3,COYUN1## ;%SAVE UNIT IN UFB
MOVE T1,1(T1) ;%FIRST REAL POINTER
MOVEM T1,UFBPT1##(T2) ;%SAVE IN UFB
PUSHJ P,GVCBJ## ;%RETURN CB RESOURCE
CLSRI5: MOVE T1,.USMBF ;IOWD FOR MON BUF
HRRZ P1,DEVACC##(F) ;LOC OF A.T.
JUMPE P1,CLRSTS ;GO IF UNIT YANKED
SKIPE T4,ACCWRT##(P1) ;NO. OF BLOCKS WRITTEN
SUBI T4,1 ;-1
LSH T4,BLKLSH## ;*128
MOVE T3,P1
LDB P2,ACZLBS## ;SIZE OF LAST BLOCK
JUMPGE M,CLSRI6 ;IF THE FILE IS A DIRECTORY
SKIPE ACCWRT##(P1) ; WHICH IS NOT EMPTY,
MOVEI P2,BLKSIZ## ; MAKE SURE THE LAST BLOCK IS "FULL"
DPB P2,ACZLBS## ;SAVE NEW SIZE IN ACC
CLSRI6: ADD T4,P2 ;TOTAL NUMBER OF WORDS IN FILE
MOVEM T4,RIBSIZ##+1(T1) ;SAVE IN RIB
MOVEI T2,RIPPAL##
MOVE T3,DEVPAL##(F) ;PRE-ALLOCATING?
TRZE T3,DEPPAL##
TLNE F,OUTPB ;YES, OUTPUT DONE?
JRST CLSRI7 ;NOT PRE-ALLOCATING OR WRITTEN
IORM T2,RIBSTS##+1(T1) ;PRE-ALLOCATED, LIGHT BIT
JRST CLSRI8
CLSRI7: MOVEM T3,DEVPAL##(F) ;ENSURE DEPPAL=0
ANDCAM T2,RIBSTS##+1(T1) ; AND THE BIT IS OFF
CLSRI8: MOVE T2,ACCSTS##(P1) ;STATUS OF FILE
TLNN F,RENMB ;FILE BEING RENAMED?
TRNE T2,ACPUPD ;UPDATE?
TLNN F,OUTPB+INPB ;YES, ANY OUTPUTS OR INPUTS DONE?
JRST CLSRI9 ;NO
MOVE T3,TIME## ;YES, ACCESS DATE
IDIV T3,TICMIN## ;T3=TIME RIGHT ADJUSTED
HRRZ T4,THSDAT## ;DATE
DPB T4,[POINT 15,ACCADT##(P1),17] ;SAVE NEW ACCESS DATE
DPB T4,[POINT 15,RIBEXT##+1(T1),35] ; IN RIB AND A.T.
TLNN F,OUTPB ;OUTPUTS DONE?
JRST CLSR10 ;NO, DON'T UPDATE CREATION DATE
LDB T2,[POINT 3,T4,23] ;HI PART OF CREATION DATE
DPB T3,[POINT 11,T4,23];POSITION TIME IN WORD
MOVSI T3,777740 ;SET TO MASK OUT TIME,DATE
AND T3,RIBPRV##+1(T1) ;GET MODE, PROTECTION
ORM T3,T4 ;PLUS NEW DATE, TIME
MOVEM T4,RIBPRV##+1(T1) ;SAVE NEW DATE, TIME WORD IN RIB
MOVEM T4,ACCPRV##(P1) ; AND IN ACC
DPB T2,[POINT 3,RIBEXT##+1(T1),20] ;SAVE HI CRE-DATE IN RIB
DPB T2,[POINT 3,ACCADT##(P1),2] ; AND IN A.T.
MOVE T3,DATE## ;MOVE NEW DATE TIME IN
HRRZ T4,RIBFIR##+1(T1) ;NO OF VALUES IN RIB
CAIL T4,RIBTIM##+1 ;DON'T WIPE OUT 1ST PNTR IF OLD FILE
MOVEM T3,RIBTIM##+1(T1)
CLSRI9: LDB T2,UNYKNM## ;KONTROL NUMBER
LSH T2,17
IOR T2,.C0ASN## ;APR NUMBER
HRRZ T3,RIBUNI##+1(T1)
CAIE T3,(T2) ;SAME AS BEFORE?
SETZM RIBUNI##+1(T1) ;NO, NO UNITS YET WROTE
HRRM T2,RIBUNI##+1(T1)
HLRZ U,DEVUNI##(F) ;UNIT WITH RIB
PUSHJ P,ORINUN ;LIGHT BIT
HRRZ U,DEVUNI##(F) ;CURRENT UNIT
PUSHJ P,ORINUN ;LIGHT BIT
CLSR10: MOVE T3,ACCALC##(P1) ;AMOUNT OF SPACE ALLOCATED
MOVEM T3,RIBALC##+1(T1) ;SAVE IN RIB
PUSHJ P,SPTRW## ;GET AOBJN WORD FOR POINTERS
MOVE T2,1(T1) ;GET FIRST POINTER IN PRIME RIB
MOVEM T2,ACCPT1##(P1) ;MOVE TO ACC
PUSHJ P,TSTBAD ;SET RIBELB, ETC IF ERROR
HLRZ P3,DEVUNI##(F) ;SAVE FIRST UNIT IN P3 FOR LATER CALL TO SETCFP
ALLPT1: TRNE S,IOSFA ;IF HAVE FA, MUST BE SIM UPDATE
JRST ALLPT5 ;SO JUST REWRITE PRIME RIB (WITH NEW DATES)
MOVE T2,RIBFLR##+1(T1) ;GET FIRST BLOCK NUMBER IN RIB
SKIPL DEVRIB##(F) ;SKIP IF EXTENDED RIB
SETZ T2, ;NOT EXTENDED, FIRST BLOCK =0
SKIPN T3,DEVREL##(F) ;DEVREL=0 MEANS INACTIVE RIB
JRST ALLPT2 ;GO WRITE REDUNDANT RIB NEXT TO REAL
PUSHJ P,SCNPT0## ;SCAN THE RIB FOR THE BLOCK IN T3
JRST ALLPT3 ;NOT FOUND, MUST BE A FULL RIB
SETZM DEVREL##(F) ;FLAG THAT NEXT RIB(IF ANY) IS INACTIVE
JRST ALLPT4 ;GO WRITE REDUNDANT
;HERE WHEN WORKING IN AN INACTIVE RIB (BLOCKS ALLOCATED BUT NOT USED)
ALLPT2: MOVE T3,T2 ;GET NUMBER OF FIRST BLOCK IN RIB TO T3
AOJ T3, ;POINT TO NEXT BLOCK
PUSHJ P,SCNPT0## ;SCAN THE RIB FOR THIS BLOCK
STOPCD .,JOB,BMR, ;++BLOCK MISSING FROM RIB
SETZM DEVREL##(F) ;RESET THE INACTIVE RIB FLAG TO 0
JRST ALLPT4 ;GO WRITE THE RIB
;STILL IN FTDMRB CONDITONAL
;HERE TO WRITE THE REDUNDANT RIB IN THE LAST BLOCK OF THE RIB
ALLPT3: PUSH P,DEVREL##(F) ;SAVE FLAG FOR INACTIVE RIBS
PUSHJ P,GTLPT ;GET LAST RIB POINTER
PUSHJ P,CNVPTR## ;DECODE THE POINTER
JFCL ;BAD UNIT-CHANGE
STOPCD .,JOB,LPU, ;++LAST POINTER UNIT-CHANGE
SOS T2,T1 ;LENGTH OF POINTER -1 TO T2
ADDM T2,DEVBLK##(F) ;BLOCK NUMBER FOR WRITE TO DDB
POP P,DEVREL##(F) ;RESTORE BLOCK FOR LAST ACTIVE REDUNDANT WRITE
;HERE TO WRITE RIB IN CORE REDUNDANTLY IN BLOCK NUMBER CONTAINED IN DEVBLK
ALLPT4: MOVE T1,.USMBF ;GET IOWD FOR MONITOR BUFFER
MOVE T2,DEVBLK##(F) ;GET BLOCK NUMBER FOR REDUNDANT WRITE
MOVEM T2,RIBSLF##+1(T1) ;PUT IN RIB
MOVEI T3,CODRIB## ;777777 TO RH(T3)
MOVEM T3,RIBCOD##+1(T1) ;MAKE SURE CODE IS IN RIB
TLNE F,RENMB ;DOING A RENAME?
PUSHJ P,NAMNW ;YES, PUT NEW NAME,EXT AND PPN IN RIB
PUSHJ P,MONWRU## ;WRITE REDUNDANT RIB (KEEP OUT OF DISK CACHE)
ALLPT5: PUSHJ P,WRTRIB## ;WRITE REAL RIB
JUMPE T3,ALLPT6 ;GO IF WRITTEN OK
MOVE T1,DEVACC##(F)
HRLZ T2,ACCSTS##(T1) ;IF AN UPDATE FILE
TLNE T2,ACPUPD
DPB T2,ACZFSN## ;MAKE SURE A.T. ISN'T FOUND LATER
ALLPT6: PUSHJ P,RIBSAT ;WRITE SATS WHICH HAVE CHANGED
MOVE T1,.USMBF ;IOWD TO MONITOR BUFFER
PUSH P,RIBXRA##+1(T1) ;GET POINTER TO NEXT RIB (IF ANY)
SKIPGE DEVRIB##(F) ;PRIME RIB?
JRST ALLPT7 ;NO, DON'T DO ANYTHING ABOUT BAT BLOCKS
SKIPE RIBFLR##+1(T1) ;SKIP IF EXTENDABLE RIB
SETZM (P) ;NOT EXTENDABLE, RIBFLR IS GARBAGE
PUSH P,U
PUSHJ P,ERRFIN ;YES, WRITE BAT BLOCK IF ERRORS
POP P,U
ALLPT7: POP P,DEVRIB##(F) ;GET POINTER FROM PREVIOUS RIB
SKIPN DEVRIB##(F) ;ANY MORE RIBS?
JRST ALLPT8 ;NO, THROUGH
PUSHJ P,RIBCUR## ;READ THE NEXT RIB
JUMPN T3,NOOUT2 ;IF T3 NON-ZREO, RIB ERROR
JRST ALLPT1 ;TAKE CARE OF THE EXTENDED RIB
;HERE WHEN WE ARE FINISHED CLEANING UP SATS AND RIBS
ALLPT8: TRNN S,IOSFA ;SIM UPDATE?
JRST CLSR11 ;NO, CHANGE DIRECTORY
PUSHJ P,DWNFA## ;YES, GIVE UP FA SINCE RIB NOW WRITTEN
JRST CLRSTS ;AND FINISH THE CLOSE
;ROUTINE TO STORE THE CFP
;T1 PASSES THE CFP
;T2 PASSES ADDR OF NMB
SAVCFP: HRRM T1,NMBCFP##(T2) ;SAVE THE CFP
HRRZ T1,DEVACC##(F) ;SAVE FSN CFP IS FOR
LDB T1,ACZFSN##
DPB T1,NMYFSN##
MOVE T3,T2 ;ADDR OF NMB
PUSHJ P,FSNPS2## ;POSITION A BIT
ORM T2,NMBYES##(T3) ;FILE EXISTS ON THIS STR
POPJ P,
;NOW CHANGE THE DIRECTORY
CLSR11: PUSHJ P,UPAU## ;GET AU RESOURCE
HRRZ P1,DEVACC##(F) ;LOC OF ACC
MOVE T1,ACCSTS##(P1) ;STATUS OF FILE
TRNE T1,ACPCRE ;CREATING?
JRST NOTOLD ;YES
HRRZ T3,ACCPPB##(P1) ;NO. LOC OF PPB
MOVE T4,PPBNAM##(T3) ;NEW PRJ,PRG NUMBER
CAME T4,DEVPPN(F) ;SAME AS OLD?
JRST NOTOL1 ;NO. CREATE FILE IN NEW DIR.
TLNN F,RENMB ;IF A RENAME WAS DONE,
JRST CLSR12
MOVE T3,DEVSFD##(F) ;DEFAULT SFD
HLRZ T4,T3 ;ORIGINAL SFD
CAIE T4,(T3) ;SAME AS "NEW" SFD?
JRST NOTOL1 ;NO, CREATE THE NAME IN NEW SFD
HLRZ T4,DEVEXT(F) ;RENAMED A UFD
CAIE T4,'UFD' ;NO NEED TO RE-WRITE MFD
CLSR12: TRNE T1,ACPNIU+ACPUPD ;YES, FILE BEEN REMOVED FROM DIRECTORY OR JUST UPDATE?
JRST CLRST2 ;YES, DON'T HAVE TO CHANGE DIRECTORY
TRNN T1,ACPREN ;IF FILE NOT BEING RENAMED,
TRNN T1,ACPPAL## ;IF PRE-ALLOCATED
CAIA
JRST CLRST2 ; LEAVE THE UFD ALONE
PUSHJ P,UFDSRC## ;NO. FIND FILE NAME IN DIRECTORY
JRST NOTOLD ;CANT FIND IT - CREATE NEW NAME
EXCH P1,T1 ;P1 HAS CFP, T1 HAS LOC OF ACC
PUSHJ P,GTNM1 ;FIND NMB
;HERE WITH T1=LOC OF NMB FOR THE FILE
MOVE T2,NMBNAM##(T1) ;(NEW) FILE NAME
MOVEM T2,UFDNAM##(T3) ;SAVE IN DIRECTORY
HRLZ T4,NMBEXT##(T1) ;(NEW) EXTENSION
HLLM T4,UFDEXT##(T3) ;SAVE IN DIRECTORY
HRLM T3,P1 ;SAVE LOC OF DIRECTORY SLOT
PUSH P,T1 ;SAVE LOC OF NMB
PUSHJ P,SETCFP## ;COMPUTE CFP FROM A.T. AND U
HLRZ T3,P1 ;LOC OF DIRECTORY SLOT
HRRM T1,UFDCFP##(T3) ;SAVE CFP IN UF
MOVE T2,(P) ;LOC OF NMB
HRRZ T3,DEVACC##(F) ;SAVE ACPSUP
HRL P1,ACCSTS##(T3)
PUSHJ P,NEWCFP ;SAVE CFP IN NMB
JFCL
PUSHJ P,WRTDIR ;GO WRITE THE UPDATED DIRECTORY BLOCK
;PUSHJ P,DWNAU## ;DON'T GIVE UP AU UNTIL WE'RE
; DONE WITH DELRIB. ELSE SOMEBODY
; ELSE CAN SNEAK IN A DELETE WHILE
; WE'RE BLOCKED IN RIBCUR
TLNE P1,ACPSUP ;SUPERSEDER?
JRST ALLPT9 ;YES. REMOVE OLD FILE
POP P,T1 ;NO. REMOVE JUNK FROM PD LIST
JRST CLRSTS ;AND FINISH UP
ALLPT9: HRRZ T1,P1 ;CFP FOR THE OLD FILE
HRRZ T2,DEVACC##(F) ;LOC OF A.T.
ALLP10: CBDBUG (N,Y);
LDB P1,ACYFSN## ;STR NUMBER
PUSHJ P,CFP2BK## ;CONVERT TO BLOCK ADR
JRST ALLP11 ;CFP BAD - LEAVE OLD FILE ALONE
SETZM DEVRIB##(F) ;ZERO OUT DEVRIB FOR DPB'S
LDB T3,UNYLUN## ;GET LUGICAL UNIT NUMBER FOR UFD RIB
DPB T3,DEYRBU## ;DEPOSIT IN RIB POINTER
LDB T3,UNYBPC## ;GET NUMBER OF BLOCKS PER CLUSTER
IDIV T2,T3 ;CONVERT BLOCK NUMBER TO CLUSTER NUMBER
DPB T2,DEYRBA## ;TO DDB
PUSHJ P,RIBCUR## ;GET THE RIB POINTER AT BY DEVRIB INTO CORE
JUMPN T3,ALLP11 ;JUMP IF RIB ERROR, LEAVE OLD FILE ALONE
PUSHJ P,SPTRW## ;SET AN AOBJN WORD FOR PNTRS
EXCH P1,T1 ;P1=AOBJN WORD, T1=FSN
PUSHJ P,GETCB## ;GET CB RESOURCE
POP P,T2 ;%LOC OF NMB
TRO T2,DIFNAL## ;%ADJUST FOR ACCNMB
DELTST: PUSHJ P,BYTSC1## ;%SEARCH FOR AN A.T.
SKIPA T3,ACCSTS##(T2) ;%FOUND ONE. GET STATUS
JRST CLSDL3 ;%NO A.T. TO DELETE
TRNE T3,ACPCRE+ACPUPD+ACPSUP+ACPREN ;%FILE JUST READING?
JRST DELTST ;%NO. IGNORE IT
MOVE T4,DEVACC##(F) ;%IF A LOOKUP GOT THROUGH FNDFIL
MOVE T4,ACCPT1##(T4) ;% AND READ THE NEW RIB AFTER
CAME T4,ACCPT1##(T2) ;% OUR CALL TO WRTUFD HE IS READING
JRST DELTS1 ;% THE NEW FILE, WHICH WE SHOULDN'T DELETE
HRRZ T2,DEVACC##(F) ;%DELETE OUR A.T. AND THE OLD FILE
JRST CLSDEL ;% LEAVING THE OTHER A.T. ALONE
;HERE WITH T2=LOC OF AN A.T. WHICH MUST BE DELETED
DELTS1: LDB T4,ACZCNT## ;%FILE DORMANT?
JUMPE T4,CLSDEL ;%YES, DELETE A.T., FILE
TRNN T3,ACPDEL## ;%ALREADY MARKED FOR DELETION ?
JRST DELTS2 ;%NO, MARK IT
MOVE T3,1(P1) ;% IF THE A.T. WE FOUND
CAME T3,ACCPT1##(T2) ;% IS NOT FOR THIS FILE
JRST DELTST ;% THEN THE FILE CAN BE DELETED NOW
DELTS2: MOVEI T1,ACPDEL##+ACPNIU ;MARK FILE TO BE DELETED ON CLOSE
ORM T1,ACCDEL##(T2) ;SO FILE WILL DISAPPEAR WHEN READ COUNT EXHAUSTED
PUSHJ P,GVCBJ## ;%RELEASE CB RESOURCE
JRST CLRSTS ;AND FINISH UP
;HERE WHEN THERE IS NO A.T. TO REMOVE
CLSDL3: PUSHJ P,GVCBJ1## ;%GIVE UP CB AND SKIP
;HERE WITH T2=LOC OF A.T. WHEN THERE IS AN A.T. TO REMOVE
CLSDEL: PUSHJ P,ATRMVX## ;REMOVE THE A.T. FROM SYSTEM
;HERE TO DELETE A FILE, WITH RIB IN MON BUF
CLSDL1: MOVEI P4,DEPALC##
IORM P4,DEVALC##(F) ;ACCALC SHOULD NOT BE CHANGED
HRRZ T1,DEVACC##(F) ;CLEAR SUPERSEDING BIT, SO
JUMPE T1,CLSDL2
MOVEI T2,ACPSUP ; SNUKIN CODE WILL WORK IF WE
ANDCAM T2,ACCSTS##(T1) ; GET RESCHEDULED AND A LOOKUP IS IN PROGRESS
MOVEI T2,ACPCNT## ;IF WE GET RESCHEDULED AND A LOOKUP/CLOSE HAPPENS
ADDM T2,ACCCNT##(T1) ; THE A.T. WILL BECOME DORMANT, SO BUMP READ-COUNT
CLSDL2: PUSHJ P,DELRIB ;DELETE THE FILE
STOPCD .+1,DEBUG,DCR, ;++DELRIB CPOPJ RETURN
ANDCAM P4,DEVALC##(F) ;CHANGE ACCALC AGAIN
MOVNI P4,ACPCNT## ;DECR READ-COUNT WHEN
JRST CLRSTX ; WE ARE THROUGH (CLRST0)
ALLP11: POP P,T1 ;ERR READING RIB - REMOVE JUNK FROM PD LIST
JRST CLRSTS ;AND FINISH UP
;HERE TO CREATE A NEW NAME IN A DIRECTORY BLOCK
NOTOLD: TRZA M,-1 ;NO OLD DIR
NOTOL1: HRRI M,CHNDIR ;INDICATE DELETE NAME FOM OLD DIR
HRRZ T1,DEVACC##(F) ;IF ACPNIU IS LIT, WE MUST BE DOING
MOVE T1,ACCSTS##(T1) ; A RENAME ACCROSS DIRS AND SOMEBODY
TRNE T1,ACPNIU ; SNUCK IN WITH A LOOKUP AND RENAME TO 0.
JRST FNDFRY ; SO DON'T PUT IT IN THE DIR
PUSHJ P,DIRSET## ;GET RETRIEVAL PNTRS TO READ THE DIR
TROA S,IOIMPM ;NOT THERE - LIGHT AN ERROR BIT
JRST NOTOL3 ;THERE IS A REAL PNTR
PUSHJ P,DWNAU## ;GIVE UP AU RESOURCE
PUSHJ P,SPTRW## ;SET AN AOBJN WORD FOR WHOLE RIB PNTRS
EXCH P1,T1 ;P1=AOBJN WORD, T1=LOC OF A.T.
MOVE T2,T1 ;A.T. LOC INTO T2
PUSHJ P,GETCB## ;GET CB RESOURCE
JRST CLSDEL ;%DELETE THE FILE WHICH WAS JUST WRITTEN
NOTOL3: PUSHJ P,SETFS0## ;SET UP TO READ DIRECTORY
JRST BADUFD ;ERROR READING DIRECTORY - CANT ENTER NAME
PUSHJ P,UFORSS## ;GET UFB OR SFD A.T. LOC
TRZE T3,NMPSFU## ;AN SFD?
SKIPA P2,ACCWRT##(T3) ;YES, GET SIZE FROM ACCWRT
LDB P2,UFYWRT## ;NO OF DATA BLOCKS IN DIRECTORY
;IN THE FOLLOWING CODE, P4 IS A FLAG THAT TELLS YOU WHETHER OR NOT TO COMPRESS:
;P4=NEGATIVE, NEVER COMPRESS
;P4=ZERO, SOMETIMES COMPRESS (ONLY COMPRESS IF YOU REALLY HAVE TO)
;P4=POSITIVE, ALWAYS COMPRESS
HLRZ P4,UFBZRB##(T3) ;"ALWAYS" COMPRESS IF BLOCK OF ZEROES
ANDI P4,UFPZRB##
CAIGE P2,2 ;NEVER COMPRESS UNLESS AT LEAST TWO BLOCKS
SETO P4,
JUMPE P2,UFDNXT ;DON'T TRY TO READ ZERO LENGTH DIR
JUMPLE P4,NOTO3B ;ONLY CALL CMPOK IF GOING TO COMPRESS
PUSHJ P,CMPOK ;OK TO COMPRESS?
TLOA P4,-1 ;NO
JRST UFDNXT ;YES, DO IT NOW
NOTO3B: MOVE T2,DEVDMP##(F) ;ADR OF RIB
ADD T2,P2 ;(PROBABLE) DIRECTORY BLOCK
HRRZ T4,DEVLFT##(F) ;NO OF BLOCKS IN FIRST POINTER
CAIG P2,(T4) ;IS BLOCK TO WRITE IN 1ST PNTR?
JRST NOTOL6 ;YES
PUSHJ P,UFDCRD ;NO, READ DIRECTORY RIB
JRST BADUFD ;ERROR READING RIB
SETZ T2, ;START AT 1ST PNTR
MOVE T3,P2 ;BLOCK WE'RE LOOKING FOR
PUSHJ P,SCNPT0## ;GO FIND PNTR TO BLOCK
STOPCD .,JOB,BNR, ;++BLOCK NOT RIB
MOVEM T2,DEVFLR##(F) ;SAVE LOWEST BLOCK IN DDB
PUSHJ P,PTRBLT## ;COPY PNTRS INTO DDB
MOVE T2,DEVBLK##(F) ;DIRECTORY BLOCK TO WRITE
JRST NOTOL6 ;GO MAKE SURE IT'S NOT FULL
;STILL IN FTDUFC CONDITIONAL
;HERE AFTER COMPRESSING THE DIRECTORY
NOTOL5: POP P,T1 ;REMOVE JUNK FROM PD LIST
MOVE P2,DEVREL##(F) ;RESET LENGTH OF DIRECTORY
;HERE WITH T2= BLOCK FOR DIRECTORY
NOTOL6: MOVEM T2,DEVBLK##(F) ;SAVE DATA BLOCK NO.
MOVE T1,.USMBF ;IOWD FOR DATA
PUSHJ P,MONRED## ;READ THE DIRECTORY BLOCK
JUMPN T3,UFDNXT ;LEAVE DATA BLOCK ALONE IF ERROR READING
SKIPN BLKSIZ##-1(T1) ;IS IT FULL?
AOJA T1,FNDFRE ;NO - GO FIND FIRST EMPTY SLOT
;HERE TO INITIALIZE THE NEXT BLOCK FOR THE DIRECTORY
UFDNXT: JSP T4,SAVUN## ;PUSH U, SET DEVUNI TO RIB UNIT
PUSHJ P,UFDCRD ;READ THE UFD RIB
JRST BADUF0 ;ERROR READING RIB - CANT ENTER FILE
;HERE WITH THE UFD RIB IN THE MONITOR BUFFER
PUSHJ P,UFORSS## ;GET LOC OF UFB OR SFD AT
EXCH P2,T2 ;LOC INTO P2, T2 HAS HIGHEST DATA BLOCK
SETZ P1, ;ASSUME ONLY 1 POINTER
JUMPG P4,UFDNX3 ;COMPRESS IF A WHOLE BLOCK OF ZEROES
HRRZ T1,.USMBF ;LOC OF MON BUF (-1)
ADDI T2,2 ;ACCOUNT FOR 2 RIB BLOCKS
CAMGE T2,RIBALC##+1(T1) ;HAVE WE WRITTEN IN ALL ALLOCATED BLOCKS?
JRST UFDNX2 ;NO. ZERO OUT NEXT BLOCK AND WRITE IN IT
;HERE IF "SOMETIMES" OR "NEVER"
JUMPL P4,UFDNX4 ;GO IF "NEVER" COMPRESS
MOVE T2,P2 ;HAVEN'T CALLED CMPOK YET
PUSHJ P,CMPOK ;OK TO COMPRESS?
JRST UFDNX4 ;NO
UFDNX3: PUSHJ P,UFDCMP ;YES. SQUEEZE ZEROS OUT OF UFD
JRST NOTOL5 ;DELETED SOME UFD SLOTS - TRY AGAIN
;HERE WHEN ONE MORE CLUSTER MUST BE ALLOCATED TO THE UFD
JSP T4,RIBUN## ;GET RIB UNIT BACK
PUSHJ P,UFDCRD ;READ THE RIB AGAIN
JRST BADUF0 ;ERROR
UFDNX4: HRRZ T1,.USMBF ;GET HIGHEST BLOCK WRITTEN
MOVE T3,RIBALC##+1(T1)
SUBI T3,2 ;ACCOUNT FOR BOTH RIBS
SETZ T2, ;RIB STARTS AT BLOCK ZERO
PUSHJ P,SCNPT0## ;FIND HIGHEST BLOCK WRITTEN
STOPCD .,JOB,NLB ;++NO LAST BLOCK
MOVE P1,T1 ;SAVE AOBJN PNTR TO LAST RTP
HRRM T1,DEVRET##(F) ;SAVE LOC OF LAST POINTER IN DEVRET
MOVEI T2,DEPALC##
IORM T2,DEVALC##(F) ;DON'T CHANGE ACCALC
MOVEI T2,1 ;WANT 1 MORE BLOCK
PUSHJ P,CHKADD## ;CAN WE ADD TO CURRENT PNTR?
JUMPE T2,UFDAL2 ;NOT IF T2=0
MOVE T1,DEVBLK##(F) ;YES. BLOCK WE WANT
ADDI T1,2 ;1 PAST FORMER END (ALLOW FOR 2ND RIB)
PUSHJ P,TAKBLK## ;TRY TO GET 1 MORE CLUSTER
JRST UFDAL2 ;CANT ADD TO END
PUSHJ P,ADDPTR## ;GOT IT. UPDATE POINTER
MOVE T2,P2 ;UFB LOC
TRZ T2,NMPSFU## ;T2 = L(A.T.) IF AN SFD
PUSHJ P,SPTRW## ;SET AOBJN WORD FOR POINTERS
MOVE T3,1(T1) ;GET 1ST REAL POINTER (MAY HAVE UPDATED IT)
MOVEM T3,CORPT1##(T2) ;SAVE IN UFB BLOCK
SETZ P1, ;INDICATE STILL ONLY 1 PNTR
MOVE T1,DEVPPN(F) ;PRJ,PRG
TRNN P2,NMPSFU## ;IS IT A UFD
CAME T1,MFDPPN## ;YES, IS IT [1,1]?
JRST UFDAL9 ;NO
LDB T1,UFYFSN## ;YES, GET STR INDEX
MOVE T1,TABSTR##(T1) ;STR DB LOC
MOVEM T3,STRPT1##(T1) ;UPDATE VERSION IN SDB
JRST UFDAL9 ;AND CONTINUE
;HERE WHEN WE HAVE TO GET A NEW POINTER FOR THE EXTRA BLOCK IN THE UFD
UFDAL2: AOBJP P1,UFDFUL ;POINT TO FIRST FREE SLOT
UFDAL3: MOVEI T2,1 ;WANT 1 BLOCK
SETZ T1, ;ANYWHERE ON THE UNIT
PUSHJ P,TAKBLK## ;TRY FOR A BLOCK
SKIPA ;CANT GET 1 ON THIS UNIT
JRST UFDAL8 ;GOT A BLOCK
HRRM P1,DEVRET##(F) ;SAVE THE POINTER SLOT IN THE DDB
PUSHJ P,NEXTUN## ;STEP TO NEXT UNIT WITH SPACE
JRST UFDAL5 ;NO UNIT HAS UNITAL GT 0
MOVSS (P) ;SAVE UNIT TO WRITE DATA BLOCK ON
HRRM U,(P) ;SAVE UNIT TO WRITE 2ND RIB ON
AOBJN P1,UFDAL3 ;GOT ONE. STEP TO NEXT POINTER SLOT
;HERE WHEN THERE ARE NO POINTER SLOTS IN THE UFD RIB
UFDFUL: TRO S,IOBKTL ;LIGHT AN ERROR BIT
POP P,T1 ;REMOVE GARBAGE FROM PD LIST
JRST BADUFD ;AND FINISH UP (DON'T WRITE UFD)
;HERE WHEN NO UNIT HAS UNITAL GT 0.(THERE STILL MAY BE SPACE SINCE UNITAL
; DOES NOT SHOW ALL THE FREE BLOCKS IN THE UNIT)
UFDAL5: HRRZ U,UNISTR(U) ;LOC OF STR DB
HLRZ U,STRUNI##(U) ;SET U TO 1ST UNIT IN STR
UFDAL6: SETZ T1, ;WANT A BLOCK ANYWHERE
MOVEI T2,1 ;ONLY 1 BLOCK
PUSHJ P,TAKBLK## ;TRY TO GET ONE
SKIPA ;THIS UNIT REALLY FULL
JRST UFDAL7 ;FOUND A FREE BLOCK
HLRZ U,UNISTR(U) ;STEP TO NEXT UNIT IN STR
JUMPN U,UFDAL6 ;TEST IT IF NOT END
LDB J,PJOBN## ;JOB NUMBER
PUSH P,P1 ;SAVE P1
PUSHJ P,HNGSTP## ;TYPE MESSAGE TO USER (STR FULL)
POP P,P1 ;RESTORE P1
MOVE U,(P) ; AND U
JRST UFDAL3 ;GO TRY FOR A BLOCK AGAIN
;HERE WHEN WE GOT A BLOCK ON SOME UNIT IN STR
UFDAL7: LDB T1,UNYLUN## ;UNIT NUMBER
TRO T1,RIPNUB## ;INSURE NON-0
MOVEM T1,(P1) ;SAVE UNIT-CHANGE PNTR IN RIB
AOBJP P1,UFDFUL ;STEP TO NEXT PNTR SLOT
MOVSS (P) ;SAVE UNIT FOR DATA BLOCK
HRRM U,(P) ;SAVE NEW CURRENT UNIT (FOR 2ND RIB)
;HERE WITH T2=NEW POINTER, P1=LOC IN MONITOR BUFFER
UFDAL8: MOVEM T2,(P1) ;SAVE POINTER IN MON BUF
PUSHJ P,CNVPTR## ;CONVERT TO ADR, COUNT
JFCL ;BAD UNIT-CHANGE
STOPCD .,JOB,NAP, ;++NOT ADDRESS POINTER
MOVE T2,P2 ;L(UFB OR SFD A.T.)
TRZ T2,NMPSFU## ;L(A.T.) IF AN SFD
MOVEI P1,UFP1PT## ;PNTR SAVED IN UFB CANT BE THE ONLY PNTR,
ANDCAM P1,COR1PT##(T2) ; SO INSURE 1PT IS OFF
MOVE T1,DEVPPN(F) ;PRJ,PRG
TRNN P2,NMPSFU## ;IS IT A UFD
CAME T1,MFDPPN## ;YES, IS IT [1,1]?
JRST UFDAL9 ;NO
LDB T1,UFYFSN## ;YES, GET STR INDEX
MOVE T1,TABSTR##(T1) ;STR DB LOC
ANDCAM P1,STRUN1##(T1) ;INDICATE MORE THAN 1 PTR IN MFD
UFDAL9: PUSHJ P,WTUSAT ;WRITE CHANGED SAT
LDB T3,UNYBPC## ;DONT COUNT BLOCKS ADDED TO UFD
TRNN P2,NMPSFU##
ADDM T3,UFBTAL##(P2) ; AS PART OF THIS JOBS QUOTA
MOVEI T1,DEPALC##
ANDCAM T1,DEVALC##(F)
MOVE T1,.USMBF
ADDM T3,RIBALC##+1(T1);UPDATE NO OF BLOCKS ALLOCATED
UFDNX2: TRNE P2,NMPSFU## ;AN SFD?
AOSA T3,DIFAWU##(P2) ;YES, GET ACCWRT
AOS T3,UFBWRT##(P2) ;UPDATE NO OF DIRECTORY BLOCKS WRITTEN
ANDI T3,UFWMSK## ;JUST NO OF BLOCKS IN UFD
MOVE T4,T3 ;NEW NUMBER OF BLOCKS
LSH T4,BLKLSH## ;NUMBER OF WORDS
MOVEM T4,RIBSIZ##+1(T1) ;STORE NEW SIZE OF UFD IN RIB
ADDI T3,1 ;+1=LOC OF 2ND UFD RIB
SETZ T2, ;START AT BEGINNING
PUSHJ P,SPTRW## ;SINCE SCNPTR WONT FIND LAST BLOCK
SUB T1,[1,,0] ; FAKE IT OUT IN CASE RIB IS FULL
PUSHJ P,SCNPTR## ;FIND POINTER FOR THE BLOCK
; (STORE LOC OF 2ND RIB IN DEVBLK)
STOPCD .,JOB,SPM, ;++SECOND POINTER MISSING
TRNE P2,NMPSFU## ;AN SFD?
JRST UFDALB ;YES, DON'T LOOK FOR A UFD A.T.
PUSHJ P,UFDACC ;FIND THE A.T. FOR THE UFD
SKIPA T3,P2 ;%FOUND - UPDATE ACCWRT
JRST UFDALA ;%NOT THERE
LDB T1,UFYWRT## ;NO OF BLOCKS IN UFD
MOVEM T1,ACCWRT##(T2) ;STORE IN A.T.
ANDCAM P1,ACC1PT##(T2) ;%TURN OFF 1PT IF CAME THROUGH UFDAL8
UFDALA: PUSHJ P,GVCBJ## ;%
UFDALB: PUSHJ P,UFORSS## ;GET LOC OF THE DIRECTORY BLOCK
TRZN T2,NMPSFU## ;AN SFD?
JRST UFDALX ;NO
MOVEI T3,BLKSIZ## ;SET NO OF WORDS WRITTEN
DPB T3,ACYLBS## ;=A FULL BLOCK
UFDALX: MOVE T1,.USMBF ;IOWD FOR MON BUF
MOVE T2,DEVDMP##(F) ;ADR OF UFD RIB
JSP T4,RIBUN## ;SET U TO UNIT OF 1ST RIB
PUSHJ P,MONWRT## ;WRITE THE UPDATED RIB
MOVE T2,DEVBLK##(F) ;LOC OF 2ND UFD RIB
MOVEM T2,RIBSLF##+1(T1)
POP P,U ;UNIT FOR NEW UFD BLOCK
PUSHJ P,STORU## ;SAVE IN DDB
PUSHJ P,MONWRU## ;WRITE 2ND RIB (KEEP OUT OF DISK CACHE)
TLNN U,-1 ;IS THERE A DIFFERENT UNIT FOR THE DATA?
JRST UFDALC ;NO
HLRZS U ;YES, SET U TO DATA BLOCK UNIT
PUSHJ P,STORU## ;AND SAVE IN DDB
UFDALC: HRRZ T3,DEVUFB##(F) ;LOC OF UFB
TRNE P2,NMPSFU## ;AN SFD?
SKIPA T3,DIFAWU##(P2) ;YES, GET ACCWRT
LDB T3,UFYWRT## ;NO OF BLOCKS IN UFD
SETZ T2, ;INDICATE START AT 1ST BLOCK IN FILE
PUSHJ P,SCNPT0## ;FIND PTR FOR LAST DATA BLOCK IN UFD
STOPCD .,JOB,UDM, ;++UFD DATA MISSING
PUSHJ P,PTRBLT## ;COPY POINTERS FROM RIB TO DDB (NEED FOR WRTUFD)
HRRZ T1,.USMBF ;LOC OF MON BUF (-1)
MOVSI T2,1(T1) ;SET TO ZERO ENTIRE BUFFER
HRRI T2,2(T1)
SETZM 1(T1)
BLT T2,BLKSIZ##(T1) ;ENTIRE BLOCK IS 0
AOSA T1 ;T1=LOC OF 1ST WORD IN BUF
FNDFRZ: ADDI T1,2 ;STEP TO NEXT NAME LOC
;HERE WITH T1=START OF MON BUF,EMPTY SLOT SOMEWHERE IN BLOCK
FNDFRE: SKIPE (T1) ;EMPTY UFD SLOT?
JRST FNDFRZ ;NO. TRY NEXT
PUSH P,T1 ;SAVE ADDR OF UFD SLOT
PUSHJ P,GETNMB ;FIND THE NMB
PUSH P,T1 ;SAVE ADDR OF NMB
PUSHJ P,SETCFP## ;BUILD A CFP
POP P,T2 ;ADDR OF NMB
POP P,T4 ;ADDR OF UFD SLOT
MOVE T3,NMBNAM##(T2) ;GET FILENAME FROM NMB
MOVEM T3,UFDNAM##(T4) ;STORE IN UFD
HRL T1,NMBEXT##(T2) ;ADD EXT TO CFP
MOVEM T1,UFDEXT##(T4) ;STORE IN UFD
PUSHJ P,NEWCFP ;SAVE CFP IN NMB
JFCL
PUSHJ P,WRTDIR ;WRITE THE NEW DIRECTORY BLOCK
FNDFRY: PUSHJ P,GETNMB ;FIND THE NMB AND ACC
LDB T3,ACYFSN## ;GET FSN
PUSH P,T3 ;SAVE FSN
HLRZ P1,T1 ;SAVE NMB IN A SAFE PLACE
HRRZ P3,ACCPPB##(T2) ;GET ADDR OF NEW PPB
HRRZ P2,DEVUFB##(F) ;SAVE LOC OF UFB
SETZ P4, ;INDICATE NO EXTRA PPB
TRNN M,CHNDIR ;CHANGING DIRECTORIES?
JRST FNDFR1 ;NO
;YES, FALL INTO NEXT PAGE
;HERE WHEN CHANGING DIRECTORIES - DELETE THE FILE FROM THE OLD DIR
PUSHJ P,DECUSA ;DECREMENT USE-COUNT OF NEW SFD
HRRZ T1,DEVSFD##(F) ;IF RENAME INTO A UFD
JUMPE T1,[SKIPE DEVSFD##(F) ; FROM AN SFD
AOS PPBCNT##(P3) ; PPBCNT IS TOO LOW, SO BUMP IT
JRST .+2]
SOS NMBCNT##(T1) ;RENAME INTO SFD - ADJUST COUNT
SKIPE DEVSFD##(F) ;IF RENAME INTO/OUT OF AN SFD
TLO P3,-1 ; SET A FLAG FOR FNDFR1
HLRZS DEVSFD##(F) ;RESTORE SFD LOC OF OLD DIRECTORY
PUSHJ P,GETCB## ;GET CB RESOURCE
HLRZ T2,SYSPPB## ;%START OF PPB BLOCKS
MOVE T1,DEVPPN(F) ;%OLD PRJ,PRG
PUSHJ P,LSTSCN## ;%FIND THE OLD PPB BLOCK
JRST FNDFRA ;%PPB WAS DELETED (SYSTEM ERROR)
MOVE P4,T2 ;SAVE LOC OF PPB
MOVE T1,(P) ;%FSN
HLRZ T2,PPBUFB##(T2) ;%START OF UFB BLOCKS FOR FILE
PUSHJ P,BYTSCA## ;%FIND THE UFB
JRST FNDFR0 ;%FOUND UFB
;STILL IN FTDRDR CONDITIONAL
;HERE IF THE PPB AND/OR THE UFB WAS DELETED (BY TSTPPB)
FNDFRA: PUSHJ P,GVCBJ## ;%RELEASE CB RESOURCE
TLZ M,UUOMSK ;WIPE BITS OUT OF LH(UUO)
TLO M,UUOLUK ;MAKE BELIEVE THIS IS A LOOKUP
PUSHJ P,SETSRC## ;SET UP SEARCH LIST
STOPCD FNDFR1,DEBUG,SLM, ;++SEARCH LIST MISSING
MOVE T2,T1 ;SEARCH LIST INTO T2
PUSHJ P,FNDFIL## ;SET UP UFB BLOCK
JFCL ;FNDFIL GETS A RIB ERROR ON LOOKUP(WRONG RIBPPN)
JRST FNDFRB ;AND CONTINUE
FNDFR0: PUSHJ P,GVCBJ##
PUSHJ P,DWNAU## ;GIVE UP AU FOR OLD UFB
MOVEM T2,DEVUFB##(F) ;SAVE OLD UFB LOC IN DDB
PUSHJ P,UPAU## ;GET AU FOR NEW UFB
PUSHJ P,LOGTS2 ;REWRITE UFD RIB WITH NEW QUOTA
PUSHJ P,UPAU## ;GET AU RESOURCE AGAIN
FNDFRB: SETZ P1, ;INDICATE NMB SHOULD BE LEFT ALONE
PUSHJ P,DELNAM ;DELETE THE NAME FROM THE UFD
FNDFR1: PUSHJ P,DWNAU## ;NOT THERE - RELEASE AU
HRRM P2,DEVUFB##(F) ;RESTORE NEW UFB LOC
CAIN P4,(P3) ;IF RENAME IN SAME PPN
TLZ P3,-1 ; COUNTS ARE RIGHT
TLNE P3,-1 ;IF RENAME TO/FROM SFD ACCROSS PPNS
SOS PPBCNT##(P3) ; THEN PPB COUNT IS TOO HIGH
MOVE P3,PPBNAM##(P3) ;GET NEW PPN
MOVEM P3,DEVPPN(F) ;SAVE IN DDB (NEEDED BY LOGTST
;IF RENAMING INTO NEW DIR)
SKIPE P4 ;DECR OLD PPB USE-COUNT
SOS PPBCNT##(P4) ; SO TSTPPB CAN DO ITS THING
HLRZ T1,DEVEXT(F) ;EXTENSION OF FILE
CAIE T1,(SIXBIT .UFD.) ;UFD?
JRST FNDFR3 ;NO
MOVE T1,DEVFIL(F) ;YES. PRJ,PRG
PUSHJ P,GETCB## ;GET CB RESOURCE
HLRZ T2,SYSPPB## ;%T1=START OF PPB'S
PUSHJ P,LSTSCN## ;%FIND PPB FOR FILE
JRST FNDFR2 ;%NOT THERE
MOVE T1,(P) ;%FOUND. T1=FSN
MOVE T4,T2 ;%SAVE PPB LOC
PUSHJ P,FSNPS2## ;%POSITION A BIT FOR FSN
ORM T2,PPBKNO##(T4) ;%INDICATE THAT THERE IS A UFD
ORM T2,PPBYES##(T4) ;% FOR THIS STR
FNDFR2: PUSHJ P,GVCBJ## ;%GIVE UP CB
FNDFR3: POP P,T1 ;REMOVE FSN FROM PD LIST
LDB T1,DEYFSN## ;FSN OF FILE BEING SUPERSEDED
JUMPE T1,CLRSTS ;NONE IF 0
;HERE IF A FILE IN 1 STR IS SUPERSEDING A FILE IN ANOTHER STR
;(NO ROOM TO WRITE NEW FILE IN ORIGINAL STR)
HRRZ T2,DEVACC##(F) ;LOC OF A.T.
LDB T3,ACYFSN## ;FSN THEN NEW FILE EXISTS OR
CAMN T3,T1 ;IF THE SAME,
JRST CLRSTS ; THE SUPERCEEDED FILE GOT DELETED
HRRZ T2,ACCPPB##(T2) ;LOC OF PPB
HLRZ T2,PPBUFB##(T2) ;1ST UFB LOC
PUSHJ P,BYTSCA## ;FIND UFB FOR FORMER FILE
SKIPA
JRST CLRSTS ;NOT THERE
HRRM T2,DEVUFB##(F) ;SAVE LOC OF UFB FOR UFDSRC
PUSHJ P,UPAU## ;GET AU
LDB T1,UFYFSN## ;FSN
MOVE U,TABSTR##(T1) ;STR DATA BLOCK LOC
HLRZ U,STRUNI##(U) ;SET U TO ANY UNIT IN STR
HRLM U,DEVUNI##(F) ;SAVE IN DDB (FOR DELNAM)
HLRZS P1 ;LOC OF NMB
PUSHJ P,DELNAM ;REMOVE NAME FROM UFD
JRST CLRST2 ;NOT THERE - SOMEONE ALREADY DELETED IT
PUSH P,P1 ;SAVE LOC OF NMB
HRRZ T2,DEVUFB##(F) ;LOC OF UFB
JRST ALLP10 ;GO DELETE OLD FILE
;HERE WHEN WE CANT ENTER THE FILE IN THE UFD
BADUF0: POP P,U ;REMOVE U FROM PDLIST
BADUFD: TLNE S,IOSAU ;HAVE AU RESOURCE?
PUSHJ P,DWNAU## ;NOT ANY MORE
PUSHJ P,REDRIB## ;READ THE PRIME-RIB AGAIN
JRST CLRSTS ;NOW THAT'S GONE BAD?
PUSHJ P,SPTRW## ;GET PNTR TO RET PNTRS
MOVE P1,T1 ;INTO P1 FOR DELRIB
PUSHJ P,DELRIB ;
STOPCD .+1,DEBUG,DDS, ;++ DELRIB DIDNT SKIP
JRST CLRSTS
CLRST2: PUSHJ P,DWNAU## ;GIVE UP AU RESOURCE
;HERE WHEN THE UFD IS WRITTEN
CLRSTS: SETZ P4, ;PREPARE FOR ADDM P4,ACCCNT
CLRSTX: TLNE S,IOSAU ;STILL HAVE AU?
PUSHJ P,DWNAU## ;YES, GIVE IT UP
MOVE T1,DEVUFB##(F)
MOVSI T2,UFPCHG## ;SOME FILE HAS BEEN WRITTEN OR RENAMED
IORM T2,UFBCHG##(T1)
TLNE M,UUOREN ;IF RENAME
PUSHJ P,CLSNM ; GET DDB RIGHT FOR WATCH FILE
PUSHJ P,GETCB## ;DID FILOP TELL US TO SLIP?
PUSHJ P,NWCFP0
JRST CLRSTB ;NO
;HERE IF FILOP IS SLIPPING THE FILE INTO UPDATE MODE.
;MOST OF THE WORK WAS ALREADY DONE BY NEWCFP, WE MERELY
;NEED TO CLEAN UP (I.E. DO THE STUFF THAT COULDN'T
;BE DONE WHILE THE DIRECTORY POINTERS WERE IN CORE)
HRRZ T3,DEVACC##(F) ;ADDR OF ACC
ADDM P4,ACCCNT##(T3) ;DECR IF CLSDEL DID INCR
PUSHJ P,AT2DDB## ;SET UP POINTERS FROM ACC
JFCL
TLZ F,ICLOSB+OCLOSB ;UNDO CLOSE
TLO F,ENTRB+LOOKB
HRRZ T3,DEVCPY##(F) ;ALREADY GOT COPY?
JUMPN T3,CLRSTY
PUSHJ P,GETCPY ;NO, COPY THE POINTERS
CAIA
CLRSTY: PUSHJ P,CPYPTR ;YES, UPDATE THE COPY
HRRZ T2,DEVACC##(F)
MOVE W,ACCWRT##(T2) ;SIZE OF FILE
ADDI W,1 ;EOF
PUSHJ P,USETO0## ;UPDATE POINTERS
JRST STOIOS## ;DONE
;ROUTINE TO STORE THE CFP AND SLIP THE FILE INTO UPDATE MODE.
;IF, INDEED, THE FILE MUST BE SLIPPED INTO UPDATE MODE, THIS MUST
;BE DONE BEFORE THE DIRECTORY IS WRITTEN (ELSE SOME OTHER JOB CAN
;START A LOOKUP AND BUILD A DUPLICATE ACC).
;WE MUST CLEAR ACPCRE+ACPSUP SO THAT HE WILL SEE OUR OWN ACC
;AND USE IT. ORDINARILY A DUPLICATE ACC WOULD NOT BE
;A PROBLEM, WE'D DETECT HIS ACC AND DELETE OUR COPY.
;BUT DURING A FILOP SLIP, WE CANNOT DELETE OUR ACC AND
;THEREFORE CANNOT ALLOW HIM TO BUILD A DUPLICATE.
;T1 PASSES THE CFP
;T2 PASSES ADDR OF NMB
;CPOPJ IF NO SLIP, CPOPJ1 IF SLIP
NEWCFP: PUSHJ P,GETCB## ;GET THE CB
PUSHJ P,SAVCFP ;%STORE CFP IN NMB
;HERE IF NMB DOESN'T NEED TO BE UPDATED
NWCFP0: MOVE T3,DEVJOB(F) ;%DID FILOP TELL US TO SLIP?
TLNE T3,DEPFFA
PUSHJ P,TSTSFD
PJRST GVCBJ## ;%NO
JUMPL M,GVCBJ## ;%NO
HRRZ T2,DEVACC##(F)
JUMPE T2,GVCBJ## ;%NO
LDB T1,ACYSTS## ;%ALREADY IN UPDATE MODE?
CAIN T1,ACRUPD##
JRST NWCFP1 ;%YES
MOVEI T1,ACRUPD## ;%NO, SET UPDATE NOW
DPB T1,ACYSTS##
MOVEI T1,1 ;%FIRST WRITTER
DPB T1,ACZWCT##
MOVEI T1,ACPSMU
TLNE T3,DEPSIM ;%SIMULTANEOUS UPDATE?
IORM T1,ACCSTS##(T2) ;%YES, LIGHT BIT IN ACC
NWCFP1: TLOE S,IOSRDC ;%INPUT CLOSE DONE?
PJRST GVCBJ1## ;%NO
MOVEI T1,ACPCNT## ;%YES, UNDO INPUT CLOSE
ADDM T1,ACCCNT##(T2)
PUSHJ P,INCUC
MOVEM S,DEVIOS(F)
PJRST GVCBJ1##
;HERE WITH P4=0 OR -ACPCNT (CLSDL1)
CLRSTB: CBDBUG (N,Y);
SKIPN DEVSPN##(F)
SKIPGE DEVSPL(F) ;SPOOLED FILE?
PUSHJ P,[PUSHJ P,CLSNAM ;YES, TELL QUASAR
JRST QSRSPL##]
SETZM DEVSPN##(F)
IFN FTFDAE,<
MOVSI T1,DEPFDA## ;CALL THE FILE DAEMON ON CLOSE BIT
TDNN T1,DEVFDA##(F) ;SHOULD THE FILE DAEMON BE CALLED?
JRST CLRST0 ;NO
ANDCAM T1,DEVFDA##(F) ;YES, CLEAR THE BIT
MOVEI T1,.FDCLO ;INDICATE OUTPUT CLOSE
PUSHJ P,SNDFMG## ;TELL THE FILE DAEMON
JFCL ;DON'T CARE
PUSHJ P,GTMNBF##
CLRST0:>
PUSHJ P,DDBZR ;CLEAR OUT PNTRS IN CASE OF NEW ENTER
MOVEI T1,DEPWRT## ;CLEAR THE DDB - IS - WRITING BIT
ANDCAM T1,DEVWRT##(F)
TLZ F,ENTRB+RENMB+OUTPB ;ZERO RENAME, OUTPUT AND ENTER BITS
HRRZ T1,DEVACC##(F) ;LOCATION OF ACCESS TABLE
JUMPE T1,[SETZM DEVUNI##(F)
PUSHJ P,LOGTSP ;DO UFD ACCOUNTING
SETO T1,
JRST CLRSTC]
MOVE T2,ACCSTS##(T1) ;FILE STATUS
TRNE T2,ACPUPD ;UPDATE MODE ?
TLNE F,ICLOSB ;YES, IMPUT SIDE STILL OPEN ?
SETZM DEVUNI##(F) ;NO, CLEAR DEVUNI
PUSHJ P,LOGTST ;TURN ON RIPLOG IN UFD IF PPB NOT LOGGED IN
PUSHJ P,DDBZR ;LOGTST MIGHT SET PNTRS UP AGAIN
PUSHJ P,GETNMB ;GET THE NMB
MOVE T3,ACCSTS##(T2) ;DON'T CALL FIXPTH IF RENAME
TRNN T3,ACPREN ;IT WAS ALREADY DONE BY FNDFIL
PUSHJ P,FIXPTH ;BUMP COUNT IF IN SOMEBODY'S PATH
EXCH T1,T2 ;T1=LOC OF AT, T2=NMB
MOVE P2,T2 ;SET P2 TO DECREMENT COUNTS
HRL P2,ACCPPB##(T1)
LDB J,PJOBN## ;JOB NUMBER
TLNE F,LOOKB ;CLOSIN WILL GET IT IF INPUT SIDE OPEN
JRST CLRS0A
PUSHJ P,SFDDEC ;DEC PPBCNT,NMBCNT FOR SFD
PUSHJ P,DECUSA ;DECREMENT USE-COUNTS FOR SFD
CLRS0A: HRRZ T1,DEVACC##(F) ;RESET T1 TO LOC OF A.T.
PUSHJ P,GETCB## ;%GET CB RESOURCE
MOVE T3,ACCSTS##(T1) ;%FILE STATUS
TRNE T3,ACPUPD ;%UPDATE?
TLNE F,ICLOSB ;%YES, INPUT SIDE CLOSED?
PUSHJ P,UACLR ;%YES, TAKE A.T. OUT OF DDB, CLEAR DEVUFB
MOVSI T2,DEPSIM ;%CLEAR SIM. UPDATE BIT FROM DDB
ANDCAM T2,DEVJOB(F) ;%
LDB T4,ACYWCT## ;%DECREMENT NUMBER OF WRITERS
TRNE T3,ACPUPD ;% IF AN UPDATE FILE
SUBI T4,1 ;%(UP EVEN IF NOT SIM-UPD)
DPB T4,ACYWCT##
MOVEI T2,ACPCRE!ACPREN!ACPSUP+ACPPAL##
SKIPN T4 ;%SIM UPDATE?
TRO T2,ACPUPD!ACPSMU ;%DONT CLEAR ACPUPD IF STILL UPDATERS
ADDM P4,ACCCNT##(T1) ;DECR READ-COUNT IF IT WAS COUNTED UP
; AT CLSDL1 TO PREVENT A.T. GOING DORMANT
ANDCAB T2,ACCSTS##(T1) ;%CLEAR THE STATE CODE
PUSHJ P,DECUC ;%DECR USE-COUNTS OF NMB, PPB
MOVEI T3,ACPPAL##
MOVE T4,DEVPAL##(F) ;%IF PRE-ALLOCATED,
TRZE T4,DEPPAL##
IORM T3,ACCPAL##(T1) ;% LIGHT BIT IN A/T/
MOVEM T4,DEVPAL##(F) ;% AND CLEAR THE DDB BIT
CLRSTC: HRRZ T4,DEVCPY##(F) ;% IS THERE AN IN-CORE COPY?
JUMPE T4,CLRSTG
MOVEI T3,SYSPTR##-PTRSYS## ;% YES, START AT BEGINNING
PUSH P,T1
DDBSRL ;% INTERLOCK IT
CLRSTD: HLRZ T1,PTRSYS##(T3) ;% STEP TO NEXT
CAIN T1,(T4) ;% IS IT THE ONE WE WANT?
JRST CLRSTE ;% YES
SKIPE T3,T1 ;% NO, STEP TO NEXT
JRST CLRSTD
JRST CLRSTF ;% NONE. (SYSTEM ERROR)
CLRSTE: MOVE T1,PTRSYS##(T4) ;% GET LINK OF THIS ONE
HLLM T1,PTRSYS##(T3) ;% STORE IN PREVIOUS LINK
CLRSTF: DDBSRU ;% NO NEED FOR INTERLOCK NOW
HLLZS DEVCPY##(F) ;% NO IN-CORE COPY NOW
MOVE T2,T4 ;% ADDRESS
MOVEI T1,PTRCOR## ;% WORDS USED
PUSHJ P,GIVWDS## ;% GIVE UP THE SPACE
POP P,T1 ;% RESTORE T1
MOVE T2,ACCSTS##(T1) ;% AND T2
CLRSTG: JUMPL T1,CLRST1 ;GO IF NO ACCESS TABLE
TRNE T2,ACMCNT!ACPUPD ;%ANYONE READING FILE?
JRST CLRST4 ;%YES, RETURN
TRNE T2,ACPDEL## ;%FILE MARKED FOR DELETION (RACE CONDITION-
; CAUSED BY THIS JOB BEING HELD UP IN OUTPUT CLOSE
; AND ANOTHER JOB ZOOMING THROUGH DELETE)
JRST CLRST3 ;%YES, GO DELETE FILE NOW
SKIPE T2,ACCDOR##(T1) ;%NO, A.T. DORMANT?
STOPCD GVCBJ##,DEBUG,FAD, ;%++FILE ALREADY DORMANT
PUSHJ P,SPARKS ;%DID ANOTHER A.T. SNEAK IN?
PUSHJ P,ATSDRA## ;%NO, MAKE OUR A.T. DORMANT
CLRST1: PJRST TSTPPB ;TEST IF PPB LOGGED IN, EXIT
;HERE ON A WIERD TIMING PROBLEM
CLRST3: HRRM T1,DEVACC##(F) ;CAUSE CLOSR2 CALLS GETNMB
PUSHJ P,GVCBJ##
PUSHJ P,STORU##
HRLM U,DEVUNI##(F) ;SAVE U IN DDB
SETZ P2, ;DONT DECR USE-COUNTS AGAIN
JRST CLOSR2 ;GO BACK TO INPUT CLOSE AND DELETE FILE
;HERE IF OTHER READERS OF THE FILE
CLRST4: PUSHJ P,GVCBJ##
HRRZ T3,DEVACC##(F) ;AT
JUMPE T3,CPOPJ## ;IF 0 THEN WE'RE NOT UPDATING
;UPDATER - RESET DDB POINTERS
PUSHJ P,AT2DDB## ; (ELSE NEXT INPUT WILL READ UFD)
JFCL ;AT IS MESSED UP - HE'LL FINE OUT SOON
POPJ P,
;THIS ROUTINE TESTS FOR AN OBSCURE RACE.
;IF WE JUST CREATED A NEW VERSION OF THE FILE,
;THEN IT IS POSSIBLE THAT A LOOKUP SNUCK IN
;AFTER WE WROTE THE UFD. THE JOB DOING THE LOOKUP
;IGNORED OUR A.T. BECAUSE IT WAS MARKED AS EITHER
;ACPCRE OR ACPSUP. HE NOW HAS AN A.T. FOR THE
;NEW VERSION OF THE FILE. HIS A.T. IS
;NOW AN EXACT DUPLICATE OF OUR OWN. WE CANNOT ALLOW
;DUPLICATE A.T.'S SO WE MUST DESTROY ONE OF THE TWO.
;WE CHOOSE TO DESTROY OUR OWN A.T. AS IT IS KNOWN
;TO BE DORMANT.
;CALL WITH T1=A.T.
;CALL WITH CB
;NORMALLY EXITS CPOPJ (STILL HAVING CB)
;EXITS CPOPJ1 IF THERE WAS A DUPLICATE A.T. (IT HAS
;BEEN DESTROYED AND CB WAS GIVEN AWAY).
SPARKS: PUSH P,T1 ;%SAVE ADDR OF OUR A.T.
PUSHJ P,GTNM1 ;%GET ADDR OF NMB
MOVEI T2,DIFNAL##(T1) ;%ADDR OF NMBACC
MOVE T1,(P) ;%GET FSN OF OUR A.T.
LDB T1,ACZFSN##
SPARK1: PUSHJ P,BYTSC1## ;%FIND ANOTHER A.T.
SKIPA T3,ACCPT1##(T2) ;%GET ITS RTP
JRST TPOPJ## ;%NO MORE A.T.'S
MOVE T4,(P) ;%ADDR OF OUR A.T.
CAME T2,T4 ;%SKIP OVER OUR OWN
CAME T3,ACCPT1##(T4) ;%SAME RTP?
JRST SPARK1 ;%NO, KEEP LOOKING
POP P,T2 ;%YES, GET BACK OUR A.T.
PUSHJ P,ATRMVX## ;%DESTROY OUR A.T.
JRST CPOPJ1##
;SUBROUTINE TO TEST IF USER IS LOGGED IN (ON A CLOSE)
;IF NOT, RECOMPUTE RIBUSD AND REWRITE THE RIB
;ENTER AT LOGTS1 IF KNOWN NOT TO BE LOGGED IN
;ENTER AT LOGTS2 IF ALREADY HAVE AU RESOURCE
;ENTER AT LOGTSP IF A.T. NOT AVAILABLE
LOGTSP: MOVE T1,DEVPPN(F) ;GET THE FILE'S PPN
HLRZ T2,SYSPPB## ;GET LOC OF 1ST PPB
PUSHJ P,LSTSCN## ;SEARCH FOR THE PPB
POPJ P, ;NONE. JUST RETURN
MOVE T1,T2 ;COPY THE PPB
JRST LOGTS3 ;PICK UP WITH PPB BELOW
LOGTST: MOVE T1,DEVACC##(F) ;LOC OF A.T.
MOVE T1,ACCPPB##(T1) ;LOC OF PPB
LOGTS3: MOVE T1,PPBNLG##(T1) ;LOGGED-IN WORD
TLNE S,IOSWLK ;DON'T WRITE IF STR IS WRITE-LOCKED
POPJ P, ;YES. RETURN
PUSHJ P,SAVE2## ;S.L. STUFF WIPES P2
TRNN T1,PPPNLG## ;IS USER LOGGED IN ?
JRST LOGTS1 ;NO, WRITE RIB
SKIPN T1,DEVUFB##(F) ;YES. GET UFB
JRST LOGTS1
MOVE T1,UFBLOG##(T1)
TLNE T1,UFPLOG## ;IS RIPLOG ON IN UFD?
POPJ P, ;YES, RETURN
LOGTS1: PUSHJ P,UPAU## ;NO. GET AU RESOURCE
CAIA
LOGTS2: PUSHJ P,SAVE1##
HRRZ P1,DEVUFB##(F) ;LOC OF UFB
JUMPE P1,DWNAU##
SKIPN T2,UFBPT1##(P1) ;RETRIEVAL PNTR FOR UFD
PJRST DWNAU## ;UFD WAS DELETED - RETURN
MOVE T1,UFBUN1##(P1) ;UNIT WORD
PUSHJ P,SETFS0## ;SET UP U, BLOCK IN T2
PJRST DWNAU## ;ERROR READING RIB - RETURN
PUSHJ P,UFDRED## ;READ THE UFD RIB
PJRST DWNAU## ;ERROR READING RIB - RETURN
MOVEI T3,RIPNDL## ;GET NO DELETE BIT
TDNE T3,RIBSTS##+1(T1) ;IS IT SET FOR THIS UFD?
PJRST DWNAU## ;YES, DON'T UPDATE
MOVE T3,UFBCHG##(P1) ;HAS ANY FILE BEEN CHANGED?
TLZN T3,UFPCHG##
TDZA T2,T2 ;NO, DON'T SET BIT IN RIB
MOVSI T2,RIPCHG## ;YES, SET BIT IN RIB
MOVEM T3,UFBCHG##(P1) ;CLEAR BIT IN UFB
TDNE T2,RIBSTS##+1(T1) ;BIT ALREADY SET IN RIB?
SETZ T2, ;YES, DON'T REWRITE RIB
IORM T2,RIBSTS##+1(T1) ;LIGHT RIBSTS BIT IF CHANGE
MOVE T3,RIBQTF##+1(T1) ;COMPUTE NUMBER OF BLOCKS USED
SUB T3,UFBTAL##(P1)
CAME T3,RIBUSD##+1(T1) ;SAME AS BEFORE?
SETO T2, ;NO, MUST REWRITE RIB
MOVEM T3,RIBUSD##+1(T1) ;STORE NEW VALUE IN RIB
JUMPE T2,DWNAU## ;DON'T REWRITE IF DIDN'T ALTER RIB
MOVE T2,RIBSLF##+1(T1) ;BLOCK NUMBER OF RIB
PUSHJ P,MONWRT## ;REWRITE 1ST RIB OF UFD
PJRST DWNAU## ;RETURN AU RESOURCE AND EXIT
;SUBROUTINE CALLED ON OUTPUT CLOSE OF A FILE
;CLEARS DEVACC, DEVUFB UNLESS FLOW WILL GET GO CLRST3
;ENTER WITH T3=ACCSTS. CALL UACLX TO CLEAR DEVACC, DEVUFB
;PRESERVES ALL ACS
UACLR: TRNN T3,ACMCNT ;%ANY READERS?
TRNN T3,ACPDEL## ;%YES, MARKED FOR DELETION
CAIA ;%READERS OR NOT TO DELETE - OK
POPJ P, ;%GOING TO DELETE NOW - DON'T CLEAR DDB
;% (CALL INPUT CLOSE TO DELETE FILE NOW)
UACLX: HLLZS DEVACC##(F) ;%CLEAR DEVACC, DEVUFB
SETZM DEVUFB##(F) ;%
POPJ P, ;%
;SUBROUTINE TO READ THE UFD RIB DURING CLOSE
;ENTER WITH U SET UP, EXIT CPOPJ IF ERROR READING RIB
;EXIT CPOPJ1 NORMALLY, WITH RIB IN MONITOR BUFFER
UFDCRD: PUSH P,DEVPPN(F) ;SAVE OLD PRJ-PRG
MOVE T1,DEVACC##(F) ;LOC OF A.T.
MOVE T1,ACCPPB##(T1) ;LOC OF (NEW) PPB
MOVE T1,PPBNAM##(T1) ;(NEW)PRJ-PRG
MOVEM T1,DEVPPN(F) ;SAVE IN DEVPPN SO UFDRED WONT GIVE AN ERROR
;RETURN IF RENAMING INTO ANOTHER DIRECTORY
MOVE T2,DEVDMP##(F) ;BLOCK NUMBER OF RIB
PUSHJ P,UFDRED## ;GO READ THE RIB
JRST TPOPJ## ;BAD UFD RIB, ERROR RETURN
POP P,DEVPPN(F) ;RESTORE OLD PRJ-PRG
JRST CPOPJ1## ;AND RETURN
;SUBROUTINE TO FIND THE LAST UNIT-CHANGE POINTER IN THE RIB
;ENTER WITH RIB IN MON BUF
;EXIT U=RH(DEVUNI)=LAST UNIT POINTED TO BY RIB
LSTUNI: PUSHJ P,SPTRW## ;SET AOBJN WORD FOR POINTERS
LSTUN2: SKIPN T3,(T1) ;GET A POINTER
JRST LSTUN3 ;THROUGH
TLNN T3,-1 ;UNIT CHANGE?
MOVE T2,T3 ;YES, SAVE IN T2
AOBJN T1,LSTUN2 ;TEST NEXT POINTER
LSTUN3: PUSHJ P,CNVPTR## ;CONVERT POINTER TO UNIT
CAIA ;BAD UNIT-CHANGE PNTR
POPJ P, ;AND RETURN
STOPCD CPOPJ##,DEBUG,NUP, ;++NO UNIT CHANGE POINTER
;SUBROUTINE TO LIGHT UNIT-BIT IN RIBUNI
;ENTER T1=C(.UPMBF), U=UNIT
;LIGHTS RIGHT BIT IN LH(RIBUNI) FOR THIS UNIT
;EXIT T1=C(.UPMBF)
ORINUN: MOVSI T2,1 ;BIT FOR DRIVE 0
LSH T2,@UDBPDN(U) ;POSITION BIT FOR PHYSICAL DRIVE NUMBER
IORM T2,RIBUNI##+1(T1) ;STORE IN RIB
POPJ P, ;AND RETURN
;SUBROUTINE TO GET LAST RIB POINTER
;ENTER WITH RIB IN MONITOR BUFFER
;EXIT WITH T2 = LAST POINTER
;PRESERVES T3
GTLPT:: PUSHJ P,SPTRW## ;GET AOBJN WORD FOR PNTRS
HLRE T2,T1 ;NUMBER OF PNTRS
SUB T1,T2 ;POINT AT END +1
MOVE T2,-1(T1) ;GET LAST POINTER
POPJ P, ;AND RETURN
;SUBROUTINE TO UPDATE RIBNAM,RIBEXT, RIBPPN IN THE CASE OF A CLOSE FOR RENAME
;T1=IOWD FOR MONITOR BUFFER, T1,T2 RESPECTED.
NAMNW: PUSH P,T2 ;SAVE T2
HRRZ T4,DEVACC##(F) ;GET ADDRESS OF A.T.
HLRZ T4,ACCNMB##(T4) ;STEP TO NEXT IN RING
TRZN T4,DIFNAL## ;NAME BLOCK?
JRST .-2 ;NO, LOOK AT NEXT
MOVE T2,NMBNAM##(T4) ;GET NEW NAME
MOVEM T2,RIBNAM##+1(T1) ;TO RIB
MOVE T2,NMBEXT##(T4) ;NEW EXTENSION
HRLM T2,RIBEXT##+1(T1) ;TO RIB
HRRZ T2,DEVACC##(F) ;GET A.T. AGAIN
HRRZ T4,ACCPPB##(T2) ;LOCATION OF PPB
MOVE T3,PPBNAM##(T4) ;NEW PPN
MOVEM T3,RIBPPN##+1(T1) ;TO RIB
PUSH P,T1
LDB T1,ACYFSN## ;STR NUMBER
HLRZ T2,PPBUFB##(T4) ;START OF UFB CHAIN
PUSHJ P,BYTSCN## ;FIND UFB (ANOTHER JOB MIGHT
CAIA ; HAVE RENAMED ACCROSS DIRECTORIES)
STOPCD .+1,DEBUG,UNF, ;++ UFB NOT FOUND
HRRM T2,DEVUFB##(F) ;SAVE (NEW) DEVUFB
POP P,T1
PUSHJ P,SETUFR ;SET UP RIBUFD
PJRST T2POPJ## ;RESTORE T2 AND RETURN
;SUBROUTINE TO COMPRESS THE UFD INTO AS FEW BLOCKS AS POSSIBLE
;ENTER WITH 1 MONITOR BUFFER, UFD RIB IN IT
; SETS DEVREL TO NEW SIZE OF THE FILE
;EXIT CPOPJ IF NO MORE BLOCKS HAVE TO BE ALLOCATED, T2=BLOCK TO WRITE
;EXIT CPOPJ1 IF MORE BLOCKS MUST BE ALLOCATED
UFDCMP: PUSHJ P,SAVE4## ;SAVE P1-P4
PUSHJ P,CPYFST## ;COPY 1ST VALUES FROM UFD RIB TO DDB
POPJ P, ;RIB FOULED UP BADLY - RETURN
SOS T1,DEVBLK##(F) ;POINT DEVBLK TO RIB
MOVEM T1,DEVDMP##(F) ;SAVE RIB BLOCK NO IN DDB
SETZB P4,DEVREL##(F) ;DEVREL WILL BE BUMPED IN DIRRED
MOVE P3,F ;SAVE LOC OF DDB
PUSHJ P,FAKDDB ;GET AN EXTRA DDB
JRST UFDCMD ;NO ROOM
EXCH P3,F ;RESTORE F, SAVE NEW DDB LOC
MOVE S,DEVIOS(F) ;RESTORE S
MOVEM U,DEVUNI##(P3) ;SAVE U IN CASE NO HOLES
MOVE T1,.USMBF ;LOC OF MON-BUF
MOVE T2,RIBSTS##+1(T1) ;GET RIB STATUS BITS
TROE T2,RIPCMP## ;LIGHT UFD-BEING-COMPRESSED BIT
TRO T2,RIPCBS## ;PLUS RIPCBS IF RIPCMP WAS ALREADY ON
MOVEM T2,RIBSTS##+1(T1) ;REPLACE STATUS BITS
MOVE T2,RIBSLF##+1(T1); (UFD CAN GET ZAPPED IF SYSTEM CRASHES
PUSHJ P,MONWRT## ; WHILE A UFD IS BEING COMPRESSED)
MOVE P1,.USMBF ;SAVE ADDR OF MON BUF
SETZM .USMBF ;SET TO GET ANOTHER BUFFER
PUSHJ P,GTMNBF## ;GET SECOND MON-BUF
MOVE P2,.USMBF ;LOC OF MON BUF INTO P2
;STILL IN FTDUFC CONDITIONAL
;HERE WITH P1,P2 = LOC OF MON BUFS, P3=L(EXTRA DDB)
UFDCM4: PUSHJ P,DIRRED## ;READ A UFD BLOCK
JRST [HRRM P2,DEVDMP(P3) ;NO HOLES AT ALL
MOVEM P1,.USMBF ;FIX THINGS UP
JRST UFDCMB] ;AND EXIT
TRNE S,IOIMPM!IODERR!IODTER!IOBKTL ;ANY READ ERRORS?
JRST [HRRM P2,DEVDMP(P3) ;YES, FIX THINGS UP
MOVEM P1,.USMBF ;AND DON'T COMPRESS
JRST UFDCMC]
SKIPE BLKSIZ##-2(P2) ;IS BLOCK FULL?
AOJA P4,UFDCM4 ;YES - READ NEXT BLOCK
;HERE WHEN A UFD BLOCK WITH AT LEAST 1 HOLE HAS BEEN FOUND
MOVEI T1,DEVMOD(P3) ;LOC OF EXTRA DDB
HRLI T1,DEVMOD(F) ;SET TO BLT CURRENT STATE OF DDB
BLT T1,DEVRBN##(P3) ;EXTRA DDB POINTS TO 1ST UFD BLOCK TO WRITE
HRRZ T1,P3 ;NOW ADJUST DEVRET IN COPIED UFD
SUBI T1,(F) ;RELATIVE DISTANCE
ADDM T1,DEVRET##(P3) ;NEW DEVRET POINTS TO RIGHT PNTR
SOS DEVBLK##(P3) ;RESET LOCS IN THE DDB WHICH WE WILL WRITE FROM
SOS DEVREL##(P3) ; (DIRRED INCREMENTS BEFORE I/O)
AOS DEVLFT##(P3)
MOVEM P1,.USMBF ;BUFFER TO READ INTO
MOVE P4,P2 ;PNTR TO MON BUF WITH UFD DATA
AOSA P4 ;GO FIND 1ST EMPTY SLOT
ADD P4,[XWD 2,2]
SKIPE (P4) ;THIS SLOT FREE?
JRST .-2 ;NO, TRY NEXT
MOVEM S,DEVIOS(P3) ;SAVE S (IOSFIR) IN WRITING-DDB
PUSH P,DEVPPN(F) ;IF DIRRED HAS TO READ THE UFD RIB
MOVE T1,DEVACC##(F) ; AND WE WERE CALLED VIA
MOVE T1,ACCPPB##(T1) ; RENAME ACROSS DIRECTORIES
MOVE T1,PPBNAM##(T1) ; UFDRED WILL CHECK DEVPPN
MOVEM T1,DEVPPN(F) ;SO MAKE IT RIGHT
UFDCM5: PUSHJ P,DIRRED## ;READ INTO P1-BUFFER
JRST UFDCM9 ;EOF - FINISH UP
MOVE P1,.USMBF ;POINTER TO THIS UFD BLOCK DATA
UFDCM6: SKIPN T1,1(P1) ;PICK UP UFD ENTRY
JRST UFDCM5 ;DONE - READ NEXT UFD BLOCK
MOVEM T1,(P4) ;SAVE IN OUTPUT-BUFFER
MOVE T1,2(P1) ;GET EXTENSION, CFP
MOVEM T1,1(P4) ;SAVE IN OUT-BUF
AOBJN P4,.+1 ;COUNT OUTPUT WORDS
AOBJP P4,UFDCM8 ;GO IF OUT-BUFFER IS FULL
UFDCM7: AOBJN P1,.+1 ;COUNT INPUT WORDS
AOBJN P1,UFDCM6 ;GO IF MORE IN THIS BLOCK
JRST UFDCM5 ;BLOCK THROUGH - READ NEXT
;STILL IN FTDUFC CONDITIONAL
;HERE WITH P2-BUFFER FULL, WRITE IT
UFDCM8: EXCH P2,.USMBF ;WRITE THE P2-BUFFER
PUSHJ P,DIRWRT ;WRITE THE UFD BLOCK
EXCH P2,.USMBF
MOVE P4,P2 ;POINTER TO THE BUFFER
AOJA P4,UFDCM7 ;GO FILL IT AGAIN
;HERE WHEN THE UFD HAS BEEN COMPLETELY READ
UFDCM9: POP P,DEVPPN(F)
HLRE P1,P4 ;SAVE NO OF WDS IN LAST BUFFER
SETZM (P4) ;ZERO THE REST OF THE UFD BLOCK
AOBJN P4,.-1
HLLOM DEVLFT##(P3) ;MAKE SURE DIRWRT DOESNT CHANGE DDB DATA
; (LAST BLOCK OF A GROUP)
EXCH P2,.USMBF ;WRITE P2-BUFFER
PUSHJ P,DIRWRT ;WRITE THE LAST UFD DATA BLOCK
EXCH P2,.USMBF
HRRM P2,DEVDMP##(P3) ;SAVE LOC OF EXTRA MON BUF
MOVE P4,DEVREL##(P3) ;NEW SIZE OF UFD
CAMN P4,DEVREL##(F) ;SAME AS ORIGINAL SIZE?
CAMG P1,[EXP -2*6] ;YES. AT LEAST 6 FREE SLOTS?
SETZ P1, ;YES. SET P1=0(DON'T ALLOCATE)
PUSHJ P,UFORSS## ;GET L(UFB OF SFD A.T.)
TRZ T3,NMPSFU## ;CLEAR NOISE BIT
MOVSI T4,UFPZRB## ;COMPRESSED SUCCESSFULLY
ANDCAM T4,UFBZRB##(T3) ;BLOCK OF ZEROES IS GONE
MOVE P2,DEVPPN(F) ;IN CASE IT IS H OR SFD
TRZE T2,NMPSFU## ;SFD?
JRST [PUSHJ P,GETCB## ;YES, JUST UPDATE ACCWRT
JRST UFDCMA]
MOVE T3,T2 ;NO, GET LOC IN T3
DPB P4,UFYWRT## ;SAVE NEW NO OF BLOCKS WRITTEN
MOVE P2,DEVACC##(F) ;GET (NEW) PPB NAME
MOVE P2,ACCPPB##(P2) ; AND SAVE IN DEVPPN FOR UFDACC
MOVE P2,PPBNAM##(P2)
EXCH P2,DEVPPN(F)
PUSHJ P,UFDACC ;FIND THE UFD NMB IN [1,1]
UFDCMA: MOVEM P4,ACCWRT##(T2) ;%SAVE UPDATED SIZE IN NMB
MOVEM P2,DEVPPN(F) ;RESTORE OLD PPN
PUSHJ P,GVCBJ## ;%GIVE UP CB RESOURCE
UFDCMB: JSP T4,RIBUN## ;SET U TO UNIT OF UFD RIB
PUSHJ P,UFDCRD ;READ THE RIB
JRST UFDCMC ;CAN'T READ IT
LSH P4,BLKLSH## ;COMPUTE NO WDS IN UFD
MOVEM P4,RIBSIZ##+1(T1) ;SAVE IN RIB
MOVE T3,RIBSTS##+1(T1) ;GET STATUS BITS
TRZN T3,RIPCBS## ;TURN OFF RIBCBS
TRZ T3,RIPCMP## ;BUT NOT RIPCMP IF IT WAS ON GNTRY
MOVEM T3,RIBSTS##+1(T1) ;REPLACE BITS
PUSHJ P,MONWRT## ;AND GO REWRITE THE RIB
;STILL IN FTDUFC CONDITIONAL
UFDCMC: EXCH P3,F ;SET F=L(EXTRA DDB)
HRRZ T1,DEVDMP##(F) ;LOC OF EXTRA MON BUF
PUSHJ P,GVMNBF ;RETURN 2ND MONITOR BUFFER
HRRZ U,DEVUNI##(F) ;SAVE UNIT OF LAST UFD BLOCK
MOVE P2,DEVBLK##(F) ;AND NO OF THE BLOCK
PUSHJ P,CLRDDB ;RETURN THE EXTRA DDB
MOVE F,P3 ;RESTORE F
JUMPN P1,CPOPJ1## ;GO IF HAVE TO ALLOCATE MORE BLOCKS
MOVE T2,P2 ;DON'T ALLOCATE - BLOCK TO WRITE
PJRST STORU## ;SAVE UNIT TO WRITE THE BLOCK AND NON-SKIP
;HERE IF NO ROOM FOR ANOTHER DDB
UFDCMD: MOVE F,P3
PJRST CPOPJ1##
;SUBROUTINE TO WRITE A UFD BLOCK
;WRITES THE MONITOR BUFFER WHOSE ADDR IS IN THE EXTRA DDB (POINTED TO BY P3)
DIRWRT: EXCH P3,F ;SAVE F, SET UP OTHER DDB
HRRZ U,DEVUNI##(F) ;UNIT OF UFD DATA
SETZM DEVNAM(F) ;DEVNAM=0 - WRITE UFD BLOCK
PUSHJ P,DIRRED## ;GO WRITE THE BLOCK
HRRZ T1,DEVLFT##(F) ;NO OF BLOCKS LEFT IN POINTER
SOJGE T1,DIRWR1 ;GO IF THERE IS ANOTHER BLOCK
;HERE IF THE PNTR IS EXHAUSTED
;CALL DIRRED ONCE MORE TO SET UP NEXT PNTR
;(MAY HAVE TO READ THE RIB INTO MON BUF)
SETOM DEVNAM(F) ;SO DIRRED WON'T WRITE
PUSHJ P,DIRRED## ;GO SET UP NEXT PNTR
JFCL ;DIRRED RETURNS CPOPJ1
SOS DEVBLK##(F) ;RESET THE DDB LOCS WHICH DIRRED CHANGED
SOS DEVREL##(F) ; (THESE LOCS ARE BUMPED BEFORE WRITING)
AOS DEVLFT##(F)
DIRWR1: EXCH P3,F ;RESTORE F
HRRZ U,DEVUNI##(F) ; AND U
POPJ P, ;AND EXIT
;STILL IN FTDUFC CONDITIONAL
;ROUTINE TO TEST IF IT'S OK TO COMPRESS
;DON'T COMPRESS IF SOMEBODY IS READING THE DIRECTORY AS A FILE.
;IT'LL SCREW UP HIS WILDCARD ROUTINE.
;T2 PASSES UFB OR SFD ACC
;CPOPJ IF NOT OK TO COMPRESS
;CPOPJ1 IF OK
;RULES:
;1. DON'T CALL CMPOK EXCEPT AS A LAST DITCH BEFORE
;YOU COMPRESS. (CMPOK IS SLOW).
;2. IF CMPOK SAYS DON'T COMPRESS, THEN TRY EVERYTHING
;POSSIBLE BEFORE ALLOCATING MORE DIRECTORY BLOCKS.
CMPOK: TRZN T2,NMPSFU## ;SFD OR UFD?
JRST CMPOK1 ;UFD
PUSHJ P,GETCB## ;SFD, GET INTERLOCK
LDB T1,ACZCNT## ;%GET USE COUNT
SOJE T1,GVCBJ1## ;%COMPRESS IF WE'RE THE ONLY GUY
CMPOK2: HLRZ T2,ACCNMB##(T2) ;%FIND NMB
TRZN T2,DIFNAL##
JRST CMPOK2
MOVE T3,NMBCNT##(T2) ;%COUNT UP ONLY BECAUSE SET PATH?
SOJE T3,GVCBJ1## ;%SET PATH DOESN'T BUMP NMBCNT
;NMBCNT IS PROBABLY WRONG AGAIN, DOUBLE CHECK.
MOVE T3,HIGHJB## ;%HIGHEST JOB IN USE
CMPOK3: HRRZ T4,JBTSFD##(T3) ;%DOES JOB HAVE PATH SET HERE?
TRZ T4,CORXTR##
CAMN T2,T4
SOJE T1,GVCBJ1## ;%YES, COMPRESS IF ALL ACCOUNTED FOR
SOJG T3,CMPOK3 ;%NO, TEST NEXT JOB
PJRST GVCBJ## ;%SOMEBODY LEFT, DON'T COMPRESS
CMPOK1: PUSHJ P,UFDACC ;FIND THE UFD'S ACC
SKIPA T1,ACCCNT##(T2) ;%PICK UP THE USE COUNT
PJRST GVCBJ1## ;%NO ACC, NO READER, COMPRESS
TRNN T1,ACMCNT ;%IS THERE A READER?
AOS (P) ;%NO, COMPRESS
PJRST GVCBJ##
;RELEASE UUO
DSKREL: PUSHJ P,WAIT1## ;WAIT FOR I/O TO STOP
PUSHJ P,NULTST ;IF NULL
POPJ P, ; DONT DO ANYTHING
MOVE J,.CPJOB## ;SET J FOR RETRES
IFN FTFDAE,<
PUSHJ P,CHKFCU ;CHECK IF AT COUNT UP FOR FILDAE
>
PUSHJ P,RETRES## ;RETURN ANY RESOURCES DDB HAS
;IN CASE OF ERROR RE-ENTRY)
SKIPGE DEVSPL(F) ;SPOOLING DEVICE?
TLOE S,IOSRST ;YES, DO A CLOSE INSTEAD OF A RELEASE
; (BUT IF ERROR, NEXT RELEASE WILL RESET)
TLO F,RESETB ;INDICATE RESET IN PROGRESS
PUSHJ P,GTMNBF## ;COULD HAVE GIVEN IT UP ON A KJOB
PUSHJ P,CLOSIN ;CLOSE INPUT (IF NOT ALREADY DONE)
TLO F,ICLOSB
PUSHJ P,CLOSOU ;CLOSE OUTPUT (DITTO)
TLO F,OCLOSB
TLZE S,IOSUPR ;SUPER USETI/O?
TLNN S,IOSERR## ;YES, ANY ERRORS?
JRST DSKRL1 ;NO
;HERE TO WRITE BAT BLOCK FOR ERRORS DETECTED DURING INPUT/OUTPUT WITH SUPER USETI/O
;MUST DO AT RELEASE SINCE NO FILE IS OPEN SO CLOSE WONT WRITE THEM
MOVEM S,DEVIOS(F) ;SAVE S, IOSUPR OFF
PUSHJ P,SETU## ;WRITE BAT BLOCK SINCE CLOSE DID NOT
JRST DSKRL1 ;IF F/S JERKED, OR OUTPUT CLOSE DONE
MOVSI T1,UNPHWP ;DON'T TRY TO UPDATE BAT BLOCK
TDNE T1,UNIDES(U) ;IF THE UNIT IS HARDWARE WRITE PROT.
JRST DSKRL1 ;IT IS SO FORGET IT
MOVEI T1,DEPDER ;IF ERROR RECOVERY HAS BEEN DISABLED,
TDNE T1,DEVSTA(F) ; ...
JRST DSKRL1 ;THEN DON'T MESS WITH BAT BLOCKS
PUSHJ P,TSTBAD ;FIND EXTENT OF BAD REGION
MOVE T1,.USMBF ;LOC OF MON BUF
HRRZ T2,RIBNBB##+1(T1) ;NO OF BAD BLOCKS
MOVE T1,DEVELB##(F) ;FIRST BAD BLOCK
TLZ T1,BATMSK## ;ONLY BLOCK NUMBER
JUMPE T1,DSKRL0
HRRZ T3,UNISTR(U) ;DONT ALLOCATE IF NOT IN A STR
JUMPE T3,DSKRL0
PUSHJ P,TAKBLK## ;ALLOCATE THEM IF POSSIBLE
JFCL ; (SO WONT BE GIVEN UP AGAIN)
DSKRL0: PUSHJ P,ERRFIN ;WRITE BAT BLOCKS
TLZ S,IOSERR## ;NO BAD BLOCKS NOW
DSKRL1: TLZ F,RESETB ;RESET BIT
SETZM DEVFIL(F) ;INDICATE FILE RELEASED
SETZM DEVUFB##(F) ;ZERO DEVUFB SO UFDLK WILL WORK RIGHT
SETZM DEVREL##(F) ;ZERO DEVREL SO SUPER USETI WILL WORK RIGHT
SETZM DEVPPN(F) ;ZERO DEVPPN SO SPTSTO/I WILL WORK RIGHT
SETZM DEVSFD##(F) ;ZERO DEVSFD SO NO SFD TO START
SETZM DEVELB##(F) ;ZERO DEVELB SO NEXT ERROR WILL GET IN BAT BLOCK
HLLZS DEVCPY##(F) ;SUPERSTITION
TLZ S,IOSWLK!IOSUPR!IOSRST!IOSMON ;ZERO SOME BITS
MOVSI T1,DEPLIB## ;CLEAR DEPLIB IN DDB
ANDCAM T1,DEVLIB##(F)
MOVEI T1,DEPPAL## ;CLEAR PRE-ALLOCATING FILE
ANDCAM T1,DEVPAL##(F)
PJRST STOIOS## ;SAVE IN DDB AND RETURN
;ROUTINE TO WRITE A DIRECTORY BLOCK
WRTDIR: MOVE T1,.USMBF ;IOWD FOR MONITOR BUFFER
MOVE T2,DEVBLK##(F) ;BLOCK NUMBER
;PJRST WRTUFD ;GO WRITE THE UPDATED UFD
;SUBROUTINE TO WRITE A UFD BLOCK
;ENTER WITH AC'S, DATA SET AS FOR MONWRT
WRTUFD: TLZ S,IOSFIR ;MAKE SURE IOSFIR IS OFF
PJRST MONWRT## ;WRITE UFD
IFN FTFDAE,<
;SUBROUTINE TO CHECK IF AT COUNT IS UP
;IF SO, DECREMENT COUNT
CHKFCU: MOVSI T1,DEPFCU##
TDNN T1,DEVFCU##(F) ;COUNT UP?
POPJ P, ;NO
ANDCAM T1,DEVFCU##(F) ;YES, BUT NO LONGER
PUSHJ P,DECRDR ;DECR COUNT
JUMPN T1,GVCBJ## ;%EXIT IF OTHER READERS
JUMPE T1,CPOPJ## ;%DON'T HAVE CB IF NO AT
SKIPN ACCDOR##(T1) ;%ALREADY DORMANT?
JRST ATSDRA## ;%NO, MAKE DORMANT
PJRST GVCBJ## ;%AND RETURN
>
;SUBROUTINE TO FIND THE ACCESS TABLE FOR A UFD
;ASSUMES PRJ,PRG IS IN DEVPPN - UFD JUST READ UNDER [1,1]
;RETURNS CPOPJ IF FOUND, WITH T2=LOC OF A.T.; CPOPJ1 IF NOT FOUND
;ALWAYS RETURNS WITH THE CB RESOURCE
UFDACC: MOVE T1,MFDPPN## ;PPN FOR UFD'S
PUSHJ P,GETCB## ;GET CB RESOURCE
HLRZ T2,SYSPPB## ;%START OF UFD BLOCKS
PUSHJ P,LSTSCN## ;%SEARCH FOR THIS MFD PPB
JRST CPOPJ1## ;%NOT THERE
HLRZ T2,PPBNMB##(T2) ;%START OF NMBS UNDER MFD
MOVE T1,DEVACC##(F) ;%GET PPN FROM A.T.
MOVE T1,ACCPPB##(T1) ;% (DEVPPN "WRONG" IF RENAMING
MOVE T1,PPBNAM##(T1) ;%ACROSS DIRECTORIES)
SETO T3, ;%INDICATE DON'T CREATE NMB IF NOT FOUND
UFDAC1: PUSHJ P,LSTSRA## ;%SEARCH FOR IT
JRST CPOPJ1## ;%NOT THERE
HRRZ T3,NMBEXT##(T2) ;%EXTENSION
CAIN T3,(SIXBIT .UFD.) ;%IS IT "UFD"?
JRST UFDAC2 ;%YES. OK
HLRZ T2,NMBPPB##(T2) ;%NO. IGNORE THE ENTRY
TRNE T2,NMPUPT## ;%IS IT A REAL NMBPPB POINTER?
PJRST CPOPJ1## ;%NO, RETURN (UPWARD PNTR TO FATHER SFD)
JRST UFDAC1 ;%YES, SCAN FOR ANOTHER JBTPPN NAME BLOCK
UFDAC2: HLRZ T2,NMBACC##(T2) ;%FOUND NMB FOR THIS UFD. LOC OF 1ST A.T.
MOVE T1,DEVACC##(F) ;%A.T. FOR THIS FILE
LDB T1,ACZFSN## ;%FSN OF FILE (=FSN OF UFD)
PJRST BYTSCA## ;%SEARCH FOR A.T. FOR UFD
;SUBROUTINE TO TEST IF THE PPB BLOCK IS IN USE
;IF SO,RETURN IF NOT, TEST THE UFB BLOCKS
;IF A UFB IS FOUND WHICH IS NOT CURRENTLY BEING USED BY A FILE, RETURN TO FREE CORE
;IF ALL UFB'S ARE RETURNED, RETURN THE PPB TO FREE CORE
;CALLED BY CLOSE
TSTPPB::CBDBUG (N,Y);
LDB J,PJOBN## ;JOB NUMBER
MOVE T1,JBTSTS##(J) ;STATUS WORD
TLNE T1,JACCT ;JACCT ON (PROBABLY LOGIN)?
TLNE T1,JLOG ;YES, JOB LOGGED IN?
CAIA ;YES, CAN'T BE LOGIN
POPJ P, ;NO. LEAVE CORE BLOCKS ALONE
TSTPP1: PUSHJ P,GETCB## ;GET CB RESOURCE
MOVE T1,DEVPPN(F) ;%PPN OF FILE
TSTPPX::HLRZ T2,SYSPPB## ;%NO, GET LOC OF 1ST PPB
PUSHJ P,LSTSCN## ;%SEARCH FOR PPB BLOCK
PJRST GVCBJ## ;%
TSTPP2: MOVE T1,PPBNLG##(T2) ;%LOGGED-IN WORD
SKIPN PPBCNT##(T2) ;%ANY DDBS USING PPB?
TRNE T1,PPPNLG## ;%IS PPN LOGGED IN?
PJRST GVCBJ## ;%YES. GIVE UP CB AND RETURN
PUSH P,T2 ;%NO. SAVE LOC OF PPB
CAMN T3,[-1] ;%FIRST PPB?
MOVEI T3,SYSPPB## ;%YES, SET PREDECESSOR
HRLM T3,(P) ;%SAVE LOC OF PREDECESSOR
MOVEI T3,DIFPBC##(T2) ;%PPB=PRED OF 1ST UFB
HLRZ T4,PPBUFB##(T2) ;%LOC OF 1ST UFB IN PPB
JUMPE T4,TSTPP4 ;%NONE IF 0
TSTPP3: HLL T4,CORLNK##(T4) ;%SAVE LINK TO NEXT UFB
PUSHJ P,RET4WD ;%NO, DELETE THIS UFB
HLRZS T4 ;%NEXT UFB INTO T4
JUMPN T4,TSTPP3 ;%TEST IT IF IT EXISTS
TSTPP4: POP P,T1 ;%LOC OF PPB
HLRZ T2,PPBNMB##(T1) ;%LOC OF 1ST NMB UNDER PPB
PUSHJ P,SAVE2## ;%SAVE P1,P2
PUSH P,T1 ;%SAVE LOC OF PPB 1ST ON PD LIST
SKIPA P1,T2 ;%P1=LOC OF 1ST NMB
TSTPP5: HLRZS P1 ;%NEXT NMB
TRZE P1,NMPUPT## ;%IS IT A PNTR TO A FATHER SFD?
JRST TSTPP7 ;%YES, GO CHECK FATHER
TSTPP6: JUMPE P1,TSTPP9 ;%NO NMBS - DELETE PPB
HLRZ T3,NMBRNG##(P1) ;%NMB FOR AN SFD?
JUMPE T3,TSTPP7 ;%NO, CONTINUE
MOVE P1,T3 ;%YES, DOES IT POINT TO ANOTHER NMB LIST?
TRZN P1,NMPUPT## ;%
JRST TSTPP6 ;%YES, TURN DOWN THAT CHAIN
;HERE WHEN THE NMB IS REMOVABLE
TSTPP7: HLRZ T1,NMBACC##(P1) ;%LOC OF 1ST A.T. ON NMB RING
TRNE T1,DIFNAL## ;%1-ITEM RING?
JRST TSTPP8 ;%YES. ALL A.T.'S GIVEN UP
PUSH P,F ;%NO, SAVE F
MOVEI F,0 ;%INDICATE DONT MESS WITH CB RESOURCE
PUSHJ P,ATRMOV## ;%REMOVE THE ACCESS TABLE
POP P,F ;%RESTORE F
JUMPE F,TSTPP7 ;%CANT BE OUR AT IF DEVACC =0
HRRZ T2,DEVACC##(F) ;%OUT A.T.
CAIN T2,(T1) ;%DID WE REMOVE THE AT FOR THIS DDB?
HLLZS DEVACC##(F) ;YES, CLEAR DEVACC
JRST TSTPP7 ;%AND GO TEST NEXT AT IN THE RING
TSTPP8: HLL T1,SYSCOR## ;%CURRENT 1ST FREE CORE BLOCK
HRLM P1,SYSCOR## ;%THIS NMB IS NEW 1ST FREE
HLL P1,NMBPPB##(P1) ;%LH(P1)=LOC OF NEXT NMB
HLLM T1,CORLNK##(P1) ;%LINK PREVIOUS 1ST FREE TO THIS
JRST TSTPP5 ;%AND GO DELET NEXT NMB RING
TSTPP9: POP P,T4 ;%LOC OF PPB
SKIPE PPBLOK##(T4) ;%ANY INTERLOCKS SET?
PJRST TSTP10 ;%YES, LEAVE PPB ALONE
HLRZ T3,T4 ;%PRED OF PPB
CAIN T3,SYSPPB## ;%PRED=SYSPPB?
SUBI T3,CORLNK## ;%YES. ADJUST PREDECESSOR
PUSHJ P,RET4WD ;%RETURN PPB TO FREE CORE
HRRZ T2,SYSPPB## ;%PPB THE CORE GRABBER WILL LOOK AT NEXT
CAIN T2,(T4) ;%DID WE JUST DELETE IT?
HLLZS SYSPPB## ;%YES, START AT 1ST PPB NEXT TIME
CBDBUG (Y,Y);
PJRST GVCBJ## ;%GIVE UP CB RESOURCE AND RETURN
;HERE IF INTERLOCKS SET IN PPB
TSTP10: SETZM PPBNMB##(T4) ;%DON'T LEAVE FUNNY LINKS
SETZM PPBUFB##(T4) ;% HANGING AROUND IN DATABASE
PJRST GVCBJ##
;SUBROUTINE TO RETURN A 4-WORD BLOCK TO FREE CORE.
;THIS ROUTINE LINKS THE PREDECESSOR BLOCK AROUND THE BLOCK BEING RETURNED
;ENTER WITH T4=LOC OF BLOCK TO RETURN, T3=LOC OF PREDECESSOR
;ENTER AT RETXWD IF DONT CARE ABOUT PREDECESSOR LINK
RETXWD: MOVE T3,T4 ;%MAKE SURE DONT CLOBBER ANYTHING WITH T3
RET4WD::MOVE T1,CORLNK##(T4) ;%LINK TO NEXT BLOCK
HLLM T1,CORLNK##(T3) ;%SAVE AS LINK IN PREDECESSOR
MOVE T1,SYSCOR## ;%1ST FREE CORE BLOCK
HRLM T4,SYSCOR## ;%SAVE THIS AS 1ST BLOCK
HLLM T1,CORLNK##(T4) ;%LINK PREVIOUS 1ST TO THIS ONE
POPJ P, ;%AND RETURN
SUBTTL LOOKUP
ULOOK: PUSHJ P,NULTST ;ON DEVICE NUL,
PJRST CPOPJ1## ; LOOKUP WINS
SKIPGE DEVSPL(F) ;SPOOL-MODE?
PJRST CPOPJ1## ;YES, OK RETURN
TLNE F,ENTRB ;ENTER IN FORCE?
JRST LUKER1 ;YES. ERROR RETURN
SETZM DEVSFD##(F)
TLZ F,INPB ;MIGHT BE ON FROM SUPER I/O
SETZM DEVLNM##(F) ;NOT A LOGICAL NAME TO START WITH
PUSHJ P,SAVE4## ;SAVE ACS (SETLER RETURNS STUFF IN P3,P4)
PUSHJ P,SETLER ;NO, SET UP UUO FOR LOOKUP
JRST ILNMER ;ILLEGAL NAME - ERROR RETURN
MOVSI T2,DEPLIB## ;MAKE SURE DEPLIB IS OFF
ANDCAM T2,DEVLIB##(F) ; SO UPDATE WILL WIN
SKIPE DEVLNM##(F) ;IF A LOGICAL NAME
TLZ F,SYSDEV ;NOT FROM SYS (YET)
MOVSI T2,DEPFFS##!DEPFFL## ;CLEAR FOUND BY SCANNING, FOUND IN LIB
ANDCAM T2,DEVPTB##(F) ; BITS FROM THE DDB
PUSH P,[-1,,0] ;INITIALIZE ERROR - SAVE
TLOA M,UUOLUK
ULOOK2: TLO M,UTRTWC
PUSHJ P,SETSRC## ;SET UP SEARCH LIST IN T1
JRST [SKIPN DEVLNM##(F)
JRST ULOO20
MOVEI T1,SLEERR
JRST ULOOK4]
ULOOK3: TLO M,UUOLUK ;INSURE FNDFIL KNOWS
MOVE T2,T1 ;SEARCH LIST INTO T2
TLZ S,IOSWLK ;MAKE SURE IOSWLK OFF (IN CASE OF RENAME)
PUSHJ P,FNDFIL## ;SEARCH FOR FILE NAME
SKIPA ;ERROR
JRST FOUND ;FILE FOUND
;HERE ON AN ERROR RETURN FROM FNDFIL
SETZM DEVUNI##(F) ;ZERO DEVUNI SO THAT UNILUP WILL WORK RIGHT IF AN
; ENTER IS DONE (IT POINTS TO UFD-UNIT NOW)
SETZM DEVUFB##(F) ;ZERO DEVUFB SO TSTPPB WILL WORK RIGHT
SKIPGE DEVSPL(F) ;SPOOL MODE?
POPJ P, ;YES, IMMEDIATE RETURN
CAIE T1,TRNERR
CAIN T1,PRTERR
SETZM (P)
ULOOK4: HRRM T1,(P)
PUSHJ P,TSTPPB ;DELETE USELESS CORE BLOCKS
SKIPL (P)
JRST ULOO15
HRRZ T1,DEVSFD##(F) ;SCAN - GET LOC OF SFD
JUMPE T1,ULOOK7 ;DONE IF 0 (JUST SEARCHED UFD)
PUSHJ P,SFDDEC
LDB T2,DEYSCN## ;SCANNING SWITCH
JUMPE T2,ULOOK6 ;DON'T SCAN IF 0
MOVSI T2,DEPFFS## ;SET FILE-FOUND-BY-SCANNING BIT IN DDB
IORM T2,DEVPTB##(F) ;(WILL CLEAR IF NOT FOUND)
PUSHJ P,DECALL ;DECR. USE-COUNTS OF THIS SFD
ULOOK5: HLRZ T1,NMBPPB##(T1) ;SCAN FOR POINTER TO FATHER SFD
TRZN T1,NMPUPT##
JUMPN T1,ULOOK5
HRRM T1,DEVSFD##(F) ;FOUND - SAVE AS CURRENT SFD
SKIPE T1 ;UFD ITSELF?
PUSHJ P,INCALL ;NO, INCR. USE-COUNTS OF A.T.'S
PUSHJ P,SFDUP
JRST ULOOK2 ;AND RETRY THE LOOKUP IN THIS DIRECTORY
ULOOK6: HRRZ T1,DEVSFD##(F) ;IF AN SFD IS DEFAULT PATH
JUMPE T1,ULOOK7 ; AND SCAN IS OFF
PUSHJ P,DECALL ;DECR SFD USE-COUNTS
ULOOK7: SETZM DEVSFD##(F) ;SO LIB WILL BE SEARCHED
MOVSI T2,DEPFFS## ;DIDN'T FIND IT BY SCANNING
ANDCAM T2,DEVPTB##(F)
SKIPL (P) ;ARE WE REMEMBERING AN ERROR?
JRST ULOO15 ;YES, DON'T TRY LOGICAL NAMES
SKIPN DEVLNM##(F) ;NO, LOOKING AT LOGICAL NAME?
JRST ULOOK8 ;NO, SEE IF /SYS
PUSHJ P,NXTSPC ;YES, GET NEXT PART OF SPECIFICATION
JRST ULOOK2 ;TRY LOOKUP ON THIS PPN/SFD
SETZM DEVLNM##(F) ;AT END OF SPEC - NOT IN TTHIS LOG NAME
JRST ULOO10 ;SEE IF /SYS WANTED
ULOOK8: MOVSI T2,'SYS'
CAMN T2,DEVNAM(F) ;IF LOOKUP SYS:FILE TRIED NEW:
JRST ULOO12 ; THEN TRY SYS: WITHOUT DEPLIB
SUB T2,DEVLOG(F) ;T2 = 0 IF LOGICAL SYS
MOVSI T1,DEPPP0##
TDZE T1,DEVPP0##(F) ;WAS E+3=0 ON LOOKUP?
JUMPN T2,ULOO20 ;NO, NO LIB/SYS IF NOT LOGICAL SYS
HLR T2,T1 ;T2=0 IF LOGICAL SYS, NOT DSK=SYS
MOVE T1,DEVLLE##(F) ;HOW WE HANDLE LIB
TLNE T1,DEPDSL## ;DON'T SEARCH IT (OR SYS?)
JRST ULOO20 ;YES, LOOKUP FAILS
TLNE T1,DEPAUL## ;ALLOW UPDATE/RENAME IN LIB?
TDZA T1,T1 ;YES, DON'T LIGHT DEPLIB
MOVSI T1,DEPLIB## ;INDICATE FROM LIB/SYS
ORM T1,DEVLIB##(F) ;IN CASE THIS LOOKUP WINS
; (IN CASE OF UPDATE)
TLNE F,SYSDEV ;SYSTEM?
JRST ULOO12 ;YES
JUMPE T2,ULOO10 ;SEARCH SYS IF LOGICAL SYS
SKIPN T1,.PDOSL##(W) ;IS THERE AN OLD-STYLE LIB?
JRST ULOOK9
CAMN T1,DEVPPN(F) ;YES. ALREADY SEARCHED IT?
JRST ULOO10 ;YES, TRY SYS
MOVEM T1,DEVPPN(F) ;NO, SEARCH IT NOW
JRST ULOOK2
ULOOK9: MOVE T1,DEVNAM(F) ;SEARCH LIB IF OPEN WAS
PUSHJ P,ALIASD## ; DONE ON "DSK"
PUSHJ P,FNDLB ;IS THERE A LIB?
JRST ULOO10 ;NO, TEST IF /SYS
MOVSI T1,DEPFFL## ;LIGHT FILE-FOUND-IN-LIB
IORM T1,DEVPTB##(F) ; SINCE ITS EITHER IN LIB/SYS OR LOOKUP FAILS
MOVE T1,@.USLNM ;YES, POINT AT LIB SPEC
ADDI T1,LNMDEV##-LNRDEV##
HRRZM T1,DEVLNM##(F) ;SAVE IT IN THE DDB
PUSHJ P,NXTSP3 ;POINT AT START OF THE SPEC
JRST ULOOK2 ;GO LOOKUP FILE IN THIS PPB
;HERE IF DSK AND LIB ARE DONE, TRY SYS:
ULOO10: HLRZ T1,JBTSFD##(J) ;LIB, SYS BITS
TRNN T1,JBPSYS## ;USER WANT TO LOOKUP SYS:?
JRST ULOO14 ;NO, FILE NOT FOUND
MOVE T2,NEWPPN## ;YES, GET NEW: PPN
TRNE T1,JBPXSY## ;WANT NEW:?
CAMN T2,DEVPPN(F) ;YES, HAVE WE TRIED IT ALREADY?
MOVE T2,SYSPPN## ;YES, TRY REAL SYS
TLO F,SYSDEV ; AND SAY ITS REAL
ULOO11: MOVEM T2,DEVPPN(F) ;SAVE SYS OR NEW PPN
MOVE T1,DEVNAM(F) ;ARGUMENT FOR ALIASD
PUSHJ P,ALIASD## ;IS THIS "DSK"?
SKIPA ;YES, USE SYSTEM 'SL
PUSHJ P,SETSRC## ;NO, GET SEARCH LIST FROM DEVICE NAME
MOVE T1,SYSSRC##
MOVSI T2,DEPFFL## ;LIGHT FOUND-IN-LIB
IORM T2,DEVPTB##(F) ; SINCE ITS EITHER IN SYS OR LOOKUP FAILS
MOVE T2,T1 ;FNDFIL WANTS T2=SEARCH LIST
PUSHJ P,FNDFIL## ;LOOKUP THE FILE
ULOO12: SKIPA T2,SYSPPN## ;DIDN'T FIND IT
JRST FOUND ;FOUND - FINISH UP
TLNE F,SYSDEV ;IF SYS (NEW)
JUMPE T1,ULOO13 ;DON'T REMEMBER FNF ERROR
SKIPGE (P) ;ERROR CODE STORED? (NOT IF FNF ON SYS:)
TLNE T1,-1 ;NO, ERROR RETURN FROM FNDFIL?
CAIA ;NO
MOVEM T1,(P) ;YES, STORE ERROR NOW
ULOO13: CAME T2,DEVPPN(F) ;TRIED SYS?
JRST ULOO11 ;NO, TRY IT NOW
ULOO14: TLNE M,UTRTWC
SETZM (P)
ULOO15: PUSH P,M ;SAVE M
PUSHJ P,GETWDU## ;GET E+3
TLNN T1,-1 ;PATH POINTER ?
HRRI M,2(T1) ;YES, POINT AT PPN WRD
HRRZ T1,-1(P) ;GET THE ERROR CODE
CAIE T1,TRNERR ;RIB ERROR
CAIN T1,PRTERR ; OR PROTECTION FAILURE?
SKIPA T1,DEVPPN(F) ;YES, STORE THE PPN IN THE LOOKUP BLOCK
SETZ T1, ;NO, ZERO PPN WORD ON LOOKUP FAILURE
PUSHJ P,PUTWDU##
SETZM DEVPPN(F) ;SO PATH. WILL WIN
JUMPE T1,ULOO19 ;DON'T STORE PATH IF NO PPN
CAMN M,(P) ;ARE WE FILLING IN A PATH BLOCK?
JRST ULOO19 ;NO. ALL DONE THEN.
PUSH P,[0] ;YES, PUT A MARKER ON THE STACK
HRRZ T2,DEVSFD##(F) ;GET THE FIRST SFD NMB POINTER
JUMPE T2,ULOO18 ;JUMP IF NO SFD
ULOO16: PUSH P,NMBNAM##(T2) ;SAVE THE SFD NAME
ULOO17: HLRZ T2,NMBPPB##(T2) ;GET THE NEXT NMB LINK
TRZN T2,NMPUPT## ;POINTER TO THE NEXT HIGHER LEVEL?
JUMPN T2,ULOO17 ;NO, TRY NEXT
JUMPN T2,ULOO16 ;YES, REMEMBER THIS ONE
ULOO18: POP P,T1 ;RESTORE AN SFD NAME
PUSHJ P,PUTWD1## ;STORE THE SFD NAME IN THE PATH BLOCK
JUMPN T1,ULOO18 ;DO ALL OF THEM.
ULOO19: POP P,M
ULOO20: POP P,T1 ;RESTORE ERROR CODE
PJRST LKENR4 ;AND GO TELL USER
;HERE WHEN FILE NAME IS FOUND ON LOOKUP
;HERE WITH M AT PPN
FOUND: MOVE J,.CPJOB## ;JOB
MOVE T1,JBTSTS##(J)
MOVE T2,DEVFIL(F) ;FILE NAME WE LOOKED UP
TRNE T1,JS.ASA ;MONITOR DO THE LOOKUP (SAVGET)?
MOVEM T2,.JDAT+SGANAM## ;YES. MAKE SURE WE KNOW THE REAL FILE
PUSHJ P,SDVTSS ;UDPATE SYSDEV BIT
PUSHJ P,CMPSLP ;WAIT TILL UFD COMPRESSOR IS DONE
HRRZ T2,DEVACC##(F) ;LOC OF A.T. ENTRY
MOVE T3,T2 ;INTO T3 ALSO
SKIPGE DEVSPL(F) ;SPOOL-MODE?
JRST FOUND3 ;YES, DON'T STORE IN USER AREA
POP P,(P) ;REMOVE "ERROR CODE" FROM LIST
TLNE M,EXTUUO ;EXTENDED UUO?
JRST FOUND2 ;YES
PUSHJ P,WRDCNT ;SAVE LENGTH IN E+3
HRRI M,-<UUNPPN-UUNATT>(M) ;POINT TO ATTRIBUTES WORD
MOVE T1,ACCPRV##(T3) ;DATE AND TIME WORD
PUSHJ P,PUTWDU##
HRRI M,-<UUNATT-UUNEXT>(M) ;POINT M TO ACCESS DATE WORD
PUSHJ P,GTWST2## ;GET ACCESS DATE WORD
HLR T1,ACCADT##(T3) ;ACCESS DATE
PUSHJ P,PUTWDU## ;STORE IT IN THE USER'S AREA
HRRI M,UUNPPN-UUNEXT(M) ;BACK TO PPN
JRST FOUND3 ;FINISH UP (RIB DOESN'T HAVE TO BE READ)
;SUBROUTINE TO COMPUTE THE CONTENTS OF E+3 FOR LOOKUP/UPDATE ENTER
;EXITS T1=E+3 WORD (ALSO STORED IN USERS AREA)
; T2, T3=LOC OF A.T.
WRDCNT: HRRZ T2,DEVACC##(F) ;AT LOC INTO T2
MOVE T3,T2 ;AND T3
SKIPE T1,ACCWRT##(T2) ;GET HIGHEST WRITTEN BLOCK
SUBI T1,1 ;LAST BLOCK WILL BE COUNTED SEPERATELY
CAIL T1,2000 ;GT 2^17 WORDS?
AOJA T1,FOUND1 ;YES, STORE +BLOCK COUNT
LSH T1,BLKLSH## ;NO, CONVERT TO WORDS
LDB T4,ACZLBS## ;GET NO. OF WORDS IN LAST BLOCK
ADD T1,T4 ;ADD INTO TOTAL NUMBER OF WORDS
MOVNS T1 ;STORE -N IN LH
FOUND1: HRLZS T1
PJRST PUTWDU## ;STORE LENGTH IN E+3 AND RETURN
;HERE WHEN FILE IS FOUND FOR AN EXTENDED LOOKUP
FOUND2: HRRI M,-UUXPPN(M)
PUSHJ P,GTWST2## ;NUMBER OF ARGUMENTS
MOVE P1,T1
TRZ P1,RB.BIT ;CLEAR FLAG BITS
HRRI M,UUXPPN(M) ;POINT TO PPN WORD
PUSH P,M
PUSHJ P,GETWDU## ;GET PPN/SFD LIST WORD
TLNN T1,-1 ;IS IT AN SFD POINTER?
HRRI M,2(T1) ;YES. POINT M TO REAL PPN WORD
MOVE T1,DEVPPN(F) ;GET PPN (MIGHT BE LIB,SYS,NEW)
PUSHJ P,PUTWDU## ;TELL USER REAL PPN
POP P,M
CAIGE P1,4 ;STORE VALUES?
JRST FOUND3 ;NO. FINISH UP
HRRI M,UUXPRV-UUXPPN(M) ;YES. POINT TO PRIVS WORD
MOVE T1,ACCPRV##(T3) ;PRIVILEGES WORD
PUSHJ P,PUTWDU## ;SAVE IN USERS AREA
HRRI M,-<UUXPRV-UUXEXT>(M) ;POINT TO ACCESS DATE WORD
PUSHJ P,GTWST2## ;GET ACCESS DATE WORD
HLR T1,ACCADT##(T3) ;ACCESS DATE
PUSHJ P,PUTWDU## ;STORE IT IN THE USER'S AREA
HRRI M,UUXSIZ-UUXEXT(M) ;POINT TO LENGTH WORD
SKIPE T1,ACCWRT##(T2) ;LENGTH
SUBI T1,1 ;LAST BLOCK WILL BE COUNTED SEPERATELY
LSH T1,BLKLSH## ;CONVERT TO WORDS
LDB T4,ACZLBS## ;NUMBER OF WORDS IN LAST BLOCK
ADD T1,T4 ;=TOTAL NUMBER OF WORDS IN FILE
CAILE P1,UUXPRV ;WANT LENGTH IN DIRECTORY BLOCK?
PUSHJ P,PUTWDU## ;YES. SAVE IT
HRRI M,UUXPPN-UUXSIZ(M) ;BACK TO PPN
CAILE P1,UUXSIZ ;NEED MORE VALUES?
JRST FOUND4 ;YES. GO READ RIB
;HERE TO FINISH UP A LOOKUP IF THE RIB DOESN'T HAVE TO BE READ
;HERE WITH M AT PPN
FOUND3: TLZ S,IO ;INDICATE READING
PUSHJ P,AT2DDB## ;SET DEVREL, ETC FROM A.T. DATA
JRST LKRIB ;ACCESS TABLE DATA IS BADLY FOULED UP!
JRST LKXIT ;GIVE UP MON BUF AND GOOD RETURN
;HERE WHEN USER WANTS MORE VALUES THAN ARE STORED IN ACCESS TABLE
;READ RIB (IF IT ISN'T ALREADY IN CORE)
FOUND4: PUSH P,M ;SAVE ADDR OF PPN
HRRI M,RIBVER##-RIBPPN##(M)
TLNE S,IOSRIB ;JOB HAVE RIB IN MONITOR BUFFER?
JRST FOUND5 ;YES
MOVE T1,ACCUN1##(T3) ;UN1 WORD
LDB T2,UN1PTR## ;UNIT NUMBER
PUSHJ P,NEWUNI## ;SET U,DEVUNI
JRST FOUND7 ;BAD UNIT - MAKE DO WITH DATA FROM A.T.
HRLM U,DEVUNI##(F) ;SAVE AS RIB UNIT NO.
PUSHJ P,BUFRIB## ;GET MON BUF, READ RIB INTO IT
JRST FOUND7 ;RIB ERR - GIVE DATA FROM A.T.
;HERE WITH FILE RIB IN CORE
FOUND5: HRRZ T2,.USMBF ;LOC OF MONITOR BUF
HRRZ T1,RIBFIR##+1(T2);NO OF VALUES IN RIB
HRRZ P2,P1 ;NUMBER OF ARGS USER WANTS
CAIL P2,UUXACT ;WANT ACCOUNT STRING?
CAIGE T1,UUXACT ;YES, IS THERE ONE IN THE RIB?
JRST FND5A ;NO
SUBI P2,UUXACT ;YES, NO. OF ACCOUNT STRING WORDS HE WANTS
CAILE P2,MAXACS## ;WANT MORE THAN THERE POSSIBLY ARE?
MOVEI P2,MAXACS## ;YES, GIVE HIM THE MAX
MOVNS P2 ;P2 NEGATIVE NUMBER OF ARGS TO STORE
MOVE T3,RIBACT##+1(T2);AOBJN WORD FOR ACCT STRING
ADDI T3,1(T2) ;RELOCATE IT
MOVEI P1,UUXACT-1 ;ONLY STORE UP TO ACCT STRING IN 1ST LOOP
FND5A: CAILE P1,-1(T1) ;USER WANT TOO MANY?
MOVEI P1,-1(T1) ;YES, SETTLE FOR EVERYTHING
MOVE T1,UNILOG(U) ;(ALIAS) NAME OF UNIT
MOVEM T1,RIBDEV##+1(T2);STORE IN RIB IN CASE USER WANTS IT
HLRZ T1,DEVEXT(F) ;RIBUSD IS ONLY MEANINGFUL FOR UFD
CAIN T1,'UFD'
PUSHJ P,FIXUSD ;FIX RIBUSD
ADDI T2,RIBVER##+1 ;SET TO LOC OF RIBVER
MOVNI P1,-UUXSIZ(P1) ;WE ALREADY STORED UUXSIZ VALUES,
HRLI T2,(P1) ; SO SET AOBJN WORD FOR VALUES -UUXSIZ
FOUND6: MOVE T1,(T2) ;GET A NUMBER FROM RIB
PUSHJ P,PUTWDU## ;SAVE IN DIRECTORY BLOCK FOR USER
HRRI M,1(M) ;POINT TO NEXT WORD
AOBJN T2,FOUND6 ;AND CONTINUE IF MORE WANTED
JUMPGE P2,FND6C ;GO IF NO ACCOUNT STUFF TO STORE
FND6A: SKIPA T1,(T3) ;GET AN ACCOUNT-STRING WORD
FND6B: SETZ T1, ;NO MORE IN RIB, RETURN A 0
PUSHJ P,PUTWDU## ;TELL THE USER
HRRI M,1(M)
AOJGE P2,FND6C ;GO IF ALL STORED
AOBJN T3,FND6A ;GET ANOTHER VALUE IF MORE IN RIB
JRST FND6B ;NO MORE IN RIB, STORE A 0
FND6C: POP P,M ;RESTORE ADDR OF PPN
PUSHJ P,CPYFST## ;COPY POINTERS TO DDB, SET DEVBLK,ETC
JRST LKRIB ;RIB IS BADLY FOULED UP
;HERE WHEN LOOKUP ALL THROUGH
LKXIT: PUSHJ P,DECMST ;DECREMENT ALL SFD AT'S EXCEPT THE RIGHT ONE
SETZM DEVFLR##(F) ;1ST POINTER INDDB IS FOR BLOCK 0
HRRZ U,DEVUNI##(F) ;LOC OF UNIT DATA BLOCK
HRRM U,DEVFUN##(F) ;=UNIT OF 1ST POINTER IN DDB
SETZM DEVRIB##(F) ;CLEAR POINTER TO CURRENT RIB
LDB T2,UNYLUN## ;GET CURRENT LOGICAL UNIT NUMBER
DPB T2,DEYRBU## ;STORE IN DEVRIB
MOVE T3,UNISTR(U) ;GET SDB ADDRESS FOR CURRENT RIB
MOVE T2,DEVACC##(F) ;GET ADDRESS OF A.T.
MOVE T2,ACCPT1##(T2) ;GET FIRST RETRIEVAL POINTER
LDB T2,STYCLP##(T3) ;PICK OUT CLUSTER ADDRESS
DPB T2,DEYRBA## ;STORE IN DEVRIB
TLZ S,IOSRIB ;RIB IS NO LONGER IN MON BUFFER
MOVEM S,DEVIOS(F)
PJRST CPOPJ1## ;AND TAKE GOOD RETURN
;HERE WHEN CANNOT READ RIB - GIVE USER DATA FROM A.T.
FOUND7: HRRZ T3,DEVACC##(F) ;LOC OF A.T.
POP P,M ;RESTORE ADDR OF PPN
JRST FOUND3 ;GO GET A.T. STUFF
;HERE IF THE DATA IN THE RIB IS BADLY FOULED UP, BUT RIBCHK PASSED IT
;DON'T ATTEMPT TO DECREMENT THE USE COUNT ON THE FILE ITSELF,
;THE ACC IS PROBABLY CLOBBERED.
;OK TO DECREMENT THE SFD
LKRIB: MOVEI T1,TRNERR ;ERROR CODE
PJRST LKENR4 ;GO GIVE AN ERROR RETURN
SUBTTL ENTER
UENTR: PUSHJ P,NULTST ;ON DEVICE NUL,
PJRST CPOPJ1## ; ENTER WINS
SKIPL DEVSPL(F) ;SPOOLING DEVICE?
JRST UENT3 ;NO
PUSH P,M ;SAVE M
PUSHJ P,GETWDU## ;YES, GET NAME OR ADDRESS USER IS ENTERING
MOVE T2,T1 ;SAVE INCASE IYB
TLNE T1,-1 ;FILENAME OR ADDRESS
JRST UENT2 ;FILENAME
HRRI M,UUXNUM(M) ;POINT M TO LENGTH IN ENTER BLOCK
PUSHJ P,GETWDU## ;GET LENGTH OF ENTER BLOCK
HRRI M,<UUXNAM-UUXNUM>(M) ;ASSUME FILENAME FOR SPOOLED NAME
CAIGE T1,<UUXFUT-UUXNUM> ;IS THE BLOCK LONG ENOUGH TO
; INCLUDE A SPOOLED NAME?
JRST UENT1 ;NO, USER FILENAME
HRRI M,<UUXFUT-UUXNAM>(M) ;POINT M TO SPOOLED NAME IN
; THE ENTER BLOCK
PUSHJ P,GETWDU## ;GET THE SPOOLED NAME
JUMPN T1,UENT2 ;IF ZERO NAME USER FILENAME
HRRI M,<UUXNAM-UUXFUT>(M) ;ZERO SPOOLED NAME, SO USER FILENAME
UENT1: PUSHJ P,GETWDU## ;GET FILENAME FOR SPOOL NAME
UENT2: MOVEM T1,DEVSPN##(F) ;SAVE TEMPORARILY IN DDB
SETZM DEVPPN(F)
POP P,M ;RESTORE M
MOVSI T1,(UP.IYB) ;IN-YOUR-BEHALF BIT
TLNN T2,-1 ;EXTENDED ENTER?
TDNN T1,.USBTS ;IS THAT WHAT WE'RE DOING?
PJRST CPOPJ1## ;NO--JUST RETURN
ANDI T2,<-1-RB.BIT> ;KEEP ONLY THE WORD COUNT
CAIGE T2,UUXACT ;ACCT STRING SPECIFIED?
JRST CPOPJ1## ;NOPE
MOVEI T3,ACTSTL## ;GET ACCT STRING LENGTH AS DEFINED IN COMMON
JUMPE T3,CPOPJ1## ;RETURN IF ZERO
SUBI T2,UUXACT ;COMPUTE LENGTH OF
CAILE T2,(T3) ; SPECIFIED STRING
MOVEI T2,(T3) ; IN THE ENTER BLOCK
MOVNS T2 ;NEGATE
HRLZS T2 ;MAKE IT -LEN,,0
PUSH P,T2 ;AND SAVE COUNT
PUSHJ P,SETSPB ;SET UP SPB
JRST CPOPJ1## ;NO FREE CORE
HRRI M,UUXACT-1(M) ;POINT TO ACCT STRING IN ENTER BLOCK
POP P,T2 ;GET -LEN,,0
HRRI T2,SPBACT##(T1) ;POINT TO ACCT STRING IN SPB
UENT3A: PUSHJ P,GETWD1## ;GET A WORD
MOVEM T1,(T2) ;PUT A WORD
AOBJN T2,UENT3A ;LOOP
JRST CPOPJ1## ;AND RETURN
UENT3: TLNE F,LOOKB ;LOOKUP IN FORCE?
JRST UPDATE ;YES. UPDATE
;HERE FOR AN ENTER WHICH IS A CREATE OR SUPERSEDE
UENT4: SETZM DEVSFD##(F)
PUSHJ P,SAVE4## ;SAVE ACS (SETLER RETURNS STUFF IN P3,P4)
MOVE J,.CPJOB##
PUSH P,JBTSFD##(J) ;SAVE JBTSFD
MOVSI T1,JBPXSY##
ANDCAM T1,JBTSFD##(J) ;MAKE SURE NEW: ISN'T WRITTEN
MOVSI T1,DEPLIB##
ANDCAM T1,DEVLIB##(F) ;IN CASE OF LOOKUP FAILURE FIRST
SETZM DEVLNM##(F) ;START WITH NO LOGICAL NAME
PUSHJ P,SETLER ;NO. SET UUO FOR ENTER
JRST ILNMEN ;BAD NAME - ERROR
MOVE J,.CPJOB##
POP P,JBTSFD##(J)
TLNN M,UUODIR ;TRYING TO ENTER A DIRECTORY?
JRST UENT5 ;NO
PUSHJ P,CNTLVL ;YES, GET SFD LEVEL
CAMGE T1,SFDLVL## ;ALREADY AT LIMIT?
JRST UENT5 ;BELOW LIMIT
MOVEI T1,LVLERR ;ABOVE, GIVE HIM ERROR
JRST LKENR4
UENT5:
;HERE IF NOT TRYING TO ENTER A DIRECTORY
UENT6: SKIPN T1,DEVLNM##(F) ;LOGICAL NAME SPEC?
JRST UENT11 ;NO
TLO M,UUOLUK ;NO, SEE IF FILE EXISTS HERE
UENT7: JUMPGE P4,UENT8 ;/OVERRIDE?
MOVE T1,DEVLNM##(F) ;YES. GET SPEC
HRLZ T2,P4 ;IS NAME.EXT FROM LOOKUP/ENTER BLOCK
CAMN P3,LNRNAM##(T1) ; THE SAME AS THE PATHOLOGICAL NAME SPEC?
CAME T2,LNREXT##(T1)
JRST UENT9 ;NO, STEP TO NEXT SPEC
UENT8: PUSHJ P,SETSRC##
JRST UENT9 ;UNIT NOT THERE
MOVE T2,T1
PUSHJ P,FNDFIL## ;DOES FILE EXIST HERE?
JRST UENT99 ;NO
PUSH P,P2 ;YES, SET UP P2 FOR DECUC
PUSHJ P,DECSU
PUSHJ P,DECRDR ;DECREMENT ACC
PUSHJ P,GVCBJ1## ;%OTHER READERS, GIVE UP CB
PUSHJ P,TSTAMD## ;%LAST READER, FILE MARKED FOR DELETION?
CAIA ;YES
PUSHJ P,ATSDRA## ;%NO, MAKE ACC DORMANT
PUSHJ P,DECUC ;DECREMENT PPB+NMB
POP P,P2 ;RESTORE P2
JRST UENT10 ;USE THIS STR
UENT99: CAIN T1,PRTERR ;PROTECTION FAILURE?
JRST UENT10 ;YES, THIS STR WILL FAIL
UENT9: PUSHJ P,SFDDEC ;CLEAR ANY SFD STUFF WE SET UP
PUSHJ P,DECSFD
SETZM DEVSFD##(F)
PUSHJ P,NXTSPC ;STEP TO NEXT SPEC
JRST UENT7 ;SEE IF FILE EXISTS THERE
MOVE T1,DEVNAM(F) ;NO FILE TO SUPERSEDE - GO BACK TO START
PUSHJ P,SDVTST
PUSHJ P,LNMSTP ;WHAT? IT USED TO BE A LOG NAME
MOVE T1,@.USLNM ;GO TO 1ST PART OF SPEC
ADDI T1,LNMDEV##-LNRDEV##
HRRZM T1,DEVLNM##(F)
PUSHJ P,NXTSP3
CAIA
PUSHJ P,LNMSTP ;WHAT? IT USED TO BE THERE
;HERE WITTH DDB SET UP TO THE PPN/SFD WE WANT TO CREATE/SUPERSEDE IN
UENT10: TLZ M,UUOLUK ;NOT A LOOKUP ANY MORE
UENT11: PUSHJ P,SETSRC## ;SET UP SEARCH LIST
SKIPA T1,DEVLNM##(F) ;LOG NAME?
JRST UENT12
JUMPE T1,CPOPJ## ;NO, LOSE
PUSHJ P,NXTSPC ;YES, GET NEXT PART
JRST UENT11 ;SEE IF DEVICE EXISTS
POPJ P,
UENT12: MOVE T2,T1 ;SEARCH LIST INTO T2
TLZ S,IOSWLK ;MAKE SURE IOSWLK IS OFF
MOVEM S,DEVIOS(F) ; (COULD BE ON FROM PREVIOUS LOOKUP)
PUSHJ P,FNDFIL## ;SEARCH FOR MATCH, SET A.T.
JRST LKENR4 ;ERROR
HLRZ T1,DEVEXT(F) ;GET EXTENSION
MOVE T2,DEVPPN(F) ; AND PPN
CAIN T1,'UFD' ;TRYING TO CREATE A UFD ?
CAMN T2,MFDPPN## ;YES. IN THE MFD ?
SKIPA T2,DEVACC##(F) ;YES, GET LOC OF A.T.
JRST NTFOUN ;NO, ERROR
HRRZ P1,ACCSTS##(T2)
TRNE P1,ACPSUP ;SUPERSEDING
TRNN P1,ACPPAL## ; A PRE-ALLOCATED FILE?
CAIA ;NO
JRST SETE19 ;YES, FINISH UP
TLNE S,IOSWLK ;FILE (STR) WRITE LOCKED?
JRST ENER12 ;YES. ERROR
HRRZ P2,U ;REMEMBER UNIT WE OWN DA FOR
PUSHJ P,DDBZR ;ZERO THE DDB POINTERS
MOVSI T4,MRIBLN##+1 ;SET UP DEVRSU(COUNT 1 FOR 1ST UNIT)
HLLM T4,DEVRSU##(F)
SETZM ACCALC##(T2) ;INSURE THAT THE ALLOCATION WORD IS 0
LDB T4,ACYFSN## ;T4 = FSN
MOVE P1,TABSTR##(T4) ;LOC OF STR DATA BLOCK INTO P1
SETO T2, ;SET MASK=-1 (COMPARE WHOLE NAME)
MOVE T1,DEVNAM(F) ;NAME USER INITED
PUSHJ P,UNSER0## ;LOOK FOR MATCHING UNINAM
JRST UNILUP ;NO MATCH - PICK BEST UNIT
SKIPLE UNITAL(T3) ;HE WANTS PARTICULAR UNIT - ANY ROOM?
JRST USEUNI ;YES. USE REQUESTED UNIT
;HERE WHEN A PARTICULAR UNIT WAS NOT SPECIFIED - FIND THE MOST EMPTY
; UNIT IN THE STR WITH NO OPEN FILES TO START THE FILE ON
UNILUP: SETZB T1,T4 ;T4 WILL CONTAIN BEST UNITAL
UNILP0: HLR T3,STRUNI##(P1) ;FIRST UNIT IN STR
PUSH P,P1 ;SAVE P1
UNILP1: CAML T4,UNITAL(T3) ;IS THIS THE BEST UNIT SO FAR?
JRST UNILP5 ;NO. TRY NEXT
MOVSI T2,DEPNLB##
TDNN T2,DEVNLB##(F) ;DID USER ASK FOR ANY UNIT?
TLNE T3,-1 ;YES. AVOIDING UNITS WITH OPEN FILES?
JRST UNILP4 ;NO, USE THIS UNIT
SKIPL T2,USRHCU## ;YES. NO OF CHANS USER HAS OPEN
SETZ P1,
UNILP2: PUSHJ P,NXTCH##
JRST UNILP4
MOVSI T2,DVDSK
TDNE T2,DEVMOD(T1)
CAIN T1,(F)
JRST UNILP2
HLRZ T2,DEVEXT(T1) ;YES. FILE'S EXTENSION
PUSHJ P,EXTCK ;IS IT A DIR?
JRST UNILP2 ;YES. PUTTING DATA FILE ON SAME UNIT IS OK
HLRZ T2,DEVUNI##(T1) ;UNIT OF THE FILE
CAIN T2,(T3) ;IS IT THIS UNIT?
JRST UNILP5 ;YES. DON'T WANT TO WRITE THE FILE ON THIS UNIT
JRST UNILP2 ;TEST NEXT USER CHAN
UNILP4: MOVE T4,UNITAL(T3) ;THIS IS THE BEST SO FAR. SAVE ITS TALLY
HRRZ U,T3 ;SAVE LOC OF UNIT DATA BLOCK
UNILP5: HLR T3,UNISTR(T3) ;STEP TO NEXT UNIT IN STR
MOVE S,DEVIOS(F)
TRNE T3,-1 ;IS THERE ONE?
JRST UNILP1 ;YES. TEST IT
POP P,P1 ;RESTORE P1
JUMPN T4,USEUN1 ;FOUND A UNIT WITH FREE BLOCKS IF T4 NON 0
TLON T3,-1 ;INDICATE ANY UNIT WILL DO
JRST UNILP0 ;GO FIND ANY UNIT WITH FREE BLOCKS
JRST UENT6 ;NONE FREE, TRY AGAIN
USEUNI: MOVE U,T3 ;SET U TO USER SPECIFIED UNIT
;HERE WHEN U IS SET UP (IT MAY BE CHANGED BY NON-0 E+11)
USEUN1: PUSHJ P,STOAU## ;SAVE LOC OF UNIT DB IN DDB
PUSHJ P,UPDA## ;AND GET IT FOR NEW UNIT
SKIPLE UNITAL(U) ;ANY SPACE ON UNIT?
JRST USEU1A ;YES, PUSH ON
PUSHJ P,DWNDA## ;NO, SOME OTHER JOB SNUCK IN AND GRABBED IT
MOVE T1,UNISTR(U)
SKIPLE STRTAL##(T1) ;IS THERE SPACE ANYWHERE ON STR?
JRST UNILUP ;YES, GO FIND ANOTHER UNIT TO WRITE ON
JRST UENT6 ;NO, CALL FILFND AGAIN
USEU1A: MOVEI T3,DEVRB2##(F) ;SET DEVRET TO DEVRB2 (1ST REAL PNTR)
HRRM T3,DEVRET##(F)
MOVE J,UDBKDB(U) ;LOC OF KONTROLLER DB
HRRZ P2,DEVACC##(F) ;SET P2 AND P3 POINTING
HRRI M,-1(M)
TLNN M,EXTUUO ;EXTENDED ENTER?
JRST CREAL4 ;NO. POINT TO PRIVS WORD
PUSHJ P,GETWDU## ;GET NUMBER OF ARGUMENTS(VALUES)
TRZ T1,RB.BIT ;CLEAR NO-SUPERSEDE BIT
HRRZ P1,T1
CAILE P1,RIBENT## ;ASKING FOR TOO MANY?
MOVEI P1,RIBENT## ;YES. TAKE SMALLER AMOUNT
HRRI M,UUXALC(M) ;POINT TO (ALLOCATION WORD)
CAIL P1,UUXALC
PUSHJ P,GETWDU##
CAIL P1,UUXALC ;MAY HE BE SPECIFYING ALLOCATION?
SKIPG T2,T1 ;YES. PICK UP AMOUNT
CAIA ;NO, ESTIMATED LENGTH GIVEN?
JRST USEUN2 ;YES, USE IT
HRRI M,-1(M)
CAIL P1,UUXEST
PUSHJ P,GETWDU##
HRRI M,1(M)
CAIL P1,UUXEST
SKIPG T2,T1 ;GET ESTIMATED ALLOCATION
HLRZ T2,UNIGRP(U) ;NO ESTIMATED, USE UNIGRP
CAIA
USEUN2: TLO M,UALASK ;INDICATE ASKING FOR A SPECIFIC AMOUNT
HRRZ T4,DEVUFB##(F) ;LOC OF UFB
CAMG T2,UFBTAL##(T4) ;ASKING FOR MORE THAN QUOTA ALLOWS?
JRST CREAL1 ;NO. OK
SKIPG T2,UFBTAL##(T4) ;YES. ANY LEFT AT ALL?
HLRZ T2,UNIGRP(U) ;NO - TAKE UNIGRP BLOCKS
;(WE DON'T CHECK QUOTAS ON SUPERSEDE IN A F/S)
TLNE M,UALASK
TLO M,UPARAL ;YES. REMEMBER FOR PARTIAL ALLOC. ERROR
;HERE WITH T2=SPACE WE WOULD LIKE TO GET
CREAL1: HRRI M,1(M) ;POINT TO START ADDRESS WORD
PUSH P,T2 ;SAVE T2
HRRZ P3,U ;SAVE THIS UNIT
PUSHJ P,ALSTRT ;SET T1 FOR POSSIBLE START-ADR. SPECIFICATION
JRST ENERR3 ;CANT START AT SPECIFIED BLOCK (ADR. TOO HIGH)
CAIN P3,(U) ;DID WE STAY ON THE SAME UNIT ?
JRST CREAL2 ;YES
EXCH U,P3 ;NO, RETURN DA FOR FIRST UNIT
PUSHJ P,DWNDA##
MOVE U,P3 ;POINT AT NEW UNIT
PUSHJ P,UPDA## ;GET THE DA FOR THAT ONE
CREAL2:
;HERE WITH T1=START ADR (OR 0), T2=NUMBER OF BLOCKS REQUESTED
PUSHJ P,ENTALC ;ALLOCATE SPACE
JRST ENERR4 ;CANT START AT SPECIFED BLOCK
MOVE T1,ACCALC##(P2) ;AMOUNT OF SPACE ALLOCATED
CAIL P1,UUXALC ;IF USER WANTS TO KNOW,
PUSHJ P,PUTWDU## ; TELL HIM AMOUNT ALLOCATED
JRST CREAL5 ;ALLOCATION COMPLETE - CONTINUE
;HERE FOR ALLOCATION ON A 4-WORD ENTER
CREAL4: HLRZ T2,UNIGRP(U) ;NUMBER OF BLOCKS TO GET
SETZ T1, ;GET THEM ANYWHERE
PUSHJ P,ADJALC ;GET SOME SPACE
JRST ENERR2 ;NO ROOM -ERROR
MOVEM T2,DEVRB2##(F) ;SAVE THE POINTER
MOVEM T1,ACCALC##(P2) ;SAVE NUMBER OF BLOCKS ALLOCATED
MOVEI P1,UUXPRV ;SET P1 SO PRIVS WORD WILL BE STORED
AOSA DEVRET##(F) ;SET DEVRET TO DEVRB2+1
;HERE WHEN ALL ALOCATION IS DONE
CREAL5: POP P,T2 ;REMOVE GARBAGE FROM PD LIST
HRLM U,DEVUNI##(F) ;SAVE UNIT OF RIB
PUSHJ P,DECMST ;DECR ALL A.T. USE COUNTS
; EXCEPT THE ONE FOR THIS STR
PUSHJ P,SDVTSS ;MAKE SURE SYSDEV IS RIGHT
LDB T4,UNYLUN## ;LOGICAL UNIT NUMBER
TRO T4,RIPNUB## ;MAKE SURE NON-0
MOVEM T4,DEVRB1##(F) ;SAVE IN THE DDB
SETZ T1, ;WILL SET UP T1
DPB T4,UN1PTR## ;SAVE UN1 IN T1
MOVE T2,DEVRB2##(F) ;1ST REAL POINTER
SKIPN DEVRB2##+1(F) ;ONLY POINTER?
TRO T1,ACP1PT## ;YES. LIGHT 1PT BIT
SETZM ACCWRT##(P2) ;INDICATE 0 BLOCKS WRITTEN
HRRM T1,ACCUN1##(P2) ;SAVE UN1 WORD IN A.T.
MOVEM T2,ACCPT1##(P2) ;SAVE 1ST PNTR IN A.T.
MOVEI T2,ACPNCK## ; FILE A DIRECTORY, PLUS ALWAYS BAD CHECKSUM
;(SINCE OTHERWISE EARLIER MONITORS WILL COMPLAIN)
TLNE M,UUODIR ;IS IT A DIRECTORY?
ORM T2,ACCDIR##(P2) ;YES. SET BITS IN ACC
TLNE M,EXTUUO ;EXTENDED ENTER?
HRRI M,-<UUXALC-UUXPRV>(M) ;YES. POINT TO PROTECTION WORD
CAIGE P1,UUXPRV ;USER SPECIFYING DATE?
TDZA T1,T1 ;NO, USE NOW
PUSHJ P,GETWDU## ;YES, GET TIME,DATE,PROTECTION WORD
HRLM T1,P2
TRNE T1,-1 ;TIME DATE GIVEN?
JRST SETEN1 ;YES
MOVE T2,TIME## ;NO. TIME, DATE =NOW
IDIV T2,TICMIN##
HRR T1,THSDAT## ;TODAY'S DATE
DPB T2,[POINT 11,T1,23] ;STORE TIME IN T2
SETEN1: MOVSI T3,777000 ;SET TO GET PROTECTION OF OLD FILE (IF ANY)
AND T3,ACCPRV##(P2) ;IF NON-0, THIS FILE IS SUPERSEDING
JUMPN T3,SETEN4 ;DEFAULT PROT=OLD FILE'S PROT IF SUPERSEDE
MOVE T3,UFDPRT## ;STANDARD DIRECTORY PROTECTION
TLNE M,UUODIR ;A DIRECTORY ?
JRST SETEN4 ;YES
LDB J,PJOBN## ;J WAS WIPED IF I/O WAS DONE
PUSHJ P,FNDPDS## ;DEFAULT PROTECTION WAS SPECIFIED BIT
IFN FTFDAE,<
MOVSI T2,(PD.FSP) ;FILE DAEMON SPECIFIED PROT BIT
TDNN T2,.PDDFL##(W) ;DID THE FILE DAEMON SPECIFY PROT?
JRST SETEN2 ;NO
ANDCAM T2,.PDDFL##(W) ;YES, CLEAR THE BIT
MOVEI T3,777000 ;GET PROTECTION
AND T3,.PDDFL##(W)
MOVSS T3 ;POSITION TO CORRECT FIELD
TLZ T1,777000 ;IGNORE WHAT ENTER SAID
JRST SETEN4 ;SET PROTECTION FIELD
SETEN2:>
TLNN F,SYSDEV ;IS DEVICE = SYS?
JRST SETEN3 ;NO
HLRZ T3,DEVEXT(F) ;YES, PROT = <155>
CAIN T3,'SYS' ; EXCEPT FOR .SYS FILES
SKIPA T3,SYSPRY## ; WHICH ARE <157>
MOVE T3,SYSPRT##
JRST SETEN4
SETEN3: MOVSI T2,(PD.DPS) ;DEFAULT PROTECTION SET BIT
MOVSI T3,777000 ;MASK TO EXTRACT DEFAULT PROTECTION FROM THE PDB
TDNN T2,.PDDFL##(W) ;HAS A DEFAULT PROTECTION BEEN SPECIFIED
SKIPA T3,STNPRT## ;NO, USE SYSTEM DEFAULT
AND T3,.PDDFL##(W) ;YES, GET USER SPECIFIED DEFAULT
SETEN4: TLNN T1,777000 ;PROTECTION ALREADY GIVEN?
OR T1,T3 ;NO, SET STANDARD PROTECTION
DPB S,[POINT 4,T1,12] ;MODE
PUSH P,T1 ;PROT, MODE, LO CRE-DATE
HRRI M,-<UUXPRV-UUXEXT>(M)
PUSHJ P,GETWDU## ;ACCESS DATE, HI CRE-DATE
SKIPGE DEVSPL(F)
HRRI T1,0 ;RH(E+1) IS A COUNT IF SPOOLED
LDB T2,[POINT 15,T1,35]
SKIPE T2 ;IF NO ACCESS DATE GIVEN
CAMLE T2,THSDAT## ;OR IF GREATER THAN TODAY
MOVE T2,THSDAT## ;USE TODAY'S DATE
DPB T2,[POINT 15,T1,35] ;SAVE IN USERS AREA
LDB T4,[POINT 3,T1,20] ;HIGH PART OF CREATION DATE
LDB T3,[POINT 12,P2,17] ;USER-SUPPLIED LOW PART OF CREATION DATE
DPB T4,[POINT 3,T3,23]
SKIPE T3
CAMLE T3,THSDAT##
MOVE T3,THSDAT## ;NO CREATION DATE, OR DATE TOO HIGH
SUB T2,T3 ;ACC DATE - CREATION DATE
SKIPGE T2 ;IF ACC DATE TOO LOW,
SUB T1,T2 ; CHANGE IT TO = CREATION DATE
DPB T3,[POINT 12,(P),35] ;SAVE LOW CREATION DATE
LSH T3,-14
DPB T3,[POINT 3,T1,20] ;SAVE HIGH CREATION DATE
PUSHJ P,PUTWDU##
EXCH T1,(P)
HRRI M,UUXPRV-UUXEXT(M)
CAIL P1,4 ;SAVE PRIVS, LOW CRE-DATE IN USERS AREA
PUSHJ P,PUTWDU## ; IF HE ASKED FOR IT
SETZ T2,
XOR T1,ACCPRV##(P2) ;GET BITS WHICH ARE BEING CHANGED
TLNE T1,777000 ;CHANGING PROTECTION?
DPB T2,DEYFNC## ;YES, FORCE RECOMPUTE OF PRIV'S
XORB T1,ACCPRV##(P2) ;STORE NEW VALUE IN ACC
PUSHJ P,GTMNBF## ;GET THE MONITOR BUFFER
MOVE T2,T1
HRLI T1,1(T2) ;SET TO ZERO THE ENTIRE BUFFER
HRRI T1,2(T2)
SETZM 1(T2)
BLT T1,200(T2) ;ZERO IT
MOVE T3,UNILOG(U) ;NAME OF FIRST UNIT FOR FILE
MOVEM T3,RIBDEV##+1(T2) ;SAVE IN RIB
TLNN M,EXTUUO ;EXTENDED UUO?
AOJA T2,SETEN5 ;NO
HRRI M,-<UUXPRV-UUXEXT>(M) ;POINT TO ACCESS DATE WORD
MOVEM M,(P) ;WIPE OUT DATE, SAVE M ON LIST
MOVE T1,DEVPPN(F) ;PPN
MOVEM T1,RIBPPN##+1(T2) ;SAVE IN RIB
HRRI M,-<UUXEXT-UUXNAM>(M) ;POINT TO NAM WORD
HRLI T2,-UUXEXT+1 ;SET TO SAVE FIRST FEW VALUES
PUSHJ P,GTWST2## ;GET A VALUE
MOVEM T1,RIBNAM##+1(T2) ;SAVE IN RIB
HRRI M,1(M) ;POINT TO NEXT VALUE
AOBJN T2,.-3 ;GO GET IT
PUSHJ P,SETVAN ;STORE USER-ARGS IN RIB
POP P,M
JRST SETEN6 ;AND CONTINUE
;HERE TO SET UP RIB BLOCK FROM A 4-WORD ENTER
SETEN5: PUSHJ P,GTWST2## ;DATE, PROT WORD
MOVEM T1,RIBATT##(T2) ;SAVE IN RIB
POP P,T1 ;GET EXT, DATE
MOVEM T1,RIBEXT##(T2) ;SAVE IN RIB
HRRI M,-<UUNATT-UUNNAM>(M) ;POINT TO E
PUSHJ P,GTWST2## ;GET NAME
MOVEM T1,RIBNAM##(T2) ;INTO RIB
HRRI M,UUNPPN-UUNNAM(M) ;POINT TO PPN WORD
MOVE T1,DEVPPN(F) ;PRJ,PRG NUMBER
MOVEM T1,RIBPPN##(T2) ;INTO RIB
MOVE T1,DEVSPN##(F)
SKIPGE DEVSPL(F)
MOVEM T1,RIBSPL##(T2) ;SAVE (POSSIBLE) NAME ENTERED ON A SPOOL-ENTER
MOVE T1,.JDAT+.JBVER## ;GET BERSION NUMBER
SKIPGE USRHCU## ;IN SAVE COMMAND?
MOVEM T1,RIBVER##(T2) ;YES--SAVE VERSION IN RIB
;HERE WHEN THE RIB BLOCK IS SET UP. INSERT CONSTANT VALUES, WRITE IT
SETEN6: PUSHJ P,RIBAD## ;COMPUTE ADR. OF RIB
MOVE T1,.USMBF ;LOC OF RIB(-1)
MOVEM T2,RIBSLF##+1(T1) ;SAVE ADR AS LAST WORD OF RIB
SETZM RIBSIZ##+1(T1) ;NUMBER OF WORDS WRITTEN=0
MOVE T2,DEVFIL(F) ;SINCE WE MIGHT DEFAULT NAME, EXT
MOVEM T2,RIBNAM##+1(T1) ; SET THEM UP FROM THE DDB, WHICH IS RIGHT
MOVE T2,DEVEXT(F)
HLLM T2,RIBEXT##+1(T1)
SKIPE RIBAUT##+1(T1) ;IF NO PRJ,PRG GIVEN
JRST SETEN8
LDB T3,PJOBN## ;JOB NUMBER
MOVE T3,JBTPPN##(T3) ;AUTHORS PRJ,PRG NUMBER
MOVE T4,DEVPPN(F) ;DIRECTORY OF FILE
CAMN T3,FFAPPN## ;IF AUTHOR IS [1,2]
CAMN T4,SPLPPN## ; UNLESS WRITING IN [3,3]
JRST SETEN7
SKIPN T3,DEVUPP##(F) ;USE IN-YOUR-BEHALF IF THERE
MOVE T3,T4 ;MAKE AUTHOR = DIRECTORY OWNER
SETEN7: MOVEM T3,RIBAUT##+1(T1) ;STORE USERS PRJ,PRG
SETEN8: MOVEI T3,CODRIB## ;CODE WORD SHOWING THIS BLOCK IS A RIB
MOVEM T3,RIBCOD##+1(T1) ;SAVE IN RIB BLOCK
MOVE T2,[XWD MRIBLN##,RIBENT##+1] ;SET UP RIBFIR
MOVEM T2,RIBFIR##+1(T1)
MOVE T4,ACCALC##(P2) ;AMOUNT OF SPACE ALLOCATED
MOVEM T4,RIBALC##+1(T1) ;SAVE IN RIB
MOVE T4,ACCPRV##(P2) ;PRIVS, DATE
MOVEM T4,RIBPRV##+1(T1) ;SAVE IN RIB
SETZM RIBFLR##+1(T1) ;BLOCK 0 STARTS PRIME RIB
MOVE T4,RIBEXT##+1(T1) ;ACCESS DATE
HRLM T4,ACCADT##(P2) ;SAVE IN ACCESS TABLE
MOVSI T4,RIPLOG## ;INDICATE JOB NOT LOGGED OUT
TLNE M,UUODIR ;IF A DIRECTORY
CAIL P1,UUXSTS ; AND NOT SPECIFYING A STATUS
SETZ T4, ;NOT A DIR, OR STATUS GIVEN
TLNE M,UUODIR ;DIRECTORY FILE?
TRO T4,RIPNCK## ;YES. SET A BIT IN RIBSTS - RIPDIR+RIPABC
; (RIPABC ELSE EARLIER MONITORS WILL COMPLAIN)
ORM T4,RIBSTS##+1(T1)
MOVSI T3,DEVRB1##(F) ;SET UP TO BLT POINTERS FROM DDB
HRRI T3,RIBENT##+2(T1) ; INTO RIB
BLT T3,RIBWN1##+1(T1) ;(THERE MAY BE PTRLEN POINTERS)
HRRI M,UUXALC-UUXEXT(M) ;POINT TO ESTIMATED LENGTH
PUSHJ P,CHKPAR ;STORE PAOERR IF NEEDED
MOVE P3,P1 ;SAVE ARGUMENT COUNT
HRRI M,-<UUXALC-UUXEST>(M)
CAIL P1,UUXEST
PUSHJ P,GTWDT3
CAIL P1,UUXEST ;SPECIFYING ESTIMATED LENGTH?
SKIPG T3
JRST SETE14 ;NO
SUB T3,RIBALC##+1(T1) ;YES. ALREADY HAVE THAT MUCH?
JUMPLE T3,SETE14 ;YES IF NEGATIVE
HRRZ P1,DEVRET##(F) ;NO. GET MORE
SUBI P1,DEVRB1##(F) ;COMPUTE NUMBER OF POINTERS
HRLS P1
PUSHJ P,SPTRW## ;SET T1 TO AN AOBJN WORD FOR POINTERS
ADD P1,T1 ;SET P1=AOBJN WORD FOR NEW POINTERS
TLZ F,OCLOSB ;SO TAKBLK WONT GIVE BLOCKS IF UNITAL LT 0
MOVE T2,T3 ;NUMBER OF BLOCKS TO GET
PUSHJ P,CHKQTA## ;CHECK QUOTA
SKIPG P2,T2 ;P2=AMOUNT WE CAN GET
JRST SETE13 ;CANT GET ANY MORE - FORGET IT
;STILL IN FTDALC CONDITIONAL
SETEN9: PUSHJ P,SCDCHK## ;SEE IF SCHED WANTS TO RUN ANOTHER JOB
PUSHJ P,TAKCHK## ;GET AS LARGE A GROUP AS THERE IS
JRST SETE11 ;ON A NEW UNIT
SETE10: MOVEM T2,(P1) ;SAME UNIT - SAVE POINTER
SUB P2,T1 ;SUBTRACT NUMBER OF BLOCKS OBTAINED
JUMPLE P2,SETE12 ;DONE IF NO MORE TO GET
MOVE T2,P2 ;NEW AMOUNT TO GET
AOBJN P1,SETEN9 ;GO TRY AGAIN
JRST SETE12 ;NO MORE POINTER SLOTS IN RIB - DONE
SETE11: JUMPE T3,SETE12 ;STR FULL IF T3=0
MOVEM T3,(P1) ;SAVE UNIT-CHANGE IN RIB
AOBJN P1,SETE10 ;STORE REAL POINTER IN RIB
MOVEM T2,-1(P1) ;NO ROOM - DELETE UNIT CHANGE, SET UP TO
SUBI P1,1 ; GIVE BACK THE BLOCKS JUST OBTAINED
PUSHJ P,DELRIB ; SINCE ONLY 1 PNTR SLOT LEFT
STOPCD .+1,DEBUG,DNR, ;++DELRIB NON-SKIP RETURN
SETE12: MOVE P2,DEVACC##(F)
TRZ S,IOBKTL ;MAKE SURE IOBKTL OFF
MOVE T1,.USMBF ;LOC OF MONITOR BUFFER
MOVEI T3,ACP1PT## ;CLEAR THE 1PT BIT
ANDCAM T3,ACC1PT##(P2) ; IN THE A.T.
MOVE T3,ACCALC##(P2) ;NO OF BLOCKS ALLOCATED
MOVEM T3,RIBALC##+1(T1) ;SAVE IN RIB
HRRI M,UUXALC-UUXEST(M) ;POINT TO ALLOCATION WORD
MOVE T1,T3
CAIL P3,UUXALC ;IF .RBCNT .LE. .RBALC, DON'T RETURN .RBALC
PUSHJ P,PUTWDU## ;TELL USER THE FINAL RESULT
SETE13: HRROI P1,DEVRBN##(F) ;PREPARE TO SET DEVRET=DEVRBN
HRRI M,-<UUXALC-UUXEST>(M) ;POINT BACK AT EST LENGTH
SETE14: PUSHJ P,SETUFR ;SET RIBUFD IN RIB
MOVE T2,DATE## ;INTERNAL CREACTION TIME, DATE
MOVEM T2,RIBTIM##+1(T1); INTO RIB
MOVE T2,[XWD MACTSL##,RIBACS##]
MOVEM T2,RIBACT##+1(T1) ;STORE AOBJN POINTER TO ACCOUNT STRING
JUMPGE T2,SETE18 ;GO IF 0-LENGTH ACCT STRING
ADDI T2,1(T1) ;AOBJN WORD FOR ACCT-STRING IN RIB
PUSH P,M ;SAVE POINTER
PUSH P,DEVUPP##(F)
SETZM DEVUPP##(F) ;ALLOW PRIVS HERE
CAIL P3,UUXACT ;IF NO STRING SPECIFIED,
PUSHJ P,PRVJB## ; OR IF NOT A PRIV'D JOB
JRST SETE16 ;GET STRING FROM PDB
HRRI M,UUXACT-UUXEST-1(M) ;POINT TO STRING DATA IN ENTER BLOCK
SUBI P3,UUXACT ;NO. OF ARGS TO GET
SETE15: HRRI M,1(M) ;ADVANCE TO NEXT ARGUMENT
PUSHJ P,GTWST2## ;GET AN ARGUMENT
JUMPE T1,SETE16 ;DONE (OR USE PDB) IF 0
MOVEM T1,(T2) ;SAVE IN RIB
AOBJP T2,SETE17 ;DONE IF RIB FULL
SOJE P3,SETE17 ;DONE IF NO MORE VALUES
JRST SETE15 ;GO GET ANOTHER ARG FRO USER
SETE16: HLRZ T3,DEVEXT(F) ;IF A UFD
TLC T2,MACTSL## ;OR WE ALREADY STORED AT LEAST 1 FROM BLOCK
TLNN T2,-1 ; AND THEN TERMINATED ON A 0
CAIN T3,'UFD'
JRST SETE17 ;THEN WE'RE DONE
HRLI T2,.PDACS##(W) ;DEFAULT CASE - BLT ACCT. STRING
MOVE T3,T2 ; FROM PDB TO RIB
BLT T2,ACTSTL##-1(T3)
SETE17: MOVE T1,.USMBF ;RESTORE T1
POP P,DEVUPP##(F)
POP P,M ;RESTORE POINTER
SETE18: MOVE T2,RIBSLF##+1(T1) ;RESTORE RIB ADDRESS
HLRZ U,DEVUNI##(F) ;RESET U TO UNIT OF RIB
PUSHJ P,MONWRT## ;WRITE THE RIB
SETE19: HRRZ T3,DEVACC##(F) ;LOC OF THE A.T.
JUMPE T3,CPOPJ## ;LOSE IF UNIT REMOVED
TLO S,IO ;INDICATE WRITING
PUSHJ P,AT2DDB## ;SET UP DEVBLK,DEVREL, ETC FROM A.T. DATA
STOPCD .,JOB,UPC, ;++UNIT-CHANGE POINTER CLOBBERED
MOVEI T2,1 ;INDICATE AT RELATIVE POINTER 1
DPB T2,DEYRLC## ;(0 IS THE UNIT N0, NOT NOW N DDB)
SKIPGE P1 ;POINTERS IN RIB WHICH AREN'T IN DDB?
HRRM P1,DEVRET##(F) ;YES, SET DEVRET=DEVRBN SO RIB WILL
; BE READ BEFORE ALLOCATION IS DONE
ENTXIT: TLZ F,OCLOSB ;TURN OFF OCLOSB IN CASE OF PARTIAL ALLOCATION
PUSHJ P,JDAADR##
TLNN M,UPARAL ;PARTIAL ALLOCATION ONLY?
JRST ENTXI1 ;NO
HRRI M,-<UUXALC-UUXEXT>(M) ;ADJUST
TLOA F,ENTRB ;YES. SET FOR NON-SKIP RETURN
ENTXI1: AOSA (P) ;NO. SKIP(GOOD) RETURN
HLLM F,(T1) ;UUOCON DOESN'T STORE F ON AN ENTER ERROR RETURN
CLRSRB: TLZ S,IOSRIB ;RIB IS NO LONGER IN MON BUFFER
JRST STRIOS## ;SAVE S AND RETURN TO USER
;HERE WHEN THE ENTER IS AN UPDATE (LOOKUP ALREADY DONE)
UPDATE: PUSHJ P,SAVE3##
PUSHJ P,CLSNAM ;IN CASE OF RENAME
HRRZ U,DEVUNI##(F) ;SET UP U
TLZ M,UUOMSK ;ZERO MEANINGFUL BITS IN UUO
TLO M,UUOUPD ;INDICATE UPDATE
PUSHJ P,SETLE1 ;CHECK FOR EXTENDED UUO, OK NAME
JRST UILNMR ;ZERO NAME - ERROR
PUSHJ P,GETWDU## ;GET NAME
HRRZ P1,DEVLNM##(F) ;GET THE LOGICAL NAME POINTER IF ANY
CAMN T1,DEVFIL(F) ;SAME AS LOOKED-UP NAME?
JRST UPDAT0 ;YES, GO ON.
JUMPE P1,UILNMR ;FILNAME MISMATCH IF NO LOGICAL NAME POINTER
SKIPE T1,LNRNAM##(P1) ;SO FAR SO GOOD. ANY FILENAME?
CAME T1,DEVFIL(F) ;YES. SAME AS LOOKED UP NAME?
JRST UILNMR ;NO. ERROR
UPDAT0: HRRI M,UUNEXT-UUNNAM(M) ;YES. POINT TO EXTENSION
PUSHJ P,GETWDU## ;SUPPLIED EXTENSION
MOVE P3,T1
TRZ T1,-1
HLLZ T2,DEVEXT(F) ;LOOKED-UP EXT
HRRI M,-1(M) ;BUMP FOR BELOW
MOVE T3,DEVLIB##(F) ;IF THE FILE WASN'T IN UFD, BUT IN LIB
TLNN T3,DEPLIB## ; MAKE UPDATE ILLEGAL
CAMN T1,T2 ;MATCH?
JRST UPDA0A ;YES, SKIP THIS
JUMPE P1,UILNMR ;ERROR IF NO LOGICAL NAME TO LOOK AT
HLL P3,LNREXT##(P1) ;GET THE LOGICAL'S EXTENSION
HLLZ T1,P3 ;COPY IT
CAME T1,T2 ;MATCH?
JRST UILNMR ;NO. ERROR
UPDA0A: HRRI M,UUNPPN-UUNEXT+1(M) ;POINT TO PRJ,PRG
TLNE M,EXTUUO ;EXTENDED UUO?
HRRI M,-<2+UUXEXT-UUXPPN>(M) ;YES,
HRRZ T2,DEVACC##(F) ;LOC OF A.T.
HRRZ T2,ACCPPB##(T2) ;LOC OF PPB
MOVE T2,PPBNAM##(T2) ;PRJ,PRG OF LOOKED-UP FILE
PUSHJ P,GTWST2## ;PPN GIVEN?
JUMPE T1,UPDAT2 ;NO PPN IF T1=0
TLNE T1,-1 ;POINTER TO A PATH?
JRST UPDAT1 ;NO
PUSH P,M ;YES, SAVE M
HRRI M,2(T1) ;POINT TO PPN WORD IN PATH
PUSHJ P,GTWST2## ;GET PPN
POP P,M
JUMPE T1,UPDAT2 ;SAME PPN IF 0
UPDAT1: CAMN T1,T2 ;PPN'S MATCH?
JRST UPDAT2 ;YES, EVERYTHING'S COOL
JUMPE P1,UPDERY ;WE'RE IN TROUBLE IF NO LOGICAL NAME HERE
SKIPE T1,LNRPPN##(P1) ;IS THERE A PPN IN THIS LOGICAL?
CAME T1,T2 ;YES, PPN'S MATCH?
JRST UPDERY ;NO, ISU ERROR
;HERE WHEN THE NAME, EXTENSION AND PRJ,PRG AGREE WITH THE LOOKED-UP FILE
UPDAT2: PUSHJ P,GETCB## ;GET CB RESOURCE
PUSHJ P,TSTSFD ;%DON'T ALLOW UPDATE OF DIRECTORY
JRST UPDER9
MOVEI T1,FNCAPP## ;%CHECK TO SEE IF APPEND IS LEGAL
PUSHJ P,CHKPRV##
JRST UPDER9
HRRZ T1,DEVACC##(F) ;%OK, LOC OF A.T.
MOVE T2,ACCNDL##(T1) ;%IS THIS A MAGIC FILE?
TRNE T2,ACPNDL##
JRST UPDER9 ;%YES, IT CAN'T BE UPDATED
MOVE T1,ACCSTS##(T1) ;%STATUS
TRNE T1,ACPDEL## ;%MARKED FOR DELETION? (IF SO, ANOTHER JOB
JRST UPDER5 ;%DID A SUPERSEDE BEFORE THIS ENTER)
PUSHJ P,TSTWRT ;%TEST IF WRITING IS ALLOWED
JRST UPDER7 ;%NO, GIVE FILE-BEING-MODIFIED ERROR
MOVEI T1,FNCCAT## ;%CAN USER CHANGE ATTRIBUTES?
SETZ P2,
PUSHJ P,CHKPRV##
SETO P2,
IFN FTFDAE,<
PUSHJ P,TSTWRT ;%FILE STILL WRITABLE?
JRST UPDER7 ;%NO, FILDAE MUST HAVE BLESSED 2 AT ONCE
>
MOVEI T2,ACPUPD ;%INDICATE THIS FILE BEING UPDATED
MOVE T3,DEVACC##(F) ;%
HLL T3,DEVJOB(F) ;%SIM UPDATE BIT
TLNE T3,DEPSIM ;%DDB ENABLED FOR SIM UPDATE?
TRO T2,ACPSMU ;%YES, FILE IS SIM UPDATE
MOVSI T1,ACPWCT## ;%INCREMENT WRITE COUNT
ADDM T1,ACCWCT##(T3) ; %EVEN FOR NON- SIM UPDATE FILES
ORM T2,ACCSTS##(T3) ;%
PUSHJ P,INCUC ;%INCR NMB, PPB USE-COUNTS
PUSHJ P,GVCBJ## ;%GIVE UP CB RES
PUSHJ P,WAIT1##
TLNE S,IOSWLK ;IS FILE (STR) WRITE LOCKED?
JRST CPOPJ1## ;YES. TAKE GOOD RETURN (DON'T CHANGE RIB)
PUSHJ P,DDBZR ;ZERO POINTERS IN CASE OF EXTENDED RIB
TLNN M,EXTUUO ;NO. EXTENDED ENTER?
JRST UPDER1 ;NO
HRRI M,-UUXPPN(M) ;YES. POINT TO E
HLRZ U,DEVUNI##(F) ;SET U TO UNIT OF RIB
PUSHJ P,GETWDU## ;NUMBER OF ARGS/VALUES
TRZ T1,RB.BIT ;IGNORE NOISE BITS
MOVE P1,T1
HRRI M,UUXALC(M) ;POINT TO ALLOCATION WORD
CAIL P1,UUXALC
PUSHJ P,GETWDU## ;GET IT
CAIL P1,UUXALC ;SPECIFYING ALLOCATION?
SKIPGE T2,T1
JRST UPDER2 ;NO. TAKE GOOD RETURN
JUMPN T1,UPDAT3 ;SPECIFIED .RBALC IN ARGUMENT BLOCK?
HRRI M,-1(M) ;NO, POINT TO .RBEST
PUSHJ P,GETWDU##
HRRI M,1(M) ;PUT M BACK TO WHAT IT WAS
SKIPN T2,T1 ;SPECIFIED .RBEST?
JRST UPDER2 ;NO, TAKE GOOD RETURN
MOVE T3,DEVACC##(F)
SUB T2,ACCALC##(T3) ;HOW BIG IS THE FILE NOW?
JUMPLE T2,UPDER2 ;IT'S ALREADY BIGGER THAN .RBEST, RETURN
TLO M,UALASK ;INDICATE ALLOCATION
PUSHJ P,UPDALC ;ADD MORE BLOCKS AT END OF FILE
JRST UPDER2 ;QUOTA EXCEEDED, RETURN ANYWAY
JRST UPDER2 ;BLOCK NOT FREE, RETURN ANYWAY
TLZ M,UPARAL ;DO NOT GIVE PARTIAL ALLOCATION FAILURE
JRST UPDAT4 ;GO WRITE SATS
UPDAT3: MOVE T3,DEVACC##(F)
SUB T2,ACCALC##(T3) ;N-J
JUMPLE T2,DELGRP ;TRUNCATING IF NEGATIVE
;CANT GET HERE FOR SIMULTANEOUS UPDATE,
;SINCE LOOKUP STORES REAL ACCALC IN ENTER BLOCK
TLO M,UALASK ;INDICATE SPECIFYING ALLOCATION
PUSHJ P,UPDALC ;ADD MORE BLOCKS TO FILE
JRST ENERR7 ;QUOTA EXCEEDED
JRST ENERR1 ;COULDN'T START WHERE REQUESTED (E+11)
UPDAT4: PUSHJ P,WTUSAT
SKIPL DEVRIB##(F) ;EXTENDED RIB?
JRST UPDAT5 ;NO
PUSHJ P,SPTRW## ;SETUP TO WRITE NEW POINTERS
PUSHJ P,PTRWRT## ;WRITE OUT DDB RETRIEVAL POINTERS
PUSHJ P,DDBZRO ;MAKE SURE UPDFIN DOESN'T SCREW UP
UPDAT5: TLOE S,IOSRIB ;ALREADY HAVE RIB IN CORE?
JRST UPDER3 ;YES
PUSHJ P,PTRGET## ;NO, READ RIB INTO CORE
PUSHJ P,UPDSET ;ADJUST DEYRLC FOR CURRENT POSITION
JRST UPDER3 ;AND CONTINUE
;SUBROUTINE TO SEE IF WRITING A FILE IS ALLOWED
;ENTER WITH DEVACC SET UP
;EXIT CPOPJ IF FILE ALREADY BEING WRITTEN
;EXIT CPOPJ1 IF OK TO WRITE
TSTWRT: PUSHJ P,GETNMB ;%GET LOC OF NMB
MOVE T3,ACCSTS##(T2) ;%STATUS OF DDB'S A.T.
TRNE T3,ACPDEL## ;%MARKED FOR DELETION?
POPJ P, ;%YES CANT RENAME OR UPDATE
LDB T2,ACYFSN## ;%STR NO IN T2
EXCH T1,T2 ;%T=FSN, T2=LOC OF NMB
TRO T2,DIFNAL## ;%ADD OFFSET FOR NMBACC
TSTWR1: PUSHJ P,BYTSC1## ;%FIND AN A.T. FOR THIS STR
SKIPA T3,ACCSTS##(T2) ;%FOUND - GET STATUS
JRST CPOPJ1## ;%NO MORE - UPDATE IS LEGAL
TRNN T3,ACPUPD!ACPSUP!ACPREN ;%FILE BEING WRITTEN?
JRST TSTWR1 ;%NO, LOOK FOR MORE A.T.'S
TRNN T3,ACPSUP!ACPREN ;%BEING SUPERSEDED OR RENAMED?
TRNN T3,ACPSMU ;%NO, OPEN FOR SIM UPDATE?
POPJ P, ;%ERROR IF NOT UPDATE ON SIM UPDATE FILE
MOVE T3,DEVJOB(F) ;%SIM UPDATE FILE,
TLNE T3,DEPSIM ;%DDB IN SIM UPDATE MODE?
TLNN M,UUOUPD ;%AND AN UPDATE UUO?
POPJ P, ;%NOT SIM UPDATER OR RENAME UUO
JRST CPOPJ1## ;%SIM UPDATE FILE AND DDB - OK
;HERE ON 4-WORD UPDATE SET UP SIZE IN E+3
UPDER1: PUSHJ P,WRDCNT ;STORE WRDCNT IN E+3
PUSHJ P,SIMRIB ;GET FA, IF SIM UPDATE, THEN READ RIB
JRST ENERR6 ;RIB ERROR
PUSHJ P,UPDAUT ;UPDATE RIBAUT
JRST UPDFN1 ;RIBAUT DIDN'T CHANGE - LEAVE RIB ALONE
PJRST UPDFIN ;REWRITE RIB AND TAKE GOOD RETURN
;SUBROUTINE TO UPDATE RIBAUT
;ENTER WITH RIB IN MONITOR BUFFER
;EXIT CPOPJ IF RIBAUT DIDN'T CHANGE
;EXIT CPOPJ1 IF IT DID, RIBAUT UPDATED
UPDAUT: LDB T1,PJOBN## ;JOB NUMBER
MOVE T1,JBTPPN##(T1) ;IF [1,2] IS UPDATING IN [3,3],
MOVE T2,DEVPPN(F)
CAMN T1,FFAPPN##
CAME T2,SPLPPN##
SKIPA T2,.USMBF
POPJ P, ;DON'T CHANGE RIBAUT
CAMN T1,RIBAUT##+1(T2) ;RIBAUT CHANGING?
POPJ P, ;NO
MOVEM T1,RIBAUT##+1(T2) ;YES, STORE NEW VALUE
PJRST CPOPJ1## ;AND SKIP-RETURN
;SUBROUTINE TO INCREMENT NMB, PPN USE-COUNTS
;PRESERVES T2
INCUC: MOVE T1,DEVACC##(F)
MOVE T3,ACCPPB##(T1) ;%LOC OF PPB
AOS PPBCNT##(T3) ;%BUMP COUNT
HLRZ T1,ACCNMB##(T1)
TRZN T1,DIFNAL## ;%FIND NMB
JRST .-2
AOS NMBCNT##(T1) ;%BUMP ITS COUNT
POPJ P, ;%AND RETURN
;HERE WHEN ALL ALLOCATION IS DONE. SET VALUES INTO USER AREA
UPDER2: PUSHJ P,SIMRIB ;GET FA IF SIM UPDATE, READRIB
JRST UPDFN2 ;RIB ERROR
UPDER3: PUSHJ P,UPDAUT ;UPDATE RIBAUT
JFCL
SKIPGE P2 ;IF USER HASN'T GOT PRIVS TO CHANGE ATTS.
TLO M,400000 ; SET A FLAG
PUSHJ P,SETVAL ;YES, STORE USER-SUPPLIED VALUES INTO THE RIB
TLZ M,400000
MOVE T1,.USMBF
CAIE P1,3 ;DID USER SPECIFY 3-WORD BLOCK?
JRST UPDER4 ;NO, USE HIS CREATION DATE
TRNN P3,700000 ;DID HE SPECIFY BITS?
IOR P3,RIBEXT##+1(T1) ;NO, GET THEM FROM THE RIB.
UPDER4: TRNN P3,77777 ;USER SUPPLIED HI CREATION DATE
IOR P3,THSDAT## ;SUPPLY ACCESS DATE IF 0
HRRM P3,RIBEXT##+1(T1) ;SAVE IN RIB
HRRZ T2,DEVACC##(F) ;GET THE ACCESS TABLE POINTER
MOVE T3,RIBPRV##+1(T1) ;GET THE PRIVS WORD
MOVEM T3,ACCPRV##(T2) ;STORE IN THE AT
HRRZ T3,RIBEXT##+1(T1) ;GET THE ACCESS DATE, HI CREATION DATE
HRLM T3,ACCADT##(T2) ;STORE IN THE AT
;HERE WHEN ALL NON-POINTER INFO IS STORED IN RIB
UPDFIN: PUSHJ P,SPTRW## ;SET UP AN AOBJN WORD FOR THE PTRS IN THE MON BUF
PUSHJ P,PTRWRT## ;COPY POINTERS INTO MON BUF AND WRITE
UPDFN1: PUSHJ P,DWNIFA## ;IF HAVE FA, RETURN IT NOW THAT RIB IS WRITTEN
SOS T1,DEVREL##(F) ;SAVE DEVREL
TLNE T1,-1 ; FOR POSSIBLE USETO -1
SETZ T1, ;OPPS! LARGER THAN 2**18
HRLM T1,DEVLRL##(F)
PUSH P,DEVRSU##(F)
PUSHJ P,CPYFST## ;SET UP FIRST DDB NUMBERS (DEVBLK, ETC)
JFCL ;SHOULD NEVER HAPPEN
POP P,DEVRSU##(F)
PUSHJ P,GETCPY
UPDFN2: PJRST ENTXIT ;AND EXIT THE UUO
;SUBROUTINE TO GET IN-CORE COPY SPACE AND LINK IT IN
GETCPY: MOVEI T2,PTRCOR## ;WORDS NEEDED
PUSHJ P,GETWDS## ;GET SOME SPACE FOR POINTERS
POPJ P, ;NONE AVAILABLE, FORGET IT
HRRM T1,DEVCPY##(F) ;SAVE THE SPACE
HRRZ T3,DEVACC##(F) ;POINT COPY TO ACCESS TABLE
HRRM T3,PTRAT##(T1) ; FOR IDENTIFICATION
DDBSRL ;INTERLOCK THIS STUFF
MOVE T2,SYSPTR## ;INSERT THIS COPY AT FRONT OF LIST
HRLM T1,SYSPTR##
HLLM T2,PTRSYS##(T1) ;POINT THIS ONE AT FORMER FIRST
DDBSRU ;UNLOCK
PJRST CPYPTR## ;STUFF POINTERS INTO SPACE WE GOT, RETURN
;HERE TO RETURN SOME BLOCKS ON AN UPDATE ENTER
DELGRP: JUMPE T2,UPDER2 ;NO ALLOCATION IF T2=0 - FINISH UP
MOVE T2,ACCCNT##(T3) ;NUMBER OF READERS
TRNE T2,ACMCNM## ;IF MORE THAN 1 READER,
JRST UPDER6 ; CANT TRUNCATE FILE (SECURITY RISK -
; THE BLOCKS MAY BE REUSED FOR ANOTHER FILE)
PUSHJ P,PTRGET## ;READ RIB INTO MON BUFFER
PUSHJ P,GTWDT3 ;GET LAST GOOD BLOCK
MOVEI T2,0 ;RIB STARTS AT BLOCK 0
DELLUP: PUSHJ P,SCNPTR## ;FIND THE RIGHT POINTER
JRST DELGP1 ;;NOT HERE, LOOK AT OTHER RIBS
PUSH P,DEVRIB##(F) ;SAVE POINTER TO CURRENT RIB
PUSHJ P,UPDGV9 ;GIVE UP SOME BLOCKS
JRST UPDER8 ;PRIVS WONT ALLOW IT - ERROR RETURN
POP P,T1 ;RESTORE PREVIOUS DEVRIB
CAME T1,DEVRIB##(F) ;SKIP IF UPDGIV DID NOT MOVE INTO ANOTHER RIB
JRST DELG0A ;IF ANOTHER RIB, PREVIOUS CURRENT RIB ALREADY WRITTEN
;DEALLOCATION IS COMPLETE - FINISH UP
MOVE T1,.USMBF ;LOC OF MON BUF (-1)
PUSHJ P,WRTRIB## ;GO WRITE NEW RIB
SKIPL DEVRIB##(F) ;PRIME RIB IN CORE?
JRST DELG0B ;YES, PROCEED
DELG0A: PUSHJ P,REDRIB## ;READ THE PRIME RIB INTO CORE
JRST UPDFN2 ;ERROR READING RIB
DELG0B: PUSHJ P,WTUSAT ;WRITE CHANGED SAT
JRST UPDER3 ;AND FINISH UP
;HERE TO LOOK AT OTHER RIBS
DELGP1: PUSHJ P,PTRNXT## ;GET NEXT RIB, IF ANY
STOPCD .,JOB,NNR, ;++NO NEXT RIB
PUSHJ P,GETALC## ;GET REAL ACCALC (BASED ON THE EXTENDED RIB)
PUSHJ P,GTWDT3 ;GET LAST GOOD BLOCK
SUB T1,T3 ;BLKS IN FILE - HIS ARGUMENT
JUMPLE T1,UPDER2 ;NOT REALLY TRUNCATING IF NON-POS
MOVE T2,.USMBF ;IOWD FOR MONITOR BUFFER
MOVE T2,RIBFLR##+1(T2) ;FIRST BLOCK NUMBER IN CURRENT RIB
PUSHJ P,SPTRW## ;SET UP AOBJN WORD TO POINTERS IN T1
JRST DELLUP ;SCAN THIS RIB
SUBTTL LOOKUP/ENTER SETUP (INCLUDING SFD PATHS)
;SUBROUTINE TO SET UP FOR LOOKUP, ENTER
;RETURNS WITH EXTUUO ON IN LH(M) IF EXTENDED UUO, AND M POINTING TO PRJ,PRG NO.
;RETURNS P3= ORIGINAL LOOKUP NAME, P4=ORIGINAL EXT (LH=-1 IF /OVERRIDE)
;SETS UP DEVPPN ON RETURN
;ON ERROR RETURN, IF UUOREN IS ON, THE ERROR CODE IS IN T1
; M WILL POINT TO THE FILE NAME WORD
SETLER: TLZ M,UUOMSK ;ZERO BITS IN LH(UUO)
TLZ S,IOSPBF+IOSERR## ;MAKE SURE PERMANENT ERR BITS ARE OFF
SETZM DEVFIL(F) ;FOR SET WATCH FILE
IFN FTFDAE,<
PUSHJ P,CHKFCU ;CHECK IF AT COUNT IS UP FROM FILDAE
>
SETLE1: PUSHJ P,GETWDU##
SETZ T2, ;SET TO ZERO PROTECTION BYTE
DPB T2,DEYFNC## ;IN CASE OF LOOKUP WITH NO PRECEDING CLOSE
DPB T2,DEYFSN## ;IN CASE OF ENTER WITH NO PRECEDING CLOSE
MOVSI T2,DEPDSL##+DEPAUL##+DEPNLB## ;CLEAR BITS LEFT FROM PREVIOUS UUO
ANDCAM T2,DEVLLE##(F)
MOVEI T2,DEPECS ;CLEAR NO-SUPERSEDE BIT IN DDB
SKIPL DEVJOB(F)
ANDCAM T2,DEVSPL(F)
IFN FTKL10&FTMP,<
SETZM DEVNBF(F) ;CLEAR COUNTERS OF BUFFERS SWEPT FOR
SETZM DEVSBF(F)
>
TLNN T1,-1 ;NAME?
JUMPN T1,SETL11 ;NO, MUST BE EXTENDED UUO
SETLE2: TLNE M,UUOUPD ;UPDATE?
JRST CPOPJ1## ;YES. GOOD RETURN
MOVE P3,T1 ;ORIGINAL NAME FROM LOOKUP BLOCK
PUSHJ P,GETWD1## ;GET EXTENSION
HLRZ P4,T1 ;SAVE IN P4
LDB J,PJOBN##
SETZM DEVPPN(F) ;START WITH DEVPPN=0
SETZM DEVSFD##(F) ;MAKE SURE START AT UFD
PUSH P,M ;SAVE M
HRRI M,UUNPPN-UUNEXT(M) ;POINT TO PPN WORD
TLNE M,EXTUUO
HRRI M,-<3+UUXNAM-UUXPPN>(M)
MOVE T1,DEVNAM(F)
PUSHJ P,SDVTST ;IS THIS AN ERSATZ DEVICE?
JRST SETLE3 ;NO, CARRY ON
CAIE T2,LIBNDX## ;YES, IS IT A LOGICAL NAME?
JRST SETLE3 ;NO
MOVE T1,@.USLNM ;YES, POINT AT THE START
ADDI T1,LNMDEV##-LNRDEV##
HRRZM T1,DEVLNM##(F) ;SAVE IN DDB
TLNE T1,LNPOVR## ;OVERRIDE?
TLO P4,-1 ;YES, SET P4 NEGATIVE
PUSHJ P,NXTSP3 ;GO GET FIRST SPEC IN LOG NAME
CAIA
JRST SETLE9 ;NOT THERE, ERROR RETURN
PUSHJ P,GETWDU## ;GET PPN
CAME T1,MFDPPN## ;IS PPN [1,1]?
JRST SETL99 ;NO
MOVEM T1,DEVPPN(F) ;YES, OVERIDE THE IMPLIED PPN
PUSHJ P,SFDDEC ;AND WIPE THE SFD (IF ANY)
PUSHJ P,DECSFD
SETZM DEVSFD##(F)
SETL99: MOVE T1,DEVPPN(F)
PUSHJ P,PUTWDU## ;TELL USER THE PPN
JRST SETLE5
SETLE3: JUMPE P3,MPOPJ## ;IF NO LOG NAME, LOOKUP 0 IS ILLEGAL
PUSHJ P,GTWDT3 ;IS IT IS XWD 0,ADR?
SKIPLE T2,T3
TLNE T2,-1
JRST SETLE4 ;NO, PATH NOT GIVEN
HRR M,T2 ;YES, POINT M TO PATH LIST
SETOM DEVFIL(F) ;MAKE SURE A 1ST SFD NAME OF 0 DOESN'T SCAN FOR A UFD
PUSHJ P,SETPT2 ;FIND THE SFD HE WANTS
JRST SETLE9 ;NO SEARCH LIST OR NO SFD
MOVE J,.CPJOB## ;PARANOIA
SETLE4: MOVEM P3,DEVFIL(F) ;SAVE NAME IN DDB
HRLM P4,DEVEXT(F) ;SAVE EXT IN DDB
SETLE5: POP P,M ;RESTORE M
HRRZ T1,P4 ;GET EXT ALONE
CAIN T1,(SIXBIT .SFD.) ;IS THE FILE AN SFD?
TLO M,UUODIR ;YES, SET UUODIR IN M
HRRI M,UUNPPN-UUNEXT-1(M) ;POINT TO PRJ, PRG WORD
TLNE M,EXTUUO ;EXTENDED UUO HAS PRJ,PRG
HRRI M,-<2+UUXEXT-UUXPPN>(M) ; IN WORD 1
SKIPLE DEVPPN(F) ;PRJ,PRG ALREADY SET UP?
AOJA M,CPOPJ1## ;YES, PATH WAS SPECIFIED. RETURN
PUSHJ P,PPNPP0 ;GET PPN
CAMN T2,MFDPPN## ;LOOKING FOR [1,1]?
MOVE T1,T2 ;YES, DONT USE IMPLIED PPN
MOVEM T1,DEVPPN(F) ;SAVE PPN IN DDB
PUSHJ P,PUTWDU## ;TELL USER THE PPN
TLNE F,SYSDEV ;IS THIS SYS:?
JRST CPOPJ1## ;YES, GOOD RETURN
SKIPN T3 ;USE DEFAULT DIR?
CAME T1,T4 ;YES, WRITING IN DEFAULT PPN?
JRST CPOPJ1## ;NO, USE UFD
PUSHJ P,SFDPPN
HRRM T2,DEVSFD##(F) ;YES, SAVE NEW PATH
DPB T3,DEYSCN## ;SAVE SCAN SWITCH
SKIPN T1,T2 ;IS THE DEFAULT AN SFD?
PJRST CPOPJ1## ;NO, GOOD RETURN
PUSHJ P,SFDUP
PUSHJ P,INCALL ;YES, INCREMENT A.T.'S(INSURANCE FROM CORE-GRABBER)
PUSHJ P,SAVE3##
MOVE P3,NMBYES##(T1) ;P1=YES BITS
PUSHJ P,SETSRC## ;SET UP SEARCH LIST
POPJ P, ;NULL SL. WILL BE CAUGHT ELSEWHERE
MOVE P1,T1
MOVE P2,T1 ;P2=SL.PTR.
SETLE6: PUSHJ P,SLITA## ;NEXT STR IN SEARCH LIST
JRST SETLE7 ;END OF LIST, SFD WASN'T FOUND
PUSHJ P,FSNPS2## ;POSITION BIT FOR YES WORD
TDNE T2,P3 ;DOES SFD EXIST IN THIS STR?
JRST [ ;YES-GIVE UP TEMP.SL.(IF ANY) AND RETURN
MOVE P2,P1
AOS (P)
PJRST SLGVT##
]
JRST SETLE6 ;NO, TRY NEXT STR
;HERE WHEN THE SFD DOESN'T EXIST IN THE SEARCH LIST
SETLE7: MOVE P2,P1 ;GIVE UP POSSIBLE TEMP SL.
PUSHJ P,SLGVT##
HRRI M,-<UUNPPN-UUNEXT+1>(M)
TLNE M,EXTUUO
HRRI M,2+UUXEXT-UUXPPN(M) ;POINT M TO EXT, ERROR CODE WORD
MOVE T1,DEVSFD##(F) ;DECR. USE-COUNTS
PUSHJ P,DECALL
PUSHJ P,SFDDEC
TLO M,UUOREN ;FLAG TO USE ERROR IN T1
ADDI M,UUNEXT ;ACCOUNT FOR LATER SUBI
JRST SETL10 ;AND GIVE SFD-NOT-FOUND ERROR RETURN
;HERE ON ERROR RETURN FROM SETPT3
;IF THIS CODE IS EXECUTED FROM THE RENAME CODE, THE ERROR
;MUST BE PLACED INTO THE USER'S AREA BY THIS ROUTINE.
;OTHERWISE, ONLY LIGHT UUOREN AND SET THE ERROR CODE INTO T1.
;THE CODE AT ILNMER WILL SET THE ERROR INTO THE USER'S AREA
SETLE8: POP P,M
TLOA M,UUOREN
SETLE9: POP P,M ;RESTORE LOC OF NAME
TLON M,UUOREN ;TURN ON UUOREN
JRST SETL10 ;IF ENTER, ONLY SET ERROR
PUSHJ P,GETWD1## ;RENAME, GET EXTENSTION WORD
HRRI T1,SNFERR ;SFD-NOT-FOUND
PUSHJ P,PUTWDU## ;SAVE IN LOOKUP/ENTER BLOCK
SETL10: MOVEI T1,SNFERR ;GET SFD-NOT-FOUND
HLRZS DEVSFD##(F) ;MAKE SURE DEVSFD=0
SUBI M,UUNEXT ;POINT BACK AT NAME
POPJ P, ;AND TAKE ERROR RETURN
;HERE ON EXTENDED UUO
SETL11: TLO M,EXTUUO ;INDICATE EXTENDED UUO
TRZE T1,RB.NSE ;NO-SUPERSEDE ENTER?
IORM T2,DEVSPL(F) ;YES, LIGHT BIT IN DDB
SETZB U,T2 ;INDICATE NON SINGLE-ACCESS
;SET BITS FOR LIB SEARCH/UPDATE
TRZE T1,RB.DSL
TLO T2,DEPDSL##
TRZE T1,RB.AUL
TLO T2,DEPAUL##
TRZE T1,RB.NLB
TLO T2,DEPNLB##
IORM T2,DEVLLE##(F) ;AND STORE IN DDB
MOVE T2,T1
CAIL T1,UUXSTS ;IS THIS A DIRECTORY FILE ENTER?
PUSHJ P,PRVJB## ;YES, IS THIS A PRIVILEGED JOB?
JRST SETL12 ;NO, CANT ENTER A UFD
HRRI M,UUXSTS(M) ;POSSIBLY.
PUSHJ P,GTWST2##
TRNE T1,RIPDIR## ;DIR BIT ON FOR ENTER?
TLO M,UUODIR ;YES. ENTERING A UFD
HRRI M,-UUXSTS(M) ;RESET ADR. OF UUO
SETL12: HRRI M,UUXNAM(M) ;UUOCHK ADR CHECKS IF VM
PUSHJ P,GTWST2##
CAIGE T2,UUXEXT ;MUST HAVE AT LEAST 3 ARGUMENTS
POPJ P, ;NOT ENOUGH ARGUMENTS
JRST SETLE2 ;ARG BLOCK OK, KEEP ON
;SUBROUTINE TO STEP TO NEXT PART OF LOGICAL NAME SPEC
;EXIT CPOPJ1 IF NONE OR AT END
;EXIT CPOPJ IF FOUND, WITH DEVLNM, DEVSFD SET UP
;ENTER AT NXTSP3 IF USE CURRENT DEVLNM = T1 TO START
NXTSPC: LDB J,PJOBN##
HRRZS P1,DEVLNM##(F) ;LNM SPEC OF DDB
JUMPE P1,CPOPJ1## ;SKIP RETURN IF NONE
MOVS T1,LNRDEV##(P1) ;CURRENT LOGICAL NAME
MOVE T2,DEVPPN(F) ;AND PPN
CAIN T1,'SYS' ;IF IT IS SYS
CAME T2,NEWPPN## ;AND WE'RE CURRENTLY LOOKING AT NEW
JRST NXTSP2
HLRZ T1,JBTSFD##(J) ;IF USER HAS NEW ENABLED
TRNN T1,JBPXSY##
JRST NXTSP2
MOVE T1,SYSPPN## ;THEN DO SYS NOW
JRST NXTS12
NXTSP0: HLLZS DEVSFD##(F) ;SETPTH MAY HAVE LEFT JUNK
MOVE J,.CPJOB##
NXTSP2: PUSHJ P,NXTILN ;GET NEXT PART OF SPEC
JRST CPOPJ1## ;NOT A LOGICAL NAME
NXTSP3: HRRZ P1,DEVLNM##(F) ;ADDR OF CURRENT SPEC
SKIPN LNRNAM##(P1) ;ZERO FILENAME?
JUMPE P3,NXTSP2 ;BOTH ZERO, TRY NEXT SPEC
MOVE T1,LNRDEV##(P1) ;GET NAME
PUSHJ P,SDVTS1 ;ERSATZ DEVICE?
JRST NXTSP9 ;NO, USE PPN AS GIVEN
JUMPN T2,NXTSP8 ;YES. SYS?
MOVE J,.CPJOB##
HLRZ T1,JBTSFD##(J) ;YES. IS NEW ENABLED?
TRNE T1,JBPXSY##
MOVEI T2,NEWNDX## ;YES. USE NEW PPN
NXTSP8: SKIPG T1,@SDVPPN##(T2) ;IMPLIED PPN FOR ERSATZ DEV?
JRST NXTSP9 ;NO
NXTS12: SKIPN LNRPPN##(P1) ;YES, IS PATH SPECIFIED?
JRST NXTS11 ;NO, USE ERSATZ PPN
JRST NXTS13 ;USE ERSATZ PPN AND PATHOLOGICAL SFDS
NXTSP9: SKIPN T1,LNRPPN##(P1) ;GET PPN, IS IT DEFAULT?
JRST NXTSP4 ;YES, SET UP FOR IT
NXTS13: SKIPN LNRSFD##(P1) ;NO, IS THERE AN SFD?
JRST NXTS11 ;NO, UFD
NXTSP4: PUSHJ P,SETPT1 ;YES, SET UP FOR THE SFD
JRST NXTSP0 ;CAN'T FIND IT, STEP TO NEXT PART OF SPEC
SKIPA J,.CPJOB##
NXTS11: PUSHJ P,PPNXWD ;SAVE PPN IN DDB
SKIPE T1,LNRNAM##(P1) ;PATHOLOGICAL NAME HAVE A FILE NAME?
JUMPL P4,NXTSP6 ;YES, USE IT IF /OVERRIDE
SKIPE P3 ;NOT /OVERRIDE, LOOKUP NAME GIVEN?
MOVE T1,P3 ;YES, USE NAME FROM LOOKUP BLOCK
NXTSP6: MOVEM T1,DEVFIL(F) ;SAVE NAME IN DDB
SKIPE T1,LNREXT##(P1) ;PATHOLOGICAL NAME HAVE AN EXTENSION?
JUMPL P4,NXTSP7 ;YES. USE IT OF /OVERRIDE
TRNE P4,-1 ;NOT /OVERRIDE. EXT IN LOOKUP BLOCK?
HRL T1,P4 ;YES, USE IT
NXTSP7: HLLM T1,DEVEXT(F) ;SAVE EXT IN DDB
POPJ P,
;ROUTINE TO STORE PPN
;T1 PASSES PPN (-1 IN EITHER HALF MEANS LOGGED IN PPN)
PPNXWD: MOVE J,.CPJOB##
TLC T1,-1 ;NO, WANT LOGGED IN PROJ NUMBER?
TLCN T1,-1
HLL T1,JBTPPN##(J) ;YES
TRC T1,-1 ;WANT LOGGED IN PROG NUMBER?
TRCN T1,-1
HRR T1,JBTPPN##(J) ;YES
MOVEM T1,DEVPPN(F) ;SAVE PPN IN DDB
POPJ P,
;SUBROUTINE TO FIND NEXT DEV, PPN, SFD SET IN LOG NAME SPEC
;NON-SKIP RETURN IF END, OR NOT A LOGICAL NAME
;SKIP-RETURN IF LOG NAME, WITH T1=RH(DEVLNM)=NEXT DEVICE IN SPEC
NXTILN: HRRZ T1,DEVLNM##(F) ;LOGICAL NAME SPEC
JUMPE T1,CPOPJ## ;NOT THERE
ADDI T1,LNRPPN## ;POINT AT PPN SPEC (OR END)
SKIPE (T1) ;FIND THE END OF THIS PART
AOJA T1,.-1
SKIPN 1(T1) ;AT END OF ENTIRE SPEC?
POPJ P, ;YES, NO NEXT PART
ADDI T1,1 ;NO, POINT DDB AT NEXT PART OF SPEC
MOVEM T1,DEVLNM##(F)
JRST CPOPJ1## ;AND GOOD RETURN
;SUBROUTINE TO GET NEXT SFD IN SPEC
;NON-SKIP RETURN IF NOT USING A LOGICAL NAME
;SKIP RETURN IF LOGICAL NAME, T1=NEXT SFD (CAN BE 0)
NXTSLN: SKIPN T1,DEVLNM##(F) ;IN LOG NAME?
POPJ P, ;NO
MOVE T2,LNRPPN##(T1) ;YES. GET PPN
TLNN T1,-1 ;1ST TIME HERE?
SKIPE T2 ;DEFAULT PATH?
JRST NXTSL6 ;NOT DEFAULT PATH OR ALREADY SET UP
HRRZ T2,.USLNM ;POINT AT TEMP SPACE
ADDI T2,LNMMAX##+MAXLVL##-2 ;AT TOP
SETZM 1(T2) ;TERMINATE THE SPEC
HRRZ T1,JBTSFD##(J)
TRZ T1,JBPSCN##
JUMPE T1,NXTSL5 ;GET PPN FROM JBTPPB IF NO JBTSFD
TRZE T1,JBPUFB## ;DEFAULT PATH AN SFD?
JRST NXTSL4 ;UFB - GET IT, DONT STORE SFDS
HLRZ T4,NMBACC##(T1) ;SFD - POINT TO ITS AT
MOVE T4,ACCPPB##(T4) ;PRESERVE POINTER TO PPB
JRST NXTSL2 ;GO STORE THIS SFD NAME IN TEMP SPACE
NXTSL1: HLRZ T1,NMBPPB##(T1) ;LINK
TRZN T1,NMPUPT## ;POINT AT FATHER SFD?
JUMPN T1,NXTSL1 ;NO, GO TO NEXT
JUMPE T1,NXTSL3
NXTSL2: MOVE T3,NMBNAM##(T1)
MOVEM T3,(T2)
SOJA T2,NXTSL1
NXTSL3: MOVE T1,T4 ;GET PPB POINTER BACK
NXTSL4: SKIPA T1,PPBNAM##(T1) ;GET PPN
NXTSL5: MOVE T1,JBTPPN##(J)
MOVEM T1,DEVPPN(F)
MOVSI T1,(T2) ;POINT JUST BEFORE 1ST SFD SPEC
NXTSL6: TLNN T1,-1 ;ALREADY POINTING AT AN SFD?
JRST NXTSL7 ;NO, POINT AT 1ST SFD
HLRZS T1 ;YES, POINT AT THIS SFD
AOSA T1 ;STEP TO NEXT PART
NXTSL7: ADDI T1,LNRSFD##
HRLM T1,DEVLNM##(F) ;SAVE IN DDB
MOVE T1,(T1) ;GET SFD NAME (OR 0 IF UFD)
JRST CPOPJ1## ;AND SKIP-RETTURN
;HERE IF WE COULDN'T SET UP LIB AGAIN AFTER ENTER COULDN'T FIND THE FILE
LNMSTP: STOPCD .+1,DEBUG,LND, ;++LOGICAL NAME NOT FOUND
POP P,(P)
JRST LKENER
;ROUTINE TO GET THE PPN
;ENTER M POINTING TO USERS ARG (-1)
;ENTER AT CURPPX IF NO USER ARG
;EXIT T1=PPN, T2=SPECIFIED PPN IF SPECIAL DEV, OTHERWISE LH(T2)=0
; EXIT T4=JOBS DEFAULT PPN
;CURPPN RETURNS NON-SKIP IF USE DEFAULT PPN(E+3=0)
; IT RETURNS CPOPJ1 IF E+3 POSITIVE
;CURPPX ALWAYS RETURNS NON-SKIP
CURPPX::HRRZ T2,F
CAIN T2,DSKDDB## ;GET DEVNAM IF NOT PROTOTYPE
SKIPL T1 ;T1 A CHAN NUMBER?
MOVE T1,DEVNAM(F) ;YES, GET NAME
PUSH P,T1 ;SAVE ON PD LIST
PUSHJ P,SFDPPN ;GET DEFAULT PPN
SETZ T3,
JRST CURPPY ;AND CONTINUE
CURPPN: PUSHJ P,SFDPPN ;GET DEFAULT
PUSHJ P,GETWD1## ;GET USERS ARG
MOVEI T3,1
PUSH P,DEVNAM(F) ;SAVE NAME
JUMPG T1,[AOS -1(P) ;IF NOT SPECIFIED
SETZ T3,
JRST CURPP1]
CURPPY: MOVE T1,T4 ;T1=DEFAULT PPN
CURPP1: EXCH T1,(P) ;SAVE PPN, GET NAME
PUSH P,T4
PUSH P,T3
PUSHJ P,SDVTST ;SPECIAL DEV?
MOVEI T2,ZPPNDX## ;NO, POINT T2 AT @0
MOVE T3,@SDVPPN##(T2) ;YES, GET ITS PPN
CAME T3,SYSPPN## ;IF SYS
CAMN T3,NEWPPN## ;OR NEW,
CAIA ;YES, IT'S GOLDEN
CAMN T3,OLDPPN## ;NO, OLD PPN IS LAST CHANCE
TLOA F,SYSDEV ;YES, LIGHT SYSDEV
TLZ F,SYSDEV ;NOT SYS, CLEAR THE BIT IN F
POP P,T3
CAIE T2,LIBNDX## ;LOGICAL NAME?
JRST CURPP2 ;NO
MOVE T1,@.USLNM ;YES, GET PPN FROM SPECIFICATION
MOVE T1,LNMPPN##(T1)
MOVEM T1,-1(P) ;SAVE AS DEFAULT PPN
CURPP2: POP P,T4
SKIPG T1,@SDVPPN##(T2) ;YES, IS THERE AN IMPLIED PPN?
JRST TPOPJ## ;NO, RETURN
ADDM T3,-1(P) ;YES, SKIP RETURN IF CALL TO CURPPN
JUMPN T2,T2POPJ## ;LOOKING FOR SYS?
MOVE T2,JBTSFD##(J) ;YES, WANT NEW?
TLNE T2,JBPXSY##
MOVE T1,NEWPPN## ;YES
PJRST T2POPJ## ;THROW AWAY OLD PPN AND RETURN
;ROUTINE TO GET CURRENT PPN, SET DEPPP0
;CALL, EXIT SAME AS CURPPN
;ALWAYS RETURNS CPOPJ
PPNPP0: PUSHJ P,CURPPN ;GET PPN
TDZA T3,T3 ;PPN=0
MOVEI T3,1 ;PPN NON-0
TLNE F,SYSDEV ;SYS?
MOVEI T3,0 ;YES, SET SO NEW: SEARCHES SYS
DPB T3,DEYPP0## ;REMEMBER STATE OF PPN WORD
POPJ P, ;RETURN
PTHUUO::PUSHJ P,SAVE4## ;SAVE P1
HRR M,T1 ;LOC OF ARG LIST
HLRZ P4,T1 ;N-3 INTO P4
SKIPE P4 ;MAKE 0 ARGS DEFAULT TO 3
SUBI P4,3 ;NO. OF ARGS-3
JUMPL P4,ECOD11## ;1 OR 2 ARGS ILLEGAL
PUSHJ P,GETWDU## ;GET VALUE
PTHUU1: HLRE P2,T1 ;GET JOB NUMBER
SKIPLE P2 ;IF .LE. 0
CAILE P2,JOBMAX## ; OR TOO HIGH
MOVE P2,.CPJOB## ;USE CURRENT JOB
TLNN T1,770000
HRRES T1 ;GET ARGUMENT
MOVN T2,T1
SKIPLE T2
CAILE T2,MXPATH
JRST PTHU13
JRST @PTHDSP-1(T2)
PTHDSP: PTHU20 ; -1 READ DEFAULT PATH
PTHUU3 ; -2 SET DEFAULT PATH
PTHUU2 ; -3 SET LIB, SYS, NEW
PTHU12 ; -4 READ LIB, SYS, NEW
PTHSLN ; -5 SET LOGICAL NAME
PTHRLN ; -6 READ LOGICAL NAME
MXPATH==.-PTHDSP
PTHUU2: SETOB P1,P4 ;SET SOME FLAGS
PUSHJ P,GETWD1## ;GET ARGUMENT
TRNN T1,PT.DTL## ;DONT CHANGE LIST?
SOJA M,PTHUU3 ;NO, DO REGULAR STUFF
ANDI T1,CORXTR## ;YES, CLEAR OUT FUNNY BITS
MOVE T2,JBTSFD##(J) ;GET CURRENT DEFAULT
TLZ T2,CORXTR##
TLO T2,(T1) ;SET NEW LIB/SYS BITS
MOVEM T2,JBTSFD##(J) ;SAVE AS CURRENT DEFAULT
JRST CPOPJ1## ;AND GOOD RETURN
PTHUU3: PUSHJ P,FAKDDB ;SET UP A DDB FROM FREE CORE
POPJ P, ;NO FREE CORE LEFT - CANT SET THE PATH
MOVEM P4,DEVNAM(F) ;STORE N-3 IN NAME
PUSHJ P,SETPT2 ;SET UP THE DEFAULT PATH
PJRST PTHUU6 ;SOME SFD WASN'T THERE
JUMPL P4,PTHUU7 ;SET LIB, SYS IF -3
MOVE T2,DEVSFD##(F)
TRNN T2,JBPUFB## ; IF POINTING AT UFD
PUSHJ P,SFDDEC
PUSHJ P,SFDPPJ ;GET OLD DEFAULT
HLRZ P2,T1 ;SAVE LOC OF SFD NMB OR PPB
LDB T1,DEYSCN## ;GET VALUE OF SCAN-SWITCH
OR T1,DEVSFD##(F) ;PLUS L(SFD NMB)
HRRM T1,JBTSFD##(J) ;SET AS NEW DEFAULT
MOVE P1,T4 ;SAVE OLD PPN
SKIPE T1,T2 ;IS THERE AN OLD SFD?
PUSHJ P,DECALL ;YES, DECREMENT ITS USE-COUNTS
CAMN P1,DEVPPN(F) ;OLD PPN=NEW PPN?
JRST PTHUU5 ;YES, FINISH UP
MOVE T1,P1 ;NO, GET OLD PPN
CAME T1,JBTPPN##(J) ;SAME AS JOB'S PPN?
PUSHJ P,PTHCHX ;NO, CLEAN UP OLD DEFAULT
MOVE T1,DEVPPN(F) ;NEW DEFAULT PPN
CAMN T1,JBTPPN##(J) ;IS IT JOB'S PPN?
JRST PTHUU5 ;YES
PUSHJ P,SFDPPN ;NO, GET L(PPB)
HLRS T1
PTHUU4: MOVEI T2,PPPNLG## ;PRETEND NEW DEFAULT PPN IS LOGGED IN
ORM T2,PPBNLG##(T1)
PTHUU5: PUSHJ P,TSTPPB ;DELETE PPB IF UNUSED
PUSHJ P,CLRDDB ;RETURN THE DDB
PJRST CPOPJ1## ;AND TAKE GOOD RETURN
;HERE ON ERROR RETURN FROM SETPT3
PTHUU6: PUSHJ P,TSTPPB ;DELETE PPB IF NOW UNUSED
PUSHJ P,CLRDDB ;RETURN THE DDB TO FREE CORE
LDB T1,PUUOAC## ;GET CALLI AC
HRR M,T1 ;INTO ADDRESS OF M
PJRST RTM1## ;RETURN -1 AS INDICATION OF FAILURE
;HERE TO SET UP A LIB
PTHUU7: PUSHJ P,GETWDU## ;GET ARGUMENT
JUMPN T1,PTHUU8 ;CLEARING LIB?
SETZM .PDOSL##(W)
PUSHJ P,FNDLB ;YES, FIND OLD LIB
JRST PTHUU9 ;NOT THERE
MOVSI T1,LN.LIB## ;CLEAR LIB SPEC
ANDCAM T1,@.USLNM
JRST PTHUU9 ;AND CONTINUE
PTHUU8: SETO P4, ;DEFINE A LOGICAL NAME
PUSHJ P,PTHSL ; SO WE DONT HAVE TO SPECIAL CASE THE OLD STUFF
PJRST CLRDDB ;CANT DEFINE IT - ERROR RETURN
PTHUU9: PUSHJ P,FNDPDS##
HRRZ T2,DEVSFD##(F) ;LIB, SYS, AND NNEW
PUSHJ P,GTWST2##
SKIPN T1 ;CLEARING LIB?
ANDI T2,CORXTR## ;YES, IGNORE WHAT SETPTH SAID
MOVEM T1,.PDOSL##(W) ;SAVE OLD-STYLE LIB
MOVE J,.CPJOB##
HLRZ P2,JBTSFD##(J) ;OLD LIB
HRLM T2,JBTSFD##(J) ;SAVE NEW LIB, SYS BITS
TRZ P2,CORXTR## ;ZAP THE EXTRA BITS
JUMPE P2,PTHU10 ;GO IF NO OLD LIB
TRZ T2,CORXTR##
CAMN T2,P2 ;
JRST PTHU10 ; OR IF OLD LIB = NEW
;HERE IF THERE IS AN OLD LIB
MOVE T1,PPBNAM##(P2) ;GET PPN
PUSHJ P,PTHCHX ;FINISH UP IF NOW NO USER OF THE PPN
PTHU10: SETO T1,
HLRZ T2,JBTSFD##(J) ;IS THERE A NEW LIB?
TRNN T2,-1-CORXTR##
PUSHJ P,PTXUDF ;NO, UNDEFINE THE OLD ONE
JRST PTHU11 ;NO OLD LIB
PUSHJ P,PTHSL2 ;RETURN THE SPACE FOR IT
JFCL
PTHU11: HRRZ T1,DEVSFD##(F) ;NEW PPB INTO T1
TRZ T1,CORXTR## ;CLEAR /SYS/NEW
JRST PTHUU4 ;GO SET IT LOGGED-IN
;HERE TO READ LIB, SYS
PTHU12: HLRZ T1,JBTSFD##(P2) ;LIB, SYS,NEW
ANDI T1,CORXTR## ;JUST SYS, NEW
PUSHJ P,PUTWD1## ;TELL USER
MOVE T1,P2 ;JOB# IN T1
MOVE T2,JBTSTS##(T1) ;IS JOB NUMBER ASSIGNED?
TLNN T2,JNA##
PJRST ECOD7## ;NO, GIVE ERROR CODE PTNSJ%
PUSHJ P,FPDBT1## ;GET POINTER TO JOB'S PDB
PJRST NPJSTP## ;NO PDB FOR JOB, GIVE STOPCD AND ERROR RETURN
MOVE T1,.PDOSL##(T1) ;OLD STYLE LIB
PUSHJ P,PUTWD1## ;TELL USER
PJRST CPOPJ1## ;AND TAKE SKIP-RETURN
;HERE WHEN TRYING TO READ THE PATH
PTHU13: PUSHJ P,DVCNSG## ;GET DDB
PJRST ECOD0## ;NONE - RETURN 0 TO USER
SETOM P3 ;SET ALL FLAGS.
TDO P1,[-1-<PT.PHO##,,0>] ;MAINTAIN STATE OF PT.PHO (PHONLY)
MOVE T2,DEVMOD(F)
TLNN T2,DVDSK ;DSK?
PJRST RTZER## ;NO, RETURN 0
HRRZ T2,F ;ADR OF DDB (SYSDEV MIGHT BE ON)
CAIE T2,DSKDDB## ;PROTOTYPE DDB?
MOVE T1,DEVNAM(F) ;NO, GET NAME
PUSHJ P,ALIASD## ;IS IT DSK?
TLZ P1,PT.GEN## ;YES, CLEAR A BIT
PUSHJ P,SDVTSP ;SPECIAL DEVICE?
JRST PTHU14
MOVE P3,T2 ;SAVE INDEX
HRL P3,T3 ;LH P3=0 IF DEV, 1 IF DEVX
HRR P1,T4 ;SAVE LOGICAL NAME INDEX
CAIN T2,LIBNDX## ;LOGICAL NAME?
PUSHJ P,SDVTS1 ;YES, ALSO AN ERSATZ DEVICE?
JRST PTHU15 ;NO
TLZA P1,PT.ESZ## ;YES, MAKE P1 POSITIVE
PTHU14: MOVSI T1,'DSK'
PTHU15: HRRZ T2,DEVACC##(F) ;LOC OF AT
JUMPE T2,PTHU16 ;NO OPEN FILE, NAME='DSK'
LDB T2,ACYFSN## ;AN OPEN FILE, GET STR NUMBER
MOVE T1,@TABSTR##(T2) ; TELL USER STR NAME
;FALL INTO PTHU16
PTHU16: CAIE P3,LIBNDX##
JRST PTHU17
MOVE T4,P1
MOVE T4,@.USLNM
MOVE T1,LNMDEV##(T4)
PTHU17: PUSHJ P,PUTWDU## ;STORE IT FOR USER
LDB T3,DEYSCN## ;SCAN-SWITCH
HRRZ T2,DEVACC##(F) ;IF NO A.T.
JUMPE T2,PTHU18 ; FILE HAS BEEN CLOSED
HRRZ T2,DEVSFD##(F) ;LOC OF SFD NMB
SKIPE T4,DEVPPN(F) ;PPN SET UP?
JRST PTHU21
JRST PTHU19
PTHU18: CAIE P3,LIBNDX##
JRST PTHU19
HRRO T2,T4 ;LOG NAME-REMEMBER LOC
SKIPA T4,LNMPPN##(T4)
PTHU19: PUSHJ P,SFDPPN ;NO, TELL HIM DEFAULT PPN
TRZ T3,JBPUFB## ;SO SCAN BITS WILL BE CORRECT
TLNE F,SYSDEV
MOVE T4,SYSPPN##
JRST PTHU21 ;CONTINUE
;HERE TO READ DEFAULT PATH
PTHU20: SETO P3,
SETZ P1, ;INSURE PT.JSL GETS SET
MOVEI F,DSKDDB## ;FAKE UP F
MOVE J,P2 ;JOB NUMBER
PUSHJ P,SFDPPN ;GET DEFAULT
TRZ T3,JBPUFB## ;MASK OUT DEFAULT=UFB BIT
PTHU21: MOVEI T1,1(T3) ;INTERNAL SCAN-SWITCH +1
HLRZ T3,JBTSFD##(J) ;LIB, SYS, NEW
TRZE T3,777774 ;CLEAR EVERYTHING BUT SYS,NEW
TRO T1,PT.LIB## ;LIB NON-0 , LIGHT A BIT
LSH T3,2 ;POSITION SYS,NEW BITS
TRO T1,(T3) ;LIGHT THEM IN T1
JUMPL P3,PTHU22 ;IF A SPECIAL DEVICE,
TLNN P1,PT.ESZ## ;BOTH LOGICAL NAME AND ERSATZ DEVICE?
TRO T1,PT.EDA## ;YES, LITE A BIT
HRRZ T3,SDVTBL##(P3) ; GET SEARCH-LIST TYPE
TLZN P3,-1 ;WAS IT DEVX?
IOR T1,T3 ;NO, RETURN TYPE TO USER
SKIPE @SDVPPN##(P3) ;IF THERE IS AN IMPLIED PPN
TRO T1,PT.IPP## ;LIGHT A BIT
PTHU22: TLNN P1,PT.GEN## ;GENERIC DSK?
TRO T1,PT.JSL## ;YES, LIGHT JOB SEARCH LIST
PUSH P,T4 ;PROTECT T4 IN CASE OF ABSURD USAGE
CAIE P3,LIBNDX## ;IF A LOGICAL NAME
JRST PTHU30 ;NO
HRRZ T4,P1 ;GET LOGICAL NAME INDEX
MOVE T4,@.USLNM ;GET ADDRESS OF ENTRY
MOVE T4,LNMPLN##(T4) ;GET NAME
AOJE T4,PTHU30 ;IF OLD-STYLE LIB:, CAN'T GET INFO (SEE PTHRL5)
TRO T1,PT.DLN## ;HE CAN GET MORE INFO WITH PATH
PTHU30: MOVE T4,DEVPTB##(F)
TLNE T4,DEPFFS## ;FOUND BY SCANNING?
TRO T1,PT.FFS##
TLNE T4,DEPFFL## ;FOUND IN LIB?
TRO T1,PT.FFL##
PUSHJ P,PUTWD1## ;TELL THE USER
POP P,T4
CAIN P3,LIBNDX## ;LIB OR LOGICAL NAME?
JRST PTHU25 ;YES, PPN ALREADY SET UP
JUMPL P3,PTHU25 ;IF A SPECIAL DEVICE,
JUMPN P3,PTHU23 ; IF SYS
HLRZ T1,JBTSFD##(J) ; IS NEW ON FOR USER ?
TRNE T1,JBPXSY##
MOVEI P3,NEWNDX## ; YES, RETURN NEWPPN
PTHU23: JUMPGE P2,PTHU24 ;IF ASKING FOR NAME.EXT,
MOVE T1,DEVFIL(F) ; TELL HIM
PUSHJ P,PUTWD1##
HLLZ T1,DEVEXT(F)
PUSHJ P,PUTWD1##
PTHU24: HRRZ T1,DEVACC##(F) ;LOOKUP DONE?
JUMPN T1,PTHU25 ;YES, GO TELL THE TRUTH
SKIPLE T1,@SDVPPN(P3) ;IS THERE AN IMPLIED PPN?
TDZA T2,T2 ;YES, FLAG NOT TO USE SFDS FROM DEFAULT PATH
PTHU25: MOVE T1,T4 ;DEFAULT PPN
PUSHJ P,PUTWD1## ;SAVE FOR USER
JUMPLE P4,CPOPJ1## ;RETURN IF THAT'S ALL HE WANTS
JUMPL T2,PTHU29 ;GO IF PATH.[SIXBIT /LOGNAM/]
PUSH P,[0] ;SAVE TERMINATOR
JUMPE T2,PTHU28 ;DONE IF HAVE A 0 NAME
PTHU26: PUSH P,NMBNAM##(T2) ;GET THE NEXT NAME
PTHU27: HLRZ T2,NMBPPB##(T2) ;SCAN FOR FATHER SFD
TRZN T2,NMPUPT##
JUMPN T2,PTHU27
JUMPN T2,PTHU26 ;SAVE ITS NAME AND CONTINUE
PTHU28: POP P,T1 ;READ A NAME FROM LIST
SOSL P4
PUSHJ P,PUTWD1## ;STORE IT IN USERS AREA
JUMPN T1,PTHU28 ;GET NEXT
PJRST CPOPJ1## ;DONE - GOOD RETURN
;HERE ON A LOGICAL NAME. GIVE PATH OF 1ST COMPONENT
PTHU29: MOVE T1,LNMSFD##(T2) ;GET SFD
PUSHJ P,PUTWD1## ;TELL USER
JUMPE T1,CPOPJ1## ;TERMINATE ON END OF SFD'S
SOJLE P4,CPOPJ1## ;TERMMINATE ON FILLING BLOCK
AOJA T2,PTHU29 ;TELL HIM NEXT SFD
;HERE TO SET A LOGICAL NAME
PTHSLN: CAILE P4,1 ;LEGAL NUMBER OF ARGS?
CAILE P4,LNMMXL##-1
JRST ECOD1## ;NO, ERROR 1
ADDI M,2 ;YES, POINT AT LOGICAL NAME
PUSHJ P,GETWDU## ;GET IT
JUMPE T1,ECOD5## ;MUST NOT BE BLANK
PUSHJ P,DEVLG## ;IS THERE A LOGICAL NAME ALREADY DEFINED?
CAMN T1,[SIXBIT /DSK/] ;NO, TRYING TO DEFINE LOG NAME "DSK"?
JRST ECOD5## ;YOU LOSE
SUBI M,1 ;POINT M BACK AT BITS
MOVEI F,DSKDDB## ;FAKE UP F FOR LNMTST
;CALLED FROM PATH FUNCTION -3 (SET LIB)
;WIPES OUT P ACS
PTHSL: SKIPE T1,.USLNM ;LOGICAL NAME TABLE EXIST?
JRST PTHSL1 ;YES
MOVEI T2,LNMMAX##+MAXLVL##+1 ;NO, GET SPACE FOR TABLE, TEMP SPACE
PUSHJ P,GTFWDC##
JRST ECOD4## ;NO FUNNY SPACE AVAILABLE
HRLI T1,T4
MOVEM T1,.USLNM ;SAVE ADDR (INDEXED BY T4) IN UPMP
SETZM (T1)
MOVS T2,T1 ;MAKE SURE THE TABLE IS EMPTY
HRRI T2,1(T1)
BLT T2,LNMMAX##(T1)
PTHSL1: JUMPL P4,PTHSL4 ;GO IF CALLED FROM PATH FNCN -3
PUSHJ P,GETWDU## ;GET BITS
TLNN T1,LN.UDF## ;UNDEFINE A LOGICAL NAME?
JRST PTHSL4 ;NO
;HERE TO DELETE A LOGICAL NAME
PUSHJ P,PTHUDF ;UNDEFINE THE NAME
JRST ECOD3## ;NO SUCH NAME
PTHSL2: MOVEI T1,@.USLNM ;POINT AT THIS LOGICAL NAME
SKIPN T3,1(T1) ;IS IT THE LAST NAME IN TABLE?
JRST PTHSL3 ;YES
MOVEI T2,1(T1) ;NO, FIND LAST
SKIPE 1(T2)
AOJA T2,.-1
MOVE T3,(T2) ;GET LAST LOGICAL NAME
SETZM (T2) ;CLEAR THE SPACE
PTHSL3: EXCH T3,(T1) ;SAVE PREVIOUS LAST NAME (OR 0) IN THIS SPACE
SETZ T4, ;SEE IF FIRST LOGICAL NAME TABLE SLOT ZERO
SKIPE @.USLNM ;(WE UNDEFINED LAST LOGICAL NAME SPEC)
JRST PTHSL5 ;NO
PUSH P,T3 ;SAVE LIBEDNESS FLAG
MOVEI T1,LNMMAX##+MAXLVL##+1 ;GIVE UP THE LOGICAL NAME TABLE SPACE
HRRZ T2,.USLNM
PUSHJ P,GVFWDS##
SETZM .USLNM ;FORGET ABOUT IT
POP P,T3 ;RESTORE LIBEDNESS FLAG
PTHSL5: JUMPGE T3,PTHS12 ;EXIT IF IT WASN'T LIB WE UNDEF'D
PUSHJ P,GETCB## ;WE GOT RID OF LIB - RETURN CORE BLOCKS
PJRST PTHS11 ; IF THIS IS LAST USER OF THAT PPN
;HERE TO DEFINE A LOGICAL NAME
PTHSL4: MOVE P1,T1 ;PRESERVE BITS
PUSHJ P,PTHUDF ;UNDEFINE PREVIOUS SPEC FOR THIS NAME
TDZA T4,T4 ;NO PREVIOUS SPEC. START AT BEGINNING
JRST PTHSL6 ;THERE WAS ONE, USE ITS TABLE SLOT
SKIPE @.USLNM ;FIND FIRST FREE TABLE SLOT
AOJA T4,.-1
CAILE T4,LNMMAX##-1 ;REACHED END OF TABLE?
JRST ECOD2## ;YES, TOO MANY NAMES TO DEFINE A NEW ONE
;HERE WITH T4=INDEX TO NEW NAME
PTHSL6: SKIPGE T2,P4 ;CALLED BY PATH. FNCN -3?
MOVEI T2,4 ;YES, 4 WDS ("DSK", 0 NAME, 0 EXT, PPN)
ADDI T2,3 ;ACCOUNT FOR OVERHEAD WORDS
DPB T2,LNYLEN## ;SAVE LENGTH OF THIS ENTRY
MOVEI P2,@.USLNM ;POINT AT TABLE ENTRY
MOVE P3,T1 ;SAVE NAME
PUSHJ P,GTFWDC## ;GET FUNNY SPACE FOR THE SPECIFICATTION
JRST [SETZM (P2) ;NOT ENOUGH FUNNY SPACE
JRST ECOD4##]
HRRM T1,(P2) ;SAVE ADDR OF SPEC IN TABLE
MOVEM P3,LNMPLN##(T1) ;SAVE LOGICAL NAME
MOVEI P3,LNMDEV##(T1) ;POINT AT DEV (DSK, UNIT, STR,...)
JUMPL P4,[MOVSI T1,'DSK' ;IF CALLED BY PATH. -3
MOVEM T1,(P3) ; NAME IS "DSK"
SETZM 1(P3) ;NO NAME
SETZM 2(P3) ;NO EXT
ADDI P3,2 ;POINT AT PPN
MOVE T1,DEVPPN(F) ; PPN IS GOTTEN FROM DDB
AOJA P3,PTHSL9] ;SAVE PPN AND FINISH UP
;FALL INTO PTHSL7 IN NOT PATH. -3
PTHSL7: MOVEI R,LNRPPN## ;ALWAYS READ 1ST FEW ARGUMENTS
AOSA M ;SKIP NODE
PTHSL8: JUMPE T1,PTHSL7 ;DO NEXT PART IF DONE WITH THIS
PUSHJ P,GETWD1## ;GET AN ARGUMENT
PTHSL9: MOVEM T1,(P3) ;REAL ARG - SAVE IT
SOSL R ;IN 1ST PART (NODE, DEV, NAME, EXT)?
MOVEI T1,1 ;YES. MAKE SURE WE DONT TERMINATE
SOSLE P4 ;MORE TO GO?
AOJA P3,PTHSL8 ;YES, GET NEXT PART OF SPEC
SETZM 1(P3) ;INDICATE WE ARE AT END
SETZM 2(P3)
MOVSI T1,LNPOVR##
ANDCAM T1,(P2) ;CLEAR BITS IN SPEC
TLNN P1,LN.OVR## ;/OVERRIDE?
TLZ T1,LNPOVR## ;NO
IORM T1,(P2) ;SAVE BITS IN SPEC WORD
MOVSI T1,LN.LIB##
HLL P2,(P2) ;GET OLD LIB SPEC
ANDCAM T1,(P2) ;CLEAR LIBEDNESS
TLNN P1,LN.LIB## ;WAS IT FORMERLY A LIB?
JUMPGE P4,PTHS10 ;NO (IF NOT PATH. -3)
PUSHJ P,FNDLB ;FIND OLD LIB
CAIA ;NO OLD LIB
ANDCAM T1,@.USLNM ;CLEAR LIBEDNESS FROM OLD LIB
IORM T1,(P2) ;SET LIBEDNESS IN NEW LIB
JUMPL P4,PTHS12 ;DONE IF PATH. -3
PUSHJ P,FNDPDS##
SETZM .PDOSL##(W) ;NO OLD-SYLE LIB
CAIA
;FALL INTO NEXT PAGE
;DROPS INTO HERE FROM PREVIOUS PAGE
PTHS10: JUMPGE P2,PTHS12 ;WAS THERE AN OLD LIB?
PUSHJ P,GETCB## ;YES
HLRZ T2,SYSPPB## ;%START AT 1ST PPB IN SYSTEM
HRRZ T3,(P2) ;%GET NEW LIB PPN
MOVE T1,LNMPPN##(T3)
PUSHJ P,LSTSRC## ;%FIND NEW LIB PPB (CREATE IF NONEXISTENT)
JUMPE T2,[PUSHJ P,GVCBJ## ;%EXIT IF NO CORE BLOCKS
SOS (P)
JRST PTHS12]
MOVEI T3,PPPNLG##
SKIPGE P2 ;%IS THERE A NEW LIB?
PTHS11: TDZA T2,T2 ;%NO
IORM T3,PPBNLG##(T2) ;%YES, PRETEND (1ST) PPN IS LOGGED IN
HLRZ P2,JBTSFD##(J) ;%GET OLD SYS/NEW BITS
TRZ P2,-1-CORXTR##
TRO T2,(P2) ;%INSERT NEW LIB PPN ADDR
HLRZ P2,JBTSFD##(J) ;%SAVE OLD LIB
HRLM T2,JBTSFD##(J) ;%STORE NEW LIB
PUSHJ P,GVCBJ## ;%RETURN CB RESOURCE
CAIN P2,(T2) ;OLD LIB+NEW LIB?
JRST PTHS12 ;YES, DONE
TRZ P2,CORXTR## ;NO SAVE ADDR OF OLD PPB
PUSHJ P,FAKDDB ;LOGTST WILL REWRITE OLD UFD RIB
JRST PTHS12 ;NO SPACE FOR FAKE DDB, GOOD EXIT
MOVE T1,PPBNAM##(P2) ;GET OLD LIB PPN
PUSHJ P,PTHCHX ;REWRITE UFD RIB IF NOW NOT LOGGED IN
PUSHJ P,CLRDDB ;GIVE UP THE FAKE DDB
PTHS12: JRST CPOPJ1## ;AND TAKE GOOD RETURN
;HERE ON PATH. -6 (READ LOGICAL NAMES)
PTHRLN: CAILE P4,0 ;NUMBER OF ARGUMENTS LEGAL?
CAILE P4,LNMMXL##-1
JRST ECOD1## ;NO
MOVEI F,DSKDDB## ;LNMTST LOOKS AT DDB
PUSHJ P,GETWD1## ;YES, GET ARGUMENT
MOVE P1,T1 ;SAVE BITS
PUSHJ P,GETWD1## ;GET NEXT WORD (WHERE TO START)
SKIPE T4,T1 ;WANT FIRST NAME?
AOJA P1,PTHRL3 ;NO
SKIPE T1,.USLNM ;YES, ANY NAMES AT ALL?
AOJA P1,PTHRL5 ;YES, GET 1ST
PTHRL1: AOS (P) ;NO, RETURN 0 (END)
PJRST PUTWDU##
;HERE WHEN USER SPECIFIES WHERE TO START
PTHRL3: PUSHJ P,LNMTST ;FIND THIS LOGICAL NAME
JRST ECOD6## ;NONE SUCH NAME - ERROR
TLNN P1,LN.RIT## ;RETURN INFO ABOUT THIS NAME?
PTHRL4: ADDI T4,1 ;NO, POINT TO NEXT NAME
PTHRL5: SKIPN T1,@.USLNM ;GET SPEC FOR THIS NAME
JRST PTHRL1 ;DONE - RETURN 0
MOVE T2,LNMPLN##(T1) ;IF -1 IT IS OLD-STYLE LIB
AOJE T2,PTHRL4 ; SO DON'T TELL ABOUT IT
TDZ T1,[-1-LN.LIB##-LNPOVR##,,-1] ;SAVE LIBEDNESS
TLZE T1,LNPOVR## ;/OVERRIDE?
TLO T1,LN.OVR## ;YES
SUBI M,1 ;POINT AT BITS
PUSHJ P,PUTWDU## ;TELL CALLER IF THIS IS LIB
MOVE P1,@.USLNM ;POINT AT SPEC
MOVE T1,(P1) ;GET PATHOLOGICAL NAME
PUSHJ P,PUTWD1## ;TELL USER
ADDI P1,1 ;POINT AT DEV
PTHRL6: MOVEI P3,LNRPPN##+1 ;ALWAYS STORE FIRST ARGS
SOS P1 ;ACCOUNT FOR LATER ADDI
TDZA T1,T1 ;STORE A ZERO FOR NODE
PTHRL7: MOVE T1,(P1) ;GET NEXT WORD OF SPEC
PUSHJ P,PUTWD1## ;TELL USER
SOJLE P4,CPOPJ1## ;DONE IF NO MORE SPACE IN CALLERS BLOCK
ADDI P1,1 ;POINT AT NEXT PART OF SPEC
SOJGE P3,PTHRL7
JUMPN T1,PTHRL7 ;GET NEXT SFD IF DIDN'T END
SKIPE (P1) ;END OF THIS PART. FINAL PART?
JRST PTHRL6 ;NO, STORE NEXT PART
SETZB T1,P4 ;YES, MAKE SURE WE EXIT
PUSHJ P,PUTWD1## ;STORE THE 2ND 0
JRST PTHRL7 ;AND STORE THE FINAL ZERO
;SUBROUTINE TO UNDEFINE A LOGICAL NAME
;ENTER WITH M POINTING AT THE NAME -1
;RETURNS CPOPJ IF NO MATCH, CPOPJ1 IF MATCH WITH T1=NAME
;RETURNS T4=INDEX IN LOG NAME TABLE IF A MATCH
PTHUDF: SKIPL T1,P4 ;CALLED BY PATH. -3 ?
PUSHJ P,GETWD1## ;NO, GET NAME
PTXUDF: PUSHJ P,LNMTST ;FIND ITS SLOT
POPJ P, ;NO SUCH NAME
PTKUDF: PUSH P,T1
PUSH P,T4
LDB T1,LNYLEN## ;NO OF WORDS FOR THIS SPEC
HRRZ T2,@.USLNM ;ADDR OF SPEC
PUSHJ P,GVFWDS## ;RETURN THE SPACE
POP P,T4
JRST TPOPJ1## ;AND RETURN
;SUBROUTINE TO SET UP THE PATH
;ENTER WITH M POINTING TO THE 1ST WD IN THE PATH SPEC, J= JOB NUMBER
;ENTER WITH DEVSFD=0
;IF DEVNAM IS POSITIVE, IT IS ASSUMED TO BE A COUNT OF SFD LEVELS (PTHUUO)
;IF DEVNAM=-1 IT IS ASSUMED THAT THE CALL IS TO SET A LIBRARY
;EXIT CPOPJ IF NO SEARCH LIST OR A NAME IN THE PATH ISN'T FOUND
;EXIT CPOPJ1 NORMALLY, WITH DEVSFD SET UP, USE CNTS UP IN SFD AT'S
;0 FOR PPN MEANS DEFAULT (NOT NECCESSARILY JOB'S PPN)
;ENTER WITH T1=LOC OF "FORBIDDEN" NMB-ERROR IF THIS
; NMB IS ON THE PATH (USED BY RENAME TO PREVENT A DIRECTORY INCONSISTENCY)
;ENTER AT SETPT2 IF ANY SFD IS LEGAL
;ENTER AT SETPT1 IF GETTING SFDS FROM LOGICAL NAME SPEC (WITH T1=PPN)
SETPT1: PUSHJ P,SAVE4##
SETZB P1,P2 ;NO SCAN, NO FORBIDDEN NMB
DPB P1,DEYSCN## ;CLEAR SCAN SWITCH
PUSHJ P,PPNXWD ;SAVE PPN IN DDB
SETOM DEVFIL(F) ;DON'T CALL FNDFIL IF 1ST SFD IS ZERO
PJRST SETPT7 ;AND KEEP ON TRUCKIN
SETPT2:
SETPT3: PUSHJ P,SAVE4##
MOVE P2,T1 ;SAVE FORBIDDEN NMB LOC
HRRZ T1,M
PUSHJ P,SETP16 ;ADDRESS CHECK ARGUMENTS (MIGHT GET EUE
MOVE T3,M ;GET SET TO ADDRESS-CHECK THE ARGUMENTS
MOVE T2,SFDLVL## ;GET MAX. NUMBER OF SFD'S
HRRI M,1(M) ;GO TO WORD BEFORE FIRST SFD
SETPT4: MOVEI T1,1(M) ;GET ADDRESS OF NEXT SFD
PUSHJ P,SETP16 ;ADDRESS-CHECK IT
PUSHJ P,GETWD1## ;GET SFD SPEC ITSELF
SKIPE T1 ;HIT ZERO?
SOJGE T2,SETPT4 ;NO, GO UNTIL SFD LVL IS REACHED
MOVE M,T3 ;RESTORE M
PUSHJ P,GETWD1##
ANDI T1,3
MOVE P1,T1 ;SCANNING SWITCH
AOSN DEVNAM(F) ;DEVNAM=-1?
TROA P1,400000 ;YES, P1 WILL BE NEGATIVE
SOSA DEVNAM(F) ;NO, RESET DEVNAM
JRST SETPT6 ;WANT ALL OF WORD IF LIB
JUMPN P1,SETPT5 ;IF NO CHANGE,
MOVE P1,JBTSFD##(J) ;GET OLD VALUE
ANDI P1,JBPSCN##
JRST SETPT6
SETPT5: CAIE T1,2 ;IF HE IS SPECIFYING IT
TDZA P1,P1 ;2 MEANS NO SCAN,
MOVEI P1,JBPSCN## ;OTHERWISE SCAN
SETPT6: HRLZS P1 ;SAVE IN LH(P1)
DPB P1,DEYSCN## ;SCAN SWITCH=0 FOR NOW
HLLZS DEVSFD##(F) ;START AT UFD
PUSHJ P,PPNPP0 ;GET PPN
MOVEM T1,DEVPPN(F) ;SAVE AS PPN
SKIPN DEVNAM(F) ;IF NOT SETTING LIB,
JRST SETPT7
PUSHJ P,PUTWRD## ;TELL USER
JRST ADRERR## ;CANT STORE IN PROTECTED JOB DATA AREA
SETPT7: TLO M,UUOLUK ;INDICATE LOOKUP
MOVSI T1,(SIXBIT .SFD.)
MOVEM T1,DEVEXT(F) ;PREPARE TO LOOKUP SFD'S
PUSH P,DEVUNI##(F) ;SAVE DEVUNI (FNDFIL WILL CHANGE IT)
SKIPN T1,DEVNAM(F) ;UFD IF DEVNAM ALREADY IS ZERO
AOSA DEVNAM(F) ;SET DEVNAM NON-ZERO
SETPT8: JRST [PUSHJ P,NXTSLN ;GET NEXT SFD IN LOGICAL NAME
PUSHJ P,GETWD1## ;NOT LOG NAME, GET USERS ARG
JRST .+1]
SKIPE DEVFIL(F) ;IF NOT 1ST TIME,
JUMPE T1,SETP12 ; 0 TERMONATES THE LIST
MOVEM T1,DEVFIL(F) ;SAVE SFD NAME (0 MEANS UFD)
MOVSI P3,DEPPRV## ;DON'T CHECK PRIVS
IORM P3,DEVPRV##(F) ; IN LOWER SFDS
PUSHJ P,SETSRC## ;SET UP SEARCH LIST
JRST SETP14 ;NONE - ERROR
MOVE T2,T1
;SO CHK PRV WONT BE CALLED
MOVE P4,S ;SAVE IOSRDC
PUSHJ P,FNDFIL## ;LOOKUP NAME.SFD
JRST SETP14 ;NOT FOUND
TLNN P4,IOSRDC
TLZ S,IOSRDC ;IOSRDC IS FOR FILE, NOT SFD
MOVEM S,DEVIOS(F) ; SO CLEAR IT
ANDCAM P3,DEVPRV##(F)
PUSHJ P,SFDDEC ;DECR NMB USE-COUNT
SKIPN DEVFIL(F) ;LOOKING FOR UFD?
JRST SETP10 ;YES
;NO, FALL INTO NEXT PAGE
;HERE WHEN NAME.SFD WAS FOUND BY FNDFIL
PUSHJ P,DECSFD ;DECREMENT USE-COUNTS OF OLD SFD
PUSHJ P,GETNMB ;FIND NMB FOR NEW SFD
CAMN T1,P2 ;THE FORBIDDEN NMB?
JRST SETP13 ;YES, ERROR
HRRM T1,DEVSFD##(F) ;SAVE AS CURRENT SFD
PUSHJ P,INCSFD ;INCREMENT ITS USE-COUNTS
SKIPL T1,DEVNAM(F) ;IF DEVNAM IS A POSITIVE NUMBER
TLNE T1,-1
JRST SETPT9
SOSG DEVNAM(F) ;DECR BY 1
AOJA P1,SETP12 ;DONE ALL HE ASKED FOR - RETURN
SETPT9: MOVEI T1,1(P1) ;COUNT LEVEL UP
CAIGE T1,MAXLVL## ;TOO HIGH?
AOJA P1,SETPT8 ;NO, TRY NEXT NAME IN USERS LIST
AOJA P1,SETP12 ;YES, DONE
;HERE ON GOOD RETURN FROM FNDFIL WITH DEVFIL=0 (LOOKING FOR UFD)
SETP10: HRRZ T1,DEVACC##(F) ;SAVE DEVACC (LOC OF UFB)
TLZE P1,400000 ;SETTING LIB?
TSOA T1,P1 ;YES, COPY SYS AND NEW BITS
TRO T1,JBPUFB## ;NOT LIB, INDICATE UFD
HRRM T1,DEVSFD##(F) ;SAVE IN DDB
SETP12: HLRZS P1 ;SCAN SWITCH
DPB P1,DEYSCN## ;SAVE IN DDB
POP P,DEVUNI##(F) ;RESTORE DEVUNI
HRRZ U,DEVUNI##(F) ; AND U
HLLZS T2,DEVACC##(F) ;WANT TO RECOMPUTE PROTECTION
DPB T2,DEYFNC## ; SO SET THE BYTE=0
PJRST CPOPJ1## ;AND TAKE GOOD RETURN
;HERE ON ERROR RETURN FROM SETSRC OR FNDFIL
SETP13: HRRZ T1,DEVACC##(F) ;DECREMENT FAILING SFD'S
PUSHJ P,DECONE ; USE COUNT
JRST SETP15
SETP14: PUSHJ P,DECSFD ;DECR USE COUNT
PUSHJ P,SFDDEC
SETP15: HLLZS DEVACC##(F) ;ZERO DEVACC
ANDCAM P3,DEVPRV##(F)
POP P,DEVUNI##(F)
POPJ P, ;AND ERROR RETURN
SETP16: TRNE T1,-20
PUSHJ P,UADRCK##
POPJ P,
;LOGICAL END OF SLSTR, PUT IN FILUUO WITH REST OF PATH STUFF
;FIXES UP ACCESS TABLES, ACCESS TABLE COUNTS WHEN AN STR IS ADDED TO S.L.
; AND THE DEFAULT PATH IS IN AN SFD
;WIPES OUT P1-P4, RETURNS CPOPJ1
;ENTER, EXIT WITH CB
ADJPT:: PUSHJ P,SFDPPN ;% GET DEFAULT PATH
JUMPE T2,CPOPJ1## ;%NOTHING TO DO IF IT ISN'T AN SFD
SETZB P1,P3 ;%
PUSHJ P,FAKDDB ;%GET A DDB TO WORK WITH
JRST ADJPT6 ;%NO FREE CORE, HOPE FOR THE BEST
ADJPT1: PUSHJ P,SFDPPJ ;%GET DEFAULT SFD
JUMPN P1,ADJPT2 ;%IF FIRST TIME,
HRLI M,UUOLUK ;%INDICATE LOOKUP
EXCH P3,F ;%ZERO F CAUSE WE ALREADY HAVE CB
PUSHJ P,DECALL ;%DECREMENT USE-COUNTS IN CURRENT SFD A.T'S
MOVE F,P3 ;%RESTORE F
MOVEM T4,DEVPPN(F) ;%SAVE PPN
MOVSI T2,'SFD' ;%SAVE EXTENSION
MOVEM T2,DEVEXT(F)
ADJPT2: CAIN P1,(T1) ;%ARE WE AT DEFAULT PATH?
JRST ADJPT5 ;%YES, FINISH UP
MOVE T2,T1 ;%NO, SAVE CURRENT SFD
ADJPT3: HLRZ T1,NMBPPB##(T1) ;%SEARCH FOR ITS FATHER SFD (OR UFD)
TRZN T1,NMPUPT##
JUMPN T1,ADJPT3
CAIN T1,(P1) ;%ARE WE THERE?
JRST ADJPT4 ;%YES
MOVE T2,T1 ;%NO, SAVE THIS AS CURRENT
JUMPN T1,ADJPT3 ;%AND FIND ITS FATHER
JRST ADJPT7 ;%SYSTEM ERROR
ADJPT4: HRRM T1,DEVSFD##(F) ;%SAVE FATHER SFD
MOVE T1,(T2) ;%GET NAME OF CURRENT SFD
MOVEM T1,DEVFIL(F) ;%SAVE IT FOR FNDFIL
MOVE T2,ALLSRC##
MOVE P2,JBTSFD##(J)
HLLZS JBTSFD##(J) ;%DON'T WANT FILFND TO MESS WITH SFDS
PUSHJ P,FNDFLA## ;%GO LOOKUP THIS SFD
JRST ADJPT8 ;COULDN'T?
MOVE J,.CPJOB##
MOVEM P2,JBTSFD##(J) ;RESTORE DEFAULT SFD
PUSHJ P,GETNMB ;GET NMB, AT FOR THIS SFD
HRRM T1,DEVSFD##(F) ;SAVE SFD NMB LOC
HRRZ P1,T1 ;SAVE WHERE WE ARE NOW
PUSHJ P,SFDEC ;DECREMENT PPB,NMB CNTS WHICH FILFND INCR'D
PUSHJ P,GETCB##
MOVNI T1,ACPCNT## ;%DECREMENT USE-COUNT
ADDM T1,ACCCNT##(T2) ;%IN CURRENT AT
JRST ADJPT1 ;%AND GO LOOKUP NEXT SFD (IF NOT UP TO DEFAULT)
;HERE WHEN "REAL" SFD HAS BEEN LOOKED UP
ADJPT5: HRRZ T1,DEVSFD##(F) ;%CURRENT SFD (=DEFAULT)
SETZ F, ;%CAUSE WE HAVE CB
PUSHJ P,INCALL ;%BUMP USE-COUNTS IN ALL AT'S
MOVE F,P3
PUSHJ P,CLRDDB ;%RETURN THE DDB
ADJPT6: SETZ F,
JRST CPOPJ1## ;%AND GOOD RETURN
;HERE WHEN FILE.SFD CANT BE FOUND
ADJPT8: PUSHJ P,GETCB## ;GETCB BACK
ADJPT7: MOVE J,.CPJOB##
HLLZS JBTSFD##(J) ;%CLEAR DEFAULT SFD
PJRST ADJPT6 ;%AND FINISH UP
;ROUTINE TO FIX THE ACC USE COUNT
;BUMPS THE COUNT ONCE FOR EACH JOB THAT HAS HIS PATH SET TO THE SFD
;T1 PASSES ADDR OF NMB
;T2 PASSES ADDR OF ACC
;PRESERVES ALL AC'S
FIXPTH::PUSHJ P,SAVE3## ;PRESERVES AC'S
HLRZ P1,NMBRNG##(T1) ;ONLY IF SFD
JUMPE P1,CPOPJ##
MOVE P1,HIGHJB## ;SET UP LOOP
MOVEI P3,ACPCNT##
FXPTH1: HRRZ P2,JBTSFD##(P1) ;IS HIS PATH HERE?
TRZ P2,CORXTR##
CAMN P2,T1
ADDM P3,ACCCNT##(T2) ;YES, BUMP COUNT
SOJG P1,FXPTH1 ;TEST EACH JOB
POPJ P,
;SUBROUTINE TO INCREMENT/DECREMENT THE USE-COUNT OF AN SFD A.T.
;ENTER WITH T1=LOC OF THE A.T.
;ENTER WITH F=0 IF HAVE CB
;EXIT T1=LOC OF THE A.T.
INCONE: SKIPA T2,[EXP ACPUSE##];SET TO INCR. COUNT
DECONE::MOVNI T2,ACPUSE## ;SET TO DECR COUNT
PUSHJ P,GETCBX##
ADDM T2,ACCUSE##(T1) ;%UPDATETHE USE COUNT
JUMPGE T2,INCON2 ;%
MOVE T2,ACCUSE##(T1) ;%IF DECREMENTING,
TRNN T2,ACMUCT##+ACPREN+ACPCRE ;%IF NOW UNUSED,
SKIPE ACCDOR##(T1) ;%
PJRST GVCBJX## ;%
PJRST ATSDRA## ;%MAKE THE A.T. DORMANT
INCON2: SKIPN T2,ACCDOR##(T1) ;%IF INCREMENTING,
PJRST GVCBJX## ;%
EXCH T1,T2 ;%
PUSHJ P,UNLINK## ;%MAKE UNDORMANT IF IT WAS DORMANT
MOVE T1,T2 ;%
PJRST GVCBJX## ;%
;SUBROUTINE TO INCREMENT/DECREMENT THE A.T. OF THE FATHER SFD FOR A FILE
INCUSA: SKIPA T1,INCLOC
DECUSA: MOVEI T1,DECONE
PUSH P,T1 ;WHERE TO GO
PUSHJ P,UFORSS## ;FIND UFB OR SFD A.T.
TRZN T2,NMPSFU## ;SFD?
PJRST TPOPJ## ;NO, RETURN
MOVE T1,T2 ;YES, A.T. LOC INTO T1
INCLOC: POPJ P,INCONE ;GO INCR OR DECR THE USE-COUNT
;SUBROUTINE TO INCREMENT ALL A.T.'S FOR AN SFD
;ENTER WITH T1=LOC OF SFD NMB
;EXIT WITH T1=LOC OF SFD NMB
;ENTER WITH F=0 IF HAVE CB
INCALL: SKIPA T2,INCLOC
DECALL::MOVEI T2,DECONE
PUSH P,F
PUSHJ P,GETCBX## ;GET CB IF DONT HAVE IT ALREADY
SETZ F, ;INDICATE NOW HAVE CB
PUSH P,T2 ;WHERE TO GO
HLRZ T1,NMBACC##(T1) ;1ST A.T. LOC
DECAL1: TRZE T1,DIFNAL## ;BACK TO THE NMB?
JRST DECAL2 ;YES, FINISH UP
HRL T1,ACCSTS##(T1) ;STILL BEING CREATED?
TLNN T1,ACPCRE
PUSHJ P,@(P) ;NO, GO INCR OR DECR
HLRZ T1,ACCNMB##(T1) ;STEP TO NEXT A.T.
JRST DECAL1 ;AND DO IT
DECAL2: POP P,(P) ;REMOVE GARBAGE FROM PD LIST
POP P,F ;RESTORE F (MAY STILL BE 0)
PJRST GVCBJX## ;RETURN CB IF GOT IT ABOVE
;SUBROUTINE TO DECREMENT ALL A.T.'S FOR THE FATHER SFD EXCEPT
; THE ONE FOR THE STR ON WHICH THE FILE ACTUALLY IS
;(NEEDED SINCE SETLER INCREMENTS ALL A.T.'S, BUT AFTER THE LOOKUP/ENTER
; PICKS AN STR, ONLY THAT A.T. SHOULD HAVE ITS COUNT UP)
DECMST: PUSHJ P,UFORSF## ;FIND SFD A.T. OR UFB
JRST DECMS1
TRZN T2,NMPSFU## ;SFD?
POPJ P, ;NO
MOVE T1,T2 ;YES, GET ITS LOC IN T1
PUSHJ P,INCONE ;INCR ITS USE-COUNT (DECSFD WILL DECR ALL AT'S)
;AND FALL INTO DECSFD
;SUBROUTINE TO DECREMENT ALL A.T.'S FOR THE FATHER SFD
DECSFD: HRRZ T1,DEVSFD##(F) ;LOC OF SFD NMB
JUMPE T1,CPOPJ##
PJRST DECALL ;DECR ALL A.T. COUNTS
;SUBROUTINE TO INCREMENT ALL SFD'S FOR THE FATHER SFD EXCEPT C(DEVACC)
;NEEDED SINCE FNDFIL INCREMENTS THE USE-COUNT OF THE 1ST SFD A.T. IN THE RING
; WHEN A LOOKUP IS DONE ON THE SFD
INCSFD: HRRZ T1,DEVSFD##(F) ;L(NMB)
PUSHJ P,INCALL ;INC ALL USE-COUNTS
HRRZ T1,DEVACC##(F) ;THEN DECR THE RIGHT ONE
PJRST DECONE
;HERE IF NO SFD AT WAS FOUND
DECMS1: HLLZ T2,DEVSFD##(F) ;RENAMING ACCROSS SFD's?
JUMPN T2,CPOPJ## ;YES, THIS IS OK
PJRST BNTSTP## ;NO, CRASH
;ROUTINE TO EXTRACT INFORMATION ABOUT THE DEFAULT SFD AND PPN
;ENTER AT SFDPPJ IF J IS NOT SET UP (GET FROM DDB)
;ENTER AT SFDPPN IF J=JOB NUMBER
;ENTER AT SFDPP1 WITH T1=LOC OF SFD
;EXIT CPOPJ WITH T4=PPN
;T3=JBPUFB & JBPSCN BITS
;T2=0 IF NO DEFAULT OR DEFAULT IS A BARE UFD, ELSE = L(SFD NMB)
;T1=JBTSFD, WITH EXTRANEOUS BITS =0
;LH(T1)= L(PPB) IF A DEFAULT IS GIVEN (RH(T1) NOT 0)
SFDPPJ: LDB J,PJOBN## ;JOB NUMBER
SFDPPN: HRRZ T1,JBTSFD##(J) ;LOC OF DEFAULT SFD
SFDPP1: SETZB T2,T3
JUMPE T1,SFDPP2 ;RETURN PPN IF NO DEFAULT
LDB T3,SFYSCU## ;JBPUFB & JBPSCN
TRZ T1,CORXTR## ;ZERO EXTRANEOUS BITS
HRLS T1 ;LH(T1)=L(PPB) IF JBPUFB=1
TRNE T3,JBPUFB## ;IS IT A UFB?
SKIPA T4,PPBNAM##(T1) ;YES, T4=PPN
SKIPA T2,T1 ;NO, T2=L(SFD NMB)
POPJ P, ;RETURN IF A UFB
HLRZ T4,NMBACC##(T1) ;L(1ST A.T. IN RING)
TRNE T4,DIFNAL## ;IS THERE AN A.T.?
JRST SFDPP2 ;NO. SYSTEM ERROR?
MOVE T4,ACCPPB##(T4) ;YES, GET L(PPB)
HRL T1,T4 ;SAVE IN LH(T1)
SKIPA T4,PPBNAM##(T4) ;SET T4=PPN
SFDPP2: MOVE T4,JBTPPN##(J) ;PPN=JOB'S PPN
POPJ P,
;SUBROUTINE TO SEE IF THIS IS THE ONLY USER OF A PPN
;CALL WITH T1=PPN, J=JOB NUMBER
;EXITS POPJ IF THERE IS ANOTHER JOB WITH THIS PPN, OR SOME JOB
; HAS A DEFAULT PATH IN THIS PPN
;EXITS CPOPJ1 IF NO OTHER JOB IS USING PPN
;EXITS UNDER THE NOSCHED MACRO, WITH T1=PPN
ONLYTS: CAME T1,SYSPPN## ;IF CUSP
CAMN T1,MFDPPN## ; OR MFD
POPJ P, ;PRETEND STILL LOGGED IN
CAMN T1,SPLPPN## ;IF QUEUE AREA
POPJ P, ; PRETEND STILL LOGGED IN
PUSHJ P,SAVE1##
PUSH P,J ;SAVE J
NOSCHEDULE
MOVE P1,T1 ;SAVE PPN
MOVE J,HIGHJB##
ONLYT1: CAMN J,(P) ;DON'T TEST THE JOB FOR WHICH WE'RE LOOKING
JRST ONLYT3
HLRZ T1,JBTSFD##(J) ;LOC OF LIB
TRZ T1,CORXTR## ;ZAP THE EXTRA BITS
SKIPE T1 ;0 IF NO LIB
MOVE T1,PPBNAM##(T1) ;PPN
CAMN T1,P1 ;IS IT THE RIGHT ONE?
JRST ONLYT2 ;YES, NON-SKIP RETURN
PUSHJ P,SFDPPN ;GET DEFAULT PPN
CAME P1,T4 ;IS IT THIS PPN?
CAMN P1,JBTPPN##(J) ;IS IT JOB'S PPN?
ONLYT2: SOSA -1(P) ;YES, SET FOR NON-SKIP RETURN
ONLYT3: SOJG J,ONLYT1 ;NO, TEST NEXT JOB
POP P,J ;RESTORE J
MOVE T1,JBTPPN##(J) ; AND PPN
PJRST CPOPJ1## ;TAKE SKIP OR NON-SKIP RETURN
;SUBROUTINE TO CLEAN UP WHEN CHANGING DEFAULT SFD'S FROM ONE PPN TO ANOTHER
;ENTER WITH T1= OLD PPN, P2=LOC(PPB) - AS RETURNED BY SFDPPN
;ENTER AT PTHCHX IF THIS JOB SHOULD BE LOOKED AT
;(E.G. CHANGING LIB, BUT DEFAULT PATH FOR THAT PPN EXISTS)
PTHCHX: SETZ J,
PTHCHG: PUSHJ P,ONLYTS ;ANY OTHER JOB WITH THIS PPN?
JRST [LDB J,PJOBN## ;YES, RETURN
POPJ P,]
PUSHJ P,GTMNBF## ;NO, GET A MON-BUF
MOVE T1,PPBNAM##(P2) ;PPN
MOVEM T1,DEVPPN(F) ;SAVE IN DDB
AOS PPBCNT##(P2) ;PROTECT AGAINST OTHER CLOSERS
MOVEI T1,PPPNLG## ;INDICATE PPN NOT LOGGED-IN
ANDCAM T1,PPBNLG##(P2)
HLRZ T1,PPBUFB##(P2) ;LOC OF 1ST UFB
JUMPE T1,PTHCH2
PTHCH1: HRRM T1,DEVUFB##(F) ;SAVE IN DEVUFB
LDB T1,ACZFSN## ;STR NUMBER
MOVE T1,TABSTR##(T1)
HLRZ U,STRUNI##(T1) ;SET U TO 1ST UNIT IN STR
PUSHJ P,STOAU## ;SAVE IN DDB
PUSHJ P,LOGTS1 ;GO REWRITE UFD WITH NEW QUOTAS
MOVE T1,DEVUFB##(F) ;STEP TO NEXT UFB
HLRZ T1,UFBPPB##(T1)
JUMPN T1,PTHCH1 ;REWRITE IT
PTHCH2: SCHEDULE
SOS PPBCNT##(P2)
PUSHJ P,TSTPP1 ;DELETE THE 4-WORD CORE BLOCKS FOR THE PPB
LDB J,PJOBN## ;RESTORE JOB NO
POPJ P, ;AND EXIT
SUBTTL RENAME
RENAM: PUSHJ P,NULTST ;ON DEVICE NUL
PJRST CPOPJ1## ;RENAME WINS
MOVE T1,DEVLIB##(F) ;IF FILE NOT IN UFD, BUT IN LIB
TLNE F,LOOKB ; MAKE RENAME ILLEGAL
TLNN T1,DEPLIB## ; (ERROR 0 IF LOOKUP FAILED)
SKIPN DEVFIL(F) ;IS THERE AN OPEN FILE?
JRST RENER4 ;NO. ERROR RETURN
TLNE S,IOSWLK ;STR WRITE LOCKED?
JRST RENER3 ;YES. ERROR RETURN
RECLSD: PUSHJ P,SAVE4## ;SAVE P1-P4
TLZ M,UUOMSK ;ZERO INDICATOR BITS IN M
MOVE P2,M ;SAVE ORIGINAL ADDRESS
PUSHJ P,GTWST2## ;GET 1ST WORD
JUMPE T1,RENAM1 ;RENAMING TO ZERO
TLNE T1,-1 ;EXTENDED UUO?
JRST RENAM1 ;NO
MOVE P3,T1 ;YES, SAVE NUMBER OF ARGS
TLO P2,EXTUUO ;SET EXTENDED BIT
HRRI M,UUXNAM(M) ;POINT TO FILENAME
PUSHJ P,GTWST2## ;GET IT
RENAM1: TLNE F,LOOKB+ENTRB ;DOES HE HAVE A FILE OPEN?
JRST RENAM2 ;YES
HRRZS T3,DEVSFD##(F) ;NO, WAS PREVIOUS FILE IN AN SFD?
JUMPE T3,RENAM2 ;NOT SFD, LET HIM DO IT
PUSHJ P,SFDPPN ;WE CAN'T BE SURE THAT THE NMB DEVSFD
HRRZM T2,DEVSFD##(F) ; POINTS TO IS STILL THERE, SO FORGET
MOVEM T4,DEVPPN(F) ; DEVSFD AND USE DEFAULT PATH INSTEAD
PUSHJ P,SFDUP ;BUMP PPBCNT AND NMBCNT
RENAM2: ;FALL INTO NEXT PAGE
TLNN F,ENTRB ;AN ENTER BEEN DONE?
JRST RENAM3 ;NO
;HERE ON A RENAME WITH AN OPEN OUTPUT FILE - HAVE TO CLOSE IT
;SINCE WE WILL NEED THE DDB POINTER SPACE TO READ THE UFD
HRRI M,0 ;THESE BITS MEAN THINGS TO CLOSE
TLNE F,LOOKB ;CREATE OR UPDATE?
SETO T1, ;UPDATE, CLSRST WON'T MAKE IT GO AWAY
SKIPN T1 ;DELETE A CREATE?
TROA M,CLSRST ;YES, TELL CLOSE NOT TO ENTER IN UFD
PUSHJ P,SFDUP ;NO, BUMP THE COUNTS SO THAT THE BLOCK
; DEVSFD POINTS TO WON'T GO AWAY WHILE THE
; FILE IS CLOSED.
PUSH P,DEVUPP##(F) ;SAVE "IN YOUR BEHALF" PPN
PUSHJ P,CLOSE1## ;CLOSE THE FILE
POP P,DEVUPP##(F) ;RESTORE PPN THAT CLOSE1 BLEW AWAY
TRNE M,CLSRST ;DELETE A CREATE?
JRST CPOPJ1## ;YES, ALL DONE
RENAM3: MOVE M,P2 ;RESTORE ORIGINAL ADDRESS
PUSHJ P,WAIT1##
PUSHJ P,DDBZR ;OUTPUT CLOSE WANTS TO CALL DD2MN
TLO M,UUOLUK ;INDICATE LOOKUP FOR FNDFIL
HLRZ U,DEVUNI##(F) ;SET U IN CASE DON'T GO TO FNDFIL
JUMPE U,RENM3A ;U MAY BE ZERO IF RENAME AFTER CLOSE (MAYBE LEGAL)
PUSHJ P,CHEKU## ;CHECK IF STR YANKED
JRST RENER5 ;PRETEND FILE NOT FOUND
RENM3A: HRRZ P2,DEVACC##(F) ;LOC OF ACCES BLOCK
JUMPN P2,RENAM5 ;DON'T HAVE TO LOOKUP IF THERE
PUSHJ P,SETSRC## ;SET UP SEARCH LIST
POPJ P, ;NULL LIST - SHOULD NEVER HAPPEN
MOVE T2,T1 ;SEARCH LIST INTO T2
PUSHJ P,FNDFIL## ;SET UP AN ACCESS BLOCK FOR IT
JRST RENER5
PUSHJ P,INCUSA ;INCREMENT USE-COUNT OF FATHER SFD
PUSH P,DEVUFB##(F) ;SAVE DEVUFB IN CASE OF FAILURE
PUSHJ P,RENAM4 ;AND GO DO REST OF RENAME
PJRST REFAIL ;ERROR - FIX UP ACCESS TABLE
;(UUOCON WONT DO A CLOSE SINCE THE RENAME FAILED)
PJRST TPOPJ1## ;GOOD RETURN
;HERE ON RENAME FAILURE
REFAIL: TLZ S,IOSRIB ;INVALIDATE RIB IN MONITOR BUFFER (SECURITY)
POP P,DEVUFB##(F) ;RESTORE DEVUFB
HRRZ T1,DEVACC##(F)
JUMPE T1,CLOSIN
PUSHJ P,CLSNAM
PJRST CLOSIN ;FIX ACCESS TABLE AND EXIT
RENAM4: TLO F,LOOKB ;SET SO CLOSE INPUT WILL HAPPEN
TLZ F,OCLOSB+ICLOSB
SKIPA P2,DEVACC##(F) ;LOC OF A.T. INTO P2
RENAM5: PUSHJ P,CLSNAM ;GET REAL NAME OF FILE (IN CASE OF UNSUCCESSFUL
; RENAME DEVFIL, DEVEXT ARE WRONG)
HRRZ T2,ACCNDL##(P2) ;NO-DELETE WORD
TRNE T2,ACPNDL## ;IS THIS A MAGIC FILE?
MOVSI T2,-1 ;YES, NOT EVEN [1,2] CAN DELETE IT
TLNE M,EXTUUO ;EXTENDED UUO?
HRRI M,UUXNAM(M) ;YES, POINT TO FILENAME
PUSHJ P,GTWST2## ;GET FILENAME
JUMPN T1,RENA11 ;GO IF NOT DELETE
;HERE WHEN RENAMING A FILE TO 0 (DELETING)
JUMPL T2,RENE16 ;NDL FILE IF T2 NEG
PUSHJ P,ZDYFNC ;ZERO DEYFNC
MOVEI T1,FNCDEL## ;CAN USER DELETE FILE?
PUSHJ P,CHKPRV##
JRST RENE16 ;NO. ERROR RETURN
MOVE T2,ACCDIR##(P2) ;IS FILE A DIRECTORY?
TRNN T2,ACPDIR##
JRST DIRDL4 ;NO
MOVE T2,ACCSTS##(P2) ;YES, GET USE-COUNT
TRNE T2,ACMUCM## ;IS COUNT=1 (FOR THIS READER)?
JRST DIRDL2 ;NO, CANT DELETE
MOVE T2,ACCPT1##(P2) ;YES, GET RETRIEVAL INFO
MOVE T1,ACCUN1##(P2)
PUSHJ P,SETFS0## ;SET UP TO READ THE DIRECTORY
JRST DIRDL2
PUSH P,DEVSFD##(F) ;SAVE L(SFD)
PUSHJ P,GETNMB ;GET L(NMB)
HRRM T1,DEVSFD##(F) ;SAVE AS DEVSFD
DIRDL1: PUSHJ P,DIRRED## ;READ A DIRECTORY BLOCK
JRST DIRDL3 ;EOF - IT'S EMPTY
SKIPN 1(T1) ;GOT A BLOCK - EMPTY?
JRST DIRDL1 ;YES, READ NEXT
POP P,DEVSFD##(F) ;RESTORE DEVSFD
DIRDL2: MOVEI T1,DNEERR ;DIR-NOT-EMPTY
AOJA M,PUTERR ;RETURN THE ERROR
DIRDL3: POP P,DEVSFD##(F) ;RESTORE DEVSFD
DIRDL4: PUSHJ P,UPAU## ;GET AU
PUSHJ P,GETCB##
HRRZ T1,P2 ;GET ACCESS TABLE ADDRESS
MOVEI T2,ACPNDR## ;NO DELETE ON RESET REQUESTED?
TDNN T2,ACCSTS##(T1)
JRST NONDR ;NO, FILE CAN BE DELETED
PUSHJ P,ENQNDR## ;DOES QUESER STILL NEED THIS FILE?
JRST RENE19 ;YES,IT CAN'T BE DELETED
ANDCAM T2,ACCSTS##(T1) ;CLEAR BIT NOW
NONDR:
MOVE T1,ACCSTS##(P2) ;%STATUS OF FILE
TRNE T1,ACPUPD ;%FILE BEING UPDATED BY ANOTHER JOB?
JRST RENE17 ;%YES, ERROR RETURN
TROE T1,ACPDEL##+ACPNIU ;%NO, FILE ALREADY MARKED FOR DELETION?
JRST RENAM9 ;%YES, JUST CLOSE FILE
MOVEM T1,ACCSTS##(P2) ;%NO, SET FOR DELETE AFTER LAST READER CLOSES
PUSHJ P,GETNMB ;%GET LOC OF NMB
MOVE P1,T1 ;%NMB LOC INTO P1
LDB T1,ACYFSN## ;%FSN
PUSHJ P,FSNPS2## ;%SET A BIT FOR THIS STR
ANDCAM T2,NMBYES##(P1) ;%INDICATE FILE ISNT IN THIS STR
HLLZS NMBCFP##(P1) ;%MAKE SURE A BAD CFP ISN'T LEFT AROUND
HLRZ T3,DEVEXT(F) ;GET EXTENSION
CAIE T3,'UFD' ;IS THIS A UFD?
JRST RENAM7 ;%NO
MOVE P3,T2 ;%YES. SAVE FSN BIT
PUSHJ P,GVCBJ## ;%GIVE UP CB RESOURCE
PUSHJ P,FNDUFB ;FIND UFB FOR THIS FILE
JRST RENAM8 ;NOT THERE
SETZM UFBPT1##(T2) ;%ZERO POINTER TO UFD
ANDCAM P3,PPBYES##(T1) ;%INDICATE UFD NO LONGER THERE
SETZM UFBWRT##(T2) ;% IN CASE UFD GETS RECREATED
RENAM7: PUSHJ P,GVCBJ## ;%GIVE UP CB
RENAM8: PUSH P,DEVUNI##(F) ;SAVE DEVUNI (DELNAM WILL CHANGE IT)
PUSHJ P,DELNAM ;REMOVE FILE NAME FROM UFD
PUSHJ P,DWNAU## ;ANOTHER JOB MUST HAVE DELETED THE NAME
POP P,U ;RESTORE DEVUNI(FOR INPUT-CLOSE)
PUSHJ P,STOAU##
TLZ F,RENMB+ENTRB ;SO CLOSE INPUT WONT THINK CLOSE OUTPUT WILL HAPPEN
TLZE S,IOSRDC ;IS FILE READING?
JRST RENA10 ;YES - LOOKUP, RENAME OR ENTER,CLOSE,RENAME DONE
MOVEI T1,ACPCNT## ;NO. ENTER, RENAME DONE - FAKE UP A.T.
ADDM T1,ACCCNT##(P2) ;SO CLOSIN WILL DELETE THE FILE
JRST RENA10
RENAM9: PUSHJ P,GVCBJ## ;%GIVE UP CB
PUSHJ P,DWNAU## ;GIVE UP AU
RENA10: PUSHJ P,CLOSRN ;GO FINISH UP FILE
TLZ F,LOOKB ;ZERO LOOKB SO A FOLLOWING ENTER WILL SUCCEED
PUSHJ P,JDAADR## ;GET CHAN NUM
HLLM F,(T1) ;UUOCON WONT SAVE LH(F)
JRST CPOPJ1## ;AND TAKE GOOD RETURN
;HERE TO RENAME A FILE TO SOMETHING (NOT DELETE)
RENA11: JUMPL T2,RENE16 ;NDL FILE IF T2 NEG
PUSHJ P,TSTWRT ;CAN THIS FILE BE RENAMED?
JRST RENE18 ;NO, ALREADY BEING WRITTEN - FBMERR
PUSH P,M ;SAVE LOC OF NAME
HRRI M,UUXPRV-UUXNAM(M) ;POINT TO PROT WORD
TRZ P3,RB.BIT ;CLEAR NOISE BITS
TLNN M,EXTUUO ;EXTENDED UUO?
MOVEI P3,UUXPRV ;NO, THEN PRIV WORD IS ALWAYS THERE
CAIGE P3,UUXPRV ;IS PRIV WORD THERE?
TDZA T1,T1 ;NO, DON'T CHANGE PRIVS
PUSHJ P,GETWDU## ;GET IT
SKIPE T1 ;TRYING TO CHANGE IT?
XOR T1,ACCPRV##(P2) ;MAYBE, XOR WITH ORIGINAL PROT
HLRZ P1,DEVEXT(F) ;FNCCAT IS NEVER LEGAL FOR UFD
CAIN P1,'UFD' ;IS THIS THE UFD?
TLO T1,777000 ;YES, TRY FNCCPR (IT'S SOMETIMES LEGAL)
LDB P1,[POINT 9,T1,8];GET 0 OR NEW PROT
SKIPN T1,P1 ;IF 0 HE ISNT CHANGING PROT
TROA T1,FNCCAT## ; SO TEST TO SEE IF HE CAN CHANGE ATTS
MOVEI T1,FNCCPR## ;CHANGING PROT, SEE IF HE CAN
PUSHJ P,CHKPRV## ;LEGAL?
TLOA P1,400000 ;NO, P1 NEGATIVE
SETZ P1, ;YES, P1 0
SKIPE P1 ;IF P1 IS NOT 0
TLO P1,200000 ;CANT CHANGE PROTECTION, TRYING TO
MOVE M,(P) ;RESTORE LOC OF NAME
HRRI M,-1(M) ;POINT M TO PPN
TLNN M,EXTUUO ;EXTENDED-FORMAT ARG BLK?
HRRI M,UUNPPN-UUNNAM+1(M) ;NO, ADVANCE TO E+3
HRLS DEVSFD##(F) ;SAVE OLD DIRECTORY IN LH(DEVSFD)
HRRZS -1(P) ;SET LH (PD WRD) = 0 IF NO PATH GIVEN
PUSHJ P,GETWDU## ;GET PPN
SKIPLE P4,T1
TLNE P4,-1 ;POINTER TO A PATH?
JRST RENA12 ;NO
HRRI M,2(P4) ;YES. POINT TO PPN
HRROS -1(P) ;INDICATE A PATH IS GIVEN
PUSHJ P,GETWDU## ;GET PPN
SKIPE P4,T1 ;SAVE PPN IN P4
RENA12: SKIPG P4 ;IF NO PPN GIVEN,
MOVE P4,DEVPPN(F) ;USE SAME PPN AS LOOKED-UP FILE
MOVE T1,DEVNAM(F) ;DEVICE NAME
PUSHJ P,SDVTST ;ERSATZ?
JRST RENA13 ;NO
SKIPLE @SDVPPN##(T2) ;YES, IS THERE AN IMPLIED PPN?
MOVE P4,@SDVPPN##(T2) ;YES, USET IT IN SPITE OF WHAT E+3 SAYS
RENA13: MOVE T1,P4 ;TELL USER THE PPN
PUSHJ P,PUTWDU##
POP P,M ;RESTORE LOC OF NAME
MOVE T4,M ;SAVE LOC OF NAME
PUSHJ P,GETWDU##
CAMN P4,DEVPPN(F) ;IF NOT CHANGING PPN
TLNN P1,200000 ;IF TRYING TO CHANGE PROT AND CANT
CAIA
JRST RENE15 ;LOSE WITH PROT ERR
CAMN P4,DEVPPN(F)
CAME T1,DEVFIL(F) ;RENAMING TO SAME NAME?
JRST RENA14 ;NO
PUSHJ P,GETWD1## ;GET EXTENSION
TRZ T1,-1
HLLZ T2,DEVEXT(F) ;OLD EXTENSION
XOR T1,T2
SKIPL (P) ;PATH SPECIFIED?
JUMPE T1,RENA22 ;NO, JUMP IF EXTENSIONS MATCH
;HERE WHEN CHANGING NAME, EXTENSION, OR DIRECTORY
RENA14: SKIPE T1 ;IF T1=0 THEN NAME,EXT AND PPN'S MATCH
HRRZS (P) ;WANT PDWORD NEGATIVE ONLY IF ALL MATCH
HRRI M,1(T4) ;POINT TO EXTENSION
PUSHJ P,GETWDU## ;GET NEW EXTENSION
HLRZ T2,T1
XOR T1,DEVEXT(F) ;SAME AS OLD?
TLNN T1,-1
JRST RENA15 ;YES, CONTINUE
PUSHJ P,EXTCK ;NO, RENAMING TO "UFD" OR "SFD"?
JRST RENE14
HLRZ T2,DEVEXT(F) ;NO, RENAMING FROM "UFD" OR "SFD"?
PUSHJ P,EXTCK
JRST RENE14
RENA15: HRRI M,-1(T4) ;POINT M TO UUXPPN
TLNN M,EXTUUO ;EXTENDED UUO?
HRRI M,1+UUNPPN-UUNNAM(M) ;NO. POINT TO PPN WORD
CAMN P4,DEVPPN(F) ;NEW PPN=OLD PPN?
JRST RENA16 ;YES
PUSHJ P,GETNMB ;GET L(NMB)
HLRZ T1,NMBRNG##(T1) ;IS FILE IN AN SFD?
JUMPN T1,RENER7 ;YES, CANT CHANGE PPN (ELSE ALL FILES IN SFD
; WOULD HAVE TO CHANGE ALSO)
MOVEI T1,FNCDEL## ;CHANGING DIRECTORIES
PUSHJ P,CHKPRV## ;CAN JOB DELETE FROM OLD DIRECTORY?
JRST RENER7 ;DELETE FROM OLD DIR IS ILLEGAL
MOVEM P4,DEVPPN(F) ;SAVE NEW PPN IN DDB
SETZB T1,P4 ;OK. WIPE OUT OLD HIGHEST FUNCTION
DPB T1,DEYFNC## ;(WANT TO RECOMPUTE IT FOR NEW DIRECTORY)
MOVSI T1,DEPRAD## ;RENAMING ACROSS DIRECTORIES
IORM T1,DEVRAD##(F)
;HERE WHEN RENAME HAS BEEN CHECKED (IF CHANGING DIRECTORIES)
RENA16: HRL P2,M ;SAVE LOC OF PPN
HRRI M,1(M) ;POINT TO NAME WORD AT E+2
TLNN M,EXTUUO ;EXTENDED FORMAT ARG BLK?
HRRI M,-<UUNPPN-UUNNAM+1>(M) ;NO, NAME AT E+0
PUSH P,M ;SAVE M
HLR M,P2 ;POINT TO PPN
PUSHJ P,GTWST2## ;POINTING TO A PATH?
SKIPLE T1
TLNE T1,-1
JRST RENA19 ;NO
HRR M,T1 ;YES, PATH LOC INTO M
HRRZ P3,DEVACC##(F) ;SAVE DEVACC
PUSHJ P,GETNMB ;SET T1="FORBIDDEN" NMB LOC
; (ELSE AN SFD COULD "SWALLOW" ITSELF)
PUSH P,DEVUFB##(F) ;SAVE DEVUFB (TO TELL IF RENAMING ACROSS DIRECTORIES)
PUSH P,DEVLNM##(F) ;SAVE THEE LOGICAL NAME POINTER
PUSH P,DEVNAM(F) ;SAVE THE DEVICE NAME
HRRZ T1,DEVLNM##(F) ;GET THE LOGICAL NAME POINTER IF ANY
JUMPE T1,REN16A ;SKIP THIS IF NO LOGICAL NAME
SETZM DEVLNM##(F) ;PRETEND THERE ISN'T ONE
SKIPN T1,LNRDEV##(T1) ;GET THE DEVICE NAME WE'RE USING
MOVSI T1,'DSK' ;NONE. DEFAULT
MOVEM T1,DEVNAM(F) ;STORE THE REAL DEVICE NAME
REN16A: PUSHJ P,SETPT3 ;SET UP NEW PATH
TLO P3,-1 ;ERROR
POP P,DEVNAM(F) ;RESTORE THE DEVICE NAME
POP P,DEVLNM##(F) ;RESTORE THE LOGICAL NAME POINTER
POP P,DEVUFB##(F)
HRRM P3,DEVACC##(F) ;RESTORE DEVACC
JUMPL P3,SETLE8 ;GO IF AN ERROR
HRRZ T1,DEVSFD##(F) ;NEW SFD
HLRZ T2,DEVSFD##(F) ;OLD SFD
CAME T1,T2 ;NEW SFD=OLD SFD?
JRST RENA17 ;NO, THIS REALLY DOES CHANGE SOMETHING
PUSHJ P,DECSFD ;YES, SETPT3 COUNTED SFD USE-COUNT UP, SO
PUSHJ P,SFDDEC ; DECR IT
SKIPL -1(P)
JRST RENA20 ;GO IF NAME, EXT, OR PPN ARE BEING CHANGED
POP P,(P) ;THIS ISN'T CHANGING NAME EXT OR DIRECTORY
HLR M,P2 ;RESTORE AC'S AND DDB
PUSHJ P,CLSNM
JRST RENA23 ;AND CONTINUE
;HERE ON A RENAME CHANGING SFD'S
RENA17: PUSHJ P,GTUFR ;SFD EXIST ON THIS STR?
SKIPA T1,SETL10 ;NO
JRST RENA18 ;YES
POP P,M ;RESTORE M = LOC OF NAME
AOJA M,RENER9
RENA18: PUSHJ P,DECMST ;ADJUST USE-COUNTS
JRST RENA20
;HERE IF NO PATH IS GIVEN
RENA19: JUMPN P4,RENA20 ;IF CHANGING PPN'S
HLLZS DEVSFD##(F) ; RENAME INTO THE UFD
RENA20: POP P,M ;RESTORE M
PUSHJ P,GETWDU## ;GET NAME
MOVEM T1,DEVFIL(F) ;SAVE IN DDB (FOR FNDFIL)
PUSHJ P,GETWD1## ;GET EXTENSION
HLLM T1,DEVEXT(F) ;SAVE IN DDB
HLRZS T1 ;RENAMING AN SFD?
CAIE T1,'SFD'
JRST RENA99 ;NO
HLRZ T2,DEVSFD##(F) ;YES, COUNT OLD LEVEL
PUSHJ P,CNTLV0
PUSH P,T1 ;SAVE OLD LEVEL
PUSHJ P,CNTLVL ;COUNT NEW LEVEL
POP P,T2
CAMLE T1,T2 ;CAN'T GO DEEPER
JRST RENER8
RENA99: MOVE P3,DEVUFB##(F) ;LOC OF UFB
MOVE P4,DEVUNI##(F) ;ADDR. OF UNIT DATA BLOCK
PUSHJ P,SETSRC## ;GET SEARCH LIST
PUSHJ P,SLXBPT## ;STOPCD BPT IF NONE
MOVE T2,T1 ;SL INTO T2
TLC M,UUOLUK+UUOREN ;ZERO UUOLUK, LIGHT UUOREN
PUSHJ P,FNDFIL## ;CHECK THAT NEW FILE NAME DOESN'T EXIST
JRST RENA21 ;NEW FILE NAME ALREADY EXISTS
TLNE M,UUOREN ;CHANGING DIRECTORIES?
MOVEM P3,DEVUFB##(F) ;NO, RESTORE LOC OF UFB
MOVEM P4,DEVUNI##(F) ;RESTORE LOC OF UNIT DATA BLOCK
HLR M,P2 ;RESTORE LOC OF PPN
MOVE T2,UFBTAL##(P3)
MOVE T1,DEVACC##(F) ;LOC OF A.T.
MOVE T1,ACCALC##(T1) ;SIZE OF FILE
CAME P3,DEVUFB##(F) ;NEW UFD=OLD UFD?
ADDM T1,UFBTAL##(P3) ;NO. CHANGING DIRECTORIES
;INCREASE AMOUNT OF ROOM LEFT IN OLD DIR
JUMPL T2,RENA24 ;WAS QUOTA POSITIVE?
SKIPGE UFBTAL##(P3) ;YES, DID QUOTA BECOME HUGELY NEGATIVE?
HRLOS UFBTAL##(P3) ;YES (OVERFLOW). MAKE IT POSITIVE AGAIN
JRST RENA24 ;AND CONTINUE
RENA21: HRRM P3,DEVUFB##(F)
MOVEM P4,DEVUNI##(F) ;IN CASE ANOTHER RENAME IS DONE
MOVE P2,DEVACC##(F) ;GET THE ACCESS TABLE
MOVE T2,ACCPPB##(P2) ;GET THE PPB
MOVE T2,PPBNAM##(T2) ;GET THE PPN
MOVEM T2,DEVPPN(F) ;YES, RESTORE OLD ONE
JRST RENER9 ;GIVE USER THE ERROR CODE
;SUBROUTINE TO CHECK EXTENSIONS
;ENTER T2=EXTENSION
;RETURN CPOPJ IF "SFD" OR "UFD"
;RETURN CPOPJ1 OTHERWISE
;T4 PRESERVED
EXTCK: CAIE T2,(SIXBIT /UFD/)
CAIN T2,(SIXBIT /SFD/)
POPJ P,
PJRST CPOPJ1##
;HERE ON A RENAME WHEN THE NAME, EXTENSION AND DIRECTORY ARE NOT BEING CHANGED
RENA22: HRRI M,-1(T4) ;POINT TO UUXPPN
TLNN M,EXTUUO ;EXTENDED UUO?
HRRI M,1+UUNPPN-UUNNAM(M) ;NO. POINT TO PPN WORD
RENA23: PUSHJ P,GETCB## ;GET CB RESOURCE
MOVE T1,ACCSTS##(P2) ;% STATUS OF FILE
TLC M,UUOLUK+UUOREN ;%ZERO UUOLUK, LIGHT UUOREN
TRNE T1,ACPCRE+ACPSUP+ACPUPD ;%FILE BEING WRITTEN?
TLNE F,ENTRB ;%YES, BY THIS JOB?
TROE T1,ACPREN ;%RENAME IN PROGRESS?
JRST RENER2 ;%YES, ERROR
MOVEM T1,ACCSTS##(P2) ;%NO. INDICATE RENAME IN PROGRESS
PUSHJ P,GVCBJ## ;%GIVE UP CB RESOURCE
PUSH P,P2
PUSHJ P,DECSU ;SET P2 TO PPB,,NMB
AOS NMBCNT##(P2) ;SINCE FNDFIL WONT BE CALLED
HLRZS P2 ; WE MUST INCR COUNTS BY HAND
AOS PPBCNT##(P2) ; CAUSE CLOSE WILL DECR THEM
POP P,P2
TLNE S,IOSRIB ;PRIME RIB IN CORE?
JRST RENA25 ;YES, NO NEED TO READ IT
RENA24: PUSHJ P,GTMNBF## ;GET A MONITOR BUFFER
HLRZ U,DEVUNI##(F) ;GET UNIT OF PRIME RIB
PUSHJ P,STORU## ;SAVE AS CURRENT UNIT
PUSHJ P,PRMRIB## ;SET UP TO READ PRIME RIB
PUSHJ P,MONRED## ;READ THE PRIME RIB
JUMPN T3,RENE13 ;ERROR READING RIB IF T3 NON-ZERO
MOVE T3,RIBCOD##+1(T1) ;GET RIB CODE WORD
CAIN T3,CODRIB## ;IS IT A RIB?
CAME T2,RIBSLF##+1(T1) ;YES, RIGHT ONE?
JRST RENE13 ;NO,ERROR
TLO S,IOSRIB ;INDICATE PRIME RIB IS IN CORE
MOVEM S,DEVIOS(F) ;SAVE IN DDB
;HERE WHEN WE HAVE THE MONITOR BUFFER, AND THE RIB IS IN IT
RENA25: HRRZ T1,.USMBF ;LOC OF MON BUFFER
MOVE T2,RIBNAM##+1(T1) ;GET OLD FILE NAME
MOVEM T2,DEVFIL(F) ;RESTORE IN DDB
HLLZ T2,RIBEXT##+1(T1) ;GET OLD EXTENSION
HLLM T2,DEVEXT(F) ;AND SAVE IN DDB
MOVE T2,RIBPPN##+1(T1) ;GET OLD PPN
MOVEM T2,DEVPPN(F) ;SAVE OLD PPN IN DDB
PUSHJ P,SETUFR ;SET UFD ADR INTO RIB
;HERE WITH THE RIB IN THE MON BUF, M POINTING TO PPN WORD
HRRI M,-1(M)
TLNN M,EXTUUO ;EXTENDED UUO?
JRST RENA26 ;NO. POINT TO ATT WORD
HRRI M,-<UUXPPN-1>(M) ;POINT TO E
PUSHJ P,GETWDU## ;GET NO. OF ARGS
TRZ T1,RB.BIT ;CLEAR NOISE BITS
HRR P1,T1
CAIGE T1,RIBATT## ;SPECIFYING ATTRIBUTES?
JRST [JUMPG P1,RENA37 ;OK IF CAN CHANGE ATT'S
HRRI M,4(M) ;CAN'T - ERROR
JRST RENE12]
HRRI M,UUXPRV(M) ;MAYBE. POINT TO ATT WORD
RENA26: HRRI M,-1(M) ;POINT TO EXTENSION WORD
PUSHJ P,GETWDU## ;GET EXT. HIGH CREATION DATE
LDB P3,[POINT 3,T1,20] ;HIGH CREATION DATE
MOVE T1,.USMBF ;POINT TO MON BUF
LDB P4,[POINT 3,RIBEXT##+1(T1),20] ;HI CREATION DATE FROM RIB
SUB P4,P3 ;P4=DIFFERENCE
PUSHJ P,GETWD1## ;GET ATTRIBUTES WORD
MOVE T2,T1 ;
HRRZ T3,.USMBF ;LOC OF MON BUF (-1)
SKIPN P3 ;IF HI CREATION DATE = 0
JUMPE T2,RENA30 ; RIBATT = 0 MEANS NO CHANGE
XOR T2,RIBATT##+1(T3) ;COMPARE WITH RIB ATTR. WORD
SKIPN P4 ;HI CREATION DATE THE SAME?
JUMPE T2,RENA30 ;YES, ALL THE SAME IF T2=0
TLNN M,UUOREN ;CHANGING DIRECTORIES?
JRST RENA28 ;YES, IT'S LEGAL
TLNN T2,777740 ;IF PROTECTION AND MODE SAME
TDNE T1,[37,,-1] ;IF 0 LOW DATE
JRST RENA27 ;NO, A CHANGE
TLNN M,EXTUUO ; AND NOT EXTENDED
JUMPE P3,RENA30 ; AND HI DATE 0, WIN
RENA27: TLNE T2,777000 ;IF CHANGING PROTECTION
MOVEI T1,FNCCPR## ;REMEMBER THAT
JRST RENA29 ;WE ALREADY CHECKED FNCCAT OR FNCCPR
RENA28: TLZ P1,-1 ;INDICATE NO PROT ERROR
RENA29: HRRZ T2,.USMBF ;LOC OF MON BUF
PUSH P,T1 ;GET PRIVS FROM USER
PUSHJ P,GTWST2##
LDB T4,[POINT 4,T1,12] ;GET SPECIFIED I/O MODE
MOVEI T3,1 ;GET A BIT TO POSITION
LSH T3,(T4) ;MAKE INTO MODE BIT
LDB T4,[POINT 4,RIBATT##+1(T2),12] ;GET VALUE FROM RIB
TDNN T3,DEVMOD(F) ;LEGAL MODE?
DPB T4,[POINT 4,T1,12] ;NO, OVERRIDE USER'S VALUE
LDB T4,[POINT 15,T1,35] ;CREATION DATE SUPPLIED?
DPB P3,[POINT 3,T4,23]
MOVEI T3,0
SKIPE T4 ;IF NO CREATION DATE,
CAMLE T4,THSDAT## ; OR DATE TOO HIGH
HRLOI T3,37 ;DON'T CHANGE THE CURRENT DATE
ANDM T3,RIBATT##+1(T2) ;CLEAR OLD PROTECTION (AND MAYBE LOW DATE)
ANDCAM T3,T1
IORM T1,RIBATT##+1(T2) ;STORE NEW VALUE(S)
LSH T4,-14
SKIPN T3 ;IF CHANGING DATE,
DPB T4,[POINT 3,RIBEXT##+1(T2),20] ;SAVE HIGH CREATION DATE
POP P,T1 ;RESTORE PROTECTION BYTE
HLRZ T3,DEVEXT(F) ;EXTENSION
CAIN T1,FNCCPR## ;CHANGING PROTECTION
CAIE T3,(SIXBIT /UFD/); OF A UFD?
JRST RENA30 ;NO
PUSHJ P,FNDUFB ;YES. FIND UFB FOR FILE
JRST RENA30 ;NOT THERE
PUSHJ P,GTWST2##
LDB T1,[POINT 9,T1,8];%FOUND - GET PROTECTION
MOVE T4,T2 ;%LOC OF UFB
DPB T1,UFYPRV## ;%SAVE NEW PROT IN UFB BLOCK
PUSHJ P,GVCBJ## ;%AND RETURN CB RESOURCE
RENA30: TLZE P1,-1 ;PROT ERR? (CAN'T CHANGE ATT, NOT CHANGING PROT)
PJSP T1,RENE12 ;YES, LOSE
SETZ P4,
MOVSI T1,DEPALW ;SPECIFYING ALLOCATION IN WORDS?
CAIL P1,UUXSIZ
TDNN T1,DEVJOB(F)
JRST RENA31 ;NO
PUSHJ P,GETWD1## ;YES, GET IT
MOVE P4,T1 ;SAVE IT
TRNE T1,BLKSIZ##-1 ;PARTIAL BLOCK?
ADDI T1,BLKSIZ## ;YES, ACCOUNT FOR IT
LSH T1,MBKLSH## ;CONVERT TO BLOCKS
HRRI M,UUXALC-UUXSIZ(M) ;POINT AT "REAL" ALLOCATION WORD
PUSHJ P,PUTWDU## ;SAVE IN USER'S RENAME BLOCK
JRST RENA32 ;AND CARRY ON
RENA31: HRRI M,UUXALC-UUXPRV(M) ;POINT TO ALLOCATION WORD
TLNE M,EXTUUO ;EXTENDED UUO?
CAIGE P1,UUXALC ;YES. CHANGING ALLOCATION?
JRST RENER1 ;NO
PUSHJ P,GETWDU## ;SPECIFYING ALLOCATION?
RENA32: SKIPLE T2,T1
CAMN T2,ACCALC##(P2) ;YES. ALLOCATION SAME AS BEFORE?
JRST RENER1 ;YES. NOT REALLY CHANGING IT
MOVE T3,ACCDIR##(P2) ;GET DIRECTORY WORD
MOVEI T1,FNCTRN## ;ASSUME TRUNCATING
CAML T2,ACCWRT##(P2) ;RIGHT ?
SKIPA T1,[FNCALL##] ;NO, ALLOCATE
TRNN T3,ACPDIR## ;DON'T ALLOW UFD TRUNCATION
PUSHJ P,CHKPRV## ;CHECK IT
JRST RENE11 ;CANT DO IT - ERROR
MOVE T1,ACCSTS##(P2) ;STATUS OF FILE
TRNE T1,ACMCNM## ;OTHER READERS?
JRST RENE10 ;YES, CANT CHANGE ALLOCATION
PUSHJ P,GETWDU## ;OK. HIGHEST BLOCK HE WANTS
MOVE T2,T1
SUB T2,ACCALC##(P2) ;CHECK ALLOCATION OR DEALLOCATION
JUMPL T2,RENA33 ;DEALLOCATING IF NEGATIVE
PUSHJ P,UPDALC ;ALLOCATING - GET MORE
JRST ENERR7 ;QUOTA EXCEEDED
JRST RENE20 ;CANT START WHERE SPECIFIED - ERROR
PUSHJ P,UPDSET ;UPDATE DEYRLC FOR NEW POINTERS STORED IN RIB
PUSHJ P,CHKPAR ;STORE ERROR WORD IF PARTIAL ALLOCATION
JRST RENER1 ;AND CONTINUE
;STILL IN CONDITIONAL ON FTDALC
;HERE TO DEALLOCATE/TRUNCATE ON A RENAME
RENA33: PUSHJ P,GTWDT3 ;LAST BLOCK TO KEEP
MOVEI T2,0 ;SET T2=0 (1ST BLOCK IN RIB IS 0)
RENA34: PUSHJ P,SCNPT0## ;GO FIND POINTER TO LAST BLOCK DESIRED
JRST RENA38 ;NOT IN THIS RIB, TRY NEXT
MOVE P3,P1 ;SAVE NUMBER OF ARGS
PUSH P,DEVRIB##(F) ;SAVE POINTER TO CURRENT RIB
PUSHJ P,UPDGV9 ;GO DEALLOCATE SOME BLOCKS
STOPCD .+1,DEBUG,TCI, ;++TRUNCATION CHECK INCONSISTENT
MOVE T2,DEVACC##(F) ;ALLOCATION GIVEN IN WORDS?
JUMPE P4,RENA35 ;NO
TRNN P4,BLKSIZ##-1 ;YES, PARTIAL BLOCK?
TROA P4,BLKSIZ## ;NO, LAST BLOCK IS FULL
TRZ P4,BLKSIZ## ;YES, ENSURE LESS THAN 1 BLOCK
SKIPE ACCWRT##(T2)
DPB P4,ACYLBS## ;YES, SAVE SIZE OF LAST BLOCK
RENA35: POP P,T1 ;RESTORE PREVIOUS CURRENT RIB TO T1
SKIPL DEVRIB##(F) ;CURRENTLY IN PRIME RIB?
JRST RENA36 ;YES, NO NEED TO WRITE THE RIB
CAMN T1,DEVRIB##(F) ;STILL LOOKING AT THE SAME RIB?
PUSHJ P,WRTRIB## ;YES, MAKE SURE UPDATED COPY GETS WRITTEN
PUSHJ P,REDRIB## ;READ THE PRIME RIB BACK INTO CORE
JRST RENE13 ;ERROR READING RIB
RENA36: MOVE P1,P3
PUSHJ P,CPYFST## ;COPY UPDATED POINTERS TO DDB
JRST RENE13 ;RIB ERROR
;HERE WHEN ALLOCATION/DEALLOCATION IS THROUGH. SET UP FOR CLOSE
RENER1: TLO M,UUOREN
PUSH P,M ;SAVE ADDR OF ALC
PUSHJ P,SETVAL ;STORE ARGUMENTS FROM USER IN RIB
POP P,M ;POINT AT ERROR CODE
HRRI M,<UUXEXT-UUXALC>(M);IN CASE PARTIAL ALLOCATION
;WE MUST DO "SET WATCH FILES" STUFF NOW WHILE
;DEVSFD STILL POINTS TO THE RIGHT PLACE (THE NEW SFD) AND
;WHILE THE SFD USE COUNTS ARE STILL UP
RENA37: TLNN M,UPARAL ;PARTIAL ALLOCATION ERROR?
TRZ M,-1 ;NO, INDICATE NO ERROR CODE
PUSHJ P,WCHFIL## ;TYPE SET WATCH FILES
CAI "R"
MOVEI T1,UP.SWF ;LIGHT BIT SO WE DON'T DO IT AGAIN
IORM T1,.USBTS
MOVE T1,.USMBF ;LOC OF MON BUF
MOVE T2,RIBPRV##+1(T1) ;PRIVS WORD (MAY HAVE BEEN CHANGED)
MOVEM T2,ACCPRV##(P2) ;SAVE IN ACC
MOVE T2,RIBEXT##+1(T1) ;GET ACCESS DATE HI CREATION DATE
HRLM T2,ACCADT##(P2) ; SAVE IN A.T. (CRE-DATE MIGHT CHANGE)
MOVE T1,ACCSTS##(P2) ;GET STATUS
TRNE T1,ACPCRE+ACPSUP ;IF FILE WAS JUST WRITTEN
TRZA M,-1 ;SET TO DEALLOCATE ON CLOSE
HRRI M,CLSDLL ;OTHERWISE SET TO KEEP ALL ALLOCATED BLOCKS
TLO F,RENMB ;MAKE SURE RENAME BIT IS ON
TLZ F,OCLOSB ;AND THAT OUTPUT CLOSE HAPPENS
MOVEM S,DEVIOS(F) ;SAVE S BITS IN DDB
PUSH P,DEVBUF(F)
SETZM DEVBUF(F) ;MAKE SURE CLOSE1 DOESN'T FIND ADR ERR
PUSHJ P,CLOSE1## ;CALL CLOSE CODE IN UUOCON
POP P,DEVBUF(F)
PUSHJ P,JDAADR## ;GET CHAN NUM
TLZ F,ICLOSB ;CLEAR INPUT CLOSED INDICATION
HLLM F,(T1) ;SO SUBSEQUENT CLOSE WILL WIN
TLNN M,UPARAL ;PARTIAL ALLOCATION ERROR?
AOS (P) ;NO. SET FOR SKIP-RETURN
ZDYFNC: SETZ T1,
DPB T1,DEYFNC## ;CLEAR PROT SO WILL RECOMPUTE IT
POPJ P, ;RETURN TO USER
;HERE WHEN WE HAVE TO SCAN ANOTHER RIB TO FIND THE CORRECT POINTER
RENA38: PUSHJ P,PTRNXT## ;GET THE NEXT RIB
STOPCD .,JOB,NRM, ;++NEXT RIB MISSING
MOVE T1,.USMBF ;IOWD FOR MONITOR BUFFER
MOVE T2,RIBFLR##+1(T1) ;GET FIRST BLOCK NUMBER IN RIB
PUSHJ P,GTWDT3 ;LAST BLOCK TO KEEP
JRST RENA34 ;SCAN THIS RIB
;HERE TO RENAME A FILE INTO [3,3] ON SPPRM, FUNCTION 2
SPLREN::TLNE F,ENTRB
TLNE F,OCLOSB
TLNN F,LOOKB
JRST ECOD5## ;DOCUMENT
MOVE T1,DEVFIL(F)
MOVEM T1,DEVSPN##(F)
PJRST SPTSTR
;SUBROUTINE TO ALLOCATE EXTRA BLOCKS FOR A FILE - ENTER UPDATE OR RENAME
;ENTER WITH T2= AMOUNT TO GET AND M POINTING TO ALLOCATION WORD
;EXIT CPOPJ IF QUOTA EXCEEDED
;EXIT CPOPJ1 IF CANT START WHERE REQUESTED
;EXIT CPOPJ2 IF GOT ANY BLOCKS (UPARAL MAY BE ON IN M)
UPDALC: HRRZ T4,DEVUFB##(F) ;LOC OF UFB
CAMG T2,UFBTAL##(T4) ;DOES HE WANT MORE THAN HE CAN GET?
AOJA M,UPDAL1 ;NO. OK
SKIPN T2,UFBTAL##(T4) ;YES. DOES HE HAVE ANY SPACE AT ALL?
POPJ P, ;NO. CANT GET MORE
ADDI M,UUXPOS-UUXALC ;YES. HE CAN GET PART OF IT
TLO M,UPARAL ;INDICATE PARTIAL ALLOCATION
UPDAL1: AOS (P) ;SET FOR SKIP/DOUBLE SKIP RETURN
PUSH P,T2 ;SAVE NUMBER OF BLOCKS TO GET
PUSHJ P,DDBZR ;ZERO OUT THE DDB RETRIEVAL POINTERS
MOVEI T1,DEVRB1##(F) ;SET UP DEVRET TO POINT TO
HRRM T1,DEVRET##(F) ; DEVRB1
TLON S,IOSRIB ;RIB ALREADY IN CORE?
PUSHJ P,PTRGET## ;NO, READ IT
PUSHJ P,PTRNXT## ;READ NEXT EXTENDED RIB
SKIPA ;LAST OF THEM (OR RIB ERROR)
JRST .-2 ;KEEP LOOKING FOR LAST RIB
JUMPN T3,TPOPJ## ;ALL BETS ARE OFF IF RIB ERROR
PUSHJ P,LSTUNI ;SET U TO LAST UNIT OF FILE
PUSHJ P,UPDSET ;UPDATE DEYRLC, DEVRSU
MOVSI T1,-1 ;SEE IF ANY RETRIEVAL POINTER SLOTS LEFT IN RIB
TDNE T1,DEVRSU##(F) ;...
JRST UPDA1A ;YES, PROCEED
PUSHJ P,UPDEXT ;ALLOCATE EXTENDED RIB
JRST TPOPJ## ;CAN'T EXTEND
UPDA1A: PUSHJ P,ALSTRT ;SET UP T1 FOR START ADR OF BLOCKS
JRST TPOPJ## ;CANT START AT SPECIFIED LOCATION
JUMPN T1,UPDAL4 ;NO START ADR. IF 0
MOVE T2,(P) ;RESTORE REQUESTED AMOUNT
CAMG T2,UNITAL(U) ;DOES THIS UNIT HAVE ENOUGH FREE SPACE?
JRST UPDAL5 ;YES. TRY TO GET IT
MOVE T3,UNISTR(U) ;NO. POINT TO 1ST UNI IN STR
HLRZ T3,STRUNI##(T3) ;1ST UNIT
UPDAL2: CAMG T2,UNITAL(T3) ;DOES THIS UNIT HAVE ENOUGH?
JRST UPDAL3 ;YES. USE IT
HLRZ T3,UNISTR(T3) ;NO. STEP TO NEXT UNIT IN STR
JUMPN T3,UPDAL2 ;AND TRY IT
TLO M,UPARAL ;INDICATE REQUESTING MORE BLOCKS
JRST UPDAL5 ;NO UNIT HAS ENOUGH. USE ORIGINAL UNIT
UPDAL3: MOVE U,T3 ;SET UP NEW U
UPDAL4: PUSHJ P,STORU## ;SAVE IN DDB
LDB T2,UNYLUN## ;GET LOGICAL UNIT NUMBER
TRO T2,RIPNUB## ;INSURE NON-0
PUSHJ P,PTSTO## ;SAVE CHANGE-UNIT POINTER
AOS DEVRET##(F) ;POINT TO NEXT POINTER SLOT
UPDAL5: PUSH P,T1 ;SAVE T1
PUSHJ P,UPDSET ;UPDATE DEYRLC, DEVRSU
POP P,T1 ;RESTORE T1
MOVE T2,(P) ;AND T2
PUSHJ P,ENTALU ;ALLOCATE SPACE FOR UPDATE
JRST TPOPJ## ;ERROR RETURN
UPDAL6: POP P,T2 ;REMOVE GARBAGE FROM PDL
PUSHJ P,CHKPAR ;SET ERROR BIT IF PARTIAL ALLOCATION
HRRZ T1,DEVACC##(F) ;LOC OF A.T.
MOVE T1,ACCALC##(T1) ;AMOUNT OF SPACE ALLOCATED
PUSHJ P,PUTWDU## ;TELL USER AMOUNT ALLOCATED
JRST CPOPJ1## ;TAKE GOOD RETURN
;SUBROUTINE TO UPDATE DEYRLC AFTER UPDAT5 HAS ALLOCATED MORE SPACE
; (CANT BE DONE IN UPDAT5 SINCE RIB MAY NOT BE IN CORE YET)
;ENTER AT UPDSE2 IF T1 HAS ALREADY BEEN SET TO AN AOBJN POINTER
UPDSET: PUSHJ P,SPTRW## ;SET AOBJN WORD FOR POINTERS
MOVE T2,T1 ;INTO T2
SKIPE (T2) ;THIS POINTER SLOT EMPTY?
AOBJN T2,.-1 ;NO. TRY NEXT
HLLM T2,DEVRSU##(F) ;YES, UPDATE DEVRSU
SUBI T2,(T1) ; COMPUTE NEW LENGTH
DPB T2,DEYRLC## ;SAVE LENGTH IN DDB
POPJ P, ;AND RETURN
;SUBROUTINE TO READ RIB FOR UPDATE-ENTER
;RETURNS CPOPJ WITHOUT FA IF RIB ERROR
;RETURNS CPOPJ1 IF OK, WITH RIB IN CORE AND FA IF SIM UPDATE
SIMRIB: TLOE S,IOSRIB ;IF WE ALREADY HAVE RIB IN CORE
JRST CPOPJ1## ;ALL IS OK
MOVE T1,DEVACC##(F) ;A.T. LOC
MOVE T1,ACCSMU##(T1) ;IF A SIMULTANEOUS UPDATE FILE,
TRNE T1,ACPSMU ; GET THE FA RESOURCE BEFORE READING RIB
PUSHJ P,UPFA## ;AS PROTECTION AGAINST RACE CONDITIONS
PUSHJ P,REDRIB## ; INVOLVED IN REWRITING RIBS
PJRST DWNIFA## ;ERROR READING RIB - RETURN FA - GIVE UP
MOVEI T1,DEPWRT## ;INDICATE THIS IS A
IORM T1,DEVWRT##(F) ; WRITING DDB
JRST CPOPJ1## ;TAKE GOOD RETURN
;SUBROUTINE TO ALLOCATE AN EXTENDED RIB FOR UPDALC.
;CALLED WHEN LAST RETRIEVAL POINTER IN RIB HAS BEEN FILLED
;EXIT CPOPJ IF CAN'T ALLOCATE EXTENDED RIB
;EXIT CPOPJ1 IF EXTENDED RIB ALLOCATED, DEVRET/DEVRSU UPDATED
;PRESERVES T1 AND T2
UPDEXT: PUSH P,T1 ;SAVE THE AC'S LIKE ADVERTISED
PUSH P,T2
PUSHJ P,PTRWRT## ;WRITE OUT DDB RETRIEVAL POINTERS
PUSHJ P,EXTRIB## ;ALLOCATE AN EXTENDED RIB
JRST TTPOPJ## ;CAN'T, ERROR RETURN
PUSHJ P,CPYEXT## ;SET UP THE DDB
JRST TTPOPJ## ;CAN'T, ERROR RETURN (DUH?)
PUSHJ P,DDBZRO ;CLEAR OUT RETRIEVAL POINTERS IN DDB
MOVEI T1,DEVRB1##(F) ;RESET DEVRET
HRRM T1,DEVRET##(F) ;...
AOS -2(P) ;SET FOR SKIP RETURN
JRST TTPOPJ## ;RESTORE AC'S AND RETURN
;SUBROUTINE TO DEALLOCATE OR TRUNCATE BLOCKS FROM A FILE
;ENTER WITH P1=AOBJN WORD FOR POINTERS, DEVREL,DEVBLK SET TO LAST DESIRED BLOCK
;EXIT CPOPJ IF PRIVS DON'T ALLOW TRUNCATION, FUNCTION IS TRUNCATE
;EXIT CPOPJ1 NORMALLY WITH RIB SET UP, BUT NOT WRITTEN
;HERE WITH T1=AOBJN
UPDGV9: MOVE P1,T1 ;PUT IT IN A SAFE PLACE
AOBJN T1,UPDGIV ;LAST RTP IN RIB?
AOS DEVBLK##(F) ;YES, SCNPTR LEFT DEVLFT ONE TOO LOW
;COMPENSATE BY BUMPING DEVBLK
;HERE WITH P1=AOBJN
UPDGIV: HRRZ T3,DEVACC##(F) ;LOC OF A.T.
MOVE T1,DEVREL##(F) ;LAST DESIRED BLOCK
CAML T1,ACCWRT##(T3) ;THROWING AWAY BLOCKS WITH DATA?
JRST UPDGV0 ;NO. OK
MOVEI T1,FNCTRN## ;YES. SEE IF PRIVS ALLOW TRUNCATING
PUSHJ P,CHKPRV## ;OK?
POPJ P, ;NO. ILLEGAL
HRRZ T3,DEVACC##(F) ;YES. GET A.T. LOC AGAIN
MOVE T1,DEVREL##(F) ;NEW HIGHEST BLOCK
MOVEM T1,ACCWRT##(T3) ;SAVE AS HIGHEST BLOCK WITH DATA
MOVEI T4,BLKSIZ##
DPB T4,ACZLBS## ;LAST BLOCK IS FULL
;HERE WHEN ACCWRT IS SET. T1=DEVREL HAS THE NUMBER OF THE LAST BLOCK TO KEEP
UPDGV0: SOS DEVLFT##(F) ;YES, ACCOUNT FOR THE REDUNDANT RIB BLOCK
LDB T4,UNYBPC## ;NUMBER OF BLOCKS PER CLUSTER
HRRZ T1,DEVLFT##(F) ;GET NUMBER OF BLOCKS LEFT IN CROUP
IDIV T1,T4 ;CONVERT LAST BLOCK TO CLUSTER ADDR.
JUMPE T2,UPDGV1 ;EXACT NUMBER OF CLUSTERS IF 0
ADDM T2,DEVBLK##(F) ;UPDATE LAST BLOCK ADR
ADDM T2,DEVREL##(F) ;UPDATE LAST LOGICAL BLOCK
MOVNS T2
ADDM T2,DEVLFT##(F) ;UPDATE AMOUNT TO THROW AWAY IN THIS CLUSTER
;HERE WHEN DEVREL AND DEVBLK POINT TO THE LAST BLOCK IN THE CLUSTER
UPDGV1: HRRZ T1,DEVLFT##(F) ;NO OF BLOCKS LEFT IN GROUP
JUMPE T1,UPDGV3 ;NOTHING TO DELETE IF 0
IDIV T1,T4 ;YES. CONVERT TO CLUSTERS
SKIPE T2 ;SHOULD BE AN EVEN NO OF CLUSTERS
STOPCD .+1,DEBUG,ONC, ;++ODD NUMBERED CLUSTER
PUSH P,T1 ;SAVE NO OF CLUSTERS TO DELETE
MOVE T4,UNISTR(U) ;LOC OF STR DATA BLOCK
MOVE T2,(P1) ;LAST POINTER
CAME T2,ACCPT1##(T3) ;IS IT 1ST POINTER?
SETZ T3, ;NO. INDICATE BY T3=0
LDB T1,STYCNP##(T4) ;PREVIOUS CLUSTER COUNT
SUB T1,(P) ;DECREASE BY AMOUNT WE AREW DELETING
DPB T1,STYCNP##(T4) ;SAVE NEW CLUSTER COUNT
POP P,T1 ;REMOVE JUNK FROM PD LIST
MOVEM T2,(P1) ;SAVE POINTER
SKIPE T3 ;IS THIS 1ST POINTER?
MOVEM T2,ACCPT1##(T3) ;YES. UPDATE PNTR IN ACC ALSO
HRRZ T2,DEVLFT##(F) ;NUMBER OF BLOCKS IN CLUSTER TO DELETE
AOS T1,DEVBLK##(F) ;1ST ADR NOT WANTED
UPDGV2: HLRZ T3,DEVEXT(F) ;GET EXTENSION OF FILE
CAIE T3,'UFD' ;A DIRECTORY?
CAIN T3,'SFD' ; OF SOME FLAVOR?
PUSHJ P,[PUSHJ P,SAVT## ;YES, SALT AWAY THE AC'S FOR GIVBLK
JRST CSDELR##] ;FLUSH THE DIRECTORY DATA FROM THE CACHE
PUSHJ P,GIVBLK## ;DELETE SOME BLOCKS
UPDGV3: AOBJP P1,DELRB2 ;THROUGH IF NO MORE
;SUBROUTINE TO DELETE A FILE
;ENTER WITH RIB BLOCK IN CORE, P1=AOBJN WORD FOR POINTERS
;EXIT CPOPJ1
DELRIB::SKIPN T2,(P1) ;GET NEXT POINTER FROM RIB
JRST DELRB2 ;THROUGH IF 0
SETZM (P1) ;ZERO THE POINTER (IN CASE OF TRUNCATE)
PUSHJ P,CNVPTR## ;CONVERT TO ADR, COUNT
JRST DELRB2 ;BAD UNIT-CHANGE PNTR. STOP DELETING
JRST UPDGV3 ;CHANGE-UNIT, TRY AGAIN
MOVE T2,T1 ;COUNT INTO T2
MOVE T1,DEVBLK##(F) ;ADDRESS INTO T1
JRST UPDGV2 ;GO DELETE THIS POINTER
;HERE WHEN ALL THE BLOCKS HAVE BEEN RELEASED IN THE CURRENT RIB
DELRB2: MOVE P1,.USMBF ;LOC OF MONITOR BUFFER
PUSH P,U ;SAVE CURRENT U
SKIPL DEVRIB##(F) ;CURRENT RIB EXTENDED?
SKIPN T1,RIBELB##+1(P1) ;ERROR REGION?
JRST DELRB3 ;NO. FINISH UP
HLRZ T2,RIBEUN##+1(P1) ;YES. GET UNIT OF ERROR
PUSHJ P,NEWUNI## ;SET U TO UNIT DATA BLOCK LOC
JRST DELRB3 ;BAD UNIT NUMBER - CONTINUE RECOVERS
MOVE T1,RIBELB##+1(P1) ;JUST BLOCK NUMBER(CLEAR CONI BITS IN LH)
TLZ T1,BATMSK## ;CLEAR ERROR BITS
JUMPE T1,DELRB3 ;DON'T ALLOCATE IF NO BLOCK NUMBER GIVEN
HRRZ T2,RIBNBB##+1(P1) ;GET NO OF BAD BLOCKS IN REGION
SKIPN T2 ;IF RIBNBB=0
MOVEI T2,1 ; TRY FOR 1 CLUSTER
PUSHJ P,TAKBLK## ;MARK THEM AS TAKEN
JFCL
DELRB3: MOVE U,(P)
HRRZ U,UNISTR(U) ;GET ADR STR
HLRZ U,STRUNI##(U) ;GET ADR 1ST UNIT IN STR
DELRB4: PUSHJ P,STORU## ;SAVE IN DDB
PUSHJ P,WTUSAT ;GO WRITE SATS FOR THIS UNIT IF NOT CURRENT UNIT
HLRZ U,UNISTR(U) ;GET NEXT IN THE STRUCTURE
JUMPN U,DELRB4 ;REWRITE THE SAT IF ITS BEEN CHANGED
POP P,U ;RESTORE CURRENT U
PUSHJ P,STORU## ;RESET DDB
SKIPL DEVRIB##(F) ;SKIP IF CURRENT RIB IS EXTENDED
SKIPN RIBFLR##+1(P1) ;NOT EXTENDED, NON-0 RIBFLR MEANS OLD FILE
SKIPN T1,RIBXRA##+1(P1) ;IS THERE ANOTHER RIB ON CHAIN?
PJRST CPOPJ1## ;NO, EXIT
PUSH P,T1 ;SAVE POINTER TO NEXT RIB
SETZM RIBXRA##+1(P1) ;CLEAR THE POINTER BECAUSE THE OTHERS WILL GO AWAY
PUSHJ P,WRTRIB## ;WRITE THE CURRENT RIB
POP P,DEVRIB##(F) ;SET UP DEVRIB TO POINT TO NEXT RIB
PUSHJ P,PTRCUR## ;GET THE RIB INTO CORE
JUMPN T3,CPOPJ1## ;ERROR READING RIB IF T3 NON-ZERO
MOVE P1,T1 ;GET ADDRESS OF FIRST POINTER
JRST DELRIB ;AND DELETE THIS RINFULL
;SUBROUTINE TO CHECK FOR START-ADDRESS SPECIFICATION.
;RETURNS CPOPJ IF THE SPECIFIED ADDRESS IS HIGHER THAN THE HIGHEST BLOCK IN STR.
;RETURNS CPOPJ1 IN NORMAL CASE, WITH T1 SET UP (POSSIBLY 0).
;RESTORES T2 FROM -1(P) - ASSUMES NUMBER OF BLOCKS IN IT
;IF A START ADR. IS GIVEN, U WILL BE CHANGED TO POINT TO THE RIGHT UNIT
ALSTRT: CAIL P1,UUXPOS
PUSHJ P,GETWDU## ;POSSIBLY SPECIFYING START ADR.?
HRRI M,-1(M) ;DEC M FOR RETURN
CAIL P1,UUXPOS
SKIPN T1 ;YES. IS HE?
JRST ALSTR1 ;NO. GET SPACE ANYWHERE
SKIPL T1 ;NEGATIVE BLOCK NUMBER LOSES
PUSHJ P,ADR2UN ;CONVERT T1 TO UNIT, BLOCK WITHIN UNIT
POPJ P, ;BLOCK GT HIGHEST BLOCK IN STR - NON-SKIP RETURN
SKIPA T2,-1(P) ;PICK UP NUMBER OF BLOCKS AGAIN
ALSTR1: SETZ T1, ;ZERO T1, SO TAKE BLOCKS ANYWHERE
JRST CPOPJ1## ;TAKE GOOD RETURN
;SUBROUTINE TO CHECK FOR PARTIAL ALLOCATION, STORE AN ERROR NUMBER IF SO
;ENTER WITH UUO POINTING TO ALC WORD, LH(UUO) HAS UPARAL IF AN ERROR
CHKPAR: TLNN M,UPARAL ;PARTIAL ALLOCATION?
POPJ P, ;NO. RETURN
HRRI M,-<UUXALC-UUXEXT>(M) ;YES. POINT UUO TO ERROR WORD
PUSHJ P,GTWST2## ;GET THE WORD
HRRI T1,PAOERR ;PARTIAL ALLOCATION ERROR NUMBER
PUSHJ P,PUTWDU## ;STORE ERR BIT IN USER AREA
HRRI M,UUXALC-UUXEXT(M) ;POINT TO ALC WORD AGAIN
POPJ P, ;AND RETURN
;SUBROUTINE TO CONVERT FROM A BLOCK NUMBER WITHIN AN STR TO A UNIT AND BLOCK WITHIN UNIT
;ENTER WITH T1=BLOCK NUMBER
;EXIT CPOPJ IF THE NUMBER IS HIGHER THAN THE HIGHEST BLOCK IN STR
;EXIT CPOPJ1 NORMALLY, U AND DEVUNI=NEW UNIT, T1=BLOCK WITHIN UNIT
ADR2UN::MOVE T4,UNISTR(U) ;LOC OF STR DB
CAMLE T1,STRHGH##(T4) ;START BLOCK ABOVE HIGHEST IN STR?
POPJ P, ;YES. NON-SKIP RETURN
MOVE T3,STRBPU##(T4) ;NO. NUMBER OF BLOCKS/UNIT
IDIV T1,T3 ;CONVERT START ADR TO UNIT, BLOCK NO.
EXCH T1,T2 ;SET UNIT INTO T2
HLRZ U,STRUNI##(T4) ;LOC OF 1ST UNI IN STR
PUSHJ P,NEWUN## ;SET U, DEVUNI TO DESIRED UNIT
JFCL
JRST CPOPJ1## ;AND RETURN
;SUBROUTINE TO ALLOCATE INITIAL BLOCKS FOR A FILE
;SINCE FILES MUST START AT EVEN SUPER-CLUSTER BLOCKS,
; THE START ADR. MUST BE MODIFIED
ADJALC::HRRZ T4,UNISTR(U) ;STR LOC
HLRZ T4,STRBSC##(T4) ;NUMBER OF BLOCKS/SUPER-CLUSTER
JUMPE T1,ADJAL1 ;GO IF NO START-ADR. GIVEN
MOVE T3,T1 ;DESIRED START ADR.
IDIV T3,T4 ;CONVERT TO SUPER-CLUSTER
JUMPE T4,TAKBLK## ;IF NO REMAINDER IT IS A VALID ADR.
POPJ P, ;NOT A START ADR FOR A SUPER CLUSTER. ILLEGAL
;HERE WHEN NO START ADR. IS SPECIFIED
ADJAL1: LDB T3,UNYBPC## ;NO. OF BLOCKS PER CLUSTER
SUB T4,T3 ;SUBTRACT FROM NO. IN A SUP. CLUS.
JUMPE T4,TAKBLK## ;ANY CLUSTER ADR. IS OK IS THEY ARE THE SAME
ADD T2,T4 ;ADJUST AMOUNT REQUESTED BY THE DIFFERENCE
HRRZ T4,DEVUFB##(F) ;LOC OF UFB
CAMLE T2,UFBTAL##(T4) ;WANT MORE THAN QUOTA ALLOWS?
SKIPLE T2,UFBTAL##(T4) ;YES. TAKE LESSER AMOUNT
PUSHJ P,TAKBLK## ;TRY FOR THAT MANY
POPJ P, ;RETURN (QUOTA 0 OR BELOW)
PUSHJ P,SAVE2## ;GOT SOME BLOCKS. SAVE P1,P2
PUSHJ P,GRPAD## ;CONVERT TO BLOCK ADR OF THE GROUP
MOVE P1,T1 ;SAVE NUMBER OF BLOCKS IN P1
MOVE P2,T2 ;SAVE START ADR OF THE GROUP
HRRZ T4,UNISTR(U) ;LOC OF STR DB
HLRZ T3,STRBSC##(T4) ;NO. OF BLOCKS PER SUP. CLUS.
IDIV T2,T3 ;CONVERT BLOCK TO SUP. CLUS ADR.
JUMPE T3,ADJAL2 ;EVEN ADR. IF T3=0
HLRZ T4,STRBSC##(T4) ;NO OF BLKS/SUPER CLUSTER
SUBM T4,T3 ;NO OF BLKS WE CAN'T USE
;HERE WITH T3= NO. OF BLOCKS AT START OF FILE WHICH WE CANT USE
SUB P1,T3 ;ADJUST BLOCK COUNT
MOVE T1,P2 ;1ST BLOCK TO RETURN
MOVE T2,T3 ;NO. OF BLOCKS TO RETURN
ADD P2,T3 ;ADJUST START ADR
PUSHJ P,GIVBLK## ;GIVE THEM UP
;NOW RECONSTRUCT A GROUP POINTER FROM P1,P2
ADJAL2: JUMPE P1,CPOPJ## ;ERROR RETURN IF ALL BLOCKS GIVEN BACK
MOVE T2,P2 ;STARTING BLOCK NO
LDB P2,UNYBPC## ;BLOCKS PER CLUSTER
IDIV T2,P2 ;COMPUTE START CLUSTER ADR
SKIPE T3 ;MUST BE AN EVEN CLUSTER ADR
STOPCD .+1,DEBUG,CNE, ;++CLUSTER NOT EVEN
MOVE T1,P1 ;NUMBER OF BLOCKS IN GROUP
IDIV P1,P2 ;CONVERT TO CLUSTER COUNT
SKIPE P2 ;MUST BE AN EVEN NO OF CLUSTERS
STOPCD .+1,DEBUG,CAO, ;++CLUSTER ADDRESS ODD
HRRZ T3,UNISTR(U) ;LOC OF STR DB
DPB P1,STYCNP##(T3) ;SAVE GROUP SIZE IN T2
JRST CPOPJ1## ;AND TAKE GOOD RETURN
;SUBROUTINE TO ALLOCATE FOR ENTER UUO
;ENTER WITH T2=(P)=NUMBER OF BLOCKS TO GET
;EXIT CPOPJ IF CANT START AT SPECIFIED BLOCK
;EXIT CPOPJ1 NORMALLY (UPARAL MAY BE ON)
;ENTER AT ENTALC TO GET INITIAL BLOCKS FOR A FILE
;ENTER AT ENTALU TO GET ADDITIONAL BLOCKS FOR AN EXISTING FILE
ENTALU: PUSHJ P,TAKBLK## ;GET ANY BLOCKS (NOT STARTING AT A SUPER-CLUSTER
POPJ P, ;CANT START WHERE SPECIFIED
JRST ENTAL1 ;GOT SOME - CONTINUE
ENTALC: PUSHJ P,ADJALC ;GET THE BLOCKS REQUESTED STATING AT A SUPERCLUSTER
POPJ P, ;CANT START AT SPECIFIED BLOCK
ENTAL1: PUSH P,DEVRSU##(F)
ENTAL2: PUSHJ P,PTSTO## ;SAVE POINTER IN DDB
MOVSI T4,1 ;UPDATE DEVRSU
ADDB T4,DEVRSU##(F)
JUMPGE T4,ENTAL3 ;ALL POINTERS TAKEN IF NOT NEGATIVE
AOS T4,DEVRET##(F) ;STEP TO NEXT POINTER LOC
CAILE T4,DEVRBN##(F) ;FILLED DDB?
ENTAL3: TLOA M,UPARAL ;YES. PARTIAL ALLOCATION ERROR
TLNN M,UALASK ;NO. DID HE SPECIFY A PARTICULAR AMOUNT?
JRST ENTAL4 ;ALL BLOCKS ARE ALLOCATED
MOVN T4,T1 ;-NUMBER OF BLOCKS GOTTEN
ADDB T4,-2(P) ;UPDATE AMOUNT REQUESTED
JUMPLE T4,ENTAL4 ;OK IF GOT THEM ALL
;SINCE THERE IS A RESTRICTION ON THE NUMBER OF BLOCKS WHICH WILL
;FIT INTO A RETRIEVAL POINTER, LESS THAN THE AMOUNT REQUESTED MAY HAVE BEEN
;OBTAINED AND THE NEXT CONTIGUOUS BLOCKS MAY BE AVAILABLE - TEST FOR THIS
MOVE T3,UNISTR(U)
LDB T2,STYCLP##(T3) ;ADDRESS OF 1ST CLUSTER GOTTEN
LDB T4,UNYBPC## ;NUMBER OF BLOCKS PER CLUSTER
IMUL T2,T4 ;INITIAL BLOCK ADDRESS
ADD T1,T2 ;+NUMBER OF BLOCKS GOTTEN=NEW START ADDR.
MOVE T2,-2(P) ;NUMBER OF BLOCKS LEFT TO GET
PUSHJ P,TAKBLK## ;TRY TO GET MORE
TLOA M,UPARAL ;PARTIAL ALLOCATION ERROR
JRST ENTAL2 ;SAVE THE NEW POINTER AND TRY AGAIN
;HERE WHEN DONE
ENTAL4: POP P,DEVRSU##(F) ;RESTORE DEVRSU
PJRST CPOPJ1## ;AND SKIP-RETURN
;SUBROUTINE TO STORE USER-SUPPLIED ARGUMENTS IN THE RIB BLOCK
;CALLED BY UPDATE AND RENAME
;ENTER WITH MONITOR BUF, P1=NUMBER OF ARGS, M=ALLOCATION WORD
; BIT 0 OF M=1 IF USER CANT CHANGE ANY VALUES
;ENTER AT SETVAN FROM ENTER, WITH M=PRVS WORD (EXTENDED UUO ONLY)
SETVAL: TLNE M,EXTUUO ;EXTENDED UUO?
CAIGE P1,UUXPRV ;YES. WANT MORE THAN ALREADY ARE STORED?
POPJ P, ;NO. RETURN
HRRI M,-<UUXALC-UUXPRV>(M) ;YES. POINT M TO PRIVS WORD
SKIPA T3,P1 ;REMEMBER TRUE NUMBER OF ARGS
SETVAN: SETZ T3, ;MARK THAT WE CAME FROM SETVAN
PUSHJ P,SAVE2##
SETO P2, ;P2 FOR UNPRV'D STATUS BITS
CAILE P1,UUXENX ;FORCE LIMIT OF KNOWN RIB ARGS
MOVEI P1,UUXENX
PUSHJ P,PRVJB## ;PRIVILEGED JOB?
JRST SETVAU ;NO, NOT ALL ARGUMENTS ARE LEGAL
;
;HERE WE ARE PRIV'D, T3 HAS TRUE # OF ARGS, M=PRIV WORD
;TRY TO COPY ACCOUNT STRING FROM USER TO RIB. SIMILAR TO SETE15
;
SETVAP: SKIPGE T2,[XWD MACTSL##,RIBACS##] ;GET MAX ACCT STRING LENGTH
CAIGE T3,UUXACT ;DID THE USER SPECIFY ACCT STRING?
JRST SETVP3 ;MAX IS 0 OR USER DIDN'T SPECIFY
MOVE T1,.USMBF ;POINT TO MONITOR BUFFER
MOVEM T2,RIBACT##+1(T1) ;STORE AOBJN POINTER TO ACCT STRING
ADDI T2,1(T1) ;MAKE AOBJN WORD FOR ACCT STRING IN RIB
HRLZ T1,T2 ;MAKE A BLT POINTER
HRRI T1,1(T2)
SETZM (T2) ;ZAP THE EXISTING ACCOUNT STRING
BLT T1,-MACTSL-1(T2) ;NOTE THAT MACTSL IS A NEG NUMBER
PUSH P,M ;SAVE USER ARG POINTER
HRRI M,UUXACT-UUXPRV-1(M) ;POINT TO USER SUPPLIED STRING
SUBI T3,UUXACT
SETVP1: PUSHJ P,GETWD1## ;GET NEXT USER WORD
JUMPE T1,SETVP2 ;DONE (SINCE ACCOUNT IS ASCIZ)
MOVEM T1,(T2) ;STORE A WORD IN RIB
AOBJP T2,SETVP2 ;DONE IF RIB FULL
SOJG T3,SETVP1 ;CONTINUE IF MORE ARGS
SETVP2: POP P,M ;RESTORE USER ARG POINTER TO UUXPRV
SETVP3: HLRZ T1,DEVEXT(F) ;RIBUSD IS ONLY MEANINGFUL FOR UFD
CAIN T1,'UFD'
CAIGE P1,UUXUSD ;MIGHT UUXUSD BE IN ENTER BLOCK?
JRST SETVP4 ;NO
HRRI M,UUXUSD-UUXPRV(M) ;YES. POINT TO USD ARGUMENT
PUSHJ P,GTWST2## ;JOB WANT USD COMPUTED?
HRRI M,-<UUXUSD-UUXPRV>(M) ;POINT M TO PRIV WORD AGAIN
JUMPGE T1,SETVP4 ;DON'T BOTHER IF NOT NEGATIVE ARGUMENT
PUSHJ P,FIXUSD ;FIX RIBUSD
SKIPA T3,SETVPB ;NORMAL PRIVILEGED USER BITS
SETVP4: SKIPA T3,SETVPB ;NORMAL PRIVILEGED USER BITS
TLO T3,1 ;RIBUSD NOT SETTABLE
JRST SETVAB
;HERE IF UNPRIVED
SETVAU: CAIGE P1,UUXSTS ;TRYING TO SET/CLR STATUS BITS?
JRST SETVU1 ;NO
HRRI M,UUXSTS-UUXPRV(M) ;YES, POINT AT STATUS WORD
PUSHJ P,GETWDU## ;GET ARGUMENT
ANDI T1,RIPRMS## ;GET UNPRIV'D BITS
MOVE P2,T1 ;PRESERVE THEM IN P2
HRRI M,-<UUXSTS-UUXPRV>(M) ;RESET M
SETVU1: MOVE T3,SETVUB ;ASSUME DATA FILE
PUSHJ P,TSTSFD ;SFD OR UFD?
TLO T3,17 ;YES, CAN'T SET DIR STUFF
; JRST SETVAB ;FALL INTO SETVAB
;HERE WITH P1=NUMBER OF ARGUMENTS USER IS SUPPLYING
SETVAB: TLNE M,UUOREN ;RENAME?
TLO T3,400000 ;YES, CRE-DATE, PRIVS ALREADY CORRECT IN MON-BUF
SKIPGE M ;IF USER CANT CHANGE VALUES
SETO T3, ; JUST STORE IN ENTER/RENAME BLOCK
MOVE T2,.USMBF
HRRZ T4,RIBFIR##+1(T2) ;NO OF VALUES IN FILE
JUMPE T4,SETVA1 ;HUH?!
CAILE P1,-1(T4) ;USER SUPPLYING MORE?
MOVEI P1,-1(T4) ;YES, DON'T LET HIM (OLD FILE)
SETVA1: HRRZ T2,.USMBF ;LOC OF MON BUF
MOVE T1,UNILOG(U) ;GET CURRENT UNIT NAME
MOVEM T1,RIBDEV##+1(T2) ;STORE IN RIB
ADDI T2,RIBPRV##+1 ;POINT TO PRIVS WORD
MOVNI T1,-UUXPRV+1(P1) ;T1=-NUMBER OF ARGS TO STORE
HRLM T1,T2 ;SAVE NUMBER IN LH(T2)
SETVA2: JUMPG T3,SETVA3 ;PROTECTED ARGUMENT?
MOVE T1,(T2) ;YES, GET VALUE FROM RIB
PUSHJ P,PUTWDU## ;STORE IN USERS AREA
JRST SETVA4 ;CONTINUE
SETVA3: PUSHJ P,GTWST2## ;GET AN ARG FROM USER
MOVEM T1,(T2) ;SAVE IT IN RIB
SETVA4: HRRI M,1(M) ;STEP TO NEXT ARG
LSH T3,1 ;SET NEXT CANT-SUPPLY BIT IN T3
AOBJN T2,SETVA2 ;GO IF HE WANTS ANOTHER
MOVE T2,DEVACC##(F)
CAIGE P1,UUXALC ;NEED TO GET ALLOCATION WORD?
JRST SETVA5 ;NO, GO ON
SUBI M,-UUXALC+1(P1) ;POINT TO .RBALC IN USER'S AREA
MOVE T1,ACCALC##(T2) ;GET ACTUAL ALLOCATION OF FILE
PUSHJ P,PUTWDU## ;STORE IT IN USER'S ARG BLOCK
SETVA5: MOVE T1,.USMBF ;MAKE SURE NO-DELETE BIT OFF
MOVE T2,ACCDIR##(T2) ;IS FILE A DIRECTORY?
MOVEI T4,RIPDIR##
TRNE T2,ACPDIR##
IORM T4,RIBSTS##+1(T1) ;YES, DONT LET RIPDIR OR RIPPAL BE CLEARED
MOVEI T4,RIPNDP## ; OTHERWISE COULD CREATE A
ANDCAM T4,RIBSTS##+1(T1) ; NON-DELETABLE FILE
JUMPL P2,SETVA6 ;TRYING TO SET UNPRIV'D BITS?
MOVEI T4,RIPRMS##
ANDCAM T4,RIBSTS##+1(T1) ;YES, CLEAR OR SET ACCORDINGLY
IORM P2,RIBSTS##+1(T1)
SETVA6: HLRZ T1,DEVEXT(F) ;GET EXTENSION
CAIN T1,'UFD' ;ONLY LEGAL FOR UFD
PUSHJ P,FNDUFB ;FIND UFB FOR FILE
POPJ P, ;NOT THERE -RETURN
PUSHJ P,PRVJB## ;AND ALLOWED TO ?
PJRST GVCBJ## ;NO, RETURN
MOVE T1,.USMBF ;%FOUND IT - L(MON BUF)
MOVSI T3,UFPLOG##
ANDCAM T3,UFBLOG##(T2) ;CLEAR UFPLOG
SKIPGE RIBSTS##+1(T1) ;IS RIPLOG ON?
IORM T3,UFBLOG##(T2) ;YES. LIGHT UFPLOG
MOVE T3,RIBQTF##+1(T1) ;%LOGGED-IN QUOTA
SUB T3,RIBUSD##+1(T1) ;%-AMOUNT USED
MOVEM T3,UFBTAL##(T2) ;%=CURRENT QUOTA
PJRST GVCBJ## ;%GIVE UP CB AND RETURN
;MASKS FOR ARGS IN RIB WHICH CANNOT BE SET BY USER. BIT ZERO
;REPRESENTS RIBPRV, BIT ONE REPRESENTS RIBSIZ, AND SO ON.
;TABLE BELOW INDICATES CORRESPONDANCE OF THESE BITS AND THE RIBXXX
;EXTENDED RIB ARGUMENT NAMES.
;LH BITS (LAST 4 ARE MEANINGFUL FOR UFDS ONLY):
;PRV SIZ VER FUT EST ALC POS FT1 NCA MTA DEV STS ELB EUN QTF QTO QTR USD
;(ALTERNATE USES FOR LAST 4 IN NON-UFD FILES) TYP BSZ RSZ FFB
;RH BITS:
;AUT NXT PRD PCA UFD FLR XRA TIM LAD DED ACT AC2 AC3 AC4 AC5 AC6 AC7 AC8
SETVPB: XWD 202260, 036200 ;PRIVILEGED USER BIT MASK
SETVUB: XWD 202760, 777777 ;UNPRIVILEGED USER BIT MASK
;SUBROUTINE TO ZERO THE RETRIEVAL POINTERS IN THE DDB
;RESPECTS T1,T2,T3
DDBZR:: MOVSI T4,DEPLPC## ;LAST POINTER IS NOT IN CORE
ANDCAM T4,DEVLPC##(F)
DDBZRO::SETZM DEVRB1##(F) ;ZERO 1ST PNTR
MOVSI T4,DEVRB1##(F)
HRRI T4,DEVRB2##(F) ;SET TO BLT
BLT T4,DEVRBN##(F)
HRRZ T4,DEVCPY##(F) ;LOC OF IN-CORE COPY
JUMPE T4,CPOPJ##
HRLI T4,MPTRLN## ;SET TO CLEAR IT OUT
SETZM PTRDAT##(T4)
AOBJN T4,.-1 ;ZERO THOSE POINTERS TOO
POPJ P, ;AND RETURN
;SUBROUTINE TO COMPUTE THE RIBUFD WORD
;RESPECTS T1
GTUFR:: PUSH P,T1
PUSHJ P,DIRSET##
PJRST TPOPJ##
MOVE T4,UNISTR(U) ;LOC OF STR DATA BLOCK
LDB T2,STYCLP##(T4) ;GET ADDRESS
LDB T1,UN1PTR## ;GET UN1 ALONE
LDB T3,UNYBPC## ;BLOCKS PER CLUSTER
IMUL T2,T3 ;CONVERT CLUSTER ADR TO BLOCK ADR
MOVE T3,STRBPU##(T4) ;HIGHEST BLOCK PER UNIT
IMUL T1,T3 ;NO OF PRECEEDING BLOCKS IN STR
ADD T2,T1 ;PLUS BLOCK NO RELATIVE TO UNIT
PJRST TPOPJ1## ;RETURN WITH T2=RIBUFD WORD
;SUBROUTINE TO SET RIBUFD WORD IN RIB
;EXIT WITH T1=L(MON BUF-1) AND RIBUFD WORS SET TO 1ST BLOCK OF UFD
SETUFR: PUSHJ P,GTUFR ;COMPUTE RIBUFD WORD
JRST SETUF1 ;OOPS
MOVE T1,.USMBF ;LOC OF MON BUF
MOVEM T2,RIBUFD##+1(T1) ;SAVE ADR IN RIB
FBMLOC: POPJ P,FBMERR ;AND RETURN
SETUF1: SKIPN DEVSFD##(F) ;IF THERE IS AN SFD,
SKIPN DEVUFB##(F) ; OR THERE IS NO UFB
STOPCD .,JOB,NUE, ;++NO UFB ERROR
WLKLOC: POPJ P,NCEERR ;UFD WAS DELETED - JUST RETURN
;SUBROUTINE TO FIND THE UFB BLOCK FOR A FILE
;ENTER WITH DEVFIL(F)=PRJ,PRG (DEVFIL,DEVEXT=A,B.UFD)
;EXIT CPOPJ IF NO UFB FOR FILE, CB RESOURCE RETURNED
;EXIT CPOPJ1 IF FOUND, WITH CB RESOURCE,
;T1=LOC OF PPB AND T2=LOC OF UFB
;ENTER AT FNDUF1 WITH T1=PRJ,PRG FOR PPB TO BE SEARCHED
;ENTER WITH DEVACC=A.T. WHICH HAS RIGHT FSN, OR FSN ITSELF IN DEVACC
FNDUFB: MOVE T1,DEVFIL(F) ;UFD NAME
FNDUF1::PUSHJ P,GETCB## ;GET CB RESOURCE
HLRZ T2,SYSPPB## ;%START OF PPB'S
PUSHJ P,LSTSCN## ;%TRY TO FIND THIS PPB
PJRST GVCBJ## ;%NOT THERE - RETURN
HRRZ T1,DEVACC##(F) ;%FOUND. GET FSN
CAILE T1,.FSMAX ;%ACTUAL FSN IF DEVACC LT FSNEND
LDB T1,ACZFSN## ;%A.T. LOC - GET FSN FROM ACCFSN
PUSH P,T2 ;%SAVE LOC OF PPB
HLRZ T2,PPBUFB##(T2) ;%START OF UFB'S
PUSHJ P,BYTSCA## ;%SEARCH FOR MATCHING UFB
JRST TPOPJ1## ;%FOUND - TAKE GOOD RETURN
POP P,T1 ;%REMOVE GARBAGE FROM LIST
PJRST GVCBJ## ;%NOT THERE RETURN
;ROUTINE TO FIX THE VALUE OF RIBUSD IN THE RIB
;(ONLY THE VALUE IN UFBTAL IS KNOWN TO BE RIGHT)
;RESPECTS ALL ACS EXCEPT T1
FIXUSD: PUSHJ P,SAVT##
PUSHJ P,FNDUFB ;FIND THE UFB
POPJ P, ;NOT THERE
MOVE T1,.USMBF ;%GET QUOTA FROM RIB
MOVE T3,RIBQTF##+1(T1)
SUB T3,UFBTAL##(T2) ;%MINUS AMOUNT LEFT
MOVEM T3,RIBUSD##+1(T1);%GIVES AMOUNT USED
PJRST GVCBJ## ;%GIVE UP CB
;DO NOT ALLOW A LOOKUP OF A DIRECTORY THAT IS BEING COMPRESSED
;MAKE LOOKUP BLOCK UNTIL THE COMPRESSOR IS DONE
CMPSLP: PUSHJ P,TSTSFD ;IS FILE A DIRECTORY?
CAIA ;YES
POPJ P, ;NO, LOOKUP IS OK
CAIE T1,'SFD' ;UFD OR SFD?
JRST CMPSL1 ;UFD
PUSHJ P,UPAU## ;SFD, WAIT FOR COMPRESSOR TO FINISH
PJRST DWNAU## ;DIDN'T REALLY WANT AU ANYWAY
;HERE IF UFD
CMPSL1: PUSHJ P,FNDUFB ;FIND UFB (DEVUFB POINTS TO [1,1])
POPJ P, ;NOT FOUND, COMPRESSOR NOT IN PROGRESS
AOS PPBCNT##(T1) ;%MAKE SURE UFB DOESN'T GO AWAY
PUSHJ P,GVCBJ## ;%NOW IT'S OK TO GIVE AWAY INTERLOCK
EXCH T2,DEVUFB##(F) ;POINT DDB AT RIGHT UFB
PUSHJ P,UPAU## ;WAIT FOR COMPRESSOR TO FINISH
PUSHJ P,DWNAU## ;DIDN'T REALLY WANT AU ANYWAY
MOVEM T2,DEVUFB##(F) ;POINT BACK AT [1,1]
SOS PPBCNT##(T1) ;PUT USE COUNT BACK
POPJ P,
;ERROR STUFF
ILNMEN: MOVE J,.CPJOB##
POP P,JBTSFD##(J)
JRST ILNMER
UILNMR: MOVEI T1,ISUERR
AOJA M,PUTERR
ILNMER: TLZN M,UUOREN ;IS ERROR CODE ALREADY IN T1?
MOVEI T1,FNFERR
AOJA M,LKENR2
UPDER7: SKIPA T1,FBMLOC ;%FILE BEING MODIFIED
UPDER5: MOVEI T1,FCUERR ;%FILE CANNOT BE UPDATED
JRST UPDERZ ;%GO STORE ERROR CODE
UPDER6: HRRI M,UUXEXT-UUXALC(M)
HRRZ T1,DEVACC##(F)
PUSHJ P,ENER11
MOVEI T1,FBMERR
PUTERR: MOVE T3,T1
PUSHJ P,GETWDU##
HRR T1,T3
PJRST PUTWDU##
RENER2: PUSHJ P,GVCBJ##
SKIPA T1,FBMLOC
NTFOUN: MOVEI T1,FNFERR
;HERE WITH M AT PPN
LKENER: TLZA T1,-1 ;LH=0 MEANS LEAVE NMBCNT ALONE
LKENR4: TLO T1,-1 ;LH=NON-0 MEANS DECREMENT NMBCNT
SKIPGE DEVSPL(F) ;SPOOL-MODE?
POPJ P, ;YES, IMMEDIATE RETURN
HRRI M,UUNEXT-UUNPPN(M) ;RESET M FOR ERROR CODE DEPOSIT
TLNE M,EXTUUO
HRRI M,UUXEXT-UUXPPN-<UUNEXT-UUNPPN>(M) ;BUMP M FOR EXTENDED FORMAT
TLNN T1,-1
LKENR2: TLZA T1,-1 ;LH=0 MEANS LEAVE NMBCNT ALONE
LKENR9: TLO T1,-1 ;LH=NON-0 MEANS DECREMENT NMBCNT
PUSHJ P,SAVE2## ;PUT ERROR CODE IN A SAFE PLACE
MOVE P1,T1
PUSHJ P,GETWDU##
HRR T1,P1
PUSHJ P,PUTWDU##
HRRZ T1,DEVSFD##(F) ;JOB HAVE AN SFD?
SKIPN P2,T1
JRST LKENR3 ;NO
PUSHJ P,GETCB## ;YES, GET INTERLOCK
HLRZ T2,NMBACC##(P2) ;%ADDR OF 1ST A.T.
TRNN T2,DIFNAL## ;%REALLY AN A.T.?
HRL P2,ACCPPB##(T2) ;%YES, GET ADDR OF PPB
PUSHJ P,GVCBJ## ;GIVE UP THE INTERLOCK
HLRZ T2,DEVSFD##(F) ;HAVE OLD SFD?
CAMN T1,T2 ;NEW=OLD?
JRST LKENR3 ;YES, USE COUNT NOT OP
TLNE M,UUOREN
PUSHJ P,DECUSA
TLNN M,UUOREN
PUSHJ P,DECALL ;NO, DECREMENT USE-COUNTS
TLNE P1,-1 ;SHOULD WE DECREMENT NMBCNT?
PUSHJ P,DECUC ;YES, DO IT
LKENR3: HLRZS DEVSFD##(F) ;MAKE SURE NO NEW DIRECTORY
TLNN M,UUOUPD ;IF NOT AN UPDATE (E.G. FILE NOT OPEN)
PUSHJ P,TSTPPB ;CLEAR OUT PPB IF NOT LOGGED-IN
PJRST CLRSRB ;CLEAR IOSRIB AND RETURN
ENERR2: PUSHJ P,DECMST
JRST ENERR7
ENERR3:
ENERR4: PUSHJ P,DECMST
POP P,T2
ENERR5: JUMPE T1,ENERR7
ENERR1: MOVEI T1,BNFERR
JRST ENERR8
ENERR6: SKIPA T1,[TRNERR]
ENERR7: MOVEI T1,NRMERR
ENERR8: HRRI M,-1(M) ;DECREMENT M FOR ERROR CODE
TLNE M,EXTUUO ;EXTENDED FORMAT?
HRRI M,-<UUXALC-UUXEXT-1>(M)
PUSH P,T1
TLNE S,IOSDA
PUSHJ P,DWNDA##
TRNE S,IOSFA ;HAVE FA RESOURCE?
PUSHJ P,DWNFA## ;YES, RETURN IT
HRRZ T1,DEVACC##(F)
SKIPE T1
TLNN M,UUOREN ;RENAME?
JRST ENER10
PUSHJ P,DECRDR ;YES, DECR READ COUNT
JFCL
DMOVEM T1,T3
LDB T1,ACZFSN##
PUSHJ P,FSNPS## ;POSITION BIT FOR STR
HLRZ T3,ACCNMB##(T3)
TRZN T3,DIFNAL ;FIND NMB
JRST .-2
ANDCAM T2,NMBYES##(T3) ;REMOVE FAILED - CLEAR YES BIT
PUSHJ P,GVCBJ## ;%
HRRZ T1,DEVACC##(F)
HLLZS DEVACC##(F) ;CLEAR DEVACC
TRNN T4,ACMCNT ;DONT RETURN A.T. TO FREE CORE IF OTHER READERS
ENER10: PUSHJ P,ENER11
POP P,T1
JRST LKENR2
RENER3: SKIPA T1,WLKLOC ;WRITE LOCK ERROR
RENER4: ;RENAME, NO LOOKUP OR ENTER
LUKER1: MOVEI T1,ISUERR ;LOOKUP, ENTER ALREADY IN FORCE
TSTWD0: PUSHJ P,GTWDT3
SKIPE T2,T3
TLNE T2,-1
AOSA M
HRRI M,UUXEXT(M)
JRST PUTERR
ENER11: MOVEI T2,ACPUPD ;UPDATE (BY THIS JOB)?
TDNN T2,ACCSTS##(T1)
PJRST ATRMOV## ;NO, ZAP THE AT
ANDCAM T2,ACCSTS##(T1)
PUSHJ P,DECSU ;YES, RESET AT, DDB NUMBERS
PUSHJ P,DECUC
MOVSI T2,-ACPWCT##
ADDM T2,ACCWCT##(T1)
POPJ P, ; AND DON'T WIRE THE AT
ENER12: PUSHJ P,DECMST
HRRZ T1,DEVACC##(F) ;ENTER DIDN'T HAPPEN SO A.T. WONT BE REMOVED
PUSHJ P,ATRMOV## ;BY OUTPUT CLOSE
MOVE T1,WLKLOC
JRST LKENER
RENER5: PUSHJ P,SFDDEC ;DROP THE COUNT
SETZM DEVSFD##(F) ;WIPE THE POINTER
RENER6: MOVEI T1,FNFERR ;FILE NOT FOUND
JRST TSTWD0 ;DETERMINE WHERE TO STORE THE ERROR
UPDER8: POP P,(P) ;FIX STACK
PUSHJ P,INPSW8 ;USETI TO BLOCK ONE
MOVE T1,DEVACC##(F) ;POINT TO ACC BLOCK
PUSHJ P,ENERR3 ;FIX USE COUNTS
HRRI M,UUXEXT-UUXALC(M)
MOVEI T1,PRTERR ;GET PROTECTION ERROR CODE
JRST PUTERR ;STORE ERROR CODE
UPDER9: MOVEI T1,PRTERR ;%PROTECTION FAILURE
UPDERZ: PUSHJ P,GVCBJ1## ;%GIVE UP THE INTERLOCK
UPDERY: MOVEI T1,ISUERR ;ILLEGAL SEQUENCE OF UUO'S
HRRI M,UUXEXT-UUXPPN(M) ;POINT AT EXT
TLNN M,EXTUUO
HRRI M,UUNEXT-<UUNPPN+UUXEXT-UUXPPN>(M)
PJRST PUTERR
RENER7: MOVEI T1,PRTERR ;PRIVS WON'T ALLOW UPDATE
JRST LKENER
RENER8: MOVEI T1,SLLERR
TLO M,UUOREN
RENER9: MOVSI T2,DEPRAD##
ANDCAM T2,DEVRAD##(F)
JRST LKENR9
RENE10: MOVEI T3,FBMERR
SETZ T1,
RENE11: HRRI M,-5(M)
RENE12: PUSHJ P,CLREW
SKIPN T1 ;NON-0 FROM CHKPRV
SKIPA T1,T3
MOVEI T1,PRTERR ;RENAME, NOT DELETE. NO PRIVS
HRRI M,-1(M)
JRST LKENR2
RENE13: PUSHJ P,CLREW
MOVEI T1,TRNERR
JRST LKENER
RENE14: HRRI M,-1(M)
RENE15: HLRZS DEVSFD##(F)
RENE16: MOVEI T1,PRTERR
AOJA M,PUTERR
RENE17: PUSHJ P,GVCBJ##
PUSHJ P,DWNAU##
RENE18: MOVEI T1,FBMERR
AOJA M,PUTERR
RENE19: PUSHJ P,GVCBJ##
PUSHJ P,DWNAU##
MOVEI T1,NDRERR
AOJA M,PUTERR
RENE20: PUSHJ P,CLREW ;CLEAR RENAME IN PROGRESS
PUSHJ P,DECSU ;ADJUST COUNTS
PUSHJ P,DECUC
MOVEI T1,BNFERR ;GET ERROR
HRRI M,UUXEXT-UUXPRV(M)
JRST LKENR2 ;CONTINUE
;PRESERVES ALL ACS
;BE CAREFUL NOT TO CALL THIS
;ROUTINE UNLESS YOUR'RE THE
;JOB THAT LIT ACPREN.
CLREW: PUSH P,T1
MOVEI T1,ACPREN
ANDCAM T1,ACCSTS##(P2)
MOVSI T1,DEPRAD##
ANDCAM T1,DEVRAD##(F)
JRST TPOPJ##
FUUEND: END