1
0
mirror of synced 2026-03-04 02:24:50 +00:00
Files
lisper.cpus-pdp8/tss8/system/fipb.pal
brad 0e9bfd9d85
2010-04-02 12:36:00 +00:00

1268 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.
/NOW SEE IF THE SEGMENT BEING SOUGHT IS ONE WHICH FOLLOWS
/THOSE WHICH ARE PRESENTLY IN THE CORE WINDOW. IF THE
/SOUGHT BLOCK DOES FOLLOW THE PRESENT ONE, WE CAN LOOK
/THROUGH THE RETRIEVAL INFORMATION BLOCKS STARTING AT THE ONE
/NOW IN CORE. OTHERWISE, WE MUST START AT THE VERY BEGINNING
/OF THE LIST OF FILE RETRIEVAL INFORMATION BLOCKS
TAD WNSEGC
SPA SNA
JMP WND6 /PREVIOUS BLOCK, SO MUST START AT BEGINNING OF STRING
JMS I WND201 /DIVIDE BY 7
CIA
DCA WNDCNT /MOVE FORWARD THIS MANY WINDOWS
TAD WNDPTR
WND10, DCA WNDIRP
TAD I WNDIRP /PICK UP ADDRESS OF NEXT WINDOW
CFLD /CHANGE TO CURRENT FIELD
SNA
JMP WND13 /END OF STRING
DCA WND11
TAD WNRETP /POINTER TO UFD RETRIEVAL INFORMATION
JMS I GE01 /GET ENTRY INTO CORE
WND11, 0
ISZ WNDCNT /HAVE WE MOVED AHEAD ENOUGH BLOCKS?
JMP WND10 /NOT PROPER WINDOW, KEEP LOOKING
DCA WNDIRP
WND13, 6202 /CIF FIELD 0
BLT
6221 /SOURCE FIELD (ALWAYS 2)
WNDIRP, 0 /SOURCE
DATFLD /DESTINATION FIELD
WNDPTR, 0 /DESTINATION
-10 /WORD COUNT
TAD WNDCNT /CORRECT FOR WINDOWS THAT WEREN'T THERE
JMS WND30 /MULTIPLY BY 7
TAD WNSEGC /SEGMENT NUMBER OF FIRST IN WINDOW
DATFLD
DCA I WNFCBP /FILE CONTROL BLOCK POINTER
ISZ WNFCBP /POINT AT PROTECTION WORD IN CONTROL BLOCK
TAD I WNFCBP /GET CURRENT STATUS
AND P0007 /SAVE ONLY STATUS BITS
TAD WND11 /ADD IN POINTER TO CURRENT RETRIEVAL WINDOW
DCA I WNFCBP /AND SAVE
JMP I .+1 /GO SET #JSIOTC# BEFORE EXITING
INF6
WND6, CFLD /CHANGE TO CURRENT FIELD
CLA CLL
TAD WNSEGC /SEGMENT TO GET INTO IN CORE WINDOW
JMS I WND201 /DIVIDE BY 7
CMA
DCA WNDCNT /WINDOW NUMBER TO GET INTO CORE
ISZ WNENTP
TAD I WNENTP /UFD ENTRY ADDRESS OF OPEN FILE
DCA WND5
TAD WNRETP /RETRIEVAL INFORMATION POINTER
JMS I GE01 /GET ENTRY INTO CORE
WND5, 0
TAD P0007
JMP WND10
/ROUTINE TO MULTIPLY A NUMBER BY 7
WNDSCT,
WND30, 0
DCA CFH
TAD CFH
CLL RAL
TAD CFH
CLL RAL
TAD CFH
JMP I WND30
WNFCBP, 0
WNENTP, 0
WNRETP, 0
WNDCNT, 0
WNSEGC, 0
WNDCCT, 7773
WNCURS, 0
C0177, 177
IODISP,
ASD1
REL1
REN0
OPN0
CLS0
WND0
PRT0
WND0
CRF0
EXT0
RED0
INF0
LGI0
LGO0
WHO0
SEGS0
*1200
/ROUTINE TO CREATE A NEW FILE
CRF0, TAD FIOSTK+1
SNA CLA
JMP CRF30
JMS I JBLD0
JMS I UTS01 /SEARCH THE UFD TABLE
JMP I DIRBAD /***************DEBUG**************
JMS I BLDP1 /BUILD A PTR TO RETTBL
DCA FIOSTK /MAKE A LINKAGE FOR DIRECTORY SEARCH
JMS I ACC01 /IS IT ACCOUNT 1?
CMA /YES; MAKE IT A ONE WORD SEARCH
JMS I DS01 /SEARCH THE DIRECTORY FOR THIS NAME
FIOSTK /POINTER TO SEARCH PARAMETERS
JMP CRF2 /COULD NOT FIND THIS NAME, CONTINUE
DCA CRBUFP /FOUND A FILE OF THIS NAME IN UFD. PTR INTO CRBUFP
JMS I ACC01 /SEE IF THIS IS ACCOUNT 1
JMP CRF30 /CAN'T DELETE UFD'S AS THOUGH THEY ARE FILES
TAD I ZDS1 /POINTER TO "DS1"=ADDR WITHIN UFD WHERE THIS FILE NAME'S BLOCK IS
DCA CRF11 /UFD ADDRESS OF DIRECTORY ENTRY
TAD FIOSTK
JMS I CRENS /SEARCH ENT TABLE FOR ACCESSES TO THIS FILE
CRF11, 0 /UFD ADDR OF DIRECTORY ENTRY
JMP CRF10 /ERROR, FILE IS OPEN
/COMES HERE IF A FILE BY THIS NAME ALREADY EXISTS, BUT NO ONE HAS OPENED IT
TAD CRF11
DCA I CRGD11 /GD1
TAD FIOSTK
DCA GDRETP
TAD CRBUFP /PTR TO WHERE IN CORE BUFFER THE UFD BLOCK FOR THIS FILE IS
JMS I SAVCRA /DELETE THE EXISTING FILE OF THIS NAME
JMS I DS01 /SEARCH THE UFD FOR AN EXISTING FILE OF THE SAME NAME
FIOSTK
SKP /NONE THERE, SO OKAY TO CREATE ONE
JMP I DIRBAD /**************DEBUG ONLY**********
/NOW ALL SET TO CREATE THE FILE. TO DO THIS, WE NEED TWO BLOCKS OF
/THE UFD -- ONE FOR A NAME BLOCK AND THE SECOND FOR A FILE RETRIEVAL INFORMATION
/BLOCK. THESE BLOCKS ARE OBTAINED BY TWO CALLS TO DE0. AFTER THE FIRST,
/A DUMMY 7777 IS PUT IN THE FOUND BLOCK TO PREVENT THE SECOND CALL
/TO DE0 FROM FINDING THE SAME BLOCK. IF BOTH BLOCKS CANNOT BE OBTAINED,
/THE CREATE CANNOT BE EXECUTED.
CRF2, DCA CRLINK /ADDR OF LINK WORD OF LAST ENTRY IN UFD CHAIN
ISZ UTPRNU /POINTS AT LOGIN DISK QUOTA
TAD I UTPRNU /-SEGMENTS ALLOWED WHILE LOGGED IN
TAD SEGLIM /PLUS NUMBER OF SEGMENTS FOUND WHILE SEARCHING HIS/HER DIRECTORY
ISZ UTPRNU /POINT AT HOLD REG FOR SEGMENT COUNT
SMA CLA /IS [S]HE ALLOWED ONE MORE?
JMP CRF1 /NO; TELL HIM/HER DIRECTORY FULL
TAD FIOSTK /POINTER TO RETRIEVAL INFORMATION
JMS I DE01 /FIND AN EMPTY DIRECTORY ENTRY
JMP CRF1 /ERROR, NO AVAILABLE ENTRIES
DCA CRF4 /ADDRESS OF THIS ENTRY
JMS CRF40 /GET THIS ENTRY INTO CORE
CLA CMA
DCA I CRBUFP /SIMULATE A USED ENTRY
DCA BUFMOD /SCHEDULE WRITE
TAD FIOSTK
JMS I DE01 /FIND ANOTHER ENTRY
JMP CRF51 /ERROR
DCA CRF3
TAD FIOSTK
JMS I GE01 /MAKE SURE SECOND ENTRY IS IN CORE
CRF3, 0
DCA INDEX
JMS I SATL1 /FIND A FREE SEGMENT IN THE SAT
SNA
JMP CRF20 /COULD NOT FIND A FREE SEGMENT
/AT THIS POINT, WE HAVE A DISC SEGMENT AND TWO BLOCKS FROM THE
/UFD. THIS IS ALL THAT IS NEEDED, SO GO AHEAD AND EXECUTE THE CREATE
DCA CRF11 /SAVE SEGMENT NUMBER
TAD CRF11
DCA I INDEX /PUT IT IN THE FIRST BLOCK OF RETRIEVAL
DCA BUFMOD /SCHEDULE WRITE
JMS CRF40 /GET FIRST FOUND ENTRY INTO CORE
TAD FIOSTK+1 /TRANSFER FILE NAME INTO DIRECTORY ENTRY
DCA I CRBUFP
TAD CRBUFP /MOVE POINTER TO AUTO-INDEX
DCA INDEX
TAD FIOSTK+2
DCA I INDEX
TAD FIOSTK+3
DCA I INDEX
DCA I INDEX /ZERO LINK (THIS IS THE LAST FILE)
TAD CRPROT /PICK UP PROTECTION BITS
DCA I INDEX /STORE INITIAL PROTECTION CODE
JMS I CRFUFA /GO SEE IF WE'RE CREATING A NEW ACCOUNT
CDF /CDF FIELD 0
TAD I DATE /GLOBAL TO DATE
CFLD /CHANGE TO CURRENT FIELD
CRFUFR, DCA I INDEX /STORE DATE OF CREATION
TAD CRF3 /POINTER TO RETRIEVAL
DCA I INDEX /SET UP PTR TO RETRIEVAL INFORMATION
DCA BUFMOD /SCHEDULE WRITE
TAD FIOSTK /GET LAST ENTRY ON STRING INTO CORE
JMS I GE01
CRLINK, 0
DCA CRBUFP /PTR TO WHERE THE PRESENT LAST ENTRY IS
TAD CRF4
DCA I CRBUFP
DCA BUFMOD /SCHEDULE WRITE
JMS I ACC01 /IS [S]HE CREATING A NEW UFD?
JMP CRFUFZ /YES
IAC
CRFSEG, TAD SEGLIM /STORE SEGMENT COUNT IN THE UFDTBL
DCA I UTPRNU
JMP I .+1 /REMEMBER TO WRITE OUT THE TABLES
TABOUT
CRFUFZ, TAD CRF11
JMS I SCL01 /WRITE OUT DIRECTORY BLOCK & CLEAR NEW UFD BLBOCK
JMP I FIEXIT /DON'T MODIFY THE MFD'S ENTRY IN THE UFDTBL
CRF20, STL RTR /DISK FULL
STL RTR
DCA FIUSAC /SAVE PARTIAL ERROR CODE
CRF51, JMS CRF40 /GET FIRST ENTRY BACK AGAIN
DCA I CRBUFP /ZERO OUT THE -1 WE PUT THERE
DCA BUFMOD /SCHEDULE WRITE
CRF1, CLA CLL CML RTR
CLL CML RAR
TAD FIUSAC /GET PARTIAL ERROR CODE
DCA FIUSAC /SAVE ERROR CODE; EITHER DISK FULL OR DIRECTORY FULL
JMP CRFSEG /GO SAVE SEGMENT COUNT ANYWAY
CRF30, CLA CLL CML RTR
CRF10, TAD C4400
DCA FIUSAC /SAVE ERROR CODE; EITHER FILE IN USE OR BAD FILE NAME
JMP I FIEXIT
CRF40, 0
TAD FIOSTK
JMS I GE01
CRF4, 0
DCA CRBUFP
JMP I CRF40
CRPROT, 12
CRGD11, GD1
CRENS, ENS0
SAVCRA, SAVCRE
SCL01, SCL0
CRFUFA, CRFUFD
CRBUFP, 0
/ROUTINE TO EXTEND A FILE
*1400
EXT0, JMS EXT1 /MAKE SURE IT'S OKAY TO EXTEND THIS FILE
TAD P0007 /...EXT1 RETURNS WITH PTR TO NAME BLOCK FOR THIS FILE
DCA EXBUFP /SAVE POINTER TO RETRIEVAL CHAIN
JMS I EXTQUA /CHECK THE DISK QUOTA FOR THIS USER
/NOW TRACE THROUGH TO LAST RETRIEVAL INFORMATION BLOCK FOR THIS FILE
EXT4, TAD I EXBUFP
SNA /END OF CHAIN?
JMP EXT3 /YES
DCA EXWNDP /WINDOW POINTER
TAD EXWNDP
JMS EXGE0 /GET WINDOW INTO CORE
DCA EXBUFP /SAVE POINTER TO NEXT RETRIEVAL WINDOW
JMP EXT4 /KEEP LOOKING FOR END
EXT3, TAD C7771
DCA EXT1 /7 SEGS PER WINDOW
EXT5, ISZ EXBUFP
TAD I EXBUFP /PICK UP ENTRY IN WINDOW
SNA CLA /IS IT THE FIRST FREE?
JMP EXT7 /YES, FIND A SEGMENT
ISZ EXT1 /END OF WINDOW?
JMP EXT5 /NO, KEEP LOOKING
EXT9, TAD GDRETP /RETRIEVAL POINTER
JMS I DE01 /FIND AN EMPTY ENTRY
JMP EXT20 /PARTIALLY SATISFIED
DCA EXNFRE /FREE SEGMENT ADDRESS
TAD EXWNDP /CURRENT WINDOW POINTER
JMS EXGE0 /GET IT INTO CORE
DCA EXBUFP
JMS I SATL1 /GET A FREE DISK SEGMENT FOR THE NEXT WINDOW
SNA
JMP EXT20 /THERE ARE NONE; AVOID LINKING TO NEXT WINDOW
DCA EXPROP /SAVE UNTIL WINDOWS ARE LINKED UP
TAD EXNFRE /NEXT FREE WINDOW
DCA I DXBUFP /LINK IT ONTO CHAIN
DCA BUFMOD /SCHEDULE WRITE
TAD EXNFRE
DCA EXWNDP /UPDATE CURRENT WINDOW POINTER
TAD EXWNDP
JMS EXGE0 /GET NEW WINDOW INTO CORE
IAC
DCA EXBUFP /POINTER TO FIRST ENTRY OF NEW WINDOW
TAD C7771 /ALLOW 7 ENTRIES IN NEW WINDOW
DCA EXT1
TAD EXPROP /GET DISK SEGMENT
EXT12, DCA I EXBUFP /STORE SEGMENT IN RETRIEVAL WINDOW
DCA BUFMOD /SCHEDULE WRITE
ISZ I EXQ1 /INCREMENT TOTAL COUNT IN UFDTBL
ISZ EXBUFP /INCR WINDOW POINTER
ISZ EXSEGC /HAVE WE EXTENDED FAR ENOUGH?
JMP EXT6 /NO
EXT20, TAD EXSEGC
CIA
DCA FIUSAC /NUMBER OF SEGMENTS WE FAILED TO FIND
TAD FIOSTK+1 /REQUEST IS SATISFIED
JMS I GD01 /GET DIRECTORY ENTRY INTO CORE
TAD C0005
DCA EXBUFP /POINTER TO SEGMENT COUNT
TAD FIOSTK+2 /NUMBER OF WORDS TO BE ADDED
TAD I EXBUFP /NUMBER ALREADY IN FILE
TAD EXSEGC /MINUS NUMBER WE FAILED TO GET
DCA I EXBUFP /UPDATE ENTRY
DCA BUFMOD /SCHEDULE WRITE
JMP I .+1 /EXIT AND WRITE OUT TABLES
TABOUT
EXT6, ISZ EXT1 /END OF CURRENT WINDOW?
SKP /NOT YET
JMP EXT9 /YES, TRY LINKING TO ANOTHER
EXT7, JMS I SATL1 /GET A FREE SEGMENT FROM SAT
SNA
JMP EXT20 /PARTIALLY SATISFIED
JMP EXT12 /SAVE NEW SEGMENT
EXGE0, 0 /GET WORD OF THIS UFD INTO CORE
DCA EXGE1
TAD GDRETP
JMS I GE01
EXGE1, 0
JMP I EXGE0
EXT30, TAD C4400
JMP EXT10+2
EXT10, CLL CML RAR
CLL CML RAR
DCA FIUSAC
JMP I FIEXIT
EXTQUA, EXTQU0
EXFCBP, 0
EXPROP, 0
EXBUFP, 0
EXWNDP, 0
EXSEGC, 0
EXNFRE, 0
/ROUTINE TO SET UP TO ALTER A FILE (BY EITHER EXTENDING IT OR
/REDUCING IT). CHECK PROTECTION CODE TO SEE IF THIS IS ALLOWED. MAKE SURE
/NO ONE ELSE HAS THIS FILE OPEN. JMP TO ERROR EXIT ON EITHER OF THESE CON-
/DITIONS. IF ALL IS OKAY. RETURN WITH PTR TO UFD NAME BLOCK ENTRY
EXT1, 0
JMS I IFN01 /MASK OFF BITS 0-9 OF FIOSTK+1
TAD FIOSTK+1 /INTERNAL FILE NUMBER
JMS I LNK01 /GET PTR TO APPROPRIATE FILE CONTROL BLOCK
SNA
JMP EXT10+1 /ERROR, FILE NOT OPEN
DCA EXFCBP /FILE CONTROL BLOCK POINTER
JMS I ACC01 /AS [S]HE UNDER ACCOUNT1?
JMP EXT2 /YES; SKIP PROTECTION CHECK
TAD FILPRP /GLOBAL TO "FILPRO"
TAD EXFCBP
DCA EXPROP /POINTER TO PROTECTION BIT
DATFLD /CDF FIELD 1
TAD I EXPROP /PICK UP PROTECTION BIT
CFLD /CHANGE TO CURRENT FIELD
AND P0004 /STRAIN OFF ANY EXTRANEOUS BITS
SZA CLA
JMP EXT10 /WRITE PROTECTED
EXT2, TAD FIOSTK+1 /INTERNAL FILE NUMBER
JMS I GD01 /GET DIRECTORY ENTRY INTO CORE
DCA REL6 /POINTS TO WHERE UFD NAME BLOCK IS IN CORE
JMS I ENR01 /IS THIS THE ONLY USER WHO HAS THIS FILE OPEN?
JMP EXT30 /NO, SO ABORT AND RETURN ERROR CODE
TAD FIOSTK+2 /ARE ANY SEGMENTS INVOLVED?
SNA
JMP I FIEXIT /NO, NOTHING TO DO THEN
CIA
DCA EXSEGC /SAVE NEGATIVE COUNT
DATFLD
TAD I EXFCBP /GET POINTER TO CURRENT WINDOW
DCA EXPROP
IAC
DCA I EXPROP /INVALIDATE THE WINDOW
CFLD
TAD REL6
JMP I EXT1
/ROUTINE TO REDUCE A FILE
*1600
RED0, JMS I EXT11 /MAKE SURE IT'S OKAY TO REDUCE THIS FILE
DCA REBUFP /...IF OKAY, RETURNS WITH PTR TO FILE NAME BLOCK
JMS I ACC01 /IS [S]HE UNDER ACCOUNT 1?
JMS I REDUFD /SEE IF [S]HE'S REDUCING A UFD
TAD REBUFP
TAD C0005
DCA RELINK /NOW POINTS TO NUMBER OF SEGMENTS PRESENTLY IN FILE
TAD FIOSTK+2 /SEGMENTS TO BE REMOVED
SPA /IS IT NEGATIVE?
JMP RED5 /YES; DELETE THE ENTIRE FILE
CIA
TAD I RELINK
SMA SZA /DELETE THE FILE?
JMP RED6 /NO, REDUCE IT
RED5, CLA CLL /YES, WIPE IT OUT AND CLOSE
TAD REBUFP
JMS RED1 /WIPE OUT THE FILE NAME BLOCK FROM THE UFD
TAD FIOSTK+1 /INTERNAL FILE NUMBER
JMS I CL01 /CLOSE THIS FILE SINCE IT NO LONGER EXISTS
JMP I FIEXIT
RED6, DCA I RELINK /UPDATE SEGMENT COUNT
DCA BUFMOD /SCHEDULE WRITE
TAD I RELINK
DCA CFH
ISZ RELINK
ISZ RELINK
TAD I RELINK
DCA RELINK /POINTER TO FIRST WINDOW ON CHAIN
TAD CFH
JMS RED40 /WIPE OUT REST OF FILE
JMP I FIEXIT
REDGD1, GD1
RED40, 0
JMS I WND201 /DIVIDE BY 7
CMA
DCA REWNDC /NUMBER OF WHOLE WINDOWS WHICH ARE TO REMAIN
TAD RELINK /GET POINTER TO FIRST RETRIEVAL WINDOW
JMS I RED302 /ROUTINE TO DO ACTUAL REDUCTION
JMP I RED40
EXT11, EXT1
LINK01, LINK0
RED302, RED30
REDUFD, REDUF0
REBUFP, 0
/ROUTINE TO DELETE A FILE
UFBUFP,
RED1, 0
DCA REBUFP /PTR TO THE UFD ENTRY FOR THE FILE
TAD REBUFP
TAD P0003
DCA RELINK /LINK TO NEXT FILE NAME IN THIS UFD
TAD I RELINK
DCA RED3
TAD I REDGD1 /UFD ADDR OF THIS DIRECTORY ENTRY
DCA RED4
TAD REBUFP
TAD P0007
DCA RELINK /NOW POINTS TO A RETRIEVAL BLOCK FOR THIS FILE
TAD I RELINK
DCA RELINK
RED2, DCA I REBUFP /CLEAR OUT FIRST WORD OF ENTRY
ISZ REBUFP
TAD REBUFP
AND P0007
SZA CLA /END OF CURRENT WINDOW?
JMP RED2 /NO, KEEP CLEARING
DCA BUFMOD /SCHEDULE WRITE
JMS I LINK01
RED4, 0 /UFD ADDR OF THIS DIRECTORY ENTRY
RED3, 0 /UFD ADDR OF DIRECTORY ENTRY WHICH IS NEXT IN THE CHAIN
JMS RED40 /GO WIPE OUT ACTUAL FILE
JMP I RED1
/ROUTINE TO EXTEND A UFD
/CALLING SEQUENCE:
/ TAD (RETRIEVAL POINTER)
/ JMS UFD0
/ ERROR RETURN
/ NORMAL RETURN
UFD0, 0
DCA UFRETP /RETRIEVAL POINTER
TAD C7771
DCA CFH /COUNTER FOR OVERSIZE UFD
/NOW SCAN DOWN THE UFD'S FILE RETRIEVAL BLOCK
UFD2, TAD I UFRETP
SNA CLA
JMP UFD1 /FOUND THE END OF THE LIST OF SEGMENT NUMBERS
ISZ UFRETP /POINT TO NEXT SEGMENT NUMBER
ISZ CFH /UFD ALREADY MAXIMUM SIZE?
JMP UFD2 /NO, LOOK AT NEXT WORD
JMP I UFD0 /YES, ERROR RETURN
/COMES HERE WHEN IT HAS FOUND THE END OF THE RETRIEVAL BLOCK'S LIST OF SEGMENTS
UFD1, JMS I SATL1 /GET A FREE SEGMENT FROM SAT
SNA
JMP I UFD0 /NO MORE FREE SEGMENTS
DCA I UFRETP /ADD TO RETRIEVAL INFORMATION
TAD UFRETP
JMS I ENS31 /CONVERT ABS RETTBL PTR TO A RELATIVE ENTRY NUMBER
CLL RTL /...TIMES FOUR
TAD UFDTBL /...PLUS BASE ADDR OF UFDTBL
DCA CFH /POINTER TO PROJ,PROG NUMBER OF FILE OWNER
TAD I CFH /PICK UP PROJ,PROG NUMBER
JMS I UFO61 /GO GET THE RETRIEVAL INFO FOR THIS GUY'S UFD INTO CORE
JMP I DIRBAD /*************DEBUG ONLY***********
DCA UFBUFP /PTR TO RETRIEVAL INFORMATION
ISZ UFBUFP
TAD I UFBUFP
SZA CLA /SCAN TO END OF LIST OF SEGMENT NUMBERS
JMP .-3
TAD I UFRETP /GET NUMBER OF NEW SEGMENT
DCA I UFBUFP /PUT IT IN RETRIEVAL BLOCK LIST
DCA BUFMOD /SCHEDULE WRITE
STA
DCA TABSTA /SET TABLE STATUS TO CHANGE
TAD I UFRETP /NEW SEGMENT NUMBER
JMS SCL0 /ZERO OUT THE NEW SEGMENT
ISZ UFD0 /SET UP NORMAL RETURN
JMP I UFD0
ENS31, ENS3
UFO61, UFO6
/ROUTINE TO ZERO OUT A DISC SEGMENT
/IT ZEROES THE CORE BUFFER THEN EXECUTES A CALL
/TO RD301 (THE ACTUAL READ NEVER HAPPENS).
/THUS, THE SYSTEM THINKS THAT THE SEGMENT BEING
/CLEARED IS ACTUALLY IN CORE. IT WILL BE WRITTEN OUT LATER.
SCL0, 0
DCA UFRETP /SEGMENT NUMBER
JMS I WRT1 /MAKE SURE THE BUFFER IS EMPTY
TAD P7400
DCA CFH /SET UP COUNTER FOR CLEARING SEGMENT
TAD BUFFER
DCA UFBUFP
UFD3, DCA I UFBUFP /START TO CLEAR BUFFER AREA
ISZ UFBUFP
ISZ CFH
JMP UFD3
STA
TAD UFRETP /SEGMENT NUMBER
JMS I SCL11 /NOW FAKE A READ
DCA BUFMOD /SCHEDULE WRITE
JMP I SCL0
RELINK,
UFRETP, 0
SCL11, SCL1
P7400, 7400
/ROUTINE TO PROVIDE FILE INFORMATION
*2000
INF0, JMS I IFN01 /GET INTERNAL FILE NUMBER IN FIOSTK+1
TAD FIOSTK+1 /INTERNAL FILE NUMBER
JMS I EBLD0
DCA CFH /RELATIVE POINTER TO UFD RETRIEVAL INFORMATION
TAD I CFH /GET PTR TO RETTBL OUT OF ENTTBL
SNA /DOES IT EXIST?
JMP INF1 /NO, SO FILE IS NOT OPEN
CIA
CLL CMA RTL /SUBTRACT ONE; MULTIPLY BY FOUR
TAD UFDTBL
DCA INUFDP /POINTER TO USER PROJ,PROG NUMBER
TAD I INUFDP
DCA FIOSTK+2 /SET UP LINKAGE FOR GD0
TAD FIOSTK+1 /INTERNAL FILE NUMBER
JMS I GD01 /GET DIRECTORY ENTRY FOR THIS FILE INTO CORE
CIA
CMA
DCA INDEX /SET UP INDEX REGISTER FOR TRANSFER
TAD I INDEX /OF NAME AND OTHER DIRECTORY INFORMATION
DCA FIOSTK+3
TAD I INDEX
DCA FIOSTK+4
TAD I INDEX
DCA FIOSTK+5
ISZ INDEX
TAD I INDEX
DCA FIOSTK+6
TAD I INDEX
DCA FIOSTK+7
INF5, DATFLD
TAD I FIOPTR /PICK UP JOBLNK WORD FROM JOB STATUS BLOCK
DCA INF4 /DESTINATION IN FIELD 0
CFLD /CHANGE TO PRESENT FIELD
6202 /CIF FIELD 0
BLT /MOVE FIOSTK INFORMATION INTO IOT PARAMETER BLOCK
6221 /SOURCE FIELD
FIOSTK /SOURCE
DATFLD /DESTINATION FIELD
INF4, 0 /DESTINATION
-10 /WORD COUNT
INF6, CDF
TAD I OURFLD
AND C0200
SZA CLA
JMP I FIEXIT /WE WERE CALLED BY SI - DON'T SET JSIOTC OR WE'LL GAG
DATFLD
TAD I JOBDAT /GLOBAL TO "JOBDAT"
IAC
DCA INSPTR /NOW POINTS TO STATUS WORD
TAD INIOTC /JSIOTC
CMA
AND I INSPTR /SET JSIOTC TO INDICATE THAT FIP
TAD INIOTC /...IS RETURNING INFORMATION IN THE IOT PAR. BLOCK
DCA I INSPTR
JMP I FIEXIT /EXIT
INF1, DCA FIOSTK+2
JMP INF5
INUFDP, 0
INSPTR, 0
OURFLD, CORTBL+1
INIOTC, 40
/ROUTINE TO SKIP IF CALLING USER IS NOT SYSTEM MANAGER
ACT01, 0
JMS I JBLD0 /GET PPN
CLL RAR
SZA CLA /IS IN ACCOUNT 1?
ISZ ACT01 /NO; SKIP ON RETURN
JMP I ACT01
/LOGIN ROUTINE
LGI0, TAD RETTBL /MFD RETRIEVAL IS IN ENTRY 0
DCA FIOSTK+1 /SET UP PTR TO RETRIEVAL INFORMATION CONTAINED IN RETTBL
TAD FIOSTK+2 /ACCOUNT #0
SNA CLA
JMP LGI20 /UNAUTHORIZED ACCOUNT
JMS I DS01 /SEARCH THE MFD (AC=0 TO INDICATE 3-WORD SEARCH)
FIOSTK+1 /ADDR OF PTR TO RETRIEVAL INFORMATION OF DIRECTORY TO BE SEARCHED
JMP LGI20 /COULD NOT FIND ENTRY IN MFD
DCA LGMFDP /OK TO LOG IN - POINTER TO DIRECTORY ENTRY IS IN ACC.
TAD FIOSTK+2 /PROJ,PROG NUMBER
JMS I UTS01 /SEARCH THE UFD TABLE
SKP /THIS PROJ,PROG NUMBER NOT THERE
JMP LGI1 /UFD ALREADY ON TABLE - RETURNS WITH ITS RELATIVE POSITION IN TABLE
TAD FIOSTK+2 /PROJ,PROG NUMBER
JMS I UFO01 /OPEN THE UFD - I.E. MAKE AN ENTRY IN UFDTBL, RETTBL
JMP LGI20 /COULD NOT FIND ROOM ON TABLE
LGI1, CLA CMA
TAD I UTPRNU
DCA I UTPRNU /ACCOUNT FOR NEW ENTRY IN ACCESS COUNT
/COMES HERE WHEN THE UFDTBL & RETTBL HAVE BEEN UPDATED
/TO INCLUDE THIS LOGIN
FGETJT
JOBSTS
DCA LGI3 /ADDRESS OF STR0
TAD FIOSTK+2 /ACCOUNT NUMBER?
AND C7774 /IS IT LESS THAN 4?
SNA CLA
TAD C0200 /YES - SET ACCOUNT PRIVILEGE BIT
DATFLD
DCA I LGI3 /AND SAVE IT
JMS I JBLD0
CLA
TAD FIOSTK+2 /PROJ,PROG NUMBER
JMP I .+1
RESET
LGI20, CFLD
CLA CMA /COULD NOT LOGIN - RETURN WITH 7777
DCA FIUSAC /INDICATE INABILITY TO LOG IN
JMP I FIEXIT
GTB1,
LGMFDP, 0
/DIRECTORY SEARCH
/CALLING SEQUENCE:
/ CLA OR CIA (3 OR 1 WORD SEARCH)
/ JMS DS0
/ POINTER-----------------RETRIEVAL STACK POINTER
/ RETURN IF NOT FOUND NA
/ GOOD RETURN ME
/ (POINTER IN AC) XX
*2200
DS0, 0
SNA CLA /SKIP IF ONE WORD SEARCH
CLL CML RTL /THREE WORD COMPARE
CMA
DCA DSWDNR /MINUS NUMBER OF WORDS TO COMPARE
TAD I DS0 /PICK UP POINTER TO RETRIEVAL INFORMATION
DCA DSRETS
ISZ DS0
TAD DSM160 /SET UP COUNTER ON # ENTRIES CHECKED
DCA DSKCNT
TAD I DSRETS /GET RETRIEVAL POINTER
CIA
TAD RETTBL
SNA CLA
STA /INHIBIT SEGMENT COUNTING OF THE MFD
DCA SEGLIM /ZERO SEGMENT COUNTER
DS2, DCA DS1
TAD I DSRETS /GET PTR TO RETRIEVAL INFORMATION BLOCK
JMS I GE01 /GET THE ENTRY INTO CORE
DS1, 0 /WORD NUMBER -- I.E. THE ADDR WITHIN THE DIRECTORY
SNA
JMP BADDIR /FOULED-UP DIRECTORY!
DCA DSENTP /STORE POINTER TO ENTRY
TAD C0005
TAD DSENTP
DCA DSCNTR /POINTS TO SEGMENT COUNT
TAD SEGLIM /THE TOTAL FOR THIS UFD
SPA /IS IT A UFD?
JMP DS4 /NO; SEE IF WE SHOULD RESET THE MFD
TAD I DSCNTR /ADD THIS FILE'S COUNT
DCA SEGLIM /SAVE NEW TOTAL
DS3, TAD DSWDNR /NUMBER OF WORDS TO COMPARE
DCA DSCNTR
TAD DSRETS
DCA DSOBJT /POINTER TO OBJECT NAME
TAD DSENTP
DCA DSENT /POINTER TO NAME IN BUFFER
DSCOM2, TAD I DSENT
ISZ DSENT
CIA
ISZ DSOBJT
TAD I DSOBJT
SZA CLA
JMP DSCOM1 /NOT FOUND
ISZ DSCNTR
JMP DSCOM2 /LOOK AT NEXT WORD OF NAME
ISZ DS0 /FOUND THE ENTRY
TAD DSENTP /PICK UP POINTER
JMP I DS0 /RETURN
/THIS ENTRY IS NOT THE ONE WE'RE LOOKING FOR, SO WE MUST
/GO LOOK AT THE NEXT ONE. IN THIS ENTRY IS A RELATIVE PTR TO THE NEXT ONE
/GET IT.
DSCOM1, ISZ DSKCNT /BAD DIRECTORY?
JMP DSCOM3 /IT ISN'T BAD AT THIS POINT
BADDIR, DCA RESFLG /CLEAR AC AND RESET FLAG
TAD P5400 /YES, INDICATE BAD DIRECTORY AND GET OUT
DCA FIUSAC /ONCE AGAIN, GOODNESS TRIUMPHS OVER EVIL
JMP RETURN /GO CLEAN UP BEFORE ABORTING
DSCOM3, TAD P0003 /CREATE POINTER TO NEXT ENTRY
TAD DSENTP
DCA DSCNTR
TAD I DSCNTR
SZA /IS THIS THE END OF THE DIRECTORY CHAIN?
JMP DS2 /NO, SO CONTINUE SEARCH
TAD P0003
TAD DS1
JMP I DS0
DS4, TAD RESFLG /SHOULD WE RESET?
SZA CLA
JMP DS3 /NO
DCA I DSCNTR /CLEAR CPU TIME ACCUMULATOR
ISZ DSCNTR
DCA I DSCNTR /CLEAR DEVICE TIME ACCUMULATOR
DCA BUFMOD /REMEMBER TO WRITE IT BACK
JMP DS3
DSWDNR, 0
ENRETP,
DSRETS, 0
ENADDR,
DSENTP, 0
DSOBJT, 0
DSENT, 0
DSM160, -161 /-MAXIMUM # FILES USER CAN OWN (+2)
/RETURN A BLOCK OF FREE CORE
RESFLG,
RETBKS, 0
CFLD
CIF
RETBLK
JMP I RETBKS
/RETURN A LINKED LIST OF FREE BLOCKS
ENTPTR,
DSKCNT,
RETBLS, 0
SNA
JMP I RETBLS
JMS RETBKS
JMP .-3
/SEARCH ENTTBL FOR OPENINGS TO FILE
/CALLING SEQUENCE:
/ TAD (RETRIEVAL POINTER)
/ JMS ENS0
/ UFD ADDRESS OF DIRECTORY ENTRY
/ RETURN - FOUND AN ACCESS
/ RETURN - FOUND NO ACCESS
DSCNTR,
ENS0, 0
JMS I ENS30
DCA ENRETP /RELATIVE POINTER
TAD I ENS0 /GET FILE DIRECTORY ADDRESS
CIA
DCA ENADDR
ISZ ENS0 /SKIP PAST ARG
TAD ENTTBL
DCA ENTPTR
ENS2, TAD ENRETP
CMA
TAD I ENTPTR
ISZ ENTPTR
SZA CLA
JMP ENS1 /DIFFERENT UFD ACCESS
TAD I ENTPTR /SAME UFD, SAME FILE?
TAD ENADDR
SZA CLA
JMP ENS1 /DIFFERENT FILE
TAD FIOSTK /WHICH IOT BROUGHT US HERE?
TAD ENSCRF /IF IT'S "CRF" ONE MATCH IS ENOUGH
SNA CLA
JMP I ENS0 /IT WAS; GET OUT
TAD FIOSTK+1 /FOUND A SIMILAR ENTRY
JMS I EBLD0 /SEE IF WE FOUND THE ENTRY FOR
CMA /THE GUY WHO CAUSED THE CALL TO
TAD ENTPTR /ENS0; IF IT IS, IGNORE THIS MATCH
SZA CLA
JMP I ENS0 /FOUND A SIMILAR ENTRY; DIFFERENT ENTTBL ENTRY
ENS1, ISZ ENTPTR
TAD ENTPTR
CIA
TAD ENTEND /END OF ENT TABLE
SZA CLA
JMP ENS2 /KEEP LOOKING
ISZ ENS0 /SKIP ON RETURN
JMP I ENS0
ENS30, ENS3
ENSCRF, -CRF
/ROUTINE TO LOOK IN THE SAT FOR A FREE SEGMENT
/CALLING SEQUENCE:
/ JMS SATLOK
/ RETURN (SEGMENT NUMBER IN AC, 0=NONE AVAILABLE)
*2400
SATLOK, 0
CLA CMA CLL RAL /7776
DCA SATMSK /MAKE TWO PASSES OF THE TABLE
TAD I SATCNT /# OF AVAILABLE DISC SEGMENTS
SNA /ARE THERE ANY?
JMP I SATLOK /NO, SO FORGET IT
CIA
CMA
DCA I SATCNT /DECREMENT SATCNT
DCA SATCT2
CLA CMA
DCA SATSTA /SET SAT STATUS TO WRITE OUT
/LOOK FOR A WORD IN SAT TABLE WITH A ZERO BIT IN IT
SAT1, TAD I SATPNT /GET A WORD FROM SAT TABLE
CMA
SZA CLA /ARE ALL BITS SET TO ONE?
JMP SAT2 /NO, SO WE'VE FOUND A SEGMENT
ISZ SATPNT /WAS THIS THE LAST WORD IN THE SAT TABLE?
JMP SAT1 /NO, SO KEEP LOOKING
TAD SAT5 /START LOOKING FROM THE BEGINNING
DCA SATPNT /PTR INTO SAT TABLE
ISZ SATMSK
JMP SAT1 /MAKE 1 MORE PASS
DCA I SATCNT /SOMETHING WRONG.. BETTER AVOID L2Q OVERFLOW
/BY SAYING NO SEGMENTS AVAILABLE
JMP I SATLOK
SAT5, -SATSIZ+2
/WE FOUND A SAT WORD WITH A ZERO BIT. NOW FIND THAT BIT.
SAT2, CLL CML RAR /4000 INTO ACC.
DCA SATMSK
ISZ SATCT2
TAD I SATPNT /GET WORD FROM SAT TABLE
AND SATMSK /IS THE BIT CORRESPONDING TO THE ONE IN SATMSK SET?
SNA
JMP SAT3 /NO, SO WE FOUND THE ZERO BIT
RAR /MOVE MASK BIT ONE TO THE RIGHT
JMP SAT2+1 /...AND LOOK AT THE NEXT BIT
/FOUND THE BIT WITHIN THE WORD - SATCNT INDICATES WHICH ONE IT IS
SAT3, TAD SATMSK
TAD I SATPNT
DCA I SATPNT /SET THE BIT IN SATTBL TO INDICATE THAT THIS SEGMENT IS NOW ALLOCATED
TAD SATPNT
TAD C0526
DCA SATMSK
/NOW CALCULATE THE NUMBER OF THE DISC SEGMENT
/WHICH CORRESPONDS TO THIS BIT IN THE SAT TABLE
TAD SATMSK
CLL RAL
TAD SATMSK
RTL
TAD SATCT2
JMP I SATLOK /EXIT WITH DISC SEGMENT NUMBER IN AC
SATPNT, -SATSIZ+2
SATCNT, -SATSIZ+1
SATEMP,
SATCT2, 0
SATMSK, 0
/ROUTINE TO RELEASE A SEGMENT IN SAT
/CALLING SEQUENCE:
/ TAD (SEGMENT NUMBER)
/ JMS SATREL
/DIVIDE SEGMENT NUMBER BY 14 (12 DECIMAL)
/QUOTIENT INDICATES WHICH WORD IN SAT TABLE CORRESPONDS
/TO THIS DISC SEGMENT. REMAINDER INDICATES WHICH BIT IN
/THAT WORD.
SATREL, 0
TAD P2000 /SUBTRACT 14 X 400
SZL /WAS THE SEGMENT THAT BIG?
JMP .+3 /YES
TAD P6000 /NO, ADD 14 X 400
CLL /UN-DO THE LINK
RAL /SHIFT OUT A BIT OF THE QUOTIENT
ISZ CFH
JMP SATREL+1 /MORE TO DO YET
DCA SATPNT /REMAINDER IN LINK THRU AC2; QUOTIENT IN AC3 THRU AC11
TAD SATPNT
AND P7000
RTL
RTL
CMA /NEGATE THE REMAINDER
DCA SATEMP
TAD SATPNT
AND P0777 /JUST THE QUOTIENT THIS TIME
TAD SAT5
DCA SATPNT
CLL CMA
RAR
ISZ SATEMP /SET UP A MASK CORRESPONDING TO PROPER BIT
JMP .-2
AND I SATPNT /CLEAR SAT TABLE BIT; SEGMENT IS NOW AVAILABLE
DCA I SATPNT
ISZ I SATCNT /UPDATE THE AVAILABLE SEGMENTS COUNT
CLL STA
DCA SATSTA /REMEMBER WE CHANGED THE SAT TABLE
JMP I SATREL
/ACTUAL I/O ROUTINE
/SET UP ALL I/O PARAMETERS IN #FLPARB#, AND JMS FIPIO
FIPIO, 0
TAD FIPFLD
RAR
DCA FLPARB+2 /='S FIELD WE'RE IN TIMES 4
CDF
TAD I JOB
AND C0400 /FIP OR SI CORTBL BIT ON?
SNA CLA
JMP .+3 /SI
TAD FIJOB
DCA I FIPJOB /FIP - KEEP HIGH PRIORITY ON THE SCHEDULER
TAD FIRETP /POINTER TO FIORET
DCA 1 /RETURN ADDRESS - SET TO RETURN BELOW WHEN FIP IS RESTARTED
TAD FIO3 /GET FIPBLK
DATFLD
DCA I FIUTBA
CFLD
CIF 00
BLT /MOVE DISC TRANSFER PARAMETERS INTO FREE BLOCK LINKED TO DSUTBL
CFLD /FIP ALWAYS IN FIELD 2
FLPARB /PARAMETER BLOCK
DATFLD /DESTINATION FIELD
FIO3, FIPBLK /DESTINATION
-10 /WORD COUNT
CDF CIF 00
ISZ I DSBUSY /GLOBAL TO "DSBUSY"
WAIT /DISK BUSY
JMP I OVER /GO TO FIELD 0 TO INITIATE THE TRANSFER
/MONITOR RETURNS CONTROL HERE AFTER COMPLETING THE TRANSFER
FIORET, CLA /RETURNS FROM DISC I/O COME HERE
TAD C0200 /RESET THE FIP STARTING ADDRESS
DCA 1 /... TO 0200
FGETJT
JOBSTS
DATFLD
DCA FIPTR1
TAD I FIPTR1 /PICK UP #JOBSTS#
CFLD /CHANGE TO CURRENT FIELD
TAD P0003
AND P0007 /CHECK ERROR BITS
SZA CLA
ISZ FIPIO /NO DISC TRANSFER ERROR
JMP I FIPIO /EXIT WITHOUT SKIPPING TO INDICATE DISC TRANSFER ERROR
FIPTR1, 0
FIUTBA, DSUTBL+4+4
FIRETP, FIORET
C0526, 0526
OVER, OVRLA1
/ROUTINE TO GET A DIRECTORY WORD INTO CORE
/CALLING SEQUENCE:
/ TAD (POINTER TO RETRIEVAL INFORMATION)
/ JMS GE0
/ WORD NUMBER
/ RETURN (BUFFER POINTER IN AC. 0 IF NON-EXISTENT)
*2600
GE0, 0
DCA GERETP /STORE RETRIEVAL INFORMATION POINTER
TAD I GE0
CLL RAL
RTL
RTL
AND P0007
TAD GERETP
DCA GERETP
TAD I GERETP
SNA
JMP GE3
CIA
CMA
DCA RDTEMP
/FILE READ ROUTINE, CHECKS TO SEE IF BUFFER IS FULL.
/IF SO, IS IT THE SEGMENT WE ARE TRYING TO READ?
/IF YES, LEAVE. IF NO, WRITE OUT THE BUFFER
/BEFORE READING THE PROPER SEGMENT.
TAD RDCURR /MAY THE DESIRED SEGMENT ALREADY BE IN THE BUFFER
CIA
TAD RDTEMP
SNA CLA
TAD BUFSTA /PROBABLY; IS THE DATA STILL VALID?
SPA
JMP RD3 /YES
SNA /MAYBE
JMS I WRT1 /WRONG SEGMENT, SO WRITE IT OUT (IF MODIFIED)
DCA BUFSTA /SAVE BUFFER STATUS
TAD RDTEMP
JMS RD30 /SET UP PARAMETERS FOR A READ OPERATION
TAD BUFSTA /WAS THE CORRECT DATA IN THE BUFFER AFTER ALL?
SZA CLA
JMP RD3 /YES; ONLY NEEDED TO SET THE DISK PARAMETERS
JMS I FIO01 /PERFORM THE READ
JMP I DIRBAD /ERROR ON READ
IAC
DCA BUFMOD /NEW DATA AS YET UNCHANGED
RD3, CLA CMA
DCA BUFSTA /SET BUFFER STATUS TO FULL
TAD C0377
AND I GE0 /ADDRESS WITHIN SEGMENT
TAD BUFFER /CREATE A POINTER
GE3, ISZ GE0
JMP I GE0 /RETURN
GERETP, 0
RDTEMP, 0
RDCURR, 0
K7400, 7400
C0377, 0377
/ROUTINE TO DIVIDE A NUMBER BY 7
/REMAINDER IS LEFT IN WNDREM, PAGE 0
WND20, 0
DCA WNDREM
DCA CFH
TAD WNDREM
WND24, TAD C7771
SPA
JMP WND21
ISZ CFH
JMP WND24
WND21, TAD P0007
DCA WNDREM
TAD CFH
JMP I WND20
/ROUTINE TO SET UP FOR A READ.
/ENTER WITH SEGMENT NUMBER. THIS IS CONVERTED TO
/A PHYSICAL DISC ADDRESS.
RD30, 0
DCA RDCURR /SAVE SEGMENT NUMBER
TAD RDCURR
CLL RTR
RTR
DCA RDTEMP
TAD RDTEMP
RAR
AND K7400
DCA FLPARB+5
TAD RDTEMP
AND C0377
TAD FIBASE
CLL RTL
DCA FLPARB+1
CFLD /CHANGE TO CURRENT FIELD
TAD K7400
DCA FLPARB+3 /WORD COUNT (ONE BUFFER)
CLA CMA
TAD BUFFER
DCA FLPARB+4 /CORE ADDRESS
TAD C0603 /READ IOT
DCA FLPARB
JMP I RD30
FIPFIP= C0400
FIX301, FIX30
C5600, 5600
USENAM, 0 /CALLED ONLY ONCE BY RE-NAME ROUTINE
TAD FIOSTK+1 /TO SEE IF THE NEW NAME EXISTS IN DIRECTORY
DCA FIOSTK
JMS I JBLD0
JMS I UTS01
JMP I DIRBAD
JMS I BLDP1
DCA FIOSTK+1
JMS I DS01
FIOSTK+1
ISZ USENAM /NO FILE OF THIS NAME FOUND - OK TO RENAME
CLA
JMP I USENAM
NUCOR, CORSRC-2
C7437, SWAP LOCK NOTRUN FIP CJOB
JOBMX, -JOBMAX
FIPLOC, FIPLOK
FIPTIM, TIMFIP
REL1, TAD FIOSTK+1 /RELEASE A DEVICE
SPA /DON'T LET THE USER RELEASE CONSOLES
JMS I REL01
CLA
JMP I FIEXIT
FIX50, TAD I FIOPTR
AND FIPFIP /GLOBAL TO "FIP"
SNA CLA /IF FIP BIT IS NOT SET, FIP WAS CALLED BY SI
JMP I FIX301 /GET THE SYSTEM INTERPRETER BACK INTO CORE
TAD C5600
AND I FIOPTR
DCA I FIOPTR /CLEAR OUT THE LOCK BIT
TAD JOBMX
DCA CFH /SAVE COUNT OF JOBS TO SCAN
STL RTL
TAD I NUCOR
SMA
JMP FIX51
DCA I FIPTIM
TAD C7437
DCA I FIPLOC
FIX51, CLA
DATFLD
TAD FIJOB
TAD DEVOVR
DCA INDEX
FIX50L, TAD INDEX
TAD JEND
SZA CLA
JMP .+3
TAD DEVOVR
DCA INDEX
TAD I INDEX
SZA
JMS I FIX5CK
ISZ CFH
JMP FIX50L
JMP I .+1
FIXOUT
JEND, -JOBTBL-JOBMAX
FIX5CK, FIXSCH
/ROUTINE TO FREE AN ENTRY ON THE UFD TABLE AND RETTBL
/CALLING SEQUENCE:
/ TAD (POSITION ON UFDTBL)
/ JMS TF0
/ RETURN
TF0, 0
DCA TFUFDP /POSITION ON TABLE
DCA I TFUFDP /CLEAR OWNER'S PROJ,PROG NUMBER
TAD UFDTBL /BEGINNING OF TABLE
CIA
TAD TFUFDP
CLL RTR /RELATIVE POSITION ON TABLE
IAC
JMS I BLDP1 /BUILD A PTR TO RETTBL
DCA TFUFDP /POINTER TO RETRIEVAL INFORMATION
TAD P7770 /8 WORDS PER ENTRY
DCA TFCNTR
TF1, DCA I TFUFDP /ZERO OUT THE ENTRY
ISZ TFUFDP
ISZ TFCNTR
JMP TF1
JMP I TF0
TFUFDP, 0
TFCNTR, 0
/ROUTINE TO CHECK WHETHER THE FILE A USER
/IS ATTEMPTING TO ACCESS IS HIS/HERS OR SOMEONE ELSE'S.
/CALLING SEQUENCE:
/ TAD (INTERNAL FILE NUMBER)
/ JMS UC0
/ ERROR RETURN (AC=0 IF FILE NOT OPEN)
/ NORMAL RETURN
UC0, 0
JMS I EBLD0
DCA UCENTP
TAD I UCENTP /PICK UP ENTRY FOR THIS FILE OF THIS USER'S
SNA
JMP I UC0 /FILE NOT OPEN
CIA
CLL CMA RTL /SUBTRACT ONE; MULTIPLY BY FOUR
TAD UFDTBL
DCA UCUFDP /POINTER TO OPEN UFD TABLE
JMS I JBLD0
CIA
TAD I UCUFDP
SNA /SKIP IF DIFFERENT
ISZ UC0 /CORRECT RETURN
JMP I UC0
UCENTP, 0
UCUFDP, 0
/LOGOUT ROUTINE
LGO0, JMS I ACC01 /IS IT FROM ACCOUNT 1?
TAD FIOSTK+1 /YES; SEE IF [S]HE WANTS TO RESET
TAD FIJOB /SEE IF HIS/HER AC=JOB
SNA CLA
JMP I LGRESA /GO CLEAR EVERYBODY'S CPU & DEVICE TIME ACCUMULATORS
TAD FIOSTK+1 /DID [S]HE SET HIS/HER AC= TO HIS/HER JOB #?
CIA
TAD FIJOB
SZA CLA
JMP I LGO1A /NO; SO SEE IF [S]HE WANTS COUNT OF USERS UNDER HIS/HER ACCOUNT
JMS I LNS01 /RELEASE ALL HIS/HER DEVICES
JMP .+3
JMS I REL01
JMP .-3 /KEEP GOING
JMS I CL01 /CLOSE FILE 0
IAC
JMS I CL01 /CLOSE FILE 1
CLL CML RTL
JMS I CL01 /CLOSE FILE 2
TAD P0003
JMS I CL01 /CLOSE FILE 3
JMS I JBLD0
DCA LOSRRI+1 /DELIVER TO CALLING SEQUENCE FOR SEARCH
TAD CFH
DCA LOJOBP
CLA CMA
JMS I DS01 /FIND MFD ENTRY; 1 WORD SEARCH
LOSRRI
JMP I DIRBAD /************DEBUG ONLY***********
TAD C0006
DCA LOSRRI+1 /POINTER TO CP TIME COUNTER
FGETJT
JOBRTM /JOB RUN TIME IN STATUS
DCA FIOSTK+6 /INTS TO LOW ORDER RUN TIME
DATFLD
TAD I FIOSTK+6
RTR
RTR
RTR /USE ONLY HIGH ORDER OF LOW ORDER RUN TIME
AND P0077
DCA FIOSTK+7
ISZ FIOSTK+6
TAD I FIOSTK+6
CFLD /BACK TO THIS FIELD
AND P0077
CLL RTL
RTL
RTL
TAD FIOSTK+7
TAD I LOSRRI+1
DCA I LOSRRI+1 /LOW ORDER TIME UPDATE
DCA BUFMOD /SCHEDULE WRITE