Trailing-Edge
-
PDP-10 Archives
-
AP-D543V_SB
-
filuuo.mac
There are 13 other files named filuuo.mac in the archive. Click here to see a list.
TITLE FILUUO LEVEL D DISK SERVICE ROUTINE V17564
SUBTTL DESIGNED BY T.HASTINGS,T.WACHS,C.WHITE CODED BY T.WACHS/TW 28 NOV 78
SEARCH F,S
$RELOC
$HIGH
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1973,1974,1975,1976,1977,1978 BY DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
XP VFILUU,17564
;ASSEMBLY INSTRUCTIONS: FILUUO,FILUUO/C_F,S,FILUUO
ENTRY FILUUO
FILUUO::
;ASSEMBLY PARAMETER FOR FNDFIL INTERLOCK
ENTRY FILSER,FILUUO
FILSER::
FILUUO::
;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
IOSALC==2000 ;DON'T CHANGE ACCALC WHEN GIVING UP BLOCKS OF A FILE
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
DEFINE NOSCHEDULE <>
DEFINE SCHEDULE <>
IFE FTCBDB,<
DEFINE CBDBUG(A,B)<>
>
IFN FTCBDB,<
DEFINE CBDBUG(A,B)<
IFIDN <A>,<Y><
EXCH T1,CBUSER##
CAME T1,JOB##
HALT .
EXCH T1,CBUSER##
>
IFIDN <B>,<Y><
PUSHJ P,CKBAS##
>
AOSA .+1
0
>
>
IFE FTSFD,<
IFN FTLIB,<
PRINTX ?FTLIB REQUIRES FTSFD
>>
IFN FTCBDB,<
PRINTX %FTCBDB SHOULD = 0
>
;DISPATCH TABLE
POPJ P, ;DEVOP UUO
JRST REGSIZ## ;LENGTH CAN BE GOTTEN FROM DDB
JRST DSKINI## ;INITIALIZE
JRST HNGDSK##
DSKDSP::JRST DSKREL
JRST CLOSOU
JRST OUTPT
JRST INPT
JRST UENTR
JRST ULOOK
JRST DMPOUT
JRST DMPIN
JRST USETO0##
JRST USETI0##
POPJ P, ;UGETF
JRST RENAM
JRST CLOSIN
POPJ P, ;UTPCLR
POPJ P, ;MTAPE
SUBTTL INTERFACE SUBROUTINES WITH THE REST OF THE MONITOR
;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
IFN FTSWAP,<
;SUBROUTINE TO CLEAN UP THE ACCESS TABLES FOR A JOB AFTER A SWAP-READ ERROR
;SCANS THE DDB'S, WHEN IT FINDS ONE FOR THE JOB IT FIXES IT-
; DECREMENTS THE READ-COUNT IF READING, CLEARS THE STATUS BYTE IF WRITING
; AND INCREMENTS THE QUOTA IF CREATE OR SUPERSEDE
;IT EXITS BY RETURNING ANY SYSTEM RESOURCES THE JOB MIGHT HAVE
SWPCLN::MOVEI F,DSKDDB## ;START AT PROTOTYPE DDB
SWPCL1: HLRZ F,DEVSER(F) ;LINK TO NEXT DDB
JUMPE F,CPOPJ## ;DONE IF 0
MOVE T1,DEVMOD(F)
TLNN T1,DVDSK ;IS THIS DDB A DISK?
POPJ P, ;NO, THROUGH
LDB T1,PJOBN## ;YES, SAME JOB?
CAME T1,J
JRST SWPCL1 ;NO, TRY NEXT DDB
MOVE S,DEVIOS(F) ;YES
HRRZ T1,DEVACC##(F) ;LOC OD A.T.
JUMPE T1,SWPCL5 ;THROUGH IF NONE
MOVNI T2,ACPCNT##
TLZN S,IOSRDC ;DECREMENT READ-COUNT IF ITS UP
SETZ T2,
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, TRY NEXT DDB
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
IFN FTDSIM,<
LDB T2,ACYWCT## ;HE IS AN UPDATER
SUBI T2,1 ;DECR COUNT OF UPDATERS
DPB T2,ACYWCT## ;DONT CLEAR AUALPD IF OTHER UPDATERS
JUMPN T2,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: PUSHJ P,RETRES##
HLLZS DEVACC##(F)
JRST SWPCL1 ;ANS STEP TO NEXT DDB
> ;END CONDITIONAL ON FTSWAP
IFN FTSWAP!FTEL,<
;SUBROUTINE TO DETERMINE IF A JOB HAS A SHARABLE DISK RESOURCE
;ENTER J=JOB NUMBER
;EXIT CPOPJ IF NO, CPOPJ1 IF YES
;RESPECTS T1,T2
FLSDR:: CAME J,CBUSER## ;JOB HAVE CB
CAMN J,DAUSER## ; OR DA?
PJRST CPOPJ1## ;YES - SKIP RETURN
CAMN J,AUUSER## ;JOB HAVE AU?
PJRST CPOPJ1## ;YES
HRRZ T3,BUFLST## ;NO, LOC OF 1ST MON BUF
FLSDR1: CAMN J,MBFJOB##(T3) ;JOB OWN MON BUF?
PJRST CPOPJ1## ;YES
HRRZ T3,(T3) ;NO, TRY NEXT
JUMPN T3,FLSDR1 ;JOB HAS NO RESOURCES
POPJ P,
> ;END OF FTSWAP!FTEL CONDITIONAL
;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 NON-0 IF 'DEVX', AND DSKX EXISTS
SDVTST::SETZB T2,T3 ;T2=INDEX T3=0 IF STRAIGHT MATCH
SDVTS1: HLLZ T4,SDVTBL##(T2) ;NAME
CAMN T1,T4 ;MATCH?
IFE FTLIB,<
PJRST CPOPJ1## ;YES, SKIP-RETURN
>
IFN FTLIB,<
JRST SDVTS2 ;EXTRA WORK IF LIB
>
CAIGE T2,SDVLEN## ;END OF TABLE?
AOJA T2,SDVTS1 ;NO, TRY NEXT
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,SDVTST ;IS DEV A SPECIAL DEVICE?
PJRST TPOPJ## ;NO, NON-SKIP
MOVEI T3,1 ;YES, SET T3 NON-0
PJRST TPOPJ1## ;FOUND - SKIP RETURN
IFN FTLIB,<
SDVTS2: CAIE T2,LIBNDX## ;GOOD RETURN IF NOT LIB:
PJRST CPOPJ1##
PUSH P,T1
PUSHJ P,LIBPP ;GOT LIB PPN
JUMPE T1,TPOPJ## ;NOT A DISK IF NONE
PJRST TPOPJ1## ;A DISK IF LIB EXISTS
>
IFN FTLIB,<
;SUBROUTINE TO GET THE PPN ASSOCIATED WITH DEVICE LIB:
;RETURNS PPN IN T1, 0 IF NO LIB
;RESPECTS ALL ACS (EXCEPT T1)
LIBPP: PUSHJ P,CPUJOB## ;JOB NUMBER
HLRZ T1,JBTSFD##(J) ;LIB SPECIFICATION
TRZ T1,3 ;CLEAR SYS,NEW BITS
JUMPE T1,CPOPJ## ;RETURN IF NONE
MOVE T1,PPBNAM##(T1);GET LIB PPN
POPJ P, ;AND RETURN
> ;END CONDITIONAL ON FTLIB
IFN FTNUL,<
;SUBROUTINE TO CHECK FOR DEVICE "NUL"
;RETURNS CPOPJ IF NUL:, ELSE CPOPJ1
NULTST::MOVS T1,DEVNAM(F) ;NAME USER INITED
CAIE T1,'NUL' ;NUL:?
AOS (P) ;NO
POPJ P, ;RETURN POPJ OR POPJ1
> ;END CONDITIONAL ON FTNUL
;SUBROUTINE TO GET THE PPN ASSOCIATED WITH SYS:
;RETURNS PPN IN T3
;RESPECTS ALL ACS EXCEPT T3
SYSNM::
IFN FTLIB,<
MOVE T3,.C0JOB## ;JOB NO
MOVE T3,JBTSFD##(T3)
TLNE T3,JBPXSY## ;NEW ENABLED?
SKIPA T3,XSYPPN## ;YES
>
MOVE T3,SYSPPN## ;NO
POPJ P,
;SUBROUTINE TO TEST IF THE DEVICE WHOSE NAME IS IN T1 IS A DISK
;ENTER WITH J = JOB NUMBER
;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
PUSHJ P,SDVTST ;IS IT A SPECIAL DEV?
JRST TSTDS0 ;NO
CAIG T2,SYSNDX## ;YES, IS IT SYS?
TLO F,SYSDEV ;YES, LIGHT SYSDEV
POPJ P, ;AND RETURN
TSTDS0:
IFN FTNUL,<
CAMN T1,['NUL '] ;'NUL'
POPJ P, ; IS A DISK
>
TLNN T1,-1 ;XWD 0,,"A"?
PJRST CPOPJ1## ;YES,NOT A DSK
IFN FTPSTR,<
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 TSTDS1 ;YES, AN STR
PUSHJ P,MSKUNI## ;SET T2=MASK FOR NAME
PUSHJ P,SRUNI## ;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
JUMPE T3,TSTDS2 ;JOB MUST BE PRIVILEGED IF UNIT NOT IN AN STR
TSTDS1:
IFN FTSTR,< ;IF MORE THAN ONE STR
IFN FTPSTR,<
MOVE T4,STRPVS##(T3) ;F.S. IS PRIVATE BIT
TRNN T4,STPPVS## ;IS THIS A PRIVATE F.S.?
JRST TSTD1A ;NO, ALL IS WELL
PUSHJ P,SLPTR## ;FIND THIS JOBS S.L.
JRST TSTDS2 ;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 TSTDS2 ;NO, ILLEGAL UNLESS PRIV'ED
TSTD1A:>
SKIPLE T4,STRJOB##(T3) ;STR SINGLE-ACCESS?
CAIN J,(T4) ;YES. FOR THIS JOB?
>
JRST TSTDS4 ;YES, OK
TSTDS2: 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,TSTDS3 ;IF A COMMAND,
CAMN T1,FSFPPN## ; ONLY [1,2] IS LEGAL
TSTDS3: PUSHJ P,PRVJO## ;PRIV'D JOB?
JRST TSTDS5 ;NO. ERROR RETURN
TSTDS4:
IFN FTDHIA,<
MOVE T2,UNIUST##(U) ;NO NEW ACCESSES FOR UNIT?
TLNE T2,UNPNNA##
JRST UPOPJ1## ;YES, SAY IT ISNT A DSK
>
JRST UPOPJ## ;YES. OK RETURN
TSTDS5: CAMN T1,UMDPPN## ;IF NOT IN A FILE STR
JUMPE T3,UPOPJ## ; HE CAN INIT IF [6,6]
JRST UPOPJ1## ; HE ISN'T, LOSE
;ROUTINE TO WRITE THE SATS OF ALL UNITS WHICH HAVE CHANGED
;ENTER WITH RIB IN MONITOR BUFFER
;EXITS WITH U=LAST UNIT IN RIB
RIBSAT::TLNE S,IOSDA ;HAVE DA?
JRST RIBSA1 ;YES
PUSHJ P,UPDA## ;NO, GET IT
PUSHJ P,RIBSA1 ;WRITE CHANGED SATS
PJRST DWNDA## ;GIVE UP DA AND RETURN
RIBSA1: PUSHJ P,SAVE1## ;SAVE P1
IFN FTDMRB,<
SKIPGE DEVRIB##(F) ;IF IN AN EXTENDED RIB,
PUSHJ P,WTUSAT ; NO UNIT-CHANGE TO EXTENDED RIB
>
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,WTUSAT ;WRITE SAT FOR UNIT IF IT CHANGED
RIBSA3: AOBJN P1,RIBSA2 ;AND TRY NEXT POINTER
POPJ P, ;DON'T - RETURN
;SUBROUTINE TO WRITE SATS FOR A UNIT
WTUSAT::PUSHJ P,SAVE2## ;SAVE P1,P2
LDB P1,UNYSIC## ;NUMBER OF SAB BLOCKS FOR UNIT
HLRZ P2,UNISAB##(U) ;LOC OF 1ST SAB
JUMPE P2,CPOPJ## ;EXIT IF UN HAS NO SAB (OFF-LINE OR DOWN)
WTUSA2: SKIPGE SABFIR##(P2) ;HAS SAT BEEN MODIFIED?
PUSHJ P,SATWRT## ;YES. WRITE IT
HLRZ P2,SABRNG##(P2) ;STEP TO NEXT SAB IN RING
SOJG P1,WTUSA2 ;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
ONCWAT::MOVE S,DEVIOS(F) ;S
TRNE S,IOACT ;STILL ACTIVE?
JRST ONCWAT ;YES, KEEP TRYING
DSKSTP::POPJ P,
;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 TSTPP0 ;%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,DDBCOR## ;NO OF 4-WORD BLOCKS NEEDED
PUSHJ P,GET4WD## ;GET THE CORE
JRST TPOPJ## ;CANT GET IT - RETURN
SETDD3: HRR F,T1 ;LOC OF THE CORE
HRLI T1,DSKDDB## ;FROM THE PROTOTYPE
BLT T1,DEVRB1##-1(F) ;BLT THE NEEDED INFORMATION
HRLM F,DSKDDB##+DEVSER ;LINK PROTOTYPE TO THEIS DDB
;(COPY ALREADY CONTAINS LINK TO NEXT)
IFN FTSPL,<
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)
IFN FTMOUNT,<
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)
> ;END CONDITIONAL ON FTMOUNT
SETDD2: POP P,DEVNAM(F) ;SET NAME INTO DDB
IFN FTSPL,<
SETZM DEVSPM##(F) ;CLEAR POINTER TO SPOOLING PARAMETER BLOCK
>
IFN FTNUL,<
PUSHJ P,NULTST ;IN NUL:
SKIPA T2,[XWD -1-TTYATC,177777] ;ALL DV'S, ALL MODES
PJRST CPOPJ1##
IORM T2,DEVMOD(F)
>
PJRST CPOPJ1## ;AND RETURN
;SUBROUTINE TO CLEAR A DISK DEVICE DATA BLOCK
;ENTER WITH F=LOC OF DDB
;CALLED BY RELEASE CODE
CLRDDB::MOVEI T1,DSKDDB## ;START AT PROTOTYPE
CLRDD1: MOVE T2,T1
HLRZ T1,DEVSER(T2) ;GET SUCCESSOR TO THIS DDB
SKIPN T1 ;END?
STOPCD CPOPJ##,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
SKIPE DINITF## ;IN ONCE-ONLY CODE?
POPJ P, ;YES, DON'T GIVE UP CORE
IFN FTGALAXY,<
HRRZ T2,DEVSPM##(F) ;GET POINTER TO SPB
JUMPE T2,CLRDD2 ;GO ON IF NONE
MOVEI T1,SPBCOR## ;GET SIZE OF SPB (IN 4 WD BLOCKS)
PUSHJ P,GIV4WD## ;GIVE IT BACK
CLRDD2:
>;END IFN FTGALAXY
MOVEI T1,DDBCOR## ;NO OF 4-WORD BLOCKS TO RETURN
HRRZ T2,F ;LOC OF DDB TO CLEAR
PJRST GIV4WD## ;RETURN THE CORE AND RETURN TO CALLER
;SUBROUTINE TO SET UP A DDB
;EXITS WITH F=LOC OF DDB
;EXIT CPOPJ IF NO FREE CORE, CPOPJ1 IF OK
FAKDDB::MOVEI T2,DDBCOR## ;GET CORE FOR A DDB
PUSHJ P,GET4WD##
POPJ P, ;NONE AVAILABLE - RETURN CPOPJ
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,.C0JOB## ;SET UP J
PUSHJ P,SETDVL## ;STORE JOB NUMBER
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
;SUBROUTINE TO FIND THE OWNER(S) OF MONITOR BUFFERS
;ENTER WITH P1=0(FIRST TIME) OR ADR OF A MONITOR BUFFER
;RETURNS CPOPJ IF NO MORE BUFFERS
;RETURNS CPOPJ1 NORMALLY, WITH T3 = JOB NUMBER OF OWNER OF NEXT BUFFER
NXTJBB::SKIPN P1 ;FIRST TIME?
SKIPA P1,BUFLST ;YES, START AT FIRST MON-BUF
NXTJBC: HRRZ P1,(P1) ;GET POINTER TO NEXT BUFFER
JUMPE P1,CPOPJ## ;DONE IF NO MORE
SKIPL (P1) ;IS IT IN USE?
JRST NXTJBC ;NO, LOOK AT NEXT
HRRZ T3,MBFJOB##(P1);YES, SET T3= OWNER
PJRST CPOPJ1 ;AND 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
IFN FTDSTT,<
DSKCOM::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
> ;END CONDITIONAL ON FTDSTT
IFN FTWATCH,<
;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,2 ;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##
>;END FTWATCH
IFN FTWATCH ! FTDSTT,<
;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) ;@ECREASE 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
> ;END CONDITIONAL ON FTWATCH & FTDSTT
IFE FTDSTT,<
DSKCOM==:CPOPJ##
>
;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
IFN FTSTR,< ;IF MORE THAN ONE STR
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,UNINAM##(P1) ;PHYSICAL UNIT NAME
SKIPN UNILOG##(P1) ;NO SKIP IF UNIT IS NOT IN A FILE STRUCTURE
PUSHJ P,NAMCOM ;YES, TYPE ITS NAME
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 /,/
IFN FTDBAD,<
;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
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 O OR OW?
CAIN T1,OWCOD##
AOSA T1 ;YES
PJRST UPOPJ## ;NO, NON-SKIP RETURN
ADDI T1,1 ;O2COD=OCOD+2,OW2COD=OWCOD+2
MOVEM T1,UNISTS##(U) ; (CANT AOS UNISTS SINCE INTERRUPT MIGHT HAPPEN)
PJRST UPOPJ1## ;SKIP RETURN
DSKQU2: PUSHJ P,DECIN1## ;GET THRESHOLD
POPJ P,
POPJ P,
MOVEM T2,RIBECT## ;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::
IFN FTSFD,<
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 ;NO FREE CORE - CANT RESET OLD UFD
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,JOB## ;RESET J
DSKKJ1:
IFN FTLIB,<
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
MOVE J,JOB## ;RESET J
> ;END CONDITIONAL ON FTLIB
DSKKJ2: SETZM JBTSFD##(J) ;CLEAR DEFAULT DIRECTORY
>
MOVE T1,JBTPPN##(J) ;GET PPN
PUSHJ P,ONLYTS ;IS THERE ANY JOB USING THIS PPN?
SKIPA ;YES
PUSHJ P,DSKLGO ;NO, DELETE DISK 4-WORD CONTROL BLOCKS
SCHEDULE ;TURN SCHEDULING BACK ON
POPJ P, ;AND EXIT
SUBTTL DISK. UUO - MISC DISK FUNCTIONS
;CALLI AC,DISK.
;LH(AC)=FUNCTION RH(AC)=ADR
DSKUUO::HLRZ T2,T1 ;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
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
DUULEN==.-DUUTBL-1
IFE FTDPRI,<
PRIUUO==CPOPJ##
>
IFN FTDPRI,<
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
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?
CAIG T1,17 ;YES, LEGAL?
SKIPN F,USRJDA##(T1) ;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: HRRZ T1,USRHCU## ;NO OF OPEN CHANS
PRIUU4: SKIPE F,USRJDA##(T1) ;THIS CHAN OPEN?
PUSHJ P,PRIDEP ;YES, SET PRIORITY IN DDB
SOJGE T1,PRIUU4 ;LOOP FOR ALL CHANS
PJRST CPOPJ1## ;TAKE GOOD RETURN
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,
> ;END FTDPRI CONDITIONAL
SUBTTL INPUT/OUTPUT UUO'S
;BUFFERRED MODE INPUT
INPT:
IFN FTNUL,<
PUSHJ P,NULTST ;IF NULL DEVICE,
JRST SETION ; RETURN EOF
>
IFN FTSPL,<
PUSHJ P,SPTSTI ;SEE IF 1ST SPOOLED INPUT
PJRST SETION ;YES, AND NO FILE - SET IOEND
>
TLNE F,LOOKB ;LOOKUP BEEN DONE?
TLNE S,IOSUPR ;YES. IS FILE SUPER USETI MODE?
PJRST SETIMP ;YES. LIGHT IOIMPM AND RETURN
IFE FTAIR,<
PUSHJ P,TSTAPN ;NO, TRYING TO READ AN APPEND-ONLY FILE?
PJRST SETIMP ;YES, SET IOIMPM
>
TLZ S,IO ;NO. INDICATE INPUT
MOVEM S,DEVIOS(F) ;SAVE S
PUSHJ P,SAVE2## ;SAVE SOME ACS
INPTU: PUSHJ P,UUOSET## ;SET DDB PNTRS FOR THIS BLOCK
TLOA S,IOEND ;EOF.LIGHT A BIT
PJRST UUOPWQ## ;OK. GO QUEUE REQUEST
IFN FTSTR,< ;IF MORE THAN ONE STR
;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 L(A.T.)
MOVE P2,T1 ;P2= SL. PTR.
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)
IFN FTSFD,<
PUSHJ P,CONPPB ;IN A NOT LOGGED IN SFD?
CAIA
IORM T2,PPBNLG##(T1) ;YES, PRETEND IT IS LOGGED IN
>
PUSHJ P,CLOSIN ;CLOSE CURRENT A.T.
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
POP P,P2 ;RETURN POSSIBLE TEMP SL. (SETSRC CALL)
PUSHJ P,SLGVT##
TLO F,LOOKB ;FOUND ONE. SET F AS IF LOOKUP HAPPENED
TLZ S,IOEND ;IT ISNT REALLY AN EOF YET
HRRZ T3,DEVACC##(F) ;LOC OF A.T.
PUSHJ P,AT2DDB## ;COPY DATA FROM A.T. TO DDB
JRST UFDSR2 ;A.T. DATA IS VERY WRONG
SKIPE T1,DEVMBF##(F) ;DID FNDFIL GET MONITOR BUFFER?
PUSHJ P,GVMNBF## ;YES. GIVE IT UP
IFN FTSFD,<
PUSHJ P,UFORSS## ;GET LOC OF FATHER SFD OR UFB
TRZN T2,NMPSFU## ;AS SFD?
JRST INPTU ;NO, CONTINUE
MOVE T1,T2 ;YES, L(A.T.) INTO T1
PUSHJ P,INCONE ;INCREMENT THE USE-COUNT
>
PJRST INPTU ;DO 1ST INPUT ON NEW DIRECTORY FILE
;HERE IF THE ACCESS TABLE PRODUCES A NON-EXISTENT UNIT
UFDSR2: SKIPE T1,DEVMBF##(F) ;HAVE A MON-BUF?
PUSHJ P,GVMNBF## ;YES, RETURN IT
> ;END CONDITIONAL ON FTSTR
PJRST STOIOS## ;MAKE BELIEVE NO MORE UFD'S
;HERE WHEN WE FOUND THE LAST DIRECTORY
UFDSR4:
IFN FTSFD,<
SETZM DEVUNI##(F) ;PREVENT USETI FROM "WINNING"
HRRZ T1,DEVSFD##(F) ;IN AN SFD?
JUMPE T1,UFDSR3
SETZ J, ;YES, ANY OTHER JOB WITH THIS PPN?
MOVE T1,DEVPPN(F)
PUSHJ P,ONLYTS
JRST UFDSR3
PUSHJ P,CONPPB ;NO, GET PNTR TO PPB
JRST UFDSR3 ;NO AT FOR SFD (SYSTEM ERROR?)
ANDCAM T2,PPBNLG##(T1) ;CLEAR LOGGED-IN BIT
SETZM DEVSFD##(F) ;NO SFD
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
IFN FTSFD,<
;SUBROUTINE TO FIND SFD FOR FILE
;RETURNS CPOPJ IF NONE
;RETURNS CPOPJ1 IF FOUND, T1=L(PPB) T2=PPPNLG
CONPPB: HRRZ T1,DEVSFD##(F) ;SFD
JUMPE T1,CPOPJ## ;NONE IF 0
HLRZ T1,NMBACC##(T1) ;POINT TO AT
TRNE T1,DIFNAL##
POPJ P, ;NONE
MOVE T1,ACCPPB##(T1) ;PPB
MOVEI T2,PPPNLG##
JRST CPOPJ1## ;RETURN
>
;BUFFERRED MODE OUTPUT
OUTPT:
IFN FTNUL,<
PUSHJ P,NULTST ;IF NUL:,
JRST OUTPT1 ; EAT OUTPUT
>
IFN FTSPL,<
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)
TLO S,IO ;NO. INDICATE OUTPUT
MOVEM S,DEVIOS(F) ;SAVE S
PUSHJ P,UUOSET## ;SET DDB PNTRS FOR THIS OPERATION
JRST CHKLBK ;QUOTA EXHAUSTED OR APPEND-ONLY
PJRST UUOPWQ## ;OK - GO QUEUE REQUEST
IFN FTNUL,<
OUTPT1: PUSHJ P,ADVBFE## ;NULL DEVICE-EAT THE BUFFER
JFCL
POPJ P, ;AND RETURN
>
;DUMP MODE INPUT
DMPIN:
IFN FTNUL,<
PUSHJ P,NULTST ;IF NUL:,
JRST SETION ; RETURN EOF
>
IFN FTSPL,<
PUSHJ P,SPTSTI ;SEE IF 1ST INPUT IN SPOOL MODE
PJRST SETION ;YES, AND NO FILE - SET IOEND
>
IFN FTDSUP,< ;SUPER USETI/USETO
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
IFE FTAIR,<
PUSHJ P,TSTAPN ;TRYING TO READ AN APPEND-ONLY FILE?
PJRST SETIMP ;YES, LIGHT IOIMPM
>
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)
IFN FTSFD,<
CAIE T1,(SIXBIT .SFD.) ;AN SFD?
>
CAIN T1,(SIXBIT /UFD/) ;OR UFD?
SOS (P) ;YES, YOU LOSE
PJRST CPOPJ1##
;DUMP MODE OUTPUT
DMPOUT:
IFN FTNUL,<
PUSHJ P,NULTST ;IF NUL,
POPJ P, ; DONT WRITE ANYTHING
>
IFN FTSPL,<
PUSHJ P,SPTSTO ;SEE IF 1ST OUTPUT IN SPOOL MODE
PJRST SETIMP ;YES, AND ERROR ON ENTER - SET IOIMPM
>
IFN FTDSUP,< ;SUPER USETI/USETO
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
IFN FTDSUP,<
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
JUMPN T1,DUMPG2 ;IF IOWD GO ON TO DO IT
SETZM DEVDMP##(F) ;THROUGH - ZERO DEVDMP
IFN FTDSUP,<
TRZ S,UDSX ;MAKE SURE WRITE-FORMAT OFF
>
PJRST STOIOS## ;AND RETURN TO USER
DUMPG2: HLL P1,T1 ;SAVE UNRELOCATED IOWD
MOVE T2,T1 ;SAVE WDCNT
SUBI T1,(R)
HRR P1,T1
DUMPG3: HLLZM T2,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 T1,DEVDMP##(F) ;-WORDCOUNT OF IOWD
TRNE T1,BLKSIZ##-1 ;EVEN MULTIPLE OF 200 WORDS?
TLNN S,IO ;NO. INPUT?
JRST DUMPG5 ;YES. IOWD IS OK AS IT IS
LDB T2,UNYKTP## ;OUTPUT. GET KONTROLLER TYPE
CAIE T2,TYPRP## ;OR RP04.
CAIN T2,TYPDP## ;DISK PACK?
JRST DUMPG5 ;YES, HARDWARE WILL WRITE 0'S TO END OF BLOCK
;SINCE NON DISK-PACK TYPE DISKS DO NOT WRITE ZEROS FROM THE LAST DATA WORD
; TO THE END OF BLOCK (JUST TO THE END OF SECTOR), AND THIS REQUEST IS
; FOR A NON-EVEN NUMBER OF WORDS,WE WILL HAVE TO WRITE FILLER 0'S BY HAND
MOVNS T1 ;+WORDCOUNT
LSH T1,MBKLSH## ;NUMBER OF BLOCKS IOWD WILL TRANSFER
HRRZ T2,DEVLFT##(F) ;NO OF BLOCKS LEFT IN CURRENT GROUP
CAML T1,T2 ;WILL THIS GROUP FINISH THE IOWD?
JRST DUMPG5 ;NO. DON'T NEED MON BUF TILL LATER
PUSHJ P,GTMNBF## ;YES. GET MONITOR BUFFER
MOVSI T2,1(T1) ;1ST WORD IN BUFFER
HRRI T2,2(T1) ;SET UP TO ZERO IT
SETZM 1(T1)
BLT T2,BLKSIZ##(T1) ;ZERO ENTIRE MON BUFFER
;HERE WITH A ZEROED MONITOR BUFFER IF IT WILL BE NEEDED
; (SETLST ASSUMES MON BUFFER IS SET UP IF IT IS NEEDED)
DUMPG5: MOVE T1,P1 ;ORIGINAL IOWD
HLRE T2,T1 ;-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
PUSHJ P,SAVDDL## ;ADJUST RH IN CASE PHIS IS A SAVE OF A HIGH SEGMENT
; WHICH HAS BEEN SHUFFLED SINCE LAST IO
IFN FTKI10!FTKL10,<
PUSHJ P,UVACKS## ;COMPUTE USER VIRTUAL ADDRESS OF THE CHECKSUM
HRLM T2,DEVUVA##(F) ;STORE IT FOR COMPUTING THE CHECKSUM
>
IFN FTKA10,<
HRLM T1,DEVUVA##(F) ;STORE IT FOR COMPUTING THE CHECKSUM
>
ADDI T1,(R) ;RELOCATE RH OF IOWD
HRRM T1,DEVDMP##(F) ;STORE ABS ADR FOR DATA TRANSFER
; (RH ALREADY SET -IGNORE OVERFLOW FROM LH)
PUSHJ P,UUOPWQ## ;OK - GO QUEUE REQUEST
PUSHJ P,PWAIT1## ;WAIT FOR IO TO FINISH
DUMPG6: SKIPE T1,DEVMBF##(F) ;HAVE MONITOR BUFFER?
PUSHJ P,GVMNBF## ;YES. RETURN IT
MOVE T2,DEVDMP##(F) ;THIS COMMAND DONE?
TLNE T2,-1
JRST DUMPG3 ;NO. CONTINUE WITH THIS IOWD
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 CHKLBK ;NO, QUOTA EXHAUSTED, DISK FULL OR APPEND-ONLY
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
IFE FTAIR,<
;SUBROUTINE TO TEST IF APPEND-ONLY
;RETURNS CPOPJ IF YES, CPOPJ1 IF NO
TSTAPN: LDB T1,DEYFNC##
CAIE T1,FNCAPP## ;IS IT APPEND-ONLY?
PJRST CPOPJ1## ;NO, RETURN
PJRST PRVJB## ;YES, SKIP RETURN ONLY IF PRIV'D JOB
>
;SUBROUTINE TO GET A WORD FROM USERS CORE, SAVE J
JWORD: PUSH P,J ;SAVE J (POSSIBLE KONTROLLER DB LOC)
PUSHJ P,GETWDU## ;GET THE WORD
PJRST JPOPJ## ;RESTORE J AND RETURN
;HERE ON NON-SKIP RETURN FROM UUOSET
IFE FTAPLB,<
CHKLBK==SETBTL ;IOBKTL IF CANT APPEND TO LAST BLOCK OF FILE
>
IFN FTAPLB,<
CHKLBK: PUSHJ P,SAVE2## ;SAVE P1,P2
LDB T1,DEYFNC## ;PROTECTION OF FILE
TLNE S,IO ;WRITING?
CAIE T1,FNCAPP## ;YES, APPEND-ONLY?
JRST SETBTL ;NO, SET IOBKTL
MOVE T2,DEVACC##(F) ;YES, L(A.T.)
MOVE T1,ACCWRT##(T2) ;NUMBER OF BLOCKS WRITTEN
LDB P1,ACYLBS## ;SIZE OF LAST BLOCK
CAMN T1,DEVREL##(F) ;TRYING TO WRITE LAST BLOCK?
CAIL P1,BLKSIZ## ;YES, LAST BLOCK HAVE ROOM?
JRST SETBTL ;NO, SET IOBKTL
TLZ S,IOSFIR ;DON'T ALLOW CHECKSUMS
PUSHJ P,GTMNBF## ;YES, GET A MON-BUF
MOVE T2,DEVBLK##(F) ;NUMBER OF LAST BLOCK
PUSHJ P,MONRED## ;READ IT
PJUMPN T3,GVMNBF## ;RETURN IF ERRORS DETECTED IN MONRED
LDB P2,PIOMOD## ;MODE OF FILE
CAIL P2,SD ;DUMP?
JRST CHKLB1 ;YES
MOVE T1,DEVOAD(F) ;NO, GET SIZE OF BUFFER
IFN FTKA10,<
MOVEI T1,@T1 ;RELOCATE KA10 STYLE
>
EXCTUX <MOVE T1,1(T1)>
CAIG T1,(P1) ;REALLY APPEND?
JUMPN T1,CHKLB2 ;NO, ERROR
HRRZ T1,DEVOAD(F) ;NO, GET LOC OF USERS BUFFER
HRLI T1,MBLKSZ## ;LENGTH = 200
JRST CHKLB4
;HERE IF DUMP MODE
CHKLB1: PUSHJ P,JWORD ;GET THE IOWD
HLRE T3,T1 ;- COUNT OF WORDS TO WRITE
MOVN T4,T3 ;+ COUNT
CAILE T4,BLKSIZ## ;LESS THAN A FULL BLOCK?
SKIPA T4,[XWD BLKSIZ##,BLKSIZ] ;NO, UPDATE BY A FULL BLOCK
HRLI T4,(T4) ;YES, UPDATE BY ACTUAL COUNT
ADDM T4,DEVDMP##(F) ;UPDATE THE IOWD SAVED IN THE DDB
ADD T3,P1 ;MORE THAN CURRENT SIZE OF BLOCK?
JUMPL T3,CHKLB3 ;OK IF POITIVE
CHKLB2: PUSHJ P,GVMNB0## ;BAD - RETURN THE MON BUF
PJRST SETBTL ;AND SET IOBKTL
CHKLB3: SUBI T1,1 ;ADJUST IOWD
;STILLL IN FTAPLB CONDITIONAL
;HERE WITH T1=IOWD, P1=NUMBER OF WORDS IN BUFFER
CHKLB4: MOVE T3,DEVMBF##(F) ;LOC OF MON BUFFER
ADDI T1,2(P1) ;ACCOUNT FOR HOUSEKEEPING WORDS
ADDI T3,1(P1) ;POINT TO FIRST NEW WORD IN MON BUF
IFN FTKA10,<
ADDI T1,(R) ;POINT TO FIRST NEW IN USER'S AREA
>
HRL T3,T1 ;SET FOR BLT
HLRES T1 ;NUMBER OF WORDS TO TRANSFER
MOVNS T1 ;+N
CAILE T1,BLKSIZ## ;MAKE SURE IT ISNT TOO HIGH
MOVEI T1,BLKSIZ## ;IT IS, REDUCE IT
ADD T1,DEVMBF##(F) ;POINT TO END OF BLT
EXCTUX <BLT T3,(T1)> ;INTO MON-BUF
MOVE T1,DEVMBF##(F) ;IOWD FOR THE DATA
PUSHJ P,MONWRT## ;GO WRITE IT
PUSHJ P,GVMNBF## ;RETURN THE MON-BUF
AOS DEVBLK##(F) ;UPDATE COUNTS
AOS DEVREL##(F)
SOS DEVLFT##(F)
;HERE WHEN THE NEW LAST BLOCK HAS BEEN WRITTEN
CAIL P2,SD ;DUMP MODE?
JRST DUMPG6 ;YES, FINISH UP
MOVE T1,DEVOAD(F) ;NO, POINT TO THE DATA
EXCTUX <SKIPN T1,1(T1)>;GET THE WORD COUNT
MOVEI T1,BLKSIZ## ;200 WORDS IF NOT SPECIFIED
MOVE T2,DEVACC##(F) ;LOC OF A.T.
DPB T1,ACYLBS## ;SAVE NEW LAST-BLOCK SIZE
PUSHJ P,ADVBFE## ;ADVANCE 1 BUFFER
JFCL
POPJ P, ;AND RETURN
> ;END CONDITIONAL ON FTAPLB
IFN FTSPL,<
;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
IFN FTSTR,< ;IF MORE THAN ONE STR
PUSHJ P,SLPTJ## ;SET T1= SL. PTR.
POPJ P, ;NO S.L.
>
PUSHJ P,ULOOK2 ;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
HLLM F,USRJDA##(P1) ;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
PUSHJ P,SAVE1## ;NO. SAVE P1
MOVEI T2,1 ;GET 1 4-WORD BLOCK
PUSHJ P,GET4WD##
POPJ P, ;NONE AT ALL- CANT FAKE THE ENTER
MOVE P1,T1 ;GOT ONE - SAVE ITS LOC IN P1
HRLI T1,140(R) ;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,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,141(R) ;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'
>
SPTST4: HRRM T1,140(R) ;SAVE RH OF FILE NAME IN ENTER BLOCK
MOVEI T1,^D640 ;THERE ARE 36**2 LEGAL NAMES STARTING WITH "Q",
HRRM T1,141(R) ; SO SET A LIMIT OF HALF THAT
SPTST5: 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
;STILL IN FTSPL CONDITIONAL
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,141(R) ;COUNT OF TRIES
TRNE T1,-1 ;TRIED (AND LOST) ENOUGH?
SOSA 141(R) ;NO
DPB T2,[POINT 6,T3,23] ;YES, 1ST CHAR = RANDOM
HRLM T3,140(R) ;SAVE NAME
PUSH P,M ;SAVE UUO
HRRI M,140 ;POINT M TO THE FAKED ENTER-BLOCK
IFN FTSTR,< ;IF MORE THAN ONE STR
PUSHJ P,SLPTJ## ;T1 = SL. PTR.
POPJ P, ;NO S.L.
>
MOVE T2,SPLPRT## ;PROTECTION FOR SPOOLED FILES
MOVEM T2,142(R)
SETZM 143(R) ;ZERO PRJ,PRG
IFN FTGALAXY,<
MOVE T2,QUEPPN## ;GET QUEPPN
SKIPE %SIQSR## ;QUASAR RUNNING?
MOVEM T2,143(R) ;YES, PUT FILE IN QUEPPN
>
PUSHJ P,UENT2 ;FAKE AN ENTER
JRST SPTST6 ;DID NOT WIN
TLO F,ENTRB ;OK - TURN ON ENTRB
AOSA T1,-1(P) ;SET FOR SKIP-RETURN
SPTST6: TLZ F,ENTRB ;MAKE SURE ENTRB OFF ON FAILURE
POP P,M ;RESTORE UUO
LDB T2,PUUOAC## ;GET CHAN NUM
HLLM F,USRJDA##(T2) ;SAVE BITS IN USRJDA
CAIN T1,AEFERR ;CAN'T - SUPERSEDE ERROR?
JRST SPTST5 ;YES, TRY AGAIN
HRLZ T2,P1 ;LOC OF 4-WORD BLOCK
HRRI T2,140(R) ;SET TO RESTORE USER'S 0-3
BLT T2,143(R) ;BACK AS GOOD AS NEW
MOVEI T1,1 ;DONE - GIVE UP CORE BLOCK
HRRZ T2,P1
PJRST GIV4WD## ;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,SAVE1## ;SAVE P1
HLRZ U,DEVUNI##(F) ;SET U TO UNIT OF RIB
IFN FTSTR,<
JUMPE U,CPOPJ## ;RETURN IF UNIT WAS YANKED
>
PUSHJ P,TSTRDR ;IS ANYONE ELSE READING FILE?
JUMPE T1,STOIOS## ;RETURN IF NO AT
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: SKIPN DEVMBF##(F) ;FILE HAVE MON BUF?
PUSHJ P,GTMNBF## ;NO. GET IT
NOTOL2: PUSHJ P,SAVE1## ;SAVE P1
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
IFN FTSFD,<
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
SKIPE T1,DEVMBF##(F) ;HAVE MONITOR BUFFER?
PUSHJ P,GVMNBF## ;YES. RETURN IT
PUSHJ P,GETCB## ;GET CB RESOURCE
HRRZ T1,DEVACC##(F) ;LOC OF A.T.
CBDBUG (Y,Y);
PJRST CLSN3A ;%DELETE NMB, TEST LOGGED-IN, AND EXIT
;HERE WHEN FILE IS NOT MARKED FOR DELETION
CLSIN2: TRNE M,CLSOUT ;SUPPRESSING OUTPUT CLOSE?
JRST CLSN2B ;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
CLSN2B: 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 CLSIN3 ;YES, DON'T WRITE RIB
TLNN S,IOSWLK ;FILE WRITE LOCKED?
TLNN F,INPB ;NO. ANY INPUTS DONE?
JRST CLSIN3 ;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 CLSIN3 ;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 CLSN2A ;RIB ERR - DON'T REWRITE IT
TRNE M,CLSACC
JRST CLSN2C
MOVE T1,DEVMBF##(F) ;LOC OF BUF (-1)
MOVE T2,THSDAT## ;GET TODAYS DATE
DPB T2,[POINT 15,RIBEXT##+1(T1),35]
HRRM U,DEVUNI##(F)
CLSN2C:
IFN FTDBBK,<
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
IFN FTDBBK,<
PUSHJ P,ERRFIN ;WRITE BAT BLOCK IF THERE WAS AN ERROR
>
CLSN2A: PUSHJ P,GVMNB0## ;GIVE UP MONITOR BUFFER
CLSIN3: TLNE F,ENTRB+RENMB ;ENTER OR RENAME DONE?
JRST CLSXIT ;YES, EXIT (UPDATE SUPPRESSING OUTPUT CLOSE)
IFN FTFDAE,<
MOVSI T1,DEPFDA## ;CALL FILE DAEMON ON CLOSE BIT
TDNN T1,DEVFDA##(F) ;SHOULD THE FILE DAEMON BE CALLED?
JRST CLSN3D ;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
CLSN3D:>
IFN FTSFD,<
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,CLSIN5 ;%EXIT IF READ-COUNT NON-0
TRNE T2,ACPREN ;%RENAME IN PROGRESS (BY ANOTHER JOB)?
JRST CLSIN5 ;%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 CLSIN6 ;%YES, JUST MAKE A.T. DORMANT
IFN FTSFD,<
MOVE T3,T1 ;%SAVE LOC OF A.T.
PUSHJ P,GTNM1 ;%GET L(NMB)
EXCH T1,T3 ;%L(NMB) INTO T3, L(A.T.) INTO T1
MOVE T2,NMBSFD##(T3) ;%IS THE FILE AN SFD?
TRNN T2,NMPSFD## ;%
JRST CLSN3B ;%NO, CONTINUE
MOVE T2,NMBNMB##(T3) ;%YES, DOES IT POINT TO ANY NMB'S?
TLNN T2,NMPUPT## ;% (IF SO, THERE IS AN NMB POINTING TO IT)
JRST CLSIN6 ;%YES, THE NMB MAY NOT BE DELETED
CLSN3B:>
;HERE IF NMB NOW HAS NO A.T.S IN ITS RING
CLSN3A: JUMPE T1,CLSIN5 ;IF STR WAS REMOVED
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?
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,TSTPPB ;%EXIT IF NMB STILL IN USE
HLRZ T2,P1 ;%LOC OF PPB FOR FILE
PUSHJ P,SET1NM ;%SET T2 TO 1ST NMB IN LIST
JUMPE T2,CLSIN5 ;%GO IF NONE (SYSTEM ERROR?)
CLSN3C: CAIN T2,(P1) ;%THIS THE RIGHT NMB?
JRST CLSIN4 ;%YES. HAVE PRED IN T3
MOVE T3,T2 ;%NO. NEW PREDECESSOR
HLRZ T2,NMBPPB##(T2) ;%STEP TO NEXT NMB IN RING
IFN FTSFD,<
TRNN T2,NMPUPT## ;%UPWARD PNTR (NOT SAME LIST) IF ON
>
JUMPN T2,CLSN3C ;%GO TEST IT
JRST CLSIN5 ;%CANT FIND THE PREDECESSOR (SYSTEM ERROR?)
;HERE WITH T3=LOC OF PREDECESSOR NMB TO THE ONE WE WANT TO DELETE
CLSIN4: 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
CLSIN5: PUSHJ P,GVCBJ1## ;%GIVE UP CB AND SKIP
CLSIN6: PUSHJ P,ATSDRA## ;%MAKE A.T. DORMANT
SETZM DEVUNI##(F) ;THIS FILE NO LONGER OPEN (SO ENTER WILL TEST UNIT)
IFN FTLIB,<
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:
IFN FTLIB,<
MOVSI T1,DEPLIB## ;CLEAR FILE-FROM-LIB
ANDCAM T1,DEVLIB##(F) ;SO UPDATE WILL WIN
>
POPJ P, ;EXIT
;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
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
;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::HRRZ T2,DEVACC##(F) ;LOC OF A.T.
SKIPN T1,T2 ;IS THERE ONE?
JRST GTNM2
GTNM1:: HLRZ T1,ACCNMB##(T1) ;STEP TO NEXT IN RING
TRZN T1,DIFNAL## ;IS IT AN NMB?
JRST .-2 ;NO. TRY NEXT
POPJ P, ;YES. RETURN
GTNM2: SKIPN DEVUNI(F)
POPJ P,
STOPCD CPOPJ##,DEBUG,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.
CLSNAM::PUSHJ P,GETNMB ;SET T1= NMB, T2=A.T.
MOVE T3,NMBNAM##(T1) ;NAME
MOVEM T3,DEVFIL(F) ;INTO DDB
PUSHJ P,GTNMX ;GET EXTENSION FROM NMB
HLLM T4,DEVEXT(F) ;INTO DDB
POPJ P, ;RETURN
;SUBROUTINE TO GET THE EXTENSION FROM THE NMB BLOCK
;RESPECTS T1,T2,T3
GTNMX::
IFN FTSFD,<
MOVE T4,NMBSFD##(T1) ;GET LOC OF SFD-WORD
TRNN T4,NMPSFD## ;IS THE FILE AN SFD?
SKIPA T4,NMBEXT##(T1) ;NO, GET EXT. FROM NMB
MOVSI T4,(SIXBIT .SFD.) ;YES, EXT="SFD"
POPJ P, ;RETURN
>
IFE FTSFD,<
MOVE T4,NMBEXT##(T1)
POPJ P,
>
;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::
IFN FTSFD,<
HRRZ T4,DEVSFD##(F)
JUMPE T4,SETIN1
HLRZ T2,NMBNMB##(T4) ;IN AN SFD - 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
SUB T3,T4 ;T3=WHERE TO STOP BLT
BLT T1,-2(T3) ;(BLT 1 WORD TOO MANY IN CASE THIS
;IS THE 64TH ENTRY IN THE BLOCK)
SETZM -2(T3) ;ZERO LAST SLOT IN UFD BLOCK
SETZM -1(T3)
MOVE T1,DEVMBF##(F) ;IOWD FOR MONITOR BUFFER
MOVE T2,DEVBLK##(F) ;BLOCK NUMBER
PUSHJ P,WRTUFD ;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
IFN FTSTR,< ;IF MORE THAN ONE STR
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
IFN FTDBBK,<
;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
;ENTER WITH T1=C(DEVMBF)
;EXIT WITH T1=C(DEVMBF)
TSTBAD: 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,SAVE1## ;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
LDB T2,DEYELB## ;BAD BLOCK NUMBER
MOVEI P1,1 ;P1 WILL COUNT # OF BLOCKS IN BAD REGION
MOVSI T1,MBLKSZ## ;IOWD TO READ 1 BLOCK, BUT NOT STORE DATA
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,MONRED## ;NO, READ IT
TRNE T3,IODTER+IODERR ;IS IT BAD?
AOJA P1,TSTBD2 ;YES. COUNT AND TRY NEXT BLOCK
TSTBD3: MOVE T1,DEVMBF##(F) ;NO. LOC OF MON BUF (AND RIB)
HRRM P1,RIBNBB##+1(T1) ;SAVE COUNT IN RIB
POP P,U ;RESTORE ORIGINAL U
HRRM U,DEVUNI##(F) ;SAVE IN DDB
POPJ P, ;AND RETURN
;STILL IN FTDBBK CONDITIONAL
;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,DEVMBF##(F) ;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,DEVMBF##(F) ;LOC OF RIB
HRRZ P2,RIBNBB##+1(T1) ;LENGTH OF BAD REGION
ADD P2,P1 ;TOP BLOCK(+1) OF BAD REGION
HRRZ T2,UNIHOM##(U) ;LOC OF 1ST HOME BLOCK
ADDI T2,LBOBAT## ;OFFSET FOR 1ST BAT BLOCK
PUSHJ P,MONRED## ;READ IT
HLRZ T2,UNIHOM##(U) ;LOC OF 2ND HOME BLOCK
ADDI T2,LBOBAT## ;LOC OF 2ND BAT BLOCK
TRZE T3,IODTER+IODERR+IOIMPM ;ERROR READING 1ST BAT?
PUSHJ P,MONRED## ; YES. READ 2ND
MOVE T1,DEVMBF##(F) ;LOC OF BAT BLOCK
MOVEI T2,1(T1) ;1ST REAL WORD OF BAT
ADD T2,BAFFIR##(T2) ;COMPUTE AOBJN WORD FOR BAT REGIONS
MOVS T3,BAFNAM##+1(T1) ;NAME OF BLOCK
CAIE T3,'BAT' ;"BAT"?
PJRST SDWNDA## ;NO, DON'T UPDATE
;STILL IN FTDBBK CONDITIONAL
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## ;IF OLD-STYLE
TDNN T4,BAFAPN##(T2)
HRRZS T3 ; ONLY 18 BITS COUNT
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
LDB T4,UNYPUN## ;THIS UNIT NUMBER
LSH T3,(T4) ;POSITION BIT FOR THIS UNIT
ORB T3,BAFPUB##(T2) ;MARK IN TALLY OF UNITS WHICH SAW BAD REGION
;STILL IN FTDBBK CONDITIONAL
;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
MOVE P1,T2
HRRZ T2,UNIHOM##(U) ;LOC OF 1ST HOME BLOCK
ADDI T2,LBOBAT## ;LOC OF 1ST BAT BLOCK
PUSHJ P,MONWRT## ;WRITE IT
HLRZ T2,UNIHOM##(U) ;LOC OF 2ND HOME BLOCK
ADDI T2,LBOBAT## ;LOC OF 2ND BAT BLOCK
PUSHJ P,MONWRT## ;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,SDWNDA## ;GIVE UP DA RESOURCE IF NOT SIM. UPDATE
JRST ERFIN5
;HERE IF A BAD RIBEUN IN RIB
ERFN4A: HRRZ U,DEVUNI##(F) ;RESET U
;HERE AFTER BAT BLOCK IS WRITTEN
ERFIN5:
PUSHJ P,UPAU## ;NO, GET AU RESOURCE
HRRZ P1,DEVUFB##(F) ;LOC OF UFB
JUMPE P1,DWNAU## ;NO UFB IF SUPER IO
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,DEVMBF##(F) ;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
ORM T3,RIBSTS##+1(T1) ;MARK IN LH(RIBSTS)
PUSHJ P,MONWRT## ;WRITE UFD RIB
PJRST DWNAU## ;GIVE UP AU AND RETURN
> ;END CONDITIONAL ON FTDBBK
;CLOSE OUTPUT
CHNDIR==1 ;BIT ON IN M IF CHANGE DIRECTORY ON A CLOSE
CLOSOU:
IFN FTSPL,<
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
SKIPN DEVMBF##(F) ;RENAME GETS MON BUF
PUSHJ P,GTMNBF## ;YES, GET THE MON BUFFER
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
IFN FTKA10,<
TLO T2,R ;SET TO RELOCATE
>
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 CLSO1A ;NO, SKIP ON
HLL T3,T2 ;SET TO RELOCATE BUFFER POINTER
AOS T1,T3 ;GET ADDR OF USER WORD COUNT IN T1,T3
IFN FTKA10,<
MOVEI T1,(T1) ;CLEAR INDEX PC FOR ADDR CHECK>
PUSHJ P,UADRCK## ;MAKE SURE LEGAL, NO RETURN IF NOT
EXCTUX <HRRZ T4,@T3> ;GET USER WORD COUNT
CLSO1A: JUMPE T4,NOOUTP ;DON'T OUTPUT IF LENGTH .LE. 0
TLZ S,IOSRIB ;RIB IS NO LONGER IN MON BUF
;(OUTPUT MAY READ RIB BACK)
PUSHJ P,OUT## ;WRITE THE LAST BUFFER
PUSHJ P,PWAIT1## ;WAIT FOR IT
;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!
HRRZ U,DEVUNI##(F) ;SET U TO UNIT OF SECOND RIB
IFN FTSTR,<
JUMPE U,CPOPJ## ;A.T. WAS FIXED IF STR 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
SKIPN T1,DEVMBF##(F) ;JOB HAVE MONITOR BUFFER?
PUSHJ P,GTMNBF## ;NO. GET IT
IFN FTDSIM,<
MOVE T1,DEVACC##(F) ;IF THIS IS A SIMULTANEOUS UPDATE FILE
MOVE T1,ACCSMU##(T1) ; GET THE DA RESOURCE AS A GUARD AGAINST
TRNE T1,ACPSMU ; RACE CONDITIONS INVOLVING RIBS
PUSHJ P,UPDA## ; GET DA 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
IFE FTDSIM,<
JUMPN T3,NOOUT2 ;RIB ERROR - FORGET IT
>
IFN FTDSIM,<
JUMPE T3,NOOUT1 ;GO IF NO RIB ERROR
TLNE S,IOSDA ;RIB ERROR - HAVE DA?
PUSHJ P,DWNDA## ;YES (SIM UPDATE). RETURN IT
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
HRRZ T1,DEVACC##(F) ;LOC OF A.T.
TLZN F,RESETB ;RESET BEING PERFORMED?
JRST CLSOU2 ;NO. CONTINUE
IFN FTDMRB,<
SKIPL DEVRIB##(F) ;IN EXTENDED RIB?
JRST NOUT1A ;NO
PUSHJ P,WRTRIB## ;YES, WRITE CURRENT RIB
PUSHJ P,REDRIB## ;READ PRIME RIB
JRST CLRSTS ;ERROR READING RIB
HRRZ T1,DEVACC##(F) ;RESTORE AT LOC
NOUT1A:
>
PUSHJ P,ATRMOV## ;GET RID OF A.T.
IFN FTSFD,<
PUSHJ P,DECUSA ;DECREMENT USE-COUNT OF SFD A.T.
>
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: MOVE T1,DEVACC##(F) ;LOC OF A.T.
MOVE T1,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
TLNN F,RESETB ;CLOSE ACTING LIKE RESET?
TRNN T1,ACPCRE ;CREATE?
JRST CLRSTS ;NO, DON'T TOUCH OLD FILE
JRST CLSRB7 ;YES, ENTER NAME IN UFD
;HERE WITH THE RIB IN CORE, AND ALL PNTRS IN THE RIB
CLSOU2:
IFN FTDSIM,<
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
IFN FTDMRB,<
SKIPL DEVRIB##(F) ;NOT LAST WRITER - IN PRIME RIB?
JRST CLSRB4 ;YES, JUST UPDATE DATES
PUSHJ P,WRTRIB## ;NO, WRITE CURRENT RIB
PUSHJ P,REDRIB## ;READ PRIME RIB
JRST NOOUT2 ;RIB ERR
> ;END FTDMRB
JRST CLSRB4 ;AND GO UPDATE DATE/TIME
CLSSIM: PUSHJ P,DOWNIF## ;LADT WRITER - GIVE UP DA
> ;END FTDSIM
MOVE T1,P1 ;AOBJN WORD FOR POINTERS
CLSLUP: HRRZ T4,DEVACC##(F) ;LOC OF ACC
MOVE T3,ACCWRT##(T4) ;HIGHEST WRITTEN BLOCK OF FILE
IFN FTDMRB,< ;IF MULTIPLE RIBS
MOVE T4,DEVMBF##(F) ;IOWD FOR MONITOR BUFFER
MOVE T2,RIBFLR##+1(T4) ;GET FIRST BLOCK NUMBER IN RIB
SKIPL DEVRIB##(F) ;EXTENDED RIB?
> ;END CONDITIONAL ON FTDMRB
SETZ T2, ;NO, ZERO STARTING BLOCK IN CASE OLD FILE
PUSHJ P,SCNPTR## ;GET THE POINTER FOR THIS BLOCK
JRST CLSO2A ;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
IFN FTDMRB,<
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
CLSOU3: AOBJP P1,CLSO3A ;STEP TO NEXT POINTER SLOT
SKIPE T2,(P1) ;IS THERE ONE?
JRST CLSOU6 ;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,CLSOU4 ;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 CLSOU4 ;CANT GET IT THERE - TRY ANYWHERE
IFN FTDSIM,<
PUSHJ P,DOWNIF## ;TAKBLK KEEPS DA IF SIM. UPD.
>
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
CLSO2A:
IFN FTDMRB,< ;IF MULTIPLE RIBS
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 CLSO2B ;EITHER ERROR OR NONE
PUSHJ P,SPTRW## ;PUT AOBJN WORD TO POINTERS IN T1
JRST CLSLUP ;GO SCAN THIS RIB
CLSO2B: JUMPN T3,NOOUT2 ;IF T3 NON-ZERO, ERROR
> ;END CONDITIONAL ON FTDMRB
STOPCD NOOUT2,DEBUG,NER, ;++NO EXTENDED RIB
;HERE WHEN POINTERS RAN OUT, WE KNOW THERE IS ONE MORE BLOCK IN THE LAST POINTER
CLSO3A: 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
CLSOU4: AOBJP P1,CLSFUL ;STEP TO NEXT POINTER SLOT
PUSHJ P,SUPDA##
CLSO4A: HRRM P1,DEVRET##(F) ;SAVE LOC OF NEW POINTER (IN MON BUF)
SKIPLE UNITAL##(U) ;UNIT HAVE ANY SPACE LEFT?
JRST CLSOU5 ;YES
PUSHJ P,NEXTUN## ;NO. STEP TO NEXT UNIT
JRST CLSO4B ;NO UNIT IN STR HAS SPACE!
AOBJN P1,CLSO4A ;FOUND. STEP TO NEXT PNTR LOC IF ROOM IN RIB
SETZM @DEVRET##(F) ;NO ROOM IN RIB - ZERO UNIT-CHANGE
PUSHJ P,LSTUNI ;RESET U TO LAST UNIT IN RIB
;AND FALL INTO CLSFUL
CLSO4B: PUSHJ P,DWNDA##
;HERE WHEN THERE IS NO SPACE IN STR, OR ALL POINTER SLOTS ARE TAKEN
CLSFUL: TRO S,IOBKTL ;LIGHT ERROR BIT
HRRZ T1,DEVACC##(F) ;LOC OF ACC
SOSGE ACCWRT##(T1) ;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
JRST CLSRB2 ;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
CLSOU5: 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)
CLSOU6: PUSHJ P,CNVPTR## ;CONVERT POINTER TO COUNT, ADDRESS
JRST NOOUT2 ;BAD UNIT-CHANGE PNTR
JRST CLSOU3 ;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
CLSRB2:
IFN FTDMRB,< ;IF MULTIPLE RIBS
MOVE T1,DEVRIB##(F) ;GET DEVRIB INTO T1 IN CASE NOT GO TO UPDGIV
>
TRNE M,CLSDLL ;DELETE UNWRITTEN BLOCKS FROM FILE?
JRST CLSR2A ;NO
IFN FTDMRB,< ;IF MULTIPLE RIBS
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
IFN FTDMRB,< ;IF MULTIPLE RIBS
POP P,T1 ;RESTORE PREVIOUS CURRENT RIB TO T1
>
CLSR2A:
IFN FTDMRB,<
SKIPL DEVRIB##(F) ;SKIP IF NOT IN PRIME RIB
JRST CLSRB3 ;PRIME RIB, GO WRITE REDUNDANT
CAME T1,DEVRIB##(F) ;ARE WE STILL IN THE SAME EXTENDED RIB?
JRST CLSR2C ;NO, GET PRIME
PUSHJ P,WRTRIB## ;WRITE OUT THE CURRENT RIB
CLSR2C: PUSHJ P,REDRIB## ;GET THE PRIME RIB INTO CORE
JRST NOOUT2 ;ERROR READING RIB
> ;END CONDITIONAL ON FTDMRB
CLSRB3: TLZ M,400000
HLRZ T1,DEVEXT(F) ;EXTENSION OF FILE
IFN FTSFD,<
CAIN T1,(SIXBIT .SFD.) ;AN SFD?
TLOA M,400000 ;YES, LIGHT SIGN BIT, DON'T CHANGE UFB
>
CAIE T1,(SIXBIT .UFD.) ;A UFD?
JRST CLSRB4 ;NO
TLO M,400000 ;INDICATE FILE IS A DIRECTORY
PUSHJ P,FNDUFB ;YES. FIND UFB FOR FILE
JRST CLSRB4 ;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
CLSRB4: MOVE T1,DEVMBF##(F) ;IOWD FOR MON BUF
HRRZ P1,DEVACC##(F) ;LOC OF A.T.
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,CLSRB5 ;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
CLSRB5: 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 CLSR5A ;NOT PRE-ALLOCATING OR WRITTEN
IORM T2,RIBSTS##+1(T1) ;PRE-ALLOCATED, LIGHT BIT
JRST CLSR5B
CLSR5A: MOVEM T3,DEVPAL##(F) ;ENSURE DEPPAL=0
ANDCAM T2,RIBSTS+1(T1) ; AND THE BIT IS OFF
CLSR5B: 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 CLSRB6 ;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 CLSR6A ;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)
CLSRB6: 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
CLSR6A: 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
IFN FTDBBK,<
MOVE T1,DEVMBF##(F) ;GET IOWD TO MONBUF
PUSHJ P,TSTBAD ;SET RIBELB, ETC IF ERROR
>
HLRZ P3,DEVUNI##(F) ;SAVE FIRST UNIT IN P3 FOR LATER CALL TO SETCFP
ALLPT0:
IFN FTDSIM,<
TLNE S,IOSDA ;IF HAVE DA MUST BE SIM UPDATE
JRST ALLP0D ;SO JUST REWRITE PRIME RIB (WITH NEW DATES)
>
IFN FTDMRB,< ;IF MULTIPLE RIBS
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 ALLP0A ;GO WRITE REDUNDANT RIB NEXT TO REAL
PUSHJ P,SCNPT0## ;SCAN THE RIB FOR THE BLOCK IN T3
JRST ALLP0B ;NOT FOUND, MUST BE A FULL RIB
SETZM DEVREL##(F) ;FLAG THAT NEXT RIB(IF ANY) IS INACTIVE
JRST ALLP0C ;GO WRITE REDUNDANT
;STILL IN FTDMRB CONDITONAL
;HERE WHEN WORKING IN AN INACTIVE RIB (BLOCKS ALLOCATED BUT NOT USED)
ALLP0A: 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 ALLP0C ;GO WRITE THE RIB
;HERE TO WRITE THE REDUNDANT RIB IN THE LAST BLOCK OF THE RIB
ALLP0B: 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
> ;END CONDITIONAL ON FTDMRB
;HERE TO WRITE RIB IN CORE REDUNDANTLY IN BLOCK NUMBER CONTAINED IN DEVBLK
ALLP0C: MOVE T1,DEVMBF##(F) ;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,MONWRT## ;WRITE REDUNDANT RIB
ALLP0D: PUSHJ P,WRTRIB## ;WRITE REAL RIB
PUSHJ P,RIBSAT ;WRITE SATS WHICH HAVE CHANGED
IFN FTDMRB,< ;IF MULTIPLE RIBS
MOVE T1,DEVMBF##(F) ;IOWD TO MONITOR BUFFER
PUSH P,RIBXRA##+1(T1) ;GET POINTER TO NEXT RIB (IF ANY)
SKIPGE DEVRIB##(F) ;PRIME RIB?
JRST ALLP3A ;NO, DON'T DO ANYTHING ABOUT BAT BLOCKS
SKIPE RIBFLR##+1(T1) ;SKIP IF EXTENDABLE RIB
SETZM (P) ;NOT EXTENDABLE, RIBFLR IS GARBAGE
> ;END CONDITIONAL ON FTDMRB
IFN FTDBBK,<
PUSHJ P,ERRFIN ;YES, WRITE BAT BLOCK IF ERRORS
>
IFN FTDMRB,< ;IF MULTIPLE RIBS
ALLP3A: POP P,DEVRIB##(F) ;GET POINTER FROM PREVIOUS RIB
SKIPN DEVRIB##(F) ;ANY MORE RIBS?
JRST ALLPTR ;NO, THROUGH
PUSHJ P,RIBCUR## ;READ THE NEXT RIB
JUMPN T3,NOOUT2 ;IF T3 NON-ZREO, RIB ERROR
JRST ALLPT0 ;TAKE CARE OF THE EXTENDED RIB
> ;END CONDITIONAL ON FTDMRB
;HERE WHEN WE ARE FINISHED CLEANING UP SATS AND RIBS
ALLPTR:
IFN FTDSIM,<
TLNN S,IOSDA ;SIM UPDATE?
JRST CLSRB7 ;NO, CHANGE DIRECTORY
PUSHJ P,DWNDA## ;YES, GIVE UP DA SINCE RIB NOW WRITTEN
JRST CLRSTS ;AND FINISH THE CLOSE
>
;NOW CHANGE THE DIRECTORY
CLSRB7: PUSHJ P,GETNMB ;GET LOC OF NMB,A.T.
MOVE P1,T1 ;P1=LOC OF NMB
IFN FTSTR,< ;IF MORE THAN ONE STR
LDB T1,ACYFSN## ;FSN
>
PUSHJ P,FSNPS2## ;POSITION A BIT FOR NMBYES
ORM T2,NMBYES##(P1) ;INDICATE FILE EXISTS IN STR (ANOTHER JOB MIGHT
; HAVE DELETED ORIGINAL AFTER JOB WENT THROUGH FNDFIL)
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
IFN FTDRDR,<
MOVE T4,PPBNAM##(T3) ;NEW PRJ,PRG NUMBER
CAME T4,DEVPPN(F) ;SAME AS OLD?
JRST NOTOL1 ;NO. CREATE FILE IN NEW DIR.
>
IFN FTSFD,<
TLNN F,RENMB ;IF A RENAME WAS DONE,
JRST CLSRB8
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
CLSRB8:>
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
HLRZ T1,ACCNMB##(T1) ;STEP TO NEXT IN A.T. RING
TRZN T1,DIFNAL## ;IS IT A NAME BLOCK?
JRST .-2 ;NO. TRY NEXT IN RING
;HERE WITH T1=LOC OF NMB FOR THE FILE
MOVE T2,NMBNAM##(T1) ;(NEW) FILE NAME
MOVEM T2,UFDNAM##(T3) ;SAVE IN DIRECTORY
PUSHJ P,GTNMX ;GET EXT FROM NMB BLOCK
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
HRRM T1,NMBCFP##(T2) ;SAVE CFP IN NMB
IFN FTSTR,< ;IF MORE THAN ONE STR
HRRZ T1,DEVACC##(F) ;LOC OF ACC
LDB T1,ACZFSN## ;FSN OF THIS FILE
DPB T1,NMYFSN## ;SAVE IN THE NMB
> ;END CONDITIONAL ON FTSTR
MOVE T1,DEVMBF##(F) ;IOWD FOR THE MON BUF
MOVE T2,DEVBLK##(F) ;ADR. OF THE DIRECTORY BLOCK
PUSHJ P,WRTUFD ;GO WRITE THE UPDATED DIRECTORY BLOCK
PUSHJ P,DWNAU## ;GIVE UP AU RESOURCE
HRRZ T1,DEVACC##(F) ;LOC OF A.T.
MOVE T1,ACCSTS##(T1) ;STATUS
TRNE T1,ACPSUP ;SUPERSEDER?
JRST ALLPT4 ;YES. REMOVE OLD FILE
POP P,T1 ;NO. REMOVE JUNK FROM PD LIST
JRST CLRSTS ;AND FINISH UP
ALLPT4: HRRZ T1,P1 ;CFP FOR THE OLD FILE
HRRZ T2,DEVACC##(F) ;LOC OF A.T.
ALLPT5: CBDBUG (N,Y);
IFN FTSTR,< ;IF MORE THAN ONE STR
LDB P1,ACYFSN## ;STR NUMBER
>
PUSHJ P,CFP2BK## ;CONVERT TO BLOCK ADR
JRST ALLPT6 ;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,ALLPT6 ;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: SKIPE ACCDOR##(T2) ;%FILE DORMANT?
JRST 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 NOW BE DELETED
DELTS2: MOVEI T1,ACPDEL##+ACPNIU ;%NO. 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: TLO S,IOSALC ;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
TLZ S,IOSALC
MOVNI P4,ACPCNT## ;DECR READ-COUNT WHEN SAFE
JRST CLRSTX
ALLPT6: 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:
IFN FTDRDR,<
TRZA M,-1 ;NO OLD DIR
NOTOL1: HRRI M,CHNDIR ;INDICATE DELETE NAME FOM OLD 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
NOTO1A: 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
IFN FTDUFC,< ;IF KEEP FILES IN ORDER IN UFO
PUSHJ P,UFORSS## ;GET UFB OR SFD A.T. LOC
IFN FTSFD,<
TRZE T3,NMPSFU## ;AN SFD?
SKIPA P2,ACCWRT##(T3) ;YES, GET SIZE FROM ACCWRT
>
LDB P2,UFYWRT## ;NO OF DATA BLOCKS IN DIRECTORY
JUMPN P2,NOTO3A ;GO IF NOT EMPTY
AOS DEVBLK##(F) ;ZERO UFD, SET TO WRITE 1ST BLOCK
JRST UFDNXT ;SET UP TO WRITE IT
NOTO3A: 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,DEVMBF##(F) ;IOWD FOR DATA
PUSHJ P,MONRED## ;READ THE DIRECTORY BLOCK
JUMPN T3,UFDNXT ;LEAVE DATA BLOCK ALONE IF ERROR READING
> ;END CONDITIONAL ON FTDUFC
IFE FTDUFC,<
TDZA P2,P2
SCNFRE: TLZ S,IOSFIR ;NOT 1ST BLOCK IN PTR
PUSHJ P,DIRRED## ;READ NEXT UFD BLOCK
JRST UFDNXT ;NO SPACE - ALLOCATE ANOTHER BLOCK
JUMPN T3,UFDNXT ;LEAVE DATA BLOCK ALONE IF ERROR READING
HRRZ T1,DEVMBF##(F) ;LOC OF MON BUF (-1)
>
SKIPN BLKSIZ##-1(T1) ;IS IT FULL?
AOJA T1,FNDFRE ;NO - GO FIND FIRST EMPTY SLOT
IFE FTDUFC,<
AOJA P2,SCNFRE ;NO, READ NEXT BLOCK
>
;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
UFDNX1: PUSHJ P,UFORSS## ;GET LOC OF UFB OR SFD AT
EXCH P2,T2 ;LOC INTO P2, T2 HAS HIGHEST DATA BLOCK
SETZ P1, ;AS SOME ONLY 1 POINTER
HRRZ T1,DEVMBF##(F) ;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
IFN FTDUFC,<
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
PUSHJ P,UFDCRD ;READ THE RIB AGAIN
JRST BADUF0 ;ERROR
>
PUSHJ P,SPTRW## ;SET AN AOBJN WORD FOR THE RIB PNTRS
SKIPE (T1) ;EMPTY POINTER SLOT?
AOBJN T1,.-1 ;NO. TRY NEXT
MOVE P1,T1 ;SAVE IN P1
SUBI T1,1 ;POINT TO LAST POINTER
HRRM T1,DEVRET##(F) ;SAVE LOC OF LAST POINTER IN DEVRET
TLO S,IOSALC ;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
IFN FTSFD,<
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
JRST UFDAL9 ;AND CONTINUE
;HERE WHEN WE HAVE TO GET A NEW POINTER FOR THE EXTRA BLOCK IN THE UFD
UFDAL2: JUMPG P1,UFDFUL ;NO POINTER SLOTS AVAILABLE IF P1 POSITIVE
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.)
IFN FTSFD,<
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
IFN FTSFD,<
TRNN P2,NMPSFU## ;IS IT A UFD
>
CAME T1,MFDPPN## ;YES, IS IT [1,1]?
JRST UFDAL9 ;NO
IFN FTSTR,< ;IF MORE THAN ONE STR
LDB T1,UFYFSN## ;YES, GET STR INDEX
MOVE T1,TABSTR##(T1) ;STR DB LOC
> ;END CONDITIONAL ON FTSTR
IFE FTSTR,< ;IF ONLY ONE STR
MOVE T1,TABSTR## ;GET ADDR OF STR DATA BLOCK
>
ANDCAM P1,STRUN1##(T1) ;INDICATE MORE THAN 1 PTR IN MFD
UFDAL9: LDB T3,UNYBPC## ;DONT COUNT BLOCKS ADDED TO UFD
IFN FTSFD,<
TRNN P2,NMPSFU##
>
ADDM T3,UFBTAL##(P2) ; AS PART OF THIS JOBS QUOTA
TLZ S,IOSALC
MOVE T1,DEVMBF##(F)
ADDM T3,RIBALC##+1(T1) ;UPDATE NO OF BLOCKS ALLOCATED
UFDNX2:
IFN FTSFD,<
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,SCNPT0## ;FIND POINTER FOR THE BLOCK
; (STORE LOC OF 2ND RIB IN DEVBLK)
STOPCD .,JOB,SPM, ;++SECOND POINTER MISSING
IFN FTSFD,<
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:IFN FTSFD,<
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,DEVMBF##(F) ;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
HRRM U,DEVUNI##(F) ;SAVE IN DDB
PUSHJ P,MONWRT## ;WRITE 2ND RIB
TLNN U,-1 ;IS THERE A DIFFERENT UNIT FOR THE DATA?
JRST UFDALC ;NO
HLRZS U ;YES, SET U TO DATA BLOCK UNIT
HRRM U,DEVUNI##(F) ;AND SAVE IN DDB
UFDALC: HRRZ T3,DEVUFB##(F) ;LOC OF UFB
IFN FTSFD,<
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,DEVMBF##(F) ;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
HRRZ P1,DEVACC##(F) ;LOC OF A.T.
HLRZ P1,ACCNMB##(P1) ;STEP TO NEXT IN NMB RING
TRZN P1,DIFNAL## ;NAME BLOCK?
JRST .-2 ;NO. TRY NEXT
MOVE T3,NMBNAM##(P1) ;YES. (NEW) NAME
MOVEM T3,UFDNAM##(T1) ;SAVE IN UFD BLOCK
EXCH P1,T1 ;SAVE T1, NMB LOC INTO T1
PUSHJ P,GTNMX ;GET EXTENSION FROM NMB
EXCH P1,T1 ;RESTORE T1
HLLM T4,UFDEXT##(T1) ;SAVE EXT IN UFD BLOCK
HRLM T1,P1 ;SAVE LOC OF UFD SLOT
PUSHJ P,SETCFP## ;GET CFP FROM P2, ACCPT1
HRRM T1,NMBCFP##(P1) ;SAVE CFP IN NMB
MOVSS P1 ;UFD SLOT LOCATION
HRRM T1,UFDCFP##(P1) ;SAVE CFP IN UFD
HLRZ T2,P1 ;NMB LOC
MOVE P2,DEVACC##(F) ;A.T. LOC
IFN FTSTR,< ;IF MORE THAN ONE STR
MOVE T1,P2
LDB T1,ACZFSN## ;GET FSN
PUSH P,T1 ;SAVE ON PD LIST
DPB T1,NMYFSN##
> ;END CONDITIONAL ON FTSTR
MOVE T2,DEVBLK##(F) ;UFD BLOCK NUMBER
MOVE T1,DEVMBF##(F) ;IOWD FOR MON BUF
MOVE P3,ACCPPB##(P2) ;LOC OF (NEW) PPB
MOVE P3,PPBNAM##(P3) ;(NEW)PROJ,R
PUSHJ P,WRTUFD ;WRITE THE NEW DIRECTORY BLOCK
HRRZ P2,DEVUFB##(F) ;SAVE LOC OF UFB
SETZ P4, ;INDICATE NO EXTRA DDB
IFN FTDRDR,<
TRNN M,CHNDIR ;CHANGING DIRECTORIES?
JRST FNDFR1 ;NO
;STILL IN FTDRDR CONDITIONAL
;HERE WHEN CHANGING DIRECTORIES - DELETE THE FILE FROM THE OLD DIR
IFN FTSFD,<
PUSHJ P,DECUSA ;DECREMENT USE-COUNT OF NEW SFD
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
IFN FTSTR,< ;IF MORE THAN ONE STR
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
PUSHJ P,GVMNB0## ;GIVE UP MONITOR BUFFER(FNDFIL NEEDS IT)
TLZ M,UUOMSK ;WIPE BITS OUT OF LH(UUO)
TLO M,UUOLUK ;MAKE BELIEVE THIS IS A LOOKUP
IFN FTSTR,< ;IF MORE THAN ONE STR
PUSHJ P,SETSRC## ;SET UP SEARCH LIST
STOPCD FNDFR1,DEBUG,SLM, ;++SEARCH LIST MISSING
MOVE T2,T1 ;SEARCH LIST INTO T2
> ;END CONDITIONAL ON FTSTR
PUSHJ P,FNDFIL## ;SET UP UFB BLOCK
JFCL ;FNDFIL GETS A RIB ERROR ON LOOKUP(WRONG RIBPPN)
SKIPN DEVMBF##(F) ;IF FNDFIL DIDN'T GET MON BUF,
PUSHJ P,GTMNBF## ;GET MON BUF AGAIN
JRST FNDFRB ;AND CONTINUE
FNDFR0:
PUSHJ P,GVCBJ##
PUSH P,T2 ;SAVE OLD UFB LOC
MOVE P4,F ;SAVE DDB LOC
PUSHJ P,FAKDDB ;GET AN EXTRA DDB
SETZ F, ;NONE AVAILABLE
EXCH F,P4 ;RESTORE F,SAVE EXTRA DDB LOC
;SAVE DEVUFB IN EXTRA DDB SO
SKIPE P4 ; TSTPPB WONT DELETE THE PPB IN CASE
MOVEM P2,DEVUFB##(P4) ; RENAMING INTO A NOT LOGGED-IN PPB
MOVE S,DEVIOS(F) ;RESTORE S (WITH IOSAV ON)
POP P,DEVUFB##(F) ;SAVE LOC OF OLD UFB IN DDB
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
> ;END CONDITIONAL ON FTDRDR
FNDFR1: PUSHJ P,DWNAU## ;NOT THERE - RELEASE AU
HRRM P2,DEVUFB##(F) ;RESTORE NEW UFB LOC
JUMPE P4,FNDFRC ;WAS THERE AN EXTRA DDB?
EXCH P4,F ;YES--RENAMING, DDB WAS INSURANCE
PUSHJ P,CLRDDB ; AGAINST TSTPPB. GIVE UP DDB
MOVE F,P4
FNDFRC:
MOVEM P3,DEVPPN(F) ;AND PRJ-PRG (NEEDED BY LOGTST
;IF RENAMING INTO NEW DIR)
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
IFN FTSTR,< ;IF MORE THAN ONE STR
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:
IFN FTSTR,< ;IF MORE THAN ONE STR
POP P,T1 ;REMOVE FSN FROM PD LIST
LDB T1,DEYFSN## ;FSN OF FILE BEING SUPERSEDED
JUMPE T1,CLRSTS ;NONE IF 0
SLCKFS (T1) ;CHECK FOR 0 FSN
;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 OF NEW FILE
CAMN T1,T3 ;IF SAME AS OLD FSN
JRST CLRSTS ; THEN SUPERSEDED 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 ALLPT5 ;GO DELETE OLD FILE
> ;END CONDITIONAL ON FTSTR
IFE FTSTR,< ;IF ONLY ONE STR
JRST CLRSTS
>
;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, ;DONT CHANGE READ-COUNT
CLRSTX:
IFN FT5UUO,<
MOVE P1,DEVJOB(F) ;JUST UPDATE RIB?
TLNN P1,DEPFFA
JRST CLRSTB ;NO, CHARGE AHEAD
JUMPL M,CLRSTB ;JUST CLOSE IF CALLED FROM IOALL
HRRZ T3,DEVACC(F) ;COPY A.T. ADDRESS
JUMPE T3,CLRSTB ;GET OUT IF NO AT (RIB ERR)
PUSHJ P,AT2DDB ; UPDATE DDB SO WE
JFCL ; DO NOT WIPE UFD
TLZ F,ICLOSB+OCLOSB ;UNDO CLOSE
TLO F,ENTRB+LOOKB ;..
SKIPE T1,DEVMBF##(F)
PUSHJ P,GVMNBF ;RETURN MON BUF
HRRZ T2,DEVACC##(F) ;GET A.T. ADDRESS
PUSHJ P,GETCB## ;INTERLOCK
LDB T1,ACYSTS## ;STATUS
CAIN T1,ACRUPD## ;ALREADY IN UPDATE MODE?
JRST CLRSTA
MOVEI T1,ACRUPD## ;NO, MAKE IT UPDATE
DPB T1,ACYSTS##
IFN FTDSIM,<
MOVEI T1,1
DPB T1,ACZWCT## ;IT HAS 1 WRITER
>
CLRSTA: PUSHJ P,GVCBJ## ;RETURN CB
MOVEI T1,ACPCNT ;IF READ COUNT NOT UP
ADD T1,P4
TLON S,IOSRDC ; LIGHT THE BIT
ADDM T1,ACCCNT##(T2) ; AND BUMP READ-COUNT
MOVEM S,DEVIOS(F)
HRR M,ACCWRT(T2) ;SIZE OF FILE
HRRI M,1(M) ;EOF
PUSHJ P,USETO0## ;UPDATE POINTERS
IFN FTDSIM,<
MOVEI T1,ACPSMU
TLNE P1,DEPSIM ;SIM UPDATE?
IORM T1,ACCSTS##(T2) ;YES - LIGHT BIT
>
JRST STOIOS ;DONE
> ;END FT5UUO
CLRSTB: CBDBUG (N,Y);
IFN FTGALAXY&FTSPL,<
SKIPGE DEVSPL(F) ;SPOOLED FILE?
PUSHJ P,QSRSPL## ;YES, TELL HIM
>
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
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
SKIPN T1 ;IS THE A.T. THERE ?
SETZM DEVUNI##(F) ;NO, ZERO DEVUNI
JUMPE T1,CLRST1 ; AND LEAVE
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 COULD READ NEW PNTRS
IFN FTSFD,<
PUSHJ P,GETNMB ;GET THE NMB
EXCH T1,T2 ;T1=LOC OF AT, T2=NMB
LDB J,PJOBN## ;JOB NUMBER
HRRZ T3,JBTSFD##(J) ;DEFAULT DIRECTORY
TRZ T3,CORXTR##
CAMN T2,T3 ;IS THIS FILE FOR THE DEFAULT?
PUSHJ P,INCONE ;YES, INCREMENT THE USE-COUNT
; (SO USE CNT WILL STAY UP AFTER DECUSA)
PUSHJ P,DECUSA ;DECREMENT USE-COUNTS FOR SFD
>
HRRZ T1,DEVACC##(F) ;RESET T1 TO LOC OF A.T.
PUSHJ P,GETCB##
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
IFE FTDSIM,<
MOVEI T2,ACPCRE+ACPREN+ACPSUP+ACPUPD+ACPPAL##
>
IFN FTDSIM,<
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 COUNT IF FROM CLSDL2
ANDCAB T2,ACCSTS##(T1) ;%CLEAR THE STATE CODE
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
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 CLRST5,DEBUG,FAD, ;%++FILE ALREADY DORMANT
PUSHJ P,ATSDRA## ;%NO. MAKE IT DORMANT NOW
CLRST1: PUSHJ P,GVMNB0## ;GIVE UP MONITOR BUFFER
PJRST TSTPPB ;TEST IF PPB LOGGED IN, EXIT
;HERE ON A WIERD TIMING PROBLEM
CLRST3: HRRM T1,DEVACC##(F) ;BECAUSE CLOSR2 CALLS GETNMB
PUSHJ P,GVCBJ##
HRRM U,DEVUNI##(F)
HRLM U,DEVUNI##(F) ;SAVE U IN DDB
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,GVMNB0## ;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
PJRST GVMNB0## ;GIVE UP MON-BUF AND RETURN
;HERE FAD STOPCD
CLRST5: PUSHJ P,GVCBJ## ;%RETURN CB
PJRST GVMNB0 ;GIVE UP MON BUFFER AND RETURN
;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
LOGTST: MOVE T1,DEVACC##(F) ;LOC OF A.T.
MOVE T1,ACCPPB##(T1) ;LOC OF PPB
MOVE T1,PPBNLG##(T1) ;LOGGED-IN WORD
TLNE S,IOSWLK ;DON'T WRITE IF STR IS WRITE-LOCKED
POPJ P, ;YES. RETURN
TRNN T1,PPPNLG## ;IS USER LOGGED IN ?
JRST LOGTS1 ;NO, WRITE RIB
LDB J,PJOBN## ;YES, GET JOB NUMBER
PUSHJ P,SLPTR## ;AND FIND JOB'S SEARCH LIST
JRST LOGTS1 ;NO SEARCH LIST; WRIT RIB
MOVE T1,DEVACC##(F) ;GET LOC OF A.T.
LDB T1,COZFSN## ;GET F.S. NUMBER
PUSHJ P,SLFND## ;IS IT IN S.L. ?
CAIA ;NO, WRITE RIB
POPJ P, ;YES, RETURN
LOGTS1: PUSHJ P,UPAU## ;NO. GET AU RESOURCE
LOGTS2: PUSHJ P,SAVE1##
MOVE P1,DEVUFB##(F) ;LOC OF UFB
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,RIBQTF##+1(T1) ;LOGGED-IN QUOTA
SUB T3,UFBTAL##(P1) ;- AMOUNT LEFT IN QUOTA
MOVEM T3,RIBUSD##+1(T1) ;=AMOUNT USED
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(DEVMBF), U=UNIT
;LIGHTS RIGHT BIT IN LH(RIBUNI) FOR THIS UNIT
;EXIT T1=C(DEVMBF)
ORINUN: MOVSI T2,1 ;BIT FOR DRIVE 0
LDB T3,UNYPUN## ;DRIVE NUMBER
LSH T2,(T3) ;POSITION BIT
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
IFE FTSFD,<
MOVE T2,NMBEXT##(T4) ;NEW EXTENSION
>
IFN FTSFD,<
MOVE T2,NMBSFD##(T4)
TRNN T2,NMPSFD## ;IS FILE AN SFD?
SKIPA T2,NMBEXT##(T4) ;NO, GET REAL EXTENSION
MOVSI T2,(SIXBIT .SFD.) ;YES, EXT = 'SFD'
>
HLLM 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
IFN FTDUFC,< ;IF KEEPING FILES IN ORDER
;SUBROUTINE TO COMPRESS THE UFD INTO AS FEW BLOCKS AS POSSIBLE
;*****NOTE THAT THIS ROUTINE REQUIRES 2 MONITOR BUFFERS
;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,DEVMBF##(F) ;LOC OF MON-BUF
MOVE T2,RIBSTS##+1(T1) ;GET RIB STATUS BITS
TROE T2,RIPCMP## ;LIGHT UFD-BEING-COMPRESS 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)
UFDCM1: MOVE P1,DEVMBF##(F) ;SAVE BUF LOC IN P1
MOVEM P1,DEVMBF##(P3) ;AND IN EXTRA DDB (IN CASE NO HOLES)
SKIPGE MQREQ## ;SECOND MON BUF AVAILABLE?
JRST UFDCM2 ;YES
TLNE S,IOSAU ;NO. JOB HAVE AU RESOURCE?
PUSHJ P,DWNAU## ;YES. GIVE IT UP (ELSE CAN GET INTO SCHEDULING BIND-
;ANOTHER JOB COULD HAVE MQ, BE WAITING FOR AU)
AOSG MQ2WAT## ;ANOTHER JOB WAITING FOR 2 MON BUFS?
JRST UFDCM2 ;NO
PUSHJ P,GVMNB0## ;YES - GIVE UP MON BUF (HE HAS 1, WONT RELEASE IT)
PUSHJ P,GTMNBF## ;WAIT FOR MON BUF TO BECOME AVAILABLE AGAIN
JRST UFDCM1 ;GO TRY FOR 2ND MON BUF AGAIN
UFDCM2: PUSHJ P,GTMNB0## ;GET SECOND MON-BUF
SETOM MQ2WAT## ;INDICATE NO JOB WAITING FOR 2 MON BUFS
TLNN S,IOSAU ;DID WE GIVE UP AU RESOURCE?
PUSHJ P,UPAU## ;YES, GET IT AGAIN
MOVE P2,DEVMBF##(F) ;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 UFDCMB ;NO HOLES IN UFD AT ALL
TRNE S,IOIMPM!IODERR!IODTER!IOBKTL ;ANY READ ERRORS?
JRST UFDCMC ;YES, DON'T COMPRESS
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,DEVMBF##(F) ;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
IFN FTDRDR,<
PUSH P,DEVPPN(F) ;IF DIRED HAS TO READ 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,DEVMBF##(F) ;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
;HERE WITH P2-BUFFER FULL, WRITE IT
UFDCM8: PUSHJ P,DIRWRT ;WRITE THE UFD BLOCK
MOVE P4,DEVMBF##(P3) ;POINTER TO THE BUFFER
AOJA P4,UFDCM7 ;GO FILL IT AGAIN
;STILL IN FTDUFC CONDITIONAL
;HERE WHEN THE UFD HAS BEEN COMPLETELY READ
UFDCM9:
IFN FTDRDR,<
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)
PUSHJ P,DIRWRT ;WRITE THE LAST UFD DATA BLOCK
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.)
IFN FTSFD,<
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## ;CLEAR RIPCBS AND SKIP IF IT WAS ON
TRZ T3,RIPCMP## ;DON'T CLEAR RIPCMP IF IT WAS ON ON ENTRY
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)
PUSHJ P,GVMNB0## ;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
HRRM U,DEVUNI##(F) ;SAVE UNIT TO WRITE THE BLOCK
POPJ P, ;AND TAKE NON-SKIP RETURN
;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
> ;END CONDITIONAL ON FTDUFC
;RELEASE UUO
DSKREL:
IFN FTNUL,<
PUSHJ P,NULTST
POPJ P,
>
PUSHJ P,WAIT1## ;WAIT FOR I/O TO STOP
MOVE J,JOB## ;SET J FOR RETRES
IFN FTDSEK,<
MOVEI T1,2
LDB T2,DEYCOD## ;IF DDB IS SEEKING
PUSH P,F
CAIE T2,SCOD## ; WAIT1 WANT NOTICE IT,
CAIN T2,SWCOD##
PUSHJ P,SLEEP## ;SO WAIT FOR A WHILE
POP P,F
>
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,CLOSIN ;CLOSE INPUT (IF NOT ALREADY DONE)
PUSHJ P,CLOSOU ;CLOSE OUTPUT (DITTO)
IFN FTDBBK,<
IFN FTDSUP,< ;SUPER USETI/USETO
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
HRRZ U,DEVUNI##(F) ;YES, WRITE BAT BLOCK SINCE CLOSE DID NOT
JUMPE U,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
PUSHJ P,GTMNBF## ;GET THE MON BUF
PUSHJ P,TSTBAD ;FIND EXTENT OF BAD REGION
MOVE T1,DEVMBF(F) ;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
PUSHJ P,GVMNB0## ;GIVE UP MONITOR BUFFER
>
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
IFN FTSFD,<
SETZM DEVSFD##(F) ;ZERO DEVSFD SO NO SFD TO START
>
IFN FTDBBK,<
SETZM DEVELB##(F) ;ZERO DEVELB SO NEXT ERROR WILL GET IN BAT BLOCK
>
TLZ S,IOSWLK!IOSUPR!IOSRST ;ZERO SOME BITS
IFN FTLIB,<
PUSHJ P,CLRLIB ;CLEAR DEPLIB
>
MOVEI T1,DEPPAL## ;CLEAR PRE-ALLOCATING FILE
ANDCAM T1,DEVPAL##(F)
PJRST STOIOS## ;SAVE IN DDB AND RETURN
;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
;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
HLRZ T3,NMBEXT##(T2) ;%EXTENSION
CAIN T3,(SIXBIT .UFD.) ;%IS IT "UFD"?
JRST UFDAC2 ;%YES. OK
HLRZ T2,NMBPPB##(T2) ;%NO. IGNORE THE ENTRY
IFN FTSFD,<
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.
IFN FTSTR,< ;IF MORE THAN ONE STR
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
TSTPPK:
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## ;%
TSTPP0: MOVE T1,PPBNLG##(T2) ;%LOGGED-IN WORD
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,TSTPP2 ;%NONE IF 0
HRRZ T1,DEVACC##(F)
TLNE S,IOSRDC ;IF FILE STILL OPEN (RENAME)
JUMPN T1,TSTPP3 ; DONT DELETE THE UFB
TSTPP1: HLL T4,CORLNK##(T4) ;%SAVE LINK TO NEXT UFB
PUSHJ P,UFDLK ;%IS UFD CURRENTLY IN USE?
JRST TSTPP3 ;%YES
PUSHJ P,RET4WD ;%NO, DELETE THIS UFB
JRST TSTPP4 ;%AND CONTINUE
TSTPP3: HRRO T3,T4 ;%THIS UFB =NEW PREDECESSOR
TSTPP4: HLRZS T4 ;%NEXT UFB INTO T4
JUMPN T4,TSTPP1 ;%TEST IT IF IT EXISTS
TSTPP2: POP P,T1 ;%LOC OF PPB
TLNE T3,-1 ;%ANY UFB BEING USED NOW?
PJRST GVCBJ## ;%YES. GIVE UP CB AND RETURN
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
MOVEI P2,ACMUCT## ;SET FOR READ-COUNT TEST
SKIPA P1,T2 ;%P1=LOC OF 1ST NMB
TSTPP5: HLRZS P1 ;%NEXT NMB
IFN FTSFD,<
TRZE P1,NMPUPT## ;IS IT A PNTR TO A FATHER SFD?
JRST TSTP6A ;YES, GO CHECK FATHER
TSTP5A:>
JUMPE P1,TSTPP8 ;%NO NMB IN USE - DELETE PPB
HLRZ T1,NMBACC##(P1) ;%LOC OF 1ST A.T. IN NMB RING
TSTP5B: TRNE T1,DIFNAL## ;%NMB?
JRST TSTPP6 ;%YES - THIS NMB NOT IN USE
TDNE P2,ACCUSE##(T1) ;%IS THE USE-COUNT 0?
JRST TSTPP9 ;%NO, LEAVE DATA BASE ALONE
LDB T2,ACZFSN## ;%FSN = 'INCOMPLETE' MARKER?
SLCKMK (T2)
CAIN T2,FSNINC##
JRST TSTPP9 ;%YES
HLRZ T1,ACCNMB##(T1) ;%REAL A.T. - STEP TO NEXT IN RING
JRST TSTP5B ;%TEST IT
;HERE IF NO A.T. IN NMB RING IS A DUMMY A.T.
TSTPP6:
IFN FTSFD,<
MOVE T3,NMBSFD##(P1) ;%IS IT AN SFD?
TRNN T3,NMPSFD##
JRST TSTP6A ;%NO, CONTINUE
HLRZ P1,NMBNMB##(P1) ;% DOES THIS NMB POINT TO ANOTHER NAME LIST?
TRZN P1,NMPUPT## ;%
JRST TSTP5A ;%YES, TURN DOWN THAT CHAIN
>
;HERE WHEN THE NMB IS REMOVABLE
TSTP6A: HLRZ T1,NMBACC##(P1) ;%LOC OF 1ST A.T. ON NMB RING
TRNE T1,DIFNAL## ;%1-ITEM RING?
JRST TSTPP7 ;%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,TSTP6A ;%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 TSTP6A ;%AND GO TEST NEXT AT IN THE RING
TSTPP7:
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
IFN FTCBDB,<
MOVE T1,P1
TLZ T1,NMPUPT##
MOVE T4,(P) ;FAKE OUT DATA-BASE CHECKER
HLLM T1,PPBNMB##(T4) ; BY SETTING PPBNMB TO 1ST REMAINING NMB
HLLZS NMBSFD##(T1)
>
JRST TSTPP5 ;%AND GO DELET NEXT NMB RING
;HERE IF NO DUMMY A.T.'S WERE FOUND - DELETE THE PPB
TSTPP8: POP P,T4 ;%LOC OF PPB
SKIPE PPBLOK##(T4) ;%ANY INTERLOCKS SET?
PJRST TSTP8A ;%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
TSTP8A: SETZM PPBNMB##(T4) ;%DON'T LEAVE FUNNY LINKS
SETZM PPBUFB##(T4) ;% HANGING AROUND IN DATABASE
PJRST GVCBJ##
;HERE IF A DUMMY A.T. WAS ENCOUNTERED IN AN NMB RING - THERE IS A JOB IN FNDFIL
; WHICH IS REALLY USING THIS PPB, BUT HAS NOT YET SET UP DEVUFB
;NOTHING CAN BE DONE ABOUT THE UFB'S WE DELETED, BUT WE CANT DELETE THE PPB
TSTPP9: POP P,T1 ;%LOC OF PPB
MOVE T2,ALLYES## ;%SINCE WE KNOW NOTHING ABOUT WHAT STATE THE
ANDCAM T2,PPBYES##(T1) ; OTHER JOB IS IN, PRETEND NOTHING IS KNOWN
ANDCAM T2,PPBKNO##(T1) ; ABOUT WHAT UFD'S EXIST FOR PPN
IFN FTSFD,<
MOVE T2,P1 ;%SAVE LOC OF THIS NMB
TSTP9A: HLRZ T2,NMBPPB##(T2) ;%SCAN NMB LIST FOR A POINTER
JUMPE T2,TSTP9B ;% TO AN UPWARD (FATHER) SFD NMB
TRZN T2,NMPUPT## ;%IF FOUND,
JRST TSTP9A ;%
HRLM P1,NMBNMB##(T2) ;%LINK THE FATHER SFD TO THE NEXT NMB
MOVE P1,T2 ;% IN THE LOWER CHAIN
JRST TSTP9A
TSTP9B:>
HRLM P1,PPBNMB##(T1) ;%THIS IS 1ST REMAINING NMB FOR PPB
TSTP9C: CBDBUG (Y,Y);
PJRST GVCBJ## ;%RETURN WITH AS LITTLE INFORMATION DELETED AS POSSIBLE
;SUBROUTINE TO TEST IF A UFB IS CURRENTLY IN USE
;RETURNS CPOPJ IF IT IS IN USE, CPOPJ1 OTHERWISE
;ENTER WITH T4=LOC OF UFB
;RESPECTS T3
UFDLK: SKIPA T2,PROTO ;%SET T2 TO LOC OF PROTOTYPE AND TEST ITS LINK
UFDLK1: CAIN T2,(F) ;%THIS DDB THE ONE WE'RE USING?
JRST UFDLK2 ;%YES, DON'T TEST FOR MATCH
HRRZ T1,DEVUFB##(T2) ;%NO, LOC OF UFB DDB IS USING
CAIN T1,(T4) ;%MATCH?
POPJ P, ;%YES. NON-SKIP RETURN
UFDLK2: HLRZ T2,DEVSER(T2) ;%NO. STEP TO NEXT DDB IN SYSTEM
MOVE T1,DEVMOD(T2) ;%DEVMOD WORD
IFN FTSPL,<
SKIPL DEVSPL(T2) ;SPOOLED DDB AS A DSK
>
TLNE T1,DVDSK ;%DEVICE A DISK?
JUMPN T2,UFDLK1 ;%YES. TEST ITS UFB
JRST CPOPJ1## ;%NO MATCH - SKIP REYRN
;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
PROTO: POPJ P,DSKDDB## ;%AND RETURN
SUBTTL LOOKUP
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
EXTUUO==1000 ;BIT ON IN LH(UUO) IF EXTENDED UUO
;LOOKUP
ULOOK:
IFN FTNUL,<
PUSHJ P,NULTST ;ON DEVICE NUL,
PJRST CPOPJ1## ; LOOKUP WINS
>
IFN FTSPL,<
SKIPGE DEVSPL(F) ;SPOOL-MODE?
PJRST CPOPJ1## ;YES, OK RETURN
>
TLNE F,ENTRB ;ENTER IN FORCE?
JRST LUKER1 ;YES. ERROR RETURN
TLZ F,INPB ;MIGHT BE ON FROM SUPER I/O
PUSHJ P,SETLER ;NO, SET UP UUO FOR LOOKUP
JRST ILNMER ;ILLEGAL NAME - ERROR RETURN
IFN FTLIB,<
MOVSI T2,DEPLIB## ;MAKE SURE DEPLIB IS OFF
ANDCAM T2,DEVLIB##(F) ; SO UPDATE WILL WIN
>
PUSH P,[-1,,0] ;INITIALIZE ERROR - SAVE
ULOOK1:
IFN FTSTR,< ;IF MORE THAN ONE STR
PUSHJ P,SETSRC## ;SET UP SEARCH LIST IN T1
JRST ULOOK8 ;SEARCH LIST NULL - ERROR
> ;END CONDITIONAL ON FTSTR
ULOOK2:
IFN FTSTR,< ;IF MORE THAN ONE STR
MOVE T2,T1 ;SEARCH LIST INTO T2
>
TLO M,UUOLUK ;INDICATE LOOKUP
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
IFN FTSPL,<
SKIPGE DEVSPL(F) ;SPOOL MODE?
POPJ P, ;YES, IMMEDIATE RETURN
>
SKIPL (P) ;ALREADY STORED FIRST ERROR?
JRST ULOO2A ;YES
TLNE F,SYSDEV ;NO, DON'T STORE IF FILE NOT FOUND NO SYS:
SKIPE T1 ; (MIGHT BE NEW:, BETTER ERROR MSG FROM STD:)
MOVEM T1,(P) ;NO, SAVE ERROR ON LIST
ULOO2A: CAILE T1,IPPERR ;ERROR OTHER THAN NOT FOUND OR PPN?
JRST ULOOK8 ;YES, GIVE ERROR RETURN
PUSHJ P,TSTPPB ;DELETE USELESS CORE BLOCKS
IFN FTSFD,<
HRRZ T1,DEVSFD##(F) ;SCAN - GET LOC OF SFD
JUMPE T1,ULOOK4 ;DONE IF 0 (JUST SEARCHED UFD)
LDB T2,DEYSCN## ;SCANNING SWITCH
JUMPE T2,ULOOK4 ;DON'T SCAN IF 0
PUSHJ P,DECALL ;DECR. USE-COUNTS OF THIS SFD
ULOOK3: HLRZ T1,NMBPPB##(T1) ;SCAN FOR POINTER TO FATHER SFD
TRZN T1,NMPUPT##
JUMPN T1,ULOOK3
HRRM T1,DEVSFD##(F) ;FOUND - SAVE AS CURRENT SFD
SKIPE T1 ;UFD ITSELF?
PUSHJ P,INCALL ;NO, INCR. USE-COUNTS OF A.T.'S
JRST ULOOK1 ;AND RETRY THE LOOKUP IN THIS DIRECTORY
ULOOK4:
IFN FTLIB,<
JUMPE T1,ULOO4A ; AND SCAN IS OFF
PUSHJ P,DECALL ;DECREMENT SFD USE COUNTS
ULOO4A: SETZM DEVSFD##(F) ;SO LIB WILL BE SEARCHED
MOVE T1,DEVPP0##(F) ;WAS E+3=0 ON LOOKUP
MOVSI T2,'SYS' ;IF LOOKUP SYS:
CAMN T2,DEVNAM(F) ;TRIED NEW
JRST ULOOK7
TLNE T1,DEPPP0##
JRST ULOOK8 ;NO, DON'T SEARCH LIB, SYS
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 ULOOK7 ;YES
MOVE J,JOB## ;NO, GET USER'S JOB NUMBER
HLRZ T1,JBTSFD##(J) ;NO, GET LIB PPB
TRZ T1,CORXTR## ;MAKE SURE EXTAR BITS ARE 0
JUMPE T1,ULOOK5 ;GO IF NO LIB
MOVE T1,PPBNAM##(T1) ;GET LIB PPN
CAMN T1,DEVPPN(F) ;IS IT CURRENT PPN?
JRST ULOOK5 ;YES, TRY SYS
MOVEM T1,DEVPPN(F) ;NO, SAVE NEW PPN IN DDB
JRST ULOOK1 ;GO LOOKUP FILE IN THIS PPB
;HERE IF DSK AND LIB ARE DONE, TRY SYS:
ULOOK5: HLRZ T1,JBTSFD##(J) ;LIB, SYS BITS
TRNN T1,JBPSYS## ;USER WANT TO LOOKUP SYS:?
JRST ULOOKX ;NO, FILE NOT FOUND
MOVE T2,XSYPPN## ;YES, GET EXP-SYS PPN
TRNE T1,JBPXSY## ;WANT EXP-SYS?
CAMN T2,DEVPPN(F) ;YES, HAVE WE TRIED IT ALREADY?
MOVE T2,SYSPPN## ;YES, TRY REAL SYS
TLO F,SYSDEV ;AND SAY ITS REAL
ULOOK6: MOVEM T2,DEVPPN(F) ;SAVE SYS OR NEW PPN
MOVE T1,DEVNAM(F) ;ARGUMENT FOR ALIASD
PUSHJ P,ALIASD ;IS THIS "DSK"?
SKIPA T1,SYSSRC## ;YES, USE SYSTEM 'SL
PUSHJ P,SETSRC ;NO, GET SEARCH LIST FROM DEVICE NAME
JFCL
MOVE T2,T1 ;FNDFIL WANTS T2=SEARCH LIST
PUSHJ P,FNDFIL## ;LOOKUP THE FILE
ULOOK7: SKIPA T2,SYSPPN## ;DIDN'T FIND IT
JRST FOUND ;FOUND - FINISH UP
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
CAME T2,DEVPPN(F) ;TRIED SYS?
JRST ULOOK6 ;NO, TRY IT NOW
ULOOKX: 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
SETZ T1, ;ZERO PPN WORD ON LOOKUP FAILURE
PUSHJ P,PUTWDU##
SETZM DEVPPN(F) ;SO PATH. WILL WIN
POP P,M
> ;END CONDITIONAL ON FTLIB
> ;END CONDITIONAL ON FTSFD
ULOOK8: POP P,T1 ;RESTORE ERROR CODE
PJRST LKENER ;AND GO TELL USER
;HERE WHEN FILE NAME IS FOUND ON LOOKUP
FOUND:
IFN FTSFD,<
PUSHJ P,DECMST ;DECREMENT ALL SFD AT'S EXCEPT THE RIGHT ONE
>
HRRZ T2,DEVACC##(F) ;LOC OF A.T. ENTRY
MOVE T3,T2 ;INTO T3 ALSO
IFN FTSPL,<
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
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,-1(M)
PUSHJ P,SAVE2## ;SAVE P1, P2
PUSHJ P,GTWST2## ;NUMBER OF ARGUMENTS
MOVE P1,T1
HRRI M,UUXPPN(M) ;POINT TO PPN WORD
IFN FTLIB,<
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
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
FOUND3: TLZ S,IO ;INDICATE READING
PUSHJ P,AT2DDB## ;SET DEVREL, ETC FROM A.T. DATA
JRST LKNRI2 ;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: HRRI M,1(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,DEVMBF##(F) ;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
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: PUSHJ P,CPYFST## ;COPY POINTERS TO DDB, SET DEVBLK,ETC
JRST LKRIB ;RIB IS BADLY FOULED UP
;HERE WHEN LOOKUP ALL THROUGH
LKXIT: 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
SKIPE T1,DEVMBF##(F) ;JOB HAVE MONITOR BUFFER?
PUSHJ P,GVMNBF## ;YES. GIVE IT UP
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.
HRRI M,-3(M)
JRST FOUND3 ;GO GET A.T. STUFF
;HERE IF THE DATA IN THE RIB IS BADLY FOULED UP, BUT RIBCHK PASSED IT
LKNRIB: TDZA T1,T1 ;OFFSET +1 FOR M
LKRIB: MOVNI T1,UUXSIZ-UUXEXT+1(P1) ;OFFSET +1 FOR M
ADDI T1,-1(M) ;T1:= DESIRED ADDRESS FOR M
HRR M,T1 ;GET DESIRED ADDRESS, PRESERVE LH
LKNRI2: MOVEI T1,TRNERR ;ERROR CODE
PJRST LKENR2 ;GO GIVE AN ERROR RETURN
SUBTTL ENTER
UENTR:
IFN FTNUL,<
PUSHJ P,NULTST ;ON DEVICE NUL,
PJRST CPOPJ1## ; ENTER WINS
>
IFN FTSPL,<
SKIPL DEVSPL(F) ;SPOOLING DEVICE?
JRST UENT1 ;NO
PUSHJ P,GETWDU## ;YES, GET NAME USER IS ENTERING
HRRI M,UUXNAM(M)
TLNN T1,-1
PUSHJ P,GETWDU## ;(EXTENDED ENTER)
MOVEM T1,DEVSPN##(F) ;SAVE TEMPORARILY IN DDB
SETZM DEVPPN(F)
PJRST CPOPJ1## ;AND TAKE GOOD RETURN
UENT1:
> ;END CONDITIONAL ON FTSPL
TLNE F,LOOKB ;LOOKUP IN FORCE?
JRST UPDATE ;YES. UPDATE
UENT2:
IFN FTLIB,<
MOVE J,JOB##
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
>
PUSHJ P,SETLER ;NO. SET UUO FOR ENTER
JRST ILNMEN ;BAD NAME - ERROR
IFN FTLIB,<
POP P,JBTSFD##(J)
>
IFN FTSFD,<
LDB T1,DEYLVL## ;GET CURRENT LEVEL OF NESTING
TLNE M,UUODIR ;TRYING TO ENTER A DIRECTORY?
CAMGE T1,SFDLVL## ;YES, TOO HIGH?
JRST UENT3 ;NO, CONTINUE
HLRZ T1,DEVEXT(F) ;YES, AN SFD?
CAIN T1,'UFD'
JRST UENT3 ;NO, OK
MOVEI T1,LVLERR ;YES, SET ERROR CODE IN L/E BLOCK
JRST LKENER
UENT3:
> ;END CONDITIONAL ON FTSFD
;HERE IF NOT TRYING TO ENTER A DIRECTORY
IFN FTSTR,< ;IF MORE THAN ONE STR
PUSHJ P,SETSRC## ;SET UP SEARCH LIST
POPJ P, ;NULL LIST - SHOULD NEVER HAPPEN
MOVE T2,T1 ;SEARCH LIST INTO T2
> ;END CONDITIONAL ON FTSTR
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.
TLO M,400000 ;MATCH - MAKE M NEGATIVE
JUMPL M,LKENER ;ERROR IF M IS NEGATIVE
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
JRST [PUSHJ P,DWNDA##
JRST NTFOUN] ;NO. ERROR
PUSHJ P,SAVE3## ;SAVE P1,P2,P3
MOVE T1,ACCSTS##(T2)
TRNE T1,ACPSUP ;SUPERSEDING
TRNN T1,ACPPAL## ; A PRE-ALLOCATED FILE?
SKIPA P3,P1 ;NO, P3=USER CHAN
JRST [PUSHJ P,DWNDA## ;YES. FNDFIL KEPT DA
JRST SETENC] ;SO RETURN IT AND FINISH UP
;ON A GOOD RETURN FNDFIL HAS OBTAINED THE DA RESOURCE - GIVE IT UP IN TAKBLK
TLNE S,IOSWLK ;FILE (STR) WRITE LOCKED?
JRST ENERR2 ;YES. ERROR
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
IFN FTSTR,< ;IF MORE THAN ONE STR
LDB T4,ACYFSN## ;T4 = FSN
MOVE P1,TABSTR##(T4) ;LOC OF STR DATA BLOCK INTO P1
> ;END CONDITIONAL ON FTSTR
IFE FTSTR,< ;IF ONLY ONE STR
MOVE P1,TABSTR## ;ADDR OF STR DATA BLOCK
>
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 T1,STRUNI##(P1) ;FIRST UNIT IN STR
PUSH P,P1 ;SAVE P1
MOVSI P1,DVDSK ;BIT WHICH DEFINES A DISK DDB
UNILP1: CAML T4,UNITAL##(T1) ;IS THIS THE BEST UNIT SO FAR?
JRST UNILP5 ;NO. TRY NEXT
IFN FTDALC,< ;FANCY ALLOCATION CODE
TLNE T1,-1 ;YES. AVOIDING UNITS WITH OPEN FILES?
JRST UNILP4 ;NO, USE THIS UNIT
MOVE T2,USRHCU## ;YES. NO OF CHANS USER HAS OPEN
UNILP2: CAMN T2,P3 ;ENTER BEING DONE ON THIS CHAN?
JRST UNILP3 ;YES
SKIPE T3,USRJDA##(T2) ;NO. IS THERE A DDB ON THIS CHAN?
TDNN P1,DEVMOD(T3) ;YES. IS IT A DISK DDB?
JRST UNILP3 ;NO. LOOK AT NEXT CHAN
HLRZ T3,DEVEXT(T3) ;YES. FILE'S EXTENSION
CAIN T3,(SIXBIT /UFD/) ;IS IT A UFD?
JRST UNILP3 ;YES. PUTTING DATA FILE ON SAME UNIT IS OK
MOVE T3,USRJDA##(T2) ;NO. RESTORE LOC OF DDB
HLRZ T3,DEVUNI##(T3) ;UNIT OF THE FILE
CAIN T3,(T1) ;IS IT THIS UNIT?
JRST UNILP5 ;YES. DON'T WANT TO WRITE THE FILE ON THIS UNIT
UNILP3: SOJGE T2,UNILP2 ;TEST NEXT USER CHAN
> ;END CONDITIONAL ON FTDALC
UNILP4: MOVE T4,UNITAL##(T1) ;THIS IS THE BEST SO FAR. SAVE ITS TALLY
HRRZ U,T1 ;SAVE LOC OF UNIT DATA BLOCK
UNILP5: HLR T1,UNISTR##(T1) ;STEP TO NEXT UNIT IN STR
TRNE T1,-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
IFN FTDALC,< ;FANCY ALLOCATION CODE
TLON T1,-1 ;INDICATE ANY UNIT WILL DO
JRST UNILP0 ;GO FIND ANY UNIT WITH FREE BLOCKS
> ;END CONDITIONAL ON FTDALC
STOPCD .,JOB,SFI, ;++STR FREE-COUNT INCONSISTENT
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: MOVEM U,DEVUNI##(F) ;SAVE LOC OF UNIT DB IN DDB
MOVEI T3,DEVRB2##(F) ;SET DEVRET TO DEVRB2 (1ST REAL PNTR)
HRRM T3,DEVRET##(F)
MOVE J,UNIKON##(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,400000 ;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)
IFN FTDALC,< ;FANCY ALLOCATION CODE
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
> ;END CONDITIONAL ON FTDALC
HLRZ T2,UNIGRP##(U) ;NO ESTIMATED, USE UNIGRP
IFN FTDALC,<
CAIA
USEUN2: TLO M,UALASK ;INDICATE ASKING FOR A SPECIFIC AMOUNT
>
IFN FTDQTA,<
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)
IFN FTDALC,< ;FANCY ALLOCATION CODE
TLNE M,UALASK
TLO M,UPARAL ;YES. REMEMBER FOR PARTIAL ALLOC. ERROR
> ;END CONDITIONAL ON FTDALC
> ;END CONDITIONAL ON FTDQTA
;HERE WITH T2=SPACE WE WOULD LIKE TO GET
CREAL1: HRRI M,1(M) ;POINT TO START ADDRESS WORD
PUSH P,T2 ;SAVE T2
IFN FTDALC,< ;FANCY ALLOCATION CODE
PUSHJ P,ALSTRT ;SET T1 FOR POSSIBLE START-ADR. SPECIFICATION
JRST ENERR1 ;CANT START AT SPECIFIED BLOCK (ADR. TOO HIGH)
> ;END CONDITIONAL ON FTDALC
IFE FTDALC,< ;NO FANCY ALLOCATION CODE
SETZ T1, ;TAKE BLOCKS ANYWHERE
HRRI M,-1(M) ;POINT M TO ALLOCATION WORD AGAIN
>
;HERE WITH T1=START ADR (OR 0), T2=NUMBER OF BLOCKS REQUESTED
PUSHJ P,ENTALC ;ALLOCATE SPACE
JRST ENER1A ;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 ENER1X ;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
IFN FTSFD,<
PUSHJ P,DECMST ;DECR ALL A.T. USE COUNTS
; EXCEPT THE ONE FOR THIS STR
>
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,SETEN2 ;DEFAULT PROT=OLD FILE'S PROT IF SUPERSEDE
IFE FTSET!FTFDAE,<
TLNE M,UUODIR ;CREATE, SET UP DEFAULT PROT. DIRECTORY FILE?
SKIPA T3,UFDPRT## ;YES. USE UFD STANDARD PROTECTION
MOVE T3,STNPRT## ;NO. USE REGULAR STANDARD PROTECTION
>
IFN FTSET!FTFDAE,<
MOVE T3,UFDPRT## ;STANDARD DIRECTORY PROTECTION
TLNE M,UUODIR ;A DIRECTORY ?
JRST SETEN2 ;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 SETN1A ;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 SETEN2 ;SET PROTECTION FIELD
SETN1A:>>
IFN FT5UUO,<
TLNN F,SYSDEV ;IS DEVICE = SYS?
JRST SETN1B ;NO
HLRZ T3,DEVEXT(F) ;YES, PROT = <155>
CAIN T3,'SYS' ; EXCEPT FOR .SYS FILES
SKIPA T3,SYSPRY## ; WHICH ARE <157>
MOVE T3,SYSPRT##
IFN FTSET,<
JRST SETEN2
SETN1B:>>
IFN FTSET,<
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
>
SETEN2: 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
IFN FTSPL,<
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 AC
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,SETEN4 ;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 SETEN5 ;AND CONTINUE
;HERE TO SET UP RIB BLOCK FROM A 4-WORD ENTER
SETEN4: 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
IFN FTSPL,<
MOVE T1,DEVSPN##(F)
SKIPGE DEVSPL(F)
MOVEM T1,RIBSPL##(T2) ;SAVE (POSSIBLE) NAME ENTERED ON A SPOOL-ENTER
>
LDB T1,PJOBN## ;GET JOB NUMBER
MOVE T1,JBTADR##(T1) ;GET ADDRESS OF JOBDAT
MOVE T1,.JBVER##(T1) ;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
SETEN5: PUSHJ P,RIBAD## ;COMPUTE ADR. OF RIB
MOVE T1,DEVMBF##(F) ;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
SKIPE RIBAUT##+1(T1) ;IF NO PRJ,PRG GIVEN
JRST SETN5B
LDB T3,PJOBN## ;JOB NUMBER
MOVE T3,JBTPPN##(T3) ;AUTHORS PRJ,PRG NUMBER
MOVE T4,DEVPPN(F) ;DIRECTORY OF FILE
CAMN T3,FSFPPN## ;IF AUTHOR IS [1,2]
CAMN T4,QUEPPN## ; UNLESS WRITING IN [3,3]
JRST SETN5A
MOVE T3,T4 ;MAKE AUTHOR = DIRECTORY OWNER
SETN5A: MOVEM T3,RIBAUT##+1(T1) ;STORE USERS PRJ,PRG
SETN5B: 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)
IFN FTDALC,< ;FANCY ALLOCATION CODE
PUSHJ P,GTWDT3
CAIL P1,UUXEST ;SPECIFYING ESTIMATED LENGTH?
SKIPG T3
JRST SETENA ;NO
SUB T3,RIBALC##+1(T1) ;YES. ALREADY HAVE THAT MUCH?
JUMPLE T3,SETENA ;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
IFN FTDQTA,<
MOVE T2,T3 ;NUMBER OF BLOCKS TO GET
PUSHJ P,CHKQTA## ;CHECK QUOTA
SKIPG P2,T2 ;P2=AMOUNT WE CAN GET
JRST SETENB ;CANT GET ANY MORE - FORGET IT
> ;END CONDITIONAL ON FTDQTA
;STILL IN FTDALC CONDITIONAL
SETEN6: PUSHJ P,TAKCHK## ;GET AS LARGE A GROUP AS THERE IS
JRST SETEN8 ;ON A NEW UNIT
SETEN7: MOVEM T2,(P1) ;SAME UNIT - SAVE POINTER
SUB P2,T1 ;SUBTRACT NUMBER OF BLOCKS OBTAINED
JUMPLE P2,SETEN9 ;DONE IF NO MORE TO GET
MOVE T2,P2 ;NEW AMOUNT TO GET
AOBJN P1,SETEN6 ;GO TRY AGAIN
JRST SETEN9 ;NO MORE POINTER SLOTS IN RIB - DONE
SETEN8: JUMPE T3,SETEN9 ;STR FULL IF T3=0
MOVEM T3,(P1) ;SAVE UNIT-CHANGE IN RIB
AOBJN P1,SETEN7 ;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
SETEN9: MOVE P2,DEVACC##(F)
TRZ S,IOBKTL ;MAKE SURE IOBKTL OFF
MOVE T1,DEVMBF##(F) ;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
SETENB: HRROI P1,DEVRBN##(F) ;PREPARE TO SET DEVRET=DEVRBN
IFN FTACCT,<
HRRI M,-<UUXALC-UUXEST>(M) ;POINT BACK AT EST LENGTH
>
> ;END CONDITIONAL ON FTDALC
SETENA: 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
IFN FTACCT,<
JUMPGE T2,STRAC4 ;GO IF 0-LENGTH ACCT STRING
ADDI T2,1(T1) ;AOBJN WORD FOR ACCT-STRING IN RIB
CAIL P3,UUXACT ;IF NO STRING SPECIFIED,
PUSHJ P,PRVJB## ; OR IF NOT A PRIVZD JOB
JRST STRAC2 ;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
STRAC1: HRRI M,1(M) ;ADVANCE TO NEXT ARGUMENT
PUSHJ P,GTWST2 ;GET AN ARGUMENT
JUMPE T1,STRAC2 ;DONE (OR USE PDB) IF 0
MOVEM T1,(T2) ;SAVE IN RIB
AOBJP T2,STRAC3 ;DONE IF RIB FULL
SOJE P3,STRAC3 ;DONE IF NO MORE VALUES
JRST STRAC1 ;GO GET ANOTHER ARG FRO USER
STRAC2: 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 STRAC3 ;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)
STRAC3: MOVE T1,DEVMBF##(F) ;RESTORE T1
STRAC4:>
MOVE T2,RIBSLF##+1(T1) ;RESTORE RIB ADDRESS
HLRZ U,DEVUNI##(F) ;RESET U TO UNIT OF RIB
PUSHJ P,MONWRT## ;WRITE THE RIB
PUSHJ P,GVMNB0## ;GIVE UP MONITOR BUFFER
SETENC: HRRZ T3,DEVACC##(F) ;LOC OF THE A.T.
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
LDB T1,PUUOAC##
TLNE M,UPARAL ;PARTIAL ALLOCATION ONLY?
TLOA F,ENTRB ;YES. SET FOR NON-SKIP RETURN
AOSA (P) ;NO. SKIP(GOOD) RETURN
HLLM F,USRJDA##(T1) ;UUOCON DOESN'T STORE F ON AN ENTER ERROR RETURN
POPJ P, ;RETURN TO USER
;HERE WHEN THE ENTER IS AN UPDATE (LOOKUP ALREADY DONE)
UPDATE:
PUSHJ P,GETCB## ;%GET CB RESOURCE
HRRZ U,DEVUNI##(F) ;%SET UP U
TLZ M,UUOMSK ;%ZERO MEANINGFUL BITS IN UUO
TLO M,UUOUPD ;%INDICATE UPDATE
PUSHJ P,SETLE0 ;%CHECK FOR EXTENDED UUO, OK NAME
JRST UILNMR ;%ZERO NAME - ERROR
PUSHJ P,GETWDU## ;%GET NAME
CAME T1,DEVFIL(F) ;%SAME AS LOOKED-UP NAME?
JRST UILNMR ;%NO. ERROR
HRRI M,UUNEXT-UUNNAM(M) ;%YES. POINT TO EXTENSION
PUSHJ P,GETWDU## ;%SUPPLIED EXTENSION
TRZ T1,-1
HLLZ T2,DEVEXT(F) ;%LOOKED-UP EXT
HRRI M,-1(M) ;%BUMP FOR BELOW
IFN FTLIB,<
MOVE T3,DEVLIB##(F) ;%IF THE FILE WASN'T IN UFD, BUT IN LIB
TLNN T3,DEPLIB## ; MAKE UPDATE ILLEGAL
>
CAME T1,T2 ;%MATCH?
JRST UILNMR ;%NO. ERROR
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,UPDAT1 ;%NO PPN IF T1=0
IFN FTSFD,<
TLNE T1,-1 ;POINTER TO A PATH?
JRST UPDAT0 ;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,UPDAT1 ;SAME PPN IF 0
UPDAT0:>
CAMN T1,T2 ;PPN'S MATCH?
JRST UPDAT1 ;YES
MOVEI T1,ISUERR ;%NO, ISU ERROR
PUSHJ P,GVCBJ## ;%RETURN CB RESOURCE
PJRST LKENER
;HERE WHEN THE NAME, EXTENSION AND PRJ,PRG AGREE WITH THE LOOKED-UP FILE
UPDAT1: MOVEI T1,FNCAPP## ;%CHECK TO SEE IF APPEND IS LEGAL
HLRZ T3,DEVEXT(F) ;%IS EXTENSION = "UFD"
CAIE T3,(SIXBIT /UFD/)
PUSHJ P,CHKPRV## ;% OR PRIVS NOT RIGHT?
JRST UPDER2 ;%ERROR
HRRZ T1,DEVACC##(F) ;%OK, LOC OF A.T.
MOVE T2,ACCNDL##(T1) ;%IS THIS A MAGIC FILE?
TRNE T2,ACPNDL##
JRST UPDER2 ;%YES, IT CAN'T BE UPDATED
MOVE T1,ACCSTS##(T1) ;%STATUS
TRNE T1,ACPDEL## ;%MARKED FOR DELETION? (IF SO, ANOTHER JOB
JRST UPDER4 ; DID A SUPERSEDE BEFORE THIS ENTER)
PUSHJ P,TSTWRT ;%TEST IF WRITING IS ALLOWED
JRST UPDER3 ;%NO, GIVE FILE-BEING-MODIFIED ERROR
PUSHJ P,SAVE2## ;SAVE SOME ACS
MOVEI T1,FNCCAT## ;CAN USER CHANGE ATTRIBUTES?
SETZ P2,
PUSHJ P,CHKPRV##
SETO P2, ;NO
MOVEI T2,ACPUPD ;%INDICATE THIS FILE BEING UPDATED
MOVE T3,DEVACC##(F) ;%
IFN FTDSIM,<
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,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 UPDEN3 ;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
MOVE P1,T1
HRRI M,UUXALC(M) ;POINT TO ALLOCATION WORD
IFN FTDALC,< ;FANCY ALLOCATION CODE
PUSHJ P,GETWDU## ;GET IT
CAIL P1,UUXALC ;SPECIFYING ALLOCATION?
SKIPG T2,T1
> ;END CONDITIONAL ON FTDALC
JRST UPDEND ;NO. TAKE GOOD RETURN
IFN FTDALC,< ;FANCY ALLOCATION CODE
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,UPDATA ;ADD MORE BLOCKS TO FILE
JRST ENER1B ;COULDN'T START WHERE REQUESTED (E+11)
PUSHJ P,WTUSAT
SKIPE DEVMBF##(F) ;ALREADY HAVE RIB IN CORE?
JRST UPDEN2 ;YES
PUSHJ P,PTRGET## ;NO, READ RIB INTO CORE
PUSHJ P,UPDSET ;ADJUST DEYRLC FOR CURRENT POSITION
JRST UPDEN2 ;AND CONTINUE
> ;END CONDITIONAL ON FTDALC
;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
IFN FTSTR,< ;IF MORE THAN ONE STR
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
IFE FTDSIM,<
POPJ P, ;%YES, GIVE ERROR RETURN
>
IFN FTDSIM,<
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
UPDEN3: PUSHJ P,WRDCNT ;STORE WRDCNT IN E+3
IFE FTDSIM,<
PUSHJ P,PTRGET## ;READ CURRENT PNTRS
JUMPN T3,ENER1E ;IF RIB ERROR
>
IFN FTDSIM,<
PUSHJ P,SIMRIB ;GET DA, IF SIM UPDATE, THEN READ RIB
JRST ENER1E ;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,FSFPPN##
CAME T2,QUEPPN##
SKIPA T2,DEVMBF##(F)
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
;HERE WHEN ALL ALLOCATION IS DONE. SET VALUES INTO USER AREA
UPDEND:
IFE FTDSIM,<
PUSHJ P,PTRGET## ;READ THE RIB INTO CORE
JUMPL T3,UPDFN2 ;GO IF RIB ERR
>
IFN FTDSIM,<
PUSHJ P,SIMRIB ;GET DA IF SIM UPDATE, READRIB
JRST UPDFN2 ;RIB ERROR
>
UPDEN2: PUSHJ P,UPDAUT ;UPDATE RIBAUT
JFCL
SKIPGE P2 ;IF USER HASN'T GOT PRIVS TO CHANGE ATTS.
TLO M,400000 ;USET A FLAG
PUSHJ P,SETVAL ;YES, STORE USER-SUPPLIED VALUES INTO THE RIB
TLZ M,400000
;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:
IFN FTDSIM,<
TLNE S,IOSDA ;SIM UPDATE?
PUSHJ P,DWNDA## ;YES, GIVE UP DA 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)
UPDFN2: PUSHJ P,GVMNB0## ;COPY PNTRS TO DDB, RETURN THE MONITOR BUFFER
IFE FTDSIM,<
MOVEI T1,DEPWRT## ;SET A BIT IN DDB TO INDICATE
IORM T1,DEVWRT##(F) ; THAT THIS IS THE WRITER
>
PJRST ENTXIT ;AND EXIT THE UUO
IFN FTDALC,< ;FANCY ALLOCATION CODE
;HERE TO RETURN SOME BLOCKS ON AN UPDATE ENTER
DELGRP: JUMPE T2,UPDEND ;NO ALLOCATION IF T2=0 - FINISH UP
MOVE T2,ACCCNT##(T3) ;NUMBER OF READERS
TRNE T2,ACMCNM## ;IF MORE THAN 1 READER,
JRST UPDR3A ; 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
MOVE P1,T1 ;SAVE AOBJN WORD FOR THE PNTRS IN THE MON BUF
IFN FTDMRB,< ;IF MULTIPLE RIBS
PUSH P,DEVRIB##(F) ;SAVE POINTER TO CURRENT RIB
>
PUSHJ P,UPDGIV ;GIVE UP SOME BLOCKS
JRST UPDR2A ;PRIVS WONT ALLOW IT - ERROR RETURN
IFN FTDMRB,< ;IF MULTIPLE RIBS
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
> ;END CONDITIONAL ON FTDMRB
;DEALLOCATION IS COMPLETE - FINISH UP
MOVE T1,DEVMBF##(F) ;LOC OF MON BUF (-1)
PUSHJ P,WRTRIB## ;GO WRITE NEW RIB
IFN FTDMRB,< ;IF MULTIPLE RIBS
SKIPL DEVRIB##(F) ;PRIME RIB IN CORE?
JRST DELG0B ;YES, PROCEED
DELG0A: PUSHJ P,REDRIB## ;READ THE PRIME RIB INTO CORE
JRST UPDER2 ;ERROR READING RIB
>
DELG0B:
PUSHJ P,WTUSAT ;WRITE CHANGED SAT
JRST UPDEN2 ;AND FINISH UP
;HERE TO LOOK AT OTHER RIBS
DELGP1:
IFN FTDMRB,< ;IF MULTIPLE RIBS
PUSHJ P,PTRNXT## ;GET NEXT RIB, IF ANY
>
STOPCD .,JOB,NNR, ;++NO NEXT RIB
IFN FTDMRB,< ;IF MULTIPLE RIBS
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,UPDEND ;NOT REALLY TRUNCATING IF NON-POS
MOVE T2,DEVMBF##(F) ;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
> ;END CONDITIONAL ON FTDMRB
> ;END CONDITIONAL ON FTDALC
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.
;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,IOSERR## ;MAKE SURE PERMANENT ERR BITS ARE OFF
SETLE0: PUSHJ P,GETWDU## ;E=0?
JUMPE T1,CPOPJ##
SETZ T2, ;NO. 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
MOVEI T2,DEPECS ;CLEAR NO-SUPERSEDE BIT IN DDB
SKIPL DEVJOB(F)
ANDCAM T2,DEVSPL(F)
TLNN T1,-1 ;NAME?
JRST SETLEX ;NO, MUST BE EXTENDED UUO
SETLE1: TLNE M,UUOUPD ;UPDATE?
JRST CPOPJ1## ;YES. GOOD RETURN
LDB J,PJOBN##
IFN FTSFD,<
SETZM DEVPPN(F) ;START WITH DEVPPN=0
SETZM DEVSFD##(F) ;MAKE SURE START AT UFD
PUSH P,M ;SAVE M
HRRI M,UUNPPN(M) ;POINT TO PPN WORD
TLNE M,EXTUUO
HRRI M,-<3+UUXNAM-UUXPPN>(M)
PUSHJ P,GTWDT3 ;IS IT IS XWD 0,ADR?
SKIPLE T2,T3
TLNE T2,-1
JRST SETLE2 ;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,SETPTX ;FIND THE SFD HE WANTS
JRST SETLE5 ;NO SEARCH LIST OR NO SFD
SETLE2: POP P,M ;RESTORE M
PUSHJ P,GTWST2## ;RESTORE FILE NAME
>
MOVEM T1,DEVFIL(F) ;STORE NAME IN DDB
HRRI M,UUNEXT-UUNNAM(M) ;POINT TO EXT WORD
PUSHJ P,GTWST2## ;GET EXTENSION
HLRZS T1
IFE FTSFD,<
CAIN T1,(SIXBIT .SFD.) ;IS EXTENSION SFD?
POPJ P, ;YES, ILLEGAL
>
IFN FTSFD,<
CAIN T1,(SIXBIT .SFD.) ;IS THE FILE AN SFD?
TLO M,UUODIR ;YES, SET UUODIR IN M
>
HRLM T1,DEVEXT(F) ;SAVE EXT IN DDB
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
IFN FTSFD,<
SKIPE DEVPPN(F) ;PRJ,PRG ALREADY SET UP?
AOJA M,CPOPJ1## ;YES, PATH WAS SPECIFIED. RETURN
>
PUSHJ P,PPNPP0 ;GET PPN
SETLE3: 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
IFE FTSFD,<
PJRST CPOPJ1##
>
IFN FTSFD,<
SKIPN T3 ;USE DEFAULT DIR?
CAME T1,T4 ;YES, WRITING IN DEFAULT PPN?
PJRST 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,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.
SETL4A: PUSHJ P,SLITA## ;NEXT STR IN SEARCH LIST
JRST SETL4B ;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 SETL4A ;NO, TRY NEXT STR
;HERE WHEN THE SFD DOESN'T EXIST IN THE SEACRCH LIST
SETL4B: MOVE P2,P1 ;GIVE UP POSSIBLE TEMP SL.
PUSHJ P,SLGVT##
HRRI M,-<UUNPPN-UUNEXT>(M)
TLNE M,EXTUUO
HRRI M,1+UUXEXT-UUXPPN(M) ;POINT M TO EXT, ERROR CODE WORD
MOVE T1,DEVSFD##(F) ;DECR. USE-COUNTS
PUSHJ P,DECALL
TLO M,UUOREN ;FLAG TO USE ERROR IN T1
JRST SETL5A ;AND GIVE SFD-NOT-FOUND ERROR RETURN
;HERE ON ERROR RETURN FROM SETPTH
;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
SETL5B: POP P,M
TLOA M,UUOREN
SETLE5: POP P,M ;RESTORE LOC OF NAME
TLON M,UUOREN ;TURN ON UUOREN
JRST SETL5A ;IF ENTER, ONLY SET ERROR
HRRI M,1(M) ;POINT TO EXT
PUSHJ P,GETWDU##
HRRI T1,SNFERR ;SFD-NOT-FOUND
PUSHJ P,PUTWDU## ;SAVE IN LOOKUP/ENTER BLOCK
SETL5A: MOVEI T1,SNFERR ;GET SFD-NOT-FOUND
SETZM DEVSFD(F) ;MAKE SURE DEVSFD=0
POPJ P, ;AND TAKE ERROR RETURN
>
;HERE ON EXTENDED UUO
SETLEX: TLO M,EXTUUO ;INDICATE EXTENDED UUO
TRZE T1,400000 ;NO-SUPERSEDE ENTER?
IORM T2,DEVSPL(F) ;YES, LIGHT BIT IN DDB
SETZ U, ;INDICATE NON SINGLE-ACCESS
MOVE T2,T1
CAIL T1,UUXSTS ;IS THIS A DIRECTORY FILE ENTER?
PUSHJ P,PRVJB## ;YES, IS THIS A PRIVILEGED JOB?
JRST SETLX2 ;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
SETLX2:
IFN FTVM,<
HRRI M,UUXNAM(M) ;UUOCHK ADR CHECKS IF VM
>
IFE FTVM,<
ADDI M,(T2) ;POINT TO TOP OF BLOCK
PUSHJ P,GTWST2## ; ADR CHECK IT
SUBI M,-UUXNAM(T2) ;OK, POINT AT NAME
>
PUSHJ P,GTWST2##
CAIL T2,UUXEXT ;MUST HAVE AT LEAST 3 ARGUMENTS
SKIPN T1 ;GET FILE NAME
POPJ P, ;NAME 0 - ERROR
JRST SETLE1 ;NAME NOT 0- CONTINUE
;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
POP P,T3
POP P,T4
SKIPN T1,@SDVPPN##(T2) ;YES, IS THERE AN IMPLIED PPN?
JRST TPOPJ## ;NO, RETURN
ADDM T3,-1(P) ;YES, SKIP RETURN IF CALL TO CURPPN
IFN FTLIB,<
CAIN T2,LIBNDX## ;DEVICE=LIB?
PUSHJ P,LIBPP ;YES, GET RIGHT PPN
JUMPN T2,T2POPJ## ;YES, LOOKING FOR SYS?
MOVE T2,JBTSFD##(J) ;YES, WANT NEW?
TLNE T2,JBPXSY##
MOVE T1,XSYPPN## ;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
IFE FTSFD,<
JFCL
POPJ P,
>
IFN FTSFD,<
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
SUBI P4,3 ;NO. OF ARGS-3
SKIPGE P4 ;IF P4 IS NEGATIVE,
SETZ P4, ; SET IT 0
PUSHJ P,GETWDU## ;GET VALUE
IFN FTSFD,<
HLRE P2,T1 ;GET JOB NUMBER
SKIPLE P2 ;IF .LE. 0
CAILE P2,JOBMAX## ; OR TOO HIGH
MOVE P2,JOB##
TLNN T1,770000
HRRES T1 ;GET ARGUMENT## ;USE CURRENT JOB
CAMLE T1,[-2] ;DEFINING THE DEFAULT PATH?
JRST PTHUU5 ;NO
IFE FTLIB,<
CAME T1,[-2] ;IF NOT EXACTLY -2,
JRST PTHUU5 ; LOOK FOR A DEVICE BY THAT NAME
>
IFN FTLIB,<
CAMN T1,[-4] ;IF -4
JRST PTHUU4 ;READ LIB, SYS, NEW BITS
CAMN T1,[-3] ;IF -3,
SETO P4, ;INDICATE BY P1=-1
CAME T1,[-2] ;LOOK FOR A DEVICE IF NOT -2
JUMPGE P4,PTHUU5 ; OR -3
>
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,SETPTX ;SET UP THE DEFAULT PATH
PJRST PTHUU2 ;SOME SFD WASN'T THERE
IFN FTLIB,<
JUMPL P4,PTHUU3 ;SET LIB, SYS IF -3
>
;STILL IN FTSFD CONDITIONAL
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 PTHUU1 ;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
MOVE J,JOB## ;(PTHCHX ZEROED J)
CAMN T1,JBTPPN##(J) ;IS IT JOB'S PPN?
JRST PTHUU1 ;YES
PUSHJ P,SFDPPN ;NO, GET L(PPB)
HLRS T1
PTHUU0: MOVEI T2,PPPNLG## ;PRETEND NEW DEFAULT PPN IS LOGGED IN
ORM T2,PPBNLG##(T1)
PTHUU1: PUSHJ P,CLRDDB ;RETURN THE DDB
PJRST CPOPJ1## ;AND TAKE GOOD RETURN
;HERE ON ERROR RETURN FROM SETPTH
PTHUU2: 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
;STILL IN FTSFD
IFN FTLIB,<
PTHUU3: LDB T2,DEYLVL## ;GET SYS,NEW BITS
ANDI T2,CORXTR##
PUSHJ P,GTWST2##
SKIPE T1 ;SETTING NO LIB?
OR T2,DEVSFD##(F) ;NO, SAVE LIB IN JBTSFD
MOVE J,JOB##
HLRZ P2,JBTSFD##(J) ;OLD LIB
HRLM T2,JBTSFD##(J) ;SAVE NEW LIB, SYS BITS
TRZ P2,CORXTR## ;ZAP THE EXTRA BITS
HRRZ T1,DEVSFD##(F)
JUMPE P2,PTHUU0 ;GO IF NO OLD LIB
TRZ T2,CORXTR##
CAMN T2,P2 ;
JRST PTHUU0 ; 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
HRRZ T1,DEVSFD##(F) ;NEW PPB INTO T1
JRST PTHUU0 ;GO SET IT LOGGED-IN
;HERE TO READ LIB, SYS
PTHUU4: HLRZ T1,JBTSFD##(P2) ;LIB, SYS,NEW
ANDI T1,CORXTR## ;JUST SYS, NEW
PUSHJ P,PUTWD1## ;TELL USER
HLRZ T1,JBTSFD##(P2) ;LIB
TRZ T1,CORXTR## ;JUST LIB
SKIPE T1 ;0 IF NO LIB
MOVE T1,PPBNAM##(T1) ;PPN
PUSHJ P,PUTWD1## ;TELL USER
PJRST CPOPJ1## ;AND TAKE SKIP-RETURN
> ;END CONDITIONAL ON FTLIB
;STILL IN FTSFD CONDITIONAL
;HERE WHEN TRYING TO READ THE PATH
PTHUU5: SETO P3,
CAMN T1,[-1] ;READING DEFAULT PATH?
JRST PTHUU7 ;YES
>;END FTSFD
;(RIGHT HERE IF FTSFD = 0)
IFE FTSFD,<
SETO P3, ;SPECIAL-DEVICE FLAG
>
IFN FT5UUO!FTNET!FTSFD,<
PUSHJ P,DVCNSG## ;NO, GET DDB
>
IFE FTSFD!FTNET!FT5UUO,<
PUSHJ P,DEVSRG##
>
PJRST RTZER## ;NONE - RETURN 0 TO USER
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,SDVTST ;SPECIAL DEVICE?
JRST PTHU5A
SKIPLE P4 ;IF USER'S COUNT ALLOWS
MOVEI P4,1 ;STORE A TERMINATING ZERO
SKIPA P3,T2 ;SAVE INDEX
PTHU5A: MOVSI T1,'DSK'
TLO P3,(T3) ;LH (P3)=0 IF "DEV" =1 IF "DEVX"
HRRZ T2,DEVACC##(F) ;LOC OF AT
JUMPE T2,PTHUU6 ;NO OPEN FILE, NAME='DSK'
IFE FTSTR,<
SETZ T2,
>
IFN FTSTR,<
LDB T2,ACYFSN## ;AN OPEN FILE, GET STR NUMBER
>
SKIPGE P3 ;IF NOT A SPECIAL DEVICE,
MOVE T1,@TABSTR##(T2) ; TELL USER STR NAME
PTHUU6: CAMN T1,[SIXBIT/NEW/] ;REALLY NEW?
JRST PTHU6A ;YES, DON'T CHECK SYS
TLNE F,SYSDEV ;BUT IF SYS,
HRLI T1,(SIXBIT .SYS.) ;"SYS" IS THE NAME
PTHU6A: PUSHJ P,PUTWDU## ;STORE IT FOR USER
IFN FTSFD,<
LDB T3,DEYSCN## ;SCAN-SWITCH
HRRZ T2,DEVACC##(F) ;IF NO A.T.
JUMPE T2,PTHU6B ; FILE HAS BEEN CLOSED
HRRZ T2,DEVSFD##(F) ;LOC OF SFD NMB
SKIPE T4,DEVPPN(F) ;PPN SET UP?
JRST PTHUU8
PTHU6B: PUSHJ P,SFDPPN ;NO, TELL HIM DEFAULT PPN
TLNE F,SYSDEV
MOVE T4,SYSPPN##
JRST PTHUU8 ;CONTINUE
PTHUU7: MOVEI F,DSKDDB## ;FAKE UP F
MOVE J,P2 ;JOB NUMBER
PUSHJ P,SFDPPN ;GET DEFAULT
TRZ T3,JBPUFB## ;MASK OUT DEFAULT=UFB BIT
> ;END FTSFD
IFE FTSFD,<
SKIPN T4,DEVPPN(F) ;PPN SET UP?
MOVE T4,JBTPPN##(J) ;PPN
>
PTHUU8: MOVEI T1,1(T3) ;INTERNAL SCAN-SWITCH +1
IFN FTLIB,<
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,PTHU8A ;IF A SPECIAL DEVICE,
IFN FTSTR,<
HRRZ T3,SDVTBL##(P3) ; GET SEARCH-LIST TYPE
TLZN P3,-1 ;WAS IT DEVX?
IOR T1,T3 ;NO, RETURN TYPE TO USER
>
IFE FTSTR,<
HRRZS P3
>
SKIPE @SDVPPN##(P3) ;IF THERE IS AN IMPLIED PPN
TRO T1,PT.IPP## ;LIGHT A BIT
PTHU8A: PUSH P,T4 ;PROTECT T4 IN CASE OF ABSURD USAGE
PUSHJ P,PUTWD1## ;TELL THE USER
POP P,T4
IFN FTLIB,<
CAIE P3,LIBNDX## ;LIB?
JRST PTHU8B
PUSHJ P,LIBPP ;YES, GET RIGHT PPN
JUMPN T1,PTHU8E ;GO TELL USER
PTHU8B:>
JUMPL P3,PTHU8D ;IF A SPECIAL DEVICE,
IFN FTLIB,<
JUMPN P3,PTHU8C ; IF SYS
HLRZ T1,JBTSFD##(J) ; IS NEW ON FOR USER ?
TRNE T1,JBPXSY##
MOVEI P3,NEWNDX## ; YES, RETURN NEWPPN
>
PTHU8C: MOVEI T2,0 ;NO SFD'S
SKIPN DEVPPN(F) ;TELL TRUTH IF LOOKUP WAS DONE
SKIPN T1,@SDVPPN##(P3); GET IMPLIED PPN
PTHU8D: MOVE T1,T4 ;DEFAULT PPN
PTHU8E: PUSHJ P,PUTWD1## ;SAVE FOR USER
IFE FTSFD,<
PJRST CPOPJ1##
>
IFN FTSFD,<
JUMPLE P4,CPOPJ1## ;RETURN IF THAT'S ALL HE WANTS
PUSH P,[0] ;SAVE TERMINATOR
JUMPE T2,PTHUUB ;DONE IF HAVE A 0 NAME
PTHUU9: PUSH P,NMBNAM##(T2) ;GET THE NEXT NAME
PTHUUA: HLRZ T2,NMBPPB##(T2) ;SCAN FOR FATHER SFD
TRZN T2,NMPUPT##
JUMPN T2,PTHUUA
JUMPN T2,PTHUU9 ;SAVE ITS NAME AND CONTINUE
PTHUUB: POP P,T1 ;READ A NAME FROM LIST
SOSL P4
PUSHJ P,PUTWD1## ;STORE IT IN USERS AREA
JUMPN T1,PTHUUB ;GET NEXT
PJRST CPOPJ1## ;DONE - GOOD RETURN
> ;END CONDITIONAL ON FTSFD
IFN FTSFD,<
;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 SETPTX IF ANY SFD IS LEGAL
SETPTX:
SETPTH: PUSHJ P,SAVE4##
MOVE P2,T1 ;SAVE FORBIDDEN NMB LOC
HRRZ T1,M
PUSHJ P,SETPT9 ;ADDRESS CHECK ARGUMENTS (MIGHT GET EUE
ADD T1,SFDLVL## ; IF BAD ADDRESS ON A GETSEG/RUN UUO
PUSHJ P,SETPT9
PUSHJ P,GETWD1##
MOVE P1,T1 ;SCANNING SWITCH
IFN FTLIB,<
AOSN DEVNAM(F) ;DEVNAM=-1?
TROA P1,400000 ;YES, P1 WILL BE NEGATIVE
SOSA DEVNAM(F) ;NO, RESET DEVNAM
JRST SETPT2 ;WANT ALL OF WORD IF LIB
>
JUMPN P1,SETPT1 ;IF NO CHANGE,
MOVE P1,JBTSFD##(J) ;GET OLD VALUE
ANDI P1,JBPSCN##
JRST SETPT2
SETPT1: ANDI T1,3 ;MASK OFF SCAN FIELD
CAIE T1,2 ;IF HE IS SPECIFYING IT
TDZA P1,P1 ;2 MEANS NO SCAN,
MOVEI P1,JBPSCN## ;OTHERWISE SCAN
SETPT2: 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 SETPT3
PUSHJ P,PUTWRD## ;TELL USER
JRST ADRERR## ;CANT STORE IN PROTECTED JOB DATA AREA
;STILL IN FTSFD CONDITIONAL
SETPT3: 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
SETPT4: PUSHJ P,GETWD1## ;NEXT SFD NAME
SKIPE DEVFIL(F) ;IF NOT 1ST TIME,
JUMPE T1,SETPT6 ; 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
IFN FTSTR,< ;IF MORE THAN ONE STR
PUSHJ P,SETSRC## ;SET UP SEARCH LIST
JRST SETPT7 ;NONE - ERROR
MOVE T2,T1
> ;END CONDITIONAL ON FTSTR
;SO CHK PRV WONT BE CALLED
MOVE P4,S ;SAVE IOSRDC
PUSHJ P,FNDFIL## ;LOOKUP NAME.SFD
JRST SETPT7 ;NOT FOUND
TLNN P4,IOSRDC
TLZ S,IOSRDC ;IOSRDC IS FOR FILE, NOTSFD
MOVEM S,DEVIOS(F) ; SO CLEAR IT
ANDCAM P3,DEVPRV##(F)
SKIPN DEVFIL(F) ;LOOKING FOR UFD?
JRST SETPT5 ;YES
;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 SETPT8 ;YES, ERROR
HRRM T1,DEVSFD##(F) ;SAVE AS CURRENT SFD
PUSHJ P,INCSFD ;INCREMENT ITS USE-COUNTS
SKIPL DEVNAM(F) ;IF DEVNAM IS A POSITIVE NUMBER
SOSLE DEVNAM(F) ;DECR BY 1
SKIPA ;NOT NEGATIVE - CONTINUE
JRST SETPT6 ;DONE ALL HE ASKED FOR - RETURN
MOVEI T1,1(P1) ;COUNT LEVEL UP
CAIGE T1,MAXLVL## ;TOO HIGH?
AOJA P1,SETPT4 ;NO, TRY NEXT NAME IN USERS LIST
AOJA P1,SETPT6 ;YES, DONE
;STILL IN FTSFD CONDITIONAL
;HERE ON GOOD RETURN FROM FNDFIL WITH DEVFIL=0 (LOOKING FOR UFD)
SETPT5: HRRZ T1,DEVACC##(F) ;SAVE DEVACC (LOC OF UFB)
HLLZS DEVACC##(F) ;ZERO DEVACC
TRO T1,JBPUFB## ;INDICATE DEVSFD IS REALLY A UFB
IFN FTLIB,<
JUMPGE P1,SETP5A ;IF SETTING UP A LIB,
TRZ T1,JBPUFB## ; DON'T LIGHT JBPUFB
HLRZS P1 ;STORE SYS, NEW IN DEYLVL
>
SETP5A: HRRM T1,DEVSFD##(F) ;SAVE IN DDB
SETPT6: DPB P1,DEYLVL## ;SAVE LEVEL OF NESTING
HLRZS P1 ;SCAN SWITCH
DPB P1,DEYSCN## ;SAVE IN DDB
POP P,DEVUNI##(F) ;RESTORE DEVUNI
HRRZ U,DEVUNI##(F) ; AND U
SETZ T2, ;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
SETPT8: HRRZ T1,DEVACC##(F) ;DECREMENT FAILING SFD'S
PUSHJ P,DECONE ; USE COUNT
JRST .+2
SETPT7: PUSHJ P,DECSFD ;DECR USE COUNT
HLLZS DEVACC##(F) ;ZERO DEVACC
ANDCAM P3,DEVPRV##(F)
POP P,DEVUNI##(F)
POPJ P, ;AND ERROR RETURN
SETPT9: TRNE T1,-20
PUSHJ P,UADRCK##
POPJ P,
> ;END CONDITIONAL ON FTSFD
IFN FTSFD,<
;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 ;%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
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
;STILL IN FTSFD CONDITIONAL
;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,UFORSS## ;FIND SFD A.T. OR UFB
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
> ;END CONDITIONAL IN FTSFD
;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:
IFE FTSFD,<
SETZB T1,T2 ;IF NO SFD'S,
SETZM T3
MOVE T4,JBTPPN##(J) ; PPN IS THE ONLY GOOD NUMBER
POPJ P,
>
IFN FTSFD,<
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,QUEPPN## ;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
IFN FTSFD,<
IFN FTLIB,<
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
IFN FTSFD,<
;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?
POPJ P, ;YES, RETURN
PUSHJ P,GTMNBF## ;NO, GET A MON-BUF
MOVE T1,PPBNAM##(P2) ;PPN
MOVEM T1,DEVPPN(F) ;SAVE IN DDB
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
IFN FTSTR,< ;IF MORE THAN ONE STR
LDB T1,ACZFSN## ;STR NUMBER
MOVE T1,TABSTR##(T1)
>
IFE FTSTR,< ;IF ONLY ONE STR
MOVE T1,TABSTR## ;ADDR OF STR DATA BLOCK
>
HLRZ U,STRUNI##(T1) ;SET U TO 1ST UNIT IN STR
MOVEM U,DEVUNI##(F) ;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
PUSHJ P,TSTPPK ;DELETE THE 4-WORD CORE BLOCKS FOR THE PPB
LDB J,PJOBN## ;RESTORE JOB NO
PJRST GVMNB0## ;RETURN MON BUF AND EXIT
>
SUBTTL RENAME
RENAM:
IFN FTNUL,<
PUSHJ P,NULTST ;ON DEVICE NUL
PJRST CPOPJ1## ;RENAME WINS
>
IFN FTLIB,<
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 RENER0 ;NO. ERROR RETURN
TLNE S,IOSWLK ;STR WRITE LOCKED?
JRST RENER5 ;YES. ERROR RETURN
TLNE F,ENTRB ;NO, AN ENTER BEEN DONE?
TLNE F,OCLOSB ;YES, WAS A CLOSE DONE?
JRST RECLSD ;YES, NO OPEN OUTPUT FILE
;HERE ON A RENAME WITH AN OPEN OUTPUT FILE - HAVE TO CLOSE IT
;SINCE FNDFIL WILL NEED THE DDB POINTER SPACE TO READ THE UFD
PUSH P,M ;SAVE M
HRRI M,0 ;ENSURE A CLOSE REALLY HAPPENS
MOVE T1,DEVACC##(F) ;GET LOC OF PPB
HRRZ T1,ACCPPB##(T1)
MOVEI T2,PPPNLG##
TDNN T2,PPBNLG##(T1) ;REMEMBER LOC, STATE OF NLG BIT
HRLI T1,PPPNLG##
IORM T2,PPBNLG##(T1) ;SET BIT SO TSTPPB WONT MESS THINGS UP
PUSH P,T1
PUSHJ P,CLOSE1## ;ZAP
POP P,T1
HLRZ T2,T1 ;RESTORE STATE OF NLG BIT TO PPB
ANDCAM T2,PPBNLG##(T1)
POP P,M ;OK, NOW CONTINUE
RECLSD: PUSHJ P,WAIT1##
PUSHJ P,DDBZR ;OUTPUT CLOSE WANTS TO CALL DD2MN
PUSHJ P,SAVE4## ;SAVE P1-P4
TLZ M,UUOMSK ;ZERO INDICATOR BITS IN M
TLO M,UUOLUK ;INDICATE LOOKUP FOR FNDFIL
HLRZ U,DEVUNI##(F) ;SET U IN CASE DON'T GO TO FNDFIL
HRRZ P2,DEVACC##(F) ;LOC OF ACCES BLOCK
JUMPN P2,RENAM1 ;DON'T HAVE TO LOOKUP IF THERE
IFN FTSTR,<
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
IFE FTSFD,<
JRST RENERR ;ERROR - RETURN
>
IFN FTSFD<
JRST [SETZM DEVSFD(F)
JRST RENERR]
>
IFN FTSFD,<
PUSHJ P,INCUSA ;INCREMENT USE-COUNT OF FATHER SFD
>
PUSH P,DEVUFB##(F) ;SAVE DEVUFB IN CASE OF FAILURE
PUSHJ P,RENAM0 ;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: POP P,DEVUFB##(F) ;RESTORE DEVUFB
IFN FTSFD,<
HLRS DEVSFD##(F) ;RESTORE DEVSFD
>
HRRZ T1,DEVACC##(F)
JUMPE T1,CLOSIN
PUSHJ P,CLSNAM
PJRST CLOSIN ;FIX ACCESS TABLE AND EXIT
RENAM0: TLO F,LOOKB ;SET SO CLOSE INPUT WILL HAPPEN
TLZ F,OCLOSB+ICLOSB
SKIPA P2,DEVACC##(F) ;LOC OF A.T. INTO P2
RENAM1: 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
PUSHJ P,GTWST2## ;RENAMING TO 0?
JUMPE T1,RENAM2 ;YES
TLNE T1,-1 ;MAYBE. EXTENDED UUO?
JRST RENAM3 ;NO
MOVE P3,T1 ;SAVE NO OF ARGS
IFN FTVM,<
HRRI M,UUXNAM(M) ;UUOCHK ADR CHECKS IF VM
>
IFE FTVM,<
ADDI T1,(M) ;T1:= TOP OF BLOCK
HRR M,T1 ;PICK UP 18 BIT ADDR
PUSHJ P,GTWST2## ; ADR CHECK IT
SUBI M,-UUXNAM(P3) ;OK, POINT TO NAME WORD
>
TLO M,EXTUUO ;INDICATE EXTENDED UUO
PUSHJ P,GTWST2## ;RENAMING TO 0?
JUMPN T1,RENAM3 ;NO
;HERE WHEN RENAMING A FILE TO 0 (DELETING)
RENAM2: JUMPL T2,RENER1 ;NDL FILE IF T2 NEG
MOVEI T1,FNCDEL## ;CAN USER DELETE FILE?
PUSHJ P,CHKPRV##
JRST RENER1 ;NO. ERROR RETURN
IFN FTSFD,<
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
SKIPN DEVMBF##(F) ;HAVE MON BUF?
PUSHJ P,GTMNBF## ;NO, GET IT
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
PUSHJ P,GVMNB0## ;NO, RETURN MON BUF
POP P,DEVSFD##(F) ;RESTORE DEVSFD
DIRDL2: MOVEI T1,DNEERR ;DIR-NOT-EMPTY
AOJA M,LKENR2 ;RETURN THE ERROR
DIRDL3: PUSHJ P,GVMNB0## ;RETURN THE MON BUF
POP P,DEVSFD##(F) ;RESTORE DEVSFD
DIRDL4:>
PUSHJ P,GETCB##
MOVE T1,ACCSTS##(P2) ;%STATUS OF FILE
TRNE T1,ACPUPD ;%FILE BEING UPDATED BY ANOTHER JOB?
JRST RENER8 ;%YES, ERROR RETURN
TROE T1,ACPDEL##+ACPNIU ;%NO, FILE ALREADY MARKED FOR DELETION?
PJRST GVCBJ1## ;%YES, GIVE GOOD RETURN
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
IFN FTSTR,< ;IF MORE THAN ONE STR
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 RENM2A ;%NO
MOVE P3,T2 ;%YES. SAVE FSN BIT
PUSHJ P,GVCBJ## ;%GIVE UP CB RESOURCE
PUSHJ P,FNDUFB ;FIND UFB FOR THIS FILE
JRST RENM2B ;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
RENM2A:
PUSHJ P,GVCBJ## ;%GIVE UP CB
RENM2B: SKIPN DEVMBF##(F)
PUSHJ P,GTMNBF## ;GET MONITOR BUFFER
PUSHJ P,UPAU## ;GET AU RESOURCE
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
PUSHJ P,GVMNB0## ;RETURN MON BUF
POP P,DEVUNI##(F) ;RESTORE DEVUNI (FOR INPUT-CLOSE)
TLZ F,RENMB+ENTRB ;SO CLOSE INPUT WONT THINK CLOSE OUTPUT WILL HAPPEN
TLOE S,IOSRDC ;IS FILE READING?
JRST RENM2C ;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
RENM2C: PUSHJ P,CLOSRN ;GO FINISH UP FILE
TLZ F,LOOKB ;ZERO LOOKB SO A FOLLOWING ENTER WILL SUCCEED
LDB T1,PUUOAC## ;GET CHAN NUM
HLLM F,USRJDA##(T1) ;UUOCON WONT SAVE LH(F)
JRST CPOPJ1## ;AND TAKE GOOD RETURN
;HERE TO RENAME A FILE TO SOMETHING (NOT DELETE)
RENAM3: JUMPL T2,RENER1 ;NDL FILE IF T2 NEG
PUSHJ P,TSTWRT ;CAN THIS FILE BE RENAMED?
JRST RENR8A ;NO, ALREADY BEING WRITTEN - FBMERR
PUSH P,M ;SAVE LOC OF NAME
HRRI M,UUXPRV-UUXNAM(M) ;POINT TO PROT WORD
PUSHJ P,GETWDU## ;GET IT
SKIPE T1 ;TRYING TO CHANGE IT?
XOR T1,ACCPRV##(P2);MAYBE, XOR WITH ORIGINAL PROT
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
IFN FTSFD,<
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 RENM3A ;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
RENM3A: 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 RENM3B ;NO
SKIPLE @SDVPPN##(T2) ;YES, IS THERE AN IMPLIED PPN?
MOVE P4,@SDVPPN##(T2) ;YES, USET IT IN SPITE OF WHAT E+3 SAYS
RENM3B: 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##
IFE FTDRDR,<
CAME P4,DEVPPN(F) ;SKIP IF PPN MATCHES
JRST RENER1 ;NO, MAY NOT CHANGE DIR IF FTDRDR OFF
>
IFN FTDRDR,<
CAMN P4,DEVPPN(F) ;IF NOT CHANGING PPN
TLNN P1,200000 ;IF TRYING TO CHANGE PROT AND CANT
CAIA
JRST RENER1 ;LOSE WITH PROT ERR
CAMN P4,DEVPPN(F)
>
CAME T1,DEVFIL(F) ;RENAMING TO SAME NAME?
JRST RENAM4 ;NO
PUSHJ P,GETWD1## ;GET EXTENSION
TRZ T1,-1
HLLZ T2,DEVEXT(F) ;OLD EXTENSION
XOR T1,T2
IFN FTSFD,<
SKIPL (P) ;PATH SPECIFIED?
>
JUMPE T1,RENAM6 ;NO, JUMP IF EXTENSIONS MATCH
;HERE WHEN CHANGING NAME, EXTENSION, OR DIRECTORY
RENAM4: 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 RENM4C ;YES, CONTINUE
PUSHJ P,EXTCK ;NO, RENAMING TO "UFD" OR "SFD"?
JRST [TLO M,UUOREN ;ILLEGAL, LIGHT UUOREN FOR LKEWR2
HRRI M,-1(M) ;DEC M FOR ERROR-CODE STORAGE
JRST RENER1] ;AND GIVE ERROR RETURN
HLRZ T2,DEVEXT(F) ;NO, RENAMING FROM "UFD" OR "SFD"?
PUSHJ P,EXTCK
JRST [TLO M,UUOREN ;ILLEGAL, LIGHT UUOREN FOR LKEWR2
HRRI M,-1(M) ;DEC M FOR ERROR-CODE STORAGE
JRST RENER1] ;AND GIVE ERROR RETURN
RENM4C: HRRI M,-1(T4) ;POINT M TO UUXPPN
TLNN M,EXTUUO ;EXTENDED UUO?
HRRI M,1+UUNPPN-UUNNAM(M) ;NO. POINT TO PPN WORD
SKIPE T1,DEVMBF##(F) ;JOB HAVE MONITOR BUFFER?
PUSHJ P,GVMNBF## ;YES. RETURN IT (FNDFIL NEEDS MON BUF)
IFN FTDRDR,<
CAMN P4,DEVPPN(F) ;NEW PPN=OLD PPN?
JRST RENM4A ;YES
IFN FTSFD,<
PUSHJ P,GETNMB ;GET L(NMB)
MOVE T1,NMBSFD##(T1)
TRNE T1,NMPSFD## ;IS FILE AN SFD?
JRST 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)
> ;END CONDITIONAL ON FTDRDR
;HERE WHEN RENAME HAS BEEN CHECKED (IF CHANGING DIRECTORIES)
RENM4A: 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
IFN FTSFD,<
PUSH P,M ;SAVE M
HLR M,P2 ;POINT TO PPN
PUSHJ P,GTWST2## ;POINTING TO A PATH?
SKIPLE T1
TLNE T1,-1
JRST RENM4B ;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)
PUSHJ P,SETPTH ;SET UP NEW PATH
TLO P3,-1 ;ERROR
POP P,DEVUFB##(F)
HRRM P3,DEVACC##(F) ;RESTORE DEVACC
JUMPL P3,SETL5B ;GO IF AN ERROR
HRRZ T1,DEVSFD##(F) ;NEW SFD
HLRZ T2,DEVSFD##(F) ;OLD SFD
CAME T1,T2 ;NEW SFD=OLD SFD?
JRST RENM4S ;NO, THIS REALLY DOES CHANGE SOMETHING
PUSHJ P,DECSFD ;YES, SETPTH COUNTED SFD USE-COUNT UP, SO
SKIPL -1(P) ; DECREMENT IT
JRST RENAM5 ;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,CLSNAM
JRST RENM6A ;AND CONTINUE
;HERE ON A RENAME CHANGING SFD'S
RENM4S: PUSHJ P,GTUFR ;SFD EXIST ON THIS STR?
CAIA ;NO, ERROR
JRST RENAM5 ;YES, CONTINUE
POP P,M ;RESTORE M = LOC OF NAME
HRRI M,7(M) ;ERROR CODE SUBTRACTS 6
JRST RENR4C ;GIVE ERROR RETURN (SNF)
;HERE IF NO PATH IS GIVEN
RENM4B: JUMPN P4,RENAM5 ;IF CHANGING PPN'S
HLLZS DEVSFD##(F) ; RENAME INTO THE UFD
PUSHJ P,SFDPPN ; IF NOT RENAMING TO DEFAULT
CAME T4,DEVPPN(F) ;RENAMING INTO DEFAULT DIRECTORY?
JRST RENAM5 ;NO
HRRM T2,DEVSFD##(F) ;YES, SET UP SFD
SKIPE T1,T2 ;IS THERE AN SFD?
PUSHJ P,INCUSA ;YES, INCREMENT ITS COUNTS
RENAM5: 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
MOVE P3,DEVUFB##(F) ;LOC OF UFB
MOVE P4,DEVUNI##(F) ;ADDR. OF UNIT DATA BLOCK
IFN FTSTR,<
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
HRR P1,ACCPPB##(P2)
MOVEI T1,PPPNLG##
ANDCM T1,PPBNLG##(P1) ;SAVE LOGGED-IN BIT
IORM T1,PPBNLG##(P1) ;PRESERVE US FROM TSTPPB BY ANOTHER JOB
PUSH P,T1
PUSHJ P,FNDFIL## ;LOOKUP NEW NAME
TLO P3,-1 ;NEW NAME ALREADY EXISTS
POP P,T1
ANDCAM T1,PPBNLG##(P1) ;RESTORE STATE OF LOGGED-IN BIT
JUMPL P3,RENM5B ;GO IF AN ERROR
IFN FTDRDR,<
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
IFN FTDRDR,<
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,RENAM7 ;WAS QUOTA POSITIVE?
SKIPGE UFBTAL##(P3) ;YES, DID QUOTA BECOME HUGELY NEGATIVE?
HRLOS UFBTAL##(P3) ;YES (OVERFLOW). MAKE IT POSITIVE AGAIN
>
JRST RENAM7 ;AND CONTINUE
RENM5B: HRRM P3,DEVUFB##(F)
MOVE T2,DEVACC(F) ;GET THE ACCESS TABLE
MOVE T2,ACCPPB(T2) ;GET THE PPB
MOVE T2,PPBNAM(T2) ;GET THE PPN
CAME T2,DEVPPN(F) ;HAS IT CHANGED IN THE DDB?
MOVEM T2,DEVPPN(F) ;YES, RESTORE OLD ONE
PJRST LKENR2 ;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
RENAM6: HRRI M,-1(T4) ;POINT TO UUXPPN
TLNN M,EXTUUO ;EXTENDED UUO?
HRRI M,1+UUNPPN-UUNNAM(M) ;NO. POINT TO PPN WORD
RENM6A:
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 RENER3 ;%YES, ERROR
MOVEM T1,ACCSTS##(P2) ;%NO. INDICATE RENAME IN PROGRESS
PUSHJ P,GVCBJ## ;%GIVE UP CB RESOURCE
TLNE S,IOSRIB ;PRIME RIB IN CORE?
JRST RENAM8 ;YES, NO NEED TO READ IT
RENAM7: PUSHJ P,GTMNBF## ;GET A MONITOR BUFFER
HLRZ U,DEVUNI##(F) ;GET UNIT OF PRIME RIB
HRRM U,DEVUNI##(F) ;SAVE AS CURRENT UNIT
PUSHJ P,PRMRIB## ;SET UP TO READ PRIME RIB
PUSHJ P,MONRED## ;READ THE PRIME RIB
JUMPN T3,RENER6 ;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 RENER6 ;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
RENAM8: HRRZ T1,DEVMBF##(F) ;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 RENM8A ;NO. POINT TO ATT WORD
HRRI M,-<UUXPPN-1>(M) ;POINT TO E
PUSHJ P,GETWDU## ;GET NO. OF ARGS
HRR P1,T1
CAIGE T1,RIBATT## ;SPECIFYING ATTRIBUTES?
JRST [JUMPG P1,RENDEA ;OK IF CAN CHANGE ATT'S
HRRI M,4(M) ;CAN'T - ERROR
JRST RENER4]
HRRI M,UUXPRV(M) ;MAYBE. POINT TO ATT WORD
RENM8A: 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,DEVMBF##(F) ;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,DEVMBF##(F) ;LOC OF MON BUF (-1)
SKIPN P3 ;IF HI CREATION DATE = 0
JUMPE T2,RENAM9 ; RIBATT = 0 MEANS NO CHANGE
XOR T2,RIBATT##+1(T3) ;COMPARE WITH RIB ATTR. WORD
SKIPN P4 ;HI CREATION DATE THE SAME?
JUMPE T2,RENAM9 ;YES, ALL THE SAME IF T2=0
IFN FTDRDR,<
TLNN M,UUOREN ;CHANGING DIRECTORIES?
JRST RENM8D ;YES, IT'S LEGAL
>
TLNN T2,777740 ;IF PROTECTION AND MODE SAME
TDNE T1,[37,,-1] ;IF 0 LOW DATE
JRST RENM8C ;NO, A CHANGE
TLNN M,EXTUUO ; AND NOT EXTENDED
JUMPE P3,RENAM9 ; AND HI DATE 0, WIN
RENM8C: TLNE T2,777000 ;IF CHANGING PROTECTION
MOVEI T1,FNCCPR## ;REMEMBER THAT
JRST RENM8B ;WE ALREADY CHECKED FNCCAT OR FNCCPR
RENM8D: TLZ P1,-1 ;INDICATE NO PROT ERROR
RENM8B: HRRZ T2,DEVMBF##(F) ;LOC OF MON BUF
PUSH P,T1 ;GET PRIVS FROM USER
PUSHJ P,GTWST2##
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 RENAM9 ;NO
PUSHJ P,FNDUFB ;YES. FIND UFB FOR FILE
JRST RENAM9 ;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
RENAM9: TLZE P1,-1 ;PROT ERR? (CAN'T CHANGE ATT, NOT CHANGING PROT)
PJSP T1,RENER4 ;YES, LOSE
HRRI M,UUXALC-UUXPRV(M) ;POINT TO ALLOCATION WORD
IFN FTDALC,< ;FANCY ALLOCATION CODE
TLNE M,EXTUUO ;EXTENDED UUO?
CAIGE P1,UUXALC ;YES. CHANGING ALLOCATION?
JRST RENRIB ;NO
PUSHJ P,GETWDU## ;SPECIFYING ALLOCATION?
SKIPLE T2,T1
CAMN T2,ACCALC##(P2) ;YES. ALLOCATION SAME AS BEFORE?
JRST RENRIB ;YES. NOT REALLY CHANGING IT
MOVEI T1,FNCALL## ;NO. CAN HE ALLOCATE/DEALLOCATE?
CAMGE T2,ACCWRT##(P2)
MOVEI T1,FNCTRN## ;OR TRUNCATE IF THROWING AWAY DATA BLOCKS
MOVE T1,ACCDIR## ;GET DIRECTORY WORD
CAIN T1,FNCTRN## ;IF TRUNCATING A DIRECTORY FILE
TRNN T2,ACPDIR## ;THEN GIVE PROTECTION FAILURE
MOVE T3,ACCDIR##(P2) ;GET DIRECTORY WORD
MOVEI T1,FNCTRN## ;ASSUME TRUNCATING
CAML T2,ACCWRT##(P2) ;RIGHT ?
SKIPA T1,[FNCALL##] ;NO, ALLOCATE
TRNN T3,ACCDIR## ;DON'T ALLOW UFD TRUNCATION
PUSHJ P,CHKPRV## ;CHECK IT
JRST RENR4A ;CANT DO IT - ERROR
MOVE T1,ACCSTS##(P2) ;STATUS OF FILE
TRNE T1,ACMCNM ;OTHER READERS?
JRST RENR4B ;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,RENDEL ;DEALLOCATING IF NEGATIVE
PUSHJ P,UPDATA ;ALLOCATING - GET MORE
JRST ENER1B ;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 RENRIB ;AND CONTINUE
;STILL IN CONDITIONAL ON FTDALC
;HERE TO DEALLOCATE/TRUNCATE ON A RENAME
RENDEL:
PUSHJ P,GTWDT3 ;LAST BLOCK TO KEEP
MOVEI T2,0 ;SET T2=0 (1ST BLOCK IN RIB IS 0)
RENLUP: PUSHJ P,SCNPT0## ;GO FIND POINTER TO LAST BLOCK DESIRED
JRST RENDL1 ;NOT IN THIS RIB, TRY NEXT
MOVE P3,P1 ;SAVE NUMBER OF ARGS
MOVE P1,T1 ;SAVE AOBJN POINTER IN P1
IFN FTDMRB,< ;IF MULTIPLE RIBS
PUSH P,DEVRIB##(F) ;SAVE POINTER TO CURRENT RIB
>
PUSHJ P,UPDGIV ;GO DEALLOCATE SOME BLOCKS
STOPCD .+1,DEBUG,TCI, ;++TRUNCATION CHECK INCONSISTENT
IFN FTDMRB,<
POP P,T1 ;RESTORE PREVIOUS CURRENT RIB TO T1
SKIPL DEVRIB##(F) ;CURRENTLY IN PRIME RIB?
JRST RENLP1 ;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 RENER6 ;ERROR READING RIB
> ;END CONDITIONAL FTDMRB
RENLP1: MOVE P1,P3
PUSHJ P,CPYFST## ;COPY UPDATED POINTERS TO DDB
JRST RENER6 ;RIB ERROR
> ;END CONDITIONAL ON FTDALC
;HERE WHEN ALLOCATION/DEALLOCATION IS THROUGH. SET UP FOR CLOSE
RENRIB: TLO M,UUOREN
PUSHJ P,SETVAL ;STORE ARGUMENTS FROM USER IN RIB
RENDEA: MOVE T1,DEVMBF##(F) ;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
MOVSI T1,DEPRAD## ;NO LONGER RENAMING ACROSS DIR
ANDCAM T1,DEVRAD##(F)
PUSHJ P,CLOSE1## ;CALL CLOSE CODE IN UUOCON
POP P,DEVBUF(F)
LDB T1,PUUOAC## ;GET CHAN NUM
TLZ F,ICLOSB ;CLEAR INPUT CLOSED INDICATION
HLLM F,USRJDA##(T1) ;SO SUBSEQUENT CLOSE WILL WIN
TLNN M,UPARAL ;PARTIAL ALLOCATION ERROR?
AOS (P) ;NO. SET FOR SKIP-RETURN
SETZ T1,
DPB T1,DEYFNC## ;CLEAR PROT SO WILL RECOMPUTE IT
POPJ P, ;RETURN TO USER
IFN FTDALC,< ;FANCY ALLOCATION CODE
;HERE WHEN WE HAVE TO SCAN ANOTHER RIB TO FIND THE CORRECT POINTER
RENDL1:
IFN FTDMRB,< ;IF MULTIPLE RIBS
PUSHJ P,PTRNXT## ;GET THE NEXT RIB
>
STOPCD .,JOB,NRM, ;++NEXT RIB MISSING
IFN FTDMRB,< ;IF MULTIPLE RIBS
MOVE T1,DEVMBF##(F) ;IOWD FOR MONITOR BUFFER
MOVE T2,RIBFLR##+1(T1) ;GET FIRST BLOCK NUMBER IN RIB
PUSHJ P,GTWDT3 ;LAST BLOCK TO KEEP
JRST RENLUP ;SCAN THIS RIB
> ;END CONDITIONAL FTDMRB
> ;END CONDITIONAL ON FTDALC
IFN FTDALC,< ;FANCY ALLOCATION CODE
;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 CANT START WHERE REQUESTED
;EXIT CPOPJ1 IF GOT ANY BLOCKS (UPARAL MAY BE ON IN M)
UPDATA:
IFN FTDQTA,<
HRRZ T4,DEVUFB##(F) ;LOC OF UFB
CAMG T2,UFBTAL##(T4) ;DOES HE WANT MORE THAN HE CAN GET?
AOJA M,UPDAT2 ;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
IFN FTDQTA,<
TLO M,UPARAL ;INDICATE PARTIAL ALLOCATION
>
UPDAT2: 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
SKIPN T1,DEVMBF##(F) ;RIB ALREADY IN CORE?
PUSHJ P,PTRGET## ;NO, READ IT
PUSHJ P,LSTUNI ;SET U TO LAST UNIT OF FILE
PUSHJ P,ALSTRT ;SET UP T1 FOR START ADR OF BLOCKS
JRST TPOPJ## ;CANT START AT SPECIFIED LOCATION
JUMPN T1,UPDAT6 ;NO START ADR. IF 0
CAMG T2,UNITAL##(U) ;DOES THIS UNIT HAVE ENOUGH FREE SPACE?
JRST UPDAT7 ;YES. TRY TO GET IT
MOVE T3,UNISTR##(U) ;NO. POINT TO 1ST UNI IN STR
HLRZ T3,STRUNI##(T3) ;1ST UNIT
UPDAT4: CAMG T2,UNITAL##(T3) ;DOES THIS UNIT HAVE ENOUGH?
JRST UPDAT5 ;YES. USE IT
HLRZ T3,UNISTR##(T3) ;NO. STEP TO NEXT UNIT IN STR
JUMPN T3,UPDAT4 ;AND TRY IT
TLO M,UPARAL ;INDICATE REQUESTING MORE BLOCKS
JRST UPDAT7 ;NO UNIT HAS ENOUGH. USE ORIGINAL UNIT
UPDAT5: MOVE U,T3 ;SET UP NEW U
UPDAT6: HRRM U,DEVUNI##(F) ;SAVE IN DDB
LDB T3,UNYLUN## ;GET LOGICAL UNIT NUMBER
TRO T3,RIPNUB## ;INSURE NON-0
MOVEM T3,@DEVRET##(F) ;SAVE CHANGE-UNIT POINTER
AOS DEVRET##(F) ;POINT TO NEXT POINTER SLOT
;STILL IN FTDALC CONDITIONAL
UPDAT7: PUSH P,T1 ;SAVE T1
PUSHJ P,UPDSET ;UPDATE DEYRLC, DEVRSU
POP P,T1 ;RESTORE T1
MOVE T2,(P) ;AND T2
MOVSI T3,1 ;ACCOUNT FOR UNIT-CHANGE
ADDB T3,DEVRSU##(F)
JUMPGE T3,[TLO M,UPARAL ;TOO HIGH?
JRST UPDAT8] ;YES, PARTIAL ALLOC ERR
PUSHJ P,ENTALU ;NO, ALLOCATE SPACE FOR UPDATE
JRST TPOPJ## ;ERROR RETURN
UPDAT8: 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 UPDATA HAS ALLOCATED MORE SPACE
; (CANT BE DONE IN UPDATA 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
UPDSE2: 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
> ;END CONDITIONAL ON FTDALC
IFN FTDSIM,<
;SUBROUTINE TO READ RIB FOR UPDATE-ENTER
;RETURNS CPOPJ WITHOUT DA IF RIB ERROR
;RETURNS CPOPJ1 IF OK, WITH RIB IN CORE AND DA IF SIM UPDATE
SIMRIB: SKIPE DEVMBF##(F) ;IF WE HAVE THE MON BUF,
JRST CPOPJ1## ;ALL IS OK
PUSHJ P,GTMNBF## ;GET IT
MOVE T1,DEVACC##(F) ;A.T. LOC
MOVE T1,ACCSMU##(T1) ;IF A SIMULTANEOUS UPDATE FILE,
TRNE T1,ACPSMU ; GET THE DA RESOURCE BEFORE READING RIB
PUSHJ P,UPDA## ; AS PROTECTION AGAINST RACE CONDITIONS
PUSHJ P,REDRIB## ; INVOLVED IN REWRITING RIBS
JRST DOWNIF## ;ERROR READING RIB - GIVE UP
MOVEI T1,DEPWRT## ;INDICATE THIS IS A
IORM T1,DEVWRT##(F) ; WRITING DDB
JRST CPOPJ1## ;TAKE GOOD 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
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,200
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: 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,DEVMBF##(F) ;LOC OF MONITOR BUFFER
PUSH P,U ;SAVE CURRENT U
IFN FTDBBK,<
IFN FTDMRB,< ;IF MULTIPLE RIBS
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##
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
> ;END CONDITIONAL ON FTDBBK
DELRB3: HLRZ U,DEVUNI##(F) ;SET U TO 1ST UNIT
DELRB4: HRRM U,DEVUNI##(F) ;SAVE IN DDB
PUSHJ P,WTUSAT ;GO WRITE SATS FOR THIS UNIT IF NOT CURRENT UNIT
HLRZ U,UNISTR##(U) ;GET NEXT UNIT IN STRUCTURE
JUMPN U,DELRB4 ;REWRITE SAT IF IT WAS UPDATED
POP P,U ;RESTORE CURRENT U
HRRM U,DEVUNI##(F) ;RESET DDB
IFN FTDMRB,< ;IF MULTIPLE RIBS
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?
> ;END CONDITIONAL FTDMRB
PJRST CPOPJ1## ;NO, EXIT
IFN FTDMRB,< ;IF MULTIPLE RIBS
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
> ;END CONDITIONAL FTDMRB
;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
IFN FTDALC,< ;FANCY ALLOCATION CODE
ALSTRT: 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
> ;END CONDITIONAL ON FTDALC
;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
IFN FTDALC,< ;FANCY ALLOCATION CODE
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
> ;END CONDITIONAL ON FTDALC
;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
IFN FTDQTA,<
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
IFN FTDALC,<
ENTALU: PUSHJ P,TAKBLK## ;GET ANY BLOCKS (NOT STARTING AT A SUPER-CLUSTER
POPJ P, ;CANT START WHERE SPECIFIED
JRST ENTAL1 ;GOT SOME - CONTINUE
> ;END CONDITIONAL ON FTDALC
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: MOVEM T2,@DEVRET##(F) ;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:
IFE FTDALC,<
TLO M,UPARAL
>
IFN FTDALC,<
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
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
> ;END CONDITIONAL ON FTDALC
;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 CAN'T CHANGE ANY VALUES
;ENTER AT SETVAN FROM ENTER, WITH UUO=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 UUO TO PRIVS WORD
SETVAN: PUSHJ P,SAVE1##
CAILE P1,UUXENX ;YES. ALL ARGUMENTS ARE LEGAL
MOVEI P1,UUXENX
PUSHJ P,PRVJB## ;PRIVILEGED JOB?
JRST SETVA1 ;NO, NOT ALL ARGUMENTS ARE LEGAL
HLRZ T1,DEVEXT(F) ;GET EXTENSION
CAIN T1,'UFD' ;RIBUSD ONLY MEANINGFUL FOR UFD
CAIGE P1,UUXUSD ;MIGHT UUXUSD BE IN ENTER BLOCK?
JRST SETVA2 ;NO
HRRI M,UUXUSD-UUXPRV(M) ;YES. POINT TO USD ARGUMENT
PUSHJ P,GTWST2## ;JOB WANT USD COMPUTED?
JUMPGE T1,SETVA0 ;NOT IF 0
PUSHJ P,FNDUFB ;YES. FIND UFB FOR PRJ-PRG
SKIPA T3,DEVMBF##(F) ;NOT THERE - USE OLD RIBUSD
SKIPA T3,DEVMBF##(F) ;%FOUND - GET LOC OF MON BUF
SKIPA T1,RIBUSD##+1(T3) ;OLD RIBUSD
SKIPA T1,RIBQTF##+1(T3) ;%FOUND - GET OLD QTF
TDZA T3,T3 ;NOT FOUND - SET T3=0 AS A SWITCH
SUB T1,UFBTAL##(T2) ;%FOUND, OLD FCFS-CURRENT QUOTA LEFT
PUSHJ P,PUTWDU## ;%=NEW USD VALUE
SKIPE T3 ;%IF UFB WAS FOUND,
PUSHJ P,GVCBJ## ;%RETURN CB RESOURCE
SETVA0: HRRI M,-<UUXUSD-UUXPRV>(M) ;POINT UUO TO ALC WORD AGAIN
JRST SETVA2 ;AND GO STORE USER-SUPPLIED ARGS
SETVA1: SKIPA T3,[200777,,-1] ;ONLY ARGS THROUGH UUXLNA MAY BE SUPPLIED
;HERE WITH P1=NUMBER OF ARGUMENTS USER IS SUPPLYING
SETVA2: MOVE T3,[XWD 202260,24020];BITS ON FOR ARGS WHICH CANT BE SUPPLIED BY USER
TLNE M,UUOREN ;RENAME?
TLO T3,400000 ;YES, CRE-DATE, PRIVS ALREADY CORRECT IN MON-BUF
SKIPGE M ;IF USER CAN'T CHANGE VALUES
SETO T3, ; T3=-1
MOVE T2,DEVMBF##(F)
HRRZ T4,RIBFIR##+1(T2) ;NO OF VALUES IN FILE
JUMPE T4,SETV2A
CAILE P1,-1(T4) ;USER SUPPLYING MORE?
MOVEI P1,-1(T4) ;YES, DON'T LET HIM (OLD FILE)
SETV2A: MOVNI T1,-UUXPRV+1(P1) ;T1=-NUMBER AF ARGS TO STORE
HRRZ T2,DEVMBF##(F) ;LOC OF MON BUF
ADDI T2,RIBPRV##+1 ;POINT TO PRIVS WORD
HRLM T1,T2 ;SAVE NUMBER IN LH(T2)
SETVA3: JUMPG T3,SETVA4 ;PROTECTED ARGUMENT?
MOVE T1,(T2) ;YES, GET VALUE FROM RIB
PUSHJ P,PUTWDU## ;STORE IN USERS AREA
JRST SETVA5 ;CONTINUE
SETVA4: PUSHJ P,GTWST2## ;GET AN ARG FROM USER
MOVEM T1,(T2) ;SAVE IT IN RIB
SETVA5: HRRI M,1(M) ;STEP TO NEXT ARG
LSH T3,1 ;SET NEXT CANT-SUPPLY BIT IN T3
AOBJN T2,SETVA3 ;GO IF HE WANTS ANOTHER
MOVE T1,DEVMBF##(F) ;MAKE SURE NO-DELETE BIT OFF
MOVE T2,DEVACC##(F)
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
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
CAIL P1,UUXUSD ;CHANGING QUOTA ?
PUSHJ P,PRVJB ;AND ALLOWED TO ?
PJRST GVCBJ## ;NO, RETURN
MOVE T1,DEVMBF##(F) ;%FOUND IT - L(MON BUF)
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
;SUBROUTINE TO ZERO THE RETRIEVAL POINTERS IN THE DDB
;RESPECTS T1,T2,T3
DDBZR::
IFN FTDMRB,<
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)
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,DEVMBF##(F) ;LOC OF MON BUF
MOVEM T2,RIBUFD##+1(T1) ;SAVE ADR IN RIB
FBMLOC: POPJ P,FBMERR ;AND RETURN
SETUF1:
IFN FTSFD,<
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
IFN FTSTR,< ;IF MORE THAN ONE STR
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
SLCKFS (T1) ;%GOOD FSN?
>
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
;ERROR STUFF
IFN FTLIB,<
ILNMEN: MOVE J,JOB##
POP P,JBTSFD##(J)
JRST ILNMER
>
UILNMR:
PUSHJ P,GVCBJ##
TLO M,UUOREN ;TELL ILNMER NOT TO CHANGE T1
MOVEI T1,ISUERR ;UPDATE, LOOKUP NAME NOT SAME AS ENTER NAME
IFE FTLIB,<
ILNMEN:
>
ILNMER: TLZN M,UUOREN ;IS ERROR CODE ALREADY IN T1?
MOVEI T1,FNFERR
AOJA M,LKENR2
UPDER4:
PUSHJ P,GVCBJ##
MOVEI T1,FCUERR
JRST LKENER
UPDR3A: HRRI M,-10(M) ;RESET M FOR ERROR CODE DEPOSIT
RENER3:
UPDER3:
PUSHJ P,GVCBJ##
SKIPA T1,FBMLOC
NTFOUN: MOVEI T1,FNFERR
LKENER:
IFN FTSPL,<
SKIPGE DEVSPL(F) ;SPOOL-MODE?
POPJ P, ;YES, IMMEDIATE RETURN
>
HRRI M,-2(M) ;RESET M FOR ERROR CODE DEPOSIT
LKENR1: TLNE M,EXTUUO
HRRI M,4(M) ;BUMP M FOR EXTENDED FORMAT
LKENR2: MOVE T3,T1
PUSHJ P,GETWDU##
HRR T1,T3
PUSHJ P,PUTWDU##
TLNN M,UUOUPD ;IF NOT AN UPDATE (E.G. FILE NOT OPEN)
PUSHJ P,TSTPPB ;CLEAR OUT PPB IF NOT LOGGED-IN
IFN FTSFD,<
HRRZ T1,DEVSFD##(F) ;JOB HAVE AN SFD?
JUMPE T1,LKENR3
HLRZ T2,DEVSFD##(F) ;YES, 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 ;YES, DECREMENT USE-COUNTS
LKENR3: HLRZS DEVSFD##(F) ;MAKE SURE NO NEW DIRECTORY
>
SKIPE T1,DEVMBF##(F) ;JOB HAVE MONITOR BUFFER?
PJRST GVMNBF## ;YES. RETURN IT AND EXIT
AEFLOC: POPJ P,AEFERR ;NO. RETURN
ENER1X:
IFN FTSFD,<
PUSHJ P,DECMST
>
JRST ENER1C
ENERR1:
ENER1A:
IFN FTSFD,<
PUSHJ P,DECMST
>
POP P,T2
ENER1B: JUMPE T1,ENER1C
MOVEI T1,BNFERR
JRST ENER1D
ENER1E: SKIPA T1,[TRNERR]
ENER1C: MOVEI T1,NRMERR
ENER1D: HRRI M,-1(M) ;DECREMENT M FOR ERROR CODE
TLNE M,EXTUUO ;EXTENDED FORMAT?
HRRI M,-<UUXALC-UUXEXT-1>(M)
ENER1F: PUSH P,T1
TLNE S,IOSDA
PUSHJ P,DWNDA##
HRRZ T1,DEVACC##(F)
TLNN M,UUOREN ;RENAME?
JRST ENER1G
PUSHJ P,DECRDR ;YES, DECR READ COUNT
JFCL
PUSHJ P,GVCBJ## ;%
HLLZS DEVACC##(F) ;CLEAR DEVACC
TRNN T2,ACMCNT ;DONT RETURN A.T. TO FREE CORE IF OTHER READERS
ENER1G: PUSHJ P,ATRMOV##
POP P,T1
JRST LKENR2
RENER5: SKIPA T1,WLKLOC ;WRITE LOCK ERROR
RENER0: ;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
ADDI M,3
JRST LKENR2
ENERR2: TLNE S,IOSDA
PUSHJ P,DWNDA##
IFN FTSFD,<
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
RENERR: MOVEI T1,FNFERR ;FILE NOT FOUND
JRST TSTWD0 ;DETERMINE WHERE TO STORE THE ERROR
UPDR2A: HRRI M,-7(M)
UPDER2:
PUSHJ P,GVCBJ##
RENER7: MOVEI T1,PRTERR ;PRIVS WON'T ALLOW UPDATE
JRST LKENER
RENR4B: SKIPA T3,FBMLOC
RENR4C: MOVEI T3,SNFERR
SETZ T1,
RENR4A: HRRI M,-5(M)
RENER4: MOVEI T2,ACPREN
ANDCAM T2,ACCSTS##(P2)
SKIPN T1 ;NON-0 FROM CHKPRV
SKIPA T1,T3
MOVEI T1,PRTERR ;RENAME, NOT DELETE. NO PRIVS
HRRI M,-1(M)
JRST LKENR2
RENER6: MOVEI T1,ACPREN
ANDCAM T1,ACCSTS##(P2)
MOVEI T1,TRNERR
JRST LKENER
RENER8:
PUSHJ P,GVCBJ## ;%
RENR8A: SKIPA T1,FBMLOC ;ATTEMPT TO DELETE A FILE BEING UPDATED
RENER1: MOVEI T1,PRTERR
AOJA M,LKENR2
FUUEND: END