1
0
mirror of synced 2026-04-28 20:57:13 +00:00
Files
lisper.cpus-pdp8/tss8.2/fip.pal
2010-04-02 15:46:14 +00:00

3375 lines
78 KiB
Plaintext
Raw 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.
/FIP VERSION 8.24 (01-JANUARY-75)
/
/
/
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR
/RELIABILITY OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT
/SUPPLIED BY DEC.
/FIP HANDLES ALL NON-RESIDENT FILE IOT'S
/RUNS IN AN UPPER FIELD IN PLACE OF USER IT IS SERVING
/RUNS IN EXEC MODE
FIELD 1 /FIP LOADS ONTO DISK TRACK 1
*0
JMP I .+1
FIP0
LNS01, LNS0
RETBK1, RETBKS
LNK01, LNK0
ZDS1, DS1 /
*10
INDEX, 0 /ONLY REGISTER AVAILABLE IN FIP FOR INDEXING
P5400, 5400
P2000, 2000
P0077, 0077
P0007, 7
FIDEXP, /TO REPLACE FIDEXP, FIPDEX WHERE FIPDEX=4
P0004, 4
FIPFLD, /FIELD WE ARE RUNNING IN
C0020, 20
C002,
FILPRP, FILPRO
FIPDAT= 155 /DATA REFERENCED BY FIP
*FIPDAT
FIPJOB, .
C0400, 400
SEGSIZ= C0400 /# WORDS PER SEGMENT
FIBASE, SWDEX+JOBMAX /BASE ADDRESS OF ALLOCATABLE DISC STORAGE
JOB, . /# OF CURRENT JOB
JOBDAT, . /ADDRESS OF CURRENT JOB DATA LIST. MUST RESIDE IN DATA FIELD.
P7000,
CORTBA, CORTBL-1 /CORE ALLOCATION TABLE
DEVTBA, DEVTBL /DEVICE TABLE
DEVEND, DEVTBE /START OF ASSIGNABLE DEVICE TABLE
DSBUSY, . /DISC BUSY COUNT
/THE DATE IS KEPT AS A 12 BIT NUMBER IN THE FORMAT
/DATE=((YEAR-1974)*12+(MONTH-1))*31+DAY-1
DATE, .
BLTA, BLT0 /BLOCK TRANSFER
BLT= JMS I BLTA
CORSRA, CORSRC
CORE= JMS I CORSRA
GETBA, GETB
GETBLK= JMS I GETBA
GETDBA, GETDB0 /GET A DATA BLOCK
GETDDB= JMS I GETDBA
PRINTA, PRINT0 /TYPE OUT A CHARACTER
PRINT= JMS I PRINTA
GETJT0, GETJTB /GET JOB DATA TABLE ADDRESS
GETJTA= JMS I GETJT0
RETBA, RETB /RETURN BLOCK TO FREE STORAGE
RETBLK= JMS I RETBA
WAITA, WSCHED
WAIT= JMP I WAITA
DEVOVR, JOBTBL /END OF DEVICE TABLE; START OF JOB TABLE
*20
FIUSAC, 0 /SAVED USER AC
FIJOB, 0 /JOB NUMBER FILE PHANTOM IS REPRESENTING
FIOPTR, 0 /POINTER TO FIELD 0 IOT
GDRETP, 0 /RETRIEVAL POINTER, SET BY GD0 ROUTINE
WNDREM, 0 /REMAINDER FROM DIVISION BY 7
BUFSTA, 0 /BUFFER STATUS, 7777 IF FULL
BUFMOD, 1 /BUFFER MODIFIED IF =0; UNCHANGED IF =1
SATSTA, 0 /SATSTATUS, 7777 IF CHANGED THIS RUN
TABSTA, 0 /TABLE STATUS, 7777 IF CHANGED THIS RUN
/POINTERS TO FILE PHANTOM'S INTERNAL TABLES
JOBTAB, JTABLE /TABLE OF PROJ,PROG NUMBERS FOR ALL ACTIVE JOBS
ENTEND, /END OF ENTRY TABLE
UFDTBL, UTABLE /TABLE OF ALL ACCESSED UFD'S
UFDEND, /TOP OF UFD TABLE
RETTBL, RTABLE /TABLE OF RETRIEVAL INFORMATION FOR ALL ACCESSED UUFD'S
ENTTBL, ENTABL-10 /TABLE REFLECTING STATE OF ALL POSSIBLE FILE NUMBERS
BUFFER, 5400 /BUFFER FOR DIRECTORY MANIPULATIONS
SATBOT, -SATSIZ /BOTTOM OF STORAGE ALLOCATION TABLE
/SUBROUTINE POINTERS
DE01, DE0 /GET A DIRECTORY ENTRY
DS01, DS0 /DIRECTORY SEARCH
GE01, GE0 /GET A DIRECTORY WORD INTO CORE
GD01, GD0 /GET A FILE DIRECTORY ENTRY INTO CORE
WRT1, WR1 /MAKE SURE THE BUFFER IS EMPTY
DTE01, DTE0
FIO01, FIPIO /COMMON DISC I/O ROUTINE
SATL1, SATLOK /GET A FREE SEGMENT FROM SAT
TF01, TF0 /FREE AN ENTRY ON UFD TABLE
UC01, UC0 /USER-OWNER FILE CHECK
UFO01, UFO0 /OPEN A UFD
UTS01, UTS0 /SEARCH UFD TABLE FOR PROJ,PROG NUMBER
CL01, CL0 /CLOSE A FILE
WND201, WND20 /DIVIDE BY SEVEN
FIEXIT, FIX0 /EXIT ROUTINE
BLDP1, BLDP /BUILD A POINTER TO ENTTBL
ENR01, ENR0
REL01, REL00
WR01, WR0
GTBLO1, GTBLOK
EBLD0, EBLD
JBLD0, JBLD
FIX401, FIX40
IFN01, IFN0
LGI201, LGI20 /-1 TO USER AC
FGETJT= JMS I .
FGETJ0
DIRBAD, BADDIR
/CONSTANTS
C0006, 6
C0200, 200
P0037, 37
P0003, 3
P6000, 6000
P0777, 777
C0605, 6605
C0005, 5
C0603, 6603
C7774, -4
C4400, 4400
C7771, 7771
P7770, 7770
CFLD= CDF 20 /FIP IS ALWAYS IN FIELD 2
EXQ1,
UTPRNU, 0 /USED BY UTS0 ROUTINE TO HAVE THE PTR TO UFD TABLE WHILE SEARCHING
CFH, 0 /THIS LOCATION IS USED FOR TEMP STORAGE BY MANY ROUTINES
ACC01, ACT01 /SEE IF CALLING USER IS ACCOUNT 1
BASCO1, BASCO0 /SEE IF THE FILE IS BASIC
BASSWT, 0 /SWITCH FOR BASIC
C0010, 10
C7700, 7700
BASWIN, WINBAS /FIELD 1 ADDRESS OF BASIC WINDOW
BAS1A, BAS0 /CREATES A BASIC WINDOW
SEGLIM, 0
REWNDC,
REL6, 0
FIOSTK, 0 /STACK HOLDING IOT LINKAGE
0
0
0
0
0
0
0
FLPARB, 0 /TABLE FOR READ OR WRITE PARAMETER CONSTRUCTION
0
0
0
0
0
OVERLA
0
/ROUTINE TO RELEASE FREE BLOCK, (IF ANY), IF IT IS
/NECESSARY TO ABORT FIP FOR SOME REASON.
RETURN, TAD FIOSTK /GET THE IOT THAT BROUGHT US HERE
CMA /IS THERE A PARAMETER BLOCK?
AND C4010
SZA CLA
JMP I FIEXIT /NONE, OK TO EXIT
DATFLD
TAD I FIOPTR /GET THE BLOCK
JMS I RETBK1 /RETURN IT SO IT WON'T BE LOST FOREVER
CLA
JMP I FIEXIT /NOW IT'S OK TO LEAVE
C4010, 4010 /MASK FOR FINF AND WHO
/FILE PHANTOM START
/FIP'S FIRST JOB IS TO PICK UP THE IOT WHICH IT IS TO PERFORM
/AND THE PARAMETERS WHICH GO ALONG WITH IT (IF ANY). THESE
/ARE MOVED INTO AN 8-WORD BLOCK CALLED 'FIOSTK.' THE FIRST REG-
/ISTER IN THIS BLOCK CONTAINS THE IOT, PARAMETERS FOLLOW
*200
FIP0, CLL CLA IAC
DCA BUFMOD /MARK BUFFER AS NOT MODIFIED
DCA SATSTA /CLEAR SAT STATUS
DCA TABSTA /CLEAR TABLE STATUS
TAD BUFSTA /IS THERE VALID DATA IN THE BUFFER?
SZA CLA
IAC /YES; RE-CALCULATE DISK PARAMETERS IF NEEDED
DCA BUFSTA
6201 /CDF FIELD ZERO
TAD I JOB /GLOBAL TO "JOB"
AND P0037
DCA FIJOB /SAVE IT
CFLD
FGETJT /SAVE USER AC
JOBREG+2
DCA FIUSAC /ADDRESS OF USER'S AC
FGETJT
JOBLNK /IOT REQUEST WORD
DCA FIOPTR /POINTER TO IOT LINKAGE
DATFLD
TAD I FIUSAC
DCA FIUSAC /USER'S AC
TAD I FIOPTR /PICK UP LINKAGE
AND IC7400 /IS IT AN IOT? (IF IT IS, JOBLNK WILL HAVE BITS 0-3 CLEARED)
SNA CLA
JMP FIP2 /IS AN IOT, SO GO MOVE IT INTO FIOSTK (AC IS PARAMETER)
TAD I FIOPTR /IS A POINTER, PICK UP LINKAGE
DCA FIP6 /POINTER TO LINKAGE TABLE
CFLD
6202 /CIF FIELD 0
BLT /MOVE IOT PARAMETERS INTO FIOSTK
DATFLD
FIP6, 0
6221 /CDF THIS FIELD
FIOSTK /IOT LINKAGE BUFFER
-10
TAD FIOSTK
SPA CLA /WILL THE IOT PARAMETER BLOCK BE NEEDED TO RETURN PARS?
JMP FIP4 /YES, SO DON'T RETURN IT
TAD FIP6
JMS I RETBK1 /RETURN THE IOT PARAMETER BLOCK TO FREE CORE
CLA CLL
DATFLD
DCA I FIOPTR /CLEAR JOBLNK TO AVOID CONFUSION LATER
CFLD
/COMES HERE WHEN IOT AND ITS PARAMETERS ARE COMFORTABLY
/NESTLED IN FIOSTK
FIP4, TAD IOTABL
DCA FITPTR /TABLE POINTER
FIP5, ISZ FITPTR /PICK UP IOT FROM TABLE
TAD I FITPTR
SNA /END OF TABLE?
JMP I LGI201 /DON'T KNOW WHAT TO DO SO PASS BACK AN ERROR AT LEAST
CIA /NO
TAD FIOSTK /IOT FROM USER
SZA CLA /DISPATCH?
JMP FIP5 /NO
TAD IOTABL /YES, FIND PROPER POINTER
CIA
TAD FITPTR
TAD IODSPA
DCA FITPTR
TAD I FITPTR /PICK UP DISPATCH ADDRESS
DCA FITPTR
TAD FIOSTK /IS THIS AN IOT WHICH DOES REQUIRE PARAMETERS TO BE
/RETURNED IN AN IOT PARAMETER BLOCK?
SMA CLA /...IF SO, USER AC CONTAINS A PTR TO WHERE THEY WILL GO
DCA FIUSAC /CLEAR USER AC
JMP I FITPTR /DISPATCH
/COMES HERE FOR A "SHORT" IOT. SAVED AC IS ONLY PARAMETER
/PUT IT IN FIOSTK+1
FIP2, TAD I FIOPTR /PICK UP IOT
DCA FIOSTK /PLACE ON STACK
TAD FIUSAC /USER ACCUMULATOR
DCA FIOSTK+1 /SIMULATE LINKAGE
JMP FIP4-2
IOTABL, . /TABLE OF USER FILE IOT'S
ASD /ASSIGN A DEVICE
REL /RELEASE A DEVICE
REN /RENAME A FILE
OPEN /OPEN A FILE
CLOS /CLOSE A FILE
RFILE /FILE READ (WINDOW MOVE)
PROT /FILE PROTECTION
WFILE /FILE WRITE (WINDOW MOVE)
CRF /CREATE A FILE
EXT /EXTEND A FILE
RED /REDUCE A FILE
FINF /FILE INFORMATION
LIN /LOGIN
LOUT /LOGOUT
WHO /RETURN PASSWORD
SEGS /RETURN # OF DISK SEGMENTS AVAILABLE
0
IODSPA, IODISP-1
FITPTR, 0
IC7400, 7400
/ROUTINE TO GET A DIRECTORY ENTRY INTO CORE
/CALLING SEQUENCE:
/ TAD (INTERNAL FILE NUMBER)
/ JMS GD0
/ RETURN (BUFFER POINTER IN AC, 0=ERROR)
GD0, 0
JMS I EBLD0
DCA GDUFDP
TAD I GDUFDP /RELATIVE POSITION IN UFD TABLE
JMS I BLDP1
DCA GDRETP /POINTER TO UFD RETRIEVAL INFORMATION
ISZ GDUFDP
TAD I GDUFDP /PICK UP ENTRY ADDRESS WITHIN UFD
DCA GD1
TAD GDRETP
JMS I GE01 /GET ENTRY INTO CORE
GD1, 0
JMP I GD0
GDUFDP, 0
IFN0, 0
TAD FIOSTK+1
AND P0003
DCA FIOSTK+1
JMP I IFN0
EBLD, 0
DCA CFH
TAD FIJOB
CLL RTL
TAD CFH
RAL
TAD ENTTBL
JMP I EBLD
WR0, 0 /WRITE OUT THE CONTENTS OF THE BUFFER
TAD C0605 /WRITE IOT
DCA FLPARB /I/O PARAMETER BLOCK
JMS I FIO01 /PERFORM THE WRITE
HLT /ERROR ON WRITE, TOO BAD
CLA IAC
DCA BUFMOD /SET NOT-MODIFIED STATUS
JMP I WR0
/ROUTINE TO OPEN A FILE
OPN0, JMS I BASCO1 /IF BASIC SET BASSWT TO -1
DCA OPENTT /PTR TO ENTTBL
JMS I JBLD0 /PROJ PROG # OF THIS JOB IN AC
DCA PRJPRO /SAVE PROJ, PROG #
TAD FIOSTK+2
SNA /IF HE OWNS THE FILE THEN FIOSTK+2 IS 0
JMP OPNOWN /YES, HE DOES
CIA
TAD PRJPRO /IF HE HAS MENTIONED THE PROJ, PROG #
SNA CLA /CHECK IF HE IS THE OWNER
JMP OPNOWN
STA
TAD FIOSTK+2 /TRYING TO OPEN ACCOUNT 1 FILE?
SZA CLA
JMP .+6 /NO, OK
TAD FIOSTK+3 /WHOSE UFD?
CIA
TAD PRJPRO /HIS/HER OWN?
SZA CLA
JMP OPN3 /NO, TELL HIM/HER FILE NOT FOUND
TAD FIOSTK+2
AND C7700 /TAKE OUT JUST THE PROJ # OF THE FILE
CIA
TAD PRJPRO /DOES IT AGREE WITH JOB'S PROJ #?
AND C7700
SNA CLA
TAD P0003 /4 IN AC SAME PROJ #
CLL IAC /1 IN AC DIFF PROJ #
JMP .+4
OPNOWN, TAD PRJPRO
DCA FIOSTK+2
TAD C0010 /10 IN AC IF HE OWNS THE FILE
DCA PRJPRO /STORE PROTECTIVE BITS FOR READ CASE
TAD FIOSTK+2 /PICK UP THE PROJ PROG # OF THE FILE
JMS I UTS01 /SEARCH OPEN UFD TABLE RETURN WITH PTR IN AC
JMP OPN6 /UFD NOT OPEN, GO OPEN IT
OPN2, DCA I OPENTT /SAVE ITS RELATIVE PTR IN ENTTBL
TAD I OPENTT /GET RELATIVE ADDRESS OF UFD TBL
JMS I BLDP1 /BUILD A PTR TO RETTBL ENTRY
DCA FIOSTK+2 /SAVE IT
JMS I DS01 /3 WORD SEARCH
FIOSTK+2
JMP OPN3 /NO SUCH FILE
TAD P0007 /PTR TO RETRIEVAL ENTRY IN BUFFER
DCA OPBUFP
ISZ OPENTT
TAD I ZDS1 /GET THIS FILE'S DIRECTORY ADDRESS
DCA I OPENTT /SAVE IN SECOND WORD OF ENTTBL ENTRY
CLL CMA RTL /-3 IN AC
TAD OPBUFP /PTR TO PROTECTION BIT
JMS I OPN11A /CHECK PROTECTION OF THE FILE
PRJPRO, 0
TAD I OPBUFP /ADD POINTER TO FIRST RETRIEVAL WINDOW AND
DCA PRJPRO /SAVE WITH PROTECTION BIT
TAD OPNFI0 /JOB STATUS WORD FILE FOR FILE 0
TAD FIOSTK+1
DCA OPACSC /FOR LINKING A BLOCK
TAD I OPBUFP /GET RETRIEVAL WINDOW
DCA OPBUFP /SAVE IT
TAD FIOSTK+2
JMS I GE01 /GET RETRIEVAL WINDOW IN CORE
OPBUFP, 0
DCA OPENTT /SAVE THE BUFFER ADDRESS
FGETJT /GET THE ADDRESS OF JOB STATUS FOR THIS FILE
OPACSC, 0
DCA OPACSC /SAVE POINTER
TAD OPACSC
JMS I GTBLO1 /GET A BLOCK LINKED FOR FILE CONTROL
JMP OPNOT /NO FREE CORE; CAN'T OPEN THEN
DCA OPBUFP /SAVE IT TO BUILD THE FILE CONTROL BLOCK
ISZ BASSWT
JMP OPN123
TAD I BASWIN /IS BASIC WINDOW ALREADY SET UP?
IAC
SNA CLA /YES THEN HAS -1
JMP OPRET1 /BASIC WINDOW ALREADY LOADED
TAD OPENTT /BUFFER ADDRESS OF THE WINDOW
JMS I BAS1A /CREATE BASIC WINDOW
OPRET1, TAD BASWIN /PUT BASIC WINDOW POINTER IN CONTROL BLOCK
DCA I OPBUFP
OPRET, CFLD
CLA CMA /ACCESS COUNT IN UFDTBL
TAD I UTPRNU /INCREASE BY -1
DCA I UTPRNU
DATFLD
ISZ OPBUFP
ISZ OPBUFP /POINTS TO PROTECTION BIT
TAD PRJPRO
DCA I OPBUFP /PUT IN THE WRITE PROT BIT CREATED BEFOREHAND
JMP I .+1 /EXIT AND WRITE OUT TABLES
TABOUT
OPN123, TAD OPBUFP /LINK A BLOCK
JMS I GTBLO1
JMP OPN4 /NO FREE CORE, CAN'T OPEN
DCA OPENTU
CFLD
CIF
BLT
CFLD /SOURCE
OPENTT, 0
DATFLD
OPENTU, 0
-10
JMP OPRET
OPN5, SNA /DID THE ACCOUNT EXIST?
JMP OPNOT /YES; LACK OF ROOM IN UFDTBL
OPN3, STL CLA RTR /NOT FOUND ERROR
OPNPRE, TAD P2000 /PROTECTED
TAD P2000
OPNOT, CLL CML RAR /NOT OPEN, LACK OF SYSTEM RESOURCES
DCA FIUSAC
TAD FIOSTK+1
JMS I EBLD0 /BE SURE TO REMOVE ALL THE POINTERS PUT IN BY OPEN
DCA OPENTT
DCA I OPENTT
JMP I FIEXIT
OPN4, TAD I OPACSC /CONTROL BLOCK ADDR
JMS I RETBK1 /RETURN IT
DATFLD
DCA I OPACSC /CLEAR POINTER FROM JOB BLOCKS
CFLD
JMP OPNOT /TELL HIM/HER WE COULDN'T OPEN
OPN6, TAD FIOSTK+2 /PICK UP PROJ PROG #
JMS I UFO01 /OPEN UFD
JMP OPN5 /NO LUCK, ERROR
JMP OPN2 /OPENED RELATIVE POSITION IN AC
OPNFI0, JOBF0
OPN11A, OPN11
/ROUTINE TO CLOSE A FILE
*600
CLS0, DCA CLSIFN /INTERNAL FILE NUMBER
TAD C7774
DCA CLCNTR /COUNTER FOR BIT SCAN
CLS1, TAD FIOSTK+1 /PICK UP BIT PATTERN
RAL
DCA FIOSTK+1
SZL
JMP CLS3
CLS2, ISZ CLSIFN /NEXT FILE NUMBER
ISZ CLCNTR /DONE ALL FOUR?
JMP CLS1 /NO, KEEP AT IT
JMP I FIEXIT /THROUGH
CLS3, TAD CLSIFN /PICK UP INTERNAL FILE NUMBER
JMS CL0 /CLOSE THE FILE
JMP CLS2 /LOOK FOR MORE
CLSIFN, 0
CLCNTR, 0
/ROUTINE TO DO ACTUAL FILE CLOSE
CL0, 0
JMS I EBLD0
DCA CLENTP
TAD CFH
JMS I LNK01 /RETURNS WITH PTR TO FILE CONTROL BLOCK FROM JOB STATUS BLOCK
SNA
JMP CL3 /FILE WAS NOT OPEN
DCA CLPARP /SAVE IT
DCA I CFH /CLEAR POINTER TO FILE CONTROL BLOCK --- INDICATES FILE CLOSED
CFLD /SET DATA FIELD TO THIS FIELD
TAD CLPARP /POINTER TO PARAMETER BLOCK
JMS I CLOBA /PROPERLY CLOSE TESTING FOR BASIC
DCA CLO3 /SWITCH SET TO -1 IF BASIC FILE
CLA CMA CLL
TAD I CLENTP /RELATIVE POINTER TO UFD RETRIEVAL TABLE
CLL RTL
IAC
TAD UFDTBL
DCA CLUFDP /POINTER TO ACCESS COUNTER
DCA I CLENTP /CLEAR PTR IN ENTTBL TO INDICATE FILE IS CLOSED
CLA CMA
DCA TABSTA /SET TABLE STATUS TO WRITE OUT
ISZ I CLUFDP /REMOVE THIS JOB FROM ACCESS COUNT IN UFDTBL
JMP I CL0
/THIS WAS THE ONLY GUY USING THIS UFD, SO CLOSE IT OUT
ISZ CLO3 /IS IT BASIC FILE BEING CLOSED?
JMP CL11 /NO, PROCEED FURTHER
DATFLD /YES, JUST ZERO ONE LOC IN FIELD 1
DCA I BASWIN
CFLD
CL11, CLA CMA /NO ONE IS NOW ACCESSING THIS UFD
TAD CLUFDP
JMS I TF01 /FREE A TABLE ENTRY
CL3, CFLD
JMP I CL0
CLOBA, CLOBAS
CLPARP, 0
CLENTP, 0
CLUFDP, 0
/SKIPS IF NO OTHER USER IS ACCESSING THIS FILE
ENR0, 0
TAD FIOSTK+1
JMS I EBLD0
DCA ENR1 /PTR INTO ENTTBL
ISZ ENR1
TAD I ENR1 /GET ADDR IN ENTTBL
DCA ENR1
TAD GDRETP /RTABLE
JMS I ENS01 /HOW MANY PEOPLE HAVE THIS FILE OPEN?
ENR1, 0
SKP /FOUND THE SAME FILE OPEN
ISZ ENR0 /...ONLY ONE WHO HAS IT OPEN
JMP I ENR0
ENS01, ENS0
/CHANGE THE PROTECTION OF A FILE
PRT0, TAD FIOSTK+1 /PICK UP INTERNAL FILE NUMBER
RTR
RTR
RAR
AND P0003 /AND OFF PROTECTION BITS
DCA PRIFNU /INTERNAL FILE NUMBER
TAD PRIFNU
JMS I UC01 /CHECK TO SEE IF USER IS OWNER
JMP PRT1 /ERROR RETURN, USER IS NOT OWNER
JMS I ACC01 /IS HE UNDER ACCOUNT 1?
JMP PRT1+1 /YES; ERROR - HE MUST USE #RENAME#
TAD PRIFNU
JMS I GD01 /GET THIS DIRECTORY ENTRY INTO CORE
SNA
JMP I DIRBAD /**************DEBUG*************
TAD P0004
DCA PRENTP /POINTER TO PROTECTION BITS OF THIS FILE
TAD C7637
AND FIOSTK+1 /PICK UP NEW PROTECTION BITS
DCA I PRENTP /RESTORE
DCA BUFMOD /SCHEDULE WRITE
JMP I FIEXIT
PRT1, SZA CLA /ERROR
CLL CML RAR
CLL CML RAR
DCA FIUSAC
JMP I FIEXIT
CLO3,
PRIFNU, 0
PRENTP, 0
C7637, 7637
WHO0, JMS I JBLD0
DCA PAS1
CMA /ONE WORD SEARCH
JMS I DS01 /SEARCH THE MFD FOR THIS ACC'T #
PAS0
JMP I DIRBAD /************DEBUG ONLY***********
DCA PAS1
TAD I PAS1 /GET ACC'T # FROM UFD FILE NAME BLOCK
ISZ PAS1
DCA FIOSTK+1 /STORE ACC'T #
TAD I PAS1
ISZ PAS1
DCA FIOSTK+2 /STORE FIRST TWO CHRS OF PASSWORD
TAD I PAS1
DCA FIOSTK+3 /STORE LAST TWO CHARS OF PASSWORD
JMP I PAINF5 /GO STORE THIS INFORMATION FOR RETURN TO MONITOR
PAINF5, INF5
PAS0, RTABLE
PAS1,
JBLD, 0
TAD FIJOB
TAD JOBTAB
CFLD
DCA CFH
TAD I CFH
JMP I JBLD
/ROUTINE TO MOVE THE RETRIEVAL WINDOW IN FIELD ZERO
*1000
WND0, TAD FIOSTK+2 /PICK UP INTERNAL FILE NUMBER
AND P0003 /AND OFF FIELD BITS
JMS I EBLD0
DCA WNENTP /POINTER TO RETRIEVAL INFORMATION POINTER
TAD I WNENTP
JMS I BLDP1 /GENERATE ABSOLUTE PTR INTO RETTBL
DCA WNRETP /RETRIEVAL POINTER
TAD FIOSTK+7
DCA WNFCBP /PTR TO THIS FILE'S FILE CONTROL BLOCK
TAD FIOSTK+5
DCA WND5 /LOW ORDER DISK ADDRESS
DCA WNDCNT /GET INTO CORE
TAD WNDCCT /INITIALIZE COUNT
DCA WNDSCT
TAD C0177
AND FIOSTK+1 /GET HIGH ORDER FILE ADDRESS
DCA WNDIRP
TAD SEGSIZ /GET RID OF ADDRESS WITHIN SEGMENT
CLL CIA
AND WND5
RAL
TAD WNDIRP /NOW HAVE FILE SEGMENT #; NEED TO SHIFT IT
SKP
RAL
ISZ WNDSCT /SHIFT SEGCCT TIMES?
JMP .-2
DCA WNSEGC
DATFLD /WNSEGC NOW HAS SEGMENT NUMBER TO GET
TAD I WNFCBP /PICK UP FIELD 0 WINDOW POINTER
DCA WNDPTR /PNTS TO FILE RETRIEVAL WINDOW FOR THIS FILE
ISZ WNFCBP
TAD I WNFCBP /PICK UP NUMBER OF CURRENT SEGMENT IN WINDOW
DCA WNCURS /CURRENT SEGMENT IN WINDOW
TAD WNSEGC /SEGMENT TO GET
JMS I WND201 /DIVIDE BY 7 (IGNORE REMAINDER)
JMS WND30 /MULTIPLY BY 7
DCA WNSEGC /FIRST SEGMENT IN PROPER WINDOW
CLA CMA
TAD I WNDPTR /GET FIRST WORD OF FILE RETRIEVAL WINDOW
SNA CLA /=7777?
JMP WND6 /INVALID WINDOW POINTER
TAD WNCURS /CURRENT SEGMENT AT TOP OF CURRENT CORE WINDOW
CIA
/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 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 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 EXBUFP /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 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 HE UNDER ACCOUNT 1?
JMS I REDUFD /SEE IF 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
LGMFDP, 0
LGI3,
GTBLOK, 0 / VRS: reconstructed from working TSS-8
DCA LGMFDP
CFLD
TAD LGMFDP
CIF 0
GETBLK
JMP I GTBLOK
DATFLD
TAD I LGMFDP
ISZ GTBLOK
JMP I GTBLOK
REN1, SZA CLA
CLL CML RAR
CLL CML RAR
DCA FIUSAC
JMP I 55
WR1, 0
TAD BUFSTA
TAD BUFMOD
SPA CLA
JMS I WR01
JMP I WR1 / VRS: End reconstruction
/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 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 HE SET HIS/HER AC= TO HIS/HER JOB #?
CIA
TAD FIJOB
SZA CLA
JMP I LGO1A /NO; SO SEE IF 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
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 I 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, 0
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 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 /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 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 CFH /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 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 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 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 HE REDUCED SINCE LAST EXTEND?)
JMP EXTQU9 /NO; 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 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 HE DESTROYS THE SYSTEM
TAD FIOSTK+2 /NUMBER OF SEGMENTS TO BE ADDED
SPA /IS HE BEING REASONABLE?
JMP EXTQU1 /NO - 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 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 HE'S REENTERING
STL RAL /SET GRACE BIT
DCA I EXQ3
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 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 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
$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$%&$