1
0
mirror of synced 2026-03-06 11:13:30 +00:00
Files
lisper.cpus-pdp8/tss8/system/fipc.pal
brad 0e9bfd9d85
2010-04-02 12:36:00 +00:00

1329 lines
30 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TAD I LOJOBP /PICK UP PROJ,PROG NUMBER
JMS I UTS01 /SEARCH UFD TABLE
JMP LGO2 /OOPS!! MIGHT AS WELL TRY TO LEAVE GRACEFULLY
ISZ I UTPRNU /REMOVE THIS JOB FROM ACCESS COUNT
JMP LGO2
CLA CMA /LAST USER ACCESSING THIS UFD
TAD UTPRNU
JMS I TF01 /FREE THE UFD TABLE ENTRY
LGO2, CLA
DCA I LOJOBP /REMOVE USER FROM JOB TABLE
TAD LGO4A /KLUDGE FIEXIT TO RETURN TO LGO4
DCA LGKLUJ
TABOUT, CLA CMA
DCA TABSTA /FORCE TABLES OUT
JMP I FIEXIT
LOJOBP, 0
LOSRRI, RTABLE
0
LGO4A, LGO4
LGO1A, LGO1
LGKLUJ, FIX500
LGRESA, LGRES0
/ROUTINE TO OPEN A UFD
/CALLING SEQUENCE:
/ TAD (PROJ,PROG NUMBER)
/ JMS UFO0
/ ERROR RETURN (AC=0 IF TABLES FULL; OTHERWISE UFD NOT FOUND)
/ NORMAL RETURN (POSITION ON TABLE IN AC)
*3200
UFO0, 0
JMS UFO6 /GO GET THE RETR. INFO FOR THIS GUY'S UFD INTO CORE
JMP I UFO0 /COULDN'T GET IT
DCA UOBUFP /POINTER TO RETRIEVAL INFORMATION
TAD UFDTBL
IAC
DCA UOUFDP /UFD TABLE POINTER
/SEARCH FOR A FREE SLOT IN UFDTBL
UFO3, TAD I UOUFDP
SNA CLA
JMP UFO2 /FOUND A FREE SLOT ON THE TABLE
TAD UOUFDP /THIS SLOT IS OCCUPIED
TAD P0004
DCA UOUFDP /NEXT POSITION (ACCES COUNT ENTRY)
TAD UFDEND /ARE WE AT THE END OF THE TABLE
CMA
TAD UOUFDP
SNA CLA /HAVE WE SEARCHED THE WHOLE TABLE?
JMP I UFO0 /NO ROOM ON TABLE
JMP UFO3 /LOOK AT NEXT SLOT
/COMES HERE WITH UOUFDP POINTING TO A FREE SLOT IN UFDTBL
UFO2, CLL STA RAL /AC=-2
TAD UOUFDP /BACK UP THE POINTER
DCA INDEX
TAD UFORET+1
JMS I UFQUOA /LOAD THE UFD TABLE
STA
TAD UFDTBL
CIA
TAD INDEX
CLL RTR
DCA UFO6 /RELATIVE POSITION ON TABLE
TAD UFO6
JMS I BLDP1 /GENERATE A PTR INTO RETTBL
DCA UFORET /RETRIEVAL POINTER
TAD C7771
DCA CFH /COUNTER FOR TRANSFER TO TABLE
/NOW MOVE RETRIEVAL INFORMATION FOR THIS GUY'S
/UFD INTO RETTBL
UFO4, ISZ UOBUFP
TAD I UOBUFP
DCA I UFORET
ISZ UFORET
ISZ CFH /ENTIRE RETRIEVAL BLOCK TRANSFERRED?
JMP UFO4 /NO, KEEP IT UP
ISZ UFO0 /YES, PREPARE FOR NORMAL RETURN
TAD UFO6 /PICK UP RELATIVE POSITION
JMP I UFO0
UFORET, 0
0
UFQUOA, UFQUOT
UOUFDP= UTPRNU
UOBUFP, 0
UFO6, 0
DCA UFORET+1 /SET UP CALLING SEQUENCE FOR MFD SEARCH
TAD RETTBL
DCA UFORET
CMA
JMS I DS01 /ONE WORD MASTER FILE DIRECTORY SEARCH FOR PROJ,PROG MATCH
UFORET
JMP I UFO6 /COULD NOT FIND UFD ENTRY
TAD P0004 /POINT AT DISK QUOTA WORD
DCA UFORET
TAD I UFORET
AND P0077 /SAVE ONLY LOGIN QUOTA
DCA SEGLIM /SAVE FOR LATER
TAD P0003
TAD UFORET
DCA UFORET /POINTER TO UFD RETRIEVAL INFORMATION
TAD I UFORET
DCA UFO1
TAD RETTBL /POINTER TO RET. INFO OF FILE BEING SEARCHED (IN THIS CASE, THE MFD)
JMS I GE01 /GET RETRIEVAL INFORMATION INTO CORE
UFO1, 0
ISZ UFO6
JMP I UFO6
/ROUTINE TO SEARCH UFD TABLE FOR PROJ,PROG NUMBER
/CALLING SEQUENCE:
/ TAD (PROJ,PROG NUMBER)
/ JMS UTS0
/ NOT FOUND RETURN
/ NORMAL RETURN (RETRIEVAL POSITION IN AC)
UTS0, 0
DCA UTPR1 /PROJ,PROG NUMBER
TAD UFDTBL /PTR TO HEAD OF UFDTBL
DCA UTUPTR
UTS1, TAD UFDEND /END OF UFD TABLE
CIA
TAD UTUPTR
SNA CLA
JMP I UTS0 /COULD NOT FIND PROJ,PROG NUMBER ON TABLE
TAD I UTUPTR
CIA
TAD UTPR1
SNA CLA
JMP UTS3 /FOUND ENTRY, GET POINTER
TAD UTUPTR /STEP UP ONE SLOT
TAD P0004
DCA UTUPTR
JMP UTS1 /LOOK IN THE NEXT ENTRY
UTS3, TAD UFDTBL
CIA
TAD UTUPTR
CLL RTR /RELATIVE POSITION ON TABLE
IAC /THE RELATIVE POSITION
ISZ UTPRNU /UTPRNU POINTS TO ACCESS COUNT OF THIS PROJ, PROG #
ISZ UTS0
JMP I UTS0
DVT1,
UTPR1, 0
UTUPTR= UTPRNU
DVT0, 0 /COMPUTE DEVICE TIME AT RELEASE
DCA DVT1 /ELAPSED DEVICE TIME
JMS I JBLD0
DCA DVT3 /PROJ,PROG NUMBER OF CURRENT USER
CLA CMA
JMS I DS01 /SEARCH MFD FOR PROJ,PROG NUMBER
DVT4
JMP I DIRBAD /***********DEBUG ONLY***********
TAD C0005
DCA CFH /POINTER TO DEVICE TIME WORD
TAD DVT1
TAD I CFH /UPDATE USER'S CUMULATIVE DEVICE TIME
DCA I CFH
DCA BUFMOD /SCHEDULE WRITE
DATFLD
JMP I DVT0
DVT4, RTABLE
DVT3, 0
/COMES HERE IF FIP WAS CALLED BY S.I.
/READ S.I. BACK IN AND RETURN TO IT
FIX30, CFLD /CHANGE TO CURRENT FIELD
TAD C0603
DCA FLPARB /SET UP READ IOT
DCA FLPARB+1 /SI IS ON TRACK 0 OF THE DISC
JMS I FIX401
JMS I FIO01 /RETURN WILL BE TO SI
SCL1, 0
JMS I RD301 /SET UP DISK PARAMETERS
STA
DCA BUFSTA /FUDGE TO APPEAR THAT READ WAS DONE
JMP I SCL1
RD301, RD30
/EXIT ROUTINE
/COMES HERE WHEN FIP HAS COMPLETED ITS TASK
/FIRST, SEE IF ANY INTERNAL FILES HAVE BEEN CHANGED
/THOSE THAT HAVE CHANGED MUST BE WRITTEN BACK OUT TO DISC
*3400
/*** ANY DATA FIELD IS OK AT THIS POINT!!
FIX0, JMS I WRT1 /MAKE SURE THE BUFFER IS EMPTY
ISZ TABSTA /CHECK TABLE STATUS
JMP FIX1 /NOTHING CHANGED IN TABLES
TAD JOBTAB /BOTTOM OF TABLE AREA
JMP FIX2 /SAVE TABLES BEFORE EXIT
FIX1, ISZ SATSTA /CHECK SAT STATUS
JMP FIX20 /NOTHING TO BE SAVED, EXIT
TAD SATBOT /BOTTOM OF SAT
FIX2, JMS I FIX401
TAD FIDEXP /GLOBAL TI "FIPDEX"
DCA FLPARB+1 /MEMORY FIELD
TAD C0605
DCA FLPARB /WRITE IOT
JMS I FIO01 /PERFORM THE WRITE
HLT /ERROR ON WRITE, FATAL
/ALL DISC TABLES ARE NOW UP TO DATE (*** ANY DATA FIELD IS OK AT THIS POINT!!)
FIX20, FGETJT
JOBSTS
DCA FIOPTR
DATFLD
TAD I FIOPTR
AND FISIOT
DCA I FIOPTR
CFLD
FGETJT /RESTORE USER AC
JOBREG+2
DCA FIOPTR /ADDRESS OF USER'S AC
TAD FIUSAC
DATFLD
DCA I FIOPTR
CDF
TAD C002 /FIP ALWAYS RUNS IN FIELD 2 SO ADD 2 TO CORTBL
TAD CORTBA /GLOBAL TO "CORTBL"
DCA FIOPTR /POINTS TO THIS FIELD'S ENTRY IN CORTBL
JMP I .+1
FIX500, FIX50
FISIOT, -JSIOT-1
/ROUTINE TO DETERMINE IF A DEVICE IS ASSIGNED TO THIS JOB
/CALLING SEQUENCE:
/ TAD (DEVICE NUMBER)
/ JMS DTE0
/ 0 (SET BY DTE0 TO POINT TO ENTRY IN DEVTBL)
/ RETURN (DEVICE NOT ASSIGNED TO THIS JOB)
/ RETURN (DEVICE ASSIGNED)
DTE0, 0
SPA
JMP DTE10 /NON-TTY DEVICE
TAD NULNM1 /CHECK FOR VALID TTY NUMBER
SMA
JMP DTE6 /INVALID TTY NUMBER
CLL RAL /TWO WORDS PER TTY
DTE4, TAD DEVEND /FIND LOCATION IN DEVTBL
DTE5, CFLD
DCA I DTE0 /RETURN ARGUMENT
TAD I DTE0
ISZ DTE0
DCA DTE2
DATFLD
TAD I DTE2 /GET POINTER TO DDB
SNA /IS THERE ONE?
JMP I DTE0 /NO, RETURN
DCA DTE2 /YES
ISZ DTE2
TAD I DTE2 /GET JOB NUMBER
CIA
TAD FIJOB /NUMBER OF CURRENT JOB
AND P0037
SNA CLA /DOES DEVICE BELONG TO THIS JOB?
ISZ DTE0 /YES
JMP I DTE0 /RETURN
DTE6, STA
TAD DEVTBA /POINT TO DUMMY DEVTBL ENTRY
JMP DTE5
DTE2, 0
NULNM1, -NULINE-1
P3777, 3777
NUDEVM, DEVTBE-JOBTBL
NUDEV, JOBTBL-DEVTBE
DTE10, AND P3777
TAD NUDEVM /CHECK DEVICE NUMBER FOR VALIDITY
SMA
JMP DTE6 /INVALID DEVICE NUMBER
TAD NUDEV /GET DEVICE NUMBER BACK
JMP DTE4 /GO FINISH UP
LNK0, 0 /GET FILE LINKAGE
TAD LNKF
DCA LNK1
FGETJT
LNK1, 0
DCA CFH
DATFLD
TAD I CFH /PTR TO FILE CONTROL BLOCK
JMP I LNK0
LNKF, JOBF0
SAV1,
FGETJ0, 0
CFLD
TAD I FGETJ0
DCA .+4
TAD JOBDAT
CIF
GETJTA
0
ISZ FGETJ0
JMP I FGETJ0
SAVCRE, 0
DCA SAV1
TAD SAV1 /FILE ADDR
TAD P0004 /PTR TO PROTECTION BITS IN FILE
DCA SAV2
TAD I SAV2 /GET THE PROTECTION BITS
AND C0020 /IS IT WRITE PROTECTED AGAINST THE OWNER?
SZA CLA
JMP I EXT10A /YES, RETURN WITH PROT. VIOLATION MESSAGE
TAD SAV1 /NO, REDUCE THE FILE TO 0 SEGS
JMS I RED11 /GO DO REDUCTION
JMP I SAVCRE /RETURN
RED11, RED1
EXT10A, EXT10
SAV2,
CRFUFD, 1
JMS I ACC01 /IS THIS ACCOUNT 1?
JMP CRFUF1 /YES
IAC
DCA I INDEX /FILE SIZE INITIALLY 1
JMP I CRFUFD /BACK FOR THE DATE
CRFUF1, DCA I INDEX /ZERO CPU TIME
JMP I .+1 /GO ZERO DEVICE TIME ALSO
CRFUFR
/CONVERT AN ABSOLUTE PTR INTO RETTBL TO A RELATIVE ENTRY NUMBER
ENS3, 0
CIA
TAD RETTBL /REL. PTR TO ADDRESS WITHIN RETTBL
CIA
AND P7770 /ANY POINTER WITHIN THE BLOCK IS OK
CLL RTR
RAR /DIVIDE BY 8
JMP I ENS3
/ROUTINE TO ASSIGN A DEVICE
*3600
ASD1, TAD FIOSTK+1
SMA /TTY?
JMP I LGI201 /DON'T LET HIM/HER ASSIGN TTY'S! RETURN WITH AC=7777
JMS I DTE01 /IS THIS DEVICE ASSIGNED TO THIS JOB?
ASD2, 0 /SET BY DTE01 TO POINT TO PROPER ENTRY IN DEVTBL
SKP
JMP ASD4 /YES
TAD I ASD2 /GET DDB ADDRESS FOR THIS DEVICE
SZA /ZERO?
JMP ASD11 /NO, SO SOMEONE HAS IT
/COMES HERE IF OKAY TO MAKE THIS ASSIGNMENT
CFLD /CHANGE TO CURRENT FIELD
TAD ASD2
6202 /CIF FIELD 0
GETDDB /GET A BLOCK FROM THE FREE LIST AND LINK IT INTO DEVTBL
JMP I LGI201 /NO BLOCK.. REDO IN CASE OF USER OTHERWISE ERROR RETURN FOR SI
DATFLD
TAD I ASD2 /PICK DDB ADDRESS FROM DEVTBL
DCA CFH /SAVE IT
TAD FIOSTK+1
AND P0037 /CLEAR BIT 0
DCA I CFH /SET TO REFLECT THE DEVICE NUMBER
ISZ CFH
TAD FIJOB
DCA I CFH /PLUG IN THE JOB NUMBER
ASD7, CFLD
JMP I FIEXIT
/COMES HERE IF ONE JOB ATTEMPTS TO ASSIGN AN ALREADY ASSIGNED DEVICE
ASD11, IAC
DCA CFH
TAD I CFH
SNA
CMA
DCA FIUSAC /DELIVER TO USER'S AC
JMP ASD7 /EXIT
ASD4, TAD FIOSTK+1
CLL RAL
SZA CLA /PTR?
JMP ASD7 /NO
TAD I ASD2
CIF 00
JMS I ASDCLR /CLEAR THE READER BUFFER
JMP ASD7
ASDCLR, SICLR
/ROUTINE TO PERFORM ACTUAL REDUCTION
/CALLING SEQUENCE:
/ TAD (NUMBER OF SEGMENTS TO REMAIN)
/ JMS RED30
/ RETRIEVAL CHAIN POINTER
/ UFD RETRIEVAL POINTER
/ RETURN
/FIRST TRACE THRU THE LINKED LIST OF FILE INFORMATION
/RETRIEVAL BBLOCKS UNTIL WE GET TO THE ONE IN WHICH THE
/NEW LAST SEGMENT IS
RED30, 0
DCA RED31 /LINKAGE TO RETRIEVAL CHAIN
TAD GDRETP /PICK UP RETRIEVAL POINTER
JMS I GE01 /GET THIS WORD INTO CORE
RED31, 0
DCA REBUFF
TAD I REBUFF /PICK UP LINK TO NEXT
DCA RED31 /SAVE LINK
TAD WNDREM /DELETING ENTIRE WINDOW?
SNA CLA
JMP RED36 /YES, REMOVE LINK TO LAST WINDOW AS WELL
RED37, ISZ REWNDC /AT END OF CHAIN?
JMP RED30+2 /NO, KEEP SAVING
DCA I REBUFF /YES, TERMINATE IT
/FOUND RETRIEVAL BLOCK IN WHICH TO CHOP OFF
/THE LIST OF SEGMENTS.
/START DELETING THE SEGMENT NUMBERS AND RETURNING
/THE ACTUAL DISC SEGMENTS TO THE POOL
TAD WNDREM
IAC /GET POINTER TO FIRST SEGMENT TO BE DELETED
TAD REBUFF
DCA REBUFF /POINTER TO FIRST SEGMENT TO REMOVE
DCA SEGLIM /CLEAR SEGMENT COUNTER
TAD WNDREM /NUMBER OF SEGMENTS TO LEAVE IN RET. WINDOW
RED32, TAD C7771 /7 SEGMENTS PER RETRIEVAL WINDOW
DCA REWNDC /SAVE COUNT
DCA BUFMOD /REMEMBER TO WRITE OUT THE BUFFER
RED33, TAD REDM9
DCA CFH /SET COUNT FOR SATREL DIVIDE
STL STA
TAD I REBUFF /PICK UP THE SEGMENT NUMBER
SZL /IS IT A REAL SEGMENT
JMP RED38 /NO; END OF WINDOW, END OF FILE
JMS I SATREA /RELEASE IT ON SAT
DCA I REBUFF /CLEAR THE CCELL
ISZ SEGLIM /COUNT SEGMENT
ISZ REBUFF
ISZ REWNDC /END OF CURRENT RETRIEVAL WINDOW?
JMP RED33 /NO, CONTINUE
TAD RED31 /YES, MOVE TO NEXT
SNA /END OF CHAIN?
JMP RED39 /YES, EXIT
RED34, DCA RED35 /NO
TAD GDRETP
JMS I GE01 /GET NEXT WINDOW
RED35, 0
DCA REBUFF
TAD I REBUFF
DCA RED31 /SET UP LINK TO NEXT
DCA I REBUFF /CLEAR FIRST WORD OF WINDOW
ISZ REBUFF
JMP RED32 /KEEP WIPING OUT
RED36, STL CLA RTL /ARE WE TWO WINDOWS FROM THE END YET?
TAD REWNDC
SZA CLA
JMP RED37 /NOT EXACTLY
DCA I REBUFF /YES, CLEAR LINK TO NOW EMPTY WINDOW
DCA BUFMOD /SCHEDULE WRITE
JMP RED37
RED38, CLA
DCA I REBUFF /CLEAR TO END OF WINDOW
ISZ REBUFF
ISZ REWNDC /ARE WE THERE YET?
JMP RED38 /NO
RED39, TAD GDRETP /GET RETRIEVAL POINTER
JMS I ENS32 /CONVERT IT INTO A RELATIVE ENTRY NUMBER
STL RTL /TIMES 4 PLUS 2
IAC
TAD UFDTBL /POINTS TO WORD3 OF UFDTBL ENTRY
DCA REBUFF
TAD I REBUFF /HAS HIS/HER SEGMENT COUNT BEEN SET UP YET?
SNA CLA
JMP I RED30 /NO; SO JUST EXIT
TAD SEGLIM /NUMBER OF SEGMENTS WE REMOVED FROM THIS FILE
CIA
TAD I REBUFF /SUBTRACT FROM THOSE THAT WE KNEW ABOUT
DCA I REBUFF /UPDATE UFDTBL ENTRY
STA
DCA TABSTA /REMEMBER TO WRITE OUT THE TABLES
JMP I RED30 /EXIT
ENS32, ENS3
REDM9, -11
SATREA, SATREL
REBUFF, 0
*4000
/RENAME ROUTINE
REN0, JMS I ACC01 /IS IT ACCOUNT 1?
JMP PASSQU /YES; GO CHANGE PASSWORD AND DISK QUOTA
JMS I IFN01
TAD FIOSTK+1 /PICK UP INTERNAL FILE NUMBER
JMS I UC01 /USER-OWNER CHECK
JMP I REN1A /USER NOT OWNER, ERROR
JMS I FILNAM /CHECK IF THIS NEW NAME IS IN DIRECTORY
JMP I BADNAM /YES, DON'T RENAME
TAD FIOSTK /PICK UP INTERNAL FILE NUMBER NOW SHIFTED TO FIOSTK
JMS I GD01 /GET THIS DIRECTORY ENTRY INTO CORE
DCA REENTP /POINTER TO DIRECTORY ENTRY
TAD REENTP
TAD P0004
DCA REPRTP /POINTER TO PROTECTION BITS
TAD I REPRTP /PICK UP PROTECTION BITS
AND C0020 /WRITE PROTECTED AGAINST OWNER?
SZA
JMP I REN1A /YES, ERROR
TAD FIOSTK+2 /TRANSFER NEW NAME TO DIRECTORY
SNA /IS IT A NULL NAME?
JMP I BADNAM /YES, DON'T RENAME
DCA I REENTP
ISZ REENTP
TAD FIOSTK+3
DCA I REENTP
ISZ REENTP
TAD FIOSTK+4
DCA I REENTP
DCA BUFMOD /SCHEDULE WRITE
JMP I FIEXIT /EXIT FROM FILE PHANTOM
REN1A, REN1
FILNAM, USENAM
BADNAM, CRF30
SEGS0, TAD I SEGCNT
DCA FIUSAC
JMP I FIEXIT
SEGCNT, -SATSIZ+1
SIFLD, CORTBL+1
PASSQU, CDF 00
TAD I SIFLD /IS THIS REQUEST FROM SI?
AND C0200
CFLD
SZA
JMP I REN1A
TAD FIOSTK+1 /OR IS [S]HE TRYING ACCOUNT 0?
SNA
JMP I BADNAM /YES; ERROR
JMP I .+1
PASQU0
/BUILD A RETRIEVAL POINTER GIVEN RELATIVE POSITION ON RETTBL
/CALLING SEQUENCE:
/ TAD (RELATIVE POSITION)
/ JMS BLDP
/ RETURN (POINTER IN AC)
REENTP,
BLDP, 0
DCA CFH
CLA CMA
TAD CFH
CLL RAL
RTL
TAD RETTBL
JMP I BLDP
/JMS I LINK01
/MISSING SEGMENT ADD
/REPLACEMENT
LINK0, 0
DCA LINK1
TAD GDRETP
JMS I GE01
LINK1, 0 /GET A DIRECTORY WORD INTO CORE
TAD P0003
DCA LINK2
TAD I LINK2
CIA
TAD I LINK0
SZA CLA /SEARCH THROUGH UFD UNTIL WE FIND ENTRY BEING SOUGHT
JMP LINK3
ISZ LINK0
TAD I LINK0 /TAKE A BLOCK OUT OF THE CHAIN
DCA I LINK2
DCA BUFMOD /SCHEDULE WRITE
ISZ LINK0
JMP I LINK0
REPRTP,
LINK2, 0
LINK3, TAD I LINK2
JMP LINK0+1
/ROUTINE TO SET UP A UFDTBL ENTRY AS FOLLOWS:
/WORD 0: PROJECT, PROGRAMMER NUMBER
/WORD 1: -ACCESS COUNT
/WORD 2: -DISK SEGMENT QUOTA (LOGIN)
/WORD 3: ACTUAL NUMBER OF SEGMENTS OWNED.
/(WORDS 1 AND 3 ARE INITIALLY SET TO 0.)
/WORD 3 IS LOADED BY "CREATE," OR BY "EXTEND" IF IT HAS NOT PREVIOUSLY
/BEEN LOADED. "CREATE" & "EXTEND" ALWAYS MODIFY WORD 3, "REDUCE" ONLY
/MODIFIES WORD 3 IF IT IS NON-ZERO.
UFQUOT, 0
DCA I INDEX /SAVE PROJECT, PROGRAMMER NUMBER
DCA I INDEX /ZERO ACCESSES SO FAR
TAD SEGLIM /LOGGED IN QUOTA
CLL RAL /TIMES 2
TAD SEGLIM /THREE
RAL /SIX
RTL /TWENTY FOUR
TAD SEGLIM /TWENTY FIVE
CIA /NEGATE
DCA I INDEX /SAVE LOGGED-IN SEGMENT QUOTA
DCA I INDEX /NO KNOWN SEGMENTS AS OF YET
JMP I UFQUOT
/ROUTINE TO GET THE NUMBER OF A DEVICE ATTACHED TO THIS JOB
/CALLING SEQUENCE:
/ JMS LNS0
/ RETURN IF NONE AVAILABLE
/ NORMAL RETURN (DEVICE NUMBER IN AC)
LNS0, 0
TAD DEVTBA /GLOBAL TO #DEVTBL#
DCA CFH
DATFLD /CDF FIELD 0
LNS4, TAD I CFH /PICK UP POINTER TO DDB
SNA
JMP LNS2 /DEVICE UNASSIGNED
IAC
DCA LNS3 /POINTER TO SECOOND WORD OF DDB
TAD I LNS3
AND P0037 /PICK OFF THE JOB NUMBER OF OWNER
CIA
TAD FIJOB /NUMBER OF CURRENT JOB
SNA CLA
JMP LNS5 /THIS DEVICE IS OURS
LNS2, ISZ CFH
TAD CFH
CMA
TAD DEVOVR /GLOBAL TO "JOBTBL"
SZA CLA
JMP LNS4 /CONTINUE LOOKING DOWN TABLE
LNS7, CFLD /MAKE SURE WE ARE IN THIS FIELD
JMP I LNS0 /FOUND NOW DEVICES
LNS5, TAD DEVEND
CIA
TAD CFH
ISZ LNS0
SMA
JMP LNS6
TAD LNS10
CLL RAR
JMP LNS7
LNS6, TAD C4000
JMP LNS7
LNS10, DEVTBE-DEVTBL
LNS3, 0
C4000, 4000
/ROUTINE TO RELEASE A DEVICE
*4200
REL00, 0
JMS I DTE01 /IS THIS DEVICE ASSIGNED TO THIS USER?
REL5, 0 /SET BY DTE0 TO POINT TO DEVTBL ENTRY FOR THIS DEVICE
JMP REL13 /NO, SO DON'T RELEASE IT
TAD I REL5
DCA REL6 /SAVE ADDRESS OF DDB FOR LATER
TAD REL6
TAD P0003 /POSITION OF TIME IN DDB
DCA REL2
TAD I REL2 /GET TIME ASSIGNED
CIA
DCA REL2 /-TIME ASSIGNED
CDF
TAD I RELCK1 /GET TIME NOW
RTL
RTL
AND P0007 /JUST SIGNIFICANT PART OF LOW ORDER TIME
DCA REL3
TAD I RELCK2
DATFLD
RTL
RAL
AND P7770 /JUST INSIGNIFICANT PART OF HI ORDER
TAD REL3 /TIME AT RELEASE
CLL
TAD REL2 /-TIME AT ASSIGNMENT
DCA REL2 /TIME WE OWNED IT
TAD REL2
SNL /GONE THRU MIDNITE WHILE ASSIGNED?
TAD RELCON /YES, FUDGE TO PROPER VALUE
SZA
JMS I DVT01 /RECORD TIME SINCE WE USED A MEASURABLE AMOUNT
STL
TAD REL5
TAD RELCDR /IS IT A CARD READER OR DECTAPE OR RK05?
SPA
RAR /NO - IS IT A KEYBOARD OR THE PTR?
SNL
JMP REL11 /EITHER KEYBOARD, PTR, CDR, DTA, OR RK05
TAD RELREG /EITHER PTP OR LPT
REL8, DCA REL6 /ENTER HERE FROM REL12 FOR TELEPRINTER
STA
TAD I REL5
DCA INDEX /POINT TO WORD 0 OF DDB (AUTOINDEXED)
TAD I INDEX /CHECK STATUS IF TELEPRINTER
SPA CLA
JMP REL4 /[S]HE'S IN THE ^S CONDITION - FLUSH HIM/HER OUT
DCA I INDEX /CLEAR THE JOB NUMBER
ISZ INDEX
ISZ INDEX
TAD I INDEX /CHECK FILL POINTER
SZA CLA
JMP REL9 /STILL BUSY - LET "CONOUT" RELEASE IT
TAD REL6
SZA CLA /ASSIGNABLE DEVICE?
JMP REL7 /YES
REL4, TAD I REL5
CIF 00
JMS I RELTBL /MAKE SURE THE BUFFER IS CLEAR
DATFLD
TAD I REL5 /RELEASE THE DDB
JMS I RETBK1
CLA
DATFLD
DCA I REL5
REL9, CFLD
JMP I REL00
REL7, CIF 20 /INHIBIT INTERRUPTS
TAD I REL6
CLL RAL
SNA
JMP REL4
SPA
STL
RAR
DCA I REL6
JMP REL9
REL11, SMA CLA /IS IT A KEYBOARD OR THE PTR?
JMP REL12 /NO
TAD REL6
CIF 00
JMS I RELTBL /FLUSH OUT THE BUFFER
REL12, TAD REL6
JMS I RETBK1 /RELEASE THE DDB
CLA
DATFLD
DCA I REL5 /REMOVE FROM DEVTBL
TAD DEVEND
CIA
TAD REL5
SMA CLA
JMP REL9
ISZ REL5
JMP REL8
REL13, CDF
TAD I JOB
AND C0200
CFLD
SZA CLA /CALLED BY SI??
JMP I LGI201 /YES, INDICATE ERROR WITH AC=-1
JMP I REL00 /NO, UUO CALL
RELREG, OUTREG+NULINE+3
RELCDR, -DEVTBE-4
DVT01, DVT0
REL2, 0
REL3, 0
RELCK1, CLK1
RELCK2, CLK2
RELCON, 3227 /FUDGE FOR MIDNIGHT OVERFLOW
RELTBL, SICLR
P0100, 100
FIXSCH, 0
IAC
DCA REL5
TAD I REL5
AND P0100
SNA CLA
JMP I FIXSCH
TAD DEVOVR
CIA
TAD INDEX
FIXOUT, CIF CDF
DCA I FIPJOB
WAIT
EXCEED, 215;212;"[;" ;" ;" ;" ;" ;" ;" ;"E;"X;"C;"E;"E;"D;"I;"N;"G
" ;"D;"I;"S;"K;" ;"Q;"U;"O;"T;"A;"];215;212;0
/COMPLETION OF LOGOUT ROUTINE
/REMOVES JOB FROM PERMANENT MONITOR TABLES
/MUST BE DONE LAST, SINCE WE NEED THE JOB STATUS BLOCKS
/TO INDICATE ANY ERRORS IN THE FIP I/O
LGO4, TAD LGO500 /RESTORE THE FIP EXIT
CFLD
DCA I LGOFIX
TAD FIJOB /SEE IF [S]HE OWNS ANY CORE FIELDS
CIF
CORE /SEARCH CORE TABLE FOR HIM/HER
FIP SI CJOB
JMP LGO5 /NO; NOTHING TO RELEASE
AND P0007 /YES; RELEASE THE FIELD
TAD CORTBA
DCA CFW /POINTS TO ENTRY IN CORTBL
CDF
DCA I CFH /ZERO THE ENTRY
LGO5, TAD FIJOB /RETURN STATUS BLOCKS
TAD DEVOVR /START OF JOB TABLE (END OF DEVTBL)
DCA LGO6 /POINTS TO JOB TABLE ENTRY
DATFLD
TAD I LGO6 /GET ADDRESS OF JOB STATUS
JMS I LGOBLS /RETURN STATUS
DATFLD
DCA I JOBDAT /CLEAR JOBDAT
DCA I LGO6 /CLEAR POINTER IN JOBTABLE
CDF
DCA I JOB /CLEAR JOB (SO SAVJOB WON'T SAVE US)
JMP I .+1 /AND NOW GO DO FIX50
LGO500, FIX50
LGOBLS, RETBLS
LGOFIX, FIX500
LGO1, TAD FIOSTK+1 /LOGOUT WITH AC=0?
SZA CLA
JMP I LGI201 /NO, SO IT'S AN ERROR
TAD FIJOB
TAD JOBTAB
DCA CFH /GET HIS/HER PROJ-PROG #
TAD I CFH
CIA
DCA FIOSTK+2 /SAVE HIS/HER #
TAD JOBTAB
DCA INDEX /INITIALIZE TO START OF TABLES
TAD LGOMAX /-JOBMAX
DCA FIOSTK+3 /COUNT OF JOBS TO CHECK
DCA FIOSTK+4 /COUNT OF MATCHES
TAD I INDEX
TAD FIOSTK+2 /COMPARE
SNA CLA
ISZ FIOSTK+4 /EXACT MATCH - INDEX COUNT
ISZ FIOSTK+3 /DONE?
JMP .-5 /NO
STA /YES - RETURN # OF MATCHES -1
TAD FIOSTK+4
DCA FIUSAC
JMP I FIEXIT /AND AWAY
LGOMAX, -JOBMAX
OPN11, 0
DCA OPN13
TAD FIOSTK+2 /GET RETRIEVAL POINTER OF UFD BEING ACCESSED
CIA
TAD RETTBL /IS IT THE MFD?
SNA CLA
JMP OPN14 /MFD OR UFD, READ OK/WRITE NEVER OK
JMS I ACC01 /IS [S]HE THE SYSTEM MANAGER?
JMP OPN12 /YES; SKIP PROTECTION CHECK
TAD I OPN11 /GET PROPER TEST BITS
AND P0007 /JUST TEST FOR READ PROTECTION FIRST
AND I OPN13 /COMPARE AGAINST FILE'S PROTECTION WORD
SZA CLA
JMP I OPNPRA /PROTECTION ERROR
TAD I OPN11 /READ OK, GET TEST BITS FOR WRITE
CLL RAL /CHECK FOR WRITE PROTECTION
AND I OPN13
OPN12, CMA
DCA LGO6 /-1 IF OK TO WRITE
TAD I ZDS1 /SOME MORE CONDITIONS TO TEST
DCA OPN13
TAD FIOSTK+2
JMS I OPN16 /IS [S]HE THE ONLY PERSON TO OPEN THE FILE?
OPN13, 0
JMP OPN14 /NO
TAD BASSWT
CIA
DATFLD
SZA
DCA I BASWIN /MAKE SURE THE BASIC WINDOW GETS LOADED
CFLD
ISZ LGO6 /IS [S]HE ALLOWED TO MODIFY IT?
OPN14, TAD P0004 /NO, SO WRITE PROTECT BIT IS ON
ISZ OPN11 /SKIP ON RETURN
JMP I OPN11
OPN16, ENS0
OPNPRA, OPNPRE
LGO6,
FIX40, 0
DCA FLPARB+3
TAD FLPARB+3
DCA FLPARB+5
CLA CMA
TAD FLPARB+5
DCA FLPARB+4
JMP I FIX40
*4600
TTYTBA, TTYTBL
CLK1A, CLK1
CLK2A, CLK2
RESET, DCA I CFH
FGETJT
JOBACC
DCA ADDR
DATFLD
TAD FIOSTK+2
DCA I ADDR /PLUG HIS/HER ACCOUNT # INTO HIS JOB STATUS BLOCKS
TAD FIJOB /GET JOB #
TAD TTYTBA
DCA ADDR
TAD I ADDR /GET LINE #
CLL RAL
TAD DEVTBA /FIND THE DDB
DCA ADDR
TAD P0003
TAD I ADDR
DCA ADDR
CDF
TAD I CLK1A
RTL
RTL
AND P0007
DCA CFH
TAD I CLK2A
RTL
RAL
AND P7770
TAD CFH
DATFLD /NOW RESET THE
DCA I ADDR /ASSIGN TIME
JMP I .+1 /THEN EXIT
TABOUT
BASCO0, 0
JMS I IFN01 /JUST RETURN INTERNAL FILE # IN FIOSTK+1
TAD FIOSTK+1
JMS I CL01 /CLOSE ANY FILE THAT IS OPEN
TAD FIOSTK+3 /MAY BE
SNA /IS IT A NULL FILE NAME?
JMP I OPN3A /YES, ERROR RETURN
TAD OPN3A+1 /COMPARE BA
SZA CLA
JMP BASSET /NO MATCH
TAD FIOSTK+2 /IS ACCT # 2?
SNA
JMS I JBLD0 /WHAT'S HIS/HER ACCOUNT?
CLL RTR
SNA CLA
TAD FIOSTK+4 /COMPARE SI
TAD OPN3A+2
SNA CLA
TAD FIOSTK+5
TAD OPN3A+3 /COMPARE C
SNA CLA
CMA /IF BASIC, BASSWT=-1
BASSET, DCA BASSWT /IF NOT, BASSWT=0
TAD FIOSTK+1
JMS I EBLD0 /GET PTR TO ENTTBL WORD 1 RELATIVE PTR WORD 2 ADDRESS IN UFD
JMP I BASCO0 /RETURN
OPN3A, OPN3
-4241 /-BA
-6351 /-SI
-4300 /-C
CLOBAS, 0
JMS I RETBK1
DCA BAS3
TAD BAS3
CIA
TAD BASWIN
SNA CLA
JMP CLOBA1
TAD BAS3
JMS I RETBK1
CLA SKP
CLOBA1, CLA CMA
JMP I CLOBAS
BAS0, 0
DCA BAS1 /SAVE BUFFER ADDRESS OF RETRIEVAL WINDOW
TAD BASWIN /BASIC WINDOW ADDRESS
DCA ADDR /GET BUFFER ADDRESS READY
BAS5, TAD BAS1 /
DCA BAS2
TAD C7771
DCA BAS3 /COUNT OF 7 SEGS PER WINDOW
BAS4, ISZ BAS2
CFLD
TAD I BAS2 /PICK UP THE SEG #
ISZ ADDR
SNA
JMP BAS6
DATFLD
DCA I ADDR /SAVE IT IN WINDOW
ISZ BAS3 /COUNT
JMP BAS4 /STILL IN SAME BLOCK
CFLD
TAD I BAS1 /CHANGE THE BLOCK
SNA
JMP BAS6 /NO MORE SEGMENTS
DCA BAS1
TAD FIOSTK+2 /GET THIS BLOCK OF UFD IN BUFFER
JMS I GE01
BAS1, 0
DCA BAS1 /SAVE THE BUFFER ADDRESS CONTAINING THE NEEDED BLOCK
JMP BAS5 /CONTINUE
BAS6, SNA
TAD I BAS1
SZA CLA
JMP I BAS123 /BASIC MUST BE 39 SEGMENTS OR LESS TO USE SPECIAL WINDOW
TAD ADDR
SMA CLA
JMP .+5
DATFLD
DCA I ADDR
ISZ ADDR
JMP .-2
DATFLD
CLA CMA
DCA I BASWIN /-1 IN FIRST WORD TO MARK BASIC WINDOW
JMP I BAS0
ADDR, 0
BAS2, 0
BAS3, 0
BAS123, OPN123
/ROUTINE TO LET SYSTEM MANAGER CHANGE PASSWORDS AND DISK QUOTAS
UFDNAM, RTABLE
0
PASQU0, DCA UFDNAM+1 /SAVE ACCOUNT NUMBER TO SEARCH FOR
CMA
JMS I DS01 /SEARCH MFD FOR THIS ACCOUNT
UFDNAM
JMP PASNOT /ACCOUNT NOT FOUND IN MFD
DCA INDEX /SAVE POINTER TO OLD PASSWORD
TAD FIOSTK+2 /FIRST TWO CHARACTERS OF NEW PASSWORD
DCA I INDEX /SAVE IN MFD NAME BLOCK
TAD FIOSTK+3 /SECOND TWO CHARACTERS OF NEW PASSWORD
DCA I INDEX /SAVE IN MFD
ISZ INDEX /SKIP PAST LINK TO NEXT UFD
TAD FIOSTK+4 /GET NEW DISK QUOTA
DCA I INDEX /SAVE NEW QUOTA
DCA BUFMOD /REMEMBER TO WRITE OUT THE MFD SEGMENT
TAD FIOSTK+1 /SEE IF THIS ACCOUNT IS CURRENTLY IN THE UFDTBL
JMS I UTS01
JMP I FIEXIT /NOT THERE
ISZ UTPRNU /POINTS TO -QUOTA ENTRY
STA
TAD FIOSTK+1 /IS IT THE QUOTA FOR THE "GRACE SPACE"?
SNA CLA
JMP PASQU1 /YES
TAD FIOSTK+4 /TRIM OFF THE LOGOUT PORTION OF THE QUOTA
AND P0077
DCA FIOSTK+4
TAD FIOSTK+4
CLL RAL /MULTIPLY BY TWO
TAD FIOSTK+4 /THREE
RAL /SIX
RTL /TWENTY FOUR
PASQU1, TAD FIOSTK+4 /TWENTY FIVE; OR ACTUAL COUNT IF FOR "GRACE SPACE"
CIA /NEGATE THE RESULT
DCA I UTPRNU /SAVE AWAY IN THE UFDTBL
JMP I .+1
TABOUT
PASNOT, TAD P7000 /RETURN FILE NOT FOUND
DCA FIUSAC
JMP I FIEXIT
/SUBROUTINE TO FIND AN EMPTY DIRECTORY ENTRY
/CALLING SEQUENCE:
/ TAD (POINTER TO UFD RETRIEVAL INFORMATION)
/ JMS DE0
/ BAD RETURN (COULD NOT FIND A FREE ENTRY)
/ NORMAL RETURN (POINTER TO ENTRY IN AC)
DE0, 0
DCA DERETP /SAVE RETRIEVAL PTR
DCA DE2 /ZERO THE ADDRESS IN UFD
TAD BUFSTA /IS THERE A SEGMENT IN THE BUFFER?
SMA CLA
JMP DE7 /NO, SO START FROM THE BEGINNING
TAD I GERETA /GET THE SEGMENT IN CORE
CMA
DCA NSEGCR
TAD DERETP /GET RETRIEVAL PTR FOR INCREMENT
DCA UFDPTR
DE5, TAD I UFDPTR
SNA /IS THERE A SEGMENT?
JMP DE7 /NO, START FROM 0 LOC IN UFD
TAD NSEGCR /YES, DOES IT AGREE WITH THE SEGMENT IN CORE?
SNA CLA
JMP DE6 /YES, START SEARCHING AT THIS POINT
TAD DE2 /NO, INCREMENT THE ADDR
TAD C0400
DCA DE2
ISZ UFDPTR /POINT TO NEXT SEGMENT IN RETRIEVAL BLOCK
JMP DE5 /GO BACK
DE7, DCA DE2 /INDICATE THAT SEARCH IS FROM WORD 0
STA
DE6, DCA I UFD01 /SAVE SECOND PASS FLAG
DE1, TAD DERETP
JMS I GE01 /GET ENTRY INTO CORE
DE2, 0
SNA /SKIP IF ENTRY EXISTS
JMP DE4 /DID NOT EXIST, EXTEND UFD
DCA DEBUFP
TAD I DEBUFP /FIRST WORD OF ENTRY
SZA CLA
JMP DE3 /NOT EMPTY, LOOK AT NEXT ENTRY
ISZ DEBUFP /ZERO COULD MEAN END OF STRING OF RETRIEVAL INFORMATION BLOCKS
TAD I DEBUFP /LOOK AT SECOND WORD OF ENTRY
SZA CLA /IF ZERO, EMPTY ENTRY
JMP DE3 /NOT EMPTY, KEEP LOOKING
TAD DE2 /PICK UP ENTRY POINTER
SNA /ENTRY 0 NEVER AVAILABLE
JMP DE3
ISZ DE0 /POINT TO NORMAL RETURN
JMP I DE0
DE3, TAD C0010 /INCREMENT TO NEXT ENTRY
TAD DE2
DCA DE2 /SAVE NEXT ENTRY INDEX
JMP DE1 /LOOK AT NEXT ONE
DE4, ISZ I UFD01 /HAVE WE TRIED FROM THE BEGINNING YET?
JMP DE7 /NO, WELL TRY IT THEN...
TAD DERETP
JMS I UFD01 /TRY EXTENDING THE UFD
JMP I DE0 /TOO BAD, CAN'T EXTEND UFD
JMP DE1 /NOW WE HAVE PLENTY OF ROOM
DEBUFP, 0
UFD01, UFD0
DERETP, 0
UFDPTR, 0
GERETA, RDCURR
NSEGCR, 0
/ROUTINE TO OUTPUT QUOTA EXCEEDED MESSAGE
EXTEL0, 0
DATFLD
TAD FIJOB /CURRENT JOB NUMBER
TAD TTYTAB /POINTS AT POSITION IN TTYTBL
DCA DE0
TAD I DE0 /GET CONSOLE NUMBER FOR THIS JOB
STL RAL /TIMES 2 PLUS 1
TAD DEVTBA /INDEX TO OUTPUT DDB
CDF
DCA I CONDVA /STORE FOR FIELD 0 PRINT ROUTINE
CFLD
TAD EXTMES /GET MESSAGE POINTER
DCA INDEX
EXTEL1, TAD I INDEX /GET CHARACTER OF THE MESSAGE
SNA /ANY LEFT?
JMP I EXTEL0 /NO; SO GO EXTEND
CIF CDF 00
DCA I FICHAR /STORE FOR PRINT OUT ROUTINE
CFLD
PRINT /SEND MESSAGE #[EXCEEDING DISK QUOTA]#
JMP I EXTEL0 /RAN OUT OF SPACE IN THE OUTPUT BUFFER (TOO BAD!)
JMP EXTEL1 /BACK FOR NEXT CHARACTER
TTYTAB, TTYTBL
CONDVA, CONDBA
EXTMES, EXCEED-1
FICHAR, TTCHAR
/ROUTINE TO CLEAR ALL CPU AND DEVICE TIME ACCUMULATORS IN THE MFD
/THIS IS USED BY THE #RESET# FUNCTION IN THE CUSP #CAT#
LGRES0, CLA IAC /SET RESET FLAG IN DIRECTORY SEARCH ROUTINE
DCA I RETBK1
TAD RETBK1
DCA EXQ1 /SET POINTER SO FLAG WILL CLEAR ON COMPLETION
TAD RETTBL
DCA GDRETP /SET RETRIEVAL POINTER
JMS LOQUO /GO DO THE RESET
CMA /SHOULD RETURN A ZERO IN AC
JMP EXTQU1
/ROUTINE TO COUNT TOTAL SEGMENTS OWNED BY A UFD AND
/SAVE THE RESULT IN WORD 3 OF THE UFDTBL ENTRY FOR THE RESPECTIVE UFD
/CALL:
/ EXQ1 POINTS TO WORD 3 OF CORRECT UFDTBL ENTRY
/ JMS LOQUO
/ RETURN (ENTRY 3 LOADED, TOTAL ALSO IN AC)
EXQ3,
LOQUO, 0
DCA WNDREM /FUDGE A FILE NAME BEGINNING WITH TWO SPACES
JMS I DS01 /SEARCH DIRECTORY TO DETERMINE SEGMENT COUNT
GDRETP /(HOPE NO ONE SCRAMBLES LOC. 23-26 ON PAGE 0!!)
CLA SKP /GOOD - COULDN'T FIND SUCH A FILE
JMP I DIRBAD /FOUND IT! OOPS!
TAD SEGLIM /GET THE TOTAL FROM THE DIRECTORY SEARCH
DCA I EXQ1 /SAVE IN UFDTBL
TAD FIOSTK+1 /INTERNAL FILE NUMBER?
SMA /IF THIS IS NOT A "RESET" WE MUST RELOAD
JMS I GD01 /THE CORRECT DIRECTORY SEGMENT
DCA REL6 /SAVE POINTER TO NAME BLOCK
TAD SEGLIM /RETURN WITH CURRENT TOTAL
JMP I LOQUO
EXTQU8, CLA /WE'VE BEEN HERE BEFORE FOR THIS GUY
CFLD
TAD EXQ2 /WILL THIS EXTEND CARRY
TAD I EXQ1 /THIS FILE ACROSS THE QUOTA BOUNDARY AGAIN?
SMA SZA CLA /(I.E. HAS [S]HE REDUCED SINCE LAST EXTEND?)
JMP EXTQU9 /NO; [S]HE'S STILL ABOVE QUOTA, EXTEND QUIETLY
EXTQU6, TAD EXFILE /ADDRESS WITHIN MESSAGE TO STORE FILE NAME
DCA INDEX
JMS EXTNAM /CHAR 1 & 2 OF FILE NAME
JMS EXTNAM /CHAR 3 & 4 OF FILE NAME
JMS EXTNAM /CHAR 5 & 6 OF FILE NAME
JMS I EXTELL /NOTIFY USER THAT QUOTA IS BEING EXCEEDED
EXTQU9, CLA
JMP I EXTQU0 /EXIT TO EXTEND FILE AS REQUESTED
EXTQU5, TAD FIOSTK+2 /NUMBER OF SEGMENTS [S]HE WON'T GET
EXTQU1, DCA FIUSAC /PASS RESULT BACK TO THE USER
JMP I FIEXIT
/ROUTINE TO CHECK LOGIN QUOTA BEFORE EXTENDING A FILE
EXTQU0, 0
TAD GDRETP /COMPARE RETRIEVAL POINTER
CIA
TAD RETTBL /AGAINST THE MFD'S ENTRY
SNA CLA /IS IT FROM THE SYSTEM MANAGER?
JMP I VIOLAT /GET OUT QUICK, BEFORE [S]HE DESTROYS THE SYSTEM
TAD FIOSTK+2 /NUMBER OF SEGMENTS TO BE ADDED
SPA /IS [S]HE BEING REASONABLE?
JMP EXTQU1 /NO - [S]HE DESERVES TO FAIL!
CLL CIA
TAD I SATSEG /ARE THERE THAT MANY SEGMENTS LEFT ON THE SYSTEM?
SNL CLA
JMP EXTQU5 /NO; SO DON'T GIVE ANY
TAD GDRETP /RETRIEVAL POINTER
JMS I ENS33 /CONVERT TO RELATIVE ENTRY NUMBER
STL RTL /TIMES FOUR PLUS TWO
TAD UFDTBL /POINTS AT -LOGIN QUOTA
DCA EXQ1 /SAVE POINTER
TAD I EXQ1 /GET NEGATIVE QUOTA
DCA EXQ2 /AND SAVE
ISZ EXQ1 /POINTS AT CURRENTLY OWNED COUNT
TAD I EXQ1 /GET HIS/HER PRESENT TOTAL
SNA /HAS THE COUNT BEEN SET UP YET?
JMS LOQUO /NO; GO FIGURE IT OUT
TAD FIOSTK+2 /ADD THE NUMBER [S]HE WANTS
TAD EXQ2 /AND SUBTRACT FROM QUOTA
SPA SNA /WILL THIS EXCEED THE QUOTA FOR THIS ACCOUNT?
JMP EXTQU9 /NO; GO EXTEND
TAD I GRACE /WILL IT GO BEYOND THE #GRACE SPACE#?
SMA SZA CLA
JMP EXTQU5 /YES; DON'T BOTHER EXTENDING
TAD FIOSTK+1 /SEE IF THIS FILE IS ALREADY IN THE GRACE AREA
JMS I LNK01 /GET POINTER TO FILE CONTROL BLOCK
TAD FILPRP /POINT TO STATUS WORD
DCA EXQ3
DATFLD
TAD I EXQ3 /GET CURRENT STATUS FOR THIS FILE
RAR
SZL /IS THIS FILE IN THE GRACE AREA?
JMP EXTQU8 /MAYBE; SEE IF [S]HE'S REENTERING
STL RAL /SET GRACE BIT
DCA I DXQ3
CFLD
JMP EXTQU6 /SEND MESSAGE, THEN GO EXTEND
/ROUTINE TO PLANT FILE NAME INTO "EXCEEDING QUOTA" MESSAGE
EXTNAM, 0
TAD I REL6 /GET PART OF FILE NAME
RTR
RTR
RTR
AND P0077 /SAVE LEFT BYTE
TAD P0240 /CONVERT TO ASCII
DCA I INDEX /STORE IN THE MESSAGE AREA
TAD I REL6 /NOW FOR THE RIGHT BYTE
AND P0077
TAD P0240 /CONVERT TO ASCII
DCA I INDEX /SAVE RIGHT BYTE
ISZ REL6 /POINT TO NEXT CHARACTER
JMP I EXTNAM
/ROUTINE TO CHECK FOR THE SAFE REDUCTION OF A UFD
/TWO CONDITIONS MUST BE MET:
/ THE ACCOUNT CANNOT BE IN USE TO ANYONE
/ THE ACCOUNT MUST HAVE AN EMPTY DIRECTORY
EXQ2,
REDUF0, 0
TAD GDRETP /GET RETRIEVAL POINTER
CIA
TAD RETTBL /IS [S]HE TRYING TO REDUCE A UFD?
SZA CLA
JMP I REDUF0 /NO; LET HIM/HER REDUCE NORMAL FILES
TAD I REL6 /GET THE ACCOUNT NUMBER OF THE UFD IN QUESTION
JMS I UTS01 /LOOK IT UP IN THE UFD TABLE
JMP REDUF1 /NOT THERE - GOOD
CLA
TAD C4400 /TELL HIM "FILE IN USE"
JMP EXTQU1
REDUF1, TAD I REL6 /GET THE ACCOUNT NUMBER OF THE UFD TO BE DELETED
JMS I UFO01 /LOAD ITS RETRIEVAL WINDOW INTO RTABLE
JMP EXTQU5 /COULDN'T; PAS HIS/HER OWN AC BACK AS AN ERROR INDICATION
JMS I BLDP1 /MAKE A RETRIEVAL POINTER
DCA GDRETP /SAVE IT FOR THE SEARCH
ISZ EXQ1 /POSITION UFDTBL POINTER FOR THIS ACCOUNT
ISZ EXQ1 /TO POINT TO THE SEGMENT ACCUMULATOR
JMS LOQUO /SEE IF THIS UFD STILL CONTAINS FILES
CLL STA RTL /AC=-3
TAD EXQ1 /POSITION WE'VE BEEN ASSIGNED ON UFDTBL
JMS I TF01 /FREE THE POSITION
TAD I EXQ1 /DID [S]HE OWN ANY SEGMENTS?
SZA CLA
JMP I VIOLAT /STILL SOME FILES IN THERE!
STA
DCA FIOSTK+2 /FORCE HIM/HER TO COMPLETELY DELETE THIS UFD
JMP I REDUF0
VIOLAT, PRT1+1
ENS33, ENS3
SATSEG, -SATSIZ+1
EXFILE, EXCEED+2
EXTELL, EXTEL0
P0240, 240
GRACE, UTABLE+2
$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$