EXEC4
* /--- FILE TYPE = E
* /--- BLOCK EXEC4 00 000 78/12/18 21.22
IDENT PLAT3$
LCC OVERLAY(PLATO,1,0)
END
IDENT EXEC4
TITLE EXEC4 OVERLAYS FOR COMMAND EXECUTION
*
*
CST
*
*
EXEC4$ OVFILE
*
*
EXT ECSPRTY
EXT PROCESS,PROC,CKPROC,RETPROC
EXT PDWRITE
EXT DIOREQ,DIOREQ1
EXT WINDOW
EXT ILOC
EXT RNETSF,RNETSN,LNETSF,LNETSN
EXT REQCHK
EXT SAVKEY,RESTKEY
EXT SAVLES,RESTLES
EXT S=MAS
EXT FIPCHK
*
CONV$ EQU 0 GENERATE ERROR CODE CONV. TABLE
LIST X
*CALL PLASMRC
*
* NEEDED TO DEFINE QUALIFIED CODE
*
*CALL PLASFIP
*
LIST *
* /--- BLOCK MACROS 00 000 76/05/10 00.23
TITLE MACROS
*
*
PURGMAC CLRBIT
CLRBIT MACRO INDEX,TABLE
LOCAL A,K
SX1 INDEX
SA2 K LOAD DIVIDE LITERAL
PX3 X1
FX2 X2*X3 INDEX/48
UX2 X2 X2 = WORD POSITION
SX3 48
DX3 X2*X3 COMPUTE REMAINDER
IX3 X1-X3
SB2 X3 B2 = SHIFT COUNT
MX3 1
LX3 60-12 FORM MASK FOR SINGLE BIT
AX3 X3,B2
SB2 TABLE
SA2 X2+B2 LOAD APPROPRIATE WORD
BX6 -X3*X2 CLEAR BIT
SA6 A2
EQ A EXIT
K DATA 17170125252525252526B 1/48*2**-48
A BSS 0
ENDM
*
*
*
PURGMAC SETBIT
SETBIT MACRO INDEX,TABLE
LOCAL A,K
SX1 INDEX
SA2 K LOAD DIVIDE LITERAL
PX3 X1
FX2 X2*X3 INDEX/48
UX2 X2 X2 = WORD POSITION
SX3 48
DX3 X2*X3 COMPUTE REMAINDER
IX3 X1-X3
SB2 X3 B2 = SHIFT COUNT
MX3 1
LX3 60-12 FORM MASK FOR SINGLE BIT
AX3 X3,B2
SB2 TABLE
SA2 X2+B2 LOAD APPROPRIATE WORD
BX6 X3+X2 SET BIT
SA6 A2
EQ A EXIT
K DATA 17170125252525252526B 1/48*2**-48
A BSS 0
ENDM
* /--- BLOCK STATS 00 000 75/04/02 03.38
TITLE -STATS- COMMAND (CODE = 202)
** -STATS- COMMAND EXECUTION OVERLAY
*
* STATS ARG,LESSON
* STATS ARG,ACCOUNT';LESSON
* STATS ARG,'OLD';LESSON
* STATS ARG,(N1)';(N2)
* STATS ARG,(N2)
* STATS ARG,0 $$ ALL LESSONS
* STATS ARG $$ ALL LESSONS
*
* ARG = 1 = CONDENSING STATS OFF
* 0 = EXECUTION STATS OFF
* -1 = EXECUTION STATS ON
* -2 = CONDENSOR STATS ON
* -3 = MAXIMUM-TIME EXECUTION STATS ON
*
* GETVAR CODE 1 = ARG AS DEFINED ABOVE
* 2 = ACCOUNT NAME
* 3 = LESSON NAME
*
* ENTRY (X5) = NEG. IF LESSON NAME/ACCOUNT OMITTED
*
*
* -STATS- COMMAND OVERVIEW
*
* THE -STATS- COMMAND FIRST PROCESSES THE ARGUMENT
* (-3, -2, -1, 0, 1) AND THE OPTIONAL FILE NAME AND
* CHECKS TO SEE THAT THE FIRST ARGUMENT IS LEGAL.
* IT THEN POSTS A REQUEST TO ALL EXECUTORS OR
* CONDENSORS.
*
* REQUESTS TO EXECUTORS ARE POSTED BY (1) PLACING
* THREE WORDS OF PARAMETERS IN ECS, (2) POSTING AN
* INTER-EXECUTOR REQUEST TO OTHER EXECUTORS, AND
* (3) POSTING AN ACTION REQUEST TO YOURSELF.
*
* (EXSTPRM) CONTAINS THE ADDRESS OF THE THREE WORDS
* OF ECS PARAMETERS FOR COMMAND EXECUTION STATS,
* WHICH CONTAIN THE FOLLOWING DATA --
*
*T 60/0 TO TURN OFF, 1 FOR NORMAL, 2 FOR MAXIMUM TIME
*T, 42/ACCOUNT NAME,18/ATTRIBUTES
*T, 60/FILE NAME
*
* THE FORMAT OF AN INTER-EXECUTOR REQUEST TO TURN
* COMMAND EXECUTION STATISTICS ON OR OFF IS --
*
*T 42/0, 18/XR.STAT
*
* THE FORMAT AN ACTION-REQUEST TO TURN COMMAND
* EXECUTION STATS ON OR OFF IS --
*
*T 42/0, 18/RQSTAT
*
*
* UPON RECEIVING A REQUEST TO TURN COMMAND EXECUTION
* STATS ON OR OFF, AN EXECUTOR CALLS THE *EXSTATV*
* OVERLAY IN DECK *EXEC4* WITH (OVARG1) = 1. THIS
* OVERLAY THEN EVALUATES THE THREE WORDS IN ECS AND
* TAKES THE APPROPRIATE ACTION --
*
* IF STATS WERE PREVIOUSLY OFF AND ARE NOW
* BEING TURNED ON, THE TIME-SLICE LENGTH IS
* INCREASED BY 25 PERCENT.
*
* (SCOMFLG) IS SET TO 0 IF STATS ARE OFF, 1
* FOR NORMAL STATS, 2 FOR MAXIMUM TIME STATS.
*
* IF STATS ARE BEING TURNED ON, (SCOMACT) IS
* SET TO THE ACCOUNT NAME OR 0, (SCOMLES) IS
* SET TO THE LESSON NAME OR 0, AND THE STATS
* BUFFER FOR THAT EXECUTOR IS ZEROED.
*
* IF EXECUTION STATS WERE PREVIOUSLY ON AND
* /--- BLOCK STATS 00 000 75/04/02 03.38
* ARE NOW BEING TURNED OFF, THE ORIGINAL
* TIME-SLICE LENGTH IS RESTORED.
*
* THE PLATO EXECUTOR WILL NOW RECORD COMMAND EXECU-
* TION STATISTICS. EACH EXECUTOR HAS ITS OWN STATS
* BUFFER, THE ADDRESS OF WHICH IS (ACMNDEX)+(EXID).
* THERE IS ONE CELL PER COMMAND NUMBER (512 TOTAL).
*
* FOR NORMAL STATISTICS, EACH CELL CONTAINS --
*
*T 30/TOTAL OCCURRENCES, 30/TOTAL TIME
*
* FOR MAXIMUM EXECUTION TIMES, EACH CELL CONTAINS --
*
*T 60/MAXIMUM TIME
*
* A COUPLE OTHER CELLS ARE ALSO MAINTAINED IN
* /STATCOM/ SO THAT THE STATS OF ANY EXECUTOR CAN
* BE ACCESSED --
*
* (SCOMNDT) = TOTAL TIME FOR ALL COMMANDS
* (SCOMNDN) = TOTAL COMMANDS
*
* THE *EXSTATV* OVERLAY IS ALSO INVOKED ON A COUPLE
* OTHER OCCASIONS --
*
* WITH (OVARG1) = 2 TO INITIALIZE STATS FOR
* A NEWLY-LOADED EXECUTOR
*
* WITH (OVARG1) = 3 TO CLEAR THE STATS BUFFER
* WHEN AN EXECUTOR IS ABOUT TO BE DROPPED
*
* IN PLATO INITIALIZATIONS (DECK *MSUBS*), STATS
* BUFFERS ARE DE-ALLOCATED (1) FOR UNUSED EXECUTORS
* AND (2) FOR ALL EXECUTORS IF ESTAT=OFF IN THE
* CONFIG FILE.
*
* COMMAND CONDENSE STATISTICS ARE HANDLED IN A
* SOMEWHAT DIFFERENT MANNER. IN THE EXECUTOR
* (ACDSTAT) CONTAINS THE ADDRESS OF THE STATS BUFFER
* FOR THE ORDINAL 0 CONDENSOR. WHEN A CONDENSOR
* IS BEING INITIALIZED, THIS ADDRESS IS ADJUSTED SO
* THAT (ACDSTAT) IN A CONDENSOR POINTS TO THE STATS
* BUFFER FOR THAT INDIVIDUAL CONDENSOR.
*
* A STATS BUFFER FOR A CONDENSOR CONTAINS THE
* FOLLOWING --
*
*T 60/1 IF STATS ARE ON, 0 IF OFF
*T, 60/1 IF BUFFER SHOULD BE ZEROED, 0 IF NOT
*T, 42/ACCOUNT NAME,18/ATTRIBUTES
*T, 60/LESSON NAME
*T, 60/TOTAL COMMAND COUNT
*T, 60/TOTAL TIME
*T, CMNDMAX*60/ONE CELL PER COMMAND
*
* EACH CELL CONTAINS THE FOLLOWING INFO --
*
*T 30/TOTAL OCCURRENCES, 30/TOTAL TIME
*
* THE INITIALIZATIONS THAT ARE DONE IN *COVLAY2*
* WHEN A LESSON IS ABOUT TO BE CONDENSED CHECK
* TO SEE IF STATISTICS ARE TURNED ON AND, IF ON,
* IF STATS FOR THE CURRENT LESSON SHOULD BE TAKEN;
* IF STATS ARE TO BE COLLECTED FOR THE CURRENT
* LESSON, A FLAG (*SCOMFG1*) IS SET, AND THE BUFFER
* AND TOTALS ARE ZEROED IF REQUESTED.
STATOV OVRLAY
CALL MXTEST,-1,XR.THR CHECK FOR REQ. OVERFLOW
NG X6,=XRETRNZ IF TOO MANY INTER-EXECUTOR REQ
SA1 AOUTLOC (X1) = CURRENT ACTION REQ PTR
* /--- BLOCK STATS 00 000 75/04/02 03.38
SX1 X1+1-AOUTLTH NEED 1 WORD FOR STATS REQUEST
PL X1,=XRETRNZ IF NOT ENOUGH ROOM
* PROCESS GETVAR CODES.
NGETVAR (X1) = ARGUMENT
BX6 X1
SA6 ST.ARG
SX6 0
SA6 VARBUF PRESET FOR ZERO ACCOUNT NAME
SA6 VARBUF+1 PRESET FOR ZERO FILE NAME
SA5 A5+0 RESTORE COMMAND WORD
NG X5,STATS1 IF ACCOUNT';FILE OMITTED
BX6 X5
LX6 XCODEL (X6) = 20/ACCT GETVAR, 40/TRASH
SA6 VARBUF STORE GETVAR CODE FOR ACCT NAME
AX5 XCMNDL POSITION POINTER
MX1 -XSPTRL
BX1 -X1*X5 (X1) = EXTRA STORAGE POINTER
SA1 X1+B5 (X1) = 20/FILE GETVAR, 40/TRASH
BX6 X1
SA6 VARBUF+1
STATS1 CALL ACCFILE,VARBUF,ST.ACCT,0
* JUMP ON FIRST ARGUMENT.
SA1 ST.ARG (X1) = ARGUMENT
SX3 3
IX2 X1+X3 (X2) = JUMP TABLE INDEX
NG X2,=XERXVAL ERROR IF (ST.ARG) .LT. -3
SX3 2
IX3 X1-X3
PL X3,=XERXVAL ERROR IF (ST.ARG) .GT. 1
SB1 X2 (B1) = JUMP TABLE INDEX
JP B1+*+1
+ SX6 2 -3 = MAXIMUM EXECUTION STATS ON
EQ EXECSTS
+ SX6 1 -2 = CONDENSE STATS ON
EQ CNDSTAT
+ SX6 1 -1 = EXECUTION STATS ON
EQ EXECSTS
+ SX6 0 0 = EXECUTION STATS OFF
EQ EXECSTS
+ SX6 0 1 = CONDENSE STATS OFF
EQ CNDSTAT
CNDSTAT SPACE 5,15
** CNDSTAT -- TURN COMMAND CONDENSE STATS ON/OFF
*
* ENTRY (X6) = 1 TO TURN ON, 0 TO TURN OFF
* (ST.ACCT) = ACCOUNT NAME OR 0
* (ST.LESS) = LESSON NAME OR 0
*
* EXIT REQUEST POSTED TO ALL CONDENSORS IF STATS
* BUFFER HAS BEEN ALLOCATED
CNDSTAT SA1 ACDSTAT (X1) = ECS ADDR OF BUFFER
ZR X1,=XPROCESS EXIT IF NO BUFFER
BX0 X1 (X0) = ECS ADDR OF BUFFER
SA0 CNDSTATS (A0) = CM COPY OF REQUEST
RE /CSTAT/SCOMNDP READ BACK LAST REQUEST
RJ ECSPRTY
SA6 CNDSTATS+/CSTAT/SCOMFG1 STORE ON/OFF FLAG
ZR X6,CNDSTAT1 IF TURNING STATS OFF
SA2 ST.ACCT (X2) = ACCOUNT NAME
SA3 ST.LESS (X3) = LESSON NAME
BX6 X2
BX7 X3
SA6 CNDSTATS+/CSTAT/SCOMACT
SA7 CNDSTATS+/CSTAT/SCOMLES
* /--- BLOCK STATS 00 000 75/04/02 03.38
SX6 1
SA6 CNDSTATS+/CSTAT/SCOMZER ZERO REQ BUFFER
* PASS THE REQUEST TO ALL THE CONDENSORS.
CNDSTAT1 SX2 /CSTAT/SCOMNDH+CMNDMAX (X2) = BUFFER LTH
SB1 0 (B1) = CURRENT CONDENSOR
SB2 NCONDEN-1 (B2) = LAST CONDENSOR ORDINAL
IX0 X1-X2 PRESET FOR BUFFER -1
CNDSTAT2 IX0 X0+X2 INCREMENT BUFFER ADDRESS
WE /CSTAT/SCOMNDP WRITE REQUEST TO ECS
RJ ECSPRTY
SB1 B1+1
LE B1,B2,CNDSTAT2 DO FOR NEXT CONDENSOR
EQ =XPROCESS
EXECSTS SPACE 5,15
** EXECSTS -- TURNS EXECUTION STATS ON/OFF
*
* ENTRY (X6) = 2 FOR MAXIMUM EXECUTION STATS, 1 FOR
* NORMAL STATS, 0 TO TURN THEM OFF
* (ST.ACCT) = ACCOUNT NAME OR 0
* (ST.LESS) = LESSON NAME (0 FOR ALL LESSONS)
*
* EXIT TO *PROCESS*
* EXECUTION STATS PARAMETERS IN ECS UPDATED
* REQUEST POSTED TO ALL EXECUTORS
*
* CALLS ECSPRTY, MXRQALL
*
* MACROS CALL
* UPDATE EXECUTION STATS PARAMETERS IN ECS.
EXECSTS SA6 ST.ARG SAVE STATS ON/OFF PARAMETER
SA1 EXSTPRM (X1) = ECS ADDR OF PARAMETERS
BX0 X1
SA0 A6 (A0) = CM ADDR OF PARAMETERS
WE 3 WRITE PARAMETERS TO ECS
RJ ECSPRTY
* REQUEST OTHER EXECUTORS TO TURN LESSON EXECUTION
* STATISTICS ON OR OFF.
SX6 XR.STAT (X6) = INTER-EXECUTOR REQ. CODE
SA6 MASRQ
CALL MXRQALL POST REQUEST TO OTHER EXECUTORS
* POST REQUEST TO THIS EXECUTOR, TOO.
SA1 AOUTLOC (X1) = ACTION REQUEST POINTER
SX6 RQSTAT (X6) = ACTION REQUEST CODE
SA6 ACTOUT+X1 STORE REQUEST CODE
SX6 X1+1 INCREMENT POINTER
SA6 A1 STORE UPDATED POINTER
* EXIT.
EQ =XPROCESS
* DATA FIELDS (THE FIRST THREE MUST ALWAYS BE
* CONSECUTIVE).
ST.ARG OVDATA 1 1ST COMMAND ARGUMENT
ST.ACCT OVDATA 1 ACCOUNT NAME
ST.LESS OVDATA 1 LESSON NAME
* WHEN COMMAND CONDENSE STATISTICS ARE TURNED ON IN
* THE CONFIGURATION FILE, EACH CONDENSOR HAS A
* STATISTICS BUFFER (SCOMNDH + CMNDMAX) WORDS LONG.
*
* THE FOLLOWING SYMBOLS DEFINE OFFSETS WITHIN ONE
* OF THESE STATISTICS BUFFERS.
*
* THESE DEFINITIONS ARE REPEATED IN COTEXT, EXEC4,
* AND MSUBS. IN PLATO (EXEC4 AND MSUBS) THEY ARE
* QUALIFIED BY /CSTAT/.
QUAL CSTAT
* /--- BLOCK STATS 00 000 75/04/02 03.38
SCOMFG1 EQU 0 CONDENSE STATISTICS FLAG
SCOMZER EQU 1 NON-ZERO IF BUFFER TO BE ZEROED
SCOMACT EQU 2 ACCOUNT FOR LESSON
SCOMLES EQU 3 LESSON TO COLLECT STATS ON
SCOMNDP EQU SCOMLES-SCOMFG1+1 LTH OF PARMS FROM PLATO
SCOMNDN EQU 4 TOTAL COMMAND COUNT
SCOMNDT EQU 5 TOTAL TIME
SCOMNDH EQU SCOMNDT-SCOMFG1+1 HEADER LENGTH
SCOMNDS EQU 6 STATS BUFFER *CMNDMAX* WDS LONG
QUAL *
CNDSTATS OVDATA /CSTAT/SCOMNDH CM COPY OF BUFFER HEADER
ENDOV
EXSTATV SPACE 5,15
** EXSTATV - TURN LESSON EXECUTION STATS ON/OFF
*
* ENTRY (OVARG1) = 1 IF -STATS- COMMAND REQUEST
* 2 IF INITIALIZING NEW EXECUTOR
* 3 IF EXECUTOR IS DROPPING
*
* EXIT LESSON EXECUTION STATISTICS TURNED ON OR
* OFF AND EXECUTOR'7S STATS BUFFER
* ZEROED IF NECESSARY (SEE BELOW)
EXSTATV OVRLAY
SA1 OVARG1 (X1) = OVERLAY ARGUMENT
SB1 X1+
JP B1+*+1 JUMP TO APPROPRIATE ROUTINE
+ EQ *+1S17 0 = IMPOSSIBLE
+ EQ ONOFF 1 = TURN STATS ON/OFF
+ EQ ONOFF 2 = SAME FOR A NEW EXECUTOR
+ EQ DRPEXEC 3 = IF EXECUTOR DROPPING
ONOFF SPACE 5,15
** ONOFF - TURN EXECUTION STATISTICS ON OR OFF
*
* LESSON EXECUTION STATISTICS WILL BE TURNED ON OR
* OFF BASED ON THE PARAMETERS IN ECS. IF THE
* STATISTICS ARE BEING TURNED ON, THE STATISTICS
* BUFFER FOR THIS EXECUTOR WILL ALSO BE ZEROED.
*
* CALLS CLEARBUF, ECSPRTY
*
* MACROS CALL, RETURN
ONOFF SA1 EXSTPRM (X1) = ECS ADDR OF STATS PARMS
BX0 X1
SA0 ST.ARG (A0) = CM ADDR OF STATS PARMS
RE 3 READ PARAMETERS TO CM
RJ ECSPRTY
SA1 ST.ARG (X1) = NEW ON/OFF FLAG
SA2 SCOMFLG (X2) = CURRENT ON/OFF STATS
ZR X1,OFF IF TURNING STATS OFF
* TURN LESSON EXECUTION STATISTICS ON.
NZ X2,ON1 IF ALREADY ON
SA2 ITIMESL ADD QUARTER-TIME-SLICE TO ALL
BX6 X2 TIME-SLICES
AX6 2
IX6 X2+X6
SA6 TIMESL (TIME-SLICE) = 1.25(TIME-SLICE)
ON1 CALL CLEARBUF ZERO STATISTICS BUFFER
SA1 ST.ARG
BX6 X1 (X6) = 1 FOR NORMAL, 2 FOR MAX.
BX7 X1
AX7 1 (X7) = 0 FOR NORMAL, 1 FOR MAX.
* /--- BLOCK STATS 00 000 78/12/18 21.23
SA6 SCOMFLG MARK EXECUTION STATS ON
SA7 SCOMNDT SET MAXIMUM TIME FLAG
SA1 ST.ACCT (X1) = ACCOUNT NAME
SA2 ST.LESS (X2) = LESSON NAME
BX6 X1
BX7 X2
SA6 SCOMACT SET ACCOUNT NAME
SA7 SCOMLES SET LESSON NAME
RETURN
* TURN LESSON EXECUTION STATISTICS OFF.
OFF ZR X2,OFF1 IF ALREADY OFF
SA1 ITIMESL RESTORE NORMAL TIME-SLICE LTH
BX6 X1
SA6 TIMESL
SX6 0 TURN EXECUTION STATS OFF
SA6 SCOMFLG
OFF1 RETURN
DRPEXEC SPACE 5,15
** DRPEXEC - CLEAR STATS BUFFER WHEN EXECUTOR DROPS
*
* IF AN EXECUTOR IS DROPPED, ITS LESSON EXECUTION
* STATISTICS BUFFER MUST BE ZEROED.
*
* CALLS CLEARBUF
*
* MACROS CALL, RETURN
DRPEXEC CALL CLEARBUF
RETURN
CLEARBUF SPACE 5,15
** CLEARBUF - ZERO LESSON EXECUTION STATISTICS BUFFER
*
* THIS ROUTINE IS CALLED TO RESET COMMAND EXECUTION
* STATISTICS WHEN THE STATISTICS ARE TURNED ON OR
* AN EXECUTOR IS DROPPED.
*
* USES A - 0, 1, 2
* B - NONE
* X - 0, 1, 2
*
* CALLS NONE
*
* MACROS NONE
CLEARBUF EQ *
SA1 EXID (X1) = EXECUTOR ID
SA1 ACMNDEX+X1 (X1) = ECS ADDR OF STATS BUFFER
ZR X1,CLEARBUF IF NO BUFFER PRESENT
ZERO ZBUFFER,SCOMLTH ZERO CM BUFFER
BX0 X1 (X0) = ECS ADDR. OF STAT BUFFER
WE SCOMLTH ZERO STATS BUFFER
RJ ECSPRTY
EQ CLEARBUF EXIT
* DATA FIELDS (THE FIRST THREE MUST ALWAYS BE
* CONSECUTIVE).
ST.ARG OVDATA 1 1ST COMMAND ARGUMENT
ST.ACCT OVDATA 1 ACCOUNT NAME
ST.LESS OVDATA 1 LESSON NAME
* DEFINE A CM BUFFER TO BE ZEROED. THIS
* BUFFER WILL THEN BE USED TO INITIALIZE STATISTICS
* BUFFERS. EXISTING CM BUFFERS LIKE *WORK* AND
* *INFO* CAN NOT BE USED SINCE THIS OVERLAY IS
* EXECUTED DURING INITIALIZATIONS AND THE INITIALI-
* ZATION CODE IS OVERLAYED ON THOSE BUFFERS.
ZBUFFER OVDATA SCOMLTH CM BUFFER FOR ZEROING
ENDOV
* /--- BLOCK ALLOCOV 00 000 76/11/12 03.15
TITLE ALLOCOV ALLOCATE DISK SPACE
*
*
*
* -ALLOCOV- -CREATE- COMMAND OVERLAY
*
* ON ENTRY -
* OVARG1 = FILE NAME
* OVARG2 = DISK SPACE ALLOCATION REQUEST WORD
* 36 BITS = 0
* 12 BITS = ADDITIONAL INFO
* 6 BITS = FILE TYPE NUMBER
* 6 BITS = NUMBER OF SPACES
*
* ON EXIT -
* *TERROR* = -1 = FILE CREATION SUCCESSFUL
* 0 = ERROR--PACK NAME (NOT LOADED)
* 1 = ERROR--FILE NAME (ALREADY EXISTS)
* 2 = ERROR--IMPROPER REQUEST
* 3 = ERROR--NO ROOM FOR MORE FILES
* 4 = ERROR--CANNOT FIND ENOUGH SPACE
*
* ++ NOTE ++ 'THE CM BUFFER *WORK* IS USED IN
* UPDATING THE ECS FILE TABLES.
*
* /--- BLOCK ALLOCOV 00 000 76/03/10 20.15
*
ALLOCOV OVRLAY
CALL PACKCHK,TDISKU CHECK DIRECTORY INTACT
SA1 OVARG1 LOAD FILE NAME
NG X1,AERR2A EXIT IF BAD FILE NAME
ZR X1,AERR2A
BX7 X1 SAVE FILE NAME
SA7 AFNAME
CALL FNDFILE,TDISKU,TPNAME
* ON EXIT - X6 = FILE INDEX, X7 = 1 IF NOT FOUND
* PINF = BASIC PACK INFO
BX7 -X7 CHECK IF FILE ALREADY EXISTS
SX7 X7 CHANGE -0 TO +0
SA7 TERROR PRESET ERROR FLAG
ZR X7,AERR0 EXIT IF PACK NOT LOADED
PL X7,AERR1 EXIT IF DUPLICATE FILE NAME
SA7 TRETURN ALSO SET *ZRETURN*
SA6 AINDEX SAVE FILE INDEX
SA1 TDISKU
SA2 PITS+X1 ECS ADDRESS OF PACK INFO TABLE
SA3 PINF+4 LENGTH OF PIT
BX0 X2
SB2 X3
SA0 PINF
+ RE B2 READ COMPLETE PIT FROM ECS
RJ ECSPRTY
* /--- BLOCK ALLOCOV 00 000 77/08/17 03.53
SB1 1 B1 = 1 (STANDARD INCREMENT)
SA1 OVARG2 X1 = ALLOCATION REQUEST WORD
MX0 -6
BX5 -X0*X1 X5 = NUMBER OF SPACES REQUESTED
BX7 X1
LX7 24 RE-POSITION FILE INFO
SA7 FINF SAVE IN *FINF*
AX1 6
BX2 -X0*X1 GET FILE TYPE NUMBER
ZR X2,AERR2B EXIT IF NO FILE TYPE SPECIFIED
MX2 -18 ALLOW 12 MORE INFO BITS
BX1 X2*X1
NZ X1,AERR2C EXIT IF JUNK IN WORD
SB2 X5-1 B2 = SPACE COUNT - 1
NG B2,AERR2D EXIT IF SPACE REQUESTED = 0
SX2 B2-63
PL X2,AERR2D EXIT IF SPACE REQUESTED GT 77B
SA3 PINF+3 FILE COUNT WORD
SX2 X3 CURRENT NUMBER OF FILES
AX3 18
SX3 X3 FILE LIMIT
IX1 X2-X3
PL X1,AERR3 EXIT IF FILE TABLE FULL
SA2 PINF+2 SPACE ALLOCATION COUNT WORD
SX1 X2 CURRENT NUMBER OF SPACES IN USE
AX2 18
SX2 X2 TOTAL SPACES ON PACK
IX1 X2-X1 SPACES AVAILABLE
IX1 X1-X5 COMPARE WITH REQUEST
NG X1,AERR4 EXIT IF INSUFFICIENT SPACE
* /--- BLOCK ALLOCATE 00 000 79/12/07 16.21
EJECT
*
*
*
* SEARCH FILE SPACE BIT TABLE TO LOCATE ADEQUATE
* FREE SPACE FOR AMOUNT REQUESTED
*
* ALLOCATION SEARCH ROUTINE WILL ACCEPT SPACES OF
* THE FOLLOWING SIZES IN THE PRECEDENCE SPECIFIED -
*
* 1. EXACT MATCH WITH AMOUNT REQUESTED
* 2. SMALLEST FREE SPACE FOUND WHICH IS AT LEAST
* TWO PARTS LARGER THAN AMOUNT REQUESTED
* 3. FIRST SPACE WHICH WILL LEAVE 1 UN-ALLOCATED
* PART
*
*
BX6 X5 SAVE AMOUNT OF SPACE REQUIRED
SA6 ASPACE
*
* INITIALIZE FOR SPACE BIT TABLE SEARCH
*
SB3 X5 B3 = AMOUNT OF SPACE REQUIRED
MX0 12 X0 = MASK FOR COEF^FICIENT
BX0 -X0
SA1 PINF+5-1 X1 = CURRENT BIT TABLE WORD
MX4 0 X4 = BEST FIND POINTER
MX5 0 X5 = LENGTH OF BEST FIND
MX6 12 X6 = MASK FOR CLEARING SET BITS
*
* SEARCH FOR NEXT FREE SPACE
*
A200 SA1 A1+1 LOAD NEXT WORD OF BIT TABLE
ZR X1,A300
*
A210 UX2 X1,B2 BITS IN WORD NOT CHECKED YET
SX7 -B2 SAVE FOR LATER SUBTRACTION
NX1 X1,B2 FIND NEXT SET BIT
* B2 = WIDTH OF ZEROS FIELD
ZR X1,A200
BX2 X0-X1 COMPLEMENT COEFFICIENT
NX2 X2,B1 FIND END OF SET BITS
* B1 = WIDTH OF ONES FIELD
AX3 X6,B1
BX2 X0*X3 FORM MASK FOR SET BITS
BX1 -X2*X1 CLEAR BITS
SA3 A1
BX3 X1 SAVE A1,X1 OF AREA
SB2 B1+B2 WIDTH OF THIS PAIR OF FIELDS
SB2 X7+B2 WIDTH OF REMAINDER OF WORD
NZ B2,A250 IF NEXT WORD NOT CONTIGUOUS
*
* /--- BLOCK ALLOCATE 00 000 79/12/07 16.21
*
* SEARCH THROUGH CONTIGUOUS SPACE OVERLAPING WORD
* BOUNDARIES
*
A220 SA1 A1+1 LOAD NEXT BIT TABLE WORD
ZR X1,A250
NX2 X1,B2 FIND NEXT SET BIT
NZ B2,A250 JUMP IF NOT CONTIGUOUS
ZR X2,A250 JUMP IF NO SET BITS
BX1 X2
BX2 X0-X1 COMPLEMENT COEFFICIENT
NX2 X2,B2 FIND END OF SET BITS
SB1 B1+B2 INCREMENT TOTAL SPACES FOUND
AX2 X6,B2
ZR X2,A220 CHECK NEXT WORD CONTIGUOUS
BX2 X0*X2 FORM MASK FOR SET BITS
BX1 -X2*X1 CLEAR BITS
*
* CHECK IF THIS IS BEST FIND SO FAR
*
A250 LT B1,B3,A260 JUMP IF NOT ENOUGH SPACE
EQ B1,B3,A310 JUMP IF FOUND EXACT AMOUNT
SB2 B1-B3 COMPUTE AMOUNT OF EXTRA SPACE
SB2 B2-1
+ NZ B2,*+1 JUMP IF NOT SINGLE EXTRA SPACE
NZ X5,A260 JUMP IF A SPACE ALREADY FOUND
+ ZR X5,A255 JUMP IF NO PREVIOUS FIND
SB2 X5-1
SB2 B2-B3 CHECK SIZE OF PREVIOUS FIND
ZR B2,A255 JUMP IF PREVIOUS LEAVES 1 EXTRA
SB2 X5
GE B1,B2,A260 JUMP IF PREVIOUS SPACE SMALLER
*
A255 SA4 A3 SAVE ADDR/WORD OF BEST FIND
BX4 X3
SX5 B1 SAVE SIZE OF FIND
*
A260 NZ X1,A210 JUMP IF NOT END OF TABLE
EQ A300
*
* /--- BLOCK ALLOCATE 00 000 76/03/10 21.24
*
* COMPUTE INDEX OF BEST SPACE FOUND
*
A300 SA3 A4 A3 = TABLE ADDRESS OF BEST FIND
BX3 X4
ZR X5,A990 EXIT IF INADEQUATE SPACE
*
A310 SX4 PINF+5 X4 = BEGIN ADDRESS OF BIT TABLE
SX2 A3 ADDRESS OF STARTING WORD
IX2 X2-X4 COMPUTE WORD BIAS INTO TABLE
SX1 48
DX6 X1*X2 CONVERT TO BIT BIAS
UX2 X3,B1
SB2 48 COMPUTE BIT BIAS WITHIN WORD
SX1 B2-B1
IX6 X1+X6 COMPUTE INDEX OF SPACE FOUND
SA6 ITEMP SAVE SPACE INDEX
*
* CLEAR APPROPRIATE BITS FROM BIT TABLE
*
SX1 X6 X1 = INDEX TO CURRENT BIT
*
A400 CLRBIT X1,PINF+5 CLEAR NEXT BIT
SX1 X1+1
SB3 B3-1 END TEST
GT B3,B0,A400
SA1 ASPACE
BX5 X1 X5 = AMOUNT OF SPACE REQUESTED
SA1 ITEMP
SA2 FINF ATTACH SPACE INDEX TO INFO WORD
BX6 X1+X2
SA6 A2 *FINF* = FILE INFO WORD
EQ AUPDATE
*
* ERROR EXIT IF INSUFFICIENT SPACE AVALIABLE
*
A990 EQ AERR4 EXIT IF SPACE NOT AVAILABLE
*
*
* /--- BLOCK AUPDATE 00 000 76/03/10 20.42
EJECT
*
*
* UPDATE THE PACK INFORMATION TABLE IN ECS.
*
* ON ENTRY - X5 = AMOUNT OF SPACE REQUESTED
*
AUPDATE SB1 1 B1 = 1
SA1 PINF+2
IX7 X1+X5 INC COUNT OF SPACES ALLOCATED
SA7 A1
SA2 PINF+3
SX6 B1 X6 = 1 (USED LATER ALSO)
IX7 X2+X6 INCREMENT COUNT OF FILES USED
SA7 A2 *** NOTE--X7 USED LATER
SA1 TDISKU
SA2 PITS+X1 ECS ADDRESS OF PACK INFO TABLE
SA3 PINF+4 LENGTH OF PIT
BX0 X2
SB2 X3
SA0 PINF
+ WE B2 WRITE UPDATED PIT TO ECS
RJ ECSPRTY
* /--- BLOCK AUPDATE 00 000 76/03/10 19.52
*
* UPDATE THE FILE NAME TABLE IN ECS.
*
SA0 WORK A0 = ADDRESS OF TRANSFER BUFFER
SX5 WORKLTH X5 = LENGTH OF TRANSFER BUFFER
SA2 AINDEX INDEX TO NEW FILE
SA3 TDISKU X3 = DISK UNIT
SA4 FNTS+X3 ECS ADDRESS OF FILE NAME TABLE
SX1 X7 EXTRACT UPDATED FILE COUNT
IX1 X1-X6 X1 = OLD FILE COUNT
IX2 X1-X2 X2 = LENGTH TO MOVE
IX0 X4+X1 ADDRESS AFTER END OF TABLE
SB2 X2 PRE-SET LENGTH
IX4 X0-X2 PRE-SET ECS ADDRESS
IX7 X2-X5 X7 = LENGTH LEFT TO DO
NG X7,AUPFNT2
IX0 X0-X5 SET ECS ADDRESS
*
AUPFNT1 RE WORKLTH READ FILE NAMES
RJ ECSPRTY
SB2 X7 LENGTH IF DONE NEXT TIME
IX4 X0-X7 ECS ADDRESS IF DONE NEXT TIME
IX7 X7-X5 DECREMENT LENGTH TO DO
IX0 X0+X6 ADD 1
+ WE WORKLTH WRITE BACK 1 WORD DOWN
RJ ECSPRTY
IX0 X0-X6 SUBTRACT 1 BACK
IX0 X0-X5 NEXT ECS ADDRESS IF NOT DONE
PL X7,AUPFNT1
*
AUPFNT2 BX0 X4 GET SAVED ECS ADDRESS
SA4 AFNAME X4 = FILE NAME
NG X4,"CRASH" IF BAD FILE NAME
SA0 A0+B1 LEAVE ROOM FOR IT
+ RE B2 READ FILE NAMES THAT SHOULD
RJ ECSPRTY FOLLOW NEW FILE NAME
BX7 X4
SA0 A0-B1 BACK UP
SA7 A0 PUT NEW FILE NAME AT START
SB2 B2+B1 INCREMENT LENGTH BY 1
+ WE B2 WRITE BACK WITH NEW FILE NAME
RJ ECSPRTY
* /--- BLOCK AUPDATE 00 000 76/05/17 22.07
*
* UPDATE THE FILE INFORMATION TABLE IN ECS.
*
SA4 FITS+X3 ECS ADDRESS OF FILE INFO TABLE
IX0 X4+X1 ADDRESS AFTER END OF TABLE
SB2 X2 PRE-SET LENGTH
IX4 X0-X2 PRE-SET ECS ADDRESS
IX7 X2-X5 X7 = LENGTH LEFT TO DO
NG X7,AUPFIT2
IX0 X0-X5 SET ECS ADDRESS
*
AUPFIT1 RE WORKLTH READ FILE INFO WORDS
RJ ECSPRTY
SB2 X7 LENGTH IF DONE NEXT TIME
IX4 X0-X7 ECS ADDRESS IF DONE NEXT TIME
IX7 X7-X5 DECREMENT LENGTH TO DO
IX0 X0+X6 ADD 1
+ WE WORKLTH WRITE BACK 1 WORD DOWN
RJ ECSPRTY
IX0 X0-X6 SUBTRACT 1 BACK
IX0 X0-X5 NEXT ECS ADDRESS IF NOT DONE
PL X7,AUPFIT1
*
AUPFIT2 BX0 X4 GET SAVED ECS ADDRESS
SA4 FINF X4 = FILE INFO WORD
SA0 A0+B1 LEAVE ROOM FOR IT
+ RE B2 READ FILE INFO WORDS THAT
RJ ECSPRTY SHOULD FOLLOW NEW ONE
BX7 X4
SA0 A0-B1 BACK UP
SA7 A0 PUT NEW FILE INFO WORD AT START
SB2 B2+B1 INCREMENT LENGTH BY 1
+ WE B2 WRITE BACK WITH NEW INFO WORD
RJ ECSPRTY
*
* FORM NEW PACK DIRECTORY SUM-CHECK.
*
CALL PACKSUM,TDISKU
EQ ALLOCX
*
*
AERR0 SX6 3 *ZRETURN* = 3 = PACK NOT LOADED
EQ AERRX1 *ERROR* IS ALREADY SET
*
AERR1 SX6 11 *ZRETURN = 11 = DUP. FILE NAME
EQ AERRX1 *ERROR* IS ALREADY SET
*
AERR2A SX6 4 ZRETURN = 4 = BAD FILE NAME
EQ AERR2
AERR2B SX6 12 ZRETURN = 12 = BAD FILE TYPE
EQ AERR2
AERR2C SX6 13 ZRETURN = 13 = BAD DIR. INFO
EQ AERR2
AERR2D SX6 14 *ZRETURN* = 14 = BAD FILE LTH
AERR2 SX7 2 IMPROPER ALLOCATION REQUEST
EQ AERRX
*
AERR3 SX7 3 FILE LIMIT
SX6 15 *ZRETURN* = 15 = PACK DIR FULL
EQ AERRX
*
AERR4 SX7 4 SPACE NOT AVAILABLE
SX6 16 *ZRETURN* = 16 = NOT ENUF ROOM
EQ AERRX
*
AERRX SA7 TERROR STORE ERROR FLAG
AERRX1 SA6 TRETURN ALSO SET *ZRETURN*
EQ ALLOCX EXIT
*
*
AINDEX BSS 1 INDEX TO FILE
AFNAME BSS 1 NAME OF FILE
ASPACE BSS 1 AMOUNT OF SPACE REQUESTED
*
*
ALLOCX RETURN
*
*
ENDOV
* /--- BLOCK DEALLOV 00 000 77/08/17 03.47
TITLE DEALLOV RELEASE DISK SPACE
*
*
*
* -DEALLOV- -DESTROY- COMMAND OVERLAY
*
* ON ENTRY -
* OVARG1 = FILE NAME
*
* ON EXIT -
* *TERROR* = -1 = FILE DESTRUCTION SUCCESSFUL
* 0 = ERROR--PACK NAME (NOT LOADED)
* 1 = ERROR--FILE NAME (NOT ON PACK)
* 2 = ERROR--IMPROPER REQUEST
*
* ++ NOTE ++ 'THE CM BUFFER *WORK* IS USED IN
* UPDATING THE ECS FILE TABLES.
*
*
DEALLOV OVRLAY
CALL PACKCHK,TDISKU CHECK DIRECTORY INTACT
SA1 OVARG1 FILE NAME
NG X1,DERR1 EXIT IF BAD FILE NAME
ZR X1,DERR1
CALL FNDFILE,TDISKU,TPNAME
* ON EXIT - X6 = FILE INDEX, X7 = 1 IF NOT FOUND
* PINF = BASIC PACK INFO
SA7 TERROR SET ERROR FLAG
ZR X7,DERR0 EXIT IF PACK NOT LOADED
PL X7,DERR1A EXIT IF FILE NOT FOUND
SA7 TRETURN SET *ZRETURN* TOO
SA6 DINDEX SAVE FILE INDEX
* /--- BLOCK DEALLOV 00 000 76/03/10 21.31
EJECT
*
*
* RELEASE SPACE FOR THIS FILE IN ALLOCATION TABLE
*
SA1 A0 GET FILE INFORMATION WORD
MX0 -15
BX3 -X0*X1 X3 = SPACE INDEX
AX1 24
MX0 -6
BX5 -X0*X1 X5 = NUMBER OF SPACES ALLOCATED
SA1 TDISKU
SA1 PITS+X1 ECS ADDRESS OF PACK INFO TABLE
SA4 PINF+4 LENGTH OF PIT
BX0 X1
SB2 X4
SA0 PINF
+ RE B2 READ COMPLETE PIT FROM ECS
RJ ECSPRTY
BX1 X3 X1 = INDEX OF FILE SPACE
SB3 X5 B3 = NUMBER OF SPACES
*
R100 SETBIT X1,PINF+5 SET NEXT BIT
SX1 X1+1
SB3 B3-1 END TEST
GT B3,B0,R100
EQ DUPDATE
*
*
* /--- BLOCK DUPDATE 00 000 76/03/10 21.22
EJECT
*
*
* UPDATE THE PACK INFORMATION TABLE IN ECS.
*
DUPDATE SA1 PINF+2
IX7 X1-X5 DEC COUNT OF SPACES ALLOCATED
SA7 A1
SA2 PINF+3
SX6 1 X6 = 1 (USED LATER ALSO)
IX7 X2-X6 DECREMENT COUNT OF FILES USED
SA7 A2 *** NOTE--X7 USED LATER
SA1 TDISKU
SA2 PITS+X1 ECS ADDRESS OF PACK INFO TABLE
SA3 PINF+4 LENGTH OF PIT
BX0 X2
SB2 X3
SA0 PINF
+ WE B2 WRITE UPDATED PIT TO ECS
RJ ECSPRTY
*
* UPDATE ECS FILE NAME TABLE
*
SA0 WORK A0 = ADDRESS OF TRANSFER BUFFER
SX5 WORKLTH X5 = LENGTH OF TRANSFER BUFFER
SA2 DINDEX INDEX TO OLD FILE
SA3 TDISKU X3 = DISK UNIT
SA4 FNTS+X3 ECS ADDRESS OF FILE NAME TABLE
SX1 X7 EXTRACT UPDATED FILE COUNT
IX1 X1-X2 X1 = LENGTH TO MOVE
IX2 X2+X6 X2 = STARTING INDEX
IX0 X4+X2 STARTING ECS ADDRESS
SB2 X1 PRE-SET LENGTH
IX7 X1-X5 X7 = LENGTH LEFT TO DO
NG X7,DUPFNT2
*
DUPFNT1 RE WORKLTH READ FILE NAMES
RJ ECSPRTY
SB2 X7+0 LENGTH IF DONE NEXT TIME
IX7 X7-X5 DECREMENT LENGTH TO DO
IX0 X0-X6 SUBTRACT 1
+ WE WORKLTH WRITE BACK 1 WORD UP
RJ ECSPRTY
IX0 X0+X6 ADD 1 BACK
IX0 X0+X5 NEXT ECS ADDRESS
PL X7,DUPFNT1
* /--- BLOCK DUPDATE 00 000 77/08/17 03.50
*
DUPFNT2 RE B2 READ NAMES FOLLOWING OLD ONE
RJ ECSPRTY
IX0 X0-X6
+ WE B2 WRITE BACK OVER OLD FILE NAME
RJ ECSPRTY
*
* UPDATE THE FILE INFORMATION TABLE IN ECS.
*
SA4 FITS+X3 ECS ADDRESS OF FILE INFO TABLE
IX0 X4+X2 STARTING ECS ADDRESS
SB2 X1 PRE-SET LENGTH
IX7 X1-X5 X7 = LENGTH LEFT TO DO
NG X7,DUPFIT2
*
DUPFIT1 RE WORKLTH READ FILE INFO WORDS
RJ ECSPRTY
SB2 X7+0 LENGTH IF DONE NEXT TIME
IX7 X7-X5 DECREMENT LENGTH TO DO
IX0 X0-X6 SUBTRACT 1
+ WE WORKLTH WRITE BACK 1 WORD UP
RJ ECSPRTY
IX0 X0+X6 ADD 1 BACK
IX0 X0+X5 NEXT ECS ADDRESS
PL X7,DUPFIT1
*
DUPFIT2 RE B2 READ WORDS FOLLOWING OLD ONE
RJ ECSPRTY
IX0 X0-X6
+ WE B2 WRITE BACK OVER OLD INFO WORD
RJ ECSPRTY
CALL PACKSUM,TDISKU
EQ DEALLX
*
*
DERR0 SX6 3 *ZRETURN* = 3 = PACK NOT LOADED
EQ DERRX1 *ERROR* IS ALREADY SET
DERR1 SX7 1 NO SUCH FILE
SX6 4 *ZRETURN* = 4 = BAD FILE NAME
EQ DERRX
DERR1A SX6 0 *ZRETURN* = 0 = FILE NOT FOUND
EQ DERRX1 *ERROR* IS ALREADY SET
*
DERRX SA7 TERROR STORE ERROR FLAG
DERRX1 SA6 TRETURN ALSO SET *ZRETURN*
EQ DEALLX --- ERROR EXIT
*
*
DINDEX BSS 1 INDEX TO FILE
*
*
DEALLX RETURN
*
*
ENDOV
* /--- BLOCK RENAMOV 00 000 75/06/22 16.52
TITLE RENAMOV CHANGE NAME OF DISK FILE
* RENAMOV
*
* 'THIS ROUTINE RENAMES A FILE ON AN 844 DISK PACK.
* 'IT IS USED BY THE -RENAME- COMMAND (FILE IOPUT).
*
* 'ON ENTRY, IT REQUIRES--
* OVARG1 = CURRENT FILE NAME
* OVARG2 = NEW FILE NAME
*
* 'ON EXIT, *TERROR* IS SET AS FOLLOWS--
* -1 = FILE RENAMED SUCCESSFULLY
* 0 = ERROR--PACK NAME (NO LONGER LOADED)
* 1 = ERROR--OLD FILE NAME (NOT ON PACK)
* 2 = ERROR--NEW FILE NAME (ALREADY EXISTS)
* 3 = ERROR--NEW FILE NAME (IMPROPER NAME)
*
* 'THE FILE NAME AND INFO TABLES IN ECS ARE
* UPDATED IF THE RENAMING IS SUCCESSFUL.
*
* ++ NOTE ++ 'THE CM BUFFER *WORK* IS USED IN
* UPDATING THE ECS FILE TABLES.
*
*
RENAMOV OVRLAY
*
* 'CHECK IF PACK DIRECTORY IS STILL INTACT.
*
CALL PACKCHK,TDISKU
*
SA1 OVARG1 OLD FILE NAME
NG X1,RERR1 --- ERROR IF OLD NAME NEGATIVE
ZR X1,RERR1 --- ERROR IF NO OLD NAME
CALL FNDFILE,TDISKU,TPNAME X1=OLD FILE NAME, X6=FILE INDEX
SA7 TERROR PRESET ERROR FLAG
ZR X7,RERR0 --- ERROR IF PACK NOT LOADED
PL X7,RERR1A --- ERROR IF FILE NOT FOUND
SA7 TRETURN SET *ZRETURN* TOO
SA6 RINDEX SAVE OLD INDEX
SA1 OVARG2 NEW FILE NAME
NG X1,RERR3 --- ERROR IF NEW NAME NEGATIVE
ZR X1,RERR3 --- ERROR IF NO NEW NAME
CALL FNDFILE,TDISKU,TPNAME X1=NEW FILE NAME, X6=FILE INDEX
NG X7,RERR2 --- ERROR IF NEW FILE NAME ALREADY EXISTS
SA2 RINDEX X2 = OLD INDEX
BX7 X1
SA7 RFNAME SAVE NEW FILE NAME
IX7 X2-X6 OLD INDEX - NEW INDEX
ZR X7,RSAME JUMP IF NEW NAME IN SAME SPOT
PL X7,RBEFORE JUMP IF NEW NAME BEFORE OLD
SX6 1 X6 = 1 (USED LATER ALSO)
BX7 -X7
IX7 X7-X6 SUBTRACT 1 TO GET LENGTH
ZR X7,RSAME JUMP IF IN SAME SPOT
EQ RAFTER JUMP IF NEW NAME AFTER OLD
*
*
RERR0 SX6 3 *ZRETURN* = 3 = PACK NOT LOADED
EQ RERRX1 *ERROR* IS ALREADY SET
RERR1 SX7 1 IMPROPER OLD FILE NAME
SX6 4 *ZRETURN* = 4 = BAD FILE NAME
EQ RERRX
RERR1A SX6 0 *ZRETURN* = 0 = FILE NOT FOUND
EQ RERRX1 *ERROR* IS ALREADY SET
RERR2 SX7 2 NEW FILE NAME ALREADY EXISTS
SX6 11 *ZRETURN* = 11 = DUP. FILE NAME
EQ RERRX
* /--- BLOCK RENAMOV 00 000 75/06/22 16.52
RERR3 SX7 3 IMPROPER NEW FILE NAME
SX6 4 *ZRETURN* = 4 = BAD FILE NAME
EQ RERRX
*
RERRX SA7 TERROR STORE ERROR FLAG
RERRX1 SA6 TRETURN SET *ZRETURN* TOO
EQ RENAMX --- ERROR EXIT
*
*
RINDEX BSS 1 STORAGE FOR INDEX
RFNAME BSS 1 NEW NAME FOR FILE
RFINFO BSS 1 STORAGE FOR FILE INFO WORD
* /--- BLOCK RAFTER 00 000 75/04/03 03.03
*
*
* 'NEW FILE NAME GOES AFTER OLD ONE.
*
RAFTER IX1 X2+X6 X1 = STARTING INDEX FOR MOVE (OLD INDEX+1)
BX2 X7 X2 = LENGTH TO BE MOVED
*
* 'UPDATE THE FILE NAME TABLE IN ECS.
*
SA0 WORK A0 = ADDRESS OF TRANSFER BUFFER
SX5 WORKLTH X5 = LENGTH OF TRANSFER BUFFER
SA3 TDISKU X3 = DISK UNIT
SA4 FNTS+X3 ECS ADDRESS OF FILE NAME TABLE
SB2 X2 PRE-SET LENGTH
IX0 X4+X1 SET ECS ADDRESS
IX7 X2-X5 X7 = LENGTH LEFT TO DO
NG X7,RAFNT2
*
RAFNT1 RE WORKLTH READ FILE NAMES
RJ =XECSPRTY
SB2 X7+0 LENGTH IF DONE NEXT TIME
IX7 X7-X5 DECREMENT LENGTH TO DO
IX0 X0-X6 -1
WE WORKLTH WRITE BACK 1 WORD UP
RJ =XECSPRTY
IX0 X0+X6 +1
IX0 X0+X5 NEXT ECS ADDRESS
PL X7,RAFNT1
RAFNT2 RE B2 READ FILE NAMES THAT SHOULD PRECEDE NEW ONE
RJ =XECSPRTY
SA4 RFNAME NEW NAME
NG X4,"CRASH" IF BAD FILE NAME
BX7 X4
SA7 A0+B2 STORE NEW NAME AT END
IX0 X0-X6 -1
SB2 B2+1 ADD 1 TO LENGTH
WE B2 WRITE BACK WITH NEW FILE NAME
RJ =XECSPRTY
*
* 'UPDATE THE FILE INFORMATION TABLE IN ECS.
*
SA4 FITS+X3 ECS ADDRESS OF FILE INFO TABLE
SB2 X2 PRE-SET LENGTH
IX0 X4+X1 SET ECS ADDRESS
IX0 X0-X6 ADDRESS BEFORE 1ST INFO WORD TO MOVE
SA0 RFINFO
RE 1 READ INFO WORD FOR THIS FILE
RJ =XECSPRTY
SA0 WORK
IX0 X0+X6 RESET ECS ADDRESS
IX7 X2-X5 X7 = LENGTH LEFT TO DO
NG X7,RAFIT2
*
RAFIT1 RE WORKLTH READ FILE INFO WORDS
RJ =XECSPRTY
SB2 X7+0 LENGTH IF DONE NEXT TIME
IX7 X7-X5 DECREMENT LENGTH TO DO
IX0 X0-X6 -1
WE WORKLTH WRITE BACK 1 WORD UP
RJ =XECSPRTY
IX0 X0+X6 +1
IX0 X0+X5 NEXT ECS ADDRESS
PL X7,RAFIT1
RAFIT2 RE B2 READ INFO WORDS THAT SHOULD PRECEDE THIS
RJ =XECSPRTY
SA4 RFINFO FILE INFO WORD
BX7 X4
SA7 A0+B2 STORE THIS INFO WORD AT END
IX0 X0-X6 -1
SB2 B2+1 ADD 1 TO LENGTH
WE B2 WRITE BACK WITH THIS INFO WORD
RJ =XECSPRTY
* /--- BLOCK RAFTER 00 000 75/04/03 03.03
EQ RPSUM --- GET NEW SUMCHECK AND EXIT
* /--- BLOCK RBEFORE 00 000 75/01/29 03.41
*
*
* 'NEW FILE NAME GOES BEFORE OLD ONE.
*
RBEFORE BX1 X6 X1 = STARTING INDEX FOR MOVE
BX2 X7 X2 = LENGTH TO BE MOVED
*
* 'UPDATE THE FILE NAME TABLE IN ECS.
*
SB1 1 B1 = 1 (STANDARD INCREMENT)
SA0 WORK A0 = ADDRESS OF TRANSFER BUFFER
SX5 WORKLTH X5 = LENGTH OF TRANSFER BUFFER
SA3 TDISKU X3 = DISK UNIT
SA4 FNTS+X3 ECS ADDRESS OF FILE NAME TABLE
SX6 B1 X6 = 1
SB2 X2 PRE-SET LENGTH
IX4 X4+X1 PRE-SET ECS ADDRESS
IX0 X4+X2 ADDRESS AFTER LAST NAME TO MOVE
IX7 X2-X5 X7 = LENGTH LEFT TO DO
NG X7,RBFNT2
IX0 X0-X5 SET ECS ADDRESS
*
RBFNT1 RE WORKLTH READ FILE NAMES
RJ =XECSPRTY
SB2 X7 LENGTH IF DONE NEXT TIME
IX4 X0-X7 ECS ADDRESS IF DONE NEXT TIME
IX7 X7-X5 DECREMENT LENGTH TO DO
IX0 X0+X6 ADD 1
WE WORKLTH WRITE BACK 1 WORD DOWN
RJ =XECSPRTY
IX0 X0-X6 SUBTRACT 1 BACK
IX0 X0-X5 NEXT ECS ADDRESS IF NOT DONE
PL X7,RBFNT1
RBFNT2 BX0 X4 GET SAVED ECS ADDRESS
SA4 RFNAME X4 = NEW NAME
NG X4,"CRASH" IF BAD FILE NAME
SA0 A0+B1 LEAVE ROOM FOR IT
RE B2 READ FILE NAMES THAT SHOULD FOLLOW NEW ONE
RJ =XECSPRTY
BX7 X4
SA0 A0-B1 BACK UP
SA7 A0 PUT NEW FILE NAME AT START
SB2 B2+B1 INCREMENT LENGTH BY 1
WE B2 WRITE BACK WITH NEW FILE NAME
RJ =XECSPRTY
* /--- BLOCK RBFIT 00 000 76/05/17 22.11
*
* 'UPDATE THE FILE INFORMATION TABLE IN ECS.
*
SA4 FITS+X3 ECS ADDRESS OF FILE INFO TABLE
SB2 X2 PRE-SET LENGTH
IX4 X4+X1 PRE-SET ECS ADDRESS
IX0 X4+X2 ADDRESS AFTER LAST INFO WORD TO MOVE
IX7 X2-X5 X7 = LENGTH LEFT TO DO
SA0 RFINFO STORAGE FOR FILE INFO WORD
RE 1 READ INFO WORD FOR THIS FILE
RJ =XECSPRTY
SA0 WORK
NG X7,RBFIT2
IX0 X0-X5 SET ECS ADDRESS
*
RBFIT1 RE WORKLTH READ FILE INFO WORDS
RJ =XECSPRTY
SB2 X7 LENGTH IF DONE NEXT TIME
IX4 X0-X7 ECS ADDRESS IF DONE NEXT TIME
IX7 X7-X5 DECREMENT LENGTH TO DO
IX0 X0+X6 ADD 1
WE WORKLTH WRITE BACK 1 WORD DOWN
RJ =XECSPRTY
IX0 X0-X6 SUBTRACT 1 BACK
IX0 X0-X5 NEXT ECS ADDRESS IF NOT DONE
PL X7,RBFIT1
RBFIT2 BX0 X4 GET SAVED ECS ADDRESS
SA4 RFINFO X4 = FILE INFO WORD
SA0 A0+B1 LEAVE ROOM FOR IT
RE B2 READ INFO WORDS THAT SHOULD FOLLOW THIS ONE
RJ =XECSPRTY
BX7 X4
SA0 A0-B1 BACK UP
SA7 A0 PUT THIS INFO WORD AT START
SB2 B2+B1 INCREMENT LENGTH BY 1
WE B2 WRITE BACK WITH THIS INFO WORD
RJ =XECSPRTY
EQ RPSUM --- GET NEW SUMCHECK AND EXIT
*
*
RSAME SA3 TDISKU
SA4 FNTS+X3 ECS ADDRESS OF FILE NAME TABLE
SA0 RFNAME
IX0 X4+X2
WE 1 WRITE NEW NAME IN PLACE OF OLD
RJ =XECSPRTY
*
* 'FORM NEW PACK DIRECTORY SUM-CHECK.
*
RPSUM CALL PACKSUM,TDISKU
*
*
RENAMX RETURN
*
*
ENDOV
* /--- BLOCK RETYPOV 00 000 77/11/03 02.35
TITLE RETYPE - CHANGE FILE TYPE
RETYPOV OVRLAY
*
* RETYPOV
*
* ROUTINE REPLACES THE 6-BIT FILE TYPE FIELD IN FIW
*
*
* ON ENTRY'; OVARG1 = FILE NAME
* OVARG2 = NEW FILE TYPE
*
* ON EXIT'; *TERROR* IS SET AS FOLLOWS';
* -1 OPERATION COMPLETED W/O PROBLEMS
* 0 ERROR -- PACK NOT LOADED
* 1 ERROR -- FILE DOES NOT ON PACK
* 2 ERROR -- NEW FILE TYPE FIELD INVALID
*
* USES A/X 1-3, 6-7
*
*
* BEFORE STARTING, CHECK PACK SUMCHECK
*
CALL PACKCHK,TDISKU
*
SA1 OVARG1 GET FILE NAME
NG X1,RTERR1 -- FILE NAME LEGALITY
ZR X1,RTERR1 --
*
* FIND FILE ON PACK SET BY TDISKU/TPNAME, RETURNS';
* X1 = FILE NAME, X6 = FILE INDEX, X7 = *ERROR* RETURN
*
CALL FNDFILE,TDISKU,TPNAME
SA7 TERROR PRESET ERROR RETURN
ZR X7,RTERR0 -- PACK NOT LOADED
PL X7,RTERR1A -- FILE NOT FOUND
SA7 TRETURN SET *ZRETURN* TOO
*
SA3 OVARG2 GET NEW FILE TYPE
MX1 -6 MASK FIELD (COMPLEMENT)
BX2 -X1*X3 X2 _ 6 BITS (FILE TYPE)
BX3 X1*X3 X3 _ REST OF INPUT ARGUMENT
NZ X3,RTERR2 -- UNUSED FIELD NOT EMPTY
ZR X2,RTERR2 -- USED FIELD EMPTY
*
SA3 TDISKU GET DISK UNIT NUMBER
SA3 FITS+X3 GET ECS ADDR OF FILE INFO TABLE
IX0 X3+X6 ADDR + FILE INDEX = ECS PTR
SA0 RTFINFO CM BUFFER FOR FIW (1 WD)
*
+ RE 1 READ FILE INFO WORD FROM ECS
RJ =XECSPRTY
*
SA3 A0 READ WORD FROM CM BUFFER
LX1 30 MOVE MASK TO PROPER POSITION
BX1 X1*X3 CLEAR FILE TYPE FIELD IN FIW
LX2 30 MOVE NEW TYPE TO SAME POSITION
BX6 X1+X2 UNION NEW FILE TYPE INTO FIW
SA6 A0 PUT NEW FIW IN CM TO ECS WORD
*
+ WE 1 WRITE OUT NEW FILE INFO WORD
RJ =XECSPRTY
*
* MODIFY COMPLETE, GET NEW PACK DIRECTORY CHECKSUM, EXIT
*
CALL PACKSUM,TDISKU
*
RETYPX RETURN --- EXIT TO CALLING PROGRAM
*
*
RTERR0 SX6 3 *ZRETURN* = 3 = PACK NOT LOADED
EQ RTERRX1 *ERROR* IS ALREADY SET
*
RTERR1 SX7 1 FILE DOES NOT EXIST
SX6 4 *ZRETURN* = 4 = BAD FILE NAME
EQ RTERRX
*
RTERR1A SX6 0 *ZRETURN* = 0 = FILE NOT FOUND
EQ RTERRX1 *ERROR* IS ALREADY SET
*
RTERR2 SX7 2 INVALID NEW TYPE FIELD
* /--- BLOCK RETYPOV 00 000 77/11/03 02.35
SX6 12 *ZRETURN* = 12 = BAD FILE TYPE
EQ RTERRX
* /--- BLOCK RETYPOV 00 000 77/11/03 02.35
*
RTERRX SA7 TERROR PASS *ERROR* RETURN
RTERRX1 SA6 TRETURN SET *ZRETURN* TOO
EQ RETYPX
*
*
RTFINFO BSS 1 STORAGE FOR FILE INFO WORD
*
*
ENDOV
* /--- BLOCK DIOGOV 00 000 77/08/17 04.45
TITLE DIOGOV DISK I/O PROCESSING
* DIOGOV
*
* 'THIS OVERLAY PROCESSES DISK I/O REQUESTS FROM
* THE FOLLOWING COMMANDS--
* -DREAD-
* -DWRITE-
* -DSKREAD-
* -DSKWRIT-
* 'IT IS CALLED FROM ROUTINE *DIOGO* (FILE IOPUT)
*
* 'ON ENTRY--
* OVARG1 = BLOCK SIZE (BLKLTH=320, DBSIZE=64)
*
*
DIOGOV OVRLAY
SA5 A5 GUARANTEE X5 INTACT
LX5 18 POSITION EXTRA STORAGE POINTER
SA1 X5+B5
BX5 X1 TO X5 FOR -NGETVAR-
BX6 X1
SA6 DIOSAVE
NGETVAR GET BLOCK NUMBER
SX6 X1
NG X6,DIOERR2 --- ERROR IF BLOCK NUMBER NEGATIVE
SA6 DIOBLK SAVE STARTING BLOCK NUMBER
SA1 DIOSAVE SET UP NEXT -GETVAR- CODE
BX5 X1
LX5 XCODEL
NGETVAR GET ECS ADDRESS
SX6 X1-1
NG X6,DIOERR3 --- ERROR IF ECS ADDRESS NOT POSITIVE
SA6 DIOECS SAVE RELATIVE ECS ADDRESS
SA1 DIOSAVE SET UP NEXT -GETVAR- CODE
BX5 X1
LX5 2*XCODEL
NGETVAR GET BLOCK COUNT
SX6 X1-1 X6 = BLOCK COUNT-1
NG X6,DIOERR2 --- ERROR IF BLOCK COUNT NOT POSITIVE
SA1 TDISKU X1 = DISK UNIT
SA2 TPNAME
SA3 PNAMES+X1 CURRENT PACK ON THAT UNIT
BX4 X2-X3
ZR X3,DIOERR0 --- ERROR IF NO PACK LOADED
NZ X4,DIOERR0 --- ERROR IF PACK NAME NON-AGREEMENT
SA1 TFINFO X1 = FILE INFORMATION WORD
ZR X1,DIOERR1 --- ERROR IF FILE INFO WORD NOT SET
SA2 DIOBLK X2 = STARTING BLOCK NUMBER
BX3 X1
AX3 24
MX0 -6
BX3 -X0*X3 DISK SPACE COUNT
SX4 DSBLKS*BLKLTH WORDS PER DISK SPACE
IX3 X3*X4 X3 = NUMBER OF WORDS IN FILE
SA4 OVARG1 X4 = BLOCK SIZE
IX7 X2*X4 STARTING WORD
IX7 X7-X3
PL X7,DIOERR2 --- ERROR IF STARTING WORD TOO BIG
IX7 X2+X6 ENDING BLOCK NUMBER
IX7 X7*X4 ENDING WORD
IX7 X7-X3
PL X7,DIOERR2 --- ERROR IF ENDING WORD TOO BIG
SX6 X6+1
SA6 DIOSAVE SAVE BLOCK COUNT
SA3 TDISKU X3 = DISK UNIT
* /--- BLOCK DIOGOV 00 000 77/08/17 04.25
*---
SA4 OVARG1 BLOCK SIZE
SX4 X4-BLKLTH
ZR X4,DIOGO1 JUMP IF OLD BLOCK SIZE
*---
*
* X1 = FILE INFO WORD
* X2 = SECTOR NUMBER
* X3 = DISK UNIT
*
CALL DSKADDR SETS *DISKINF* TO DISK ADDRESS
*
*-----
EQ DIOGO2
*
* X1 = FILE INFO WORD
* X2 = BLOCK NUMBER
* X3 = DISK UNIT
*
DIOGO1 BSS 0
CALL DISKADD SETS *DISKINF* TO DISK ADDRESS
*
DIOGO2 BSS 0
*-----
SA1 TBXSTOR
CALL SETSTOR SET UP *STORWRD*
SA1 DIOECS X1 = RELATIVE ECS ADDRESS
SA4 STORWRD X4 = EXTRA STORAGE ECS POINTERS
NG X4,SERXECS --- SYSTEM ERROR IF ECS BASE NEGATIVE
AX4 18 POSITION ECS LENGTH FOR STATION AT RIGHT
SA2 DIOSAVE X2 = NUMBER OF BLOCKS
SA3 OVARG1 BLOCK SIZE
IX0 X2*X3
SX3 X4 LENGTH OF STORAGE
IX3 X3-X0
IX3 X3-X1 LENGTH-N*SIZE-(START-1)
NG X3,DIOERR3 --- FINAL ECS ADDRESS TOO BIG
AX4 18 X4 = BASE OF ECS FOR THIS STATION
IX6 X4+X1 ADD OFFSET FOR THIS REQUEST
LX6 36 POSITION ECS ADDRESS
SA1 DISKINF RETRIEVE OTHER DISK INFO
BX6 X6+X1
SA6 A1 STORE DISK INFORMATION PACKAGE
SX7 -1 I/O REQUEST OK
SA7 TERROR
SA1 DIOTYPE X1 = DISK I/O REQUEST TYPE
* X2 = NUMBER OF BLOCKS
EQ DIOREQ1 --- EXIT TO MAKE DISK I/O REQUEST
*
SERXECS BX1 X4
EXECERR 918 SYSTEM ERROR, BAD ECS LOCATION.
*
*
DIOERR0 SX7 0 PACK NOT LOADED
EQ DIOERRX
DIOERR1 SX7 1 FILE INFO WORD NOT SET
EQ DIOERRX
DIOERR2 SX7 2 BLOCK NUMBER OUT OF RANGE
EQ DIOERRX
DIOERR3 SX7 3 ECS ADDRESS OUT OF RANGE
EQ DIOERRX
*
DIOERRX SA7 TERROR STORE ERROR FLAG
EQ =XCKPROC --- ERROR RETURN
*
*
DIOBLK BSS 1 STARTING BLOCK NUMBER
DIOECS BSS 1 STARTING ECS ADDRESS (RELATIVE)
DIOSAVE BSS 1 (EVENTUALLY HOLDS BLOCK COUNT)
*
*
ENDOV
* /--- BLOCK FBIT 00 000 77/10/18 02.34
TITLE FBIT COMMAND
*
* -FBIT- COMMAND
* SETS OR UNSETS -BACKUP- BIT IN FILE INFO WORD
*
* (OVARG1) = -1 IF -SYSFILE-, 0 IF -FBIT-
*
* FOR -SYSFILE-, (TBINTSV) = FILE NAME
* (TBINTSV+1) = 0 IF OFF, 1 IF ON
* (TBINTSV+3) = ADDRESS OF FIP
*
*
FBITOV OVRLAY
INTLOK X,I.DDIR,W INTERLOCK DISK DIRECTORIES
CALL S=UDSKR READ DISK PARAMETERS
SA1 OVARG1 CHECK IF -FBIT- OR -SYSFILE-
ZR X1,FBIT1 --- IF -FBIT-
SA1 TBINTSV (X1) = FILE NAME
CALL FNDFILE,TDISKU,TPNAME
PL X7,FBERR EXIT IF FILE NOT FOUND
BX6 X0
SA6 FBWK SAVE ECS ADDRESS OF INFO WORD
SA1 A0
BX6 X1 SAVE FILE INFO WORD
SA6 FBWK1
SA1 TBINTSV+1 (X1) = 0 FOR OFF, 1 FOR ON
EQ FBIT2
FBIT1 BSS 0
CALL GETFILE GET FILE INFO WORD
PL X7,FBERR EXIT IF FILE NOT FOUND
BX6 X0
SA6 FBWK SAVE ECS ADDRESS OF INFO WORD
SA1 A0
BX6 X1 SAVE FILE INFO WORD
SA6 FBWK1
SA5 A5
LX5 XCODEL POSITION NEXT -GETVAR- CODE
NGETVAR GET -OFF- OR -ON-
FBIT2 BSS 0
MX6 1
ZR X1,FBITOFF JUMP IF -OFF-
SA1 FBWK1 LOAD FILE INFO WORD
BX6 X1+X6
SA6 A1 STORE WITH BIT SET
EQ FBIT10
*
FBITOFF SA1 FBWK1 LOAD FILE INFO WORD
BX6 -X6*X1
SA6 A1 STORE WITH BIT CLEAR
*
FBIT10 SA0 FBWK1
SA1 FBWK ECS ADDRESS OF FILE INFO WORD
BX0 X1
+ WE 1 RE-WRITE FILE INFO WORD
RJ ECSPRTY
MX6 0 MARK NO ERROR
SA6 TERROR
MX7 -1 ZRETURN WILL BE -1 IF -SYSFILE-
FBEXIT SA1 OVARG1 CHECK IF -FBIT- OR -SYSFILE-
ZR X1,FBEXIT2 --- IF -FBIT-
SA7 TRETURN SET ZRETURN IF -SYSFILE-
PL X7,FBEXIT2 --- IF FILE WAS NOT FOUND
SA1 TBINTSV+3 (X1) = ADDRESS OF FIP
SA1 X1+/FIP/MFF (X1) = MISC. FIP FIELDS
MX6 1
LX6 1+/MFF/S.FBIT SHIFT MASK TO POSITION
SA2 TBINTSV+1 (X2) = 0 IF CLEARED, 1 IF SET
ZR X2,FBEXIT1 --- IF BACKUP BIT WAS CLEARED
BX6 X1+X6 SET BIT IN FIP
SA6 A1 STORE
EQ FBEXIT2
FBEXIT1 BX6 -X6*X1 CLEAR BIT IN FIP
SA6 A1 STORE
FBEXIT2 INTCLR X,I.DDIR RELEASE DIRECTORY INTERLOCK
* /--- BLOCK FBIT 00 000 77/10/18 02.34
EQ PROCESS --- EXIT
FBERR MX6 -1 ERROR = -1 IF FILE NOT FOUND
MX7 0 ZRETURN WILL BE 0 IF -SYSFILE-
EQ FBEXIT
FBWK OVDATA
FBWK1 OVDATA
ENDOV
* /--- BLOCK TERMSET 00 000 74/03/12 01.48
TITLE -TERMSET-
*
*
* -TERMSET-
* SETS UP A CALL TO GETUNIT TO GET THE TERM TABLE,
* WHICH IS UNIT NUMBER ZERO IN THE UNIT LOC TABLE.
*
* RETURNS UNIT TO BRANCH TO IN ARG WHICH IS POINTED
* TO BY (OVARG1) AT ENTRY.
* THIS ARG IS -1 IF THE TERM IS NOT FOUND.
*
EXT GETUNIT
*
*
TERMSET OVRLAY
SA1 OVARG1 LOAD ARGUMENT ADDRESS
BX6 X1
SA6 ARG SAVE ARG
MX5 0 UNIT=0
RJ GETUNIT
SB2 B5 ADDRESS OF TERM TABLE (UNIT) TO B2
SA1 ARG
SB1 X1
SB3 B1 SET UP ARGS FOR SEARCH
SA1 B1
AX1 12
MX0 12
BX6 -X0*X1 LEFT JUSTIFY TERM, AND CLEAN EXTRA BITS
SA6 B1
RJ LOCATE FIND TERM
EQ TERMEX EXIT
*
ARG BSS 1
*
*
* /--- BLOCK LOCATE 00 000 76/05/29 00.21
TITLE LOCATE
* LOCATE
*
* DOES BINARY CHOP SEARCH TO FIND TERM.
*
* UPON ENTRY,
* (B1) = ADDRESS OF TERM, WHICH IS RIGHT JUSTIFIED
* (B2) = ADDRESS OF TERM TABLE
* (B3) = ADDRESS OF RETURN VARIABLE
*
* UPON EXIT,
* CONTENTS OF RETURN VARIABLE';
*
* + UNIT NUMBER TO BRANCH TO IF TERM FOUND,
* 0 IF TERM NOT FOUND
* - COMPLEMENT OF UNIT NUMBER TO BRANCH TO FOR
* CATCH-ALL TERM
*
*
* BREAK EVEN POINT FOR STRAIGHT SEARCH VS BINARY CHOP
BKEVEN EQU 10
*
*
*
*
LOCATE EQ *
SA2 B1 TERM TO FIND TO X2
SA5 B2 NO. OF TERMS TO X5
ZR X2,NOTFND --- EXIT IF NO TERM ENTERED
ZR X5,NOTFND EXIT IF NO TERMS TO SEARCH
SB1 1 UIC TO B1
SB7 X5 NO. TERMS TO B7
MX0 12 UNIT POINTER MASK
SB6 X5-BKEVEN
NG B6,SHORT DO STRAIGHT SEARCH IF IT WILL BE FASTER
AX5 1
BX7 X5 FIRST CHOP OFFSET TO X7
SB2 B2+B1 ADDRESS OF TERM TABLE TO B2
*
* BINARY CHOP LOOP
*
BCLOOP SA1 B2+X7 LOAD TERM FROM TABLE
BX3 -X0*X1 CLEAR UNIT POINTER
IX3 X2-X3 COMPARE TERMS
ZR X3,FINDEX TERM FOUND
AX5 1
ZR X5,ENDGO
NG X3,NGSET BRANCH TO MOVE BACK IN TABLE
IX7 X7+X5 NEW POINTER TO TABLE TO X7
SB6 B1 FLAG THAT LAST MOVE FORWARD TO B6
EQ BCLOOP
*
NGSET IX7 X7-X5 NEW TABLE INDEX TO X7
SB6 -B1 FLAG THAT LAST MOVE BACKWARD TO B6
EQ BCLOOP
*
*
*
ENDGO NG X3,NGEND
NG B6,LOSTEX NOT FOUND IF REVERSAL IN SINGLE STEP
SX7 X7+B1
SB4 X7
EQ B4,B7,LOSTEX NOT FOUND IF RUNS OFF END
SB6 B1 FLAG LAST MOVE FORWARD
EQ BCLOOP
*
NGEND PL B6,LOSTEX
SX7 X7-1
NG X7,LOSTEX NOT FOUND IF RUN OFF TABLE
SB6 -B1 FLAG THAT LAST MOVE BACKWARD
EQ BCLOOP
*
*
*
* TERM FOUND
*
FINDEX BX6 X1*X0 GET UNIT POINTER
LX6 12 RIGHT JUSTIFY
SA6 B3 STORE UNIT NUMBER,
EQ LOCATE --- EXIT
*
*
* FASTEST SEARCH STRAIGHT, DUE TO SHORT UNIT TABLE LENGTH
*
SHORT SB4 B0
* /--- BLOCK LOCATE 00 000 76/05/28 21.23
SLOOP SB4 B4+B1 INCREMENT
SA1 B2+B4
BX3 -X0*X1
BX3 X3-X2 CHECK IF FOUND
ZR X3,FINDEX DONE IF TERM FOUND
NE B4,B7,SLOOP LOOP IF MORE LIST
SB2 B2+B1 ADDRESS OF TERM TABLE TO B2
*
* TERM REQUESTED NOT FOUND, CHECK FOR CATCH-ALL TERM
*
LOSTEX SA1 B2 GET FIRST ENTRY IN TABLE
BX3 -X0*X1 MASK OFF UNIT
NZ X3,NOTFND NO BLANK TERM
BX6 X1*X0 GET UNIT POINTER
LX6 12 RIGHT JUSTIFY
BX6 -X6 COMPLEMENT FOR CATCH-ALL TERM
SA6 B3
EQ LOCATE ---EXIT
*
NOTFND SX6 0
SA6 B3 STORE AS NOT FOUND TERM
EQ LOCATE ---EXIT
*
*
TERMEX RETURN
*
*
ENDOV
* /--- BLOCK -ATTACHF- 00 000 79/11/15 20.58
TITLE -ATTACHF- AND -FILEF-
*
* -ATTACHF- (CODE = 449, OVARG1 = 0)
* -FILEF- (CODE = 471, OVARG1 = 1)
*
* ATTACHF FIP;KEYWORD,VALUE;KEYWORD,VALUE;
* KEYWORD;VALUE
*
* THE FIRST ARGUMENT SPECIFIES A FILE INFOR-
* MATION PACKET (FIP), WHICH CONTAINS THE FILE
* NAME, AN OPTIONAL PACK NAME, A LOCATION FOR
* INFO RETURNED FROM MASTOR, AND A LOCATION FOR
* THE FILE INFORMATION WORD. THE OPTIONAL KEYWORDS
* ARE AS FOLLOWS --
*
* PACK PACK NAME
* FILE FILE NAME
* MODE 0 = R/O = DEFAULT, -1 = R/W
*
* ONLY THE *PACK* AND *FILE* TAGS ARE VALID
* WITH -FILEF-
*
* /--- BLOCK -ATTACHF- 00 000 79/11/15 20.46
*
* MASTOR REQUEST FORMAT --
* MASRQ+2 - FILE NAME
* MASRQ+3 - OPTIONAL PACK NAME OR ZERO
* MASRQ+4 - 1/ATTACH TYPE(READ=0,WRITE=1)
* 1/COMMAND(0=ATTACHF,1=FILEF)
* 58/UNUSED
* MASRQ+5 - UNUSED(NEEDED FOR REPLY ONLY)
* MASRQ+6 - STATION NUMBER PLUS 1 OF ATTACHER
*
* MASTOR REPLY FORMAT --
* MASRQ+2 - FILE NAME
* MASRQ+3 - PACK NAME
* MASRQ+4 - 1/ATTACH TYPE
* 1/COMMAND(0=ATTACHF,1=FILEF),
* 31/UNUSED,
* 9/UNIT NO.,18/POINTER TO FILE INFO WORD
* MASRQ+5 - FILE INFO WORD
* MASRQ+6 - ATTACHED STATION + 1
* MASRQ+7 - ERROR CODE OR -1 IF ALL OKAY
*
* THE PACK NAME IS RETURNED TO THE SECOND WORD OF
* THE FIP FOLLOWING A SUCCESSFUL ATTACH.
*
* MASRQ+4 IS RETURNED TO THE THIRD WORD OF THE
* FIP FOLLOWING A SUCCESSFUL ATTACH.
*
* THE FILE INFO WORD IS RETURNED TO THE FOURTH WORD
* OF THE FIP FOLLOWING A SUCCESSFUL ATTACH.
*
* ON COMPLETION *TRETURN* IS SET AS FOLLOWS
* -2 = REDUNDANT ATTACH
* -1 = ATTACH SUCCESSFUL OR REDUNDANT
* 0 = ERROR -- FILE DOES NOT EXIST
* 1 = ERROR -- FILE ATTACHED TO ANOTHER STATION
* (SEE *TERROR* FOR STATION NUMBER)
* 2 = ERROR -- IMPROPER MASTOR REQUEST
* 3 = ERROR -- BAD PACK NAME
* 4 = ERROR -- BAD FILE NAME
*
* *TERROR* IS SET TO THE STATION NUMBER OF THE
* ATTACHED STATION WHEN *TRETURN* IS 4, OTHERWISE
* UNUSED.
*
* /--- BLOCK SETUP 00 000 80/02/07 04.19
ATTFOV OVRLAY
*
* * SAVE ATTACHF/FILEF FLAG
*
SA1 OVARG1 X1 = ATTACHF/FILEF FLAG
NG X1,TAGSDONE --- IF -SYSFILE- COMMAND
BX6 X1
SA6 SAVETYP
*
* * CHECK REQUEST BUFFERS FOR SPACE AND SAVE *KEY*
*
CALLX REQCHK
CALL RESTKEY RESTORE *KEY*
*
* * UNPACK ARGUMENTS INTO *VARBUF*
*
SX6 63 X6 = MAX. NUMBER OF ARGUMENTS
SA5 A5 RETRIEVE COMMAND WORD
CALL GETARGS MOVE GETVAR CODES TO *VARBUF*
SA6 NUMARGS STORE NUMBER OF ARGUMENTS
*
* * PROCESS FIRST ARGUMENT (FIP)
*
SA1 VARBUF X1 = FIRST GETVAR CODE
BX5 X1
NGETVAR A1 = ADDR. OF FIP
SX6 A1
SA6 FIPADDR SAVE IT
SX1 0 MARK NOT IN -CALC- FOR FIPCHK
CALL FIPCHK CHECKS BOUNDS ON FIP
SX6 1
SA6 ARGSDONE FIRST ARG HAS BEEN PROCESSED
* /--- BLOCK TAGS 00 000 80/02/07 04.54
*
* * LOOP TO PROCESS TAGS
*
TAGLOOP SA1 ARGSDONE
SA2 NUMARGS
IX2 X1-X2
ZR X2,TAGSDONE --- IF ALL TAGS PROCESSED
SX6 X1+2 INCREMENT COUNT OF ARGS DONE
SA6 A1 STORE INCREMENTED COUNT
SA1 VARBUF+X1 X1 = NEXT GETVAR CODE
LX1 XCODEL SHIFT CODE TO BITS 0-19
SB1 X1 B1 = TAG NUMBER
SA1 A1+1 X1 = NEXT GETVAR CODE
BX5 X1
JP TAGTAB+B1 --- PROCESS THIS TAG
*
* * JUMP TABLE FOR KEYWORD ARGUMENTS
*
TAGTAB BSS 0
+ EQ FILENAM 0 = FILE NAME
+ EQ PACKNAM 1 = PACK NAME
+ EQ ACCMODE 2 = ACCESS MODE
*
* * GET FILE NAME
*
FILENAM X GETFILV,ARGSDONE,ACCT,FILE
SA1 FILE X1 = FILE NAME
BX6 X1
SA1 FIPADDR X1 = ADDR OF FIP
SA6 X1+/FIP/FILE STORE FILE NAME IN FIP
EQ TAGLOOP --- PROCESS NEXT TAG
*
* * GET PACK NAME
*
PACKNAM NGETVAR X1 = PACK NAME
BX6 X1
SA1 FIPADDR X1 = ADDR. OF FIP
SA6 X1+/FIP/DIR STORE PACK NAME IN FIP
EQ TAGLOOP --- PROCESS NEXT TAG
*
* * GET ACCESS MODE
*
ACCMODE NGETVAR X1 = -1 FOR R/W, 0 FOR R/O
SX6 MA.READ PRESET FOR R/O ACCESS
PL X1,ACCMOD1 --- IF R/O ACCESS
SX6 MA.RW SET FOR R/W ACCESS
ACCMOD1 BSS 0
SA1 FIPADDR X1 = ADDR. OF FIP
SA1 X1+/FIP/MFF (X1) = MISC. FIP FIELDS
MX0 -/MFF/M.ATTACH (X0) = MASK FOR ATTACH MODE
LX0 /MFF/S.ATTACH SHIFT MASK TO POSITION
BX1 X0*X1 CLEAR OLD ATTACH MODE
LX6 /MFF/S.ATTACH POSITION NEW ATTACH MODE
BX6 X1+X6
SA6 A1 STORE IN FIP
EQ TAGLOOP --- PROCESS NEXT TAG
* /--- BLOCK PREPARE 00 000 80/02/07 04.19
*
* * PREPARE MASTOR REQUEST
*
TAGSDONE SA1 FIPADDR X1 = ADDR. OF FIP
SX6 MS.AFFS X6 = -ATTACH- MASTOR REQ. CODE
SA6 MASRQ SET REQUEST CODE
SA2 X1+/FIP/FILE (X2) = FILE NAME
ZR X2,ATTFE4 --- IF FILE NAME IS BAD
NG X2,ATTFE4 --- IF FILE NAME IS BAD
BX6 X2 (X6) = FILE NAME
SA6 MASRQ+2 STORE FILE NAME IN REQUEST
SA2 X1+/FIP/DIR (X2) = PACK NAME
NG X2,ATTFE3 --- IF PACK NAME IS BAD
BX6 X2 (X6) = PACK NAME
SA6 MASRQ+3 STORE PACK NAME IN MASTOR REQ.
SA2 SAVETYP X2 = 0 IF ATTACHF, 1 IF FILEF
NZ X2,TAGSDON2 --- IF EXECUTING -FILEF-
CALL ZFILACC,X1 (X1) = -1 FOR R/W, 0 FOR R/O
MX0 1 X0 = MASK FOR SIGN BIT
BX6 X0*X1 X6 = SIGN BIT = ACCESS MODE
EQ TAGSDON3
TAGSDON2 MX6 1 SET -FILEF- BIT
LX6 59 SHIFT TO BIT 58
TAGSDON3 SA6 MASRQ+4 STORE ACCESS MODE/FILEF FLAGS
SA1 STATION X1 = STATION NUMBER
SX6 X1+1 X6 = STATION + 1
SA6 MASRQ+6 STORE STATION NO. IN REQUEST
* /--- BLOCK REQUEST 00 000 80/02/07 04.54
*
* * SAVE COMMON, STORAGE, ETC. AND POST REQUEST
*
CALL SAVKEY
CALL SAVLES
CALL S=MAS,MASRQ,STATION
*
* * WAIT FOR REQUEST TO COMPLETE
*
ATTFX2 TUTIM -1,,IOKEY
SA1 KEY
SX1 X1-IOKEY
NZ X1,ATTFX2 --- IF NOT IOKEY
*
* * RETURN COMPLETION STATUS TO REQUESTOR
*
SA1 MASRQ+7 X1 = MASTOR STATUS WORD
BX6 X1
SA6 TRETURN *ZRETURN* = COMPLETION STATUS
*
* * RETURN NUMBER OF ATTACHED STATION
*
SA1 MASRQ+6 X1 = ATTACHED STATION + 1
SX6 X1-1 GET EXACT STATION NUMBER
SA6 TERROR *ERROR* = ATTACHED STATION
*
* * RESTORE COMMON, LESSON, ETC.
*
CALL RESTKEY RESTORE *KEY*
CALL RESTLES RESTORE COMMON, LESSON, ETC.
*
* * RETURN FIP TO CALLER
*
SA1 FIPADDR X1 = ADDR. OF FIP
X NEWFIPV,(MASRQ+2),X1 CONVERT TO NEW FORMAT
*
* * EXIT
*
EQ CKPROC --- PROCESS NEXT COMMAND
*
* * ERROR -- BAD PACK NAME
*
ATTFE3 SX6 3
EQ ATTFE
*
* * ERROR -- BAD FILE NAME
*
ATTFE4 SX6 4
*
* * SET ERROR CODES AND EXIT
*
ATTFE SA6 TRETURN SET *ZRETURN*
EQ PROCESS
FIPADDR EQU TBINTSV ADDR. OF FIP
NUMARGS EQU TBINTSV+1 NO. OF GETVAR CODES
ARGSDONE EQU TBINTSV+2 NO. OF GETVAR CODES PROCESSED
SAVETYP EQU TBINTSV+3 TO SAVE FILEF/ATTACHF FLAG
ACCT EQU TBINTSV+4 ACCOUNT NAME
FILE EQU TBINTSV+5 FILE NAME
ENDOV
* /--- BLOCK -DETACHF- 00 000 79/11/11 23.30
TITLE -DETACHF-
*
* -DETACHF- (CODE = 454)
*
* DETACHF FIP;KEYWORD,VALUE;KEYWORD,VALUE;
* KEYWORD
*
* THE FIRST ARGUMENT SPECIFIES A FOUR WORD FILE
* INFORMATION PACKET (FIP). THE OPTIONAL KEYWORDS
* MAY BE USED TO SPECIFY --
*
* FILE,N1 - FILE NAME
* PACK,N1 - PACK NAME
* STATION - DETACH ONLY IF THIS STATION HAS THE
* FILE ATTACHED (DEFAULT)
* MASTER - DETACH NO MATTER WHAT STATION HAS THE
* FILE ATTACHED
*
* MASTOR REQUEST FORMAT --
* MASRQ+2 - FILE NAME
* MASRQ+3 - OPTIONAL PACK NAME OR ZERO
* MASRQ+4 - 1/ATTACH TYPE(READ=0,WRITE=1),59/UNUSED
* MASRQ+5 - UNUSED(NEEDED FOR REPLY ONLY)
* MASRQ+6 - STATION NUMBER PLUS 1 OF ATTACHER
* MASRQ+7 - DETACH TYPE(0=STATION,1=MASTER)
*
* MASTOR REPLY FORMAT --
* MASRQ+2 - FILE NAME
* MASRQ+3 - PACK NAME
* MASRQ+4 - 1/ATTACH TYPE,32/UNUSED
* 9/UNIT NO.,18/POINTER TO FILE INFO WORD
* MASRQ+5 - FILE INFO WORD
* MASRQ+6 - STATION+1 THAT WAS ATTACHED
* MASRQ+7 - ERROR CODE OR -1 IF ALL OKAY
*
* ON COMPLETION *TRETURN* IS SET AS FOLLOWS
* -2 = FILE NOT ATTACHED
* -1 = DETACH SUCCESSFUL
* 0 = ERROR -- FILE DOES NOT EXIST
* 1 = ERROR -- FILE ATTACHED TO ANOTHER STATION
* 2 = ERROR -- IMPROPER MASTOR REQUEST
* 3 = ERROR -- BAD PACK NAME
* 4 = ERROR -- BAD FILE NAME
*
* ON COMPLETION *ERROR* CONTAINS THE NUMBER OF THE
* STATION WHICH HAD THE FILE ATTACHED.
*
* /--- BLOCK SETUP 00 000 79/12/28 16.21
DETFOV OVRLAY
SA1 OVARG1
NG X1,TAGSDONE --- IF -SYSFILE- COMMAND
*
* * CHECK REQUEST BUFFERS FOR SPACE AND SAVE *KEY*
*
CALLX REQCHK
CALL RESTKEY RESTORE *KEY*
*
* * UNPACK ARGUMENTS INTO *VARBUF*
*
SX6 63 X6 = MAX. NUMBER OF ARGUMENTS
SA5 A5 RETRIEVE COMMAND WORD
CALL GETARGS MOVE GETVAR CODES TO *VARBUF*
SA6 NUMARGS STORE NUMBER OF ARGUMENTS
*
* * PROCESS FIRST ARGUMENT (FIP)
*
SA1 VARBUF X1 = FIRST GETVAR CODE
BX5 X1
NGETVAR A1 = ADDR. OF FIP
SX6 A1
SA6 FIPADDR SAVE IT
SX1 0 MARK NOT IN -CALC- FOR FIPCHK
CALL FIPCHK CHECKS BOUNDS ON FIP
SX6 1
SA6 ARGSDONE FIRST ARG HAS BEEN PROCESSED
SX6 0 DEFAULT TO *STATION* -DETACHF-
SA6 SMCODE (RATHER THAN *MASTER*)
* /--- BLOCK TAGS 00 000 80/02/07 04.54
*
* * LOOP TO PROCESS TAGS
*
TAGLOOP SA1 ARGSDONE
SA2 NUMARGS
IX2 X1-X2
ZR X2,TAGSDONE --- IF ALL TAGS PROCESSED
SX6 X1+2 INCREMENT COUNT OF ARGS DONE
SA6 A1 STORE INCREMENTED COUNT
SA1 VARBUF+X1 X1 = NEXT GETVAR CODE
LX1 XCODEL SHIFT CODE TO BITS 0-19
SB1 X1 B1 = TAG NUMBER
SA1 A1+1 X1 = NEXT GETVAR CODE
BX5 X1
JP TAGTAB+B1 --- PROCESS THIS TAG
*
* * JUMP TABLE FOR KEYWORD ARGUMENTS
*
TAGTAB BSS 0
+ EQ FILENAM 0 = FILE NAME
+ EQ PACKNAM 1 = PACK NAME
+ SX6 0 2 = STATION
EQ STAMAST
+ SX6 1 3 = MASTER
EQ STAMAST
*
* * GET FILE NAME
*
FILENAM X GETFILV,ARGSDONE,ACCT,FILE
SA1 FILE X1 = FILE NAME
BX6 X1
SA1 FIPADDR X1 = ADDR OF FIP
SA6 X1+/FIP/FILE STORE FILE NAME IN FIP
EQ TAGLOOP --- PROCESS NEXT TAG
*
* * GET PACK NAME
*
PACKNAM NGETVAR X1 = PACK NAME
BX6 X1
SA1 FIPADDR X1 = ADDR. OF FIP
SA6 X1+/FIP/DIR STORE PACK NAME IN FIP
EQ TAGLOOP --- PROCESS NEXT TAG
*
* * STATION/MASTER FLAG
*
STAMAST SA6 SMCODE STORE FLAG (0=STATION,1=MASTER)
SA1 ARGSDONE BACK UP RUNNING GETVAR COUNTER
SX6 X1-1
SA6 A1
EQ TAGLOOP --- PROCESS NEXT TAG
* /--- BLOCK PREPARE 00 000 79/11/11 23.32
*
* * PREPARE MASTOR REQUEST
*
TAGSDONE SA1 FIPADDR X1 = ADDR. OF FIP
SX6 MS.DFFS DETACHF MASTOR REQUEST
SA6 MASRQ SET REQUEST CODE
SA2 X1+/FIP/FILE (X2) = FILE NAME
ZR X2,DETFE4 --- IF FILE NAME IS BAD
NG X2,DETFE4 --- IF FILE NAME IS BAD
SA2 X1+/FIP/DIR (X2) = PACK NAME
NG X2,DETFE3 --- IF PACK NAME IS BAD
X OLDFIPV,X1,(MASRQ+2) CONVERT TO OLD FORMAT
SA1 STATION X1 = STATION NUMBER
SX6 X1+1 STATION PLUS 1 FOR -DETACHF-
SA6 MASRQ+6 STORE IN REQUEST
SA1 SMCODE X1 = STATION/MASTOR INDICATOR
BX6 X1
SA6 MASRQ+7 STORE IN REQUEST
* /--- BLOCK REQUEST 00 000 80/02/07 04.55
*
* * SAVE COMMON, STORAGE, ETC. AND POST REQUEST
*
CALL SAVLES
CALL SAVKEY
CALL S=MAS,MASRQ,STATION
*
* * WAIT FOR REQUEST TO COMPLETE
*
DETFX2 TUTIM -1,,IOKEY
SA1 KEY
SX1 X1-IOKEY
NZ X1,DETFX2 IGNORE IF NOT IOKEY
*
* * RETURN COMPLETION STATUS TO REQUESTOR
*
SA1 MASRQ+7 X1 = COMPLETION STATUS
BX6 X1
SA6 TRETURN *ZRETURN* = COMPLETION STATUS
*
* * RETURN STATION NUMBER IN CASE *ZRETURN* IS 4
*
SA1 MASRQ+6 X1 = STATION NUMBER + 1
SX6 X1-1 GET EXACT STATION NUMBER
SA6 TERROR *ERROR* = STATION NUMBER
*
* * RESTORE COMMON, LESSON, ETC., AND EXIT
*
CALL RESTKEY RESTORE *KEY*
CALL RESTLES RESTORE COMMON, LESSON, ETC.
EQ CKPROC --- PROCESS NEXT COMMAND
*
* * ERROR -- BAD PACK NAME
*
DETFE3 SX6 3
EQ DETFE
*
* * ERROR -- BAD FILE NAME
*
DETFE4 SX6 4
*
* * SET ERROR CODE AND EXIT
*
DETFE SA6 TRETURN
EQ PROCESS
FIPADDR EQU TBINTSV ADDR. OF FIP
NUMARGS EQU TBINTSV+1 NO. OF GETVAR CODES
ARGSDONE EQU TBINTSV+2 NO. OF GETVAR CODES PROCESSED
SMCODE EQU TBINTSV+3 STATION/MASTER INDICATOR
ACCT EQU TBINTSV+4 ACCOUNT NAME
FILE EQU TBINTSV+5 FILE NAME
ENDOV
* /--- BLOCK -READF- 00 000 79/11/11 23.33
TITLE -READF-/-WRITEF-
*
* READF/WRITEF (CODE = 450/451)
*
* READF FIP,STARTING BLOCK,STORAGE<,NO. OF BLOCKS>
* WRITEF FIP,STARTING BLOCK,STORAGE<,NO. OF BLOCKS>
*
* READ/WRITE 64 WORD DISK BLOCKS
*
* THE FIRST ARGUMENT IS THE ADDRESS OF THE FILE
* INFORMATION PACKET WHICH IS FOUR WORDS LONG.
* THE FIP CONTAINS THE FOLLOWING INFORMATION -
* FILE NAME, PACK NAME, A POINTER WORD WHICH
* CAN BE USED TO LOCATE THE FILE INFO WORD
* IN THE PACK DIRECTORY, AND THE FILE INFO WORD.
* THE FIP IS SETUP BY THE -ATTACHF- COMMAND. THE
* 2ND ARGUMENT SPECIFIES THE STARTING BLOCK NUMBER
* THE 3RD THE ECS ADDRESS, AND THE 4TH THE NUMBER
* OF BLOCKS TO READ.
*
* MASTOR REQUEST FORMAT --
* MASRQ = MASTOR FUNCTION CODE
* MASRQ+2 = FILE NAME
* MASRQ+3 = PACK NAME
* MASRQ+4 = 1/ATTACH TYPE,32/UNUSED
* 9/UNIT NO,18/PTR TO FILE INFO WORD
* MASRQ+5 = UNUSED
* MASRQ+6 = 12/STATION+1,18/UNUSED
* 18/NO. OF SECTORS TO TRANSFER,
* 12/IO TYPE(READ=3,WRITE=4)
* MASRQ+7 = 24/ABS ECSFWA,18/UNUSED,
* 18/STARTING SECTOR
*
* MASTOR REPLY FORMAT --
* MASRQ+2 - FILE NAME
* MASRQ+3 - PACK NAME
* MASRQ+4 - SAME AS REQUEST
* MASRQ+5 - FILE INFO WORD
* MASRQ+6 - SAME AS REQUEST
* MASRQ+7 - ERROR CODE OR -1 IF ALL OKAY
*
* ON COMPLETION *TRETURN* IS SET AS FOLLOWS
* -1 = I/O COMPLETE SUCCESSFULLY
* 0 = FILE DOES NOT EXIST
* 1 = FILE NOT ATTACHED TO THIS STATION
* 2 = BAD MASTOR REQUEST
* 3 = BAD PACK NAME
* 4 = BAD FILE NAME
* 5 = BAD STARTING BLOCK NUMBER
* 6 = NUMBER OF BLOCKS IS BAD
* 7 = TRANSFER LENGTH TOO LONG FOR STORAGE
* 8 = BAD ECS ADDRESS
* 9 = I/O TRANSFER LENGTH PAST END OF FILE
* 10 = SYSTEM DISK ERROR (SEE *TERROR*)
*
* ON COMPLETION *TERROR* IS SET AS FOLLOWS-
* -1 = NO SYSTEM DISK ERROR
* N = SYSTEM DISK ERROR CODE
*
* /--- BLOCK SETUP 00 000 79/11/30 07.29
FIOV OVRLAY
SA1 OVARG1 X1 = 3 TO READ, 4 TO WRITE
NG X1,FIOX0 --- IF -SYSFILE- COMMAND
BX6 X1
SA6 IOTYPE SAVE I/O TYPE
*
* * CHECK REQUEST BUFFERS FOR SPACE AND SAVE *KEY*
*
CALLX REQCHK
CALL RESTKEY RESTORE *KEY*
*
* * GET ADDRESS OF FIP
*
NGETVAR A1 = ADDR. OF FIP
SX6 A1
SA6 FIPADDR SAVE ADDR. OF FIP
SX1 0 MARK NOT IN -CALC- FOR FIPCHK
CALL FIPCHK CHECKS BOUNDS ON FIP
*
* * GET STARTING BLOCK NUMBER
*
SA5 A5 RETRIEVE COMMAND WORD
LX5 XCODEL SHIFT TO 2ND GETVAR CODE
NGETVAR X1 = NO. OF FIRST BLOCK
SX2 X1
NG X2,FIOE5 --- ERROR IF BAD NUMBER
NG X1,FIOE5 --- ERROR IF NEGATIVE BLOCK NO.
BX6 X1
SA6 FRSTBLK SAVE STARTING BLOCK NO.
*
* * GET ECS ADDRESS
*
SA5 A5 RETRIEVE COMMAND WORD
MX0 -XSPTRL X0 = MASK FOR STORAGE POINTER
AX5 XCMNDL SHIFT OFF COMMAND CODE
BX5 -X0*X5 X5 = EXTRA STORAGE PTR.
SA1 B5+X5 X1 = EXTRA STORAGE WORD
BX5 X1 SET UP FOR GETVAR ROUTINES
BX6 X1
SA6 TEMP SAVE A COPY FOR LATER USE
NGETVAR X1 = STORAGE ADDRESS
SX6 1
IX6 X1-X6
NG X6,FIOE8 --- ERROR IF ECS ADDR. <= 0
SA6 ECSADDR SAVE ECS ADDRESS
*
* * GET NUMBER OF BLOCKS
*
SA1 TEMP X1 = EXTRA STORAGE WORD
BX5 X1 SET UP FOR GETVAR CALL
LX5 XCODEL SHIFT TO NEXT GETVAR CODE
NGETVAR X1 = NUMBER OF BLOCKS
SX2 X1
NG X2,FIOE6 --- ERROR IF BAD NUMBER
NG X1,FIOE6 --- ERROR IF NEGATIVE
ZR X1,FIOE6 --- ERROR IF ZERO
BX6 X1
SA6 NUMBLKS SAVE NO. OF BLOCKS
* /--- BLOCK PREPARE 00 000 79/11/11 23.34
*
* * PREPARE MASTOR REQUEST
*
FIOX0 BSS 0
SX6 MS.NFIO X6 = READF/WRITEF REQ. CODE
SA6 MASRQ STORE MASTOR REQUEST CODE
SA1 FIPADDR X1 = ADDR. OF FIP
SA2 X1+/FIP/FILE (X2) = FILE NAME
NG X2,FIOE4 --- IF FILE NAME IS BAD
ZR X2,FIOE4 --- IF FILE NAME IS BAD
SA2 X1+/FIP/DIR (X2) = PACK NAME
NG X2,FIOE3 --- IF PACK NAME IS BAD
ZR X2,FIOE3 --- IF PACK NAME IS BAD
X OLDFIPV,X1,(MASRQ+2) CONVERT TO OLD FORMAT
SA1 NUMBLKS X2 = NO. OF BLOCKS
LX1 12 POSITION TRANSFER LENGTH
SA2 IOTYPE I/O TYPE (3 = READ, 4 = WRITE)
BX6 X1+X2
SA1 STATION X1 = STATION NUMBER
SX1 X1+1 ADD ONE TO STATION NUMBER
LX1 48 POSTION IT
BX6 X1+X6 COMBINE
SA6 MASRQ+6 STORE IN REQUEST
SA1 TBXSTOR X1 = STORAGE INFO
CALL SETSTOR SETS UP *STORWRD*
SA4 STORWRD X4 = 24/ECS ADDR,18/LENGTH,18/0
AX4 18 SHIFT TO STORAGE LENGTH
SA1 ECSADDR X1 = STARTING ECS ADDR.
SX0 DBSIZE X0 = WORDS/DISK SECTOR
SA2 NUMBLKS NO. BLOCKS TO READ/WRITE
IX0 X0*X2 X0 = TOTAL WORDS TO READ/WRITE
SX3 X4 X3 = STORAGE LENGTH
IX3 X3-X0 SUBTRACT I/O LENGTH
IX3 X3-X1 SUBTRACT STARTING ADDRESS
NG X3,FIOE7 --- ERROR IF OUT OF RANGE
AX4 18 X4 = ABS. ADDR. OF STORAGE
IX6 X4+X1 X6 = ABS. STARTING ADDRESS
LX6 36 SHIFT TO TOP
SA1 FRSTBLK X1 = NO. OF FIRST BLOCK
BX6 X1+X6 MERGE ADDR. AND STARTING BLOCK
SA6 MASRQ+7 STORE IN REQUEST
* /--- BLOCK REQUEST 00 000 79/11/12 23.45
*
* * COLLECT STATISTICS INFO
*
SA2 NUMBLKS X2 = NO. OF BLOCKS
SB4 0 SET USER TYPE TO SYSTEM
SB2 SDEATTS B2 = ADDR. OF STATISTICS CELLS
SA1 IOTYPE X1 = I/O TYPE
CALL DSKST UPDATE STATS
*
* * UNLOAD COMMON/STORAGE AND SAVE LESSON POINTERS
*
CALL SAVLES SAVE COMMON, STORAGE, ETC.
CALL SAVKEY SAVE *KEY*
*
* * MARK STORAGE AS NON-RELOCATABLE AND NON-DELETABLE
*
CALL IOLESSN,TBXSTOR,4000B
*
* * SET *SDINFO* SO PLATO IGNORES DISK ERRORS
*
MX6 -1
SA6 SDINFO
* /--- BLOCK REQUEST 00 000 79/11/12 23.47
*
* * POST REQUEST TO MASTOR
*
CALL S=MAS,MASRQ,STATION
*
* * INCREMENT NUMBER OF DISK REQUESTS POSTED
*
SA1 POSTED
SX6 X1+1
SA6 A1
*
* * WAIT FOR REQUEST TO BE COMPLETED
*
FIOX1 TUTIM -1,,IOKEY
SA1 KEY
SX1 X1-IOKEY
NZ X1,FIOX1 --- IF NOT = *IOKEY*
*
* * DECREMENT NUMBER OF DISK REQUESTS POSTED
*
SA1 POSTED
SX6 X1-1
SA6 A1
*
* * FREE STORAGE FOR RELOCATION
*
SA1 TBXSTOR
SX1 X1
ZR X1,FIOX2 JUMP IF NO STORAGE
CALL IOLESSN,TBXSTOR,-4000B
*
* * RESTORE COMMON, LESSON, ETC.
*
FIOX2 CALL RESTLES
CALL RESTKEY
*
* * RETURN SYSTEM DISK STATUS IN *ERROR*
*
SA1 MASRQ+6
SX6 X1
SA6 TERROR RETURN TO USER IN *ERROR*
*
* * CHECK FOR ERROR TO RETURN IN *ZRETURN*
*
SA1 MASRQ+7
BX6 X1
SA6 TRETURN SET *ZRETURN*
PL X6,CKPROC --- PROCESS NEXT COMMAND
*
* * IF NO ERROR, RETURN PACK NAME, FIW POINTER,
* * AND FIW
*
SA1 FIPADDR X1 = ADDR. OF FIP
X NEWFIPV,(MASRQ+2),X1 CONVERT TO NEW FORMAT
EQ CKPROC --- PROCESS NEXT COMMAND
* /--- BLOCK ERRORS 00 000 80/12/02 02.00
*
* * BAD PACK NAME
*
FIOE3 SX6 3
EQ FIOERRX
*
* * BAD FILE NAME
*
FIOE4 SX6 4
EQ FIOERRX
*
* * BAD STARTING BLOCK
*
FIOE5 SX6 5
EQ FIOERRX
*
* * BAD NO. OF BLOCKS
*
FIOE6 SX6 6
EQ FIOERRX
*
* * TRANSFER LENGTH IS TOO LONG FOR STORAGE
*
FIOE7 SX6 7
EQ FIOERRX
*
* * BAD ECS ADDRESS
*
FIOE8 SX6 8
*
* * SET *ZRETURN* AND *ERROR*
*
FIOERRX SA6 TRETURN SET *ZRETURN*
SX6 -1
SA6 TERROR SET *ERROR* TO -1 (NO DISK ERR)
EQ PROCESS
FIPADDR EQU TBINTSV ADDR. OF FIP
FRSTBLK EQU TBINTSV+1 STARTING BLOCK NO.
NUMBLKS EQU TBINTSV+2 NO. OF BLOCKS
IOTYPE EQU TBINTSV+3 3 = READ, 4 = WRITE
ECSADDR EQU TBINTSV+4 STARTING STORAGE ADDRESS
TEMP EQU TBINTSV+5 SCRATCH VAR
ENDOV
* /--- BLOCK FILENAM 00 000 80/12/02 02.00
TITLE -FILENAM- COMMAND
*
* -FILENAM- HAS TWO POSSIBLE FORMS --
*
* FILENAM ACCOUNT';FILE,ONEWORD (FORM 0)
* FILENAM ONEWORD,ACCOUNT';FILE (FORM 1)
*
* THE FIRST GETVAR CODE IS SET UP AS A FAKE ARGUMENT
* TO INDICATE WHICH FORM IS USED.
*
* NOTE -- AFTER THE ACCOUNT NAME/NUMBER CONVERSION
* IS AVAILABLE SOME ERROR CHECKING SHOULD BE ADDED
* TO ZERO THE RESULT IN CASE OF AN INCONVERTIBLE
* FILE NAME.
*
*
FILNAMV OVRLAY
SX6 4
CALL GETCODX UNPACK 4 GETVAR CODES TO VARBUF
SA1 VARBUF GET FIRST GETVAR CODE
MX0 XCODEL
BX1 X0*X1 CLEAR OFF OTHER JUNK
NZ X1,FN100 IF ONE-WD TO TWO-WD CONVERSION
*
*
* TWO-WORD TO ONE-WORD CONVERSION
*
*
SA1 VARBUF+1 GET ACCOUNT ARGUMENT
BX5 X1
NGETVAR
CALL LJUST,(1R ),0
BX6 X1
SA6 FNBUF SAVE ACCOUNT WORD
SA1 VARBUF+2 GET FILE NAME ARGUMENT
BX5 X1
NGETVAR
CALL LJUST,(1R ),0
SA2 FNBUF RETRIEVE ACCOUNT NAME
SA3 KOLD
IX3 X2-X3
ZR X3,FN50 IF ALREADY A ONE-WORD NAME
BX6 X1
SA6 FNBUF+1 SAVE FILE WORD
CALL ACCFILC,FNBUF CONVERT ACCOUNT KEYWORDS
CALL FSQUISH,FNBUF COMPRESS FILE NAME
FN50 BX6 X1 (X6) = ONE-WORD NAME
SA1 VARBUF+3 GET RETURN VARIABLE
BX5 X1
NPUTVAR
EQ PROCESS
*
*
* ONE-WORD TO TWO-WORD CONVERSION
*
*
FN100 BSS 0
SA1 VARBUF+1 GET ONE-WORD FILENAME ARGUMENT
BX5 X1
NGETVAR
BX6 X1 (X6) = ONE-WORD NAME
SA6 FNBUF+1
SA1 KOLD SPECIAL FOR OLD-STYLE FILES
PL X6,FN150 IF NAME NOT COMPRESSED
CALL FEXPAND,FNBUF PERFORM CONVERSION
SA1 FNBUF (X1) = ACCOUNT NAME
FN150 SA2 VARBUF+2 GET FIRST RETURN VARIABLE
BX6 X1 (X6) = ACCOUNT NAME
BX5 X2 (X5) = GETVAR CODE
NPUTVAR
SA1 FNBUF+1 GET FILE NAME
* /--- BLOCK FILENAM 00 000 80/12/02 01.59
SA2 VARBUF+3 GET SECOND RETURN VARIABLE
BX6 X1 (X6) = FILE NAME
BX5 X2 (X5) = GETVAR CODE
NPUTVAR
EQ PROCESS
KOLD DATA 0L'OLD SPECIAL ACCOUNT KEYWORD
FNBUF OVDATA 2 TEMPORARY BUFFER FOR FILE NAME
ENDOV
TITLE -NVERS- COMMAND
*
* -NVERS- COMMAND
*
* NVERS ACCOUNT';FILE,ACCOUNT';FILE
*
* CONVERTS SPECIFIED FILE NAME TO ITS N-VERSION FORM.
*
NVERSV OVRLAY
SX6 4 UNPACK 4 ARGUMENTS
CALL GETCODX UNPACK ARGUMENTS TO VARBUF
CALL ACCFILE,VARBUF,VARBUF,0
CALL NVERSC,VARBUF,NVNAM
SA1 VARBUF+2 GET RETURN ACCOUNT ARGUMENT
MX0 XCODEL
BX5 X0*X1
ZR X5,NVONE IF NO ACCOUNT ARG
SA1 NVNAM
CALL ACNOUT MAKE ACCOUNT NAME DISPLAYABLE
BX6 X1 (X6) = N-VERSION ACCOUNT
NPUTVAR
SA1 NVNAM+1 (X1) = N-VERSION FILE NAME
NVFRET SA2 VARBUF+3 GET RETURN FILE ARGUMENT
BX5 X2
BX6 X1 (X6) = N-VERSION FILE NAME
NPUTVAR
EQ PROCESS
* IF NO RETURN ACCOUNT ARGUMENT SPECIFIED,
* SQUISH FILE NAME INTO ONE WORD.
NVONE CALL FSQUISH,NVNAM (X1) = ONE-WORD NAME
EQ NVFRET
NVNAM OVDATA 2 TEMPORARY FOR N-VERSION NAME
ENDOV
* /--- BLOCK SYSFILE 00 000 80/12/02 02.00
TITLE -SYSFILE- EXECUTION OVERLAY
*
* -SYSFILE-
*
* COMMAND FOR SYSTEM FILE OPERATIONS (ATTACH, READ,
* WRITE, CREATE, ETC.)
*
* SOME POSSIBLE FORMS ARE --
*
* SYSFILE FIP;ATTACH; $$ ATTACH FILE
* PACK,N1;FILE,N2;MODE,N3
*
* SYSFILE FIP;CHECK; $$ CHECK EXISTENCE
* PACK,N1;FILE,N2
*
* SYSFILE FIP;DETACH; $$ DETACH FILE
* PACK,N1;FILE,N2;STATION
*
* SYSFILE FIP;READ,0,1 $$ READ BLOCK 0
*
* SYSFILE FIP;WRITE,0,1 $$ WRITE BLOCK 0
*
* SYSFILE FIP;CREATE; $$ CREATE FILE
* PACK,N1;FILE,N2;TYPE,',A',;LENGTH,5
*
* SYSFILE FIP;DESTROY; $$ DESTROY FILE
* PACK,N1;FILE,N2
*
* SYSFILE FIP;RENAME; $$ CHANGE FILE NAME
* PACK,N1;FILE,N2;NEW NAME,N3
*
* SYSFILE FIP;RETYPE; $$ CHANGE FILE TYPE
* PACK,N1;FILE,N2;TYPE,',E',
*
* SYSFILE FIP;FBIT;ON $$ SET BACKUP BIT
* SYSFILE FIP;FBIT;OFF $$ CLEAR BACKUP BIT
*
* SYSFILE FIP;RECREATE $$ RE-CREATE FILE
* FILE,N1';N2;TYPE,N3;LENGTH,N4
*
* FIPS (FILE INFO PACKETS) ARE IDENTICAL TO THOSE
* USED FOR -ATTACHF-, ETC.
*
* AFTER EXECUTION OF A -SYSFILE- COMMAND, *ZRETURN*
* IS SET AS FOLLOWS --
*
* -2 = REDUNDANT ATTACH / UNNECESSARY DETACH
* -1 = FILE OPERATION SUCCESSFUL
* 0 = FILE DOES NOT EXIST
* 1 = FILE NOT ATTACHED TO THIS STATION AND/OR
* FILE ATTACHED TO OTHER STATION
* 2 = BAD MASTOR REQUEST
* 3 = BAD PACK NAME / PACK NOT LOADED
* 4 = BAD FILE NAME
* 5 = STARTING BLOCK NUMBER IS BAD
* 6 = NUMBER OF BLOCKS TO READ OR WRITE IS BAD
* 7 = TRANSFER LENGTH IS TOO LONG FOR STORAGE
* 8 = BAD EXTENDED MEMORY ADDRESS
* 9 = ATTEMPT TO TRANSFER PAST END OF FILE
* 10 = SYSTEM DISK ERROR
* 11 = DUPLICATE FILE NAME
* 12 = BAD FILE TYPE
* 13 = BAD FILE DIRECTORY PARAMETERS
* 14 = BAD FILE LENGTH
* 15 = NO ROOM FOR MORE FILES
* 16 = NOT ENOUGH DISK SPACE
* 17 = ILLEGAL I/O CODE
* 18 = ILLEGAL MS.FILE FUNCTION
* 19 = MORE THAN ONE FILE MEETS SPECS
* 20 = NON-EXISTANT DIRECTORY
* 21 = AFT POINTER INVALID
* 22 = ACCOUNT ATTACHED
* 23 = NO SUCH ACCOUNT FILE
* 24 = ACCOUNT FILE IS TURNED OFF
* 25 = ILLEGAL ATTACH CODE PROVIDED
* 26 = ILLEGAL ATTACH SIGNATURE GIVEN
* /--- BLOCK SYSFILE 00 000 80/12/02 02.00
* 27 = INSUFFICIENT SPACE IN ACCOUNT
* 28 = INSUFFICIENT SPACE IN SUB-ACCOUNT
* 29 = NO SUCH SUB-ACCOUNT
* 30 = ACCOUNT FILE IS FULL
* 31 = DIRECTORY FILE IS FULL
* 32 = CHECKSUM ERROR
* 33 = BLOCK NAME IN ERROR
* 34 = NOT ENOUGH ROOM FOR HEADER
* 35 = HEADER PARAMETERS IN ERROR
* 36 = FILE VERSION MISMATCH
* 37 = ILLEGAL NAME ORDERING
* 38 = DUPLICATE ACCOUNT NUMBERS
* 39 = ACCOUNT NUMBER TOO LARGE
* 40 = PACK OR ACCOUNT NOT LOADED
* 41 = A SYSTEM ERROR OCCURRED
* 42 = COULD NOT ATTACH THE FILE
*
* THE SYSTEM RESERVED WORD *ERROR* IS ALSO SET
* OCCASIONALLY --
*
* IF AN ATTACH OPTION FAILS BECAUSE A FILE IS
* ATTACHED ELSEWHERE, *ERROR* CONTAINS THE NUMBER
* OF THE STATION WHICH HAS THE FILE ATTACHED.
*
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
* AFTER THE DETACH OPTION IS USED, *ERROR*
* CONTAINS THE NUMBER OF THE STATION WHICH HAD
* THE FILE ATTACHED. THIS WORKS ONLY FOR THE OLD
* DISK SYSTEM.
*
* THE READ AND WRITE OPTIONS LEAVE THE SYSTEM
* DISK ERROR STATUS (-1 IF NO ERROR) IN *ERROR*.
*
* THE CREATE, DESTROY, RENAME AND RETYPE OPTIONS
* MAY SET *ERROR* IF THE FILE IS CREATED OR FOUND
* ON THE OLD DISK SYSTEM (DO NOT RELY ON THIS).
*
SYSFILV OVRLAY
* SYSFDBG EQU 0 DEBUG CODE ENABLED IF DEFINED
* CHECK FOR IMPENDING MASTOR REQUEST BUFFER
* OVERFLOW.
CALLX REQCHK CHECK FOR MASTER REQ OVERFLOW
CALL RESTKEY RESTORE *KEY*
* INITIALIZE SOME CELLS SO GARBAGE VALUES WILL
* NOT BE USED IF THE CORRESPONDING TAGS ARE NOT
* SPECIFIED.
SX6 0
SA6 MSGADDR ADDRESS OF ERROR MESSAGE BUFFER
SA6 SMCODE STATION/MASTER DETACH FLAG
SA6 NFILE NEW FILE NAME
SA6 NACCT NEW ACCOUNT NAME
SA6 F.TYP FILE TYPE
SA6 F.LTH FILE LENGTH
SA6 F.DIR SIZE OF DIRECTORY (IN SECTORS)
SA6 F.RMT SIZE/16 OF RMT (WORDS)
SA6 NPDWRIT PACK DIRECTORY CHECKPOINT FLAG
SA6 OLDPACK CLEAR *OLDPACK* FLAG
SA6 PACK CLEAR PACK NAME
SA6 DIRECT CLEAR DIRECTORY NAME
SA6 NEWFBIT NEW BACKUP BIT VALUE
SA6 ACCTRES ACCOUNT OF RESIDENCE
SA6 SUBACCT SUB-ACCOUNT
SA6 ATTRIBS ATTRIBUTE BITS
* UNPACK COMMAND ARGUMENTS TO *VARBUF*.
SX6 63 (X6) = MAX. NUMBER OF ARGUMENTS
SA5 A5+0 RETRIEVE COMMAND WORD
CALL GETARGS MOVE GETVAR CODES TO *VARBUF*
SA6 NUMARGS STORE NUMBER OF ARGUMENTS
* PROCESS FIP (FILE INFO PACKET) ARGUMENT.
SA1 VARBUF (X1) = FIRST GETVAR CODE
BX5 X1
NGETVAR (A1) = ADDRESS OF FIP
SX6 A1
SA6 FIPSAVE SAVE IT
MX1 0 MARK NOT IN -CALC- FOR *FIPCHK*
CALL FIPCHK CHECK BOUNDS ON FIP
* GET PRIMARY COMMAND OPTION.
SA1 VARBUF+1 (X1) = OPTION (ATTACH, ETC.)
LX1 XCODEL RIGHT-JUSTIFY GETVAR CODE
SX6 X1
SA6 TYPSAVE SAVE PRIMARY OPTION NUMBER
* PRESET FILE NAME FOR OLD-DISK-SYSTEM
* DESTROY/RENAME/RETYPE/FBIT FUNCTIONS.
SA1 FIPSAVE (A1) = ADDRESS OF FIP
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
SA1 X1+/FIP/FILE (A1) = FILE NAME
BX6 X1
SA6 FILE PRESET FILE NAME
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
SA1 TBLESAC
SA2 TBLESSN
SA3 TUNAME
SA4 TUNAMEC
MX6 42
BX6 X6*X1
BX7 X2
SA6 DEBUGM1B+1
SA7 DEBUGM1C+1
MX1 48
BX6 X1*X3
LX4 12
BX7 X1*X4
SA6 DEBUGM1D+1
SA7 DEBUGM1E+1
SA1 TYPSAVE (X1) = PRIMARY OPTION
SB6 A5 SAVE A5
CALL S=OTOA
SA5 B6 RESTORE A5
SA7 DEBUGM1F+2 STORE OCTAL IN MESSAGE
CALL S=MSG,DEBUGM1A
CALL S=MSG,DEBUGM1B
CALL S=MSG,DEBUGM1C
CALL S=MSG,DEBUGM1D
CALL S=MSG,DEBUGM1E
CALL S=MSG,DEBUGM1F
CALL S=MSG,FIPMSG
SA1 FIPSAVE
CALL OCTDUMP,X1,FIPLTH
EQ DEBUG1
DEBUGM1A DIS ,/***********************************/
DEBUGM1B DIS ,* ACCT - XXXXXXXXXX*
DEBUGM1C DIS ,* LESSON - XXXXXXXXXX*
DEBUGM1D DIS ,* M UNIT - XXXXXXXXXX*
DEBUGM1E DIS ,* C UNIT - XXXXXXXXXX*
DEBUGM1F DATA 20HSYSFILE OPTION
DATA 0,0
DEBUG1 BSS 0
.1 ENDIF
* PRESET PACK AND DIRECTORY NAMES.
SA1 FIPSAVE (X1) = ADDRESS OF FIP
SA2 X1+/FIP/MFF (X2) = MISC. FIP FIELDS
LX2 59-/MFF/S.OLD SEE IF OLD-DISK-SYSTEM FIP
SA3 X1+/FIP/DIR
BX6 X3 (X6) = PACK/DIRECTORY NAME
NG X2,SYSFIL1 IF OLD-DISK-SYSTEM FIP
SA6 DIRECT NEW-DISK-SYSTEM DIRECTORY NAME
EQ SYSFIL2
SYSFIL1 SA6 PACK OLD-DISK-SYSTEM PACK NAME
* IF ATTACH OPTION AND NO ATTACH MODE IS LEFT OVER
* IN THE FIP, SET IT TO R/O AS DEFAULT.
SYSFIL2 SA1 TYPSAVE (X1) = PRIMARY OPTION
SX1 X1-F.ATTACH
NZ X1,SYSFIL3 IF NOT ATTACH
SA1 FIPSAVE (X1) = ADDRESS OF FIP
SA1 X1+/FIP/MFF
MX2 -/MFF/M.ATTACH (X2) = MASK FOR ATTACH MODE
LX2 /MFF/S.ATTACH POSITION MASK
BX2 -X2*X1 (X2) = ATTACH MODE IN FIP
NZ X2,SYSFIL3 IF ALREADY SET
SX6 MA.RO DEFAULT TO READ/ONLY
LX6 /MFF/S.ATTACH
BX6 X1+X6
SA6 A1 STORE IN FIP
* CHECK FOR READ AND WRITE SECONDARY OPTIONS, WHICH
* DO NOT USE NORMAL SECONDARY KEYWORD PROCESSING.
SYSFIL3 SA1 TYPSAVE (X1) = PRIMARY OPTION
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
SX2 X1-F.READ
ZR X2,SPECIAL IF READ OPTION
SX2 X1-F.WRITE
ZR X2,SPECIAL IF WRITE OPTION
EJECT
* PROCESS SECONDARY KEYWORDS
SX6 2
SA6 ARGSDONE TWO ARGUMENTS ARE PROCESSED
TAGLOOP SA1 ARGSDONE (X1) = NO. ARGUMENTS PROCESSED
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
SA2 NUMARGS (X2) = TOTAL ARGUMENTS
IX2 X1-X2
ZR X2,TAGSDONE --- IF ALL TAGS PROCESSED
SX6 X1+2 INCREMENT COUNT OF ARGS DONE
SA6 A1+0 STORE UPDATED COUNT
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
SA1 VARBUF+X1 (X1) = NEXT GETVAR CODE
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
LX1 XCODEL SHIFT CODE TO BITS 0-19
SB1 X1 (B1) = TAG NUMBER
SA1 A1+1 (X1) = NEXT GETVAR CODE
BX5 X1
JP TAGTAB+B1 PROCESS THIS TAG
* JUMP TABLE FOR KEYWORD ARGUMENTS.
TAGTAB BSS 0
+ EQ FILENAM 0 = FILE NAME
+ EQ PACKNAM 1 = PACK NAME
+ EQ DIRNAM 2 = DIRECTORY NAME
+ EQ ACCMODE 3 = ACCESS MODE
+ MX6 0 4 = STATION DETACH
EQ STAMAST
+ SX6 1 5 = MASTER DETACH
EQ STAMAST
+ EQ FILETYP 6 = FILE TYPE
+ EQ FILELTH 7 = FILE LENGTH
+ MX6 -1 8 = PACK DIR. WRITE FLAG
EQ PDWFLAG
+ EQ NEWFNAM 9 = NEW FILE NAME
+ EQ DIRSIZE 10 = FILE DIR. SIZE
+ EQ RMTSIZE 11 = FILE RMT SIZE
+ SX6 1 12 = SET BACKUP BIT
EQ SETFBIT
+ MX6 0 13 = CLEAR BACKUP BIT
EQ SETFBIT
+ EQ OLDPN 14 = OLD SYSTEM PACK NAME
+ EQ MESSAG 15 = DISPLAYABLE ERROR MESSAGE
+ EQ NOATTACH 16 = OK TO READ W/O ATTACH
+ EQ ACCRES 17 = ACCOUNT OF RESIDENCE
+ EQ SUBACC 18 = SUB-ACCOUNT
+ EQ ORIGNAL 19 = ORIGINAL FILE FLAG
* GET FILE NAME (KEYWORD NO. 0).
FILENAM X GETFILV,ARGSDONE,ACCT,FILE
EQ TAGLOOP --- PROCESS NEXT TAG
* GET PACK NAME (KEYWORD NO. 1).
PACKNAM NGETVAR (X1) = PACK NAME
BX6 X1
MX7 0
SA6 PACK STORE PACK NAME
SA7 OLDPACK CLEAR *OLDPACK* FLAG
.1 IF DEF,SYSFDBG
* SX7 -1
* SA7 OLDPACK ALL OLD PACKS FOR NOW
.1 ENDIF
EQ TAGLOOP --- PROCESS NEXT TAG
* GET DIRECTORY NAME (KEYWORD NO. 2).
DIRNAM NGETVAR (X1) = DIRECTORY NAME
BX6 X1
SA6 DIRECT STORE DIRECTORY NAME
EQ TAGLOOP --- PROCESS NEXT TAG
* GET ACCESS MODE (KEYWORD NO. 3).
ACCMODE NGETVAR (X1) = -1 FOR R/W, 0 FOR R/O
SX6 MA.READ PRESET FOR R/O ACCESS
PL X1,ACCMOD1 --- IF R/O ACCESS
SX6 MA.RW SET FOR R/W ACCESS
ACCMOD1 BSS 0
SA1 FIPSAVE (X1) = ADDR. OF FIP
SA1 X1+/FIP/MFF (X1) = MISC. FIP FIELDS
MX0 -/MFF/M.ATTACH (X0) = MASK FOR ATTACH MODE
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
LX0 /MFF/S.ATTACH SHIFT MASK TO POSITION
BX1 X0*X1 CLEAR OLD ATTACH MODE
LX6 /MFF/S.ATTACH POSITION NEW ATTACH MODE
BX6 X1+X6
SA6 A1 STORE IN FIP
EQ TAGLOOP --- PROCESS NEXT TAG
* SET STATION/MASTER FLAG (KEYWORDS 4-5).
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
STAMAST SA6 SMCODE STORE FLAG (0=STATION,1=MASTER)
SA1 ARGSDONE BACK UP RUNNING GETVAR COUNTER
SX6 X1-1
SA6 A1+0
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
EQ TAGLOOP --- PROCESS NEXT TAG
* GET FILE TYPE (KEYWORD 6).
FILETYP NGETVAR (X1) = FILE TYPE CODE
MX0 -6
BX2 X0*X1 TOP 54 BITS MUST BE ZERO
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
NZ X2,SYSFE12 --- ERROR IF GARBAGE PRESENT
SX6 X1+0 (X6) = FILE TYPE
SA6 F.TYP
EQ TAGLOOP --- PROCESS NEXT TAG
* GET FILE LENGTH (KEYWORD 7).
FILELTH NGETVAR (X1) = FILE TYPE WORD
MX0 -6
BX2 X0*X1 TOP 54 BITS MUST BE ZERO
NZ X2,SYSFE14 --- ERROR IF GARBAGE PRESENT
SX6 X1+0 (X6) = FILE LENGTH
SA6 F.LTH
EQ TAGLOOP --- PROCESS NEXT TAG
* INHIBIT RETURN OF PACK DIRECTORY (KEYWORD 8).
PDWFLAG SA6 NPDWRIT
SA1 ARGSDONE BACK UP RUNNING GETVAR COUNTER
SX6 X1-1
SA6 A1+0
EQ TAGLOOP
* GET NEW FILE NAME (KEYWORD NO. 9)
NEWFNAM X GETFILV,ARGSDONE,NACCT,NFILE
EQ TAGLOOP --- PROCESS NEXT TAG
* GET DIRECTORY SIZE (KEYWORD 10).
DIRSIZE NGETVAR (X1) = DIRECTORY SIZE (SECTORS)
MX0 -6
BX2 X0*X1 TOP 54 BITS MUST BE ZERO
NZ X2,SYSFE13 --- ERROR IF GARBAGE PRESENT
SX6 X1+0 (X6) = DIRECTORY SIZE
SA6 F.DIR
EQ TAGLOOP --- PROCESS NEXT TAG
* GET RECORD MANAGEMENT TABLE SIZE (KEYWORD 11).
RMTSIZE NGETVAR (X1) = RMT SIZE / 16 WORDS
MX0 -6
BX2 X0*X1 TOP 54 BITS MUST BE ZERO
NZ X2,SYSFE13 --- ERROR IF GARBAGE PRESENT
SX6 X1+0 (X6) = RMT SIZE
SA6 F.RMT
EQ TAGLOOP --- PROCESS NEXT TAG
* SET/CLEAR BACKUP BIT (KEYWORDS 12-13).
SETFBIT SA6 NEWFBIT
SA1 ARGSDONE BACK UP RUNNING GETVAR COUNTER
SX6 X1-1
SA6 A1+0
EQ TAGLOOP
* GET PACK NAME THAT WILL BE USED ONLY IF A
* FILE IS BEING CREATED ON THE OLD DISK
* SYSTEM (KEYWORD 14).
OLDPN NGETVAR (X1) = OLD SYSTEM PACK NAME
BX6 X1
MX7 -1
SA1 FIPSAVE (X1) = ADDRESS OF FIP
SA6 X1+/FIP/DIR
SA7 OLDPACK SET *OLDPACK* FLAG
EQ TAGLOOP --- PROCESS NEXT TAG
* PROCESS ADDRESS OF BUFFER TO RECEIVE DISPLAYABLE
* MESSAGE IN CASE OF ERROR.
MESSAG NGETVAR (A1) = ADDRESS OF BUFFER
SX6 A1
SA6 MSGADDR SAVE THE ADDRESS
SA0 X6 (A0) = ADDRESS OF BUFFER
SX1 5 (X1) = LENGTH OF BUFFER
CALL BOUNDS CHECK BOUNDS ON BUFFER
EQ TAGLOOP PROCESS NEXT TAG
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
* FLAG THAT IT IS OK TO READ A FILE WITHOUT
* FIRST ATTACHING IT.
NOATTACH SA1 FIPSAVE (X1) = ADDRESS OF FIP
SA1 X1+/FIP/MFF (X1) = MISC. FIP FIELDS
MX6 1
LX6 1+/MFF/S.NOATT
BX6 X1+X6 SET NO ATTACH BIT IN FIP
SA6 A1
SA1 ARGSDONE BACK UP RUNNING GETVAR COUNTER
SX6 X1-1
SA6 A1
EQ TAGLOOP
* PROCESS *ACCOUNT OF RESIDENCE* (KEYWORD 17)
ACCRES NGETVAR
SA0 ACCTRES
EQ ALFINT -- PROCESS ALPHA OR INTEGER
* PROCESS *SUB-ACCOUNT* (KEYWORD 18)
SUBACC NGETVAR
SA0 SUBACCT
EQ ALFINT -- PROCESS ALPHA OR INTEGER
* PROCESS ALPHA OR INTEGER IDENTIFIER FOR *ACCOUNT
* OF RESIDENCE* OR *SUB-ACCOUNT* KEYWORDS. NOTE
* THAT THE RESULT ALWAYS OCCUPIES THE UPPER 42 BITS
* OF THE CELL DESIGNATED BY *A0* ON ENTRY. (SO THE
* INTEGER FIELD IS SHIFTED BEFORE STORING). *X1*
* CONTAINS THE USER'7S INPUT ON ENTRY.
ALFINT MX0 42 MASK TO SPLIT ALPHA/INTEGERS
BX6 X0*X1 X6 = ALPHA FIELD
NZ X6,ALFINT1 -- ALPHA FIELD DESIGNATED
BX6 -X0*X1 X6 = INTEGER FIELD
LX6 18 (SHIFT INTEGER FIELD)
ALFINT1 SA6 A0 STORE IN SPECIFIED CELL
EQ TAGLOOP -- EXIT TO NEXT KEYWORD
* PROCESS ORIGINAL FILE FLAG (KEYWORD 19)
ORIGNAL NGETVAR (X1) = FLAG STATUS (0/NON-0)
SA2 ATTRIBS GET ATTRIBUTE FLAGS WORD
SX6 200000B ORIGINAL FILE FLAG BIT (LX 59)
ZR X1,ORIGN0 -- BRANCH IF TURNING IT OFF
BX6 X2+X6 ELSE UNION ORIGINAL FLAG IN
SA6 A2 STORE NEW ATTRIBUTES FLAG
EQ TAGLOOP -- PROCESS NEXT TAG
ORIGN0 BX6 -X6*X2 CLEAR ORIGINAL FILE FLAG
SA6 A2 STORE NEW ATTRIBUTES FLAG
EQ TAGLOOP -- PROCESS NEXT TAG
EJECT
* SPECIAL HANDLING FOR READ/WRITE OPTIONS -- TWO
* GETVAR CODES (STARTING BLOCK NUMBER AND STORAGE
* INDEX) ARE ALWAYS PRESENT. 'THE THIRD GETVAR
* CODE (NUMBER OF BLOCKS) MAY BE PRESENT OR MARKED
* AS OMITTED; IN THE LATTER CASE A VALUE OF ONE (1)
* IS ASSUMED.
*
* THE FOURTH GETVAR CODE IS OPTIONAL. IF PRESENT IT
* IS THE FIRST WORD OF A 5-WORD BUFFER TO RECEIVE
* DISPLAYABLE ERROR MESSAGES.
SPECIAL SA1 NUMARGS (X1) = NUMBER OF GETVAR CODES
SX1 X1-2-4 SEE IF 4TH CODE PRESENT
NZ X1,SPECIAL1 IF 4TH GETVAR CODE NOT PRESENT
SA1 VARBUF+5
BX5 X1
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
NGETVAR (A1) = ADDRESS OF MSG BUFFER
SX6 A1
SA6 MSGADDR
SA0 X6 (A0) = ADDRESS OF BUFFER
SX1 5 (X1) = LENGTH OF BUFFER
CALL BOUNDS CHECK BOUNDS ON BUFFER
SPECIAL1 SA1 VARBUF+2 (X1) = 3RD GETVAR CODE
BX5 X1
NGETVAR (X1) = STARTING BLOCK NUMBER
SX6 X1
NG X6,SYSFE5 --- ERROR IF BAD NUMBER
NG X1,SYSFE5 --- ERROR IF NEG. BLOCK NUMBER
BX6 X1
SA6 START
SA1 VARBUF+3 (X1) = 4TH GETVAR CODE
BX5 X1
NGETVAR (X1) = STORAGE INDEX
SX6 1
IX6 X1-X6
NG X6,SYSFE8 --- ERROR IF < 0
SA6 STORAGE
SX6 1 PRESET TO READ/WRITE ONE BLOCK
SA1 VARBUF+4 (X1) = 5TH GETVAR CODE
BX5 X1
LX1 1 SHIFT OMITTED ARG. BIT TO SIGN
NG X1,SPECIAL2 --- IF DEFAULT NUMBER OF BLOCKS
NGETVAR (X1) = NUMBER OF BLOCKS
SX6 X1
NG X6,SYSFE6 --- ERROR IF BAD NUMBER
NG X1,SYSFE6 --- ERROR IF NEGATIVE
ZR X1,SYSFE6 --- ERROR IF ZERO
BX6 X1
SPECIAL2 SA6 NUMBER
EJECT
* DETERMINE THE DISK SYSTEM ON WHICH THE OPERATION
* SHOULD TAKE PLACE.
*
* FOR OPTIONS WHICH REQUIRE THAT A FILE BE ATTACHED,
* WE CAN SIMPLY CHECK THE OLD DISK SYSTEM BIT IN THE
* FIP.
.MDS IFNE *F,0
TAGSDONE SA1 TYPSAVE (X1) = PRIMARY OPTION
SA1 ATTRTAB+X1 (X1) = OPTION ATTRIBUTES
LX1 R.AFIP
PL X1,TAGSD0 --- IF ATTACH NOT REQUIRED
SA1 FIPSAVE (X1) = ADDRESS OF FIP
SA1 X1+/FIP/MFF (X1) = MISC. FIP FIELDS
LX1 59-/MFF/S.OLD
NG X1,OLDDSYS --- IF OLD DISK SYSTEM FILE
EQ NEWDSYS --- IF NEW DISK SYSTEM FILE
* SPECIAL RIGHT-JUSTIFIED DIRECTORY NAMES OF *OLD*
* AND *NEW* ARE USED TO FORCE FILE OPERATIONS TO THE
* OLD AND NEW DISK SYSTEMS, RESPECTIVELY. ANY OTHER
* NON-ZERO DIRECTORY NAMES WILL ALWAYS SELECT THE
* NEW DISK SYSTEM.
TAGSD0 SA1 DIRECT (X1) = DIRECTORY NAME
NZ X1,TAGSD1 IF DIRECTORY SPECIFIED
SA1 TYPSAVE (X1) = PRIMARY OPTION
SX1 X1-F.RECRE CHECK FOR RE-CREATE OPTION
NZ X1,TAGSD1 IF NOT RE-CREATE
SX6 3RNEW
SA6 DIRECT FORCE RE-CREATE TO NEW SYSTEM
TAGSD1 SA1 DIRECT (X1) = DIRECTORY NAME
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
ZR X1,TAGSD2 IF NO DIRECTORY SPECIFIED
SX2 3ROLD
BX2 X1-X2 TEST FOR 3ROLD
ZR X2,OLDDSYS IF FORCING OLD DISK SYSTEM
SX2 3RNEW
BX2 X1-X2 TEST FOR 3RNEW
NZ X2,NEWDSYS IF NOT DEFAULT DIRECTORY
SX6 0
SA6 DIRECT CHANGE 3RNEW TO DEFAULT DIR.
EQ NEWDSYS USE NEW DISK SYSTEM
* CHECK THE VALUE OF *DEFDS* (DEFAULT DISK SYSTEM).
* IF IT IS 0 OR 3, THE OLD OR NEW DISK SYSTEM,
* RESPECTIVELY, MUST BE CHOSEN.
TAGSD2 SX1 DEFDS (X1) = DEFAULT DISK SYSTEM
ZR X1,OLDDSYS --- IF OLD DISK SYSTEM ALWAYS
SX1 DEFDS-3
ZR X1,NEWDSYS --- IF NEW DISK SYSTEM ALWAYS
* IF *DEFDS* IS 1 OR 2, BOTH DISK SYSTEMS MUST BE
* SEARCHED.
SX1 DEFDS-2 CHECK FOR DEFDS .EQ. 2
ZR X1,TAGSD3 IF NEW DISK SYSTEM FIRST
RJ OLDSRCH SEARCH OLD DISK SYSTEM
SB1 -1 MARK OLD DISK SYSTEM SEARCHED
RJ SEARCHED CREATE/RENAME OPTION CHECKS
NG X6,OLDDSYS TO OLD DISK SYSTEM IF FOUND
TAGSD3 RJ NEWSRCH SEARCH NEW DISK SYSTEM
SB1 0 MARK NEW DISK SYSTEM SEARCHED
RJ SEARCHED CREATE/RENAME OPTION CHECKS
NG X6,NEWDSYS TO NEW DISK SYSTEM IF FOUND
SX1 DEFDS-1 CHECK FOR DEFAULT = OLD
ZR X1,TAGSD4 IF OLD ALREADY SEARCHED
RJ OLDSRCH SEARCH OLD DISK SYSTEM
SB1 -1 MARK OLD DISK SYSTEM SEARCHED
RJ SEARCHED CREATE/RENAME OPTION CHECKS
NG X6,OLDDSYS TO OLD DISK SYSTEM IF FOUND
TAGSD4 SA1 TYPSAVE CHECK PRIMARY OPTION
SX1 X1-F.CREATE CHECK FOR CREATE OPTION
NZ X1,SYSFE0 IF NOT CREATE AND NOT FOUND
SX1 DEFDS-1
ZR X1,OLDDSYS CREATE ON OLD DISK SYSTEM
EQ NEWDSYS CREATE ON NEW DISK SYSTEM (2)
NEWSRCH SPACE 4,15
** NEWSRCH - SEARCH NEW DISK SYSTEM FOR FILE
*
* ENTRY (FILE) = FILE NAME.
* (PACK) = PACK NAME OR ZERO.
*
* EXIT (X6) = -1 IF FILE FOUND, 0 IF NOT.
*
* USES A - 1, 2, 6, 7.
* B - 1, 2, 3, 4.
* X - 1, 2, 6, 7.
*
* CALLS INITDRQ, OVRUP, REQCHK, RESTKEY, RESTLES,
* SAVLES, SYSFRST, SYSFSAV, S=MAS.
*
* MACROS CALL, TUTIM.
NEWSRCH EQ * MUST BE AN -EQ-, SEE *RJSAVE*
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,DEBUGM2
EQ DEBUG2
DEBUGM2 DIS ,* SEARCHING NEW DISK SYSTEM.*
DEBUG2 BSS 0
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
.1 ENDIF
NEWSRCH0 RJ SYSFSAV SAVE OVDATAS OVER INTERRUPT
CALLX REQCHK CHECK FOR MASTOR REQ. OVERFLOW
RJ SYSFRST RESTORE OVDATAS
RJ =XINITDRQ INITIALIZE *MS.FILE* REQUEST
SX6 MF.ATT PRIMARY OPTION = ATTACH
SX7 MA.NONE ATTACH TYPE = NONE
LX7 36 POSITION ATTACH TYPE
BX6 X6+X7 MERGE
SA6 MASRQ+FP.FUNC
SA1 ACCT (X1) = ACCOUNT NAME
SA2 FILE (X2) = FILE NAME
BX6 X1
BX7 X2
SA6 MASRQ+FP.ACCO STORE ACCT NAME IN REQUEST
SA7 MASRQ+FP.FNAME STORE FILE NAME IN REQUEST
SA1 DIRECT (X1) = DIRECTORY NAME
SA2 PACK (X2) = PACK NAME OR TYPE
BX6 X1
BX7 X2
SA6 MASRQ+FP.DNAME STORE DIR. NAME IN REQUEST
SA1 OLDPACK CHECK *OLDPACK* FLAG
NG X1,NEWSRCH1 IF FOR OLD DISK SYSTEM ONLY
SA7 MASRQ+FP.PACK STORE PACK NAME IN REQUEST
NEWSRCH1 SA1 NEWSRCH SAVE RJ TRAIL
AX1 30 MOVE RETURN ADDRESS TO LOW END
SX6 X1 EXTRACT RETURN ADDRESS
SA6 RJSAVE
RJ SYSFSAV SAVE OVDATAS OVER INTERRUPT
RJ =XSAVLES SAVE LESSON, COMMON, ETC.
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,DEBUGM4
EQ DEBUG4
DEBUGM4 DIS ,/ POSTING REQUEST FOR *NEWSRCH*./
DEBUG4 CALL OCTDUMP,MASRQ,MS.RDIM
.1 ENDIF
CALL S=MAS,MASRQ,STATION POST REQUEST TO MASTOR
NEWSRCH2 TUTIM -1,,IOKEY
SA1 KEY CHECK FOR *IOKEY*
SX1 X1-IOKEY
NZ X1,NEWSRCH2 IF WRONG KEY
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,DEBUGM5
EQ DEBUG5
DEBUGM5 DIS ,/ REPLY RECEIVED FOR *NEWSRCH*./
DEBUG5 CALL OCTDUMP,MASRQ,MS.RDIM
.1 ENDIF
RJ =XRESTKEY RESTORE *KEY*
RJ =XRESTLES RESTORE LESSON, COMMON, ETC.
RJ SYSFRST RESTORE OVDATAS
SA2 NEWSRCH USE ENTRY POINT FOR MODEL -EQ-
MX1 6 MASK OFF THE OP-CODE
BX2 X1*X2 X2 = FORCED-UPPER -EQ- OP-CODE
SA1 RJSAVE RETRIEVE 18-BIT RETURN ADDRESS
LX1 30 SHIFT TO OPERAND FIELD FOR -EQ-
BX6 X1+X2 FORM COMPLETE RETURN INSTRUCT.
SA6 NEWSRCH
SA1 MASRQ+FR.ERR CHECK ERROR RETURN
SX2 X1-/ERRCODE/BUSY
ZR X2,NEWSRCH0 REPEAT IF BUSY CONDITION
PL X1,NEWSRCH3 IF FILE NOT FOUND
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
MX6 -1 (X6) = -1 = FILE FOUND
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
RJ YFOUND
.1 ENDIF
EQ NEWSRCH
NEWSRCH3 MX6 0 (X6) = 0 = FILE NOT FOUND
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
RJ NFOUND
.1 ENDIF
EQ NEWSRCH
OLDSRCH SPACE 4,14
** OLDSRCH -- SEARCH OLD DISK SYSTEM FOR FILE
*
* ENTRY (FILE) = FILE NAME.
* (PACK) = PACK NAME OR ZERO.
*
* EXIT (X6) = -1 IF FILE FOUND, 0 IF NOT.
*
* USES A - 1, 2, 6, 7.
* B - 1, 2.
* X - 1, 2, 3, 6, 7.
*
* CALLS FINDFN, FNDFILE.
*
* MACROS CALL.
OLDSRCH EQ *
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,DEBUGM3
EQ DEBUG3
DEBUGM3 DIS ,* SEARCHING OLD DISK SYSTEM.*
DEBUG3 BSS 0
.1 ENDIF
SA1 PACK (X1) = PACK TO SEARCH
NG X1,OLDSRCH4 NOT FOUND IF BAD PACK NAME
ZR X1,OLDSRCH3 IF SHOULD SEARCH ALL PACKS
* IF SEARCHING ONE PACK, LOCATE PACK IN PACK NAME
* TABLE AND CALL ROUTINE (*FNDFILE*) TO SEARCH ONE
* PACK.
SB1 0 (B1) = CURRENT DISK UNIT
SB2 NDSUS (B2) = NUMBER OF DISK UNITS
OLDSRCH1 SA2 PNAMES+B1 CHECK NEXT PACK NAME
BX3 X1-X2 SEE IF NAMES MATCH
ZR X3,OLDSRCH2 IF PACK NAMES MATCHED
SB1 B1+1 INCREMENT CURRENT UNIT
LT B1,B2,OLDSRCH1 IF MORE NAMES TO CHECK
EQ OLDSRCH4 IF SPECIFIED PACK NOT MOUNTED
OLDSRCH2 SX6 B1 (X6) = DISK UNIT
BX7 X2 (X7) = PACK NAME
SA6 OLDSRCHA
SA7 OLDSRCHB
SA1 FILE (X1) = FILE NAME
CALL FNDFILE,OLDSRCHA,OLDSRCHB SEARCH ONE PACK
NG X7,OLDSRCH5 IF FILE FOUND
EQ OLDSRCH4 IF FILE NOT FOUND
* SEARCH ALL PACKS.
OLDSRCH3 SA1 FILE
RJ =XFINDFN
PL X7,OLDSRCH5 IF FILE FOUND
* MARK FILE NOT FOUND
OLDSRCH4 MX6 0 (X6) = 0 = FILE NOT FOUND
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
RJ NFOUND
.1 ENDIF
EQ OLDSRCH
* MARK FILE FOUND.
OLDSRCH5 MX6 -1 (X6) = -1 = FILE FOUND
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
RJ YFOUND
.1 ENDIF
EQ OLDSRCH
OLDSRCHA OVDATA DISK UNIT
OLDSRCHB OVDATA PACK NAME
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
SEARCHED SPACE 4,15
** SEARCHED -- INITIAL CHECKS AFTER LOOKING FOR FILE
*
* ENTRY (X6) = -1 IF FILE FOUND, 0 IF NOT.
* (B1) = -1 IF OLD DISK SYSTEM SEARCHED, 0 IF
* NEW DISK SYSTEM SEARCHED
* (TYPSAVE) = PRIMARY KEYWORD OPTION.
*
* EXIT TO *SYSFE11* IF CREATE OPTION AND FILE
* ALREADY EXISTS OR IF RENAME OPTION AND THE
* OLD NAME EXISTS ON ONE DISK SYSTEM AND THE
* NEW NAME EXISTS ON THE OTHER DISK SYSTEM.
*
* USES A - 1, 2, 6.
* B - NONE.
* X - 1, 2, 6.
*
* CALLS NEWSRCH, OLDSRCH, SWAPFNS.
*
* MACROS NONE.
SEARCHED EQ * MUST BE AN -EQ-, SEE *RJSAVE1*
ZR X6,SEARCHED EXIT IF FILE WAS NOT FOUND
SA1 TYPSAVE (X1) = PRIMARY KEYWORD OPTION
SX2 X1-F.RENAME CHECK FOR RENAME OPTION
ZR X2,SEARCHD1 IF RENAME OPTION
SX2 X1-F.CREATE CHECK FOR CREATE OPTION
NZ X2,SEARCHED EXIT IF NOT CREATE OPTION
* IF CREATE OPTION AND FILE WAS FOUND ON EITHER DISK
* SYSTEM, RETURN A DUPLICATE FILE ERROR.
EQ SYSFE11 DUPLICATE FILE NAME ERROR
* IF RENAME OPTION AND FILE IS FOUND ON ONE DISK
* SYSTEM, CHECK THE OTHER DISK SYSTEM FOR A DUPLI-
* CATE NAME. DUPLICATE NAMES ON THE SAME DISK
* DISK SYSTEM WILL BE DETECTED WHEN YOU TRY TO
* RENAME THE FILE.
SEARCHD1 SA1 SEARCHED SAVE RJ TRAIL
AX1 30 SHIFT RETURN ADDRESS TO LOW END
SX6 X1 EXTRACT 18-BIT RETURN ADDRESS
SA6 RJSAVE1
RJ SWAPFNS SWAP OLD AND NEW FILE NAMES
PL B1,SEARCHD2 IF FOUND ON NEW DISK SYSTEM
RJ NEWSRCH SEARCH NEW DISK SYSTEM
NG X6,SYSFE11 DUPLICATE FILE ERROR IF FOUND
EQ SEARCHD3 IF NOT FOUND
SEARCHD2 RJ OLDSRCH SEARCH OLD DISK SYSTEM
NG X6,SYSFE11 DUPLICATE FILE ERROR IF FOUND
SEARCHD3 RJ SWAPFNS SWAP FILE NAMES BACK
SA2 SEARCHED USE ENTRY POINT FOR MODEL -EQ-
MX1 6 MASK OFF THE OP-CODE
BX2 X1*X2 X2 = FORCED-UPPER -EQ- OP-CODE
SA1 RJSAVE1 RETRIEVE 18-BIT RETURN ADDRESS
LX1 30 SHIFT TO OPERAND FIELD FOR -EQ-
BX6 X1+X2 FORM COMPLETE RETURN INSTRUCT.
SA6 SEARCHED RESTORE RETURN INSTRUCTION
SX6 -1 RESTORE (X6) = -1 = FILE FOUND
EQ SEARCHED -- EXIT
SWAPFNS SPACE 4,10
** SWAPFNS -- SWAP OLD AND NEW FILE NAMES
*
* SWAP OLD AND NEW ACCOUNT AND FILE NAMES IN ORDER
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
* TO CHECK FOR A DUPLICATE FILE NAME ON A DIFFERENT
* DISK SYSTEM BEFORE RENAMING A FILE.
*
* USES A - 1, 2, 6, 7.
* B - NONE.
* X - 1, 2, 6, 7.
*
* CALLS NONE.
*
* MACROS NONE.
*
SWAPFNS EQ *
SA1 ACCT (X1) = ACCOUNT NAME
SA2 NACCT (X2) = NEW ACCOUNT NAME
BX6 X1
BX7 X2
SA6 A2
SA7 A1
SA1 FILE (X1) = FILE NAME
SA2 NFILE (X2) = NEW FILE NAME
BX6 X1
BX7 X2
SA6 A2
SA7 A1
EQ SWAPFNS
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
NFOUND EQ *
CALL S=MSG,NFOUNDA
RJ FILACCTL
MX6 0
EQ NFOUND
NFOUNDA DIS ,* FILE NOT FOUND.*
YFOUND EQ *
CALL S=MSG,YFOUNDA
RJ FILACCTL
MX6 -1
EQ YFOUND
YFOUNDA DIS ,* FILE FOUND.*
FILACCTL EQ *
SA1 FILE
SB6 A5 SAVE A5
CALL S=OTOA
SA5 B6 RESTORE A5
SA6 FILEMSG+1
SA7 FILEMSG+2
CALL S=MSG,FILEMSG
SA1 ACCT
SB6 A5 SAVE A5
CALL S=OTOA
SA5 B6 RESTORE A5
SA6 ACCTMSG+1
SA7 ACCTMSG+2
CALL S=MSG,ACCTMSG
EQ FILACCTL
FILEMSG DATA 10H FILE -
DATA 0,0,0
ACCTMSG DATA 10H ACCT -
DATA 0,0,0
.1 ENDIF
SYSFRST SPACE 4,13
** SYSFRST - RESTORE OVDATAS FOR -SYSFILE-
*
* ENTRY NONE.
*
* EXIT OVDATA VARIABLES RESTORED FROM *TBINTSV*.
*
* USES A - 1, 6.
* B - 1, 2, 3.
* X - 1, 6.
*
* CALLS NONE.
*
* MACROS NONE.
SYSFRST EQ *
SB1 SAVE60L-1 (B1) = NO. OF 60-BIT FIELDS - 1
SYSFRST1 SA1 TBINTSV+B1 (X1) = NEXT FIELD TO RESTORE
BX6 X1
SA6 SAVE60+B1 RESTORE IT
SB1 B1-1 END TEST
PL B1,SYSFRST1 IF MORE TO RESTORE
SB1 SAVE18L-1 (B1) = WORDS TO RESTORE - 1
SB2 0 COUNT OF SAVED WORDS RESTORED
SYSFRST2 SA1 TBINTSV+SAVE60L+B2 (X1) = NEXT 3 FIELDS
SB3 3 (B3) = NO. FIELDS / WORD
SYSFRST3 LX1 18 POSITION NEXT 18-BIT FIELD
SX6 X1 (X6) = NEXT 18-BIT FIELD
SA6 SAVE18+B1 RESTORE THE FIELD
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
SB1 B1-1 END TEST
NG B1,SYSFRST RETURN IF ALL DONE
SB3 B3-1 SEE IF MORE FIELDS IN X1
NZ B3,SYSFRST3 IF MORE IN X1
SB2 B2+1 INCREMENT SAVED WORDS RESTORED
EQ SYSFRST2
SYSFSAV SPACE 4,13
** SYSFSAV - SAVE OVDATAS FOR -SYSFILE-
*
* ENTRY NONE.
*
* EXIT OVDATA VARIABLES SAVED IN *TBINTSV*.
*
* USES A - 1, 6.
* B - 1, 2, 3, 4.
* X - 0, 1, 6.
*
* CALLS NONE.
*
* MACROS NONE.
SYSFSAV EQ *
SB1 SAVE60L-1 (B1) = NO. OF 60-BIT FIELDS - 1
SYSFSAV1 SA1 SAVE60+B1 (X1) = NEXT FIELD TO SAVE
BX6 X1
SA6 TBINTSV+B1 SAVE IT
SB1 B1-1 END TEST
PL B1,SYSFSAV1 IF MORE TO SAVE
SB1 SAVE18L (B1) = NO. OF 18-BIT FIELDS
SB2 B0 (B2) = COUNTER FOR WORDS STORED
MX0 -18 (X0) = MASK FOR 18-BIT FIELDS
SYSFSAV2 SB3 18+18+6 (B3) = SHIFT COUNT
SX6 B0 PRESET NEXT 3 FIELDS TO ZERO
SB4 B0 FLAG NOTHING IN X6 YET
SYSFSAV3 SB1 B1-1 END TEST
NG B1,SYSFSAV4 IF NO MORE TO SAVE
SA1 SAVE18+B1 (X1) = NEXT FIELD TO SAVE
BX1 -X0*X1 LIMIT TO 18 BITS
LX1 X1,B3 SHIFT TO POSITION
BX6 X1+X6 MERGE
SB4 -1 FLAG SOMETHING IN X6
SB3 B3-18 ADJUST SHIFT-COUNT
PL B3,SYSFSAV3 IF ROOM FOR MORE IN X6
SYSFSAV4 PL B4,SYSFSAV IF NOTHING IN X6
SA6 TBINTSV+SAVE60L+B2 STORE NEXT WORD
NG B1,SYSFSAV RETURN IF ALL DONE
SB2 B2+1 INCREMENT COUNT OF WORDS STORED
EQ SYSFSAV2
.MDS ELSE
TAGSDONE BSS 0
.MDS ENDIF
EJECT
* FINISH PREPARATIONS NEEDED FOR THE PRIMARY
* OPTIONS (ATTACH, DETACH, ETC.) AND BRANCH TO
* THE APPROPRIATE ROUTINE.
*
* THE FOLLOWING CODE HANDLES TRANSACTIONS ON THE
* OLD DISK SYSTEM.
OLDDSYS SA1 FILE (X1) = FILE NAME
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,ONOLD
SA1 FILE
EQ ONOLD2
ONOLD DIS ,* USING OLD DISK SYSTEM.*
ONOLD2 BSS 0
.1 ENDIF
SA2 PACK (X2) = PACK NAME
BX6 X1
BX7 X2
SA3 FIPSAVE (X3) = ADDRESS OF FIP
SA6 X3+/FIP/FILE SET FILE NAME IN FIP
SA7 X3+/FIP/DIR SET PACK NAME IN FIP
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,FIPMSG
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
SA1 FIPSAVE
CALL OCTDUMP,X1,FIPLTH
.1 ENDIF
SA1 TYPSAVE (X1) = PRIMARY OPTION
SB1 X1+0
JP B1+TYPJTAB --- JUMP ON PRIMARY OPTION
TYPJTAB BSS 0
+ SX6 0 0 = ATTACH FILE
EQ O.ATTACH
+ SA1 FIPSAVE 1 = DETACH FILE
EQ O.DETACH
+ SX6 1 2 = CHECK EXISTENCE OF A FILE
EQ O.ATTACH
+ SX6 3 3 = READ FILE
EQ O.RW
+ SX6 4 4 = WRITE FILE
EQ O.RW
+ SA1 FIPSAVE 5 = CREATE FILE
EQ O.CREATE
+ SA1 FIPSAVE 6 = DESTROY FILE
EQ O.DEST
+ SA1 FIPSAVE 7 = RENAME FILE
EQ O.RENAME
+ SA1 FIPSAVE 8 = CHANGE FILE TYPE
EQ O.RETYPE
+ SA1 FIPSAVE 9 = SET/CLEAR BACKUP BIT
EQ O.FBIT
+ EQ SYSFE99 10 = RECREATE FILE (CANNOT DO)
* ATTACH OPTION AND CHECK EXISTENCE OF A
* FILE -- SET/CLEAR THE -FILEF- FLAG AND EXECUTE
* THE -ATTACHF- OVERLAY.
O.ATTACH SA6 /ATTFOV/SAVETYP SET/CLEAR -FILEF- FLAG
SX6 -1
SA6 OVARG1 FLAG FROM -SYSFILE- COMMAND
SA1 FIPSAVE (X1) = ADDRESS OF FIP
SX6 X1+0
SA6 /ATTFOV/FIPADDR
EXEC EXEC4,ATTFOV
* DETACH OPTION -- SET THE STATION/MASTER FLAG AND
* EXECUTE THE -DETACHF- OVERLAY.
O.DETACH SX6 X1 (X6) = ADDRESS OF FIP
SA6 /DETFOV/FIPADDR
SA1 SMCODE
BX6 X1
MX7 -1
SA6 /DETFOV/SMCODE
SA7 OVARG1 FLAG FROM -SYSFILE- COMMAND
EXEC EXEC4,DETFOV
* READ/WRITE OPTIONS -- MOVE STARTING BLOCK, STORAGE
* INDEX, NUMBER OF BLOCKS AND I/O TYPE TO THE PROPER
* CELLS AND EXECUTE THE -READF-/-WRITEF- OVERLAY.
O.RW SA6 /FIOV/IOTYPE SET I/O TYPE
SA1 START (X1) = STARTING BLOCK NUMBER
SA2 STORAGE (X2) = STORAGE INDEX
BX6 X1
BX7 X2
SA6 /FIOV/FRSTBLK
SA7 /FIOV/ECSADDR
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
SA1 NUMBER (X1) = NUMBER OF BLOCKS
BX6 X1
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
MX7 -1
SA6 /FIOV/NUMBLKS
* /--- BLOCK SYSFILE 00 000 80/12/02 03.41
SA7 OVARG1 FLAG FROM -SYSFILE- COMMAND
SA1 FIPSAVE (X1) = ADDRESS OF FIP
SX6 X1+0
SA6 /FIOV/FIPADDR
EXEC EXEC4,FIOV
* CREATE OPTION -- DO -SETPACK- EQUIVALENT AND PLACE
* THE DESIRED FILE NAME, SPACE ALLOCATION INFO AND
* PACK DIRECTORY RETURN FLAG IN THE PROPER CELLS.
O.CREATE SX6 X1 (X6) = ADDRESS OF FIP
SA6 /CREATE/FIPADDR
RJ SETPACK
SA1 F.LTH (X1) = FILE LENGTH
SA2 F.TYP (X2) = FILE TYPE
SA3 F.DIR (X3) = DIRECTORY SIZE
SA4 F.RMT (X4) = RMT SIZE
LX2 6 SHIFT FIELDS TO POSITION
LX3 12
LX4 18
BX6 X1+X2 MERGE
BX6 X6+X3
BX6 X6+X4
SA6 /CREATE/INFO STORE SPACE ALLOC. INFO WORD
SA1 FILE (X1) = DESIRED FILE NAME
SA2 NPDWRIT (X2) = PACK DIR. CHECKPT FLAG
BX6 X1 (X6) = DESIRED FILE NAME
BX7 X2
SA6 /CREATE/FILE
SA7 /CREATE/CHECKPT
EQ =XCREATE1 --- JUMP TO -CREATE- COMMAND
* DESTROY OPTION -- DO -SETPACK- EQUIVALENT AND
* PLACE THE FILE NAME IN THE CORRECT CELL
O.DEST SX6 X1 (X6) = ADDRESS OF FIP
SA6 /DESTROY/FIPADDR
RJ SETPF SET TO PACK AND FILE
SA1 FILE (X1) = DESIRED FILE NAME
BX6 X1
SA6 /DESTROY/FILE
EQ =XDESTRY1 --- JUMP TO -DESTROY- COMMAND
* /--- BLOCK SYSFILE 00 000 80/12/02 04.00
* RENAME OPTION -- DO -SETPACK- EQUIVALENT AND
* PLACE THE FILE NAME AND DESIRED NEW NAME IN THE
* PROPER CELLS.
O.RENAME SX6 X1 (X6) = ADDRESS OF FIP
SA6 /RENAME/FIPADDR
RJ SETPF SET TO PACK AND FILE
SA1 FILE (X1) = FILE NAME
SA2 NFILE (X2) = NEW NAME
BX6 X1
BX7 X2
SA6 /RENAME/FILE
SA7 /RENAME/NFILE
SX6 0
SA6 /RENAME/FLAG SET -RENAMEF-/-RETYPEF- FLAG
*
RENAME1 MX6 0 CLEAR OVERLAY STACK
SA6 OVRSTAK
X DSKCOV,3 EXECUTE -RENAMEF- COMMAND CODE
* RETYPE OPTION -- DO -SETPACK- EQUIVALENT AND
* PLACE THE FILE NAME AND NEW FILE TYPE IN THE
* PROPER CELLS.
O.RETYPE SX6 X1 (X6) = ADDRESS OF FIP
SA6 /RETYPE/FIPADDR
RJ SETPF SET TO PACK AND FILE
SA1 FILE (X1) = FILE NAME
SA2 F.TYP (X2) = NEW FILE TYPE
BX6 X1
BX7 X2
SA6 /RETYPE/FILE
SA7 /RETYPE/TYPE
SX6 -1
SA6 /RETYPE/FLAG SET -RENAMEF-/-RETYPEF- FLAG
EQ RENAME1
* FBIT OPTION -- DO -SETPACK- EQUIVALENT AND PLACE
* THE FILE NAME AND ON/OFF FLAG IN THE APPROPRIATE
* CELLS.
O.FBIT SX6 X1 (X6) = ADDRESS OF FIP
SA6 /FBIT/FIPADDR
RJ SETPF
SA1 FILE (X1) = FILE NAME
SA2 NEWFBIT (X2) = NEW BACKUP BIT
BX6 X1
BX7 X2
SA6 /FBIT/FILE
SA7 /FBIT/NEWFBIT
SX6 -1
SA6 OVARG1 FLAG FROM -SYSFILE- COMMAND
EXEC EXEC4,FBITOV
* /--- BLOCK SYSFILE 00 000 80/12/02 03.44
EJECT
** SETPF - SET TO PLATO PACK AND FILE
*
* THIS SUBROUTINE IMITATES THE ACTION OF -SETPACK-
* AND -SETFILE- COMMANDS.
*
* IF A PACK NAME IS PROVIDED, *SETPACK* IS CALLED
* SET TO THAT SPECIFIC PACK.
*
* IF NO PACK NAME IS PROVIDED, *FINDFN* IS CALLED
* TO SEARCH ALL ACTIVE PACKS.
*
* ENTRY (FIPSAVE) = ADDRESS OF FIP
*
* EXIT (TDISKU) = DISK UNIT IF SUCCESSFUL, ELSE 0
* (TPNAME) = PACK NAME IF SUCCESSFUL, ELSE 0
* TO *SYSFE0* IF FILE DOES NOT EXIT
* TO *SYSFE3* IF PACK NAME IS BAD
* TO *SYSFE4* IF FILE NAME IS BAD
*
* CALLS FINDFN, SETPACK
*
* USES X - 1, 2, 7.
* A - 1, 2, 7.
* B - NONE.
*
SETPF EQ *
SA2 FIPSAVE (X2) = ADDRESS OF FIP
SA1 X2+/FIP/FILE (X1) = FILE NAME
ZR X1,SYSFE4 --- ERROR IF BAD FILE NAME
NG X1,SYSFE4 --- ERROR IF BAD FILE NAME
SA2 X2+/FIP/DIR (X2) = PACK NAME
NG X2,SYSFE3 --- ERROR IF BAD PACK NAME
ZR X2,SETPF1 --- TO SEARCH ALL PACKS
RJ SETPACK SET TO SPECIFIED PACK
EQ SETPF --- RETURN
SETPF1 RJ =XFINDFN SEARCH ALL ACTIVE PACKS
NG X7,SYSFE0 --- ERROR IF FILE NOT FOUND
SA7 TDISKU STORE DISK UNIT NUMBER
SA1 PNAMES+X7 (X1) = PACK NAME
BX7 X1
SA7 TPNAME STORE PACK NAME
EQ SETPF --- RETURN
EJECT
** SETPACK - IMITATION -SETPACK- COMMAND
*
* ENTRY (FIPSAVE) = ADDRESS OF FIP
*
* EXIT (TDISKU) = DISK UNIT IF SUCCESSFUL, ELSE 0
* (TPNAME) = PACK NAME IF SUCCESSFUL, ELSE 0
* TO *SYSFE3* IF PACK NAME IS BAD
* TO *SYSFE3* IF PACK IS NOT LOADED
*
* USES X - 1, 2, 3, 6, 7.
* A - 0, 1, 2, 6, 7.
* B - 2, 3.
*
SETPACK EQ *
SA1 TDISKU (X1) = CURRENT DISK UNIT
SA2 X1+PNAMES (X2) = CURRENT PACK NAME
SA1 FIPSAVE (X1) = ADDRESS OF FIP
SA1 X1+/FIP/DIR (X1) = PACK TO SET TO
ZR X1,SETPACK2 --- ERROR IF NO PACK NAME
NG X1,SETPACK2 --- ERROR IF BAD PACK NAME
BX2 X1-X2 SEE IF ALREADY SET TO THE PACK
ZR X2,SETPACK4 --- IF ALREADY DONE
SB2 B0 (B2) = DISK UNIT INDEX
SB3 NDSUS (B3) = NUMBER OF DISK UNITS
SA0 PNAMES (A0) = ADDRESS OF PACK NAMES
* /--- BLOCK SYSFILE 00 000 80/12/02 03.44
SETPACK1 SA2 A0+B2 (X2) = NEXT PACK NAME
BX3 X1-X2 SEE IF THE MATCH
ZR X3,SETPACK3 --- IF PACK NAMES IDENTICAL
SB2 B2+1 INCREMENT DISK UNIT INDEX
LT B2,B3,SETPACK1 --- IF MORE PACKS TO CHECK
SETPACK2 SX6 0
SA6 TPNAME CLEAR PACK NAME
SA6 TDISKU CLEAR DISK UNIT
EQ SYSFE3 --- TO ERROR EXIT
SETPACK3 SX6 B2 (X6) = DISK UNIT NUMBER
BX7 X2 (X2) = PACK NAME
SA6 TDISKU
SA7 TPNAME
EQ SETPACK
SETPACK4 BX6 X1 (X6) = PACK NAME
SA6 TPNAME MAKE SURE PACK NAME IS CORRECT
EQ SETPACK
EJECT
.MDS IFNE *F,0
* THE FOLLOWING CODE HANDLES TRANSACTIONS ON THE
* NEW DISK SYSTEM.
NEWDSYS RJ SYSFSAV SAVE OVDATAS OVER INTERRUPT
CALLX REQCHK CHECK FOR MASTOR REQ. OVERFLOW
RJ SYSFRST RESTORE OVDATAS
SX6 0
SA6 PINNED MARK STORAGE NOT PINNED
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,ONNEW
EQ ONNEW2
ONNEW DIS ,* USING NEW DISK SYSTEM.*
ONNEW2 BSS 0
.1 ENDIF
RJ =XINITDRQ INITIALIZE MASTOR REQUEST AREA
SA1 TYPSAVE (X1) = PRIMARY OPTION
SA2 X1+ATTRTAB (X2) = OPTION ATTRIBUTES
SA1 FIPSAVE (X1) = ADDR. OF FIP
SX6 X2 (X6) = SUB-FUNCTION CODE
ZR X6,SYSFOK IF NO-OP ON NEW DISK SYSTEM
BX0 X2 (X0) = OPTION ATTRIBUTES
LX0 R.MODE
PL X0,NEWDSYS0 IF ATTACH MODE NOT NEEDED
SA3 X1+/FIP/MFF (X3) = MISC. FIP FIELDS
LX3 60-/MFF/S.ATTACH
MX4 -/MFF/M.ATTACH
BX4 -X4*X3 (X4) = ATTACH MODE
LX4 18 POSITION ATTACH MODE
BX6 X4+X6 MERGE WITH SUB-FUNCTION CODE
NEWDSYS0 SA3 MSGADDR (X3) = ADDR OF MESSAGE BUFFER
ZR X3,NEWDS0.1 IF NO MESSAGE BUFFER
SX3 1
LX3 FO.ERROR POSITION FLAG FOR MSG. OPTION
BX6 X3+X6
NEWDS0.1 LX0 R.NOATT-R.MODE
PL X0,NEWDS0.2 IF *NOATTACH* NOT ALLOWED
SA3 X1+/FIP/MFF
LX3 59-/MFF/S.NOATT
ERRNZ /MFF/M.NOATT-1
PL X3,NEWDS0.2 IF ATTACH REQUIRED
MX3 1
LX3 1+FO.IGNA
BX6 X3+X6
NEWDS0.2 SA6 MASRQ+FP.FUNC
LX0 R.AFT-R.NOATT
PL X0,NEWDSYS1 IF AFT SHOULD NOT BE SPECIFIED
SA3 X1+/FIP/MFF (X3) = MISC. FIP FIELDS
* /--- BLOCK SYSFILE 00 000 80/12/02 03.44
MX0 -/MFF/M.AFT (X0) = MASK FOR AFT INDEX
BX6 -X0*X3 (X6) = AFT INDEX
SA6 MASRQ+FP.AFT
NEWDSYS1 SA3 FILE (X3) = FILE NAME
BX6 X3
SA6 MASRQ+FP.FNAME
SA3 ACCTRES SEE IF ACCT OF RES SPECIFIED
NZ X3,NEWDS1.1 USE NEW VALUE IF SPECIFIED
SA3 X1+/FIP/FAW ELSE USE VALUE FROM /FIP/
AX3 /FAW/S.ACCRES
MX0 -/FAW/M.ACCRES
BX3 -X0*X3
LX3 18
NEWDS1.1 SA4 MASRQ+FP.ACCR
BX6 X3+X4 RETAIN STATION NUMBER FIELD
SA6 A4 STORE ACCT OF RES IN MASRQ BUFF
SA3 ACCT (X3) = ACCOUNT NAME
BX6 X3
SA6 MASRQ+FP.ACCO
SA3 SUBACCT (X3) = SUB-ACCOUNT IDENTIFIER
BX6 X3
SA6 MASRQ+FP.SUBA
SA3 DIRECT (X3) = DIRECTORY NAME
SX6 3RNEW CHECK FOR GLOBAL DIRECTORY
IX6 X3-X6
ZR X6,NEWDS1.2 IF GLOBAL DIRECTORY DESIRED
BX6 X3
NEWDS1.2 SA6 MASRQ+FP.DNAME
SA3 OLDPACK IF PACK FOR OLD SYSTEM ONLY
NG X3,NOPNAME IF NOT FOR NEW DISK SYSTEM
SA3 PACK (X3) = PACK NAME OR TYPE
BX6 X3
SA6 MASRQ+FP.PACK
NOPNAME BX0 X2 (X0) = OPTION ATTRIBUTES
LX0 R.NAME
NG X0,NEWDSYS6 IF NEW ACCOUNT';NAME REQUIRED
* FOR SINGLE FILE OPERATION, UNION ATTR BITS
* INTO ACCT-OF-ORIGIN WORD FOR THAT FILE.
SA3 MASRQ+FP.ACCO
SA4 ATTRIBS (X4) = ATTRIBUTE BITS
LX4 1 SHIFT ATTRIBUTE BITS INTO POS.
BX6 X3+X4 UNION ATTR BITS
SA6 A3 UPDATE REQUEST BUFFER
MX6 0 PRE-CLEAR X6
LX0 R.LTH-R.NAME
PL X0,NEWDSYS2 IF FILE LENGTH NOT NEEDED
SA3 F.LTH (X3) = FILE LENGTH
SX4 35 (X4) = SECTORS / PART
IX3 X3*X4 (X3) = LENGTH IN SECTORS
LX3 24+18 SHIFT TO POSITION
BX6 X3+X6 MERGE
NEWDSYS2 LX0 R.DIR-R.LTH
PL X0,NEWDSYS3 IF DIRECTORY SIZE NOT NEEDED
SA3 F.DIR (X3) = DIRECTORY SIZE
LX3 9+18 SHIFT TO POSITION
BX6 X3+X6 MERGE
NEWDSYS3 LX0 R.RMT-R.DIR
PL X0,NEWDSYS4 IF RMT SIZE NOT NEEDED
SA3 F.RMT (X3) = RMT SIZE
LX3 18 SHIFT TO POSITION
BX6 X3+X6 MERGE
NEWDSYS4 LX0 R.TYP-R.RMT
PL X0,NEWDSYS5 IF FILE TYPE NOT NEEDED
* /--- BLOCK SYSFILE 00 000 80/12/02 03.44
SA3 F.TYP (X3) = DESIRED FILE TYPE
BX6 X3+X6 MERGE
NEWDSYS5 SA6 MASRQ+FP.INFO
AX2 18 POSITION I/O CODE
SX6 X2 (X6) = I/O CODE
ZR X6,NEWDSYS7 IF NO I/O INVOLVED
LX6 18+12+24 POSITION I/O CODE
SA6 MASRQ+FP.IO STORE I/O CODE
SA1 TBXSTOR (X1) = STORAGE INFO
CALL SETSTOR SET UP *STORWRD*
SA4 STORWRD (X4) = 24/EM ADDR,18/LTH,18/0
AX4 18 POSITION STORAGE LENGTH
SA1 STORAGE (X1) = STARTING STORAGE ADDR.
SX0 DBSIZE (X0) = WORDS / SECTOR
SA2 NUMBER (X2) = NO. BLOCKS TO READ/WRITE
IX0 X0*X2 (X0) = NO. WORDS TO READ/WRITE
SX3 X4 (X3) = STORAGE LENGTH
IX3 X3-X0 SUBTRACT I/O LENGTH
IX3 X3-X1 SUBTRACT STARTING ADDRESS
NG X3,SYSFE7 ERROR IF OUT OF RANGE
AX4 18 (X4) = ABS. STORAGE ADDRESS
IX6 X4+X1 (X6) = ABS. STARTING ADDRESS
SA1 MASRQ+FP.IO (X1) = 6/IO CODE,54/0
SA2 START (X2) = STARTING SECTOR
SA3 NUMBER (X3) = SECTORS TO READ/WRITE
LX2 12+24 POSITION STARTING SECTOR
LX3 24 POSITION NUMBER OF SECTORS
BX6 X1+X6 MERGE
BX6 X2+X6
BX6 X3+X6
SA6 MASRQ+FP.IO STORE IN MASTOR REQUEST BUFFER
SA2 NUMBER (X2) = NUMBER OF SECTORS
SB4 0 SET USER TYPE TO SYSTEM
SB2 SDEATTS (B2) = ADDR. OF STATS CELLS
AX6 54 (X6) = 54/0, 6/IO CODE
SX1 X6+2 (X1) = 3 TO READ, 4 TO WRITE
RJ =XDSKST UPDATE DISK STATISTICS
CALL IOLESSN,TBXSTOR,4000B PIN STORAGE
SX6 -1
SA6 PINNED MARK STORAGE PINNED
EQ NEWDSYS7
* FOR OPERATIONS INVOLVING TWO FILE NAMES,
* UNION ATTR BITS INTO THE NEW FILE NAME.
NEWDSYS6 SA1 NACCT (X1) = NEW ACCOUNT NAME
SA2 ATTRIBS (X2) = NEW ATTRIBUTES
LX2 1 SHIFT ATTR BITS INTO POS.
BX6 X1+X2
SA6 MASRQ+FP.ACCO2
SA1 NFILE (X1) = NEW FILE NAME
BX6 X1
SA6 MASRQ+FP.FNAM2
NEWDSYS7 RJ =XSAVLES SAVE COMMON, LESSON, ETC.
RJ SYSFSAV SAVE *OVDATA* CELLS
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,DEBUGM6
EQ DEBUG6
DEBUGM6 DIS ,/ POSTING REQUEST FOR *NEWDSYS*./
DEBUG6 CALL OCTDUMP,MASRQ,MS.RDIM
.1 ENDIF
* /--- BLOCK SYSFILE 00 000 80/12/02 03.44
CALL S=MAS,MASRQ,STATION POST REQUEST TO MASTOR
NEWDSYS8 TUTIM -1,,IOKEY
SA1 KEY CHECK FOR *IOKEY*
SX1 X1-IOKEY
NZ X1,NEWDSYS8 IF WRONG KEY
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
CALL S=MSG,DEBUGM7
EQ DEBUG7
DEBUGM7 DIS ,/ REPLY RECEIVED FOR *NEWDSYS*./
DEBUG7 CALL OCTDUMP,MASRQ,MS.RDIM
.1 ENDIF
RJ SYSFRST RESTORE *OVDATA* CELLS
SA1 PINNED (X1) = -1 IF STORAGE WAS PINNED
ZR X1,NEWDSYS9 IF NOT PINNED
CALL IOLESSN,TBXSTOR,-4000B
NEWDSYS9 RJ =XRESTLES RESTORE LESSON, COMMON, ETC.
RJ =XRESTKEY RESTORE *KEY*
* CHECK FOR BUSY CONDITION.
SA1 MASRQ+FR.ERR (X1) = ERROR RETURN
SX1 X1-/ERRCODE/BUSY
ZR X1,NEWDSYS REPEAT IF BUSY CONDITION
* RETURN THE FIP.
ERRNZ /MFF/M.AFT-18
ERRNZ /MFF/M.STATN-18
SA1 FIPSAVE (X1) = ADDRESS OF FIP
SA2 X1+/FIP/MFF (X2) = MISC. FIP FIELDS
MX6 -/MFF/M.ATTACH (X6) = MASK FOR ATTACH MODE
LX6 /MFF/S.ATTACH POSITION THE MASK
BX6 -X6*X2 (X6) = ATTACH MODE
MX3 -/MFF/M.NOATT
LX3 /MFF/S.NOATT
BX3 -X3*X2 PRESERVE *NOATTACH* BIT
BX6 X3+X6 MERGE WITH ATTACH MODE FIELD
SA2 MASRQ+FR.AFT (X2) = 27/0,15/STATN,18/AFT
MX3 -18 (X3) = MASK FOR AFT POINTER
BX3 -X3*X2 (X3) = AFT POINTER
LX3 /MFF/S.AFT POSITION AFT POINTER
BX6 X3+X6 INSERT AFT POINTER INTO FIP
SA3 MASRQ+FR.ERR CHECK ERROR RETURN
SX3 X3-/ERRCODE/ATTACHED
NZ X3,NOCONFL IF NOT ALREADY ATTACHED
AX2 18 SHIFT STATION NUMBER DOWN
MX3 -15
BX3 -X3*X2 (X3) = CONFLICTING STATION
SX3 X3+1 FIP NEEDS STATION + 1
LX3 /MFF/S.STATN POSITION STATION NUMBER
BX6 X3+X6 INSERT STATION INTO FIP
NOCONFL SA6 X1+/FIP/MFF STORE FIRST WORD OF FIP
SA2 MASRQ+FR.FNAME (X2) = FILE NAME
SA3 MASRQ+FR.FAW (X3) = FAW
BX6 X2
BX7 X3
SA6 X1+/FIP/FILE
SA7 X1+/FIP/FAW
SA2 MASRQ+FR.FIW (X2) = FIW
SA3 MASRQ+FR.DNAME (X3) = DIRECTORY
NZ X3,GOTDIRN
SX3 3RNEW
GOTDIRN BX6 X2
BX7 X3
SA6 X1+/FIP/FIW
SA7 X1+/FIP/DIR
* SET *ZRETURN* AND *ERROR*.
* /--- BLOCK SYSFILE 00 000 80/12/02 03.44
SA1 MASRQ+FR.ERR CHECK ERROR RETURN
PL X1,NEWDONE IF ERROR OCCURRED
MX6 -1
MX7 0
SA6 TRETURN
SA7 TERROR
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
EQ DEBUG8
.1 ENDIF
EQ =XCKPROC
NEWDONE SA2 MSGADDR SEE IF DISPLAYABLE MSG WANTED
ZR X2,NEWDONE2 IF MESSAGE NOT DESIRED
SB1 4
NEWDONE1 SA3 MASRQ+FR.MSG+B1 (X1) = NEXT WORD OF MSG.
BX6 X3
SA6 X2+B1 STORE IN USER MESSAGE BUFFER
SB1 B1-1
PL B1,NEWDONE1
NEWDONE2 SX2 X1-/ERRCODE/IOFUNC DISK ERRS .LT. IOFUNC
PL X2,NEWCONV IF NOT DISK ERROR
SX6 10
SX7 X1+
SA6 TRETURN *ZRETURN* = 10 FOR DISK ERROR
SA7 TERROR RETURN *ERROR* = DISK ERROR
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
EQ DEBUG8
.1 ENDIF
EQ =XCKPROC
* CONVERT *MS.FILE* RETURN TO -SYSFILE- *ZRETURN*
NEWCONV SA2 CONVTAB-1
NEWCONV1 SA2 A2+1 (X2) = 24/0,18/ZRETURN,18/CODE
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
ZR X2,*+1S17 WEIRD ERROR, CRASH PLATO
.1 ELSE
ZR X2,SYSFE98 RETURN BAD ZRETURN
.1 ENDIF
SX3 X2
BX3 X1-X3 SEE IF ERROR CODES MATCH
NZ X3,NEWCONV1 IF NOT, TRY NEXT ONE
AX2 18
SX6 X2
SA6 TRETURN SET *ZRETURN*
SX6 0
SX2 X1-/ERRCODE/ATTACHED
NZ X2,NEWCONV2 IF NOT ATTACHED ELSEWHERE
SA2 MASRQ+FR.AFT (X2) = 27/0,15/STATN,18/AFT
AX2 18 POSITION STATION NUMBER
MX6 -15
BX6 -X6*X2 (X6) = CONFLICTING STATION NO.
NEWCONV2 SA6 TERROR SET *ERROR*
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
EQ DEBUG8
.1 ENDIF
EQ =XCKPROC
.MDS ENDIF
EJECT
* EXITS FROM THE -SYSFILE- COMMAND --
SYSFOK SX6 -1 -1 = ALL OK
SYSFEX SA6 TRETURN SET *ZRETURN*
.1 IF DEF,SYSFDBG IF -SYSFILE- DEBUG ON
SA7 RJSAVE SAVE MSG ADDRESS
DEBUG8 SA1 TRETURN
SB6 A5 SAVE A5
CALL S=OTOA
SA5 B6 RESTORE A5
SA6 ZRETURNM+1
SA7 ZRETURNM+2
SA1 TERROR
SB6 A5 SAVE A5
CALL S=OTOA
SA5 B6 RESTORE A5
SA6 ERRORM+1
SA7 ERRORM+2
* /--- BLOCK SYSFILE 00 000 80/12/02 03.44
CALL S=MSG,ZRETURNM
CALL S=MSG,ERRORM
CALL S=MSG,FIPMSG
EQ DEBUG9
ZRETURNM DATA 10HZRETURN -
DATA 0,0,0
ERRORM DATA 10HERROR -
DATA 0,0,0
FIPMSG DIS ,* FIP CONTENTS --*
DEBUG9 SA1 FIPSAVE
ZR X1,*
CALL OCTDUMP,X1,FIPLTH
SA1 TRETURN RESTORE (X6)
SX6 X1+
SA1 RJSAVE RESTORE (X7)
SX7 X1+
.1 ENDIF
NG X6,=XCKPROC IF NO ERROR OCCURRED
SA1 MSGADDR (X1) = ADDRESS OF MSG BUFFER
ZR X1,=XCKPROC IF NO MESSAGE DESIRED
SB1 1 (B1) = 1
SB2 4 (B2) = COUNTER FOR LOOP
SX6 0
SYSFEX1 SA6 A1+B2 PRE-CLEAR MESSAGE BUFFER
SB2 B2-B1
PL B2,SYSFEX1
MX0 -12 (X0) = MASK FOR LAST MSG WORD
SB2 0 (B2) = CURRENT WORD OF MSG.
SB3 4 (B3) = MAX. MSG. WORDS - 1
SYSFEX2 SA2 X7+B2 (X2) = NEXT WORD OF MESSAGE
BX6 X2
SA6 X1+B2 STORE NEXT WORD OF MESSAGE
BX2 -X0*X2 TEST FOR WORD ENDING IN 0000B
ZR X2,=XCKPROC IF REACHED END OF MESSAGE
EQ B2,B3,=XCKPROC IF MAX. WORDS REACHED
SB2 B2+B1 INCREMENT COUNT OF WORDS
EQ SYSFEX2 GO DO NEXT WORD
SYSFE0 SX6 0 0 = FILE NOT FOUND
SX7 MSG0
EQ SYSFEX
SYSFE3 SX6 3 3 = PACK NOT LOADED
SX7 MSG3
EQ SYSFEX
SYSFE4 SX6 4 4 = BAD FILE NAME
SX7 MSG4
EQ SYSFEX
SYSFE5 SX6 5 5 = BAD STARTING BLOCK
SX7 MSG5
EQ SYSFEX
SYSFE6 SX6 6 6 = BAD NUMBER OF BLOCKS
SX7 MSG6
EQ SYSFEX
SYSFE7 SX6 7 7 = TRANSFER LENGTH TOO LONG
SX7 MSG7
EQ SYSFEX
SYSFE8 SX6 8 8 = BAD STORAGE INDEX
SX7 MSG8
EQ SYSFEX
SYSFE11 SX6 11 11 = DUPLICATE FILE NAME
SX7 MSG11
EQ SYSFEX
SYSFE12 SX6 12 12 = BAD FILE TYPE
SX7 MSG12
EQ SYSFEX
SYSFE13 SX6 13 13 = BAD DIRECTORY INFO
SX7 MSG13
EQ SYSFEX
SYSFE14 SX6 14 14 = BAD FILE LENGTH
SX7 MSG14
EQ SYSFEX
SYSFE98 BX6 X1 98 = WEIRD RETURN VALUE
SA6 TERROR RETURN *ERROR* = ACTUAL VALUE
* /--- BLOCK SYSFILE 00 000 80/12/02 03.44
SX6 98
SX7 MSG98
EQ SYSFEX
SYSFE99 SX6 99 99 = UNSUPPORTED OPTION
SX7 MSG99
EQ SYSFEX
MSG0 DIS ,*FILE NOT FOUND*
MSG3 DIS ,*PACK NOT LOADED*
MSG4 DIS ,*BAD FILE NAME*
MSG5 DIS ,*BAD STARTING BLOCK*
MSG6 DIS ,*BAD NUMBER OF BLOCKS*
MSG7 DIS ,*TRANSFER LENGTH TOO LONG*
MSG8 DIS ,*BAD STORAGE INDEX*
MSG11 DIS ,*DUPLICATE FILE NAME*
MSG12 DIS ,*BAD FILE TYPE*
MSG13 DIS ,*BAD DIRECTORY PARAMETERS*
MSG14 DIS ,*BAD FILE LENGTH*
MSG98 DIS ,/WEIRD *MS.FILE* RETURN/
MSG99 DIS ,*UNSUPPORTED OPTION*
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
.MDS IFEQ *F,1
EJECT
* THE FOLLOWING ARE USED TO SPECIFY ATTRIBUTES AND
* REQUIREMENTS OF VARIOUS SYSFILE OPTIONS. THERE IS
* ONE WORD FOR EACH OPTION. IF AN OPTION IS NOT
* AVAILABLE IN THE MASTOR DISK SYSTEM, SET THE
* FUNCTION CODE TO 0.
*
* THE CONTENTS OF AN ENTRY ARE --
*
* 1/SET IF ATTACH FIP REQUIRED
* 1/SET IF ATTACH MODE TO BE SPECIFIED
* 1/SET IF NEW FILE TYPE TO BE SPECIFIED
* 1/SET IF NEW FILE LENGTH TO BE SPECIFIED
* 1/SET IF NEW FILE NAME TO BE SPECIFIED
* 1/SET IF NEW DIRECTORY SIZE TO BE SPECIFIED
* 1/SET IF NEW RMT SIZE TO BE SPECIFIED
* 1/SET IF AFT POINTER CAN BE SPECIFIED
* 1/SET IF OK TO READ WITHOUT ATTACH
* 15/0
* 18/READ/WRITE CODE
* 18/FUNCTION CODE
* DEFINE SHIFTS FOR USING THE ATTRIBUTE TABLE.
R.AFIP EQU 0 ATTACH FIP REQUIRED (LX)
R.MODE EQU 1 ATTACH MODE REQUIRED (LX)
R.TYP EQU 2 FILE TYPE REQUIRED
R.LTH EQU 3 FILE LENGTH REQUIRED
R.NAME EQU 4 NEW ACCOUNT';NAME REQUIRED
R.DIR EQU 5 DIRECTORY SIZE REQUIRED
R.RMT EQU 6 RMT SIZE REQUIRED
R.AFT EQU 7 SET IF AFT POINTER SPECIFIED
R.NOATT EQU 8 SET IF OK TO READ W/O ATTACH
* DEFINE TABLE OF PRIMARY OPTION ATTRIBUTES.
ATTRTAB BSS 0
VFD 1/0,1/1,1/0,1/0,1/0,1/0,1/0,1/1 ATTACH
VFD 16/0,18/0,18/MF.ATT
VFD 1/0,1/0,1/0,1/0,1/0,1/0,1/0,1/1 DETACH
VFD 16/0,18/0,18/MF.DET
VFD 1/0,1/0,1/0,1/0,1/0,1/0,1/0,1/1 CHECK
VFD 16/0,18/0,18/MF.ATT
VFD 1/1,1/0,1/0,1/0,1/0,1/0,1/0,1/1 READ
VFD 1/1,15/0,18/1,18/MF.READ
VFD 1/1,1/0,1/0,1/0,1/0,1/0,1/0,1/1 WRITE
VFD 16/0,18/2,18/MF.WRITE
VFD 1/0,1/0,1/1,1/1,1/0,1/1,1/1,1/0 CREATE
VFD 16/0,18/0,18/MF.CREAT
VFD 1/0,1/0,1/0,1/0,1/0,1/0,1/0,1/1 DESTROY
VFD 16/0,18/0,18/MF.DESTR
VFD 1/0,1/0,1/0,1/0,1/1,1/0,1/0,1/0 RENAME
VFD 16/0,18/0,18/MF.RENAM
VFD 1/0,1/0,1/1,1/0,1/0,1/0,1/0,1/1 RETYPE
VFD 16/0,18/0,18/MF.CHANG
VFD 1/0,1/0,1/0,1/0,1/0,1/0,1/0,1/0 FBIT
VFD 16/0,18/0,18/0
VFD 1/0,1/0,1/1,1/1,1/0,1/1,1/1,1/1 RECREATE
VFD 16/0,18/0,18/MF.RECRE
.MDS ENDIF
* FUNCTION CODES FOR THE VARIOUS -SYSFILE- OPTIONS.
F.ATTACH EQU 0 ATTACH FILE
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
F.DETACH EQU 1 DETACH FILE
F.CHECK EQU 2 SEE IF FILE EXISTS
F.READ EQU 3 READ FILE
F.WRITE EQU 4 WRITE FILE
F.CREATE EQU 5 CREATE FILE
F.DEST EQU 6 DESTROY FILE
F.RENAME EQU 7 CHANGE FILE NAME
F.RETYPE EQU 8 CHANGE FILE TYPE
F.FBIT EQU 9 SET/CLEAR BACKUP BIT
.MDS IFEQ *F,1
F.RECRE EQU 10 RECREATE FILE
* DEFINE TABLE USED TO CONVERT *MS.FILE* ERROR
* CODES TO -SYSFILE- *ZRETURN* CODES.
CONVTAB BSS 0
CONV HERE
DATA 0 MARK END OF TABLE
.MDS ENDIF
* DATA DEFINITIONS
NUMARGS OVDATA TOTAL NUMBER OF ARGUMENTS
ARGSDONE OVDATA NUMBER OF ARGUMENTS PROCESSED
* THE FOLLOWING FIELDS REQUIRE 60 BITS EACH WHEN
* THEY ARE SAVED OVER INTERRUPTS.
SAVE60 OVDATA 0 START OF 60-BIT FIELDS
FILE OVDATA FILE NAME
ACCT OVDATA ACCOUNT NAME
NFILE OVDATA NEW FILE NAME
NACCT OVDATA NEW ACCOUNT NAME
PACK OVDATA PACK NAME
DIRECT OVDATA DIRECTORY NAME
SUBACCT OVDATA SUB-ACCOUNT IDENTIFIER
ACCTRES OVDATA ACCOUNT OF RESIDENCE IDENT.
* THE FOLLOWING FIELDS REQUIRE 18 BITS EACH WHEN
* THEY ARE SAVED OVER INTERRUPTS.
SAVE18 OVDATA 0 START OF 18-BIT FIELDS
FIPSAVE OVDATA ADDRESS OF FIP
TYPSAVE OVDATA PRIMARY KEYWORD OPTION
OLDPACK OVDATA -1 IF PACK FOR OLD DISK SYSTEM
PINNED OVDATA -1 IF STORAGE PINNED, 0 IF NOT
SMCODE OVDATA STATION/MASTER DETACH FLAG
F.TYP OVDATA FILE TYPE
F.LTH OVDATA FILE LENGTH
F.DIR OVDATA SIZE OF DIRECTORY (SECTORS)
F.RMT OVDATA SIZE/16 OF RMT (WORDS)
NPDWRIT OVDATA ZERO TO CHECKPT PACK DIRECTORY
START OVDATA STARTING SECTOR
STORAGE OVDATA STORAGE INDEX
NUMBER OVDATA NUMBER OF SECTORS
MSGADDR OVDATA ADDRESS OF USER MESSAGE BUFFER
NEWFBIT OVDATA NEW BACKUP BIT
RJSAVE OVDATA -RJ- ADDRESS FOR *NEWSRCH*
RJSAVE1 OVDATA -RJ- ADDRESS FOR *SEARCHED*
ATTRIBS OVDATA ATTRIBUTE BITS
SAVEND OVDATA 0 END OF FIELDS TO BE SAVED
OVD RMT MUST BE ASSEMBLED W/OVDATA DEFS
* THE OVERFLOW CHECK BELOW USES *TINTSVL-1* AS THE
* MAXIMUM LENGTH AVAILABLE BECAUSE *TBINTSV+15* IS
* USED BY *REQCHK*.
SAVE60L EQU SAVE18-SAVE60 60-BIT FIELDS TO SAVE
TSAV18L SET SAVEND-SAVE18+2
* /--- BLOCK SYSFILE 00 000 79/10/28 01.18
TSAV18L SET TSAV18L/3 WORDS NEEDED FOR 18-BIT FIELDS
ERRNG TINTSVL-1-SAVE60L-TSAV18L OVERFLOW CHECK
ERRNZ TINTSVL-1-15 *TBINTSV+15* MUST BE LAST
TSAV18L SET SAVEND-SAVE18 RESET TO NO OF 18-BIT FIELDS
*
* THE FOLLOWING -EQU- IS NEEDED BECAUSE COMPASS NO
* LONGER RETAINS THE LAST VALUE OF THE -SET- PSEUDO
* BETWEEN PASSES 1 AND 2. THIS WOULD THEN CAUSE
* SYMBOL *SAVE18L* TO BE UNDEFINED AS IT IS
* REFERENCED BEFORE IT IS -SET- TO A VALUE.
*
* KUBAT 82/02/17
*
SAVE18L EQU TSAV18L
RMT
* PARAMETERS EXPECTED BY -CREATE-
QUAL CREATE
FILE EQU TBINTSV FILE NAME
INFO EQU TBINTSV+1 SPACE ALLOCATION REQUEST
CHECKPT EQU TBINTSV+2 NEG. IF NOT TO RETURN PACK DIR.
FIPADDR EQU TBINTSV+3 ADDRESS OF FIP
QUAL *
* PARAMETERS EXPECTED BY -DESTROY-
QUAL DESTROY
FILE EQU TBINTSV NAME OF FILE TO DESTROY
FIPADDR EQU TBINTSV+3 ADDRESS OF FIP
QUAL *
* PARAMETERS EXPECTED BY -RENAMEF-
QUAL RENAME
FILE EQU TBINTSV FILE NAME
NFILE EQU TBINTSV+1 DESIRED NEW FILE NAME
FLAG EQU TBINTSV+2 0 FOR -RENAMEF-
FIPADDR EQU TBINTSV+3 ADDRESS OF FIP
QUAL *
* PARAMETERS EXPECTED BY -RETYPEF-
QUAL RETYPE
FILE EQU TBINTSV FILE NAME
TYPE EQU TBINTSV+1 NEW FILE TYPE
FLAG EQU TBINTSV+2 -1 FOR -RETYPEF-
FIPADDR EQU TBINTSV+3 ADDRESS OF FIP
QUAL *
* PARAMETERS EXPECTED BY -FBIT-
QUAL FBIT
FILE EQU TBINTSV
NEWFBIT EQU TBINTSV+1
FIPADDR EQU TBINTSV+3
QUAL *
ENDOV
* /--- BLOCK FIPS 00 000 80/11/26 15.00
EJECT
TITLE FIP CONVERSIONS
** FIELD - MOVE BIT FIELD BETWEEN REGISTERS
*
* FIELD OW,OAS,OR,NLS,NR
*
* ENTRY (OW) = WIDTH OF OLD FIELD
* (OAS) = SHIFT TO RIGHT-JUSTIFY OLD FIELD
* (OR) = X-REGISTER CONTAINING OLD FIELD
* (NOT 0 OR 4)
* (NLS) = LEFT SHIFT TO POSITION NEW FIELD
* (NR) = X-REGISTER TO CONTAIN NEW FIELD
* (NOT 0 OR 4)
*
* USES A - NONE.
* B - 4.
* X - 0, 4.
*
PURGMAC FIELD
MACREF FIELD$
FIELD MACRO OW,OAS,OR,NLS,NR
.0 IFNE OAS,0
SB4 OAS (B4) = SHIFT TO RIGHT-JUSTIFY
.0 ELSE
SB4 B0
.0 ENDIF
AX4 OR,B4 RIGHT-JUSTFY FIELD IN X4
MX0 -OW
BX4 -X0*X4 (X4) = DESIRED FIELD
.1 IFNE NLS,0
LX4 NLS SHIFT TO NEW POSITION
.1 ENDIF
B_NR X4+NR MERGE
ENDM
* /--- BLOCK FIPS 00 000 80/11/26 15.00
EJECT
** NEWFIPV - CONVERT OLD FORMAT FIP TO NEW FORMAT
*
* ENTRY (OVARG1) = ADDRESS OF OLD FIP
* (OVARG2) = ADDRESS OF NEW FIP
*
NEWFIPV OVRLAY
SA1 OVARG1
SA2 OVARG2
SB1 X1 (B1) = ADDR. OF OLD FIP
SB2 X2 (B2) = ADDR. OF NEW FIP
SA1 B1+0 (X1) = FILE NAME
SA2 B1+1 (X2) = PACK NAME
BX6 X1
BX7 X2
SA6 B2+/FIP/FILE
SA7 B2+/FIP/DIR
SA1 B1+2
SA2 B1+3
SX6 MA.READ PRESET TO R/O ACCESS
PL X1,NEWFIP1 --- IF R/O ACCESS
SX6 MA.RW RESET TO R/W ACCESS
NEWFIP1 LX6 /MFF/S.ATTACH
SX4 1 SET OLD DISK SYSTEM FLAG
LX4 /MFF/S.OLD
BX6 X4+X6
FIELD 11,48,X2,/MFF/S.STATN,X6
FIELD 1,59,X2,/MFF/S.FBIT,X6
FIELD 1,58,X1,/MFF/S.FILEF,X6
FIELD 18,0,X1,/MFF/S.AFT,X6
SA6 B2+/FIP/MFF STORE MISC. FIP FIELDS
MX6 0
FIELD 6,30,X2,/FAW/S.FTYPE,X6
SA6 B2+/FIP/FAW STORE FILE ATTRIBUTE WORD
MX6 0
FIELD 6,36,X2,/FIW/S.NDIR,X6
FIELD 6,42,X2,/FIW/S.RMTS,X6
FIELD 6,24,X2,/FIW/S.SIZE,X6
FIELD 9,18,X1,/FIW/S.PACK,X6
FIELD 18,0,X2,/FIW/S.ALLOC,X6
SA6 B2+/FIP/FIW STORE FILE INFORMATION WORD
RETURN
ENDOV
* /--- BLOCK FIPS 00 000 80/11/26 15.13
EJECT
** OLDFIPV - CONVERT NEW FORMAT FIP TO OLD FORMAT
*
* ENTRY (OVARG1) = ADDRESS OF NEW FIP
* (OVARG2) = ADDRESS OF OLD FIP
*
OLDFIPV OVRLAY
SA1 OVARG1
SA2 OVARG2
SB1 X1 (B1) = ADDRESS OF NEW FIP
SB2 X2 (B2) = ADDRESS OF OLD FIP
SA1 B1+/FIP/FILE (X1) = FILE NAME
SA2 B1+/FIP/DIR (X2) = PACK NAME
BX6 X1
BX7 X2
SA6 B2+0
SA7 B2+1
SX6 0 CLEAR UNUSED WORD
SA6 B2+4
RJ =XZFILACC (X1) = -1 IF R/W, 0 IF R/O
MX6 1 (X6) = MASK FOR ACCESS MODE
BX6 X6*X1 (X6) = 1/ACCESS MODE, 59/0
SA1 B1+/FIP/MFF (X1) = MISC. FIP FIELDS
SA2 B1+/FIP/FIW (X2) = FILE INFORMATION WORD
SA3 B1+/FIP/FAW (X3) = FILE ATTRIBUTE WORD
FIELD 1,/MFF/S.FILEF,X1,58,X6
FIELD 9,/FIW/S.PACK,X2,18,X6
FIELD 18,/MFF/S.AFT,X1,0,X6
SA6 B2+2 STORE MISC. GARBAGE
MX6 0
FIELD 1,/MFF/S.FBIT,X1,59,X6
FIELD 11,/MFF/S.STATN,X1,48,X6
FIELD 6,/FIW/S.RMTS,X2,42,X6
FIELD 6,/FIW/S.NDIR,X2,36,X6
FIELD 6,/FAW/S.FTYPE,X3,30,X6
FIELD 6,/FIW/S.SIZE,X2,24,X6
FIELD 18,/FIW/S.ALLOC,X2,0,X6
SA6 B2+3 STORE FIW
RETURN
ENDOV
* /--- BLOCK SYSLOC 00 000 80/11/26 15.13
TITLE -SYSLOC- COMMAND EXECUTION OVERLAY
* -SYSLOC- (CODE=182)
*
* RETURNS ADDRESS OF SYSTEM NAME
*
*
SYSLOCV OVRLAY
NGETVAR (X1) = SYSTEM NAME TO FIND
CALL LJUST,(1R ),0
MX6 -1 MARK INFO BUFFER USED
SA6 JJSTORE
SA2 ASYSLST ADDRESS OF SYSTEM NAME TABLE
BX0 X2
SA4 NSYSNAM LENGTH OF TABLE
SNREAD SB1 X4 SET LENGTH TO READ
SA0 INFO READ TABLE TO INFO BUFFER
SB2 INFOLTH LENGTH OF INFO BUFFER
LE B1,B2,SYSLOX1 --- IF EVERYTHING FITS
SB1 B2 DON'7T READ MORE THAN FITS
SYSLOX1 RE B1
RJ ECSPRTY
MX7 42 MASK FOR NAME PORTION
SA2 A0 GET FIRST ENTRY
EQ SNL1
*
SNLOOK SA2 A2+1 LOAD NEXT NAME
SB2 INFO+INFOLTH END OF BUFFER
SB2 A2-B2 TEST FOR END OF BUFFER
GE B2,SNNEXT PAST END - READ NEXT BUFFER
ZR X2,SYSNOT EXIT IF NAME NOT FOUND
SNL1 BX3 X7*X2 GET NAME ONLY
BX3 X1-X3 ...AND CHECK IF ITS THE ONE
NZ X3,SNLOOK KEEP LOOKING
SX6 X2 MASK OFF ADDRESS
SA6 SSLOC SAVE ADDRESS OF VARIABLE
SA5 A5
LX5 XCODEL
NGETVAR GET SECOND VARIABLE
SA2 SSLOC
BX6 X2 STORE ADDRESS IN 2ND VAR
SA6 A1
SX6 0 *ERROR* = 0 IF ALL OK
SX7 -1 *ZRETURN* = -1
SYSLEX SA6 TERROR
SA7 TRETURN
EQ PROCESS --- EXIT TO NEXT COMMAND
SYSNOT MX6 -1 *ERROR* = -1 IF ERROR
MX7 0 *ZRETURN* = 0 IF ERROR
EQ SYSLEX
*
SNNEXT SX3 INFOLTH BUFFER LENGTH
IX4 X4-X3 TOTAL AMOUNT LEFT
ZR X4,SYSNOT --- IF NOTHING LEFT
NG X4,SYSNOT --- IF LESS THAN NOTHING LEFT
IX0 X0+X3 ADVANCE ECS ADDRESS
EQ SNREAD READ NEXT BUFFER
SSLOC OVDATA ADDRESS OF VARIABLE
ENDOV
* /--- BLOCK DSKCOV 00 000 80/12/02 03.45
TITLE DISK COMMANDS
*
*
*
DSKCOV OVRLAY
SA1 OVARG1
SB1 X1 GET JUMP TABLE INDEX
JP B1+*+1
*
+ EQ * 0 = UNUSED
+ EQ RENAMFX 1 = -RENAMEF- COMMAND
+ EQ RETYPFX 2 = -RETYPEF- COMMAND
+ EQ RENAME1 3 = -SYSFILE- COMMAND RENAME
*
*
* /--- BLOCK RENAMEF 00 000 80/12/02 03.31
TITLE -RENAMEF- AND -RETYPEF- TUTOR COMMANDS
*
*
* RENAMEF
*
* THE 1ST ARGUMENT SPECIFIES THE CURRENT NAME
* OF THE FILE AND THE 2ND ARGUMENT SPECIFIES THE
* NEW NAME FOR THE FILE. THE DISK UNIT AND PACK
* NAME ARE ASSUMED TO BE IN *TDISKU* AND *TPNAME*.
* THE ECS FILE NAME AND INFO TABLES ARE CHANGED
* AND THE PACK DIRECTORY IS THEN WRITTEN BACK ON
* THE DISK.
*
* ON EXIT, *TERROR* IS SET AS FOLLOWS--
* -1 = FILE RENAMED SUCCESSFULLY
* 0 = ERROR--PACK NAME (NO LONGER LOADED)
* 1 = ERROR--OLD FILE NAME (NOT ON PACK)
* 2 = ERROR--NEW FILE NAME (ALREADY EXISTS)
* 3 = ERROR--NEW FILE NAME (IMPROPER NAME)
*
*
* RETYPEF
*
* FIRST ARGUMENT IS FILE NAME TO BE RETYPED.
* SECOND ARGUMENT IS NEW FILE TYPE. MOST CODE
* SHARED WITH RENAMEF, ERROR RETURNS THE SAME
* EXCEPT ERROR = 2 MEANS BAD FILE TYPE
*
*
*
RETYPFX MX6 -1 SET FLAG FOR -RETYPEF-
EQ RENATYP JUMP TO COMMON ROUTINES
*
RENAMFX MX6 0 SET FLAG FOR -RENAMEF-
RENATYP SA6 TBINTSV+2 STORE FLAG
NGETVAR X1 = OLD FILE NAME
BX6 X1
SA6 TBINTSV
SA5 A5 RETRIEVE ORIGINAL COMMAND WORD
LX5 XCODEL
NGETVAR X1 = NEW FILE NAME OR FILE TYPE
BX6 X1
SA6 TBINTSV+1
*
RENAME1 BSS 0
SA1 TDISKU
NG X1,RERR0 NO SETPACK IN EFFECT
SA2 PTYPES+X1 PACK TYPE
SA3 PDTYPES+3 BINARY
BX3 X2-X3
ZR X3,RERR0 ERROR EXIT IF BINARY PACK
CALL SAVLES SAVE COMMON, STORAGE, ETC.
CALL SAVKEY
*
QUEUE ADCTQUE,DACT WAIT IN *DACT* QUEUE
*
* /--- BLOCK RENAMEF 00 000 80/12/02 03.30
*
* INFORM *MASTOR* OF PENDING PACK DIRECTORY CHANGE
*
INTLOK X,I.DDIR,W INTERLOCK DISK DIRECTORIES
CALL S=UDSKR READ DISK SYSTEM PARAMETERS
SA1 TDISKU
MX6 1
SA1 X1+PKSTS SET BIT IN PACK STATUS TABLE TO
BX6 X1+X6 MARK DIRECTORY CHANGE PENDING
SA6 A1
CALL S=UDSKW WRITE DISK SYSTEM PARAMETERS
INTCLR X,I.DDIR
CALL S=UDSK,STATION UPDATE DISK STATUS TABLES
*
REN120 TUTIM -1,,IOKEY WAIT REQUEST COMPLETE
SA1 KEY
SX1 X1-IOKEY CHECK *KEY* = *IOKEY*
NZ X1,REN120
*
CALL MXDSKW FORCE OTHER EXECUTOR TO RECALL
*
* EXECUTE DISK FILE RENAME OVERLAY.
*
SA1 TBINTSV SET UP OVERLAY ARGUMENTS
SA2 TBINTSV+1
BX6 X1
BX7 X2
SA6 OVARG1
SA7 OVARG2
CALL S=UDSKR READ DISK SYSTEM PARAMETERS
*
SA1 TBINTSV+2 GET RENAMEF/RETYPEF FLAG
NG X1,RETYP2 EXEC DIFF OVERLAYS DEP. ON FLAG
*
X RENAMOV -RENAMEF-
SA1 TBINTSV+1 (X1) = NEW FILE NAME
BX6 X1
SA6 TBINTSV OVERWRITE ORIGINAL NAME
EQ RENATY2
*
RETYP2 X RETYPOV -RETYPEF-
*
RENATY2 SA1 TDISKU GET DISK UNIT NUMBER
MX6 1
SA1 X1+PKSTS CLEAR DIRECTORY CHANGE BIT
BX6 -X6*X1
SA6 A1
CALL S=UDSKW WRITE DISK SYSTEM PARAMETERS
CALL MXDSKC RELEASE OTHER EXECUTOR
CALL S=UDSK,0 INFORM *MASTOR*
SA1 TERROR
NG X1,PDWRITE OK -- WRITE PACK DIRECTORY
MX6 0 CLEAR *DACT*
SA6 DACT
REPLAX DACT
CALL RESTKEY
EQ RETPROC TO PROCESS IF ERROR
*
RERR0 SX6 0 BAD PACK
SA6 TERROR
SX6 3
SA6 TRETURN ALSO SET *ZRETURN*
EQ PROCESS ERROR RETURN
*
ENDOV
*
*
* /--- BLOCK NETIO 00 000 78/08/11 21.56
TITLE PLATO NETWORK REQUEST PROCESSING
*
* NETIOV
*
* NETIO REQUEST,RESPONSE (CODE = 107)
*
* REQUEST - 2 WORD REQUEST PACKED FOR -PLF-
* RESPONSE - 2 WORD RESPONSE AREA FOR -PLF- RESPONSE
*
*
* REQUEST PACKET FROM LESSON (E.G. LINKCTL)
* WORD 1 - 04/UNUSED
* 01/NETWORK TYPE(0=DOELZ, 1=3266)
* 01/UNUSED
* 02/EOM(0=EOD, 1=EOB, 2=EOF)
* 04/UNUSED
* 12/UNUSED
* 12/UNUSED
* 12/NET ADDRESS (IF APPLICABLE)
* 12/REQUEST CODE
* WORD 2 - ESTABLISH LINK REQUEST
* 4/NUMBER OF CALL PARAMETERS
* 56/UP TO EIGHT 7 BIT CALL PARAMETERS
* WORD 2 - STORAGE ASSOCIATED REQUESTS
* 12/LENGTH OF STORAGE
* 12/NUMBER OF WORDS OF STORAGE USED
* 12/UNUSED
* 24/RELATIVE STORAGE ADDRESS
*
* REQUEST PACKET SENT TO -PLF-
* WORD 1 - 04/UNUSED
* 01/NETWORK TYPE(0=DOELZ, 1=3266)
* 01/UNUSED
* 02/EOM (EOF, EOB, EOD)
* 04/EXECUTOR NUMBER
* 12/LESSON STATION NUMBER
* 12/NUMBER OF CM WORDS IN REQUEST
* 12/NET ADDRESS (IF APPLICABLE)
* 12/REQUEST CODE
* WORD 2 - ESTABLISH LINK REQUEST
* 4/NUMBER OF CALL PARAMETERS
* 56/UP TO EIGHT 7 BIT CALL PARAMETERS
* WORD 2 - STORAGE ASSOCIATED REQUESTS
* 12/LENGTH OF STORAGE
* 12/NUMBER OF WORDS OF STORAGE USED
* 12/UNUSED
* 24/ABSOLUTE STORAGE ADDRESS
*
* /--- BLOCK NETIO 00 000 78/08/06 22.40
*
* TWO WORD RESPONSE PACKET RETURNED BY -PLF-, THEN
* RETURNED IN -RESPONSE- TO LESSON.
* WORD 1 - 04/UNUSED
* 01/NETWORK TYPE(0=DOELZ, 1=3266)
* 01/UNUSED
* 02/EOM (0=EOD, 1=EOB, 2=EOF)
* 04/EXECUTOR NUMBER
* 12/LESSON STATION NUMBER
* 12/NUMBER OF CM WORDS IN RESPONSE
* 12/NET ADDRESS (IF APPLICABLE)
* 12/RESPONSE CODE
* WORD 2 - ERROR RESPONSE
* 60/ERROR TYPE
* WORD 2 - STORAGE ASSOCIATED RESPONSE
* 12/LENGTH OF STORAGE
* 12/LENGTH OF MESSAGE
* 12/UNUSED
* 24/ABSOLUTE STORAGE ADDRESS
*
*
REQC EQU TBINTSV+9 REQUEST CODE
BORDSV EQU TBINTSV+10 FIXED BUFFER ORDINAL
LSTORSV EQU TBINTSV+11 LESSON STORAGE FWA
NETSTOP EQU TBINTSV+12 1 IF DROP LINK SENT TO PLF
* BECAUSE TIMEOUT OCCURRED OR
* STOP1 WAS PRESSED, OTHERWISE
* SET TO ZERO
RPSAV EQU TBINTSV+13 SAVE -RESPONSE- ADDRESS
STORSAV EQU TBINTSV+14 STORAGE ASSOCIATED FLAG
PLFTIM EQU TBINTSV+15 -PLF- ALIVE TIMER
* /--- BLOCK NETIO 00 000 78/07/13 22.31
NETIOV OVRLAY
*
* * * INITIALIZE STORAGE FLAG TO NO STORAGE
MX6 0
SA6 STORSAV
*
* * * SET TO NO -STOP1- RECEIVED
SA6 NETSTOP
*
* * * SAVE THE CURRENT KEY
SA1 KEY
BX6 X1
SA6 TOKEY
*
* * * GET ADDRESS OF REQUEST
NGETVAR
*
* * * MAKE SURE ALL WORDS ARE IN BOUNDS
SA0 A1
SX1 PTSIZE LENGTH OF NETWORK REQUEST
RJ =XBOUNDS
*
* * * MOVE REQUEST PACKET TO WORK VARIABLES
SA1 A1
BX6 X1
SA6 NETRQ WORD 1
SA1 A1+1
BX6 X1
SA6 NETRQ+1 WORD 2
*
* * * GET -RESPONSE- ADDRESS
SA5 A5
LX5 XCODEL
NGETVAR
*
* * * MAKE SURE -RESPONSE- IS IN BOUNDS
SA0 A1
SX1 PFSIZE LENGTH OF NETWORK RESPONSE
RJ =XBOUNDS
*
* * * SAVE -RESPONSE- ADDRESS IN STUDENT BANK
SX6 A1
SA6 RPSAV
* /--- BLOCK NETIO 00 000 79/01/30 14.57
* SAVE COMMON AND STORAGE INFO.
CALL SAVLES
* TEST IF DOELZ NETWORK SUPPORTED.
SX0 =XPLF
ZR X0,NIOE8 IF NOT SUPPORTED
*
* * * ISOLATE REQUEST CODE
MX0 -RRCM
SA1 NETRQ
BX7 -X0*X1
*
* * * MAKE SURE REQUEST IS IN RANGE
SX1 X7-MAXRQ1-1
PL X1,NIOE1 JUMP IF BAD REQUEST NUMBER
*
* * * PROCESS WORD 2 OF REQUEST IF NECESSARY
SB2 X7
SA7 REQC SAVE REQUEST CODE
JP B2+NETTB
*
* * * JUMP DEPENDING ON WHETHER REQUEST HAS
* * * ASSOCIATED STORAGE. THE -JPTAB- MACRO
* * * IS DEFINED IN -NETTEXT-.
*
NETTB JPTAB JUMP TABLE
JPTAB 0,NIOE1 NEVER USED
JPTAB IATSIM,NIOS INTERACTIVE TRUNK SIMULATION
JPTAB ESTSIM,NIONS ESTABLISH SIMULATION LINK
JPTAB SWRITE,NIOS SELECTIVE WRITE
JPTAB DLDL,NIONS
JPTAB CBST,NIOS CIRCULAR BUFFER STATISTICS
JPTAB ENDP,NIONS END -PLF-
JPTAB DIAG,NIOS DIAGNOSTIC REQUEST
JPTAB DISP,NIONS SET DISPLAY WINDOW
JPTAB ESTT,NIONS ESTABLISH TERMINAL LINK
JPTAB RNWA,NIONS RESERVE NETWORK ADDRESS
JPTAB LDSIM,NIONS LOCAL DISTRIBUTION SIMULATOR
JPTAB PLFSTS,NIOS PLF STATISTICS
JPTAB HHLBA,NIOS HOST TO HOST LOOPBACK
JPTAB ESTI,NIONS ESTABLISH LINK (IA)
JPTAB ESTLB,NIONS ESTABLISH LINK (LOOP)
JPTAB IAP,NIONS INTERACTIVE LINK PAUSE
JPTAB APTS,NIOS PERMISSION TO SEND
JPTAB ADRPL,NIONS DROP LINK
JPTAB ESTR,NIONS ESTABLISH RUNNER STATION
JPTAB DRR,NIONS DROP RUNNER STATION
JPTAB SREAD,NIOS SELECTIVE READ
JPTAB ESTD,NIONS ESTABLISH DATA LINK
JPTAB SENDD,NIOS SEND DATA
JPTAB SNAME,NIOS GET SYSTEM NAME
JPTAB ESTNAM,NIOS NODE AVAILABLE MESSAGES
JPTAB TPLFS,NIOS TEST - STORAGE
JPTAB TPLFNS,NIONS TEST - NO STORAGE
JPTAB MAXRQ1 END OF JUMP TABLE
* /--- BLOCK NETIO 00 000 79/03/08 00.15
*
* * * GET STORAGE INFO FOR THIS STATION
NIOS SA1 TBXSTOR
RJ =XSETSTOR SET UP *STORWRD*
*
* * * GET STORAGE LENGTH FROM REQUEST
MX0 ECLM
SA1 NETRQ+1
BX3 X0*X1
LX3 ECLS
ZR X3,NIOE2 JUMP IF BAD STORAGE LENGTH
*
* * * GET STORAGE ADDRESS FROM REQUEST
MX0 -ECAM
BX2 -X0*X1
BX6 X0*X1 CLEAR OLD ECS ADDR. AND SAVE
SX4 1
IX2 X2-X4
NG X2,NIOE3 JUMP IF BAD STORAGE ADDRESS
*
* * * GET LENGTH OF STORAGE FOR THIS STATION
SA4 STORWRD
AX4 18 POSITION LENGTH TO BOTTOM
SX1 X4
*
* * * CHECK STORAGE BOUNDS
IX1 X1-X3 SUBTRACT STORAGE LENGTH
IX1 X1-X2 SUBTRACT STORAGE START
NG X1,NIOE4 JUMP IF OUT OF RANGE
*
* * * CALCULATE ABSOLUTE STORAGE ADDRESS
AX4 18 STARTING ADDR. FROM -STORWRD-
IX4 X4+X2
*
* * * MERGE WITH STORAGE LENGTH AND DATA LENGTH
BX6 X4+X6
SA6 NETRQ+1
*
* * * SET FLAG TO INDICATE STORAGE ASSOCIATED REQUEST
MX6 -1
SA6 STORSAV
*
* * * LOCK THE STORAGE
CALL IOLESSN,TBXSTOR,4000B
RJ NETIOF MOVE TO FIXED BUFFER
PL X6,NETIOX IF ERRORS
* SAVE PLF TIMER, FOR TIME OUT.
NIONS SA0 PLFTIM
SA1 APLFCLK
BX0 X1
RE 1
RJ ECSPRTY
*
* * * PUT NEW REQUEST INTO -TO PLF- BUFFER
SX6 NETRQ SET -PUTPLF- ARGUMENTS
SX7 PTSIZE
SA6 OVARG1
SA7 OVARG2
X PUTPLF CALL PUTPLF
SA1 OVRET1 PICK UP RETURN ARGUMENT
NG X1,NIOE5 JUMP IF NO ROOM
* /--- BLOCK NETIO 00 000 80/07/21 21.54
EQ NETIO3 WAIT FOR RESPONSE FROM PLF
* CHECK FOR PLF NOT RUNNING.
NETIO1 SA3 PLFTIM (X3) = LAST PLF TIME
SA0 A3
SA2 APLFCLK ECS ADDRESS OF PLF CLOCK
BX0 X2
RE 1 READ CURRENT VALUE OF CLOCK
RJ ECSPRTY
*
* * * COMPARE OLD AND NEW CLOCK VALUES.
SA2 A0
IX2 X2-X3
ZR X2,NIOE6 JUMP IF PLF IS NOT RUNNING.
* WAIT FOR RESPONSE FROM PLF.
NETIO3 TUTIM PLFPTL,,ANYKEY
CALL DETUTIM DELETE TUTIM TIMING REQUEST
*
SA1 KEY
SX2 X1-TUTUP
ZR X2,NETIO1 IF -TUTUP- TIMING KEY
SX2 X1-NETKEY CHECK FOR -NETKEY-
ZR X2,NIONK JUMP IF -NETKEY-
*
* * * CHECK FOR -STOP1- KEY.
* (X1) = CURRENT KEY.
SX2 X1-STOP1
NZ X2,NETIO3 IF NOT -STOP1- KEY
*
* * * HAS -STOP1- BEEN PRESSED BEFORE.
SA1 NETSTOP
NZ X1,NETIO3 IF -STOP1- ALREADY PRESSED
*
* * * SEND DROP LINK TO PLF.
SX6 NIODRPL SET -PUTPLF- ARGUMENTS
SX7 PTSIZE
SA6 OVARG1
SA7 OVARG2
X PUTPLF CALL PUTPLF
SA1 OVRET1 PICK UP RETURN ARGUMENT
NG X1,NETIO3 LOOP IF BUFFER FULL
*
* * * SET THE -STOP1- FLAG.
SX6 1
SA6 NETSTOP
EQ NETIO3 WAIT FOR RESPONSE FROM PLF
* MOVE RESPONSE TO LESSON RESPONSE WORDS.
NIONK SA1 RPSAV ADDRESS OF -RESPONSE-
SA2 NETRP FIRST WORD OF RESPONSE
BX7 X2
SA7 X1 STORE FIRST WORD
SA2 NETRP+1 SECOND WORD OF RESPONSE
BX6 X2
SA6 X1+1 STORE SECOND WORD
* TEST FOR -PLF- ERROR RESPONSE.
MX0 -RRCM
BX0 -X0*X7
SX0 X0-ERMC
ZR X0,NIOE7 IF -PLF- ERROR RESPONSE
*
* * * SET ERROR RETURN IF DROP LINK SENT
SA1 NETSTOP
NZ X1,NIOE6
*
* * * SET FOR NORMAL RETURN
MX6 -1
EQ NETIOX
* /--- BLOCK NETIO 00 000 78/10/27 13.48
*
* * * ERROR --REQUEST NUMBER OUT OF RANGE
NIOE1 BSS 0
SX6 1
EQ NETIOX
*
* * * ERROR -- STORAGE LENGTH IS ZERO
NIOE2 BSS 0
SX6 2
EQ NETIOX
*
* * * ERROR -- STORAGE ADDRESS IS ZERO
NIOE3 BSS 0
SX6 3
EQ NETIOX
*
* * * ERROR -- STORAGE OUT OF BOUNDS
NIOE4 BSS 0
SX6 4
EQ NETIOX
*
* * * ERROR -- PLF REQUEST BUFFER IS FULL
NIOE5 BSS 0
SX6 5
EQ NETIOX
*
* * * ERROR -- NO PLF RESPONSE
NIOE6 BSS 0
SX6 6
EQ NETIOX
* ERROR RESPONSE RECEIVED FROM -PLF-.
NIOE7 SX6 7
EQ NETIOX
* ERROR - DOELZ NETWORK NOT SUPPORTED.
NIOE8 SX6 8
EQ NETIOX
*
* * * SET RETURN CODE
NETIOX SA6 TRETURN
*
* * * STORAGE ASSOCIATED WITH THIS REQUEST/RESPONSE
SA1 STORSAV
ZR X1,NETIO2 JUMP IF NOT
PL X6,NETIOX1 IF ERROR ALREADY DETECTED
SA1 REQC CHECK REQUEST CODE
SX1 X1-DIAG CHECK FOR *DIAG* REQUEST
ZR X1,NETIOX1 IF *DIAG* DO NOT WRITE STORAGE
RJ NETIOT MOVE FROM FIXED BUFFER
SA6 TRETURN SET ERROR RETURN
NETIOX1 RJ NETIOR RELEASE FIXED BUFFER
*
* * * UNLOCK STORAGE BUFFER
CALL IOLESSN,TBXSTOR,-4000B
* RESTORE LESSON AND COMMON/STORAGE POINTERS.
NETIO2 CALL RESTLES
* RESTORE *KEY*.
SA1 TOKEY
BX6 X1
SA6 KEY
EQ CKPROC
*
NIODRPL VFD 60/ADRPL NETWORK DROP LINK REQUEST
VFD 60/0
* /--- BLOCK NETIOF 00 000 78/09/15 01.19
SPACE 4,10
** NETIOF - TEMPORARY NETIO ROUTINE.
*
* MOVE DATA FROM LESSON STORAGE TO A FIXED -NETIO-
* ECS BUFFER AND ALTER PLF REQUEST TO USE THIS FIXED
* ECS STORAGE BUFFER. THIS PROTECTS PLATO FROM PLF
* ERRORS DURING DEBUGGING, BECAUSE PLFS FLX CONTAINS
* THESE FIXED BUFFERS.
*
* ENTRY (NETRQ+1) = LESSON STORAGE FWA AND LENGTH.
*
* EXIT (X6) = -1, IF NO ERRORS.
* (X6) = 96, IF DATA LENGTH TOO LONG.
* (X6) = 99, IF FIXED BUFFER NOT AVAILABLE.
* (X6) = 100, IF LESSON STORAGE TOO LONG.
* (NETRQ+1) = FIXED BUFFER FWA AND LENGTH.
* (BORDSV) = FIXED BUFFER ORDINAL.
*
* USES X - 0,1,2,3,4,6,7.
* A - 0,1,4,7.
* B - 1,2,3.
*
* CALLS INTLOKW,INTCLR
NETIOF PS ENTRY/EXIT
* SET TO NO BUFFER ALLOCATED.
MX6 -1
SA6 BORDSV
* TEST STORAGE LENGTH.
SA4 NETRQ+1
MX3 ECLM
BX1 X4*X3
LX1 ECLS
SX3 X1-NETIOBL-1
SX6 100 SET LENGTH ERROR
PL X3,NETIOF RETURN IF STORAGE TOO LONG
SB2 X1 SAVE THE LENGTH
* TEST DATA LENGTH
MX3 EDLM
LX3 60-EDLS+EDLM
BX2 X4*X3
LX2 EDLS
IX3 X1-X2 STORAGE LTH - DATA LTH
SX6 96 SET DATA LENGTH ERROR
NG X3,NETIOF RETURN IF DATA LTH .GT. STORAGE
* ALLOCATE A FIXED BUFFER.
INTLOK X,I.PLFT,W INTERLOCK THE BUFFER BITS
SA1 ANETBB GET BUFFER BITS ECS ADDRESS
RX3 X1 READ BUFFER BITS FROM ECS
NX2 X3
ZR X2,NETIOF1 RETURN, IF NO BUFFERS
UX2,B1 X2 GET BUFFER ORDINAL IN *B1*
SX7 B1 SAVE BUFFER ORDINAL
SA7 BORDSV
MX6 -1 CLEAR BUFFER BIT
SB3 =XNNIOB-48
SB1 B1-B3
LX6 B1
BX6 X3*X6
WX6 X1 REPLACE BUFFER BITS
INTCLR X,I.PLFT UNLOCK BUFFER BITS
* /--- BLOCK NETIOF 00 000 78/10/27 16.49
* COMPUTE FIXED BUFFER FWA.
SX2 NETIOBL BUFFER LENGTH
IX7 X7*X2 OFFSET TO NEXT BUFFER
SA1 ANETBF ECS FWA OF BUFFERS
IX2 X1+X7 FWA OF THIS BUFFER
* SAVE LESSON STORAGE FWA.
MX6 -ECAM
BX7 -X6*X4 LESSON STORAGE ECS FWA
SA7 LSTORSV
* MOVE LESSON STORAGE TO FIXED BUFFER.
BX0 X7
SA0 WORK
+ RE B2
RJ =XECSPRTY ANALYZE ECS ERROR
BX0 X2
+ WE B2
RJ =XECSPRTY ANALYZE ECS ERROR
* REPLACE LESSON STORAGE FWA WITH FIXED BUFFER
* FWA IN THE REQUEST.
BX6 X4*X6 CLEAR ECS FWA
BX6 X0+X6 INSERT FIXED BUFFER FWA
SA6 NETRQ+1
* SET TO NO ERRORS AND RETURN.
SX6 -1
EQ NETIOF RETURN
NETIOF1 INTCLR X,I.PLFT UNLOCK BUFFER BITS
SX6 99 SET NO BUFFER ERROR
EQ NETIOF RETURN
* /--- BLOCK NETIOT 00 000 78/08/11 01.27
SPACE 4,10
** NETIOT - TEMPORARY NETIO ROUTINE.
*
* MOVE DATA FROM A FIXED -NETIO- BUFFER TO LESSON
* STORAGE BUFFER AND ALTER PLF RESPONSE TO USE THE
* LESSON BUFFER ADDRESS. THIS PROTECTS PLATO FROM
* PLF ERRORS DURING DEBUGGING, BECAUSE PLFS FLX
* CONTAINS THESE FIXED BUFFERS.
*
* ENTRY (RPSAV) = FWA OF RESPONSE.
*
* EXIT (X6) = -1, IF NO ERRORS.
* (X6) = 98, IF STORAGE BUFFER ERROR.
* (X6) = 97, IF PLF MESSAGE TOO LONG.
* ((RPSAV)+1) = STORAGE LENGTH, MESSAGE
* LENGTH, LESSON STORAGE FWA.
*
* USES X - 0,1,2,3,4,6,7.
* A - 0,1,4,6.
* B - 1,2.
*
* CALLS INTLOKW,INTCLR,SETSTOR.
NETIOT PS ENTRY/EXIT
* CHECK THAT LESSON STORAGE FWA IS .LE. THE SAVED
* STORAGE FWA.
SA1 TBXSTOR
RJ =XSETSTOR GET LESSON STORAGE INFORMATION
SA1 STORWRD
AX1 18
SX4 X1 SAVE LESSON STORAGE LENGTH
AX1 18 GET LESSON STORAGE FWA
SA2 LSTORSV SAVED STORAGE FWA
* /--- BLOCK NETIOT 00 000 78/08/11 02.47
IX3 X2-X1
SX6 98 SET STORAGE BUFFER ERROR
NG X3,NETIOT RETURN IF STORAGE BUFFER ERROR
* CHECK THAT MESSAGE WILL NOT OVERFLOW LESSON
* STORAGE.
IX1 X1+X4 LESSON STORAGE LWA
SA3 RPSAV GET PLF MESSAGE LENGTH
SA3 X3+1
MX6 -EDLM
LX3 EDLS
BX7 -X6*X3 ISOLATE MESSAGE LENGTH
SB1 X7 SAVE MESSAGE LENGTH
IX1 X1-X7 LWA - MESSAGE LENGTH
IX1 X1-X2
SX6 97 SET MESSAGE LENGTH ERROR
NG X1,NETIOT RETURN IF MESSAGE TOO LONG
* MOVE MESSAGE FROM FIXED -NETIO- BUFFER TO
* LESSON STORAGE.
LX3 60-EDLS ISOLATE PLF STORAGE FWA
MX6 -ECAM
BX4 -X6*X3
BX0 X4
SA0 WORK
+ RE B1
RJ =XECSPRTY ANALYZE ECS ERROR
BX0 X2
+ WE B1
RJ =XECSPRTY ANALYZE ECS ERROR
* REPLACE PLF ECS FWA WITH LESSON STORAGE FWA IN
* RESPONSE.
BX3 X3*X6 CLEAR ECS FWA FILED
BX6 X3+X0 INSERT LESSON STORAGE FWA
SA6 A3
* /--- BLOCK NETIOT 00 000 78/09/15 01.20
MX6 -1 SET NO ERRORS
EQ NETIOT RETURN
SPACE 4,10
** NETIOR - RELEASE FIXED -NETIO- BUFFER.
*
* ENTRY (BORDSV) = FIXED BUFFER ORDINAL.
*
* EXIT NONE.
*
* USES X - 0,1,2,6.
* A - 0,1,2,6.
* B - 2,3.
*
* CALLS INTLOKW,INTCLR.
NETIOR PS ENTRY/EXIT
SA1 BORDSV
NG X1,NETIOR RETURN IF NO BUFFER ALLOCATED
SB2 X1 BUFFER ORDINAL
INTLOK X,I.PLFT,W INTERLOCK BUFFER BITS
SA1 ANETBB
RX2 X1 READ BUFFER BITS
MX6 -1
SB3 =XNNIOB-48
SB2 B2-B3
LX6 B2
BX6 -X6+X2 SET BUFFER BIT
WX6 X1 WRITE BUFFER BITS
INTCLR X,I.PLFT REMOVE INTERLOCK
EQ NETIOR RETURN
* /--- BLOCK END NETIO 00 000 78/08/11 21.56
ENDOV
* /--- BLOCK PUTPLF 00 000 79/03/08 00.47
TITLE PUT PLF REQUEST
*
* * * PUTPLF
*
* ENTRY (OVARG1) = ADDRESS OF REQUEST
* (OVARG2) = LENGTH OF REQUEST
*
* EXIT (OVRET1) = -(REQUEST LENGTH) IF NO ROOM
*
* FORMAT OF REQUEST HEADER-
* 06/UNUSED
* 02/EOM TYPE
* 04/UNUSED
* 12/STATION
* 12/NUMBER OF CM WORDS IN REQUEST
* 12/SEQUENCE NUMBER
* 12/REQUEST TYPE
*
PUTPLF OVRLAY
* TEST IF DOELZ NETWORK SUPPORTED.
SX6 =XPLF
ZR X6,PPLF7 IF NOT SUPPORTED
* UPDATE SEQUENCE NUMBER.
SA1 NETSEQ
SX6 X1+1
MX0 -12
BX6 -X0*X6
SA6 A1+
* INSERT STATION, LENGTH AND SEQUENCE IN REQUEST.
SA1 STATION
SA2 OVARG1
SB2 X2 (B2) = REQUEST FWA
SA2 B2 (X2) = REQUEST WORD 0
SA4 OVARG2 (X4) = REQUEST LENGTH
SB3 X4 (B3) = REQUEST LENGTH
MX0 36
LX1 36 POSTION STATION
LX4 24 POSITION LENGTH
LX6 12 POSITION SEQUENCE
LX0 47-59 POSITION MASK
BX2 -X0*X2 CLEAR FIELDS
BX6 X2+X6 MERGE SEQUENCE
BX6 X1+X6 MERGE STATION
BX6 X4+X6 MERGE LENGTH
SA6 B2+
*
* * * INTERLOCK -TO PLF- BUFFER
INTLOK X,I.PLFT,W
*
* * * GET BUFFER ADDRESS. SAVE IN X4.
SA1 APLFTO GET BUFFER LENGTH / FWA WORD
MX0 -ECAM ISOLATE FWA IN X4
BX4 -X0*X1 ** X4 = BUFFER FWA **
*
* * * GET BUFFER LENGTH. SAVE IN B4
MX0 -BFLM ISOLATE LENGTH IN X1
LX1 BFLS
BX1 -X0*X1
SB4 X1 ** B4 = BUFFER LENGTH **
*
* * * GET BUFFER IN AND OUT POINTERS FROM ECS.
SA2 APTIN ECS ADDRESS OF POINTERS
BX0 X2
SA0 NETPTRS
+ RE 2
RJ =XECSPRTY ANALYZE ECS ERROR
*
* * * COMPUTE FREE SPACE IN BUFFER.
*
* IF (IN < OUT)
* FREE SPACE = OUT - IN - 1
* ELSE
* FREE SPACE = (BUFFER LENGTH - IN) + (OUT - 1)
* ENDIF
* /--- BLOCK PUTPLF 00 000 79/03/08 00.47
SA2 A0 ** X2 = IN **
SA3 A0+1 GET OUT POINTER
IX0 X2-X3 (IN - OUT)
BX1 -X0 (OUT - IN)
SB6 X1-1 FREE SPACE IF IN < OUT
NG X0,PPLF2 IF IN < OUT
SB6 B6+B4 FREE SPACE IF IN .GE. OUT
PPLF2 BSS 0
LT B6,B3,PPLF5 IF NOT ENOUGH FREE SPACE
* /--- BLOCK PUTPLF 00 000 79/04/18 00.07
*
* * * COMPUTE THE NEW IN POINTER VALUE. SAVE IN B6.
*
* T = IN + MESSAGE LENGTH
* IF (T < BUFFER LENGTH)
* NEW IN = T
* ELSE
* NEW IN = T - BUFFER LENGTH
* ENDIF
SB6 X2+B3 NEW IN IF NO WRAP AROUND
LT B6,B4,PPLF3 JUMP IF NO WRAP AROUND
SB6 B4-B6 NEW IN IF WRAP AROUND
*
* * * WRAP AROUND, SO MESSAGE MUST BE WRITTEN IN
* TWO PARTS.
SA0 B2 (MESSAGE FWA)
SB1 X2 IN
SB1 B4-B1 BUFFER LTH - IN
IX0 X4+X2 (BUFFER FWA + IN)
+ WE B1
RJ =XECSPRTY ANALYZE ECS ERROR
*
* * * SECOND PART.
SA0 B2+B1 (MESSAGE FWA + 1ST PART LENGTH)
BX0 X4 (BUFFER FWA)
+ WE B6
RJ =XECSPRTY ANAYZE ECS ERROR
EQ PPLF4 UPDATE IN POINTER
*
* * * WRITE MESSAGE IN ONE PART.
PPLF3 BSS 0
SA0 B2 MESSAGE FWA
IX0 X2+X4 (IN + BUFFER FWA)
+ WE B3
RJ =XECSPRTY ANALYZE ECS ERROR
*
* * * UPDATE IN POINTER.
PPLF4 SX6 B6 PLACE POINTER IN CM
SA1 APTIN GET IN POINTER ECS ADDRESS
WX6 X1
EQ PPLF6
*
* * * ERROR -- NO ROOM IN BUFFER
PPLF5 BSS 0
SB3 -B3
*
* * * CLEAR -PLF- BUFFER INTERLOCK
PPLF6 BSS 0
INTCLR X,I.PLFT
SX6 B3 SET RETURN WITH ERROR
SA6 OVRET1
PPLF7 RETURN RETURN FROM THIS OVERLAY
* /--- BLOCK END PUTPLF 00 000 79/03/07 19.15
ENDOV
* /--- BLOCK DRPLINK 00 000 79/04/18 00.02
TITLE DROP LINK
*
* * * DRPLINK
*
* THIS ROUTINE IS CALLED TO CHECK TO SEE IF A STATION
* IS ON THE DOELZ NETWORK LINK, AND IF SO, SEND A DROP
* LINK REQUEST TO PLF.
*
*
DRPLINK OVRLAY
*
* CHECK TO SEE IF THIS SYSTEM HAS A DOELZ NETWORK
*
SX1 =XPLF
ZR X1,DLEXIT IF DOELZ NOT SUPPORTED
*
* CHECK TO SEE IF THE STATION IS A REMOTE DOELZ STATION
*
SA1 STATION GET THE STATION NUMBER
SX2 RNETSF GET FIRST REMOTE DOELZ STATION
IX3 X1-X2
NG X3,LDLZ BRANCH IF NOT A REMOTE STATION
*
SX2 RNETSN GET NUMBER OF REMOTE STATIONS
IX3 X3-X2
PL X3,LDLZ IF NOT A REMOTE STATION
SX6 ADRPL REMOTE DROP LINK REQUEST CODE
EQ DROPL SEND REQUEST TO PLF
*
* CHECK TO SEE IF THE STATION IS A LOCAL DOELZ STATION
*
LDLZ BSS 0
SX2 LNETSF GET FIRST LOCAL DOELZ STATION
IX3 X1-X2
NG X3,DLEXIT EXIT IF NOT A LOCAL STATION
*
SX2 LNETSF GET NUMBER OF LOCAL STATIONS
IX3 X3-X2
PL X3,DLEXIT IF NOT A LOCAL STATION
SX6 DLDL LOCAL DROP LINK REQUEST CODE
*
* SEND A DROP LINK REQUEST TO PLF (X6) = REQUEST CODE.
*
DROPL BSS 0
SA6 NIODROP SET PLF REQUEST CODE
SX6 NIODROP SET -PUTPLF- ARGUMENTS
SX7 PTSIZE
SA6 OVARG1
SA7 OVARG2
X PUTPLF CALL PUTPLF
*
DLEXIT RETURN EXIT DRPLINK
*
NIODROP BSSZ 2 DROP LINK REQUEST
*
ENDOV
* /--- BLOCK END 00 000 76/07/21 20.27
*
*
OVTABLE
*
*
END EXEC4$