DISKFIO
* /--- FILE TYPE = E
* /--- BLOCK IDENT 00 000 77/11/14 19.46
IDENT DISKFIO
TITLE VARIOUS DISK FILE I/O COMMANDS
*
* GET COMMON SYMBOL TABLE
*
CST
*CALL PLASFIP
*
* /--- BLOCK EXTERNAL 00 000 80/05/18 16.30
EXT LOADOV,WHATSIN
EXT SYSTEST
EXT ERXUNUS
EXT GETARGS
EXT ECSPRTY
EXT PROCESS,ECSPRTY,CKPROC,NGETVAR,RETPROC
EXT ERXROLC WRITING READ-ONLY COMMON
EXT ERXRAT NAMESET INTERNAL ERROR
EXT ERXBREC
EXT ERXOPEN
ENTRY ZWKBUFF
ZWKBUFF EQU TBINTSV FOR PASSING NEW -ATTACH- FIPS
*
* /--- BLOCK ATTPAUS 00 000 79/08/05 01.46
*
** -ATTPAUS- SUBROUTINE (INTERRUPTABLE)
**
** INCREMENTS BAD -ATTACH- COUNTER AND PAUSES TO
** HINDER THEFT OF CODEWORDS AND COMPILATION OF
** LESSON NAMES
*
* THIS PAUSE IS SKIPPED IN FINISH UNITS BUT THE
* BAD-ATTACH COUNTER IS INCREMENTED TO PREVENT USE
* USE TO SEARCH FOR FILES.
* THE PAUSE CANNOT BE USED IN FINISH UNITS WHEN A
* BAD ATTACH IS IN A TIGHT LOOP WITH NO EXIT. THIS
* WILL CAUSE THE TERMINAL TO HANG UP SINCE THERE ARE
* ENOUGH PAUSES TO KEEP TIPS LOW AND THERE WILL BE
* NO AUTO-BREAK TO KICK THE USER OUT.
**
** SHOULD BE CALLED WHEN -ATTACH- FAILS
**
** ASSUMES THAT COMMON, STORAGE, KEY, ETC. HAVE
** ALREADY BEEN SAVED AND THAT ALL INTERLOCKS HAVE
** BEEN CLEARED
**
** EXIT ADDRESS IS STORED IN (TBINTSV+4), WHICH IS
** USED BY -ATTACH- TO STORE THE CODEWORD ARGUMENT
** AND NO LONGER NEEDED (FOR OBVIOUS REASONS)
** BY THE TIME THIS ROUTINE IS EXECUTED
**
** DOES NOT RETURN IF STOP1 PRESSED
*
* /--- BLOCK ATTPAUS 00 000 79/09/02 21.42
ENTRY ATTPAUS
*
ATTPAUS EQ *
*
SA1 LESSCM+LSTOUSE CHECK IF SYSTEM LESSON
NG X1,ATTPAUS --- EXIT IF SYSTEM LESSON
*
SA1 TRETURN X1 = *ZRETURN*
ZR X1,ATTPAUS1 --- BRIF IF 0 (NO SUCH FILE)
*
SX1 X1-1 CHECK IF 1 (CODEWORD ERROR)
NZ X1,ATTPAUS --- EXIT IF NOT CODEWORD ERROR
*
ATTPAUS1 SA1 ATTPAUS SAVE EXIT ADDRESS
BX6 X1
SA6 RETADDR
*
SA1 TBADATT X1 = BAD -ATTACH- COUNTER
SX6 X1+1 INCREMENT COUNT
SA6 A1 UPDATE COUNT
AX1 18 SHIFT TIME TO POSITION
*
SB1 50 B1 = 50 MSEC MINIMUM PENALTY
SX2 X6-101 100 FREE BAD -ATTACH-ES
NG X2,ATTPAUS3 --- BRIF <= 100
*
SX2 X6-100 X2 = NO. OVER LIMIT
SX3 25 X2 = MSEC PAUSE/BAD -ATTACH-
IX2 X2*X3 X2 = LENGTH OF PAUSE
SX3 60000 X3 = MAXIMUM PAUSE
IX3 X3-X2 SEE IF PAUSE TOO LARGE
PL X3,ATTPAUS2 --- BRIF NOT TOO LARGE
SX2 60000 ADJUST
ATTPAUS2 IX1 X1+X2 X1 = TIME WHEN PAUSE SHOULD END
SA2 SYSCLOK X2 = CURRENT MSEC CLOCK TIME
IX1 X1-X2 CHECK IF ENUF TIME PASSED
NG X1,ATTPAUS3 --- BRIF ENUF TIME PASSED
SB1 B1+X1 ADD DIFFERENCE TO MINIMUM
*
ATTPAUS3 FINISH ATTPAUS4 IF IN FINISH UNIT
TUTIM B1,,,ALLOW PAUSE TO KEEP '7EM HONEST
*
ATTPAUS4 BSS 0
SA1 TBADATT X1 = BAD -ATTACH- COUNTER
MX0 -18 X0 = MASK FOR NO. OF BAD ONES
BX1 -X0*X1 X1 = NO. OF BAD -ATTACH-ES
SA2 SYSCLOK X2 = CURRENT MSEC CLOCK TIME
LX2 18 SHIFT TO POSITION
BX6 X1+X2 MERGE TIME AND COUNT
SA6 A1 UPDATE COUNTER
*
STOPCHK --- EXIT IF STOP1 PRESSED
*
EQ RETADDR --- RETURN
*
RETADDR EQU TBINTSV+4 STORE EXIT ADDR IN SAME PLACE
* /--- BLOCK PARAMETERS 00 000 77/12/16 23.02
TITLE VARIOUS DATA NEEDED FOR DISKFIO ROUTINES
*
* INACTIVE FILE TABLE EQUATES
*
IACTFWA VFD 60/TIFFWA INACTIVE FILE TABLE FWA
IACTLTH VFD 60/TIFLTH LENGTH OF INACTIVE FILE TABLE
IACTWPF EQU TWPF WORDS PER FILE ENTRY
*
* TEMPLATE LESSON BUFFER NAMES
*
ENTRY TUTNODE
TUTNODE BSSZ 2
DATA 10LTUTOR NODE
+ VFD 12/10,48/0
ENTRY IOBNAME
IOBNAME DATA 0
DATA 10LTUTOR FILE
DATA 10LI/O BUFFER
+ VFD 12/1,48/0
*
* LESSON DIRECTORY STRUCTURE
*
LFNAME EQU INFO+0
LTYPE EQU INFO+1
LBLOCKS EQU INFO+2
EXTRAI EQU INFO+4
LBINF0 EQU INFO+64
LBNAM0 EQU INFO+192
*
**
* /--- BLOCK ACTF 00 000 78/02/03 13.07
TITLE -ACTF- ACTIVATE FILE IF IN INACTIVE TABLE
*
* -ACTF-
*
* ACTIVATE THE GIVEN FILE. IF IT IS ALREADY
* ACTIVE, SIMPLY EXIT. IF IT IS INACTIVE, SWAP
* IT WITH THE ACTIVE FILE. IF IT IS NEITHER
* ACTIVE NOR INACTIVE, THEN TAKE AN ERROR EXIT.
*
* ON ENTRY -- B1 = ADDRESS OF ACCOUNT';FILE NAME
* EXIT -- X7 = 0 IF FILE IS NOW OPEN/ACTIVE
* -1 IF FILE IS NOT OPEN
*
ENTRY ACTF
ACTF EQ *
RJ =XFSQUISH (X1) = ONE-WORD NAME
*
* SEE IF FILE IS CURRENTLY ACTIVE
*
SA2 TAFNAME CURRENTLY ACTIVE FILE NAME
BX7 X1-X2 COMPARE THE TWO NAMES
NG X7,ACTF1 IF NO MATCH (BEWARE OF -0)
ZR X7,ACTF --- EXIT IF FILE ACTIVE
*
* SEARCH THE INACTIVE TABLE FOR THE DESIRED FILE
*
ACTF1 SA2 IACTLTH READ LENGTH OF TABLE
SB3 X2 TRANSFER TO B3
SA2 IACTFWA TABLE FWA
SA2 X2 PLACE ADDRESS IN A2
SB2 IACTWPF NO. OF WORDS PER FILE ENTRY
MX7 -1 PRESET FOR ERROR EXIT
IACTLP SB3 B3-1 DECREMENT NUMBER TO SEARCH
NG B3,ACTF --- EXIT IF FILE NOT OPEN
BX6 X1-X2 COMPARE THE TWO FILE NAMES
ZR X6,IACTFND --- BRIF INACTIVE FILE FOUND
SA2 A2+B2 INCREMENT TO NEXT ENTRY
EQ IACTLP --- LOOP ON NEXT TABLE ENTRY
*
* INACTIVE FILE FOUND -- SWAP WITH ACTIVE FILE AND EXIT
*
IACTFND SB1 1 B1 = 1
SA1 TAFNAME FWA OF OPEN FILE BUFFER
SWAPLP SB2 B2-B1 ONE LESS WORD TO SWAP
NG B2,IACTZN --- BRIF DONE SWAPPING
BX6 X1
BX7 X2
SA6 A2
SA7 A1
SA1 A1+B1 LOOK AT NEXT WORDS IN BOTH
SA2 A2+B1
EQ SWAPLP --- LOOP AND SWAP ANOTHER
*
* CLEAR OUT THE CURRENTLY SELECTED NAME
*
IACTZN CALL CHRMOVE,NONAME,TRECNAM,MAXNCHR
MX7 0 FLAG FILE OPEN AND ACTIVE
EQ ACTF --- EXIT TO CALLER
*
**
* /--- BLOCK NEWACTF 00 000 77/12/04 21.03
TITLE -NEWACTF- ASSIGN NEW FILE AS ACTIVE FILE
*
* -NEWACTF-
*
* DESIGNATES A FILE AS THE NEW ACTIVE FILE WHILE
* PLACING THE PRESENT ACTIVE FILE INTO THE INACTIVE
* TABLE. ENTER WITH B1 POINTING TO A *IACTWPF* WORD
* PACKAGE CONTAINING FILE INFORMATION OF THE CORRECT
* FORMAT. ON EXIT, THE PACKAGE WILL HAVE BEEN
* COPIED OVER TO THE ACTIVE FILE PACKAGE IN THE
* STUDENT BANK. IF NO SPACE IS LEFT IN THE
* INACTIVE TABLE, THE CURRENTLY ACTIVE FILE
* WILL BE CLOSED TO MAKE ROOM FOR THE NEW ONE.
*
* ENTRY (ZWKBUFF - ZWKBUFF+2) = NEW FIP.
*
* *SAVLES* IS ASSUMED TO BE CALLED ON ENTRY.
*
ENTRY NEWACTF
NEWACTF EQ *
LINK NEWACTF
*
* SEE IF NO FILE CURRENTLY ACTIVE
*
SB1 ZWKBUFF (B1) = BUFFER FWA
SA1 TAFNAME CURRENTLY ACTIVE FILE NAME
BX7 X1
NG X7,NACTSRCH IF FILE IS ACTIVE
ZR X7,NACTFAKE --- SIMPLY ACTIVATE USER FIP
*
* SEARCH THE INACTIVE TABLE FOR A CLEAR SLOT
*
NACTSRCH SA2 IACTLTH GET LENGTH OF IACT TABLE
SB3 X2 TRANSFER TO B3
SA2 IACTFWA READ ADDRESS OF IACT TABLE
SA2 X2 READ ADDRESS TO A2
SB2 IACTWPF NO. OF WORDS PER FILE ENTRY
NACTLP SB3 B3-1 DECREMENT NUMBER TO SEARCH
NG B3,IACTOVF --- IACT TABLE FULL
NG X2,NACTLP1 IF SLOT IN USE
ZR X2,NACTFND --- BRIF INACTIVE 0 SLOT FOUND
NACTLP1 SA2 A2+B2 INCREMENT TO NEXT ENTRY
EQ NACTLP --- LOOP ON NEXT TABLE ENTRY
*
* CLEAR SLOT FOUND -- INSERT ACTIVE/INACTIVE FILES AND EXIT
*
* (A2) = FAW OF INACTIVE SLOT TO RECEIVE ACTIVE FIP
* (B1) = FWA OF FIP TO PLACE IN ACTIVE SLOT
NACTFND SB3 1 B3 = 1
SA1 TAFNAME FWA OF OPEN FILE BUFFER
SA3 B1 FWA OF USER FILE BUFFER
XFERLP SB2 B2-B3 ONE LESS WORD TO TRANSFER
NG B2,NACTZN --- BRIF DONE TRANSFERRING
BX6 X1
BX7 X3
SA6 A2 WRITE OVER INACTIVE FILE ENTRY
SA7 A1 WRITE OVER ACTIVE FILE ENTRY
SA1 A1+B3
SA2 A2+B3 INCREMENT BUFFER POINTERS
SA3 A3+B3
EQ XFERLP --- LOOP AND XFER ANOTHER
*
* CLEAR OUT THE CURRENTLY SELECTED NAME
*
NACTZN CALL CHRMOVE,NONAME,TRECNAM,MAXNCHR
EQ NEWACTF --- EXIT TO CALLER
* /--- BLOCK NEWACTF 00 000 77/12/01 02.58
*
* PROCEED TO CLOSE THE ACTIVE FILE
*
IACTOVF CALL CLSACTF,(0)
SB1 ZWKBUFF (B1) = BUFFER FWA
EQ NACTSRCH --- TRANSFER BUFFERS
*
* TRANSFER USER BUFFER TO ACTIVE FILE BUFFER
*
NACTFAKE SB2 IACTWPF
SA2 IACTEMP A2 = DUMMY INACTIVE BUFFER
SB1 ZWKBUFF (B1) = BUFFER FWA
EQ NACTFND --- TRANSFER BUFFERS
IACTEMP BSS IACTWPF TEMPORARY BUFFER
*
**
* /--- BLOCK CLSACTF 00 000 79/10/04 03.53
TITLE -CLSACTF- CLOSE CURRENTLY ACTIVE FILE
*
* -CLSACTF-
*
* CALLS THE APPROPRIATE ROUTINE TO CLOSE AN
* ACTIVE FILE.
*
* THIS ROUTINE WILL ALSO ATTEMPT TO COPY AN
* INACTIVE FILE TO THE ACTIVE SLOT AND SHORTEN
* THE INACTIVE TABLE IF POSSIBLE. ONLY IF THERE
* ARE NO INACTIVE FILES WILL THIS ROUTINE EVER
* LEAVE THE ACTIVE SLOT *TAFNAME* ZERO.
*
* ON ENTRY -- B1 = -1 TO IGNORE CLOSE ERRORS
* 0 TO CAUSE EXEC ERRORS
*
* **** SAVLES IS ASSUMED TO BE CALLED ON ENTRY ****
*
* WHILE CLOSING FILE NODES, *TBINTSV* IS USED AS
* FOLLOWS --
*
* 0 - 10 STORED ATTACH PARAMETERS
* 11 - 14 FOR SAVING *CLSACTF* RJ TRAIL
* 15 - 15 USED BY *DETACHP*
*
ENTRY CLSACTF
CLSACTF EQ *
LINK CLSACTF
SA1 TAFNAME GET FILE NAME
NG X1,CLSACTF1 IF ACTIVE FILE
ZR X1,CLSACTF --- EXIT IF NO ACTIVE FILE
CLSACTF1 SX1 B1 (X1) = CLOSE ERRORS PARAMETER
MX6 1
BX6 X1*X6 SAVE SIGN BIT
SA1 KEY
BX6 X1+X6 (X6) = 1/ERROR FLAG,41/0,18/KEY
SA1 NERROR PRESERVE EXECERR INFO
MX2 -18
BX1 -X2*X1 LIMIT TO 18 BITS
LX1 18 (X1) = 24/0, 18/NERROR, 18/0
BX6 X1+X6 (X6)=1/EF,23/0,18/NERROR,18/KEY
SA6 TBINTSV+15 SAVE STUFF HERE FOR THE MOMENT
* SAVE THE RJ TRAIL IN TBINTSV+11 - TBINTSV+14.
CALL LINKS,(TBINTSV+11)
SB2 B2-5 ONLY ROOM FOR 4 WORDS
PL B2,"CRASH" OOPS (USED .GT. 4 WORDS)
* MOVE THE PARAMETERS WHICH WERE SAVED TEMPORARILY
* IN *TBINTSV+15* (WHICH MAY BE USED BY *DETACHP*)
* TO *TBINTSV+14* (THE LAST WORD FOR THE SAVED RJ
* TRAIL). IF *LINKS* USED *TBINTSV+14*, IT MUST
* CONTAIN A ZERO, WHICH WILL BE RESTORED LATER.
SA1 TBINTSV+15 (X1)=1/EF,23/0,18/NERROR,18/KEY
BX6 X1
SA6 TBINTSV+14 SAVE OVER LAST WORD OF RJ TRAIL
* /--- BLOCK CLSACTF 00 000 80/02/10 02.38
* BEWARE OF STRAY INTERLOCKS -- CLEAR THEM JUST
* IN CASE.
INTCLR X,I.SIGN RELEASE SIGNIN/SIGNOUT PROCESS
INTCLR X,I.DS RELEASE DATASET PROCESS
*
* BRANCH TO APPROPRIATE FILE CLOSE ROUTINE
*
AFTJMP "CRASH",DSETCL,TUTCL
*
* CALL THE DATASET/NAMESET/GROUP CLOSE PROCESSOR
*
* DSETCL X CLOSEDS,TDSNAME
DSETCL CALL CLOSEDS,TDSNAME
SA1 TBINTSV+14 (X1)=1/EF,23/0,18/NERROR,18/KEY
NG X1,COPYIACT --- BRIF IGNORE CLOSE ERRORS
NG X6,COPYIACT --- FILL SPACE WITH INACT FILE
ZR X1,ERXOPEN --- BRIF FILE NOT OPEN
EQ ERXBREC
*
* CALL THE TUTOR FILE CLOSE PROCESSOR
*
* TUTCL X TCLOSE
TUTCL CALL TCLOSE
SA1 TBINTSV+14 (X1)=1/EF,23/0,18/NERROR,18/KEY
NG X1,COPYIACT --- BRIF IGNORE CLOSE ERRORS
NG X6,COPYIACT --- FILL SPACE WITH INACT FILE
EQ ERXOPEN
* /--- BLOCK CLSACTF 00 000 77/12/02 20.36
COPYIACT CALL COPIACT
*
RESTRJ SA1 TBINTSV+14 (X1)=1/EF,23/0,18/NERROR,18/KEY
SX6 X1
MX7 0
SA6 KEY RESTORE *KEY*
SA7 A1+ ENSURE LAST WORD OF RJ TRAIL 0
AX1 18 SHIFT SAVED *NERROR* DOWN
SX6 X1+ (X6) = SAVED *NERROR*
SA6 NERROR RESTORE *NERROR* FOR EXECERR
CALL LINKR,(TBINTSV+11) RESTORE RJ TRAIL
EQ CLSACTF
TITLE -COPIACT- REACTIVATE LAST INACTIVE FILE
*
* -COPIACT-
*
* REACTIVATES LAST FILE IN THE OPEN FILE BUFFER.
* THIS IS USUALLY THE PREVIOUSLY ACTIVE FILE THAT
* IS MADE INACTIVE BY AN ATTEMPT TO ATTACH ANOTHER
* FILE.
*
ENTRY COPIACT
COPIACT PS
SB1 1 B1 = 1
SB2 IACTWPF NO. OF WORDS PER FILE ENTRY
SA1 TAFNAME FWA OF OPEN FILE BUFFER
MX7 0 PRECLEAR FOR ZEROING
SA7 A1 CLEAR OUT TAFNAME JUST IN CASE
*
* FIND LAST PHYSICAL INACTIVE SLOT WITH A FILE IN IT
*
SX0 B2 LENGTH OF A FIP
SA2 IACTLTH GET NUMBER OF FIPS
SX2 X2-1 SUBTRACT ONE FOR LAST ONE
IX0 X0*X2 BIAS INTO TABLE
SB3 X0 BECAUSE SA A+X IS ILLEGAL
SA2 IACTFWA FWA OF IACT TABLE
SA2 X2 READ ADDRESS TO A2
SA2 A2+B3 ADD BIAS INTO TABLE
LASTLP NZ X2,COPYLP --- BRIF SOMETHING IN SLOT
NG X2,COPYLP
SA2 A2-IACTWPF LOOK AT SLOT PREVIOUS
SX0 X0-IACTWPF SUBTRACT BIAS FOR LATER
PL X0,LASTLP --- LOOP ON NEXT SLOT
EQ COPIACT IF ALL DONE
COPYLP SB2 B2-B1 ONE LESS WORD TO TRANSFER
NG B2,COPIACT IF COPY DONE
BX6 X2
*
SA6 A1 WRITE OVER ACTIVE FILE ENTRY
SA7 A2 CLEAR OUT INACTIVE SLOT
SA1 A1+B1
SA2 A2+B1 INCREMENT BUFFER POINTERS
EQ COPYLP --- LOOP AND COPY ANOTHER
* /--- BLOCK CLSALLF 00 000 80/02/03 05.23
TITLE -CLSALLF- CLOSE ALL ACTIVE/INACTIVE FILES
*
* -CLSALLF-
*
* CLOSES ALL FILES WHETHER THEY ARE ACTIVE OR
* INACTIVE. NO ERROR RETURNS WILL BE GIVEN ON
* BAD CLOSES.
*
*
ENTRY CLSALLF
CLSALLF EQ *
LINK CLSALLF
CALL SAVETB SAVE *TBINTSV* CELLS
*
* LOOP ON CLOSING ALL INACTIVE FILES IGNORING ERRORS
*
CLSLOOP CALL CLSACTF,(-1)
SA1 TAFNAME READ ACTIVE FILE NAME
NG X1,CLSLOOP IF INACTIVE FILE PRESENT
NZ X1,CLSLOOP --- BRIF MORE INACTIVE LEFT
CALL RESTTB RESTORE *TBINTSV* CELLS
EQ CLSALLF --- RETURN TO CALLER
*
**
* /--- BLOCK TDSINIT 00 000 80/08/19 01.34
*
TITLE -TDSINIT- INITIALIZE DATA/NAMESET INFO
*
* -TDSINIT-
*
* UNCONDITIONALLY CLEAR OUT INFO PACKETS FOR ALL
* ACTIVE AND INACTIVE FILES
*
ENTRY TDSINIT
TDSINIT EQ *
SB1 1
SB2 TIFLTH*TWPF+TWPF TOTAL LENGTH OF PACKETS
SX6 0
SA0 TAFBUF START OF PACKETS
TDSINI1 SB2 B2-B1 DECREMENT COUNTER
SA6 A0+B2 ZERO NEXT WORD
NZ B2,TDSINI1 --- RELOOP UNTIL DONE
EQ TDSINIT --- EXIT
* /--- BLOCK FILTYPE 00 000 80/07/18 03.32
TITLE -FILTYPE- GET FILETYPE TO B1
*
* -FILTYPE-
*
* GETS THE FILE TYPE OF THE ACTIVE FILE TO B1
*
* ON ENTRY -- SOME FILE IS ACTIVE
* EXIT -- B1 = 0 FOR UNRECOGNIZED TYPE
* 1 FOR DATASET TYPE
* 2 FOR TUTOR TYPE
* X1 = 0 (FOR GETVAR)
*
* DESTROYS A1,X2,X1,B1 (GETVAR CONVENTIONS)
*
*
ENTRY FILTYPE
FILTYPE EQ *
SB1 B0 PRESET B1 IN CASE OF EXIT
SA1 TAFNAME GET ACTIVE FILE NAME
NG X1,FILTYP1 IF ACTIVE FILE
ZR X1,FILTYPE --- EXIT IF NO ACTIVE FILE
FILTYP1 RJ FILTYP2 (X1) = 6-BIT FILE TYPE CODE
ZR X1,FILTYPE --- IF NO FILE TYPE
SX2 X1-NFTYPES-1
PL X2,NOTYPE --- IF OUT OF RANGE
SA1 ATTRTAB+X1 (X1) = FILE TYPE ATTRIBUTE WORD
SB1 X1+1
SX1 0
EQ FILTYPE
NOTYPE SB1 B0
MX1 0
EQ FILTYPE
*
* -FILTYP2-
*
* ISOLATE 6-BIT FILE TYPE TO X1
*
ENTRY FILTYP2
FILTYP2 EQ *
SA1 TAFNAME GET ACTIVE FILE NAME
NG X1,FILTYP3 IF ACTIVE FILE
ZR X1,FILTYP2 IF NO FILE
FILTYP3 SA1 TAFINF2 READ ATTACHED FILE INFO
AX1 18 SHIFT INTO POSITION
MX2 -6 FORM 6 BIT FILE TYPE MASK
BX1 -X2*X1 MASK TO 6 BITS
EQ FILTYP2
* /--- BLOCK READTF 00 000 78/04/29 19.13
TITLE -READTF- READ TUTOR FILE NODE
**
*
* -READTF-
*
* ROUTINE TO READ TUTOR FILE NODE TO INFO BUFFER
*
* ALSO RETURNS THE FOLLOWING PARAMETERS --
*
* B1 = 0 IF PARTS OPTION SELECTED
* CURRENT NAME BIAS IF NAME OPTION SELECTED
* B2 = BIAS OF LAST BLOCK NAME IN FILE
* X1 = CURRENT NAME IF ONE IS SELECTED
*
ENTRY READTF
READTF EQ *
SA1 TAFINF2 GET ACTIVE FILE INFO
CALL READLES,B0,B0 GET ECS FWA OF NODE
SX1 TUTHEAD GET STANDARD HEADER LENGTH
IX0 X0+X1 BIAS PAST HEADER
SA0 INFO READ DIRECTORY TO *INFO* BUFFER
RE BLKLTH
RJ ECSPRTY
MX7 -1
SA7 JJSTORE FLAG *INFO* OVERWRITTEN
SA1 LBLOCKS GET NUMBER OF BLOCKS IN FILE
SB2 X1-1 ISOLATE MAXIMUM LEGAL BIAS
ZEROLP SA1 LBNAM0+B2 GET NEXT BLOCK NAME
NZ X1,LASTB --- BRIF LAST BLOCK FOUND
NG X1,LASTB --- BRIF LAST BLOCK FOUND
SB2 B2-1
EQ ZEROLP --- LOOP UNTIL LAST BLOCK FOUND
LASTB SB1 0 PRESET BIAS TO 0
*///
*/// TRAP PUT IN BY OZZIE ON 78.04.29.
*///
*/// TRAP IF B2 IS ILLEGAL VALUE. THIS WILL HOPEFULLY
*/// GIVE MORE INFO ABOUT THE CAUSE OF TWO CRASHES
*/// IN WHICH THE ABOVE READ OF THE TUTOR FILE NODE
*/// READ 320 WORDS OF ZERO WHILE THE ECS STORAGE
*/// BUFFER APPEARED TO BE INTACT. THE FORMER CRASHES
*/// WERE IN ROUTINE -NAMBIAS- AND WERE CAUSED BECAUSE
*/// B2 WAS NEGATIVE, CAUSING A2 TO BE NEGATIVE IN A
*/// LOOP. TRAP HERE IF B2 IS INITIALIZED NEGATIVE.
*///
LT B2,B0,"CRASH"
*///
SA1 TAFINF1 GET BIAS INFO WORD
NG X1,READTF --- EXIT IF PARTS OPTION
AX1 36 SHIFT NAME BIAS INTO POSITION
SB1 X1 STORE BIAS IN B1
SA1 LBNAM0+B1 GET CURRENT NAME SELECTED
EQ READTF --- EXIT TO CALLER
*
**
* /--- BLOCK NAMBIAS 00 000 79/02/08 02.08
TITLE -NAMBIAS- CALCULATE NAME BIASES
**
*
* -NAMBIAS-
*
* THIS ROUTINE, GIVEN THE BIAS TO ANY BLOCK,
* WILL RETURN THE BIAS TO THE NAME ASSOCIATED
* WITH THAT BLOCK AND THE BIAS TO THE NEXT
* SEQUENTIAL NAME.
*
* ON ENTRY -- B1 = BIAS TO ANY BLOCK NAME
* B2 = BIAS TO LAST BLOCK IN FILE
* EXIT -- B1 = BIAS TO NAME FOR THAT BLOCK
* B2 = SAME AS ON ENTRY
* B3 = BIAS TO NEXT SEQUENTIAL NAME
* -1 IF NO NEXT SEQUENTIAL NAME
*
* DESTROYS A1,A2,X0,X1,X2
*
ENTRY NAMBIAS
NAMBIAS EQ *
*
* SCAN BACKWARD FOR FIRST BLOCK IN THIS NAME
*
SA2 LBINF0+B1 READ BLOCK INFO WORD
LX2 L.TYPE
MX0 -L.TYPEL
BX2 -X0*X2 ISOLATE BLOCK TYPE
SB3 X2 MOVE BLOCK TYPE TO B3
SB3 B0-B3 COMPLEMENT IT
SA1 LBNAM0+B1 GET CURRENT BLOCK NAME
ZR X2,BCKLP IGNORE BBLKS IF ITS A SORCE BLK
SX0 X2-7
ZR X0,BCKLP ... OR TEXT BLOCKS
SX0 X2-9
NZ X0,BCKLP0 ... OR LISTING BLOCKS
BCKLP SB1 B1-1 LOOK AT THE PREVIOUS NAME
ZR B1,BCKDONE --- BRIF FIRST NAME IN FILE
SA2 LBINF0+B1 GET PREVIOUS BLOCK INFO WORD
LX2 L.TYPE SHIFT BLOCK TYPE INTO POSITION
MX0 -L.TYPEL TYPE FIELD MASK
BX2 -X0*X2 ISOLATE BLOCK TYPE
SX0 X2+B3 COMPARE THE BLOCK TYPES
NZ X0,BCKDONE --- BRIF DIFFERENT TYPE
ZR X2,BCKLP1 --- BRIF SOURCE BLOCK
SX0 X2-7
ZR X0,BCKLP1 --- BRIF TEXT BLOCK
SX0 X2-9
ZR X0,BCKLP1 --- BRIF LISTING BLOCK
* ALL NON-SOURCE/TEXT/LISTING BLOCKS GO THRU HERE
BCKLP0 SA2 LBINF0+B1 GET BLOCK INFO AGAIN
LX2 L.BLKS SHIFT NO. OF BLOCKS INTO POS
MX0 -L.BLKSL
BX2 -X0*X2 ISOLATE NUMBER OF CONTIG BLOCKS
NZ X2,FWDSRCH --- BRIF THIS IS START BLOCK
BCKLP1 SA2 LBNAM0+B1 GET PREVIOUS NAME
BX0 X2-X1 COMPARE THE TWO NAMES
NZ X0,BCKDONE --- BRIF DIFFERENT NAME
PL X0,BCKLP --- LOOP UNTIL DIFFERENT NAME
BCKDONE SB1 B1+1 INCREMENT PAST MISMATCH
FWDSRCH BSS 0 START FORWARD SEARCH
* /--- BLOCK NAMBIAS 00 000 78/10/29 01.57
*
* SCAN FORWARD TO DIFFERENT NAME
*
SB3 B1
NXTLP SB3 B3+1 LOOK AT NEXT SEQUENTIAL BLOCK
GT B3,B2,LASTN --- BRIF LAST NAME IN FILE
SA2 LBNAM0+B3 GET NEXT BLOCK NAME
BX0 X2-X1 COMPARE THE TWO NAMES
NZ X0,NAMBIAS --- EXIT IF A DIFFERENT NAME
NG X0,NAMBIAS --- EXIT IF A DIFFERENT NAME
MX0 -L.TYPEL
SA2 LBINF0+B3 GET BLOCK INFO WORD AGAIN
LX2 L.TYPE
BX1 -X0*X2 ISOLATE BLOCK TYPE
SA2 LBINF0+B1 GET OLD BLOCK TYPE
LX2 L.TYPE
BX2 -X0*X2 ISOLATE OLD BLOCK TYPE
IX0 X1-X2 COMPARE BLOCK TYPES
SA1 A1 RESTORE BLOCK NAME
NZ X0,NAMBIAS --- EXIT IF BLOCK TYPES DIFFER
EQ NXTLP --- LOOP UNTIL DIFFERENT NAME
LASTN SB3 -1 FLAG LAST NAME IN FILE
EQ NAMBIAS --- RETURN TO CALLER
*
**
* /--- BLOCK GENCOMP 00 000 77/12/20 00.18
TITLE -GENCOMP- GENERIC COMPARISON OF TWO WORDS
**
*
* -GENCOMP-
*
* PERFORMS GENERIC COMPARISON OF TWO WORDS
*
* ON ENTRY -- X1 CONTAINS WORD TO TEST
* X2 CONTAINS WORD TO TEST AGAINST
* EXIT -- X7 = 1 IF PARTIAL OR FULL MATCH
* 0 IF NO MATCH
* B3 = BITS IN PARTIAL MATCH - 1
*
ENTRY GENCOMP
GENCOMP EQ *
MX6 1 1 BIT FOR MASK FORMATION
MX7 0 0 IN CASE OF GENERIC FAILURE
SB3 65 INITIAL SHIFT COUNT
GENLP SB3 B3-6 MASK 1 LESS CHARACTER
NG B3,GENCOMP --- EXIT IF NO GENERIC MATCH
LX0 X6,-B3 FORM MASK FOR N CHARACTERS
BX0 X0*X2 MASK DOWN FOR COMPARISON
BX0 X0-X1 COMPARE THE TWO
NZ X0,GENLP --- LOOP IF NOT THE SAME
NG X0,GENLP --- LOOP IF NOT THE SAME
SX7 1 FLAG PARTIAL MATCH
EQ GENCOMP --- RETURN TO CALLER
*
**
* /--- BLOCK NAMREC 00 000 79/08/13 02.25
TITLE NAMREC CONVERT RELATIVE RECORD TO ABSOLUTE
*
* -NAMREC-
*
* THIS ROUTINE CALCULATES THE ABSOLUTE RECORD
* NUMBER OF THE FILE GIVEN THE RELATIVE RECORD
* WITHIN THE NAME CURRENTLY SELECTED. THIS
* ASSUMES THAT THE FILE NODE HEADER HAS BEEN READ
* AND THAT THE DATASET PROCESS (I.DS) HAS BEEN
* INTERLOCKED.
*
* A0 = ADDRESS OF RECORD ALLOCATION TABLE
* X1 = HEADER RECORD FOR CHAIN
* X2 = RELATIVE RECORD NUMBER - 1 (RELATIVE TO ZERO)
*
* ON EXIT,
*
* X1 = ABSOLUTE RECORD NUMBER
* X6 = NEGATIVE IF SYSTEM ERROR (RECORD=0 OR OUT OF RANGE)
* = POSITIVE IF OK
*
*
ENTRY NAMREC
*
NAMREC EQ *
BX3 X2 X3 = RELATIVE RECORD NUMBER
MX2 -FFIELD
SA4 FILINF1
AX4 FMAXREC SHIFT TO MAX. RECORD NUMBER
BX4 -X2*X4 X4 = MAX. POSSIBLE RECORD
MX5 -1 INCREMENT FOR EACH ITERATION
NAMREC2 ZR X1,NAMREC3 --- SYSTEM ERROR IF RECORD = 0
IX6 X4-X1 CHECK IF RECORD NUMBER VALID
NG X6,NAMREC --- SYSTEM ERROR, OUT OF RANGE
ZR X3,NAMREC --- ALREADY AT CORRECT RECORD
GETSEG GET NEXT RECORD IN CHAIN IN X2
BX1 X2 CURRENT RECORD <- NEXT RECORD
IX3 X3+X5 SUBTRACT FROM RELATIVE COUNT
EQ NAMREC2
*
NAMREC3 SX6 -1 MARK SYSTEM ERROR
EQ NAMREC
* /--- BLOCK NXTLINK 00 000 79/08/13 21.59
TITLE NXTLINK
*
* -NXTLINK-
*
* OBTAINS THE NEXT RECORD NUMBER IN THE CHAIN GIVEN
* THE CURRENT RECORD NUMBER. THIS PERFORMS BOUNDS
* CHECKING ON THE NEXT RECORD NUMBER TO MAKE SURE
* THE ALLOCATION TABLE IS NOT MESSED UP.
*
* THE DATASET PROCESS (I.DS) SHOULD BE INTERLOCKED.
*
* ON ENTRY
*
* X1 = CURRENT RECORD NUMBER IN CHAIN
* A0 = ADDRESS OF RECORD ALLOCATION TABLE
*
* ON EXIT
*
* X1 = NEXT RECORD NUMBER IN CHAIN
* X6 = NEGATIVE IF SYSTEM ERROR
* = POSITIVE IF OK
*
ENTRY NXTLINK
*
NXTLINK EQ *
GETSEG GET LINK VALUE FOR THIS RECORD
BX1 X2 CURRENT <- NEXT
SA2 FILINF1
AX2 FMAXREC
MX6 -FFIELD
BX2 -X6*X2 X2 = MAX. VALUE FOR LINK
ZR X1,NXTL1 --- ERROR IF OUT OF RANGE
IX6 X2-X1 CHECK IF RECORD NUMBER VALID
PL X6,NXTLINK --- EXIT IF VALID NUMBER
*
* SYSTEM ERROR
*
NXTL1 SX6 -1
EQ NXTLINK
* /--- BLOCK READDS 00 000 79/08/13 02.28
TITLE READDS
*
*
*
* -READDS-
* READS THE DATASET ECS FILE NODE HEADER AND
* THE NAMESET HEADER INTO CM.
*
* THE DATASET PROCESS (I.DS) SHOULD BE INTERLOCKED
* IF THE INFO IN THE HEADER WILL BE USED AS THE
* BASIS FOR DECISIONS (E.G. CHECKS TO SEE IF SOME-
* THING IS RESERVED OR TO SEE IF THERE'7S ENOUGH
* ROOM LEFT IN THE FILE TO ADD RECORDS)
*
* ENTRY (B1) = ADDR OF -ATTACH- FIP (E.G. TDSNAME)
*
* ON EXIT -
* DSLOC = ECS ADDRESS OF FILE NODE
* NAMLOC0 = ECS ADDRESS OF FIRST NAME (NAMESETS)
* NAMWDS = NAME ENTRY LENGTH IN WORDS (NAMESETS)
* X0 = ECS ADDRESS OF FILE NODE
* X6 = ECS ADDRESS OF NAMES (ONLY FOR NAMESETS)
*
ENTRY READDS
READDS EQ *
SA1 B1+BDSPARM (X1) = 42/JUNK, 18/LESSON NO.
CALL READLES,DSNODE,(DSHEAD+FPRMLTH)
MX7 -12
SA2 DSNODE LOAD 1ST WORD OF HEADER
LX2 12
BX2 -X7*X2 MASK OFF LESSON TYPE CODE
SX7 X2-9
NZ X7,"CRASH" EROR IF NOT DATASET FILE NODE
BX7 X0
SA7 DSLOC SAVE ADDRESS OF ECS BUFFER
SA1 BNAMBUF GET BIAS TO NAMESET HEADER
ZR X1,READDS EXIT IF NOT NAMESET
IX0 X0+X1 ECS ADDRESS OF NAMESET HEADER
SA0 NSH
+ RE NPRMLTH READ NAMESET HEADER
RJ ECSPRTY
SX1 NPRMLTH LENGTH OF NAMESET HEADER
IX6 X0+X1 ECS ADDRESS OF NAMES
SA6 NAMLOC0 SAVE ADDRESS OF NAMES
BX0 X7 RETURN ECS ADDRESS OF FILE NODE
SA1 FILINF2
AX1 FNWORDS SHIFT TO ENTRY LENGTH
MX2 -FFIELD
BX7 -X2*X1 ENTRY LENGTH IN WORDS
SA7 NAMWDS SAVE FOR LATER USE
EQ READDS
*
* /--- BLOCK SETFIO 00 000 79/10/18 23.25
TITLE SETFIO SET FILE I/O ACTIVITY
*
* SETFIO
*
* SETS THE FILE I/O ACTIVITY RESERVATION ENTRY.
*
* ENTRY (B1) = ADDR OF -ATTACH- FIP (E.G. TDSNAME)
*
* ON EXIT,
* X6 = -1 IF OK
* 0 IF FILE BUSY
*
* THE -CLRFIO- ROUTINE MUST BE CALLED AFTER
* THE I/O IS COMPLETED (WITH OR WITHOUT ERROR).
*
*
ENTRY SETFIO
*
SETFIO EQ *
*
SX3 B1 SAVE OVER INTLOK
INTLOK X,I.DS,W INTERLOCK CHANGING FILE NODE
CALL READDS,X3 READ FILE NODE HEADER
*
SA1 FILINF1
LX1 -FIO POSITION I/O RESERVE AT RIGHT
MX6 -FFIELD
BX3 -X6*X1 X3 = I/O ACTIVITY MARKER
*
SA2 STATION RESERVING STATION NUMBER
SX2 X2+1 INCR (TO ALLOW FOR CONSOLE)
*
NZ X3,SETFIO2 --- IF ALREADY RESERVED
*
BX6 X1+X2 STATION + REST OF FILINF1
LX6 FIO
SA6 A1
*
* * MODIFY FILE NODE IN ECS
*
SA1 DSLOC ECS ADDRESS OF FILE NODE
SX2 DSHEAD LENGTH OF STANDARD HEADER
IX0 X1+X2 ADDRESS OF DATASET HEADER
SA0 DSH
WE FPRMLTH
RJ ECSPRTY
*
SETFIO1 INTCLR X,I.DS
SX6 -1 OK
EQ SETFIO --- EXIT
*
SETFIO2 BX3 X2-X3 CHECK IF SAME STATION NUMBER
ZR X3,SETFIO1 --- OK IF RESERVED HERE
*
SETFE0 INTCLR X,I.DS
SX6 0 FILE BUSY
EQ SETFIO --- EXIT
* /--- BLOCK CLRFIO 00 000 79/10/18 13.11
TITLE CLRFIO CLEAR FILE I/O ACTIVITY
*
* CLRFIO
*
* CLEARS THE FILE I/O ACTIVITY RESERVATION ENTRY.
*
* ENTRY (B1) = ADDR OF -ATTACH- FIP (E.G. TDSNAME)
*
* NOTE--A CHECK IS DONE TO ASSURE THAT THE CALLING
* STATION IS THE SAME AS THE ONE WITH THE I/O
* RESERVED; NO CLEAR IS DONE IF IT IS NOT.
*
*
ENTRY CLRFIO
*
CLRFIO EQ *
*
SA1 B1+BDSNAME (X1) = NAME OF FILE
NG X1,CLRFIO1 NEG. NAME = FILE IS PRESENT
ZR X1,CLRFIO --- EXIT IF NO FILE PRESENT
CLRFIO1 SA1 B1+BDSINF (X1) = FILE INFORMATION
AX1 18
MX2 -6
BX1 -X2*X1 (X1) = FILE TYPE
ZR X1,CLRFIO --- EXIT IF NO FILE TYPE
SX2 X1-NFTYPES-1 COMPARE W/ MAXIMUM FILE TYPE
PL X2,CLRFIO --- EXIT IF TYPE OUT OF RANGE
SA1 X1+ATTRTAB (X1) = FILE ATTRIBUTE WORD
SX1 X1+ (X1) = *AFTJMP* PARAMETER
NZ X1,CLRFIO --- NEITHER DATASET NOR NAMESET
SX3 B1+ SAVE FIP ADDR OVER INTLOK
*
INTLOK X,I.DS,W INTERLOCK CHANGING FILE NODE
CALL READDS,X3 READ FILE NODE HEADER
SA1 FILINF1 FILE INFORMATION WORD
MX6 -FFIELD
LX6 FIO
BX7 X6*X1 CLEAR FILE I/O ACTIVITY
*
* ENSURE THAT THIS STATION IS THE ONE WITH THE RESERVATION
*
BX1 -X6*X1 EXTRACT RESERVATION ENTRY
LX1 -FIO POSITION AT RIGHT
SA2 STATION RELEASING STATION NUMBER
SX2 X2+1 INCR (TO ALLOW FOR CONSOLE)
IX6 X1-X2 COMPARE WITH RESERVATION
NZ X6,CLRDON EXIT IF NOT THE SAME STATION
SA7 A1 STORE WITH ENTRY CLEARED
*
* * MODIFY FILE NODE IN ECS
*
SA1 DSLOC
SX2 DSHEAD
IX0 X1+X2
SA0 DSH
WE FPRMLTH
RJ ECSPRTY
*
CLRDON INTCLR X,I.DS
EQ CLRFIO --- EXIT
* /--- BLOCK READFTB 00 000 79/08/13 02.29
TITLE READFTB
*
* -READFTB-
*
* THIS ROUTINE READS THE RECORD MANAGEMENT TABLE
* AND THE RECORD ALLOCATION TABLE FROM ECS INTO
* THE CM BUFFERS. THE ALLOC. TABLE IS ONLY READ
* FOR NAMESET TYPE FILES.
*
* THIS ASSUMES THAT -READDS- HAS BEEN CALLED.
*
* THE DATASET PROCESS (I.DS) SHOULD BE INTERLOCKED.
*
* ENTRY (B1) = ADDRESS OF -ATTACH- FIP.
*
* ON EXIT,
*
* RMT = RECORD MANAGEMENT TABLE
* RAT = RECORD ALLOCATION TABLE (NAMESETS ONLY)
*
ENTRY READFTB
*
READFTB EQ *
SA1 DSLOC ECS ADDRESS OF FILE NODE
SA2 BRMT BIAS TO RMT
IX0 X1+X2 ECS ADDRESS OF RMT
SA3 FILINF2
MX6 -FFIELD
AX3 FTBSIZE SHIFT TO TABLE SIZE IN WORDS
BX3 -X6*X3 GET TABLE SIZE
SA2 B1+BDSINF (X2) = 1/NAMESET,59/OTHER STUFF
SB1 X3+ (B1) = RAT/RMT SIZE IN WORDS
SA0 RMT ADDRESS OF CM BUFFER
RE B1 READ RECORD MANAGEMENT TABLE
RJ ECSPRTY
*
PL X2,READFTB --- EXIT IF NOT NAMESET
SA2 BRAT BIAS TO RAT
IX0 X1+X2 ECS ADDRESS OF RAT
SA0 RAT ADDRESS OF CM BUFFER
RE B1 READ RECORD ALLOCATION TABLE
RJ ECSPRTY
EQ READFTB --- EXIT
* /--- BLOCK READNAM 00 000 79/08/13 02.29
TITLE READNAM -- READ CURRENT USER NAME
READNAM SPACE 5,20
** READNAM - READ CURRENT NAME ENTRY
*
* READS THE NAME ENTRY THAT THE USER IS CURRENTLY
* SET FOR INTO A SPECIFIED LOCATION.
*
* ENTRY *READDS* CALLED.
* *I.DS* (DATASET PROCESS) INTERLOCKED.
*
* ENTRY (B1) = ADDR OF -ATTACH- FIP (E.G. TDSNAME)
* (B2) = ADDR OF NAMESET NAME (E.G. TRECNAM)
*
* EXIT (X2) = >0 IF NON-SOURCE BLK IN USER LESSON.
* (X7) = -1 IF NAME FOUND, ELSE POSITIVE.
* (B1) = LENGTH OF NAME ENTRY.
*
* CALLS CHRCOMP, CHRMOVE, FINDNAM.
*
* MACROS CALL.
*
ENTRY READNAM
*
READNAM EQ *
SX6 B1 SAVE ADDR OF -ATTACH- FIP
SX7 B2 SAVE ADDR OF NAME
SA6 FIPSAVE
SA7 NAMSAVE
SA1 B2+ CHECK IF CURRENTLY SET TO NAME
ZR X1,READE0 --- ERROR IF NOTHING TO READ
*
* * READ CURRENT NAME
*
SA1 NAMLOC0 ECS ADDRESS OF NAMES
SA2 B1+BDSINF
SX2 X2 BIAS TO CURRENT NAME ENTRY
IX0 X1+X2 ECS ADDRESS OF NAME ENTRY
BX6 X0
SA6 NAMLOC SAVE ADDRESS FOR LATER USE
SA1 NAMWDS LENGTH OF NAME ENTRY
SB1 X1
SA0 NAME
RE B1 READ CURRENT NAME ENTRY
RJ ECSPRTY
*
* * CHECK IF BIAS STILL GIVES CURRENT NAME
*
SA1 FILINF2
MX7 -FFIELD
AX1 FNSIZE SHIFT TO NAME SIZE IN CHARS
BX6 -X7*X1 X6 = NAME SIZE IN CHARS
SA1 NAMSAVE (X1) = ADDRESS OF NAME
CALL CHRCOMP,X1,A0,X6
NZ X6,REFIND IF NAME MOVED SINCE LAST TIME
SA1 NAMLOC ECS ADDRESS OF NAME ENTRY
SA2 NAMWDS GET LENGTH OF ENTRY
BX0 X1 RETURN ECS ADDRESS
SB1 X2 RETURN LENGTH OF ENTRY
EQ READOK --- EXIT OK
* /--- BLOCK REFIND 00 000 79/06/27 11.47
*
* * RE-FIND THE NAME (SOMEONE SHIFTED IT)
*
REFIND SA1 NAMSAVE (X1) = ADDRESS OF NAME
CALL FINDNAM,X1 FIND THE CURRENT NAME
*
* AFTER CALL, X0 = ECS ADDRESS OF NAME, X6 HAS BIAS
* TO NAME, X5 = SIZE OF ENTRY IN WORDS, X7 = RETURN.
*
PL X7,READE0 --- JUMP IF NO LONGER EXISTS
*
* * UPDATE ECS BIAS TO CURRENT NAME
*
SA1 FIPSAVE (X1) = ADDRESS OF -ATTACH- FIP
SA1 X1+BDSINF
MX2 -18 MASK FOR NAME BIAS
BX1 X1*X2 ZERO OUT OLD BIAS
BX6 X1+X6 INSERT NEW LOCATION
SA6 A1 STORE
*
* * UPDATE ECS ADDRESS OF CURRENT NAME
*
BX6 X0 X6 = ECS ADDR. OF CURRENT NAME
SA6 NAMLOC
*
* * RE-READ CORRECT NAME ENTRY
*
SA1 NAMWDS LENGTH OF NAME ENTRY
SB1 X1
SA0 NAME
RE B1 READ NAME ENTRY
RJ ECSPRTY
*
READOK SA1 NAME-1+B1 GET EXTRA INFO WORD
BX6 X1
SA6 NAMINFO SAVE COPY FOR LATER USE
MX7 -1 RETURN FOUND
MX2 0 SET TO SOURCE OR SYSTEM LESSON
SA3 LESSCM+LSTOUSE
NG X3,READNAM --- IF SYSTEM LESSON
SA3 FFAW (X3) = FILE ATTRIBUTE WORD
LX3 60-/FAW/S.FTYPE POSITION FILE TYPE CODE
MX4 -/FAW/M.FTYPE (X4) = MASK FOR FILE TYPE
BX3 -X4*X3 (X3) = FILE TYPE
SX3 X3-GRTYPE CHECK FOR GROUP
NZ X3,READOK1 --- IF NOT GROUP
SA3 FILINF5 (X3) = FILE INFORMATION
AX3 FUPD8LV POSITION UPDATE LEVEL
MX4 -FFIELD (X4) = MASK FOR UPDATE LEVEL
BX3 -X4*X3 (X3) = UPDATE LEVEL
SX3 X3-UPD8LV6 CHECK FOR LEVEL .GE. 6
NG X3,READNAM --- EXIT IF GROUP .LE. 5
READOK1 AX1 15+15+24
MX2 -IBSUBF
BX2 -X2*X1 (X2) = 0 IF SOURCE, ELSE .GT. 0
EQ READNAM --- EXIT
*
* * CURRENT NAME WAS DELETED BY ANOTHER USER
*
READE0 SA1 NAMSAVE (X1) = ADDRESS OF NAME
CALL CHRMOVE,NONAME,X1,MAXNCHR
SA1 FIPSAVE (X1) = ADDRESS OF -ATTACH- FIP
SA1 X1+BDSINF
MX2 -18 MASK FOR NAME BIAS
BX6 X1*X2 ZERO OUT BIAS
SA6 A1 STORE
MX7 0 INDICATE NAME CANNOT BE FOUND
EQ READNAM --- EXIT
FIPSAVE BSS 1 ADDRESS OF -ATTACH- FIP
NAMSAVE BSS 1 ADDRESS OF NAME
* /--- BLOCK FINDNAM 00 000 79/08/13 02.29
TITLE NAMESET BINARY/GENERIC SEARCH
*
* -FINDNAM-
*
* THIS ROUTINE PERFORMS A BINARY CHOP SEARCH
* OF AN ECS RESIDENT NAMESET DIRECTORY. ONCE
* THE BINARY SEARCH IS DONE, A LINEAR SCAN IS
* PERFORMED TO COUNT (UP TO 2) THE NUMBER OF
* GENERIC MATCHES TO THE KEY UNTIL IT CANNOT BE
* MATCHED GENERICALLY. THE FIRST NON-ZERO 6-BIT
* CODE WHEN SCANNING FROM THE END OF THE OBJECT
* KEY FORWARD DETERMINES THE MASK USED FOR GENERIC
* COMPARISONS.
*
* THIS ASSUMES THAT -READDS- HAS BEEN CALLED.
*
* THE DATASET PROCESS (I.DS) SHOULD BE INTERLOCKED.
*
* ON ENTRY--
*
* B1 = ADDRESS OF KEY TO SEARCH FOR
*
* ON EXIT--
*
* X0 = ECS ADDRESS OF REQUESTED NAME
* X5 = LENGTH OF AN ENTRY IN WORDS
* X6 = RELATIVE ECS BIAS TO NAME
* (OR WHERE IT SHOULD BE PUT)
* X7 = -1 IF FOUND,
* ELSE COUNT OF GENERIC MATCHES (UP TO 2)
*
*
ENTRY FINDNAM
FINDNAM EQ *
*
* SAVE B5, B7 OVER THE ROUTINE
*
SX6 B5 SAVE B5
SA6 B5SAVE
SX6 B7 SAVE B7
SA6 NCTYPE
* /--- BLOCK FINDNAM 00 000 79/01/25 04.05
*
* * GENERATE MASK FOR LAST WORD OF ENTRY
*
SA1 FILINF2
MX7 -FFIELD
AX1 FNSIZE SHIFT TO LENGTH OF NAME (CHARS)
BX1 -X7*X1 CHARACTERS IN NAME
CALL CHRMOVE,B1,NAMKEY,X1 GET OBJECT KEY
BX4 X7 X4 = MASK FOR LAST WORD
*
* * INITIALIZE CONSTANTS
*
SA1 NAMWDS GET ENTRY LENGTH (WORDS)
BX5 X1 X5 = LENGTH OF ENTRY IN WORDS
SB6 X1-1 B6 = LENGTH OF OBJECT KEY
SB5 NAMKEY-1+B6 B5 = LWA OF OBJECT KEY
SB1 1 B1 = CONSTANT 1
SB7 59 B7 = CONSTANT 59
SA0 NAMTMP
SA1 NAMLOC0 GET ECS ADDRESS OF FIRST NAME
BX7 X1 X7 = ECS ADDRESS OF NAMES
* /--- BLOCK FINDNAM 00 000 78/02/03 03.23
*
* BEGIN EXECUTION
*
SB2 B0 B2 = BASE POSITION (REL. 0)
SA2 NNAMINF BOTTOM 18 = NAMES IN USE
SB3 X2 B3 = DOMAIN OF SEARCH
EQ NHALF1 BEGIN EXECUTION
*
NHALF2 SB2 X3+B1 ADVANCE BASE POSITION (SCAN+1)
NG X6,NHALF1 JUMP IF PREV. LENGTH WAS ODD
SB3 B3-B1 REDUCE DOMAIN BY 1 IF EVEN
*
NHALF1 ZR B3,NOTFND -- UNSUCCESSFUL EXIT
SX3 B3 GET DOMAIN IN X3
LX6 X3,B7 SAVE ODD/EVEN FLAG IN SIGN BIT
AX3 1 DIVIDE BY 2
SB3 X3 B3 = NEW DOMAIN (LAST ONE/2)
SX3 B2+B3 X3 = POSITION BEING TESTED
IX0 X3*X5 DISPLACEMENT INTO BUFFER
IX0 X7+X0 COMPUTE ECS ADDRESS
RE B6
RJ ECSPRTY
SA1 A0 FIRST WORD OF SCAN KEY
SB4 NAMKEY FIRST WORD OF OBJECT KEY
COMP1 SA2 B4 GET OBJECT WORD
NG X1,COMP2 JUMP IF SCAN KEY NEGATIVE
NG X2,NHALF2 OBJECT HIGHER THAN SCAN
EQ COMP3 COMPARE - BOTH HAVE SAME SIGN
*
COMP2 PL X2,NHALF1 OBJECT LESS THAN SCAN KEY
*
COMP3 LT B4,B5,COMP4 --- JUMP IF NOT LAST WORD
BX1 X4*X1 MASK OFF IRRELAVENT CHARACTERS
*
COMP4 IX1 X2-X1
NG X1,NHALF1 JUMP IF IN 1ST HALF
NZ X1,NHALF2 JUMP IF IN 2ND HALF
SA1 A1+B1 NEXT WORD OF SCAN KEY
SB4 B4+B1 NEXT WORD OF OBJECT KEY
LE B4,B5,COMP1 CONTINUE IF MORE WORDS LEFT
IX6 X3*X5 X6 = BIAS TO NAME ENTRY
IX0 X7+X6 X0 = ECS ADDRESS OF NAME
SX7 -B1 X7 = -1 (FOUND)
BNREST SA1 B5SAVE
SB5 X1 RESTORE B5
SA1 NCTYPE
SB7 X1 RESTORE B7
EQ FINDNAM --- EXIT
* /--- BLOCK GENSCAN 00 000 78/02/03 02.57
*
* IF THE KEY CANNOT BE FOUND, SEARCH LINEARLY
* COUNTING THE NUMBER OF GENERIC MATCHES.
*
NOTFND SB3 B0 B3 = NUMBER OF GENERIC MATCHES
SB7 2 B7 = MAXIMUM VALUE OF GENERIC COUNT
*
* FIRST, SEARCH THE OBJECT KEY FROM THE END
* OF THE KEY FORWARD LOOKING FOR THE LAST
* CHARACTER. MASK WILL BE GENERATED FROM THAT.
*
* B5 WILL = LWA OF GENERIC PORTION OF KEY
*
MX0 -6 FOR MASKING OFF LOWER 6 BITS
SB4 NAMKEY USE B4 FOR END TEST
SB5 B4+B6 START B5 AT LWA+1 OF KEY
MSKLP1 LE B5,B4,GENEXIT IF KEY = 0, EXIT SEARCH
SB5 B5-B1 SCAN FROM LAST TO FIRST
SA1 B5 GET WORD OF KEY
MX6 60 INITIALIZE MASK TO WHOLE WORD
MSKLP2 LX6 6 DECREASE SIZE OF MASK
BX6 X0*X6 BY 6 BITS
BX3 -X6*X1 SEE IF MASK HOLDS CONTENTS
NZ X3,MSKFIN --- IF NOT, LAST CHAR FOUND
NZ X6,MSKLP2 IF MORE CHARS LEFT, CONTINUE
EQ MSKLP1 TRY PREVIOUS WORD IN OBJECT
*
MSKFIN AX6 6 EXTEND MASK OVER LAST CHAR
MX0 6
BX6 X0+X6 IN CASE ONLY ONE CHARACTER
* /--- BLOCK GENSCAN 00 000 78/02/03 03.07
*
* BEGIN SCANNING THE NAMES
*
SA3 NNAMINF BOTTOM 18 = NAMES IN USE
SX3 X3+B1 X3 = ENTRIES + 1
GSCAN SX1 B2+B3 ENTRY TO BE TESTED
IX0 X1-X3 SEE IF END OF NAMES
PL X0,GENEXIT --- IF NO MORE NAMES, EXIT
IX0 X1*X5 DISPLACEMENT INTO BUFFER
IX0 X7+X0 COMPUTE ECS ADDRESS
RE B6
RJ ECSPRTY
SB4 NAMKEY START OF GENERIC KEY
SA1 A0 START OF NAME BEING SEARCHED
GCOMP SA2 B4 GET NEXT WORD OF DIRECTORY NAME
LT B4,B5,GCOMP2 --- IF LAST WORD, USE MASK
BX1 X1*X6 MASK OFF ALL BUT GENERIC PART
GCOMP2 BX1 X1-X2 COMPARE WITH GENERIC KEY
NZ X1,GENEXIT --- IF DOES NOT MATCH, EXIT
SA1 A1+B1 GET NEXT WORD OF SEARCH NAME
SB4 B4+B1 NEXT WORD OF GENERIC KEY
LE B4,B5,GCOMP --- IF NOT LAST WORD, CONTINUE
SB3 B3+B1 ADD TO COUNT OF GENERIC MATCHES
LT B3,B7,GSCAN --- KEEP LOOKING IF LESS THAN 2
*
GENEXIT SX6 B2 RETURN FIRST GENERIC MATCH
IX6 X6*X5 BIAS TO FIRST GENERIC MATCH
IX0 X7+X6 X0 = ECS ADDRESS OF NAME
SX7 B3 RETURN COUNT OF GENERIC MATCHES
EQ BNREST --- RESTORE REGS AND EXIT
*
NAMKEY BSS MAXNWDS KEY BEING SEARCHED FOR
NAMTMP BSS MAXNWDS+1 TABLE ENTRY BEING CHECKED
B5SAVE BSS 1 USED TO SAVE B5 OVER ROUTINE
* /--- BLOCK FINDRES 00 000 80/07/02 00.14
TITLE FINDRES -- SEARCH SIGNON RESERVATION TABLE
*
* -FINDRES-
*
* SEARCHES THE SIGNON RESERVATION TABLE IN ECS TO
* DETERMINE IF THE CURRENTLY SELECTED NAME IS SIGNED
* ON OR NOT.
*
* ENTRY (TDSNAME) = GROUP NAME
* (TRECNAM) = SIGNON NAME
*
* EXIT (X6) = -1 IF RESERVED BY A STATION
* 0 IF NOT RESERVED
* (X5) = INDEX TO ENTRY WHERE FOUND
* (X4) = PREVIOUS ENTRY IN CHAIN (-1 IF NONE)
* (X0) = ECS ADDRESS OF RESERVATION
* (SIGNCM) = RESERVATION ENTRY (3 WORDS)
*
*
ENTRY FINDRES
FINDRES EQ *
SA1 TRECNAM COMBINE NAME
SA2 TRECNAM+1
SA3 TDSNAME AND GROUP
IX1 X1+X2
IX1 X1+X3
MX6 12
BX1 -X6*X1 MASK OFF EXPONENT
PX6 X1
NX6 X6
SX2 NUMRESV SIZE OF HASH SECTION OF TABLE
PX3 X2
NX3 X3
FX6 X6/X3 INDEX/TABLESIZE
UX6 X6,B1
LX6 X6,B1 INT(INDEX/TABLESIZE)
IX6 X2*X6 TABLESIZE*INT(INDEX/TABLESIZE)
IX5 X1-X6 INDEX MOD TABLESIZE
MX4 -1 INITIALIZE PREVIOUS INDEX
* /--- BLOCK FINDRES 00 000 80/07/02 00.14
*
* * CHECK IF SIGNON ENTRY MATCHES
*
READRES SA1 ASIGNON ECS ADDRESS OF TABLE
SX2 RESVLTH SIZE OF EACH ENTRY
IX6 X5*X2 BIAS TO THIS ENTRY
IX0 X1+X6
SA0 SIGNCM
RE RESVLTH
RJ ECSPRTY
SA1 A0 PICK UP FIRST WORD
ZR X1,EMPTY --- DETECT THIS ENTRY EMPTY
SB1 1
SA1 TRECNAM
SA2 SIGNCM
BX6 X1-X2 COMPARE FIRST WORD
NZ X6,REHASH --- REHASH IF NO MATCH
SA1 A1+B1
SA2 A2+B1
BX6 X1-X2 COMPARE SECOND WORD
MX7 -12
BX6 X7*X6 MASK OFF UNUSED BITS
NZ X6,REHASH --- REHASH IF NO MATCH
SA1 TDSNAME
SA2 A2+B1
BX6 X1-X2 COMPARE THIRD WORD
BX6 X7*X6 MASK OFF UNUSED BITS
NZ X6,REHASH --- REHASH IF NO MATCH
BX3 X0 SAVE ECS ADDRESS
BX0 X3 RESTORE ECS ADDRESS
MX6 -1 -1 = FOUND
EQ FINDRES --- EXIT
*
* * SELECT NEXT ENTRY IN CHAIN
*
REHASH BX4 X5 SET PREVIOUS INDEX TO ENTRY
SA1 SIGNCM+1 PICK UP SECOND WORD OF ENTRY
MX6 -12
BX5 -X6*X1 MASK OFF INDEX TO NEXT ENTRY
NZ X5,READRES --- JUMP IF NOT END-OF-CHAIN
*
EMPTY BSS 0
MX6 0 0 = NOT FOUND
EQ FINDRES --- EXIT
* /--- BLOCK LJUSTC 00 000 77/08/17 23.07
TITLE LJUSTC LEFT JUSTIFY CODEWORD
*
* LJUSTC
*
* 'LEFT JUSTIFIES THE NAME IN X1, CHANGING ANY
* ENCLOSED ZEROS TO SPACES.
*
*
ENTRY LJUSTC
LJUSTC EQ *
ZR X1,LJUSTC --- EXIT IF ALL ZEROS (OR -0)
MX0 6 MASK FOR ONE CHARACTER
LX1 -6 ACCOUNT FOR INITIAL SHIFT
LJC1 LX1 6 GET NEXT CHAR TO TOP
BX2 X0*X1 EXTRACT
ZR X2,LJC1 ELIMINATE LEADING ZEROS
SB1 1
SB2 9
MX0 -6 SEARCH FOR LAST CHAR (NONZERO)
SX4 1R X4 = SPACE CODE FOR FILL
LJC2 BX2 -X0*X1
LX0 6 SHIFT MASK
LX4 6 SHIFT FILL CHARACTER
SB2 B2-B1
ZR X2,LJC2
NG B2,LJUSTC --- EXIT IF ONLY 1 CHAR
LJC3 BX2 -X0*X1
NZ X2,LJC4
BX1 X1+X4
LJC4 LX0 6
LX4 6
SB2 B2-B1
PL B2,LJC3
EQ LJUSTC --- EXIT
* /--- BLOCK MASTERFILE 00 000 82/10/01 17.13
TITLE MASTERFILE FUNCTIONS
RMFSIZE SPACE 4,10
** RMFSIZE - READ MASTERFILE DIRECTORY SIZE.
*
* READS MASTERFILE DIRECTORY SIZE FROM THE MASTER-
* FILE DIRECTORY FOR A SPECIFIC MASTERFILE.
*
* ENTRY (X1) = MASTERFILE NAME OR NUMBER
*
* EXIT (X1) = NUM OF DIRECTORY BLOCKS IF MF ACTIVE
* = -1 IF MASTERFILE NOT ACTIVE
*
* USES A - 0, 1, 2.
* B - 1, 3.
* X - 0, 1, 2.
*
* CALLS NONE.
*
* MACROS NONE.
RMFSIZE EQ *
SA0 PNAMES (A0) = MASTERFILE NAMES FWA
* CHECK IF WE HAVE A NUMBER
NG X1,RMF10 IF A NAME (NO MF NUMBER IS NEG)
SB3 X1 (B3) = PRESET TO POSS MF NUM
SX2 NDSUS (X2) = NUMBER OF MASTERFILES
IX2 X1-X2 COMPARE PARAMETER WITH NDSUS
PL X2,RMF10 IF A NAME (NOT IN (0..NDSUS-1))
SA2 A0+B3 (X2) = THE MASTERFILE NAME
NZ X2,RMF40 IF MASTERFILE ACTIVE
EQ RMF30 MASTERFILE NOT ACTIVE
* LOOP THROUGH LIST FOR THIS MASTERFILE NAME
RMF10 BSS 0
SB3 NDSUS (B3) = NUMBER OF MASTERFILES
RMF20 BSS 0
SA2 A0+B3 (X2) = NEXT MASTERFILE NAME
BX2 X1-X2 COMPARE WITH SPECIFIED MF NAME
ZR X2,RMF40 IF THIS MF (IF THEY ARE SAME)
SB3 B3-B1 (B3) = NEXT ORDINAL
PL B3,RMF20 IF MORE MFS TO SEARCH THROUGH
RMF30 BSS 0
MX1 -1 (X1) = -1 = MF NOT ACTIVE
EQ RMFSIZE
* GET DIRECTORY SIZE FIELD FOR THIS MASTERFILE
RMF40 BSS 0
SA1 PITS+B3 (X1) = EM ADDR OF SPEC MF DIR
SX0 2 (X0) = OFFSET TO FIRST PARAMETR
IX0 X0+X1 (X0) = EM ADDR OF FRST PARAMETR
RX1 X0 (-RXX- 1 WD READ, MAY CHG *A1*)
MX0 -6 (X0) = MASK FOR DIR SIZE FIELD
LX1 60D-48D POSITION DIR SIZE TO LOW BITS
BX1 -X0*X1 (X1) = DIRECTORY SIZE FIELD
EQ RMFSIZE
* /--- BLOCK MASTERFILE 00 000 79/04/06 23.31
SPACE 4,10
** S"MF$" - RETURN *MF$* FOR A SPECIFIC MASTERFILE.
*
* RETURNS THE VALUE OF MASTERFILE PARAMETER *MF$*
* FOR A SPECIFIED MASTERFILE. POSSIBLE PARAMETERS
* ARE *DCPP*, *NMFBLK*, *PITLTH*, AND *MFFILS*.
*
* ENTRY (X1) = MASTERFILE NAME OR NUMBER
*
* EXIT (X1) = *MF$* FOR THE MASTERFILE IF ACTIVE
* = -1 IF MASTERFILE NOT ACTIVE
*
* USES A - NONE.
* B - NONE.
* X - 1.
*
* CALLS RMFSIZE.
*
* MACROS NONE.
PURGMAC MFFUNC
MACREF MFFUNC$
MFFUNC MACRO ARG
LOCAL LAB20
MACREF MFFUNC
MF$ MICRO 1,, ARG
ENTRY S"MF$"
S"MF$" EQ *
CALL RMFSIZE
NG X1,S"MF$" IF MASTERFILE NOT ACTIVE
NZ X1,LAB20 IF NOT A 2-PART DIRECTORY MF
* GET PARM FOR A 2-PART DIRECTORY MASTERFILE
SX1 "MF$"2 (X1) = *MF$* FOR A 2-PART MF
EQ S"MF$"
* GET PARM FOR A 3-PART DIRECTORY MASTERFILE
LAB20 BSS 0
SX1 "MF$"3 (X1) = *MF$* FOR A 3-PART MF
EQ S"MF$"
ENDM
MFFUNC DCPP
MFFUNC NMFBLK
MFFUNC PITLTH
MFFUNC MFFILS
MFFUNC MFLTH
* /--- BLOCK END 00 000 77/11/14 19.48
*
END