Retro1.org codex

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