3253 lines
80 KiB
Plaintext
3253 lines
80 KiB
Plaintext
/FIP - UWM VERSION 25
|
||
/
|
||
/COPYRIGHT 1971, 1975 DIGITAL EQUIPMENT CORPORATION
|
||
/ MAYNARD, MASSACHUSETTS
|
||
/
|
||
/EXTENSIVELY MODIFIED AND CORRECTED BY
|
||
/ RICHARD BARTLEIN, 1974, 1976
|
||
/ UNIVERSITY OF WISCONSIN - MILWAUKEE
|
||
|
||
/HANDLES ALL NON RESIDENT FILE IOT'S
|
||
/RUNS IN EXEC MODE
|
||
|
||
*0
|
||
JMP I .+1
|
||
FIP0
|
||
RETBK1, RETBKS
|
||
LNK01, LNK0
|
||
ZDS1, DSWORD /POINTER TO 'FIND' LOCATION IN DIRECTORY
|
||
P0004= .
|
||
FIDEXP, FIPDEX /FIP DISC EXTENSION (SHIFTED 2 BITS)
|
||
C002= .
|
||
FILPRP, FILPRO
|
||
C0020= .
|
||
FIPFLD, 20 /FIELD WE ARE RUNNING IN
|
||
|
||
*10
|
||
INDEX, 0 /ONLY REGISTER AVAILABLE IN FIP FOR INDEXING
|
||
|
||
/CONSTANTS
|
||
|
||
P0003, 3
|
||
C0005, 5
|
||
C0006, 6
|
||
P0007, 7
|
||
C0010, 10
|
||
P0037, 37
|
||
P0077, 77
|
||
C0200, 200
|
||
IFNZRO WRDSEG-400 <GLITCH>
|
||
SEGSIZ=. /WRDSEG
|
||
C0400, 400
|
||
P0777, 777
|
||
P1000, 1000
|
||
P2000, 2000
|
||
C3777, 3777
|
||
P5400, 5400
|
||
C6603, 6603 /DMAR - DISC READ IOT
|
||
C6605, 6605 /DMAW - DISC WRITE IOT
|
||
C7000, 7000
|
||
C7400, 7400
|
||
C7700, 7700
|
||
P7770, -10
|
||
C7771, -7
|
||
C7774, -4
|
||
|
||
BUFSTA, 0 /BUFFER STATUS, 7777 IF FULL
|
||
BUFWRT, 0 /-1, IF BUFFER CHANGED
|
||
CORTBA, CORTBL-1
|
||
FANFLD, CORTBL-1+2 /PHANTOM FIELD ENTRY
|
||
FIBASE, SWDEX+JOBMAX /BASE ADDRESS OF ALLOCATABLE DISC STORAGE
|
||
FIUSPC, 0 /SAVED USER PC
|
||
FILINK, 0 /SAVED USER EAE MODE, LINK, GT, & SC
|
||
FIUSAC, 0 /SAVED USER AC
|
||
0 /SAVED USER MQ (IF ANY)
|
||
FIACCT, 0 /USER'S ACCOUNT NUMBER
|
||
FIJOB, 0 /JOB NUMBER FILE PHANTOM IS REPRESENTING
|
||
FIOPTR, 0 /POINTER TO FIELD 0 IOT
|
||
GDRETP, 0 /RETRIEVAL POINTER, SET BY GD0 ROUTINE
|
||
JOBA, JOB
|
||
JOBDAT, CJOBDA
|
||
OPNFLG, 0
|
||
SATSTA, 0 /SAT STATUS, 7777 IF CHANGED THIS RUN
|
||
TABSTA, 0 /TABLE STATUS, 7777 IF CHANGED THIS RUN
|
||
WNDREM, 0 /REMAINDER FROM DIVISION BY 7
|
||
|
||
/GLOBALS TO MONITOR DATA AREA
|
||
|
||
DEVTBA, DEVTBL
|
||
DEVEND, DEVTBE
|
||
|
||
/POINTERS TO FILE PHANTOM'S INTERNAL TABLES
|
||
|
||
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 UFD'S
|
||
ENTTBL, ENTABL-10 /TABLE REFLECTING STATE OF ALL POSSIBLE FILE NUMBERS
|
||
BUFFER, SEGBUF /BUFFER FOR DIRECTORY MANIPULATIONS
|
||
SATBOT, -SATSIZ /BOTTOM OF STORAGE ALLOCATION TABLE
|
||
DEVOVR,
|
||
JOBTBA, JOBTBL /END OF FIELD 1 DEVICE ASSIGNMENT TABLE
|
||
|
||
|
||
/SUBROUTINE POINTERS
|
||
|
||
BLDP1, BLDP /BUILD A POINTER TO RETTBL
|
||
BLT= JMS I . /BLOCK TRANSFER
|
||
BLT0
|
||
CHKACT= JMS I . /CHECK TYPE OF ACCOUNT NUMBER
|
||
CHKAC0
|
||
CHKPRV= JMS I . /CHECK FOR PRIVILEGE
|
||
CHKPV0
|
||
CHKSRC= JMS I . /CHECK SOURCE OF FIP CALL
|
||
CHKSR0
|
||
CL01, CL0 /CLOSE A FILE
|
||
CORE= JMS I . /SEARCH THE CORTBL
|
||
CORSRC
|
||
DE01, DE0 /GET A FREE DIRECTORY ENTRY
|
||
DS01, DS0 /DIRECTORY SEARCH
|
||
DTE01, DTE0
|
||
EBLD0, EBLD /BUILD 'ENTTBL' ENTRY ADDRESS FROM FILE #
|
||
ENS01, ENS0 /COUNT NUMBER OF FILE OPENINGS
|
||
FGETJT= JMS I . /FIND JOB STATUS-BLOCK WORD ADDRESS
|
||
FGETJ0
|
||
FIO01, FIPIO /COMMON DISC IO ROUTINE
|
||
GD01, GD0 /GET A FILE DIRECTORY ENTRY INTO CORE
|
||
GE01, GE0 /GET A DIRECTORY WORD INTO CORE
|
||
GETBLK= JMS I . /FETCH A FREE BLOCK
|
||
GETB
|
||
GETDDB= JMS I . /GET A DEVICE DATA-BLOCK
|
||
GETDB0
|
||
GETJTA= JMS I . /GET A JOB-STATUS WORD ADDRESS
|
||
GETJTB
|
||
GTBLO1, GTBLOK
|
||
IFN01, IFN0
|
||
REBOOT= JMS I . /INITIATE AUTOMATIC SYSTEM RESTART
|
||
RBOOT
|
||
REL01, REL00
|
||
RETBLK= JMS I . /RETURN A FREE-CORE BLOCK
|
||
RETB
|
||
SATL1, SATLOK /GET A FREE SEGMENT FROM SAT
|
||
SATR1, SATREL /RELEASE A SEGMENT IN SAT
|
||
SAVBUF= JMS I . /SET 'BUFFER CHANGED' SWITCH
|
||
SAVBF0
|
||
SCL01, SCL0 /CLEAR A DISC SEGMENT TO ZEROES
|
||
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
|
||
WAIT= JMP I . /RESCHEDULE
|
||
WSCHED
|
||
WRT1, WRITE /MAKE SURE THE BUFFER IS EMPTY
|
||
|
||
FIEXIT, FIX0 /EXIT ROUTINE
|
||
LGI201, LGI20 /-1 TO USER AC
|
||
|
||
/UTILITY ROUTINES
|
||
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
|
||
CFLD= 6221 /FIP IS IN FIELD 2 ALWAYS
|
||
BASWIN, WINBAS /FIELD 1 ADDRESS OF BASIC WINDOW
|
||
|
||
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
|
||
|
||
IFNZRO BILLNG <
|
||
LOGACT, -BILLNG /BILLING SYSTEM ACCOUNT NUMBER
|
||
>
|
||
*200
|
||
/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
|
||
|
||
FIP0, CLA CLL
|
||
DCA SATSTA /CLEAR SAT STATUS
|
||
DCA TABSTA /CLEAR TABLE STATUS
|
||
DCA BUFWRT /CLEAR THE 'WRITE BUFFER' SWITCH
|
||
/
|
||
/***** NOTE!!! IF, FOR ANY REASON, SOME PROGRAM IN THE SYSTEM
|
||
/ WRITES INTO ANY UFD (INCLUDING THE MFD), THE FOLLOWING
|
||
/ BUFFER STATUS-CHECK 'ISZ' SHOULD BE NOP'ED OUT. THIS WILL
|
||
/ HELP PREVENT THE CASE WHERE FIP READS A BLOCK, THE PROGRAM
|
||
/ WRITES INTO IT, AND THEN FIP WRITES IT BACK OUT, THUS
|
||
/ CLOBBERING WHAT THE PROGRAM JUST WROTE OUT. NOTE THAT THIS
|
||
/ COULD HAPPEN IN REVERSE ALSO, THEREBY MESSING UP FIP.
|
||
/
|
||
/ NOTE ALSO THAT BY DISALLOWING FIP TO 'REMEMBER' WHAT'S IN
|
||
/ ITS BUFFER CURRENTLY DOES NOT COMPLETELY PROTECT AGAINST
|
||
/ THE ABOVE PROBLEM AND SHOULD NOT BE TAKEN LIGHTLY.
|
||
/***** ***** ***** ***** ***** ***** ***** ***** *****
|
||
ISZ BUFSTA /IS THERE ANYTHING IN THE BUFFER?
|
||
JMP .+4 /NO - JUST CLEAR THE SWITCH
|
||
TAD I RDCURA /YES - RE-SET THE ADDRESS BECAUSE IT
|
||
JMS I RD301 / MIGHT HAVE BEEN CLOBBERED AT LAST EXIT
|
||
CLA CMA /THEN RESET THE SWITCH
|
||
DCA BUFSTA
|
||
CDF
|
||
TAD I JOBA /GLOBAL TO "JOB"
|
||
AND P0037
|
||
SNA /IS EVERYTHING PROPER?
|
||
REBOOT /NO - ERROR *****
|
||
DCA FIJOB /SAVE IT
|
||
FGETJT /GET THE REGISTER SAVE-AREA ADDRESS
|
||
JOBREG
|
||
DCA .+4
|
||
CIF
|
||
BLT /SAVE THE USERS REGISTERS
|
||
DATFLD
|
||
FITPTR, 0
|
||
CFLD
|
||
FIUSPC
|
||
-5
|
||
CHKSRC /WHERE ARE WE COMING FROM?
|
||
CHKPRV /A PROGRAM - DOES IT HAVE PRIVILEGE?
|
||
JMS I FIPSFC /EITHER 'SI' OR NO PRIVILEGE - CLOSE SPECIAL FILES
|
||
FGETJT
|
||
JOBLNK /IOT REQUEST WORD
|
||
DCA FIOPTR /POINTER TO IOT LINKAGE
|
||
DATFLD /CDF FIELD 0
|
||
TAD I FIOPTR /PICK UP LINKAGE
|
||
AND C7400 /IS IT AN IOT? (IF IT IS, JOBDAT 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
|
||
CIF
|
||
BLT /MOVE IOT PARAMETERS INTO FIOSTK
|
||
DATFLD
|
||
FIP6, 0
|
||
CFLD
|
||
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 THE 'JOBLNK' POINTER
|
||
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?
|
||
REBOOT /YES - ERROR *****
|
||
CIA /NO
|
||
TAD FIOSTK /IOT FROM USER
|
||
SZA CLA /DISPATCH?
|
||
JMP FIP5 /NO
|
||
TAD FITPTR /YES - GET THE DISPATCH ADDRESS
|
||
TAD IODSPA
|
||
DCA FITPTR
|
||
TAD I FITPTR
|
||
DCA FITPTR
|
||
TAD FIOSTK /DOES THIS IOT 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
|
||
CFLD /CHANGE TO CURRENT FIELD
|
||
JMP FIP4
|
||
/
|
||
FIPSFC, PRVCLS
|
||
RDCURA, RDCURR /POINTER TO SEGMENT # IN BUFFER
|
||
RD301, RD30
|
||
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)
|
||
XOPEN /OPEN A FILE WITH EXCLUSIVE USE
|
||
CPASS /CHANGE A USER'S PASSWORD
|
||
CRF /CREATE A FILE
|
||
EXT /EXTEND A FILE
|
||
RED /REDUCE A FILE
|
||
FINF /FILE INFORMATION
|
||
LIN
|
||
LOUT
|
||
BCLR /CLEAR ACCOUNT BILLING INFORMATION
|
||
0
|
||
|
||
IODSPA, IODISP-IOTABL-1
|
||
/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,
|
||
IFN0, 0
|
||
TAD FIOSTK+1
|
||
AND P0003
|
||
DCA FIOSTK+1
|
||
TAD FIOSTK+1 /RETURN THE FILE INDEX
|
||
JMP I IFN0
|
||
PAGE
|
||
/THIS HANDLES THE 'OPEN' & 'XOPEN' IOTS.
|
||
/THE 'XOPEN' WORKS EXACTLY LIKE THE NORMAL 'OPEN', EXCEPT
|
||
/THAT THE USER GAINS EXCLUSIVE USE OVER THE FILE IF HE
|
||
/IS ALLOWED TO WRITE IT. NO ONE ELSE MAY OPEN IT WHILE
|
||
/HE HAS IT EXCLUSIVELY.
|
||
/
|
||
/THERE ARE SEVERAL SPECIAL CASES WHICH ARE HANDLED:
|
||
/
|
||
/A USER NO LONGER NEEDS HIS ACCT # & PASSWORD TO OPEN HIS UFD.
|
||
/ALL HE NEEDS IS THE OWNER'S ACCT BE 0001 AND THE FIRST
|
||
/WORD OF THE NAME BE 0 OR HIS ACCT #. IF HIS IS A SYSTEM
|
||
/ACCOUNT, HE MAY OPEN ANY UFD (EXCEPT THE MFD) BY SETTING
|
||
/THE FIRST WORD OF THE NAME TO THE DESIRED ACCOUNT.
|
||
/
|
||
/EXCEPT WHEN OPENED BY THE SYSTEM MANAGER (0001), ALL UFD'S
|
||
/ARE WRITE-PROTECTED REGARDLESS OF THE PROTECTION CODE.
|
||
/THIS ALLOWS THESE BITS IN THE MFD TO BE USED FOR DISC QUOTAS.
|
||
/
|
||
/WHEN AN OPERATOR ACCOUNT TRIES TO OPEN A NON-EXISTENT
|
||
/UFD, HE IS RETURNED THE NUMBER OF THE NEXT UFD IN
|
||
/THE FOURTH WORD OF HIS OPEN PACKET.
|
||
/
|
||
/WHEN 'SI' OPENS A FILE FROM THE SYSTEM LIBRARY WHICH
|
||
/HAS THE ".SVP" EXTENSION, WE SET THE "JSPRIV" BIT IN
|
||
/THE USER'S JOB-STATUS WORD. THIS ALLOWS ONLY CERTAIN
|
||
/SYSTEM PROGRAMS TO USE THE "PEEK" IOT, THUS PREVENTING
|
||
/USERS FROM EXAMINING SYSTEM KEYBOARD BUFFERS AND
|
||
/STEALING PASSWORDS.
|
||
/
|
||
/A USER (OTHER THAN ACCOUNT 1 OR 7) CAN ONLY OPEN A FILE
|
||
/OWNED BY THE BILLING SYSTEM (ACCOUNT 7) IF HE IS RUNNING
|
||
/A PROGRAM WHICH ENABLES HIS 'JSPRIV' BIT. CHANGING THE
|
||
/PROGRAM (THUS CLEARING PRIVILEGE) DISALLOWS ANY FURTHER
|
||
/I-O TO A PRIVILEGED FILE AND FORCES THE FILE CLOSED AT THE
|
||
/NEXT CALL TO 'FIP'.
|
||
/
|
||
/THE SYSTEM MANAGER AND, IF CONFIGURED, THE BILLING SYSTEM
|
||
/ACCOUNT MAY OPEN ANY FILE IN THE SYSTEM AS IF THEY OWNED IT.
|
||
/NOTE THAT THIS IS ONLY NECESSARY FOR DELETING OTHER USERS'
|
||
/FILES WHEN BILLING OR REMOVING AN ACCOUNT NUMBER.
|
||
/
|
||
/THE SYSTEM LIBRARY FILE "BASIC" IS GIVEN ITS OWN PRIVATE
|
||
/RETRIEVAL WINDOW IN FIELD 1 ONLY IF IT IS WRITE-PROTECTED
|
||
/AND IT IS NOT TOO LARGE FOR THIS FIXED WINDOW.
|
||
/
|
||
/ANY NUMBER OF USERS MAY NOW READ-WRITE THE SAME FILE
|
||
/SIMULTANEOUSLY PROVIDING THAT NO ATTEMPTS ARE MADE
|
||
/TO EXTEND OR REDUCE THE FILE. OBVIOUSLY, PROGRAMS
|
||
/SHARING DATA FILES MUST USE SOME METHOD OF ENSURING
|
||
/GRACEFUL FILE HANDLING.
|
||
/
|
||
OPNACT= FIOSTK+6
|
||
OPNBUF= FIOSTK+7
|
||
/
|
||
XOPN0, CLA CLL CML RAR /SET THE 'EXCLUSIVE USE' BIT
|
||
OPN0, DCA XOPNSW
|
||
JMS I IFN01 /CHECK FOR A LEGAL FILE #
|
||
JMS I CL01 /CLOSE THE FILE IF ANY OPEN
|
||
TAD FIOSTK+2
|
||
SNA /IS IT ASSUMED TO BE THIS USER'S FILE?
|
||
TAD FIACCT /YES - FILL IT IN
|
||
DCA OPNACT
|
||
CLA CMA
|
||
TAD OPNACT
|
||
SZA CLA /IS IT A FILE-DIRECTORY?
|
||
JMP OPN2 /NO
|
||
/
|
||
/HE WANTS TO OPEN A DIRECTORY - WE CHECK TO SEE IF
|
||
/THE DIRECTORY HE WANTS IS HIS OR, IF NOT, IF HE
|
||
/IS THE MANAGER OR OTHER SYSTEM PERSONNEL OR THE
|
||
/BILLING SYSTEM ACCOUNT.
|
||
TAD FIOSTK+3
|
||
SNA /IS IT ASSUMED TO BE HIS OWN?
|
||
TAD FIACCT /YES - SET IT
|
||
DCA FIOSTK+3
|
||
TAD FIACCT
|
||
CIA
|
||
TAD FIOSTK+3
|
||
SNA CLA /IS IT HIS OWN UFD?
|
||
JMP OPN1 /YES
|
||
CLA CLL CMA RAL
|
||
TAD FIOSTK+3
|
||
SNA /IS IT THE LIBRARY UFD?
|
||
JMP OPN1 /YES - ANYONE CAN READ THAT
|
||
IAC
|
||
SNA CLA /NO - IS IT THE MFD?
|
||
JMP OPNER2 /YES - "PROTECTION VIOLATION"
|
||
CHKACT /IS THIS THE MANAGER OR BILLING SYSTEM?
|
||
JMP OPN1 /YES - THEY GET ANYTHING ELSE
|
||
TAD FIACCT
|
||
AND C7700
|
||
SZA CLA /IS THIS A SYSTEM OPERATOR OR MANAGER?
|
||
JMP OPNER2 /NO - "PROTECTION VIOLATION"
|
||
OPN1, CLA CMA /SET NON-ZERO FOR ONE-WORD SEARCH
|
||
OPN2, DCA OPNTYP / OF FILE-DIRECTORY
|
||
TAD FIOSTK+3
|
||
SNA CLA /IS IT A NULL FILENAME?
|
||
JMP OPNER1 /YES - "FILE NOT FOUND"
|
||
TAD OPNACT
|
||
JMS I UFO01 /OPEN THE OWNER'S UFD
|
||
JMP OPNER1 /NO SUCH USER - "FILE NOT FOUND"
|
||
TAD XOPNSW /ADD IN THE 'EXCLUSIVE USE' BIT (4000)
|
||
DCA XOPNSW / & SAVE FOR FIRST WORD OF 'ENTTBL' ENTRY
|
||
TAD XOPNSW
|
||
JMS I BLDP1 /GET THE 'RETTBL' ENTRY ADDRESS
|
||
DCA FIOSTK+2
|
||
TAD OPNTYP /NOW GET THE SEARCH-TYPE AND DO
|
||
JMS I DS01 / A 1- OR 3-WORD DIRECTORY SEARCH
|
||
FIOSTK+2
|
||
JMP OPNER0 /NO FIND - "FILE NOT FOUND"
|
||
TAD P0004
|
||
DCA OPNBUF /SAVE THE POINTER TO THE PROTECT-WORD
|
||
/
|
||
/HERE WE FIGURE OUT THE TYPE OF ACCOUNT THIS USER
|
||
/HAS & THEN SEE IF THE FILE IS PROTECTED AGAINST THAT
|
||
/TYPE OF ACCESS.
|
||
TAD OPNTYP
|
||
SZA CLA /WAS THIS AN OPEN OF A 'UFD'?
|
||
JMP OPN3 /YES - ONLY MANAGER #1 CAN WRITE THEM
|
||
JMS I OPNPRT /CALCULATE THE PROTECTION CHECK-MASK
|
||
DCA OPNFLG
|
||
TAD OPNFLG /'AND' THE PROTECTION-CODE TO THE LOW-
|
||
AND P0007 / ORDER 3 BITS OF THE MASK
|
||
AND I OPNBUF
|
||
SZA CLA /IS THE FILE READ PROTECTED?
|
||
JMP OPNER2 /YES - "PROTECTION VIOLATION"
|
||
TAD OPNFLG /NO - CHECK FOR 'WRITE-PROTECT'
|
||
CLL RAL
|
||
AND I OPNBUF
|
||
SNA CLA /IS IT WRITE-PROTECTED?
|
||
JMP OPN4 /NO
|
||
OPN3, TAD OPNTYP
|
||
TAD FIACCT
|
||
SNA CLA /IS THIS THE MANAGER #1 OPENING A UFD?
|
||
JMP OPN4 /YES - HE MUST BE ALLOWED TO WRITE IT
|
||
TAD XOPNSW
|
||
SPA CLA /DOES THE USER WANT EXCLUSIVE USE?
|
||
JMP OPNER2 /YES, TOO BAD - "PROTECTION VIOLATION"
|
||
TAD P0004 /NO - SET 'PROTECTED' BIT
|
||
OPN4, DCA OPNFLG
|
||
TAD OPNACT
|
||
TAD LOGACT
|
||
SNA CLA /WAS THIS AN ACCOUNT #7 (BILLING ACCOUNT) FILE?
|
||
CHKACT /YES - IS THIS A MERE ORDINARY USER?
|
||
JMP .+4 /NO
|
||
CHKPRV /YES - IS HE RUNNING WITH PRIVILEGE?
|
||
JMP OPNER2 /NO - ACCOUNT 7 FILES ARE SPECIAL - "PROTECTION VIOLATION"
|
||
ISZ OPNFLG /SET THE 'SPECIAL FILE' BIT IN THE CONTROL BLOCK
|
||
TAD I ZDS1 /GET THE SEARCH-FIND ADDRESS
|
||
DCA .+3
|
||
TAD FIOSTK+2
|
||
JMS I ENS01 /NOW CHECK FOR OTHER OPENINGS
|
||
OPNTYP, 0
|
||
SNA CLA /ANYONE ELSE HAVE IT OPEN?
|
||
JMP OPN5 /NO
|
||
CLA CLL CMA CML
|
||
TAD I OPNFND /YES - GET THE LAST 'FIND' ENTRY (IN 'ENTTBL')
|
||
DCA CFH
|
||
TAD I CFH
|
||
TAD XOPNSW
|
||
SPA SZL CLA /DOES SOMEONE ELSE HAVE 'EXCL. USE' OR DO WE WANT IT?
|
||
JMP OPNER3 /YES, TOO BAD - "ANOTHER USER HAS FILE"
|
||
OPN5, TAD FIOSTK+1 /WE HAVE THE FILE - NOW FILL IN THE
|
||
JMS I EBLD0 / 'ENTTBL' ENTRY
|
||
DCA CFH
|
||
TAD XOPNSW /FIRST THE 'UFDTBL' INDEX &
|
||
DCA I CFH / THE 'EXCLUSIVE USE' BIT
|
||
ISZ CFH
|
||
TAD I ZDS1 /THEN THE UFD ENTRY-ADDRESS
|
||
DCA I CFH
|
||
JMP I .+1 / AND GO DO THE BOOKKEEPING
|
||
OPN6
|
||
|
||
/COMES HERE TO RETURN VARIOUS ERROR STATUSES.
|
||
OPNER0, CHKSRC /IS THIS 'OPEN' FROM 'SI'?
|
||
TAD OPNTYP /NO - WAS IT A PROGRAMMATIC OPEN OF A 'UFD'?
|
||
SZA CLA /WAS THIS A DIRECTORY OPEN?
|
||
JMP I OPNR0A /YES - RETURN THE NEXT UFD NUMBER
|
||
/NO - JUST RETURN THE ERROR CODE
|
||
OPNER1, CLA CLL CML RAR /7000 = "FILE NOT FOUND"
|
||
OPNER2, CLL CML RAR /6000 = "PROTECTION VIOLATION"
|
||
SKP
|
||
OPNER3, TAD P1000 /4400 = "ANOTHER USER HAS FILE OPEN"
|
||
CLL CML RAR
|
||
OPNEXT, DCA FIUSAC /SET (OR CLEAR) HIS AC
|
||
DATFLD
|
||
TAD I FIOPTR
|
||
JMS I RETBK1 /RETURN THE PARAMETER BLOCK
|
||
JMP I FIEXIT /THEN EXIT FIP
|
||
/
|
||
OPNFND, ENSFND /LOC. OF LAST 'FIND' IN ENS0
|
||
OPNPRT, OPNPR0 /CALCULATE CHECK-MASK
|
||
OPNR0A, OPNR01
|
||
XOPNSW, 0
|
||
PAGE
|
||
/
|
||
/NOW WE CAN OPEN THE FILE - JUST BUILD THE FILE CONTROL-
|
||
/BLOCK AND THE SEGMENT RETRIEVAL WINDOW.
|
||
OPN6, CLA CMA
|
||
DCA TABSTA /REMEMBER TO SAVE THE TABLES
|
||
JMS I OPNPRV /CHECK TO SEE IF THE 'PRIVILEGE' BIT GETS SET
|
||
ISZ OPNBUF
|
||
TAD I OPNBUF /GET THE FILE SIZE (FOR BASIC CHECK)
|
||
DCA OPNSIZ
|
||
ISZ OPNBUF
|
||
ISZ OPNBUF
|
||
TAD I OPNBUF /GET THE RETRIEVAL WINDOW ADDRESS
|
||
DCA .+3
|
||
TAD FIOSTK+2
|
||
JMS I GE01 /NOW READ IN THE FIRST WINDOW
|
||
0
|
||
DCA OPNWND / AND SAVE ITS IN-CORE ADDRESS
|
||
TAD FIOSTK+1
|
||
TAD OPNJF0 /FIND THE FILE STATUS WORD
|
||
DCA .+2
|
||
FGETJT / & GET ITS ADDRESS
|
||
OPNPTR, 0
|
||
JMS I GTBLO1 /THEN GET A LINKED-BLOCK FOR FILE CONTROL
|
||
DCA OPNBUF / (POINTS TO WINDOW-ADDRESS)
|
||
CLA CLL CML RTL /GET THE PROTECTION-WORD LOCATION
|
||
TAD OPNBUF
|
||
DCA CFH
|
||
TAD OPNFLG / AND SET THE PROTECTION-WORD IN THE BLOCK
|
||
DCA I CFH / 0=READ/WRITE; 4=READ ONLY
|
||
/
|
||
/NOW WE CHECK TO SEE IF THIS IS BASIC AND SHOULD HAVE ITS
|
||
/OWN PRIVATE RETRIEVAL WINDOW.
|
||
TAD FIOSTK+3
|
||
TAD OPNBAS
|
||
SZA CLA / "BA"?
|
||
JMP OPN11 /NO
|
||
CLA CLL CMA RAL
|
||
TAD OPNACT
|
||
SNA CLA /IS IT FROM THE SYSTEM LIBRARY?
|
||
TAD FIOSTK+4 /YES
|
||
TAD OPNBAS+1
|
||
SNA CLA / "BASI"?
|
||
TAD FIOSTK+5
|
||
TAD OPNBAS+2
|
||
SNA CLA / "BASIC "?
|
||
TAD OPNFLG
|
||
SNA CLA /YES - CAN HE ALTER IT?
|
||
JMP OPN11 /YES - NO SPECIAL WINDOW
|
||
TAD OPNSIZ
|
||
TAD BASWIN
|
||
SMA CLA /NO - IS IT TOO LARGE?
|
||
JMP OPN10 /YES - INVALIDATE THE SPECIAL WINDOW
|
||
/
|
||
/HERE WE BUILD THE SPECIAL WINDOW FOR BASIC. NOTE THAT WHEN BASIC
|
||
/IS TOO LARGE FOR THE WINDOW, WE INVALIDATE IT. TO INSURE THAT
|
||
/THE SPECIAL WINDOW REFLECTS ANY CHANGES, WE ALWAYS REBUILD
|
||
/IT, SINCE WE (CURRENTLY) HAVE NO GRACEFUL WAY OF DETECTING
|
||
/A LONE USER CHANGING THE SIZE (SEVERAL USERS MAY NOW WRITE
|
||
/INTO A FILE SIMULTANEOUSLY).
|
||
CFLD
|
||
TAD BASWIN /NO - SET THE WINDOW POINTER
|
||
DCA OPNPTR
|
||
OPN7, TAD OPNWND / AND THE RETRIEVAL-BLOCK BUFFER-ADDRESS
|
||
DCA INDEX
|
||
TAD C7771
|
||
DCA CFH /SET THE SEGMENT/BLOCK COUNT (-7)
|
||
OPN8, TAD I INDEX /NOW GET A SEGMENT NUMBER
|
||
SNA /AT THE END OF THE SEGMENTS?
|
||
JMP OPN9 /YES
|
||
ISZ OPNPTR /NO - INCREMENT THE WINDOW POINTER
|
||
SKP
|
||
HLT /OOPS!! ERROR IN SIZE CHECK *****
|
||
DATFLD
|
||
DCA I OPNPTR /PLOP THE SEGMENT NUMBER INTO THE WINDOW
|
||
CFLD
|
||
ISZ CFH /INCREMENT COUNT
|
||
JMP OPN8 / & CONTINUE
|
||
TAD I OPNWND /GET THE NEXT BLOCK ADDRESS
|
||
SNA /ARE WE DONE?
|
||
JMP OPN9 /YES
|
||
DCA .+3 /NO - SET NEXT ENTRY ADDRESS
|
||
TAD FIOSTK+2
|
||
JMS I GE01 /NOW GET THE NEXT WINDOW IN CHAIN
|
||
OPNSIZ, 0
|
||
DCA OPNWND / & SAVE ITS CORE-ADDRESS
|
||
JMP OPN7 /OK - KEEP MOVING SEGMENT NUMBERS
|
||
OPN9, DATFLD
|
||
CLA CMA /ALL DONE - SET THE 'SET UP' SWITCH
|
||
DCA I BASWIN
|
||
SKP
|
||
DCA I OPNPTR /CLEAR THE REST OF THE SPECIAL WINDOW
|
||
ISZ OPNPTR
|
||
JMP .-2
|
||
TAD BASWIN /SET THE WINDOW ADDRESS IN THE
|
||
DCA I OPNBUF / FILE CONTROL-BLOCK
|
||
JMP OPN12 /NOW FINISH UP
|
||
/
|
||
/HERE WE FETCH A FREE-CORE BLOCK AND COPY THE FIRST WINDOW
|
||
/INTO IT.
|
||
OPN10, DCA I BASWIN /CLEAR THE BASIC WINDOW FLAG
|
||
OPN11, TAD OPNBUF /GET THE WINDOW-ADDRESS POINTER
|
||
JMS I GTBLO1 / & AND LINK A BLOCK TO IT
|
||
DCA OPNPRW
|
||
CFLD
|
||
CIF
|
||
BLT /NOW COPY OVER THE WINDOW
|
||
CFLD
|
||
OPNWND, 0 /SOURCE
|
||
DATFLD
|
||
OPNPRW, 0 /DESTINATION
|
||
-10 /WORD-COUNT
|
||
/
|
||
/ALL DONE - NOW JUST INCREMENT THE UFD-USAGE COUNT & EXIT.
|
||
OPN12, CFLD
|
||
CLA CMA
|
||
TAD I UTPRNU /INDICATE OUR UFD-USAGE
|
||
DCA I UTPRNU
|
||
JMP I .+1 /GO CLEAN UP & EXIT
|
||
OPNEXT
|
||
/
|
||
OPNJF0, JOBF0
|
||
OPNPRV, OPNPV0
|
||
OPNBAS, -4241 / (-) "BASIC " IN TSS/8 6-BIT
|
||
-6351
|
||
-4300
|
||
|
||
/
|
||
/SUBROUTINE TO CALCULATE THE PROTECTION CHECK-MASK. THIS
|
||
/IS BASED ON WHO THE FILE OWNER IS COMPARED TO WHO IS
|
||
/REQUESTING THE FILE.
|
||
OPNPR0, 0
|
||
TAD OPNACT
|
||
CIA
|
||
TAD FIACCT
|
||
SZA CLA /IS IT HIS OWN FILE?
|
||
CHKACT /NO - IS THIS A PRIVILEGED USER?
|
||
JMP OPNPR1 /YES - HE OWNS EVERYTHING
|
||
TAD OPNACT /NO - GET THE OWNER'S PROJECT
|
||
AND C7700
|
||
CIA
|
||
DCA OPNPRW
|
||
TAD FIACCT / AND THE REQUESTOR'S PROJECT
|
||
AND C7700
|
||
TAD OPNPRW
|
||
SNA CLA /DO THE PROJECT NUMBERS MATCH?
|
||
TAD P0003 /YES - MASK = 4
|
||
CLL IAC /NO - MASK = 1
|
||
SKP
|
||
OPNPR1, TAD C0010 /OWNS FILE - MASK = 10
|
||
JMP I OPNPR0 /RETURN WITH AC = MASK
|
||
PAGE
|
||
/ROUTINE TO CLOSE A FILE
|
||
|
||
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
|
||
SNL /BIT SET FOR THIS FILE #?
|
||
JMP .+3
|
||
TAD CLSIFN /YES - GET THE FILE #
|
||
JMS CL0 / AND CLOSE IT
|
||
ISZ CLSIFN /NEXT FILE NUMBER
|
||
ISZ CLCNTR /DONE ALL FOUR?
|
||
JMP CLS1 /NO, KEEP AT IT
|
||
JMP I FIEXIT /THROUGH
|
||
|
||
CLSIFN, 0
|
||
CLCNTR, 0
|
||
|
||
/ROUTINE TO DO ACTUAL FILE CLOSE
|
||
CL0, 0
|
||
JMS I EBLD0
|
||
DCA ENR0 /SAVE THE 'ENTTBL' POINTER
|
||
TAD CFH
|
||
JMS I LNK01 /RETURNS WITH PTR. TO FILE CONTROL BLOCK FROM JOB STATUS BLOCK
|
||
SNA
|
||
JMP CL3 /FILE WAS NOT OPEN
|
||
DCA ENR1 /SAVE IT
|
||
DCA I CFH /CLEAR POINTER TO FILE CONTROL BLOCK---INDICATES FILE CLOSED
|
||
CFLD /SET DATA FIELD TO THIS FIELD
|
||
TAD ENR1 /POINTER TO PARAMETER BLOCK
|
||
JMS I RETBK1 /RETURN THE CONTROL-BLOCK
|
||
DCA ENR1
|
||
TAD ENR1 /GET THE RETRIEVAL-WINDOW ADDR.
|
||
CIA
|
||
TAD BASWIN
|
||
SNA CLA /IS IT THE SPECIAL BASIC WINDOW?
|
||
JMP .+3 /YES - DON'T FREE IT
|
||
TAD ENR1 /NO - RETURN IT TO FREE-CORE
|
||
JMS I RETBK1
|
||
CLA CLL CMA
|
||
TAD I ENR0 /RELATIVE POINTER TO UFD RETRIEVAL TABLE
|
||
CLL RAL / * 2 (AND ZAP 'EXCLUSIVE USE' BIT)
|
||
IAC
|
||
TAD UFDTBL
|
||
DCA CLUFDP /POINTER TO ACCESS COUNTER
|
||
DCA I ENR0 /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
|
||
CLA CMA /NO ONE IS NOW ACCESSING THIS UFD
|
||
TAD CLUFDP
|
||
JMS I TF01 /FREE A TABLE ENTRY
|
||
JMP I CL0
|
||
|
||
CL3, CFLD
|
||
JMP I CL0
|
||
|
||
CLUFDP, 0
|
||
|
||
/FIND THE NUMBER OF PEOPLE ACCESSING THIS FILE
|
||
/SKIPS IF EXACTLY ONE USER IS
|
||
ENR0, 0
|
||
TAD FIOSTK+1
|
||
JMS I EBLD0
|
||
DCA ENR1 /PTR. INTO ENTTBL
|
||
ISZ ENR1
|
||
TAD I ENR1 /GET ADDRESS IN UFD
|
||
DCA ENR1
|
||
TAD GDRETP /RTABLE
|
||
JMS I ENS01 /HOW MANY PEOPLE HAVE THIS FILE OPEN?
|
||
ENR1, 0
|
||
CIA /RETURNS WITH # OF PEOPLE WHO HAVE THIS FILE OPEN
|
||
CMA
|
||
SNA CLA /IS THE PERSON TRYING TO CHANGE THE FILE THE
|
||
ISZ ENR0 /...ONLY ONE WHO HAS IT OPEN?
|
||
JMP I ENR0 /YES, SO SKIP
|
||
|
||
/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
|
||
TAD PRIFNU
|
||
JMS I GD01 /GET THIS DIRECTORY ENTRY INTO CORE
|
||
SNA
|
||
HLT /WHOOPS - ERROR *****
|
||
TAD P0004
|
||
DCA PRENTP /POINTER TO PROTECTION BITS OF THIS FILE
|
||
TAD C7637
|
||
AND FIOSTK+1 /PICK UP NEW PROTECTION BITS
|
||
DCA I PRENTP / AND SET INTO THE DIRECTORY ENTRY
|
||
SAVBUF /THEN RE-WRITE THE BUFFER
|
||
JMP I FIEXIT
|
||
|
||
PRT1, SZA CLA /ERROR
|
||
CLL CML RAR /6000 - "PROTECTION VIOLATION"
|
||
CLL CML RAR /4000 - "NO FILE OPEN"
|
||
DCA FIUSAC
|
||
JMP I FIEXIT
|
||
|
||
PRIFNU, 0
|
||
PRENTP, 0
|
||
C7637, 7637
|
||
/ROUTINE TO BUILD A RETRIEVAL POINTER FROM THE RELATIVE
|
||
/POSITION IN RETTBL (WHICH IS ALSO THE ENTTBL POINTER).
|
||
|
||
/CALLING SEQUENCE:
|
||
/ TAD (RELATIVE POSITION)
|
||
/ JMS I BLDP1
|
||
/ RETURN (POINTER IN AC)
|
||
|
||
BLDP, 0
|
||
AND C3777 /ZAP THE 'EXCLUSIVE USE' BIT
|
||
DCA CFH
|
||
CLA CMA
|
||
TAD CFH /POINTER = [(PTR - 1) * 8 + RETTBL]
|
||
CLL RAL; RTL
|
||
TAD RETTBL
|
||
JMP I BLDP /RETURN
|
||
|
||
/ROUTINE TO WRITE OUT THE SEGMENT-BUFFER IF NECESSARY.
|
||
|
||
WRITE, 0
|
||
ISZ BUFWRT /NEED IT BE SAVED?
|
||
JMP I WRITE /NO - JUST RETURN
|
||
TAD C6605 /YES - SET THE 'WRITE' IOT
|
||
DCA FLPARB
|
||
JMS I FIO01 /THEN DO THE I/O
|
||
HLT /ERROR ON WRITE - JUST CRASH *****
|
||
JMP I WRITE / OTHERWISE RETURN
|
||
|
||
/ROUTINE TO CHECK THIS USER'S ACCOUNT NUMBER AND
|
||
/SKIP IF HE IS A NORMAL USER; RETURN IS TO THE NEXT
|
||
/INSTRUCTION IF HE IS EITHER THE SYSTEM MANAGER
|
||
/(ACCOUNT NUMBER 0001) OR THE BILLING SYSTEM.
|
||
|
||
CHKAC0, 0
|
||
CLA CMA
|
||
TAD FIACCT
|
||
SNA CLA /IS IT THE SYSTEM MANAGER?
|
||
JMP I CHKAC0 /YES - SPECIAL EXIT
|
||
|
||
IFNZRO BILLNG <
|
||
TAD FIACCT
|
||
TAD LOGACT
|
||
SZA CLA /NO - IS IT THE BILLING SYSTEM?
|
||
>
|
||
ISZ CHKAC0 /NO - NORMAL EXIT
|
||
JMP I CHKAC0
|
||
PAGE
|
||
/ROUTINE TO MOVE THE RETRIEVAL WINDOW IN FIELD ZERO
|
||
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 DISC ADDRESS
|
||
DCA WNDCNT /GET INTO CORE
|
||
STA
|
||
TAD SEGSIZ
|
||
AND FIOSTK+1 /GET HIGH ORDER FILE ADDRESS
|
||
DCA WNDIRP
|
||
TAD SEGSIZ /GET RID OF ADDRESS WITHIN SEGMENT
|
||
CIA
|
||
AND WND5
|
||
CLL RAL
|
||
TAD WNDIRP /WE NOW HAVE ALL THE NECESSARY BITS
|
||
RTL; RTL / SO SHIFT THEM AROUND
|
||
DCA WNSEGC /SAVE AS SEGMENT # TO GET
|
||
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 WND20 /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 RETIEVAL WINDOW
|
||
SNA CLA / = 1?
|
||
JMP WND6 /INVALID WINDOW POINTER
|
||
TAD WNCURS /CURRENT SEGMENT AT TOP OF CURRENT CORE WINDOW
|
||
CLL CML 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
|
||
SNA SZL
|
||
JMP WND6 /PREVIOUS BLOCK, SO MUST START AT BEGINNING OF STRING
|
||
JMS WND20 /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, CIF
|
||
BLT
|
||
CFLD /SOURCE FIELD
|
||
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
|
||
JMP I .+1 /GO SET "JSIOTC" BEFORE EXITTING
|
||
INF6
|
||
|
||
WND6, CFLD /CHANGE TO CURRENT FIELD
|
||
CLA CLL
|
||
TAD WNSEGC /SEGMENT TO GET INTO IN CORE WINDOW
|
||
JMS WND20 /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
|
||
|
||
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
|
||
WNCURS, 0
|
||
|
||
/ROUTINE TO DIVIDE A NUMBER BY 7.
|
||
/QUOTIENT IS RETURNED IN THE AC; REMAINDER
|
||
/IS LEFT IN 'WNDREM' ON PAGE ZERO.
|
||
|
||
WND20, 0
|
||
DCA WNDREM /SAVE THE NUMBER
|
||
DCA CFH /CLEAR THE QUOTIENT
|
||
TAD WNDREM
|
||
CLL CML
|
||
TAD C7771 /SUBTRACT 7
|
||
SZL /DID WE GO TOO FAR?
|
||
JMP .+3 /YES - ALL DONE
|
||
ISZ CFH /NO - INCREMENT THE QUOTIENT
|
||
JMP .-5 / & TRY ANOTHER SUBTRACTION
|
||
TAD P0007
|
||
DCA WNDREM /SAVE THE REMAINDER
|
||
TAD CFH /THEN RETURN WITH THE QUOTIENT
|
||
JMP I WND20
|
||
|
||
/ROUTINE TO CHECK THE SOURCE OF THE FIP CALL
|
||
/AND SKIP IF WE WERE CALLED BY 'SI'.
|
||
CHKSR0, 0
|
||
CLA
|
||
CDF
|
||
TAD I FANFLD /GET THE 'CORTBL' ENTRY
|
||
CFLD
|
||
AND FIPFIP
|
||
SNA CLA /'FIP' BIT SET?
|
||
ISZ CHKSR0 /NO - MUST BE FROM 'SI'
|
||
JMP I CHKSR0
|
||
|
||
/ROUTINE TO SET THE 'BUFFER CHANGED' SWITCH SO THAT THE
|
||
/SEGMENT BUFFER WILL BE WRITTEN BACK OUT BEFORE THE NEXT
|
||
/BLOCK IS READ OR WHEN FIP EXITS.
|
||
SAVBF0, 0
|
||
CLA CMA
|
||
DCA BUFWRT /'BUFFER CHANGED' = -1
|
||
JMP I SAVBF0
|
||
PAGE
|
||
/ROUTINE TO CREATE A NEW FILE
|
||
|
||
CRF0, TAD FIOSTK+1
|
||
SNA CLA /IS THE NAME REASONABLE?
|
||
JMP CRFER2 /NO - NO POINT CONTINUING
|
||
TAD FIACCT /GET USER'S ACCT #
|
||
JMS I UTS01 /SEARCH THE UFD TABLE
|
||
HLT /MUST BE AN ENTRY IF WE'RE LOGGED-IN *****
|
||
JMS I BLDP1 /BUILD A POINTER INTO RETTBL
|
||
DCA FIOSTK / FOR THE DIRECTORY-SEARCH
|
||
CRF1, CLA CMA
|
||
TAD FIACCT
|
||
SNA CLA /WILL THIS FILE BE A DIRECTORY?
|
||
CLA CMA /YES - THEN NEW ACCOUNT NUMBER MUST BE UNIQUE
|
||
JMS I DS01 /SEARCH THE DIRECTORY FOR THIS NAME
|
||
FIOSTK
|
||
JMP CRF2 /COULD NOT FIND THIS NAME, CONTINUE
|
||
DCA CRBUFP /FILE ALREADY EXISTS - SAVE POINTER
|
||
CLA CMA
|
||
TAD FIACCT
|
||
SNA CLA /ARE WE THE MANAGER (I.E. IS THIS A DIRECTORY)?
|
||
JMP CRFER3 /YES - WE WON'T AUTOMATICALLY DELETE
|
||
TAD I ZDS1 /GET ITS RELATIVE UFD-ENTRY LOCATION
|
||
DCA CRFSEG /UFD ADDRESS OF DIRECTORY ENTRY
|
||
TAD FIOSTK
|
||
JMS I ENS01 /SEARCH ENT TABLE FOR ACCESSES TO THIS FILE
|
||
CRFSEG, 0 /UFD ADDR. OF DIRECTORY ENTRY
|
||
SZA CLA /RETURNS WITH # OF ACCESSES TO THIS FILE
|
||
JMP CRFER5 /ERROR - FILE IS IN USE
|
||
|
||
/COMES HERE IF A FILE BY THIS NAME ALREADY EXISTS, BUT NOONE
|
||
/HAS OPENED IT
|
||
TAD CRFSEG
|
||
DCA I CRGD11 /SET DIRECTORY-ENTRY LOCATION FOR 'RED1'
|
||
TAD FIOSTK
|
||
DCA GDRETP / ALONG WITH THE 'RETTBL' ENTRY ADDRESS
|
||
TAD CRBUFP
|
||
TAD P0004 /GET THE PROTECTION-WORD LOCATION
|
||
DCA CRFENT
|
||
TAD I CRFENT
|
||
AND C0020
|
||
SZA CLA /IS THE FILE WRITE-PROTECTED AGAINST OWNER?
|
||
JMP CRFER3 /YES - SAY "PROTECTION VIOLATION"
|
||
TAD CRBUFP
|
||
JMS I RED11 /NO - DELETE THE FILE
|
||
JMP CRF1 / AND LOOK AGAIN FOR THE CHAIN END
|
||
|
||
/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 CALLLS 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, SNA /WERE WE PASSED THE LAST LINK-ADDRESS?
|
||
TAD P0003 /NO - MUST BE EMPTY DIRECTORY
|
||
DCA CRFLNK /ADDR. OF LINK WORD OF LAST ENTRY IN UFD CHAIN
|
||
TAD FIOSTK /POINTER TO RETRIEVAL INFORMATION
|
||
JMS I DE01 /FIND AN EMPTY DIRECTORY ENTRY
|
||
JMP CRFER4+1 /ERROR - "USER DIRECTORY FULL"
|
||
DCA CRFENT
|
||
TAD CRFENT
|
||
JMS CRFGET /GET THE WORD INTO CORE
|
||
CLA CMA
|
||
DCA I CRBUFP /SIMULATE A USED ENTRY
|
||
TAD FIOSTK
|
||
JMS I DE01 /NOW FIND AN ENTRY FOR THE RETRIEVAL-BLOCK
|
||
JMP CRFER4 /NONE AVAILABLE - "DIRECTORY FULL"
|
||
DCA CRFRET
|
||
TAD CRFRET
|
||
JMS CRFGET /MAKE SURE THE ENTRY IS IN CORE
|
||
JMS I SATL1 /FIND A FREE SEGMENT IN THE SAT
|
||
SNA
|
||
JMP CRFER1 /NONE AVAILABLE - "DISC FULL"
|
||
|
||
/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
|
||
ISZ CRBUFP
|
||
DCA I CRBUFP /SAVE THE SEGMENT NUMBER IN THE RETRIEVAL BLOCK
|
||
TAD I CRBUFP
|
||
DCA CRFSEG /SAVE THE INDEX FOR CLEARING LATER
|
||
TAD CRFENT
|
||
JMS CRFGET /GET BACK THE DIRECTORY NAME-ENTRY
|
||
CLA CMA
|
||
TAD CRBUFP
|
||
DCA INDEX
|
||
TAD FIOSTK+1 /TRANSFER FILE NAME INTO DIRECTORY ENTRY
|
||
DCA I INDEX
|
||
TAD FIOSTK+2
|
||
DCA I INDEX
|
||
TAD FIOSTK+3
|
||
DCA I INDEX
|
||
DCA I INDEX /LEAVE A WORD FOR THE NEXT FORWARD LINK
|
||
TAD CRPROT
|
||
DCA I INDEX /SET THE INITIAL PROTECTION
|
||
CLA CLL IAC
|
||
DCA I INDEX /INITIAL FILE-SIZE IS 1 SEGMENT
|
||
CDF
|
||
TAD I DATEA /PICK UP TODAY'S DATE
|
||
CFLD
|
||
DCA I INDEX / & SAVE AS DATE OF CREATION
|
||
TAD CRFRET
|
||
DCA I INDEX /SET THE RETRIEVAL-BLOCK LOCATION
|
||
TAD CRFLNK
|
||
JMS CRFGET /GET THE DIRECTORY FORWARD-LINK INTO CORE
|
||
TAD CRFENT
|
||
DCA I CRBUFP / & SET THIS ENTRY'S ADDRESS
|
||
TAD CRFSEG
|
||
JMS I SCL01 /NOW ZERO THE INITIAL SEGMENT
|
||
JMP I FIEXIT / & EXIT
|
||
|
||
/CODE TO RETURN THE VARIOUS 'CREATE' ERROR STATUSES.
|
||
CRFER1, JMS CRFCLR /CLEAR THE 'DUMMY ENTRY' WORD
|
||
CLA CLL IAC /7400 - "DISC IS FULL"
|
||
CRFER2, CLL CML RTR /6400 - "INVALID FILE NAME"
|
||
CRFER3, CLL CML RAR /6000 - "PROTECTION VIOLATION"
|
||
JMP .+4
|
||
CRFER4, JMS CRFCLR /5000 - "USER DIRECTORY FULL"
|
||
TAD P1000
|
||
CRFER5, TAD P1000 /4400 - "ANOTHER USER HAS FILE OPEN"
|
||
CLL CML RAR
|
||
DCA FIUSAC /RETURN THE CODE IN HIS AC
|
||
JMP I FIEXIT
|
||
|
||
/ROUTINE TO CLEAR THE 'DUMMY ENTRY' WORD WE PLACE IN THE
|
||
/DIRECTORY ENTRY. WE HAVE TO DO THIS WHEN AN ERROR OCCURS.
|
||
CRFCLR, 0
|
||
TAD CRFENT
|
||
JMS CRFGET /GET THE ENTRY INTO CORE
|
||
DCA I CRBUFP / & CLEAR THE FIRST WORD
|
||
JMP I CRFCLR /THEN JUST RETURN
|
||
|
||
/ROUTINE TO READ IN A SEGMENT AND SET 'CRBUFP'. IT ALSO
|
||
/SETS THE 'BUFFER CHANGED' SWITCH.
|
||
CRFGET, 0
|
||
DCA .+3 /SET THE ENTRY-ADDRESS
|
||
TAD FIOSTK
|
||
JMS I GE01 /GET THE DIRECTORY WORD
|
||
CRBUFP, 0
|
||
DCA CRBUFP /SAVE THE BUFFER-ADDRESS
|
||
SAVBUF / AND SET THE 'SAVE BUFFER' SWITCH
|
||
JMP I CRFGET /THEN RETURN
|
||
|
||
CRFENT, 0
|
||
CRFLNK, 0
|
||
CRFRET, 0
|
||
CRGD11, GD1
|
||
CRPROT, 12 /INITIAL FILE PROTECTION-WORD
|
||
DATEA, DATE
|
||
RED11, RED1
|
||
PAGE
|
||
/ROUTINE TO EXTEND A FILE
|
||
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 /SET THE RETRIEVAL-CHAIN POINTER
|
||
|
||
/NOW TRACE THRU 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
|
||
JMP EXT4 /KEEP LOOKING FOR END
|
||
|
||
EXT3, TAD FIOSTK+2 /NUMBER OF SEGMENTS TO ADD
|
||
CMA
|
||
DCA EXSEGC
|
||
DCA EXLAST /CLEAR THE 'NEW LINK' SWITCH
|
||
EXT5, ISZ EXBUFP
|
||
TAD I EXBUFP /PICK UP ENTRY IN WINDOW
|
||
SNA CLA /IS IT THE FIRST FREE ENTRY?
|
||
JMP EXT6 /YES - START EXTENDING
|
||
TAD EXBUFP
|
||
AND P0007
|
||
SZA CLA /NO - AT END OF BLOCK?
|
||
JMP EXT5 /NO - KEEP LOOKING
|
||
/
|
||
/NOW AT END OF LIST OF SEGMENTS MAKING UP THIS FILE
|
||
EXT6, ISZ EXSEGC /START EXTENDING
|
||
JMP EXT7 /GET ANOTHER SEGMENT
|
||
EXT20, TAD EXSEGC
|
||
CIA
|
||
DCA FIUSAC /NUMBER OF SEGMENTS WE FAILED TO FIND
|
||
TAD EXLAST /GET THE LAST WINDOW ADDRESS
|
||
SNA /IS IT LINKED TO NOTHINGNESS?
|
||
JMP EXT21 /NO - NO PROBLEM
|
||
JMS EXGE0 /YES - GET THE PREVIOUS BLOCK
|
||
DCA I EXBUFP / AND CLEAR ITS FORWARD LINK
|
||
SAVBUF /REMEMBER TO REWRITE THE BUFFER
|
||
EXT21, TAD FIOSTK+1 /NOW UPDATE THE DIRECTORY ENTRY
|
||
JMS I GD01 /GET DIRECTORY ENTRY INTO CORE
|
||
TAD C0005
|
||
|
||
/HAVE A NEW BLOCK FOR RETRIEVAL
|
||
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
|
||
SAVBUF / AND SET 'BUFFER CHANGED' SWITCH
|
||
EXT8, DATFLD /SET DATA FIELD TO FIELD 1
|
||
TAD I EXFCBP
|
||
DCA EXPROP /POINTER TO RETRIEVAL WINDOW
|
||
IAC
|
||
DCA I EXPROP /INVALIDATE THE WINDOW
|
||
JMP I FIEXIT
|
||
|
||
EXT7, TAD EXBUFP
|
||
AND P0007
|
||
SZA CLA /DO WE NEED A NEW BLOCK?
|
||
JMP EXT12 /NO
|
||
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
|
||
TAD EXNFRE /NEXT FREE WINDOW
|
||
DCA I EXBUFP /LINK IT ONTO CHAIN
|
||
SAVBUF / AND SET 'CHANGED' SWITCH
|
||
TAD EXWNDP /SAVE PREVIOUS BLOCK LOCATION
|
||
DCA EXLAST / IN CASE WE RUN OUT OF DISC NOW
|
||
TAD EXNFRE
|
||
DCA EXWNDP /UPDATE CURRENT WINDOW POINTER
|
||
TAD EXWNDP
|
||
JMS EXGE0 /GET NEW WINDOW INTO CORE
|
||
ISZ EXBUFP /POINTER TO FIRST ENTRY OF WINDOW
|
||
EXT12, JMS I SATL1 /GET A FREE SEGMENT FROM SAT
|
||
SNA
|
||
JMP EXT20 /PARTIALLY SATISFIED
|
||
DCA I EXBUFP /SET THE SEGMENT # IN THE WINDOW
|
||
ISZ EXBUFP
|
||
SAVBUF /SET 'BUFFER CHANGED' SWITCH
|
||
DCA EXLAST / AND CLEAR 'NEW LINK' SWITCH
|
||
JMP EXT6 /FILL NEXT WORD
|
||
|
||
|
||
EXGE0, 0 /GET WORD OF THIS UFD INTO CORE
|
||
DCA .+3 /STORE THE WORD NUMBER
|
||
TAD GDRETP
|
||
JMS I GE01 /FETCH THE WORD
|
||
EXBUFP, 0
|
||
DCA EXBUFP /SET THE BUFFER POINTER
|
||
JMP I EXGE0
|
||
|
||
EXT30, TAD P1000 /4400 - "ANOTHER USER HAS FILE OPEN"
|
||
SKP
|
||
EXT10, CLL CML RAR /6000 - "PROTECTION VIOLATION"
|
||
CLL CML RAR /4000 - "NO FILE OPEN"
|
||
DCA FIUSAC
|
||
JMP I FIEXIT
|
||
|
||
EXFCBP, 0
|
||
EXLAST, 0
|
||
EXNFRE, 0
|
||
EXPROP, 0
|
||
EXSEGC, 0
|
||
EXWNDP, 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
|
||
/NOONE 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
|
||
JMS I LNK01 /GET PTR. TO APPROPRIATE FILE CONTROL BLOCK
|
||
SNA
|
||
JMP EXT10+1 /ERROR, FILE NOT OPEN
|
||
DCA EXFCBP /FILE CONTROL BLOCK POINTER
|
||
TAD FILPRP /GLOBAL TO "FILPRO"
|
||
TAD EXFCBP
|
||
DCA EXPROP /POINTER TO PROTECTION BIT IN FIELD 0
|
||
DATFLD /CDF FIELD 0
|
||
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
|
||
TAD FIOSTK+1 /INTERNAL FILE NUMBER
|
||
JMS I GD01 /GET DIRECTORY ENTRY INTO CORE
|
||
DCA EXBUFP /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 EXBUFP
|
||
JMP I EXT1
|
||
|
||
ENR01, ENR0
|
||
PAGE
|
||
/ROUTINE TO REDUCE A FILE
|
||
|
||
RED0, JMS I EXT11 /MAKE SURE IT'S OKAY TO REDUCE THIS FILE
|
||
DCA REBUFP /...IF OKAY, RETURNS WITH PTR. TO FILE NAME BLOCK
|
||
TAD REBUFP
|
||
TAD C0005
|
||
DCA RELINK /NOW POINTS TO NUMBER OF SEGMENTS PRESENTLY IN FILE
|
||
TAD FIOSTK+2 /SEGMENTS TO BE REMOVED
|
||
SNA /IS HE REDUCING IT AT ALL?
|
||
JMP I FIEXIT /NO - SAVE OURSELVES WORK & AVOID A BUG
|
||
SPA /IS IT NEGATIVE?
|
||
CLA CLL CMA RAR /REPLACE THE NEGATIVE # BY 3777.
|
||
CIA
|
||
TAD I RELINK
|
||
SMA SZA /DELETE THE FILE?
|
||
JMP RED6 /NO, REDUCE IT
|
||
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
|
||
SAVBUF / & INDICATE BUFFER CHANGED
|
||
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 .+1 /THEN GO INVALIDATE THE RETRIEVAL WINDOW
|
||
EXT8
|
||
|
||
/ROUTINE TO DELETE A FILE
|
||
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
|
||
SAVBUF /YES - SET 'BUFFER CHANGED'
|
||
RED5, DCA .+3 /NOW SET THE ENTRY ADDRESS
|
||
TAD GDRETP
|
||
JMS I GE01 / AND GET A DIRECTORY ENTRY IN CORE
|
||
REDPTR, 0
|
||
TAD P0003 /GET TO THE LINK POINTER
|
||
DCA REDPTR
|
||
TAD I REDPTR /GET THE LINK TO THE NEXT ENTRY
|
||
CIA
|
||
TAD RED4
|
||
SNA CLA /IS IT THE ENTRY WE'RE DELETING?
|
||
JMP .+3 /YES
|
||
TAD I REDPTR /NO - GET ITS ADDRESS
|
||
JMP RED5 / AND KEEP SEARCHING
|
||
TAD RED3 /SET THE NEW LINK TO NEXT ENTRY
|
||
DCA I REDPTR / SO IT LINKS AROUND THE DELETED FILE
|
||
SAVBUF /SET 'BUFFER CHANGED'
|
||
JMS RED40 / AND GO DELETE THE FILE ITSELF
|
||
JMP I RED1
|
||
|
||
RED3, 0 /UFD ADDRESS OF NEXT ENTRY IN DIRECTORY CHAIN
|
||
RED4, 0 /UFD ADDRESS OF THIS DIRECTORY ENTRY
|
||
REDGD1, GD1
|
||
|
||
/ROUTINE TO REDUCE A FILE - ENTER WITH THE NUMBER OF
|
||
/SEGMENTS WHICH ARE TO REMAIN.
|
||
RED40, 0
|
||
DCA CFH
|
||
TAD GDRETP /RTABLE
|
||
DCA RERETP
|
||
TAD CFH /# OF SEGMENTS TO REMAIN
|
||
JMS I RED302 /ROUTINE TO DO ACTUAL REDUCTION
|
||
RELINK, 0 /RETRIEVAL CHAIN PTR
|
||
RERETP, 0 /UFD RETRIEVAL PTR.
|
||
JMP I RED40
|
||
|
||
EXT11, EXT1
|
||
RED302, RED30
|
||
REBUFP, 0
|
||
/SEARCH ENTTBL FOR OPENINGS TO FILE
|
||
/CALLING SEQUENCE:
|
||
/ TAD (RETRIEVAL POINTER)
|
||
/ JMS I ENS01
|
||
/ UFD ADDRESS OF DIRECTORY ENTRY
|
||
/ RETURN (COUNT OF ACCESSES IN AC)
|
||
|
||
ENS0, 0
|
||
JMS ENS3
|
||
CMA
|
||
DCA ENRETP / (-) RELATIVE POINTER
|
||
DCA ENACNT /CLEAR ACCESS COUNTER
|
||
TAD ENTTBL
|
||
DCA ENTPTR
|
||
ENS2, TAD I ENTPTR /GET THE UFD POINTER FOR THIS FILE
|
||
AND C3777 / ZAP THE 'EXCLUSIVE USE' BIT
|
||
TAD ENRETP / AND SUBTRACT THE ONE WE WANT
|
||
ISZ ENTPTR
|
||
SZA CLA /FILE IN SAME UFD?
|
||
JMP ENS1 /NO - KEEP LOOKING
|
||
TAD I ENTPTR
|
||
CIA
|
||
TAD I ENS0
|
||
SZA CLA /YES - SAME FILE LOCATION?
|
||
JMP ENS1 /NO
|
||
ISZ ENACNT /YES - INCREMENT ACCESS COUNT
|
||
TAD ENTPTR / AND SAVE 'FIND' LOCATION
|
||
DCA ENSFND
|
||
ENS1, ISZ ENTPTR
|
||
TAD ENTPTR
|
||
CIA
|
||
TAD ENTEND /END OF ENT TABLE
|
||
SZA CLA
|
||
JMP ENS2 /KEEP LOOKING
|
||
TAD ENACNT /PICK UP ACCUMULATED ACCESS COUNT
|
||
ISZ ENS0
|
||
JMP I ENS0
|
||
|
||
ENTPTR, 0
|
||
ENRETP, 0
|
||
ENACNT, 0
|
||
|
||
/CONVERT AN ABSOLUTE PTR INTO RETTBL TO A RELATIVE ENTRY NUMBER
|
||
ENSFND, /LOCATION OF LAST 'FIND' IN ENTTBL
|
||
ENS3, 0
|
||
CIA
|
||
TAD RETTBL /REL. PTR. TO ADDRESS WITHIN RETTBL
|
||
CIA
|
||
AND P7770
|
||
CLL RTR; RAR / DIVIDED BY 8
|
||
JMP I ENS3
|
||
PAGE
|
||
/ROUTINE TO PROVIDE FILE INFORMATION
|
||
|
||
INF0, JMS I IFN01 /GET INTERNAL FILE NUMBER IN FIOSTK+1
|
||
JMS I EBLD0
|
||
DCA CFH /RELATIVE POINTER TO UFD RETRIEVAL INFORMATION
|
||
DCA FIOSTK
|
||
DCA FIOSTK+2 /CLEAR OWNER JUST IN CASE
|
||
TAD I CFH /GET PTR. TO RETTBL OUT OF ENTTBL
|
||
SNA /DOES IT EXIST?
|
||
JMP INF5 /NO, SO FILE IS NOT OPEN
|
||
CIA
|
||
CLL CMA RAL / * 2 (AND ZAP 'EXCLUSIVE USE' BIT)
|
||
TAD UFDTBL
|
||
DCA INUFDP /POINTER TO USER PROJ,PROG NUMBER
|
||
RAR /GET BACK THE 'EXCLUSIVE USE' BIT
|
||
TAD FIOSTK+1 / AND SAVE IT WITH THE FILE #
|
||
DCA INF4
|
||
TAD I INUFDP
|
||
DCA FIOSTK+2 /SET THE OWNER'S ACCOUNT (ALSO FOR 'GD0')
|
||
TAD FIOSTK+1 /NOW GET THE INTERNAL FILE #
|
||
JMS I GD01 / AND GET THE FILE'S DIRECTORY ENTRY
|
||
CIA
|
||
CMA
|
||
DCA INDEX
|
||
TAD INF4 /SEND BACK THE 'EXCLUSIVE USE' BIT
|
||
DCA FIOSTK+1 / WITH THE FILE #
|
||
TAD I INDEX /NOW THE
|
||
DCA FIOSTK+3
|
||
TAD I INDEX / FILE
|
||
DCA FIOSTK+4
|
||
TAD I INDEX / NAME
|
||
DCA FIOSTK+5
|
||
ISZ INDEX
|
||
TAD I INDEX
|
||
DCA FIOSTK+6 /RETURN THE PROTECTION-WORD
|
||
TAD I INDEX
|
||
DCA FIOSTK+7 / AND THE SIZE
|
||
CLA CMA
|
||
TAD FIOSTK+2
|
||
SZA CLA /IS THIS FILE A DIRECTORY?
|
||
JMP INF5 /NO
|
||
DCA FIOSTK+4 /YES - CLEAR THE PASSWORD
|
||
TAD I INDEX / AND RETURN THE DATE-WORD (CPU TIME)
|
||
DCA FIOSTK+5 / (THE SIZE-WORD IS THE DEVICE-TIME)
|
||
INF5, DATFLD
|
||
TAD I FIOPTR /PICK UP JOBLNK WORD FROM JOB STATUS BLOCK
|
||
DCA INF4 /DESTINATION IN FIELD 0
|
||
CFLD /CHANGE TO PRESENT FIELD
|
||
CIF
|
||
BLT /MOVE FIOSTK INFORMATION INTO IOT PARAMETER BLOCK
|
||
CFLD /SOURCE FIELD
|
||
FIOSTK /SOURCE
|
||
DATFLD /DESTINATION FIELD 0
|
||
INF4, 0 /DESTINATION
|
||
-10 /WORD COUNT
|
||
TAD P0007 /GET THE NUMBER OF PARMS TO RETURN
|
||
INF6, CLL RTL; RTL; RAL
|
||
DCA INSPTR
|
||
TAD FILINK /GET THE LINK-SAVE WORD
|
||
AND C7037 / ZAP THE OLD COPY-COUNT
|
||
TAD INSPTR
|
||
DCA FILINK / AND SET THE NEW COUNT
|
||
CHKSRC /WERE WE CALLED FROM 'SI'?
|
||
SKP
|
||
JMP I FIEXIT /YES - CAN'T SET 'JSIOTC' OR SCHEDULER FOULS UP
|
||
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
|
||
|
||
C7037, 7037
|
||
INUFDP, 0
|
||
LGIDDB,
|
||
INSPTR, 0
|
||
INIOTC, JSIOTC
|
||
/LOGIN ROUTINE
|
||
|
||
LGI0, TAD RETTBL /MFD RETRIEVAL IS IN ENTRY 0
|
||
DCA FIOSTK+1
|
||
TAD FIOSTK+2
|
||
SNA CLA /IS THE ACCOUNT # AT ALL REASONABLE?
|
||
JMP LGI20 /NO - CAN'T LOG IN
|
||
TAD FIOSTK+3
|
||
SNA CLA /IS THE FIRST WORD OF THE PASSWORD ZERO?
|
||
TAD FIOSTK+4 /YES - THE 2ND WORD NON-ZERO FLAGS NO PASSWORD NEEDED
|
||
JMS I DS01 /SEARCH THE MFD (AC=0 TO INDICATE 3-WORD SEARCH)
|
||
FIOSTK+1
|
||
JMP LGI20 /COULD NOT FIND ENTRY IN MFD
|
||
CLA CLL / (ENTRY ADDRESS RETURNED IN AC)
|
||
TAD FIOSTK+2 /GET THE ACCOUNT NUMBER
|
||
JMS I UFO01 / AND OPEN THE UFD (I.E. FETCH RETRIEVAL INFO)
|
||
JMP LGI20 /COULD NOT FIND ROOM ON TABLE
|
||
CLA CMA
|
||
TAD I UTPRNU
|
||
DCA I UTPRNU /ACCOUNT FOR NEW ENTRY IN ACCESS COUNT
|
||
TAD FIJOB /NOW GET THE KEYBOARD NUMBER
|
||
TAD TTYTBA / FOR THIS JOB
|
||
DCA LGIDDB
|
||
DATFLD
|
||
TAD I LGIDDB
|
||
CLL RAL
|
||
TAD DEVTBA /FIND ITS DDB ADDRESS
|
||
DCA LGIDDB
|
||
TAD I LGIDDB /GET THE LOCATION OF THE
|
||
TAD P0003 / 'ASSIGNED TIME' WORD
|
||
DCA LGIDDB
|
||
CDF
|
||
TAD I CLK1A /NOW CALCULATE THE VALUE FOR
|
||
AND C7000
|
||
CLL RAL
|
||
DCA CFH
|
||
TAD I CLK2A
|
||
AND P0777
|
||
TAD CFH
|
||
RTL
|
||
RAL
|
||
DATFLD
|
||
DCA I LGIDDB /THEN SET THE CURRENT TIME IN THE DDB
|
||
JMP I .+1 /NOW WRITE OUT THE TABLES
|
||
TABOUT
|
||
|
||
LGI20, CLA CMA /COULD NOT LOGIN - RETURN WITH 7777
|
||
DCA FIUSAC /INDICATE INABILITY TO LOGIN
|
||
JMP I FIEXIT
|
||
|
||
CLK1A, CLK1
|
||
CLK2A, CLK2
|
||
TTYTBA, TTYTBL
|
||
PAGE
|
||
/ROUTINE TO PERFORM ACTUAL FILE REDUCTION
|
||
|
||
/CALLING SEQUENCE:
|
||
/ TAD (NUMBER OF SEGMENTS TO REMAIN)
|
||
/ JMS RED30
|
||
/ RETRIEVAL CHAIN POINTER
|
||
/ UFD RETRIEVAL POINTER
|
||
/ RETURN
|
||
|
||
DSCNTR,
|
||
RED30, 0
|
||
JMS I WND201 /DIVIDE BY 7
|
||
CMA
|
||
DCA REWNDC /WINDOW COUNT-- NUMBER OF WHOLE WINDOWS WHICH ARE TO REMAIN
|
||
TAD I RED30 /RETRIEVAL CHAIN POINTER
|
||
ISZ RED30
|
||
|
||
/NOW TRACE THRU THE LINKED LIST OF FILE INFORMATION
|
||
/RETRIEVAL BLOCKS UNTIL WE GET TO THE ONE IN WHICH THE
|
||
/NEW LAST SEGMENT IS
|
||
RED32, DCA RED31 /LINKAGE TO RETRIEVAL CHAIN
|
||
TAD I RED30 /PICK UP RETRIEVAL POINTER
|
||
JMS I GE01 /GET THIS WORD INTO CORE
|
||
DSENTP,
|
||
RED31, 0
|
||
DCA REBUFF
|
||
TAD I REBUFF /PICK UP LINK TO NEXT
|
||
DCA RELINC /SAVE LINK
|
||
TAD WNDREM
|
||
SZA CLA /DELETING ENTIRE WINDOW?
|
||
JMP RED37 /NO
|
||
CLA CLL CML RTL
|
||
TAD REWNDC
|
||
SZA CLA /YES - ARE WE ONE WINDOW FROM THE END YET?
|
||
JMP RED37 /NO
|
||
DCA I REBUFF /YES - CLEAR THE LINK TO IT
|
||
SAVBUF / AND SET 'BUFFER CHANGED'
|
||
RED37, TAD RELINC
|
||
ISZ REWNDC /AT END OF CHAIN?
|
||
JMP RED32 /NO, KEEP SAVING
|
||
DCA RELINC /SAVE LINC
|
||
DCA I REBUFF /YES, TERMINATE IT
|
||
SAVBUF / AND SET 'BUFFER CHANGED' SWITCH
|
||
|
||
/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 /YES; GET POINTER TO FIRST SEGMENT TO BE DELETED
|
||
TAD REBUFF
|
||
DCA REBUFF /POINTER TO FIRST SEGMENT TO REMOVE
|
||
RED33, TAD I REBUFF /PICK UP THE SEGMENT NUMBER
|
||
SZA
|
||
JMS I SATR1 /RELEASE IT ON SAT
|
||
DCA I REBUFF /CLEAR THE CELL
|
||
ISZ REBUFF
|
||
TAD REBUFF
|
||
AND P0007
|
||
SZA CLA /END OF WINDOW?
|
||
JMP RED33 /NO, CONTINUE
|
||
TAD RELINC /YES, MOVE TO NEXT
|
||
SZA /END OF CHAIN?
|
||
JMP RED34 /NO, GET NEXT WINDOW
|
||
ISZ RED30 /YES, EXIT
|
||
JMP I RED30
|
||
RED34, DCA RED35
|
||
TAD I RED30
|
||
JMS I GE01 /GET NEXT WINDOW
|
||
DSKCNT,
|
||
RED35, 0
|
||
DCA REBUFF
|
||
TAD I REBUFF
|
||
DCA RELINC /SET UP LINK TO NEXT
|
||
DCA I REBUFF /WIPE OUT THIS LINK
|
||
SAVBUF / AND INDICATE 'BUFFER CHANGED'
|
||
ISZ REBUFF
|
||
JMP RED33 /KEEP WIPING OUT
|
||
|
||
REBUFF, 0
|
||
RELINC, 0
|
||
REWNDC, 0
|
||
WND201, WND20
|
||
/DIRECTORY SEARCH
|
||
|
||
/CALLING SEQUENCE:
|
||
/ CLA OR CMA (3 OR 1 WORD SEARCH)
|
||
/ JMS DS0
|
||
/ POINTER--------------->RETRIEVAL STACK POINTER
|
||
/ RETURN IF NOT FOUND NA
|
||
/ GOOD RETURN ME
|
||
/ (POINTER IN AC) XX
|
||
|
||
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 DSMAX /SET UP COUNTER ON # ENTRIES CHECKED
|
||
DCA DSKCNT
|
||
DCA DSNEXT /CLEAR OUR NEXT-HIGHEST
|
||
DS1, DCA DSWORD
|
||
TAD I DSRETS /GET PTR. TO RETRIEVAL INFORMATION BLOCK
|
||
JMS I GE01 /GET THE ENTRY INTO CORE
|
||
DSWORD, 0 /WORD NUMBER--I.E. THE ADDR. WITHIN THE DIRECTORY
|
||
SNA /DID WE GET THE ENTRY?
|
||
HLT /NO, BUT THERE WAS A POINTER TO IT - ERROR *****
|
||
DCA DSENTP /STORE POINTER TO ENTRY
|
||
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
|
||
DS2, TAD I DSENT
|
||
ISZ DSENT
|
||
CIA
|
||
ISZ DSOBJT
|
||
TAD I DSOBJT
|
||
SZA CLA
|
||
JMP DS3 /NOT FOUND
|
||
ISZ DSCNTR
|
||
JMP DS2 /LOOK AT NEXT WORD OF NAME
|
||
|
||
/WE FOUND IT - JUST RETURN THE POINTER
|
||
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. UPDATE OUR 'NEXT UFD' WORD
|
||
/AND THEN PICK UP THE LINK TO THE NEXT ENTRY.
|
||
DS3, ISZ DSKCNT /BAD DIRECTORY?
|
||
SKP /NOT YET
|
||
HLT /LOOPING LINKS - ERROR *****
|
||
TAD I DSENTP /GET THE LAST ENTRY
|
||
CLL CML CIA
|
||
TAD I DSOBJT
|
||
SNL CLA /GREATER THAN THE ONE WE WANT?
|
||
JMP DS5 /NO
|
||
TAD DSNEXT
|
||
SNA /YES - DO WE HAVE A NEXT YET?
|
||
JMP DS4 /NO - JUST TAKE THIS ONE
|
||
CLL CML CIA
|
||
TAD I DSENTP
|
||
SNL CLA /SMALLER THAN OUR PREVIOUS 'NEXT'?
|
||
JMP DS5 /NO
|
||
DS4, TAD I DSENTP /YES - SAVE THIS ONE INSTEAD
|
||
DCA DSNEXT
|
||
DS5, TAD P0003 /CREATE POINTER TO NEXT ENTRY
|
||
TAD DSENTP
|
||
DCA DSCNTR
|
||
TAD I DSCNTR
|
||
SZA /IS THIS THE END OF THE DIRECTORY CHAIN?
|
||
JMP DS1 /NO, SO CONTINUE SEARCH
|
||
TAD P0003
|
||
TAD DSWORD /YES - RETURN ADDRESS OF LAST LINK-WORD
|
||
JMP I DS0
|
||
|
||
DSENT, 0
|
||
DSMAX, -161 / - (MAX # OF FILES USER CAN OWN + 1)
|
||
DSNEXT, 0
|
||
DSOBJT= REBUFF
|
||
DSRETS= RELINC
|
||
DSWDNR= REWNDC
|
||
PAGE
|
||
/ROUTINE TO LOOK IN THE SAT FOR A FREE SEGMENT
|
||
|
||
/CALLING SEQUENCE:
|
||
/ JMS SATLOK
|
||
/ RETURN (SEGMENT NUMBER IN AC, 0=NONE AVAILABLE)
|
||
SATLOK, 0
|
||
TAD SATTBL /SET THE POINTER INTO THE TABLE
|
||
DCA SATPNT
|
||
TAD I SATCNT /# OF AVAILABLE DISC SEGMENTS
|
||
SNA /ARE THERE ANY?
|
||
JMP I SATLOK /NO, SO SCREW 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
|
||
HLT /YES, BUT WE SUPPOSEDLY HAD A SLOT *****
|
||
DCA I SATCNT / (IF SYSTEM IS CONTINUED, WE'LL FIX THE COUNT)
|
||
JMP I SATLOK
|
||
|
||
/WE FOUND A SAT WORD WITH A ZERO BIT. NOW FIND THAT BIT
|
||
SAT2, CLL CML RAR /4000 INTO ACC.
|
||
DCA SATMSK
|
||
ISZ SATCT2 /INCREMENT THE BIT POSITION COUNT
|
||
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 /SET THE BIT IN SATTBL TO INDICATE
|
||
DCA I SATPNT / THAT THIS SEGMENT IS ALLOCATED
|
||
TAD SATPNT
|
||
TAD SATFIX
|
||
DCA SATMSK
|
||
/
|
||
/NOW CALCULATE THE NUMBER OF THE DISC SEGMENT
|
||
/WHICH CORRESPONDS TO THIS BIT IN THE SAT TABLE
|
||
TAD SATMSK /THE WORD-NUMBER
|
||
CLL RAL
|
||
TAD SATMSK
|
||
RTL / TIMES 12
|
||
TAD SATCT2 / PLUS THE BIT POSITION
|
||
JMP I SATLOK /EXIT WITH DISC SEGMENT NUMBER IN ACC.
|
||
|
||
SATFIX, SATSIZ-2
|
||
SATPNT, 0
|
||
SATCNT, -SATSIZ+1
|
||
SATEMP,
|
||
SATCT2, 0
|
||
SATMSK, 0
|
||
SATTBL, -SATSIZ+2
|
||
/ROUTINE TO RELEASE A SEGMENT IN SAT
|
||
|
||
/CALLING SEQUENCE:
|
||
/ TAD (SEGMENT NUMBER)
|
||
/ JMS SATREL
|
||
|
||
SATREL, 0
|
||
SNA /REASONABLE SEGMENT NUMBER?
|
||
HLT /NO - ERROR *****
|
||
DCA SATEMP /SEGMENT NUMBER
|
||
CLA CLL CMA CML
|
||
DCA SATSTA /MARK SAT STATUS AS HAVING BEEN CHANGED
|
||
TAD SATEMP
|
||
TAD SEGMAX
|
||
SZA SNL CLA /LEGAL SEGMENT NUMBER?
|
||
HLT /NO - ERROR *****
|
||
DCA SATPNT
|
||
/
|
||
/NOW DIVIDE SEGMENT NUMBER BY 12 DECIMAL
|
||
/QUOTIENT INDICATES WHICH WORD IN SAT TABLE CORRESPONDS
|
||
/TO THIS DISC SEGMENT. REMAINDER INDICATES WHICH BIT IN
|
||
/THAT WORD
|
||
CLA CMA /SUBTRACT 1 SO SEGMENT TABLE STARTS AT 0
|
||
SATRL1, TAD SATEMP
|
||
SMA /IS SEGMENT # > 3777?
|
||
JMP SATRL2 /NO
|
||
TAD CM3770 /YES - SUBTRACT 3770 FROM IT
|
||
DCA SATEMP
|
||
TAD SATPNT /THEN PUSH THE POINTER BY 3770 SEGMENTS
|
||
TAD C0252 / WHICH IS 252 WORDS
|
||
DCA SATPNT
|
||
JMP SATRL1 /THEN CHECK AGAIN
|
||
|
||
/NOW FIND THE WORD-ADDRESS OF THIS BIT NUMBER.
|
||
ISZ SATPNT
|
||
SATRL2, TAD C7764 /-14
|
||
SMA /IS THIS THE WORD?
|
||
JMP .-3 /NO - ADVANCE THE POINTER & SUBTRACT AGAIN
|
||
DCA SATEMP /YES - SAVE THE BIT-POSITION
|
||
TAD SATPNT
|
||
TAD SATTBL /GET THE WORD-ADDRESS
|
||
DCA SATPNT
|
||
CLL CML
|
||
RAL
|
||
ISZ SATEMP /SET UP A MASK CORRESPONDING TO PROPER BIT
|
||
JMP .-2
|
||
AND I SATPNT
|
||
SNA /IS THIS SEGMENT REALLY ASSIGNED?
|
||
HLT /NO - ERROR *****
|
||
CMA
|
||
AND I SATPNT /CLEAR SAT TABLE BIT
|
||
DCA I SATPNT / THE SEGMENT IS NOW AVAILABLE
|
||
ISZ I SATCNT /UPDATE THE AVAILABLE SEGMENTS COUNT
|
||
JMP I SATREL
|
||
|
||
C0252, 252 / [3770 BITS / 14 BITS PER WORD (OCTAL)]
|
||
C7764, -14
|
||
CM3770, -3770
|
||
SEGMAX, -DSKSIZ+JOBMAX+SWDEX^20+1 / (-) LARGEST SEGMENT NUMBER
|
||
/ROUTINE TO FETCH A LINKED-BLOCK (USED BY 'OPEN').
|
||
GTBLOK, 0
|
||
DCA GTB1
|
||
CFLD
|
||
TAD GTB1
|
||
CIF
|
||
GETBLK
|
||
JMP I GTBERR /NO BLOCK AVAILABLE - SAY "PROTECTION VIOLATION"
|
||
DATFLD
|
||
TAD I GTB1
|
||
JMP I GTBLOK
|
||
GTBERR, OPNER2
|
||
GTB1, 0
|
||
|
||
/DISPATCH TABLE FOR IOTS
|
||
|
||
IODISP, ASD1
|
||
REL0
|
||
REN0
|
||
OPN0
|
||
CLS0
|
||
WND0
|
||
PRT0
|
||
WND0
|
||
XOPN0
|
||
CPASS0
|
||
CRF0
|
||
EXT0
|
||
RED0
|
||
INF0
|
||
LGI0
|
||
LGO0
|
||
BCLR0
|
||
PAGE
|
||
/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)
|
||
|
||
GE0, 0
|
||
DCA GERETP /STORE RETRIEVAL INFORMATION POINTER
|
||
TAD I GE0
|
||
AND K7400 /FIND UFD SEGMENT #
|
||
CLL RTL; RTL; RAL
|
||
TAD GERETP
|
||
DCA GERETP
|
||
TAD I GERETP /GET THE PHYSICAL SEGMENT #
|
||
SNA
|
||
JMP GE3
|
||
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.
|
||
ISZ BUFSTA /ANYTHING IN BUFFER?
|
||
JMP RD0 /NO, READ
|
||
TAD RDCURR /YES, SAME AS SEGMENT WE ARE LOOKING FOR
|
||
CIA
|
||
TAD RDTEMP
|
||
SNA CLA /IS THIS THE SEGMENT WE WANT?
|
||
JMP RD3 /YES - SEGMENT ALREADY IN CORE
|
||
JMS I WRT1 /NO - WRITE IT OUT IF NECESSARY
|
||
RD0, TAD RDTEMP
|
||
JMS RD30 /SET UP PARAMETERS FOR A READ OPERATION
|
||
JMS I FIO01 /PERFORM THE READ
|
||
JMP I FIEXIT /ERROR ON READ
|
||
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 ZERO A DISC SEGMENT. WE DON'T ACTUALLY WRITE
|
||
/OUT ZEROES, ALL WE DO IS ZERO THE CORE-BUFFER AND SET
|
||
/THINGS UP SO IT WILL BE WRITTEN OUT THE NEXT TIME A BLOCK
|
||
/IS NEEDED OR WHEN FIP EXITS.
|
||
|
||
SCL0, 0
|
||
DCA SCLSEG /SAVE THE SEGMENT NUMBER
|
||
JMS I WRT1 /WRITE OUT THE BUFFER IF NECESSARY
|
||
TAD MSEGSZ
|
||
DCA CFH /SET THE BUFFER LENGTH
|
||
TAD BUFFER
|
||
DCA SCLPTR / AND THE BUFFER POINTER
|
||
SCL1, DCA I SCLPTR /NOW CLEAR THE BUFFER TO ZEROES
|
||
ISZ SCLPTR
|
||
ISZ CFH
|
||
JMP SCL1
|
||
TAD SCLSEG
|
||
JMS RD30 /SET UP THE READ PARAMETERS
|
||
CLA CMA / AND JUST INDICATE THE BUFFER IS FULL
|
||
DCA BUFSTA
|
||
SAVBUF /ALSO SET 'BUFFER CHANGED'
|
||
JMP I SCL0 /THEN JUST RETURN
|
||
|
||
MSEGSZ, -WRDSEG
|
||
SCLPTR= RDTEMP
|
||
SCLSEG= RDCURR
|
||
|
||
/ROUTINE TO SET UP FOR A READ
|
||
/ENTER WITH SEGMENT NUMBER. THIS IS CONVERTED
|
||
/TO A PHYSICAL DISC ADDRESS
|
||
RD30, 0
|
||
DCA RDCURR /SAVE AS CURRENT BUFFERED SEGMENT
|
||
CLA CMA
|
||
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 C6603 /READ IOT
|
||
DCA FLPARB
|
||
JMP I RD30
|
||
/ACTUAL IO ROUTINE
|
||
/SET UP ALL IO PARAMETERS IN "FLPARB", AND JMS FIPIO
|
||
|
||
FIPIO, 0
|
||
TAD FIPFLD
|
||
RAR
|
||
DCA FLPARB+2 /='S FIELD WE'RE IN TIMES 4
|
||
CFLD /CHANGE TO CURRENT FIELD IF NECESSARY
|
||
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
|
||
BLT /MOVE DISC TRANSFER PARMS INTO DSUTBL BLOCK
|
||
CFLD
|
||
FLPARB
|
||
DATFLD /DESTINATION FIELD
|
||
FIO3, FIPBLK /DESTINATION
|
||
-10 /WORD COUNT
|
||
CIF CDF
|
||
ISZ I DSBSYA /GLOBAL TO "DSBUSY"
|
||
WAIT
|
||
JMP I OVER /GO TO FIELD 0, LOCATION "OVERLA+5"
|
||
|
||
/MONITOR RETURNS CONTROL HERE AFTER COMPLETING THE TRANSFER
|
||
FIORET, CLA /RETURNS FROM DISC IO 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
|
||
AND P0007 /CHECK ERROR BITS
|
||
SZA
|
||
JMP FIO6 /SOME KIND OF ERROR OCCURRED
|
||
ISZ FIPIO /NO ERROR, NORMAL RETURN
|
||
JMP I FIPIO
|
||
FIO6, TAD C7773 /-5, DISC ERROR CODE
|
||
SZA CLA
|
||
ISZ FIPIO /ERROR WAS NOT CAUSED BY DISC TRANSFER
|
||
JMP I FIPIO /EXIT WITHOUT SKIPPING TO INDICATE DISC TRANSFER ERROR
|
||
|
||
C7773, -5
|
||
DSBSYA, DSBUSY
|
||
FIPTR1, 0
|
||
FIUTBA, DSUTBL+4+4
|
||
FIRETP, FIORET
|
||
OVER, OVRLA1
|
||
PAGE
|
||
/ROUTINE TO CHECK WHETHER THE FILE A USER
|
||
/IS ATTEMPTING TO ACCESS IS HIS.
|
||
|
||
/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 'ENTTBL' ENTRY FOR THIS FILE
|
||
SNA
|
||
JMP I UC0 /FILE NOT OPEN
|
||
CIA
|
||
CMA
|
||
CLL RAL / * 2 (AND ZAP 'EXCLUSIVE USE' BIT)
|
||
TAD UFDTBL
|
||
DCA UCUFDP /POINTER TO OPEN UFD TABLE
|
||
CLA CMA
|
||
TAD I UCUFDP
|
||
SNA CLA /IS THIS A DIRECTORY?
|
||
JMP UC1 /YES - ONLY OWNER GETS IT (NOT BILLING SYSTEM)
|
||
CHKACT /NO - IS THIS A PRIVILEGED USER?
|
||
JMP UC2 /YES - HE GETS ANYTHING ELSE
|
||
UC1, TAD FIACCT /GET HIS ACCOUNT NUMBER
|
||
CIA
|
||
TAD I UCUFDP
|
||
SNA /DOES HE OWN THIS?
|
||
UC2, ISZ UC0 /YES - FIX RETURN ADDRESS
|
||
JMP I UC0
|
||
|
||
UCUFDP, 0
|
||
/THIS HANDLES THE 'LOGOUT' IOT - IF THE AC IS SET TO THE
|
||
/USER'S JOB NUMBER, WE LOG HIM OUT; IF THE AC IS 0, WE RETURN
|
||
/THE NUMBER OF ADDITIONAL USERS LOGGED-IN UNDER HIS ACCOUNT.
|
||
|
||
LGO0, TAD FIOSTK+1 /DID HE SET HIS AC= TO HIS JOB #?
|
||
CIA
|
||
TAD FIJOB
|
||
SZA CLA
|
||
JMP I LGO1A /NO - SEE IF HE WANTS COUNT OF OTHER USERS
|
||
JMS I LNS01 /YES - FIRST RELEASE ALL HIS DEVICES
|
||
JMP .+3
|
||
JMS I REL01
|
||
JMP .-3 /KEEP GOING
|
||
JMS I CL01 /CLOSE FILE 0
|
||
IAC
|
||
JMS I CL01 /CLOSE FILE1
|
||
CLL CML RTL
|
||
JMS I CL01 /CLOSE FILE 2
|
||
TAD P0003
|
||
JMS I CL01 /CLOSE FILE3
|
||
TAD FIACCT /GET USER'S ACCOUNT NUMBER
|
||
DCA LGOPRM+1 /DELIVER TO CALLING SEQUENCE FOR SEARCH
|
||
CLA CMA
|
||
JMS I DS01 /FIND MFD ENTRY; 1 WORD SEARCH
|
||
LGOPRM
|
||
HLT /ERROR - MASTER DIRECTORY MAY BE LOST *****
|
||
TAD C0006
|
||
DCA LGOPTR /POINTER TO CP TIME COUNTER
|
||
TAD I ZDS1 /PICK UP THE RELATIVE UFD-LOCATION
|
||
DCA LGOENT / FOR CHECKING IF REDUCTION IS POSSIBLE
|
||
FGETJT
|
||
JOBRTM /JOB RUN TIME IN STATUS
|
||
DCA FIOSTK+6 /POINTS TO LOW ORDER RUN TIME
|
||
FGETJT
|
||
JOBRTH
|
||
DCA FIOSTK+7 / AND HIGH-ORDER
|
||
DATFLD
|
||
TAD I FIOSTK+6
|
||
AND C7700 /USE HIGH PART OF LOW-ORDER TIME
|
||
CLL RAL
|
||
DCA FIOSTK+6
|
||
TAD I FIOSTK+7
|
||
CFLD /BACK TO THIS FIELD
|
||
AND P0077
|
||
TAD FIOSTK+6 /NOW COMBINE THE TWO
|
||
RTL
|
||
RTL
|
||
RTL
|
||
TAD I LGOPTR /UPDATE RUNTIME (CPU TIME : DATE WORD)
|
||
SZL /DID IT JUST OVERFLOW?
|
||
CLA CMA /YES - FORCE IT TO THE MAXIMUM
|
||
DCA I LGOPTR
|
||
SAVBUF / & SET 'BUFFER CHANGED' SWITCH
|
||
ISZ LGOPTR /NOW GET TO THE RETRIEVAL-BLOCK POINTER
|
||
TAD I LGOPTR
|
||
DCA LGORET / & SAVE IT FOR POSSIBLE UFD REDUCTION
|
||
TAD FIACCT
|
||
JMS I UTS01 /FIND OUR ACCOUNT NUMBER IN 'UFDTBL'
|
||
HLT /ERROR - NO 'UFDTBL' ENTRY FOR US *****
|
||
JMS I BLDP1 /CALCULATE THE 'ENTTBL' ENTRY LOCATION
|
||
DCA LGOPTR / IN CASE WE'RE THE LAST USER OF THIS UFD
|
||
ISZ I UTPRNU /DECREMENT THE ACCESS-COUNT FOR THIS UFD
|
||
JMP LGO3
|
||
TAD RETTBL /LAST USER ACCESSING THIS UFD
|
||
JMS I ENS01 /FIND THE NUMBER OF USERS READING IT
|
||
UCENTP,
|
||
LGOENT, 0
|
||
SZA CLA /DOES ANYONE HAVE IT OPEN AS A FILE?
|
||
JMP LGO2 /YES - WE COULDN'T REDUCE IT NOW
|
||
TAD LGOPTR
|
||
JMS I GE01 /NO - GET THE INITIAL LINK-WORD IN THE UFD
|
||
3
|
||
DCA LGOENT
|
||
TAD I LGOENT
|
||
SZA CLA /IS THE UFD COMPLETELY EMPTY?
|
||
JMP LGO2 /NO - CAN'T REDUCE IT THEN
|
||
CLA CLL IAC
|
||
JMS I RED301 /NOW REDUCE THE UFD TO ONE SEGMENT
|
||
LGORET, 0
|
||
RTABLE / (FIRST RETTBL ENTRY IS ALWAYS MFD)
|
||
LGO2, CLA CMA
|
||
TAD UTPRNU
|
||
JMS I TF01 /NOW FREE THE 'UFDTBL' ENTRY
|
||
LGO3, CLA
|
||
TAD LGO4A /KLUDGE FIEXIT TO RETURN TO LGO4
|
||
DCA I LGKLUJ
|
||
TABOUT, CLA CMA
|
||
DCA TABSTA /FORCE TABLES OUT
|
||
JMP I FIEXIT
|
||
|
||
LGKLUJ, FIX500
|
||
LGOPRM, RTABLE /2-WORD PARAMETER BLOCK FOR 'DS01'
|
||
LGOPTR, 0
|
||
LGO1A, LGO1
|
||
LGO4A, LGO4
|
||
LNS01, LNS0
|
||
RED301, RED30
|
||
|
||
/ROUTINE TO RETURN A BLOCK TO FREE-CORE.
|
||
RETBKS, 0
|
||
CFLD
|
||
CIF
|
||
RETBLK /JUST LINK TO FIELD 0
|
||
JMP I RETBKS / AND RETURN
|
||
|
||
/ROUTINE TO RETURN A LINKED LIST OF FREE-CORE BLOCKS.
|
||
RETBLS, 0
|
||
SNA /AT END OF CHAIN?
|
||
JMP I RETBLS /YES - RETURN
|
||
JMS RETBKS /NO - RELEASE THE BLOCK
|
||
JMP .-3
|
||
PAGE
|
||
/ROUTINE TO OPEN A UFD & LEAVE ZERO ACCESS COUNT
|
||
|
||
/CALLING SEQUENCE:
|
||
/ TAD (PROJ,PROG NUMBER)
|
||
/ JMS UFO0
|
||
/ ERROR RETURN
|
||
/ NORMAL RETURN (POSITION ON TABLE IN AC)
|
||
|
||
UFO0, 0
|
||
DCA UFORET /SAVE THE ACCOUNT NUMBER
|
||
TAD UFORET
|
||
JMS I UTS01 /SEARCH THE TABLE
|
||
SKP CLA /NOT FOUND - BUILD NEW ENTRY
|
||
JMP UFOEXT /GOT IT - JUST EXIT
|
||
TAD UFORET
|
||
JMS UFO6 /GET THE RETRIEVAL INFO. FOR THIS UFD
|
||
JMP UFO5 /NO LUCK - TAKE ERROR EXIT
|
||
DCA UOBUFP /POINTER TO RETRIEVAL INFORMATION
|
||
TAD UFDTBL
|
||
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
|
||
ISZ UOUFDP
|
||
TAD I UOUFDP
|
||
SNA CLA /IS IT REALLY EMPTY?
|
||
JMP UFO10 /YES - CLEAN UP
|
||
|
||
/NO IT IS OCCUPIED
|
||
ISZ UOUFDP
|
||
TAD UOUFDP
|
||
CIA
|
||
TAD UFDEND
|
||
SZA CLA /HAVE WE SEARCHED THE WHOLE TABLE?
|
||
JMP UFO3 /LOOK AT NEXT SLOT
|
||
UFO5, CLA CLL
|
||
JMP I UFO0 /NO ROOM ON TABLE
|
||
|
||
/COMES HERE WITH UOUFDP POINTING TO A FREE SLOT IN UFDTBL
|
||
UFO10, CLA CMA
|
||
TAD UOUFDP /BACK UP THE POINTER
|
||
DCA UOUFDP
|
||
UFO2, TAD UFORET+1
|
||
DCA I UOUFDP /PUT PROJ,PROG NUMBER ON TABLE
|
||
ISZ UOUFDP
|
||
DCA I UOUFDP /ACCOUNT FOR THIS ACCESS
|
||
CLA CMA
|
||
TAD UFDTBL
|
||
CIA
|
||
TAD UOUFDP
|
||
CLL RAR
|
||
DCA UFO1 /RELATIVE POSITION ON TABLE
|
||
TAD UFO1
|
||
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
|
||
TAD UFO1 /YES - PICK UP RELATIVE POSITION
|
||
UFOEXT, ISZ UFO0 /PREPARE FOR NORMAL RETURN
|
||
JMP I UFO0
|
||
|
||
UFORET, 0
|
||
0
|
||
UOUFDP=UTPRNU
|
||
|
||
/ROUTINE TO READ IN THE RETRIEVAL INFORMATION FOR THE
|
||
/UFD BELONGING TO THE ACCOUNT NUMBER PASSED IN THE AC.
|
||
UOBUFP,
|
||
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 P0007
|
||
DCA UFORET /POINTER TO UFD RETRIEVAL INFORMATION
|
||
TAD I UFORET
|
||
DCA UFO1
|
||
TAD RETTBL /GET POINTER TO RETRIEVAL INFO FOR THE MFD
|
||
JMS I GE01 /GET RETRIEVAL INFORMATION INTO CORE
|
||
UFO1, 0
|
||
ISZ UFO6
|
||
JMP I UFO6
|
||
/ROUTINE TO ASSIGN A DEVICE
|
||
|
||
ASD1, TAD FIOSTK+1
|
||
JMS I DTE01 /IS THIS DEVICE ASSIGNED TO THIS JOB?
|
||
ASD2, 0 /SET BY DTE01 TO POINT TO PROPER ENTRY IN DEVTBL
|
||
SKP
|
||
JMP ASD5 /YES
|
||
TAD I ASD2 /GET THE DDB ADDRESS
|
||
SNA /IS THERE A DDB?
|
||
JMP ASD3 /NO - OKAY TO ASSIGN IT
|
||
/
|
||
/COMES HERE IF ONE JOB ATTEMPTS TO ASSIGN AN ALREADY ASSIGNED DEVICE
|
||
IAC
|
||
DCA CFH /NOW POINTS TO JOB # (OR LOC 0, IF ILLEGAL)
|
||
TAD I CFH
|
||
SNA /JOB NUMBER THERE?
|
||
CMA /NO - RETURN 7777
|
||
DCA FIUSAC /RETURN THE OWNER'S JOB NUMBER
|
||
JMP ASD4 /EXIT
|
||
/
|
||
/COMES HERE IF OKAY TO MAKE THIS ASSIGNMENT
|
||
ASD3, TAD FIOSTK+1
|
||
SMA /IS THE DEVICE BEING ASSIGNED A TELETYPE?
|
||
JMP I LGI201 /YES - THAT'S NOT ALLOWED
|
||
TAD ASDCHK
|
||
SPA CLA /IS HE TRYING TO GET THE RK05?
|
||
JMP .+3 /NO
|
||
CHKPRV /YES - DOES HE HAVE PRIVILEGE?
|
||
JMP I LGI201 /NO - ERROR
|
||
CFLD /CHANGE TO CURRENT FIELD
|
||
TAD ASD2
|
||
CIF
|
||
GETDDB /GET A BLOCK FROM THE FREE LIST AND LINK IT INTO DEVTBL
|
||
JMP I LGI201 /NO BLOCK - JUST RETURN A BAD STATUS
|
||
DATFLD
|
||
TAD I ASD2 /PICK DDB ADDRESS FROM DEVTBL
|
||
DCA CFH /SAVE IT
|
||
TAD FIOSTK+1
|
||
AND P0037
|
||
DCA I CFH /SET TO REFLECT THE DEVICE NUMBER
|
||
ISZ CFH
|
||
TAD FIJOB
|
||
DCA I CFH / AND STORE THE JOB NUMBER
|
||
ASD4, CFLD
|
||
JMP I FIEXIT /THEN JUST EXIT
|
||
/
|
||
/USER ALREADY OWNS THE DEVICE - IF IT'S THE HSR, JUST CLEAR THE BUFFER.
|
||
ASD5, TAD FIOSTK+1
|
||
CLL RAL
|
||
SZA CLA /HSR?
|
||
JMP ASD4 /NO - JUST EXIT
|
||
TAD I ASD2 /GET THE DDB POINTER
|
||
CIF
|
||
JMS I ASDCLR /CLEAR THE BUFFER
|
||
JMP ASD4
|
||
|
||
ASDCHK, -4030 /RK05 DRIVE 0 ASSIGN CODE
|
||
ASDCLR, SICLR
|
||
|
||
PAGE
|
||
|
||
/EXIT ROUTINE
|
||
/COMES HERE WHEN FIP HAS COMPLETED ITS TASK
|
||
/FIRST, SEE IF ANY INTERNAL FILE HAVE BEEN CHANGED
|
||
/THOSE THAT HAVE CHANGED MUST BE WRITTEN BACK OUT TO DISC
|
||
|
||
FIX0, CFLD
|
||
CLA
|
||
JMS I WRT1 /MAKE SURE THE BUFFER IS EMPTY
|
||
ISZ TABSTA /CHECK TABLE STATUS
|
||
JMP FIX1 /NOTHING CHANGED IN TABLES
|
||
TAD FIPTBS /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 FIX40
|
||
TAD FIDEXP /GLOBAL TO "FIPDEX"
|
||
DCA FLPARB+1 /MEMORY FIELD
|
||
TAD C6605
|
||
DCA FLPARB /WRITE IOT
|
||
JMS I FIO01 /PERFORM THE WRITE
|
||
HLT /ERROR ON WRITE, FATAL
|
||
/ALL DISC TABLES ARE NOW UP TO DATE
|
||
FIX20, FGETJT
|
||
JOBSTS
|
||
DCA FIOPTR
|
||
DATFLD
|
||
TAD I FIOPTR
|
||
AND FISIOT /CLEAR 'FIP IOT' BIT
|
||
DCA I FIOPTR
|
||
CFLD
|
||
FGETJT /RESTORE USER REGISTERS
|
||
JOBREG
|
||
DCA FIX21
|
||
CIF
|
||
BLT
|
||
CFLD
|
||
FIUSPC
|
||
DATFLD
|
||
FIX21, 0
|
||
-5
|
||
JMP I .+1
|
||
FIX500, FIX50 /CHANGED TO 'LGO4' DURING LOGOUT PROCESSING
|
||
FIX50, CFLD
|
||
TAD I SEGCNT
|
||
CDF
|
||
DCA I FIXCNT /STORE # FREE SEGMENTS IN FIELD 0
|
||
CHKSRC /WHO CALLED US?
|
||
JMP FIX30 /A USER - JUST CLEAR THE ENTRY
|
||
TAD C6603 /'SI' - SET UP TO READ IT IN
|
||
DCA FLPARB
|
||
DCA FLPARB+1 /SI IS IN THE TRACK 0 OF THE DISC
|
||
JMS FIX40
|
||
JMS I FIO01 /RETURN WILL BE TO SI
|
||
|
||
/FIP WAS CALLED BY A USER - JUST CLEAR THE 'CORTBL' ENTRY
|
||
FIX30, CDF
|
||
TAD I FANFLD /A USER - GET THE 'CORTBL' ENTRY
|
||
AND FIPCLR / AND CLEAR THE JOB NUMBER & LOCK BIT
|
||
DCA I FANFLD
|
||
JMP I .+1 /NOW GO CHECK FOR OTHER 'FIPJOB'S
|
||
FIXSCH
|
||
|
||
/ROUTINE TO SET UP THE PARAMETERS IN 'FLPARB'.
|
||
FIX40, 0
|
||
DCA FLPARB+3 /SET (-) WORD-COUNT
|
||
TAD FLPARB+3
|
||
DCA FLPARB+5 /SET DISC ADDRESS
|
||
CLA CMA
|
||
TAD FLPARB+5
|
||
DCA FLPARB+4 /SET CORE ADDRESS - 1
|
||
JMP I FIX40
|
||
|
||
FIPCLR, FSWP+NOTRUN+FIP+SI
|
||
FIPFIP= C0400
|
||
FIPTBS, ENTABL /LOWEST TABLE IN FIP
|
||
FISIOT, -JSIOT-1
|
||
FIXCNT, NFSEGS /VALUE FOR RESIDENT 'SEGS'
|
||
SEGCNT, -SATSIZ+1 /POINTER TO # FREE SEGMENTS
|
||
/ROUTINE TO DETERMINE IF A DEVICE IS ASSIGNED TO THIS JOB
|
||
|
||
/CALLING SEQUENCE:
|
||
/ TAD (DEVICE NUMBER)
|
||
/ JMS DTE0
|
||
/ RETURN (DEVICE NOT ASSIGNED TO THIS JOB)
|
||
/ RETURN (DEVICE ASSIGNED)
|
||
|
||
DTE0, 0
|
||
SPA /IS IT A TTY?
|
||
JMP .+4 /NO
|
||
CLL RAL /YES - GET THE DEVTBL ENTRY-ADDRESS
|
||
TAD DEVTBA
|
||
JMP DTE1
|
||
AND P0077 /EXTRACT THE DEVICE NUMBER
|
||
TAD DEVEND / & FIND THE DEVTBL ENTRY
|
||
DTE1, DCA DTE2 /POINTER TO DEVTBL ENTRY
|
||
TAD DTE2
|
||
CIA
|
||
TAD DEVOVR
|
||
SMA CLA /IS IT A LEGAL DEVICE NUMBER?
|
||
JMP .+3 /YES
|
||
TAD DTEBAD
|
||
DCA DTE2 /NO - FUDGE SO JOB=0 (CHANGED TO 7777)
|
||
TAD DTE2
|
||
CFLD
|
||
DCA I DTE0 /PASS BACK THE DEVTBL POINTER
|
||
ISZ DTE0
|
||
DATFLD
|
||
TAD I DTE2 /GET THE DDB ADDRESS
|
||
SNA /IS THERE A DDB?
|
||
JMP I DTE0 /NO - DEVICE NOT ASSIGNED TO ANYONE
|
||
DCA DTE2
|
||
ISZ DTE2
|
||
TAD I DTE2
|
||
AND P0077 /EXTRACT JOB NUMBER
|
||
CIA
|
||
TAD FIJOB /NUMBER OF CURRENT JOB
|
||
SNA CLA
|
||
ISZ DTE0 /"ASSIGNED" RETURN
|
||
JMP I DTE0 /NOT OWNED BY THIS JOB
|
||
|
||
DTEBAD, JOBTBL-1
|
||
/ROUTINE TO FREE AN ENTRY ON THE UFD TABLE
|
||
|
||
/CALLING SEQUENCE:
|
||
/ TAD (POSITION ON UFDTBL)
|
||
/ JMS TF0
|
||
/ RETURN
|
||
|
||
DTE2,
|
||
TF0, 0
|
||
DCA TFUFDP /POSITION ON TABLE
|
||
DCA I TFUFDP /CLEAR OWNERS PROJ,PROG NUMBER
|
||
TAD UFDTBL /BEGINNING OF TABLE
|
||
CIA
|
||
TAD TFUFDP
|
||
CLL RAR /RELATIVE POSITION ON TABLE
|
||
IAC
|
||
JMS I BLDP1 /BUILD A PTR. TO ENTTBL
|
||
DCA TFUFDP /POINTER TO RETRIEVAL INFORMATION
|
||
TAD P7770 /SET # WORDS PER ENTTBL ENTRY
|
||
DCA TFCNTR
|
||
TF1, DCA I TFUFDP /ZERO OUT THE ENTRY
|
||
ISZ TFUFDP
|
||
ISZ TFCNTR
|
||
JMP TF1
|
||
JMP I TF0
|
||
|
||
|
||
/ROUTINE TO GET THE FILE CONTROL-BLOCK FOR THE
|
||
/FILE WHOSE INTERNAL FILE NUMBER IS IN THE AC.
|
||
|
||
TFUFDP,
|
||
LNK0, 0 /GET FILE LINKAGE
|
||
TAD LNKF
|
||
DCA LNK1
|
||
FGETJT
|
||
TFCNTR,
|
||
LNK1, 0
|
||
DCA CFH
|
||
DATFLD
|
||
TAD I CFH /PTR TO FILE CONTROL BLOCK
|
||
JMP I LNK0
|
||
|
||
LNKF, JOBF0
|
||
|
||
PAGE
|
||
|
||
/ROUTINE TO FIND AN EMPTY DIRECTORY ENTRY; THE UFD
|
||
/IS EXTENDED IF NECESSARY.
|
||
/CALL: TAD (POINTER TO UFD RETRIEVAL INFORMATION)
|
||
/ JMS DE0
|
||
/ BAD RETURN (NO FREE ENTRY OR NO DISC FOR UFD)
|
||
/ NORMAL RETURN (POINTER TO ENTRY IN AC)
|
||
|
||
DE0, 0
|
||
DCA DERETP /SAVE THE RETRIEVAL POINTER
|
||
DCA DEBEGG /CLEAR THE 'FROM BEGINNING' SWITCH
|
||
TAD DERETP
|
||
DCA INDEX
|
||
/
|
||
/IN ORDER TO SAVE DISC I/O, WE START THE SEARCH FROM THE
|
||
/MIDDLE OF THE UFD IF WE ALREADY HAVE ONE OF ITS SEGMENTS
|
||
/IN OUR SEGMENT BUFFER. IF WE DON'T FIND AN ENTRY FROM THE
|
||
/MIDDLE, WE RE-CHECK THE UFD FROM THE BEGINNING; IF WE STILL
|
||
/DON'T FIND AN ENTRY, WE EXTEND THE UFD.
|
||
DE1, TAD SEGSIZ
|
||
DCA DEWORD /SET INITIAL ADDRESS TO SECOND SEGMENT IN UFD
|
||
TAD I INDEX /GET THE NEXT SEGMENT INDEX IN THE UFD
|
||
SNA /IS THERE A NEXT?
|
||
JMP DE2 /NO - WE SEARCH FROM THE TOP
|
||
CIA
|
||
TAD I DECURR
|
||
SNA CLA /YES - IS IT OUR BUFFERED SEGMENT?
|
||
JMP DE4 /YES - START SEARCH FROM WHERE WE ARE
|
||
TAD DEWORD /NO - UPDATE OUR ADDRESS BY ONE SEGMENT
|
||
JMP DE1 / & CONTINUE CHECKING
|
||
/
|
||
/THE BUFFERED SEGMENT IS NOT ANY OF THIS UFD'S OR WE COULDN'T
|
||
/FIND A FREE ENTRY STARTING FROM THE MIDDLE OF THE UFD,
|
||
/SO WE SEARCH THE UFD FROM THE BEGINNING.
|
||
DE2, CLA CMA
|
||
DCA DEBEGG /SET THE 'FROM BEGINNING' SWITCH
|
||
DE3, TAD C0010
|
||
DCA DEWORD /SET THE NEW READ ADDRESS
|
||
DE4, TAD DERETP
|
||
JMS I GE01 /GET THE NEXT ENTRY
|
||
DEWORD, 0
|
||
SNA /WAS IT WITHIN THE UFD?
|
||
JMP DE6 /NO - GO TRY TO EXTEND IT
|
||
DCA CFH /YES - SAVE ITS CORE LOCATION
|
||
TAD I CFH /GET THE FIRST ENTRY-WORD
|
||
SZA CLA /IS IT CLEAR?
|
||
JMP DE5 /NO - TRY THE NEXT
|
||
ISZ CFH
|
||
TAD I CFH /YES - CHECK THE SECOND WORD
|
||
SZA CLA /IS THAT OK ALSO?
|
||
JMP DE5 /NO
|
||
TAD DEWORD /YES - WE HAVE AN EMPTY ENTRY
|
||
ISZ DE0 / SO SKIP TO INDICATE IT
|
||
JMP I DE0 / AND RETURN WITH ITS LOCATION IN THE AC
|
||
DE5, TAD DEWORD /NOT THIS ENTRY - UPDATE THE ADDRESS
|
||
JMP DE3 / AND CONTINUE SEARCH
|
||
/
|
||
/WE'VE RUN PAST THE END OF THE UFD - WE MAY HAVE TO EXTEND IT.
|
||
DE6, ISZ DEBEGG /WAS THIS SEARCH FROM THE FRONT OF THE UFD?
|
||
JMP DE2 /NO - SEARCH AGAIN, THIS TIME FROM THE FRONT
|
||
TAD DERETP
|
||
DCA DEPTR /YES - FIND THE NEXT SEGMENT SLOT
|
||
TAD C7771
|
||
DCA CFH /SET THE COUNTER (7 SEGMENTS MAXIMUM PER UFD)
|
||
DE7, TAD I DEPTR /GET THE NEXT SEGMENT POINTER
|
||
SNA CLA /IS THERE A NEXT?
|
||
JMP DE8 /NO - WE HAVE ROOM FOR A SEGMENT
|
||
ISZ DEPTR /YES - INCREMENT THE POINTER
|
||
ISZ CFH
|
||
JMP DE7 / & TRY AGAIN
|
||
JMP I DE0 /CAN'T EXTEND THE UFD - TAKE ERROR EXIT
|
||
/
|
||
/WE HAVE ROOM FOR ANOTHER SEGMENT - GET ONE FROM SAT.
|
||
DE8, JMS I SATL1 /FIND A FREE SEGMENT
|
||
SNA /WAS ONE AVAILABLE?
|
||
JMP I DE0 /NO - TAKE ERROR EXIT
|
||
DCA I DEPTR /YES - SAVE IT IN THE RETRIEVAL TABLE
|
||
TAD DERETP
|
||
JMS I ENS31 /GET THE RELATIVE ENTRY NUMBER
|
||
CLL RAL
|
||
TAD UFDTBL / & THE POINTER INTO 'UFDTBL'
|
||
DCA CFH
|
||
TAD I CFH /GET THE OWNER'S ACCOUNT NUMBER
|
||
JMS I UFO61 / & FETCH THE UFD RETRIEVAL BLOCK
|
||
HLT /ACCOUNT NOT FOUND - ERROR *****
|
||
DCA CFH /SAVE THE BUFFER POINTER
|
||
ISZ CFH
|
||
TAD I CFH /GET THE SEGMENT NUMBERS
|
||
SZA CLA /IS THIS THE END OF THE POINTERS?
|
||
JMP .-3 /NO - KEEP LOOKING
|
||
TAD I DEPTR /YES - SET OUR NEW SEGMENT NUMBER
|
||
DCA I CFH / INTO THE RETRIEVAL BLOCK
|
||
SAVBUF /NOW SET THE SWITCH TO WRITE BACK THE BUFFER
|
||
CLA CMA
|
||
DCA TABSTA / AND INDICATE THE TABLES HAVE BEEN CHANGED
|
||
TAD I DEPTR
|
||
JMS I SCL01 /FINALLY WE ZERO THE NEW UFD SEGMENT
|
||
JMP DE4 / AND THEN FINISH OUR SEARCH
|
||
|
||
DECURR, RDCURR
|
||
DEPTR, 0
|
||
DERETP, 0
|
||
ENS31, ENS3
|
||
UFO61, 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)
|
||
|
||
DEBEGG,
|
||
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
|
||
ISZ UTUPTR /STEP UP ONE SLOT
|
||
ISZ UTUPTR
|
||
JMP UTS1 /LOOK IN THE NEXT ENTRY
|
||
UTS3, TAD UFDTBL
|
||
CIA
|
||
TAD UTUPTR
|
||
CLL RAR /RELATIVE POSITION ON TABLE
|
||
IAC /THE RELATIVE POSITION
|
||
ISZ UTPRNU /UTPRNU POINTS TO ACCESS COUNT OF THIS PROJ, PROG #
|
||
ISZ UTS0
|
||
JMP I UTS0
|
||
|
||
UTUPTR= UTPRNU
|
||
|
||
|
||
/ROUTINE TO FIND THE ADDRESS OF A WORD IN THE
|
||
/JOB STATUS BLOCKS FOR THIS JOB.
|
||
|
||
UTPR1,
|
||
FGETJ0, 0
|
||
DATFLD
|
||
TAD I JOBDAT
|
||
SNA CLA /IS EVERYTHING PROPER?
|
||
REBOOT /NO - ERROR *****
|
||
CFLD
|
||
TAD I FGETJ0 /GET THE RELATIVE WORD NUMBER
|
||
DCA .+4
|
||
TAD JOBDAT /NOW GET THE ADDRESS OF A 'JOBTBL' POINTER
|
||
CIF
|
||
GETJTA / AND LET THE FIELD 0 ROUTINE DO THE WORK
|
||
0
|
||
ISZ FGETJ0
|
||
JMP I FGETJ0 /THEN JUST RETURN; AC=ADDRESS
|
||
|
||
|
||
/ROUTINE TO INITIATE AN AUTOMATIC SYSTEM RESTART.
|
||
/
|
||
RBOOT, 0
|
||
IOF
|
||
CLA
|
||
TAD RBOOT
|
||
CIF
|
||
JMP I .+1 /OFF TO FIELD 0 WITH ERROR ADDRESS IN THE AC
|
||
RELOAD
|
||
|
||
PAGE
|
||
|
||
/THIS HANDLES THE 'REL' IOT - RELEASE A DEVICE.
|
||
REL0, TAD FIOSTK+1 /GET THE DEVICE NUMBER
|
||
SPA /IS IT A TTY?
|
||
JMS REL00 /NO - GO AHEAD AND RELEASE IT
|
||
JMP I FIEXIT
|
||
|
||
/ROUTINE WHICH ACTUALLY RELEASES THE DEVICE.
|
||
REL00, 0
|
||
JMS I DTE01 /IS THIS DEVICE ASSIGNED TO THIS USER?
|
||
RELDVT, 0 /SET BY DTE0 TO POINT TO DEVTBL ENTRY FOR THIS DEVICE
|
||
JMP REL8 /NO - TAKE ERROR EXIT IF SI
|
||
TAD I RELDVT
|
||
DCA RELBLK /SAVE ADDRESS OF DDB
|
||
TAD RELBLK
|
||
TAD P0003 /POSITION OF TIME IN DDB
|
||
DCA RELASD
|
||
TAD I RELASD /GET TIME ASSIGNED
|
||
CIA
|
||
DCA RELASD /-TIME ASSIGNED
|
||
CDF
|
||
TAD I RELCK1 /GET TIME NOW
|
||
AND C7000 /JUST SIGNIFICANT PART OF LOW-ORDER
|
||
CLL RAL
|
||
DCA RELNOW
|
||
TAD I RELCK2
|
||
CFLD /BACK TO THIS FIELD
|
||
AND P0777 / AND INSIGNIFICANT PART OR HIGH ORDER
|
||
TAD RELNOW /TIME AT RELEASE
|
||
RTL
|
||
RAL
|
||
TAD RELASD /-TIME AT ASSIGNMENT (13-BIT SUBTRACT)
|
||
SNL /GONE THROUGH MIDNIGHT?
|
||
TAD RELCON /YES - ADD FUDGE FACTOR
|
||
SNA /ANYTHING TO RECORD?
|
||
JMP REL1 /NO
|
||
DCA RELASD /YES - SAVE IT
|
||
TAD FIACCT
|
||
DCA RELRTB+1 /NOW BUILD THE PACKET FOR 'DS0'
|
||
CLA CMA
|
||
JMS I DS01 /FIND THE MASTER DIRECTORY ENTRY
|
||
RELRTB
|
||
HLT /MFD IS LOST *****
|
||
TAD C0005
|
||
DCA CFH /NOW POINTS TO DEVICE TIME WORD
|
||
CLA CLL
|
||
TAD RELASD
|
||
TAD I CFH /ADD IN THE NEW TIME
|
||
SZL /DID IT OVERFLOW?
|
||
CLA CMA /YES - FORCE IT TO ITS LARGEST
|
||
DCA I CFH
|
||
SAVBUF /REMEMBER TO WRITE BACK THE BLOCK
|
||
REL1, DATFLD
|
||
CLA CLL CML
|
||
TAD RELDVT
|
||
TAD RELDTA
|
||
SPA /IS IT THE DTA, OR RK05
|
||
RAR /NO - MUST BE HSR, ?, CDR, OR CHARACTER DEVICE
|
||
SNL /IS IT A CHARACTER OUTPUT DEVICE?
|
||
JMP REL6 /NO - MUST BE KEYBOARD, HSR, ?, CDR, R2, OR X DEVICE
|
||
TAD RELREG
|
||
REL2, DCA RELBLK /POINTS TO ENTRY IN 'OUTREG' (OR 0 FOR KEYBOARD OUTPUT)
|
||
CLA CMA
|
||
TAD I RELDVT
|
||
DCA INDEX /POINTS TO WORD 0 OF DDB
|
||
TAD I INDEX
|
||
SPA CLA /IS THE TTY IN ^S MODE?
|
||
JMP REL3 /YES - FLUSH IT OUT
|
||
DCA I INDEX /CLEAR THE JOB NUMBER
|
||
ISZ INDEX
|
||
ISZ INDEX
|
||
TAD I INDEX
|
||
SZA CLA /IS THE FILL-POINTER ZERO?
|
||
JMP REL4 /NO - LET 'CONOUT' RELEASE THE BLOCK
|
||
TAD RELBLK
|
||
SZA CLA /ASSIGNABLE DEVICE?
|
||
JMP REL5 /YES
|
||
REL3, TAD I RELDVT
|
||
CIF
|
||
JMS I RELCLR /FLUSH THE DEVICE BUFFER
|
||
DATFLD
|
||
TAD I RELDVT
|
||
JMS I RETBK1 / AND RELEASE THE BLOCK
|
||
CLA
|
||
DATFLD
|
||
DCA I RELDVT /THEN CLEAR THE DEVTBL ENTRY
|
||
REL4, CFLD
|
||
JMP I REL00 / AND RETURN
|
||
|
||
REL5, CIF 20 / (JUST INHIBIT INTERRUPTS WHEN CHECKING OUTREG)
|
||
TAD I RELBLK
|
||
CLL RAL
|
||
SNA /IS AN INTERRUPT EXPECTED OR A CHARACTER BUFFERED?
|
||
JMP REL3 /NO - JUST CLEAR OUT THE DDB
|
||
SPA /YES - IS AN INTERRUPT PENDING?
|
||
CLL CML /YES - INSURE DEVICE SERVICING
|
||
RAR
|
||
DCA I RELBLK / AND RESTORE THE WORD
|
||
JMP REL4
|
||
|
||
REL6, SMA CLA /IS IT A KEYBOARD OR THE HSR?
|
||
JMP REL7
|
||
TAD RELBLK
|
||
CIF
|
||
JMS I RELCLR /YES - CLEAR THE BUFFER
|
||
REL7, TAD RELBLK
|
||
JMS I RETBK1 /RETURN THE FREE-BLOCK
|
||
CLA
|
||
DATFLD
|
||
DCA I RELDVT / AND CLEAR THE DEVTBL ENTRY
|
||
TAD DEVEND
|
||
CIA
|
||
TAD RELDVT
|
||
SMA CLA /IS THIS A KEYBOARD?
|
||
JMP REL4 /NO - JUST RETURN
|
||
ISZ RELDVT /YES - SET THE POINTER TO THE OUTPUT SIDE
|
||
JMP REL2 / AND RUN IT ALL AGAIN
|
||
|
||
/DEVICE RELEASED IS NOT OWNED BY THIS USER.
|
||
REL8, CHKSRC /IS HE USING A KEYBOARD COMMAND?
|
||
JMP I REL00 /NO - JUST RETURN
|
||
JMP I LGI201 /YES - TELL 'SI' HE BLEW IT
|
||
|
||
RELASD, 0
|
||
RELBLK, 0
|
||
RELRTB, RTABLE /TWO-WORD PACKET FOR 'DS0'
|
||
RELNOW, 0
|
||
RELCK1, CLK1
|
||
RELCK2, CLK2
|
||
RELCLR, SICLR
|
||
RC1= INCLK1%1000
|
||
RELCON, INCLK2^10+RC1 /FUDGE FOR MIDNIGHT OVERFLOW
|
||
RELDTA, -DEVTBE-20
|
||
RELREG, DEVTBE+20-DEVTBL%2+OUTREG / = OUTREG+NULINE+CONTTY+10
|
||
PAGE
|
||
/RENAME ROUTINE
|
||
|
||
REN0, JMS I IFN01
|
||
JMS I UC01 /DOES HE OWN THE FILE?
|
||
JMP REN1 /NO - ERROR
|
||
TAD FIOSTK+1 /YES - SAVE THE INTERNAL FILE #
|
||
DCA FIOSTK
|
||
TAD I RENUCP /GET THE OWNER'S ACCOUNT NUMBER
|
||
DCA REPRTP
|
||
TAD I REPRTP
|
||
JMS I UTS01 / AND FIND THE 'UFDTBL' ENTRY
|
||
HLT /BAD - IF THE FILE'S OPEN, THERE MUST BE ONE *****
|
||
JMS I BLDP1 /GET THE 'RETTBL' ENTRY ADDRESS
|
||
DCA FIOSTK+1
|
||
CLA CMA
|
||
TAD I REPRTP /CHECK THE OWNER'S ACCOUNT
|
||
SNA CLA /IS IT A DIRECTORY (I.E. OWNED BY ACCT # 1)?
|
||
CLA CMA /YES - THE FIRST WORD (ACCOUNT) MUST BE UNIQUE
|
||
JMS I DS01 /NOW CHECK IF THE NAME ALREADY EXISTS
|
||
FIOSTK+1
|
||
SKP CLA /NOPE - OK TO RENAME
|
||
JMP REN2 /YES - "INVALID FILE NAME"
|
||
TAD FIOSTK
|
||
JMS I GD01 /GET THIS DIRECTORY ENTRY INTO CORE
|
||
DCA REENTP / AND SAVE THE POINTER
|
||
TAD REENTP
|
||
TAD P0004
|
||
DCA REPRTP /POINTER TO PROTECTION BITS
|
||
TAD I REPRTP /PICK UP PROTECTION BITS
|
||
AND C0020
|
||
SZA CLA /WRITE-PROTECTED AGAINST OWNER?
|
||
JMP REN1+1 /YES - "PROTECTION VIOLATION"
|
||
TAD FIOSTK+2 /TRANSFER NEW NAME TO DIRECTORY
|
||
SNA /IS IT A NULL NAME?
|
||
JMP REN2 /YES, DON'T RENAME
|
||
DCA I REENTP
|
||
ISZ REENTP
|
||
TAD FIOSTK+3
|
||
DCA I REENTP
|
||
ISZ REENTP
|
||
TAD FIOSTK+4
|
||
DCA I REENTP
|
||
SAVBUF /SET 'BUFFER CHANGED' SWITCH
|
||
JMP I FIEXIT /EXIT FROM FILE PHANTOM
|
||
|
||
REN1, SZA CLA /WHICH ERROR?
|
||
CPERR2, CLL CML RAR /6000 - PROTECTION VIOLATION
|
||
CLL CML RAR /4000 - NO FILE OPEN
|
||
DCA FIUSAC
|
||
JMP I FIEXIT
|
||
|
||
REN2, CLA CLL CML RTR /6400 - INVALID FILE NAME
|
||
JMP REN1+1
|
||
|
||
REENTP, 0
|
||
RENUCP, UCUFDP
|
||
REPRTP, 0
|
||
/THIS HANDLES THE 'CPASS' IOT - CHANGE PASSWORD.
|
||
/IF THE SYSTEM MANAGER PASSES THE INCORRECT CURRENT
|
||
/PASSWORD, HE IS SIMPLY RETURNED AN ERROR CODE;
|
||
/IF ANYONE ELSE PASSES US AN INCORRECT CURRENT
|
||
/PASSWORD, THEY ARE AUTOMATICALLY LOGGED-OUT.
|
||
|
||
CPASS0, TAD FIOSTK+1
|
||
SNA CLA /RATIONAL ACCOUNT NUMBER?
|
||
JMP CPERR2 /NO - RETURN ERROR CODE
|
||
CLA CMA
|
||
TAD FIACCT
|
||
SNA CLA /IS THIS THE MANAGER?
|
||
JMP CPASS1 /YES
|
||
TAD FIACCT
|
||
CIA
|
||
TAD FIOSTK+1
|
||
SZA CLA /NO - IS THIS HIS OWN PASSWORD?
|
||
JMP CPERR2 /NO - JUST SAY "PROTECTION VIOLATION"
|
||
CPASS1, TAD RETTBL
|
||
DCA FIOSTK /MFD IS ALWAYS FIRST ENTRY
|
||
JMS I DS01 /SEARCH FOR ACCT & PASSWORD IN MFD
|
||
FIOSTK
|
||
JMP CPERR1 /NOT THERE - ERROR!
|
||
DCA INDEX /SAVE THE ENTRY CORE-ADDRESS
|
||
CLA CMA
|
||
TAD FIACCT
|
||
SNA CLA /IS THIS THE MANAGER (#1)?
|
||
JMP CPASS2 /YES - HE CAN CHANGE ANYONE'S PASSWORD
|
||
TAD INDEX /NO - GET THE UFD PROTECTION
|
||
TAD P0004
|
||
DCA CFH
|
||
TAD I CFH
|
||
AND CPBIT /CHECK THE 'CHANGE PASSWORD DISABLE' BIT
|
||
SZA CLA /CAN HE CHANGE HIS OWN PASSWORD?
|
||
JMP CPERR2 /NO - "PROTECTION VIOLATION"
|
||
CPASS2, TAD FIOSTK+4 /YES - SET THE NEW PASSWORD
|
||
DCA I INDEX
|
||
TAD FIOSTK+5
|
||
DCA I INDEX
|
||
SAVBUF /SET THE 'BUFFER CHANGED' SWITCH
|
||
JMP I FIEXIT / AND EXIT
|
||
|
||
CPERR1, CLA CMA
|
||
TAD FIACCT
|
||
SNA CLA /IS THIS THE MANAGER?
|
||
JMP CPERR2 /YES - JUST RETURN ERROR CODE
|
||
TAD CPLOUT /NO - SET UP THE 'LOGOUT' PARMS
|
||
DCA FIOSTK
|
||
TAD FIJOB
|
||
DCA FIOSTK+1
|
||
JMP I .+1 /THEN LOG HIM OUT
|
||
LGO0
|
||
|
||
CPBIT, 2000 /BIT IN UFD PROTECTION - IF SET, PROHIBITS CPASS
|
||
CPLOUT, LOUT
|
||
/THIS HANDLES THE 'BCLR' IOT - THIS ALLOWS THE SYSTEM MANAGER
|
||
/AND THE BILLING SYSTEM TO CLEAR THE BILLING INFORMATION IN
|
||
/THE MFD TO ZEROES. BY USING AN IOT FOR THIS, WE AVOID THE
|
||
/NEED FOR ANY USER PROGRAM TO WRITE INTO THE MFD OR ANY UFD
|
||
/DIRECTLY (THUS AVOIDING ANY CONFLICT WITH FIP). WE THEREFORE
|
||
/NORMALLY SET THE PROTECTION CODES TO PREVENT ANYONE FROM
|
||
/WRITING ANY UFD.
|
||
|
||
BCLR0, CHKACT /IS THIS A PRIVILEGED ACCOUNT?
|
||
SKP /YES
|
||
JMP CPERR2 /NO - SAY "PROTECTION VIOLATION"
|
||
TAD FIOSTK+1
|
||
SNA CLA /DID HE PASS US AN ACCOUNT NUMBER?
|
||
JMP REN2 /NO - BOO, HISS!!
|
||
TAD RETTBL /YES - THE MFD IS ALWAYS THE FIRST ENTRY
|
||
DCA FIOSTK
|
||
CLA CMA /NOW DO A ONE-WORD SEARCH FOR THE ACCOUNT
|
||
JMS I DS01
|
||
FIOSTK
|
||
JMP REN2 /NO FIND - ERROR!!
|
||
TAD P0004
|
||
DCA INDEX /SET THE POINTER TO THE INFORMATION
|
||
DCA I INDEX / AND ZERO THE DEVICE TIME
|
||
DCA I INDEX / AND THE CPU TIME
|
||
SAVBUF /NOW SET THE 'BUFFER CHANGED' SWITCH
|
||
JMP I FIEXIT / AND EXIT
|
||
|
||
|
||
/ROUTINE TO CALCULATE A POINTER INTO 'ENTTBL'.
|
||
/AC = [JOB * 4 + FILEID] * 2 + 'ENTTBL'
|
||
EBLD, 0
|
||
DCA CFH
|
||
TAD FIJOB
|
||
CLL RTL
|
||
TAD CFH
|
||
RAL
|
||
TAD ENTTBL
|
||
JMP I EBLD
|
||
PAGE
|
||
/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
|
||
SI+FIP+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 JOBTBA /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 'JOBTBL'
|
||
TAD FIJOB
|
||
TAD LGOCLK
|
||
DCA LGO6
|
||
DCA I LGO6 /CLEAR ANY 'CLKTBL' ENTRY
|
||
CDF
|
||
DCA I JOBA /CLEAR JOB (SO SAVJOB WON'T SAVE US)
|
||
DCA FIJOB / AND AVOID MISTAKING US FOR LOGGED-IN
|
||
JMP I .+1 /AND NOW GO DO FIX50
|
||
LGO500, FIX50
|
||
LGOBLS, RETBLS
|
||
LGOCLK, CLKTBL
|
||
LGOFIX, FIX500
|
||
LGO6, 0
|
||
/
|
||
/ROUTINE TO HANDLE THE LOGOUT IOT WHEN THE PASSED AC = 0.
|
||
/WE COUNT UP THE NUMBER OF ADDITIONAL USERS ON THIS ACCOUNT.
|
||
LGO1, TAD FIOSTK+1 /LOGOUT WITH AC = 0?
|
||
SZA CLA
|
||
JMP I LGI201 /NO, SO IT'S AN ERROR
|
||
TAD LGOMAX /YES - COUNT # OF OTHER USERS
|
||
DCA LGOCNT / OF HIS ACCOUNT #
|
||
TAD DEVOVR /ADDRESS OF JOBTBL
|
||
DCA JOBDAT /INITIALIZE 'JOBDAT' TO LOOK AT ALL JOBS
|
||
DCA FIUSAC /ZERO 'FIND' COUNTER
|
||
LGOLP, ISZ JOBDAT
|
||
DATFLD
|
||
TAD I JOBDAT
|
||
CFLD
|
||
SNA CLA /IS THE JOB SLOT IN USE?
|
||
JMP LGOLPE /NO - ON TO THE NEXT
|
||
FGETJT /GET LOCATION OF USER'S ACCOUNT NUMBER
|
||
JOBACT
|
||
DCA CFH
|
||
DATFLD
|
||
TAD I CFH /PICK UP THE ACCOUNT NUMBER
|
||
CFLD
|
||
CIA
|
||
TAD FIACCT
|
||
SNA CLA /SAME AS OURS?
|
||
ISZ FIUSAC /YES - INCREMENT COUNT
|
||
LGOLPE, ISZ LGOCNT
|
||
JMP LGOLP /CONTINUE
|
||
CLA CMA
|
||
TAD FIUSAC /NOW DISCOUNT OUR OWN JOB
|
||
DCA FIUSAC
|
||
TAD LGODAT /THEN RESTORE JOBDAT
|
||
DCA JOBDAT
|
||
JMP I FIEXIT
|
||
|
||
LGOCNT, 0
|
||
LGODAT, CJOBDA
|
||
LGOMAX, -JOBMAX
|
||
|
||
|
||
/ROUTINE TO CLOSE ANY SPECIAL (ACCOUNT 7) FILES LEFT OPEN.
|
||
PRVCLS, 0
|
||
TAD C7774
|
||
DCA PCNUM /SET FOR 4 FILES
|
||
PRVCL1, TAD PCNUM
|
||
TAD P0004
|
||
JMS I LNK01 /GET THE FILE CONTROL-BLOCK
|
||
SNA
|
||
JMP PRVCL2
|
||
TAD FILPRP
|
||
DCA CFH /NOW POINTS TO THE PROTECTION & PRIVILEGE WORD
|
||
TAD I CFH
|
||
CLL RAR
|
||
SNL CLA /IS THIS A PRIVILEGED FILE?
|
||
JMP PRVCL2 /NO
|
||
TAD PCNUM
|
||
TAD P0004
|
||
JMS I CL01 /YES - CLOSE IT
|
||
PRVCL2, ISZ PCNUM
|
||
JMP PRVCL1
|
||
JMP I PRVCLS
|
||
/
|
||
PCNUM= LGOCNT
|
||
/
|
||
/ROUTINE TO GET THE NUMBER OF A DEVICE ATTACHED TO THIS JOB
|
||
/CALLING SEQUENCE:
|
||
/ JMS LNS0
|
||
/ RETURN IF NONE AVAILABLE
|
||
/ NORMAL RETURN (LINE 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 SECOND 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 NO DEVICES
|
||
|
||
LNS5, TAD DEVEND
|
||
CIA
|
||
TAD CFH
|
||
SMA
|
||
JMP LNS6
|
||
TAD LNS10
|
||
CLL RAR
|
||
LNS8, ISZ LNS0
|
||
JMP LNS7
|
||
|
||
LNS6, TAD C4000
|
||
JMP LNS8
|
||
|
||
C4000, 4000
|
||
LNS10, DEVTBE-DEVTBL
|
||
LNS3= LGOCNT
|
||
|
||
PAGE
|
||
|
||
/HERE WE CHECK FOR OTHER JOBS NEEDING 'FIP' TO TRY AND
|
||
/MINIMIZE THE NUMBER OF TIMES FIP NEEDS TO BE SWAPPED IN.
|
||
|
||
FIXSCH, TAD FIXJMX
|
||
SNA CLA /HAVE WE ALREADY EXHAUSTED OUR PRIORITY RIGHTS?
|
||
JMP FIXOUT /YES
|
||
TAD FIJOB
|
||
TAD JOBTBA
|
||
DCA INDEX
|
||
DATFLD
|
||
FIXSC1, TAD INDEX
|
||
TAD FIXSTE
|
||
SZA CLA /REACHED END OF THE JOBTBL?
|
||
JMP .+3
|
||
TAD JOBTBA /YES - RESET THE POINTER AT THE BEGINNING
|
||
DCA INDEX
|
||
TAD I INDEX
|
||
SNA /IS THERE A JOB IN THIS SLOT?
|
||
JMP FIXSC2 /NO
|
||
IAC
|
||
DCA CFH /YES - SET POINTER TO STR0 (JOBSTS)
|
||
TAD I CFH
|
||
AND FIXSJS
|
||
SNA CLA /IS THE JOB WAITING FOR 'FIP'?
|
||
JMP FIXSC2 /NO
|
||
TAD JOBTBA
|
||
CIA
|
||
TAD INDEX /YES - GET HIS JOB NUMBER
|
||
JMP FIXOUT / AND EXIT (SETTING 'FIPJOB')
|
||
FIXSC2, ISZ FIXJMX
|
||
JMP FIXSC1
|
||
|
||
/ALL DONE - SET (OR CLEAR) 'FIPJOB' IN FIELD 0 AND EXIT.
|
||
FIXOUT, CIF CDF
|
||
DCA I FIPJBA
|
||
WAIT
|
||
|
||
FIPJBA, FIPJOB
|
||
FIXJMX, -JOBMAX /GETS CLOBBERED, BUT RESET EVERY TIME FIP IS RELOADED
|
||
FIXSJS, JSIOT
|
||
FIXSTE, -JOBTBL-JOBMAX
|
||
|
||
/ROUTINE TO CHECK THE USERS 'PRIVILEGE' FLAG AND SKIP IF SET.
|
||
|
||
CHKPV0, 0
|
||
FGETJT /GET HIS STR0 LOCATION
|
||
JOBSTS
|
||
DCA CFH
|
||
DATFLD
|
||
TAD I CFH
|
||
AND CHKJSP
|
||
SZA CLA /IS HE PRIVILEGED NOW?
|
||
ISZ CHKPV0 /YES - SKIP ON RETURN
|
||
CFLD
|
||
JMP I CHKPV0
|
||
|
||
/SUBROUTINE TO CHECK THE FILE EXTENSION AND POSSIBLY
|
||
/SET THE PRIVILEGE BIT FOR THIS JOB.
|
||
|
||
OPNPV0, 0
|
||
TAD I OPNBUF /GET THE FILE PROTECTION CODE
|
||
AND C7700
|
||
TAD OPNSVP
|
||
SZA CLA /IS EXTENSION .SVP (34)?
|
||
JMP I OPNPV0 /NO - JUST RETURN
|
||
CLA CLL CMA RAL
|
||
TAD OPNACT
|
||
SNA CLA /IS THE FILE FROM THE SYSTEM LIBRARY?
|
||
CHKSRC /YES - WHO CALLED US?
|
||
JMP I OPNPV0 /A USER - CAN'T SET 'PRIVILEGE'
|
||
FGETJT /'SI' - GET THE JOB STATUS-WORD
|
||
JOBSTS
|
||
DCA CFH
|
||
DATFLD
|
||
TAD OPNJSP
|
||
CMA
|
||
AND I CFH /CLEAR THE 'PRIVILEGE' BIT
|
||
TAD OPNJSP / AND THEN SET IT
|
||
DCA I CFH
|
||
CFLD
|
||
JMP I OPNPV0 /THEN JUST RETURN
|
||
|
||
OPNSVP, -3400 /.SVP FILE EXTENSION
|
||
CHKJSP,
|
||
OPNJSP, JSPRIV
|
||
|
||
/WE GET HERE WHEN THE 'UFD' HE TRIED TO OPEN DIDN'T
|
||
/EXIST. WE GIVE HIM THE NUMBER OF THE NEXT 'UFD'.
|
||
|
||
OPNR01, DATFLD
|
||
TAD I FIOPTR /GET THE PARAMETER BLOCK
|
||
DCA OPNBUF
|
||
TAD C7000
|
||
DCA I OPNBUF /SET THE FINAL AC CONTENTS
|
||
TAD OPNBUF
|
||
TAD P0004
|
||
DCA OPNBUF
|
||
CFLD
|
||
TAD I OPNNXT /GET THE NEXT ACCOUNT
|
||
DATFLD
|
||
DCA I OPNBUF
|
||
TAD P0004 /GET THE NUMBER OF PARAMETERS
|
||
JMP I .+1 / TO RETURN TO THE USER
|
||
INF6
|
||
|
||
OPNNXT, DSNEXT /WORD IN 'DS0'
|
||
|
||
IFZERO .-5200&4000 <GLITCH>
|
||
*5200
|
||
SEGBUF, /SEGMENT-SIZE BUFFER
|
||
*WRDSEG+SEGBUF
|
||
ENTABL, /4 2-WORD ENTRIES PER JOB
|
||
*JOBMAX^10+ENTABL
|
||
UTABLE, /A 2-WORD ENTRY FOR EACH UFD ACCESSED
|
||
*JOBMAX^4+UTABLE
|
||
RTABLE, /1 8-WORD ENTRY FOR EACH 'UTABLE' ENTRY
|
||
*JOBMAX^20+RTABLE
|
||
FIPTOP, /END OF FIP TABLES (EXCEPT 'SAT')
|
||
IFZERO FIPTOP+SATSIZ&4000 <GLITCH>
|
||
*-SATSIZ /START OF DISC ALLOCATION TABLE
|
||
///// $$$$$
|
||
$$$$$
|
||
|