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$