ASMB,R,L,C
      HED RFAM 91700-16126 REV A * (C) HEWLETT-PACKARD CO. 1976 
      NAM RFAM,18,30 91700-16126 REV A 760303 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
******************************************************************
      SPC 2 
      EXT $LIBR,$LIBX 
      EXT EXEC
      IFZ 
      EXT DBUG
      XIF 
      EXT R/W$
      EXT OVFLA   ADDRESS OF OVERFLOW FILE INFO 
      EXT RMPAR 
      EXT D65SV 
      EXT D65CL 
      SUP 
      SPC 3 
* 
* RFAM
* SOURCE: 91700-18126 
* BINARY: 91700-16126 
* SHANE DICKEY
* DATE JULY 30,1974 
* 
*     DATE MODIFIED: FEBRUARY 1976
* 
* 
* Z OPTION INCLUDES DEBUG PACKAGE 
A     EQU 0 
B     EQU 1 
      SKP 
****************************************************
*                                                  *
* SIZE IS THE SIZE OF THE BSS AVAILABLE FOR        *
* THE FST AND RFAMD TABLES (THE LENGTH OF THE      *
* RBOOT SUBROUTINE IS ALSO ADDED) IT IS A          *
* FUNCTION OF THE FOREGROUND DISC RESIDENT AREA    *
* SIZE                                             *
*                                                  *
*      $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$           *
*      $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$           *
*      $$                             $$           *
*      $$    W A R N I N G  ! ! !     $$           *
*      $$                             $$           *
*      $$  SIZE MUST NOT EXEED 4747   $$           *
*      $$  LOSS OF DCB'S AND OTHER    $$           *
*      $$  STRANGE THINGS MIGHT       $$           *
*      $$  HAPPEN IF THIS IS NOT      $$           *
*      $$  RESPECTED.                 $$           *
*      $$                             $$           *
*      $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$           *
*      $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$           *
*                                                  *
*                                                  *
****************************************************
      SPC 5 
SIZE  EQU 2005
      SPC 5 
      SPC 5 
LSNPR NOP           DEF DEC 99
      NOP           DEF # RFAMD ENTRIES 
ICLAS NOP           DEF I-O CLASS 
CLASI NOP           CLASS FOR RFAEX (WITH BIT 13 SET) 
      NOP 
RFAM  NOP 
* 
* GET THE I/O CLASS FOR THIS MONITOR SET UP BY LSTEN
* 
START LDA B,I 
      IFZ 
      SZA,RSS       IF ZERO INITIALIZE CALL-SET UP
      JMP BUGD      AND TERMINATE-IF REAL LSTEN CALL- 
      XIF 
      JSB RMPAR 
      DEF *+2 
      DEF LSNPR 
* 
      LDA LSNPR     CHECK IF LSTEN SCHEDULED RFAM 
      CPA D99 
      JMP RBOOT     YES 
      JMP ILSCH     NO OUTPUT ERROR MSG 
      IFZ 
* 
* 
BUGD  JSB DBUG      SET UP DBUG 
      DEF *+1 
* 
      JSB EXEC      SAVE RESOURCES AND TERMINATE
      DEF *+4 
      DEF D6
      DEF ZERO
      DEF D1
      XIF 
* 
* SET UP RFAEX TO DO 2ND OF THE THREE PART PROCESSING 
* OF THIS REQUEST-1ST AND THIRD DONE BY RFAM- 
* GET AN I/O CLASS FOR RFAEX AND SET IT UP TO WAIT
* FOR INPUT 
* 
      IFZ 
      JMP START     LSTEN CALL STARTS HERE
      XIF 
* ISSUE GET ON I/O CLASS
* 
GET1  JSB EXEC      THIS GET WILL SUSPEND 
      DEF *+5       RFAM UNTIL QUEUE SENDS
      DEF D21       AN RFA EXEC CALL TO THE MONITOR 
      DEF ICLAS     UPON ACTIVATION THE REQUEST PARMB WILL BE 
      DEF IRBUF     IN THE IRBUF BUFFER AREA
      DEF IRBFL 
* 
*     IF ANY ERROR OCCURED IN THIS GET IT IS PROBANLY 
*     A LOSS OF CLASS NUMBER. THIS IS A CATASTROPHIC
*     ERROR FROM WICH WE CANNOT RECOVER. LET THE MONITOR
*     ABORT.
* 
* PARMB+24=LU 
* 
* MOVE FILE NAME TO FSNAM FROM PARMB
* 
* 
      LDB PARMB 
      ADB D6
* 
      JSB PIKUP     GET 1ST TWO CHARS 
      STA NNAME 
* 
      JSB PIKUP     THEN NEXT TWO 
      STA NNAME+1 
* 
      JSB PIKUP 
      STA NNAME+2 
* 
      LDA PARMB 
      ADA D22 
* 
      LDB A,I       GET CURRENT DCB ADDRESS 
      RSS           CHASE THE INDIRECT
      LDB B,I 
      RBL,CLE,SLB,ERB 
      JMP *-2 
      STB CDCBA 
* 
      INA 
      INA           THEN GET LU # 
      LDA A,I 
      AND MSK8      KEEP ONLY THE LOWER 6 BITS
      STA LU
* 
* 
* 
* 
* ALL ENTRIES TO THIS PROGRAM ARE REMOTE FILE ACCESS
* REQUESTS AND AS SUCH MUST BE CLEARED THROUGH THE
* FILE STATE TABLE (FST). 
* DETERMINE THE FUNCTION CODE OF THE REQUEST
* AND ERROR CHECK IT
* SET UP ERROR REGISTER 
* 
* 
      LDA PARMB     PICK UP THE 
      ADA D2        FUNCTION
      LDA A,I 
      AND MSK1      CODE-MASK OUT THE SESSION 
      ADA BASE      NUMBER AND ADJUST SO IT IS
      STA FCODE     A VALID LOOKUP POINTER
      LDB A 
      LDA MD25      ERROR CODE FOR "BAD FCODE"
      SSB           IS THE FUNCTION CODE NEGATIVE 
      JMP FMER      IF SO IT IS IN ERROR
      SZB,RSS       IS THE FUNCTION CODE
      JMP FMER      ZERO- IF SO ERROR 
      ADB MAXFN     IS THE FUNCTION CODE LARGER 
      SSB,RSS       THAN THOSE DEFINED ? IF SO
      JMP FMER      IT IS IN ERROR
      SPC 2 
* USE B REGISTER AS ERROR INDICATOR 
* NOTE THE NAME IS NOT IN PARMB+6 FOR THE STATUS CALL 
* SET UP AND CALL RFAM FST PROCESSOR
* 
* 
      LDA FCODE 
      ADA FSTTA 
      LDA A,I 
      JSB A,I 
* 
* 
* NOW WRITE THE REQUEST TO THE I/O CLASS OF RFAEX 
      JSB EXEC
      DEF *+8 
      DEF B124      D20 WITH SIGN BIT SET 
      DEF ICWRD 
      DEF IRBUF 
      DEF IRBFL 
      DEF IRM1
      DEF IRM2
      DEF CLASI 
* 
      JMP CLER2     ERROR RETURN
* 
* 
* SCHEDULE RFAEX WITH WAIT. RFAM WILL WAIT UNTIL RFAEX IS 
* ALL DONE, RFAEX WILL THEN TERMINATE AND BVE RESTARTED BY
* THIS SCHEDULE CALL. RFAEX WILL THEN GO BACK TO HAG ON 
* ITS CLASS GET.
* 
      JSB EXEC
      DEF *+3 
      DEF D9
      DEF RFAEX 
* 
* SET UP THE RFAM POST PROCESS S/R AND EXECUTE IT 
      LDA FCODE 
      ADA FSTTB 
      LDA A,I 
      JSB A,I 
* 
      JMP GET1
      HED RFAM: UTILITY S/R'S * (C) HEWLEWTT-PACKARD CO. 1976 
SCERR JSB EXEC      OUTPUT SCHED FAILURE
      DEF *+5 
      DEF D2
      DEF D1
      DEF ERMG1 
      DEF ERM1L 
* 
LSTRT CLA 
      STA CLASI     TELL LSTEN--NO SOAP 
* 
      LDA LSNPR     GET 1ST SCHEDULE PARAMETER
      CPA D98       UPLIN ? 
      JMP TOUT      YES, DONT WORRY ABOUT LSTEN 
* 
* 
* SCHEDULE LSTEN AND PASS FAILURE 
      JSB EXEC
      DEF *+4 
      DEF D10 
      DEF LSTEN 
      DEF CLASI 
* 
TOUT  JSB EXEC      SAVE RESOURCES & TERMINATE
      DEF *+4 
      DEF D6
      DEF ZERO
      DEF D1
* 
      JMP START 
LSTEN ASC 3,LSTEN 
* 
CLER2 JSB EXEC
      DEF *+5 
      DEF D2
      DEF D1
      DEF ERMG
      DEF ERMGL 
* 
      LDA MD26      ERROR CODE
      JMP FMER
* 
* 
ILSCH JSB EXEC
      DEF *+5 
      DEF D2
      DEF D1
      DEF ERMG2 
      DEF ERM2L 
* 
      JMP TOUT
* 
* 
      HED RFAM: S-R'S * (C) HEWLETT-PACKARD CO. 1976
MTSLT NOP 
* NEW REQUESTS ARE PROCESSED HERE 
*  A NEW REQUEST MUST BE INSERTED IF RFAMD BEFORE 
* PROCESSING CAN COMMENCE 
* 
* 
* SEARCH RFAMD FOR AN EMPTY SLOT AS DEFINED BY A 0
* IN THE 1ST NAME WORD. 
* 
* 
* ON RETURN PONTO POINTS TO 1ST RFAMD NAME WORD 
* B CONTAINS THE NUMBER OF THE RFAMD ENTRY
* NORMAL RETURN JSB+1 
* ERROR RETURN JSB+2 (NO ROOM IN RFAMD) 
* 
      CLB,INB       CLEAR ENTRY COUNTER 
      LDA RFAMA     PICK UP ADDRESS OF 1ST RFAMD
      STA PONTO     ADDRESS & PICK UP 1ST WORD
LOOP2 LDA PONTO,I   OF NAME IS IT 
      CPA M1
      JMP NOMT
      SZA,RSS       ZERO-IF NOT THIS ENTRY IS FREE
      JMP MTSLT,I   NORMAL RETURN 
      LDA PONTO     STEP TO NEXT NAME PORTION 
      ADA RFADL 
      STA PONTO 
      INB           INCREMENT ENTRY COUNTER 
      JMP LOOP2     IF NOT TRY AGAIN
NOMT  LDA MD28      IF DONE-NO ROOM IN THE INN
      ISZ MTSLT     NO "MT" SLOTS-RETURN ERROR
      JMP MTSLT,I 
      SPC 5 
TEST  NOP 
* THIS S/R LOOKS THROUGH THE RFAMD TABLE
* AND DETERMINES IF MORE THAN ONE TERMINAL
* HAS A GIVEN FILE OPEN CURRENTLY-IT RETURNS THE
* NUMBER OF FILES OPEN IN THE VARIABLE FILE#
* 
      CLA           INITIALIZE THE NUMBER OF FILES
      STA FILE#     OPEN TO ZERO
* 
      LDB RFAMA     PICK UP THE DIRECTORY ADDRESS 
* 
LP11  LDA B,I       PICK UP THE FIRST WORD OF 
      CPA M1        THE NEXT DIRECTORY ENTRY
      JMP TEST,I    IF -1 WE ARE DONE 
* THIS IS A VALID ENTRY SO CHECK NAME & INCREMENT 
* COUNT IF IT MATCHES 
      CPA NNAME 
      JMP *+3 
      ADB D5
      JMP LP11
* FIRST WORD NAME MATCHES-DOES SECOND?
      INB 
      LDA B,I 
      CPA NNAME+1 
      JMP *+3 
      ADB D4
      JMP LP11
* SECOND NAME WORD MATCHES-DOES THIRD?
      INB 
      LDA B,I 
      CPA NNAME+2 
      JMP *+3 
      ADB D3
      JMP LP11
* NAME MATCHES SO INCREMENT NUMBER OF TERMINALS 
* THAT CURRENTLY HAVE THIS FILE OPEN
      ISZ FILE# 
* GO LOOK FOR MORE
      STB FILE#+1 
      ADB D3        STEP TO NEXT RFAMD ENTRY
      JMP LP11
      SPC 5 
* THIS SUBROUTINE SENDS BACK THE ERROR
* THAT WOULD ORDINARLY COME BACK FROM THE FMP 
* THE ERROR TO BE PASSED BACK IS IN THE A REG.
      SPC 2 
FMER  STA ERRTP 
      LDA IMOD1     BUILD THE MODE
      IOR D2
      STA IMODE 
* 
* 
      LDA PARMB 
      CLB           SET RETURNED A & B TO 0 
      ADA D2
      STB A,I 
      INA 
      STB A,I 
* 
      INA 
      LDB ERRTP     PICK UP ERROR TYPE
      STB A,I 
* SEND A STOP IF IT IS A READ OR WRITE
      LDA FCODE 
      CPA D4        IS IT WRITE?
      JMP STOP      YES 
* 
      CPA D5        IS IT A READ? 
      JMP STOP      YES 
      JMP GOER      NO-CONTINUE 
* 
* SEND STOP 
* 
STOP  JSB D65CL 
      DEF *+7 
      DEF IRC       STOP CODE 
      DEF LU
      DEF DUMMY 
      DEF DUMMY 
      DEF DUMMY 
      DEF DUMMY 
* 
      JMP ABERR     ERROR RETURN
* 
* SET THE RETURN BIT IN THE STREAM WORD 
GOER  LDA IRBUF     PICK UP THE STYREAM TYPE
      IOR MSK14     SET THE REPLY BIT 
      STA IRBUF     & REPLACE IT
      AND B4000     ISOLATE F BIT 
      LDB IRBFL     GET NORMAL LENGTH 
      SZA,RSS       F BIT SET ? 
      LDB D5        NO, GET SHORT LENGTH
      STB LENGT     SAVE FOR CALL 
* SEND IT BACK
* 
     JSB D65SV
      DEF *+7 
      DEF IRWW      WRITE CODE
      DEF LU        REQUEST ONLY
      DEF IRBUF 
      DEF LENGT     REQ. LENGTH 
      DEF DUMMY 
      DEF DUMMY 
* 
ABERR JSB ERR2      ERROR RETURN
* 
      JMP GET1
      SPC 5 
CLOSE NOP 
      JSB TEST      OPEN TO OTHER REMOTE USERS? 
      LDA FILE#     PICK UP NUMBER OF USERS WHO HAVE
      CPA ZERO      FILE OPEN-IF NOBODY 
      JMP M8ERR     AN ERROR-WAS SCLOS JMP
      ADA M2        THIS FILE OPEN-MORE THAN 1 ?
      SSA,RSS       IF YES MAYBE A SPECIAL CLOSE
      JMP CLOSA     TEST TO SEE 
      JSB FDFST     OTHERWISE OPEN TO 1-IS IT OURS
      JMP SCLOS     YES STANDARD CLOSE REQUIRED 
M8ERR LDA M11       OPEN TO SOMEBODY ELSE-CANT CLOSE
      JMP FMER
* 
CLOSA JSB FDFST     IS OUR REQUESTOR AMOUNG THOSE 
      JMP *+2       WITH FILE OPEN? ERROR IF NOT
      JMP M8ERR 
* YES SPECIAL CLOSE REQUIRED AS FOLLOWS:
* THIS SPECIAL CLOSE S/R REQUIRES THE DCB TO BE 
* SET UP PRIOR TO CALL- NOTE THAT IT TAKES THE
* PLACE OF THE DISC SCHEDULE
      JSB FST2A     SET UP THE EXISTING DCB 
      CLE 
      LDB CDCBA 
      INB 
* 
      JSB R/W$
      JMP FMER
* SEND REPLY & POSTPROCESS
* 
      JSB DEALC     POSTPROCESS THE CLOSE 
* 
      LDA CDCBA     PICK UP THE ADDRESS 
      ADA D145      OF THE RETURNED 
      LDA A,I       ERROR WORD FROM FMP 
      JMP FMER      THEN SEND THE REPLY 
      SPC 2 
SCLOS JSB FST2A     EXECUTE STANDARD CLOSE
      JMP CLOSE,I 
      SPC 5 
FST3A NOP 
* THIS S/R PREPROCESSES PURGE AND RENAME FOR
* SPECIAL CONSIDERATIONS
* 
* IF A PURGE OR RENAME IS REQUIRED ON A FILE OPEN 
* TO TWO OR MORE TERMINALS THEN A SPECIAL CASE
* EXISTS
      JSB TEST      MORE THAN 1 TERMINAL HAS THIS 
      LDA FILE#     FILE OPEN IF FILE# IS GREATER 
      CPA ZERO
      JMP FST4Z 
      ADA M2        THAN 1
      SSA           IF SO SEND BACK A -8 ERROR
      JMP FST4X     IF NOT PROCESS  AS USUSAL 
* 
FST4Y LDA M8        SET UP -8 ERROR CODE
      JMP FMER      AND RETURN IT 
* 
* THIS FILE IS ONLY OPEN TO ONE TERMINAL BUT IT 
* MAY NOT BE OUR REQUESTOR-IN WHICH CASE IT IS
* AN ERROR
FST4X JSB FDFST 
      JMP *+2       IT IS OUR REQUESTOR-LET IT THRU 
      JMP FST4Y     SOMEBODY ELSE-ERROR 
FST4Z JSB FST2A     EXECUTE STANDARD PREPROCESS 
      JMP FST3A,I   SUBROUTINE & EXIT 
      SPC 5 
FST4A NOP 
* SET THE OPEN FLAG TO NONEXCLUSIVE 
      CLA 
      STA EXFLG 
* THIS S/R HANDLES OPEN REQUESTS FOR THE SPECIAL
* EXCLUSIVE OPEN CASE-IF A FILE IS TO BE OPENED 
* EXCLUSIVELY THEN A CHECK IS MADE TO DETERMINE 
* IF ANY OTHER TERMINAL REQUESTORS HAVE IT OPEN 
* CURRENTLY-IF NONE DO IT IS ALLOWED AND THE FILE 
* MANAGER WILL CATCH ANY NONE TERMINAL DUPLICATIONS 
* IF THE OPEN IS NOT EXCLUSIVE IT IS ALLOWED
* THROUGH FOR NORMAL PROCESSING 
* TEST IF EXCLUSIVE OPEN
      LDB PARMB     PICK UP CONTROL BYTE FOR 1ST
      ADB D9        OPTIONAL PARAMETER-IF NOT PRESE 
      LDA B,I       -NT DEFAULT (EXCLUSIVE OPEN)
      AND MSK1      STRIP ALL BUT CONTROL BYTE
      SZA,RSS       IF C.B. 0 THEN END OF PARMB 
      JMP EXCOP     & DEFAULT CONDITION 
* 
* IF PRESENT PICK UP THE WORD & TEST BIT 1
      INB 
      LDA B,I       PICK UP PASSED PARAMETER &
      AND MSK13     CLEAR ALL BUT BIT 1 
      SZA,RSS       IF BIT IS 0 EXCLUSIVE OPEN
      JMP EXCOP     GO MAKE EXCLUSIVE OPEN TEST 
* IF NOT EXCLUSIVE OPEN THIS REQUEST CAN BE LET 
* THROUGH THE REGULAR LOGIC 
* THE NEW REQUEST IS NOT EXCLUSIVE-BUT IT CAN BE
* HONORED ONLY IF THERE ARE NO OTHER TERMINALS WITH 
* THE FILE EXCLUSIVELY OPEN ALREADY 
* DETERMINE HOW MANY TERMINALS HAVE THIS FILE OPEN
      JSB TEST
      LDA FILE#     PICK UP # OF TERMINALS
      CPA ZERO      IF ZERO ALL SET TO LET IT THRU
      JMP FST2Y 
* 
      CPA D1        IF NOT 0 OR 1 MUST BE NONEXCLUSV
      JMP FST2V     GO CHECK 1 REQUESTOR FOR EX OPEN
      JMP FST2Y     MORE THAN 1 MUST BE OK
* 
FST2V LDA FILE#+1   PICK UP ADDRESS OF LAST WORD
      INA           OF NAME AND INCREMENT TO LU 
      LDA A,I       PICK UP AND TEST EX FLAG BIT
      SSA           (SIGN BIT)-IF SET THEN IT'S EX- 
      JMP FST2W     OPEN-IF NOT US REJECT 
* 
FST2Y JSB FST2A 
      JMP FST4A,I   RETURN AFTER REGULAR PROCESSING 
* THE EXCLUSIVE OPENS ARE HANDLED HERE
* FIRST SEE HOW MANY GUYS HAVE THIS FILE OPEN 
EXCOP JSB TEST
      LDA FILE#     IF THIS NUMBER IS 0 LET ER RIP
      CPA ZERO      BECAUSE THIS FILE IS NOT OPEN 
      JMP FST2U     TO ANY TERMINAL 
      CPA D1        IF IT IS 1 THEN THE FILE MAY
      JMP FST2Z     BE OPEN TO THIS USER ALREADY
* IF OPEN TO MORE THAN ONE THENAN EXCLUSIVE OPEN
* CANNOT BE ALLOWED 
FST2X JSB FDFST     OPEN FAILED-IS CLOSE REQUIRED?
      JMP *+2       YES- SET UP DCB FOR CLOSE CALL
      JMP FST2T     NO DCB-CLOSE NOT NEEDED 
* 
      JSB FST2A     GO SET UP DCB FOR CLOSE 
      JSB DEALC 
      LDB CDCBA     SET UP THE DCB ADDRESS
      INB           STEP PAST THE FLAG WORD 
      CLE 
* 
      JSB R/W$      CALL CLOSE WITHOUR THE PARMB
      JMP FMER      ERROR RETURN (A REG = -1) 
* 
FST2T LDA M8        SET UP OPEN ERROR FLAG
      JMP FMER
FST2Z JSB FDFST     IF THE ONLY USER TO WHOM THIS 
      JMP FST2U     FILE IS OPEN IS OUR USER IT'S OK
      JMP FST2X     OTHERWISE IT'S IN ERROR 
* SET THE OPEN FLAG TO EXCLUSIVE
FST2U CCA 
      STA EXFLG 
      JMP FST2Y     CONTINUE PROCESSING 
FST2W JSB FDFST     FIND OUT IF ONLY 1 IS US
      JMP *+2       YES-CONTINUE
      JMP FST2X     NO RETURN ERROR MSG.
      LDB FILE#+1   SET UP TO CLEAR THE EX OPEN FLAG
      INB 
      LDA B,I       PICK UP LU WORD & CLEAR 
      AND MSK4      THE EX-OPEN FLAG
      STA B,I       THEN PUT IT BACK
      JMP FST2Y     NOW PROCESS THE NONEXCLUSIVE OPN
      SPC 5 
FST5A NOP 
* THIS S/R PROCESSES THE CREATES & ONLY ALLOWS
* THOSE WHICH CAN RESULT IN AN EXCLUSIVE OPEN 
* CONDITION UPON SUCCESSFUL COMPLETION
* 
* IS THIS FILE OPEN TO ANYONE OTHER THAN THE CALLER 
      JSB TEST      DETERMINE HOW MANY TERMINALS
      LDA FILE#     HAVE THIS FILE OPEN!
      CPA ZERO      IF ZERO LET'ER REP
      JMP FST5Y 
      CPA D1        IF ONLY 1 STILL MAY BE OK 
      JMP FST5Z     BUT ONLY IF OUR TERMINAL-GO SEE 
* MORE THAN ONE TERMINAL HAS IT SO EXCLUSIVE
* OPEN WON'T WORD -GIVE DUPLICATE NAME ERROR
FST5X LDA M2
      JMP FMER      GIVE SIMULATED FMP ERROR
* 
FST5Z JSB FDFST     FIND OUT WHO HAS IT ALREADY 
      JMP FST5Y     IT'S US LET IT THROUGH
      JMP FST5X     SOMEBODY ELSE SEND -2 
* IF ALL IS WELL CONTROL HERE 
FST5Y JSB FST2A     DO STANDARD PREPROCESS
      JMP FST5A,I   AND RETURN AFTER IT'S DONE
      SPC 5 
FDFST NOP 
* ON RETURN:
* B REG POINTS TO THE START OF THE RFAMD ENTRY
* (NORMAL RETURN ONLY)
*  NORMAL RETURN FOLLOWING JSB
* B CONTAINS ERROR CODE (-11) ON NOT FOUND
* ERROR RETURN (NEXT RETURN)
* THE RFAM DIREDTORY WILL NOW BE SEARCHED FOR 
* A MATCH UNTIL A -1 IS ENCOUNTERED (END OF TABLE)
* FIRST PICK UP THE TABLE ADDRESS 
      LDB RFAMA 
LOOP1 LDA B,I 
      CPA M1
      JMP NOTHR 
* THIS IS A VALID ENTRY SO CHECK NAME & THEN LU 
      CPA NNAME 
      JMP *+3 
      ADB D5
      JMP LOOP1 
* FIRST WORD NAME MATCHES DOES SECOND?
      INB 
      LDA B,I 
      CPA NNAME+1 
      JMP *+3 
      ADB D4
      JMP LOOP1 
* SECOND NAME WORD MATCHES-DOES THIRD?
      INB 
      LDA B,I 
      CPA NNAME+2 
      JMP *+3 
      ADB D3
      JMP LOOP1 
* THIRD NAME WORD MATCHES-DOES LU # OF REQUESTING 
* TERMINAL
      INB 
      LDA B,I 
      AND MSK8      STRIP OFF STATUS BITS 
      CPA LU
* IF THE ENTRY HAS BEEN FOUND WE ARE "DUN"
      JMP DUN 
* IF NOT LOOP BACK FOR THE NEXT ENTRY 
      ADB D2
      JMP LOOP1 
* IF THE ENTRY IS NOT IN THE TABLE CONTROL COMES
* HERE
NOTHR LDA M11 
* SET UP THE ERROR FLAG IN THE B REG INCREMENT
* TO THE ERROR RETURN & RETURN
      ISZ FDFST 
      JMP FDFST,I 
DUN   ADB M3
      JMP FDFST,I 
      SPC 5 
SWAP  NOP 
* THIS S/R EXPECTS THE A REGISTER TO CONTAIN THE
* RELATIVE ENTRY #(IN THE FST)OF THE DCB THAT IS
* TO BE FILLED FROM CDCB. ALSO THE SIGN BIT WILL BE 
* SET TO 1 IF A TWO WAY MOVE IS TO BE MADE. 
      STA FLAGX SAVE UNTIL AFTER CALCULATION
* 
      AND MSK4      PICK UP THE RELATIVE
      STA FSINC     SAVE THE FST INCREMENT
* CALCULATE ADDRESS OF 1ST FST WORD TO BE MOVED 
      ADA M1
      MPY FSTLN     SET UP
      ADA FSTAD     DESTINATION 
      STA SOURC     ADRESS
      STA FSINC+1   SAVE THE FST ADDRESS
      LDB CDCBA 
      STB DEST
* SET UP LOOP COUNTER 
      LDB FSTLN 
      CMB,INB 
      STB CONTR 
      LDA FLAGX     SET UP SWAP DIRECTION 
      CLE           THE E REGISTER IS SET 
      SSA           TO ZERO IF THE MOVE IS
      CCE           ONE WAY 
LOOP3 LDA DEST,I    PICK UP CDCB WORD IN A REG $ FST
      SEZ           WORD IN B (IF TWO WAY MOVE) 
      LDB SOURC,I   THEN STORE A IN FST 
      STA SOURC,I   & IF A TWO WAY MOVE STORE 
      SEZ           B IN CDC THUS ONE CYCLE 
      STB DEST,I    IS COMPLETE 
* INCREMENT LOOP POINTERS & CONTINUE
      ISZ SOURC     INCREMENT SOURCE &
      ISZ DEST      DESTINATION COUNTERS
      ISZ CONTR     INCREMENT LOOP COUNTER &
      JMP LOOP3     CONTINUE UNTIL DONE 
* IS THE ENTRY MOVED TO FST USEFUL OR WAS CDCB EMPTY
      LDA FREE      IF EMPTY NO NEED TO SET UP
      SZA           THE RFAMD POINTER BECAUSE IT
      JMP SWAP,I    DOESN'T EXIST ANYMORE 
* NOW RESET CORE POINTER ON ENTRY THAT WAS IN CDCB
* TO NEW FST POSITION 
      LDA FSINC+1,I PICK UP 1ST FST WORD &
      ALF,ALF       ISOLATE THE RFAMD ENTRY POINTER 
      ALF,ARS       CONTAINED THERE-THEN CONVERT
      AND MSK1      THIS ENTRY # TO AN ENTRY
      ADA M1        ADDRESS FOR WORD 5 OF RFAMD 
      MPY RFADL     ENTRY 
      ADA RFAMA 
      ADA D4
      STA FSINC+2   STORE CALCULATED ADDRESS
* 
      LDA FSINC+2,I PICKUP WORD 5 OF RFAMD ENTRY &
      AND MSK2      CLEAR THE OLD FST POINTER 
* 
      LDB FSINC     NOW PICK UP NEW FST INCREMENT & 
      BLF,BLF       ROTATE IT INTO BITS 8-14 THEN 
      IOR B         MERGE IT INTO WORD 5 OF RFAMD 
      STA FSINC+2,I ENTRY & FINALLY PUT IT BACK 
* SET FST ENTRY BUSY
      LDA FSINC+1,I 
      IOR MSK5
* THE FOLLOWING IS A DUPLICATION OF EFFORT EXCEPT 
* FOR A SWAP AFTER A ROLL OUT-THEN IT IS NEEDED 
      AND MSK7      ROLLED IN FST ENTRY 
      IOR #INCR     = TO THE NO. OF ENTRIES 
      ADA M1
      STA FSINC+1,I IN CORE 
      JMP SWAP,I    RETURN
* 
      SPC 5 
AGE   NOP 
* AGE TESTS AGE OF ALL FILES CURRENTLY IN 
* CORE & ROLLS OUT THE OLDEST ONE-THE ENTRY # OF THE
* VACATED FST ENTRY IS RETURNED IN THE A REG. 
* 
* 
      CLA           INITIALIZATION FOR THE CHECK
      STA ROLL      ON THE AGEING SCHEME
      CLB,INB       INITIALIZE THE ENTRY
      STB TEMP+1    NUMBER THEN 
      LDA #FENT     BUILD A COUNTER FOR # 
      CMA,INA       OF FST ENTRIES IN 
      STA CONTR     CORE CURRENTLY
* 
      LDB FSTAD     PICK UP ADDRESS OF FIRST ENTRY
LOOP8 LDA B,I       NOW PICK THE ENTRIES 1 AT A TIME
      ADA M1
      STA B,I 
      AND MSK3      AND LOOK FOR THE ZERO AGE ENTRY 
      CPA ZERO
      RSS            ROLLED OUT 
      JMP AGE3
      LDA ROLL
      SZA           IS THIS THE 1ST 0 AGE WE FIND THIS TIME ? 
      JMP AGERR     NO, THIS IS A CATASTROPHIC ERROR
      LDA TEMP+1    OK
      STA ROLL
AGE3  ADB FSTLN     CONTINUE TO INCREMENT THE POINT-
      ISZ TEMP+1    ERS UNTIL THE ENTIRE ACTIVE FST 
      ISZ CONTR     HAS BEEN EXAMINED.
      JMP LOOP8 
* 
      LDA ROLL      NOW THAT WE ARE DONE VERIFY THAT WE FOUND 1 0 AGE 
      SZA,RSS 
      JMP AGERR     WE DID NOT FIND ANY! ERROR !
* 
* 
* ROLL OUT ENTRY HERE 
* THE ENTRY # TO ROLL OUT IS IN"ROLL" 
* LOCATE THE RFAMD ENTRY
* 
* 
      LDA ROLL      CONVERT THE FST ENTRY 
      ADA M1        # TO AN ADDRESS 
      MPY FSTLN     & PICK UP THE FIRST WORD
      ADA FSTAD     OF THE ENTRY THE ISOLATE
      STA FBFAD 
      LDA A,I       THE RFAMD POINTER 
      ALF,ALF       CONTAINED THEREIN 
      ALF,ARS 
      AND MSK1
* NOW LOCATE THE FILE RECORD NUMBER 
      ADA M1        CONVERT THE RFAMD ENTRY # TO AN 
      MPY RFADL     ADDRESS & PICK UP THE FIFTH 
      ADA RFAMA     WORD OF THAT ENTRY & ISOLATE
      ADA D4        THE DISC POINTER CONTAINED
      LDB A 
      LDA A,I       THEREIN 
* SET "ON DISC" FLAG BIT
* 
      IOR MSK5
      STA B,I 
* 
      AND MSK1
* SET UP THE ENTRY NUMBER 
      JSB CALC      CALCULATE TRACK & SECTOR ADDRS. 
      STA DSKAD+1   SAVE TRACK #
      STB DSKAD+2   SAVE SECTOR # 
* 
      LDA OVFLA     LOCATE THE LU # 
      ADA D4        IN THE MODULE QUDIS 
      LDA A,I       & PICK IT UP
      IOR ICNWD     THEN ADD THE SECRET BITS
      STA DSKAD+3   AND SET IT ASIDE FOR THE CALL 
* 
      JSB EXEC
      DEF *+7 
      DEF B102      WRITE OPERATION (SIGN BIT SET)
      DEF DSKAD+3   CONTROL WORD
FBFAD NOP           BUFFER ADDRESS
      DEF D200      BUFFER LENGTH 
      DEF DSKAD+1   TRACK # 
      DEF DSKAD+2   SECTOR #
* 
      JMP AGE1      ERROR RETURN
* 
* WAS THE WRITE SUCESSFUL?  (CHECK TRANSMITION LOG) 
      CPB D200      COMPLETE? 
      RSS           OK
      JMP AGE1      ERROR 
* 
      LDA ROLL
      JMP AGE,I     POINTER & RETURN
* 
AGE1  LDA MD27
      JMP FMER
* 
* 
*     WE COME HERE IF 2 AGES REACH 0 DURING THE 
*     SAME AGING PASS OR IF NO AGE REACHES 0 DURING 
*     A PASS. THIS IS A CATASTROPHIC ERROR WHICH
*     WOULD CAUSE A LOSS OF DCB IF NOT TAKEN CARE OF. 
* 
*     WE WILL RESET THE AGES OF ALL ENTRIES IN THE FST
*     TABLE, STARTING AT 1 AND GOING UP.
* 
AGERR LDA #FENT     GET THE CURRENT # OF ENTRIES IN 
      CMA,INA         THE TABLE AND USE IT AS A COUNTER 
      STA CONTR 
* 
      CLB,INB       INITIALIZE THE AGE
      STB TEMP+1
* 
      LDB FSTAD     GET TABLE ADDRESS 
* 
AGER1 LDA B,I       GET AGE OF AN ENTRY 
      AND MSK6      MASK OFF THE AGE
      IOR TEMP+1    INSERT THE NEW AGE
      STA B,I       REPLACE 
* 
      ISZ TEMP+1    STEP TO NEXT AGE
      ADB FSTLN     STEP TO NEXT ENTRY
      ISZ CONTR     ALL DONE ?
      JMP AGER1     NO, CONTINUE
      JMP AGE+1     YES, TRY AGAIN
* 
* 
      SPC 5 
* THE FOLLOWING S/R PICKS UP ONE WORD FROM PARMB
* THAT IS SPLIT ACROSS A WORD BOUNDARY
* IT EXPECTS THE ADDRESS OF THE 1ST BYTE IN THE B REGISTER
* IT RETURNES THE COMPLETED WORD IN THE A REGISTER
* AND THE ADJUSTED ADDRESS IN THE B REGISTER
* IT CAN THUS BE CALLED SERIALLY FOR CONSECUTIVE
* WORDS BY ONLY SETTING UP B ONCE 
PIKUP NOP 
      STB PUPAD     STORE THE PICKUP ADDRESS
      LDA B,I       PICK UP THE 1ST BYTE
      ALF,ALF       LEFT JUSTIFY IT 
      AND MSK6      THROW AWAY THE GARBAGE BYTE 
      STA B         AND SAVE IT 
      ISZ PUPAD     INCREMENT THE PIKUP ADDRESS 
      LDA PUPAD,I   PICK UP THE NEXT BYTE 
      ALF,ALF     RIGHT JUSTIFY IT
      AND MSK1      MASK OUT THE LEFT BYTE
      IOR B         ADD THE LEFT BYTE FROM WORD 1 
      LDB PUPAD     & RESTORE THE PIKUP ADDRESS 
      JMP PIKUP,I   BEFORE RETURNING
      SPC 5 
FFST  NOP 
* FIND A VACENT FST ENTRY-RETURN ENTRY # IN A REG 
* NORMAL RETURN (JSB+1) WITH A REG= FREE ENTRY
* FST FULL RETURN (JSB+2) 
      LDA #FENT     SET UP LOOP COUNTER 
      CMA,INA 
      STA CONTR      FOR # OF FST ENTRIES 
      LDA FSTAD       THAN START AT FIRST WORD
      STA TEMP+2
      CLA,INA 
LOOP5 LDB TEMP+2,I  OF TABLE & LOOP THROUGH 
      SSB,RSS            ENTRIES LOOKING FOR
      JMP FFST,I         A CONTROL WORD OF
      INA 
      LDB TEMP+2
      ADB FSTLN           ZERO-IF NOT 
      STB TEMP+2
      ISZ CONTR            FOUND TABLE IS FULL
      JMP LOOP5             SO INCREMENT RETURN & 
      ISZ FFST                SPLIT-IF FOUND RETURN 
      JMP FFST,I              POINTER IN A REG. 
                                                                                                                                                                                                                                                              