ASMB,C,Q,N
      IFN           * START EXTENDED FILE CODE
      HED RFAM  91750-16165 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 
      NAM RFAM,19,30 91750-16165 REV 2013 800703 MEF
      XIF           *  END  EXTENDED FILE CODE
* 
* 
      IFZ           * START NON-EXTENDED FILE CODE
      HED RFAM  91750-16ZZZ REV 2013 * (C) HEWLETT-PACKARD CO. 1980 
      NAM RFAM,19,30 91750-16ZZZ REV 2013 800703 MEF
      XIF           *  END  NON-EXTENDED FILE CODE
      SPC 2 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS      *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.   *
******************************************************************
      SPC 2 
      SPC 2 
****************************************************************
* 
*     RFAM RFA MONITOR
* 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
*     NAME:         RFAM
*     SOURCE:       91750-18165 
*     RELOC:        91750-16165 
*     PGMR:         DAN GIBBONS 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
*     SOURCE PART # 91750-18ZZZ REV 2013
* 
*     REL PART #    91750-16ZZZ REV 2013
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
* 
*************************************************************** 
      SPC 2 
      EXT EXEC,#GET,#SLAV 
      EXT .MVW,.CBX,.STX,.CMW 
      EXT APOSN,CLOSE,FCONT,CREAT,LOCF,NAMF 
      EXT OPEN,POSNT,PURGE,READF,FSTAT,RWNDF
      EXT WRITF,#NODE,#RFSZ 
      EXT $LIBR,$LIBX,$CVT3,$OPSY 
      EXT #RPB,.DRCT,#ATCH,DTACH
RQB   EQU #RPB
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      EXT ECREA,ECLOS,EREAD,EWRIT 
      EXT EAPOS,EPOSN,ELOCF 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      SUP 
      SKP 
* GLBLK-START 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV 2013 791213      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  DINIT, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*         DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO               *
*         RSM,   DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM        *
******************************************************************
* 
***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS      *
***!!!!!     FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES *
***!!!!!     ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE,  *
***!!!!!     REGARDLESS OF MESSAGE FORMAT.  THIS ALSO MAKES      *
***!!!!!     STORE-AND-FORWARD CODE MUCH SIMPLER.                *
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
* 
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
* GLBLK-END 
      SKP 
* RFBLK-START 
* 
******************************************************************
*                                                                *
*       R F A   B L O C K                REV 2013  791119        *
*                                                                *
*       OFFSETS INTO DS/1000 RFA MESSAGE BUFFERS, USED BY:       *
*                                                                *
*           RFMST, RFAM1, RFAM2, REMAT, RQCNV, RPCNV             *
*                                                                *
******************************************************************
* 
* OFFSETS INTO RFA REQUEST BUFFERS. 
* 
#FCN  EQU #REQ      RFA FUNCTION CODE.
#DCB  EQU #FCN+1    DCB/FILENAME AREA.
#IRC  EQU #DCB+3    DAPOS: IREC 
#IRB  EQU #IRC+1           IRB
#XIB  EQU #IRC+2           IRB   (DXAPO)
#IOF  EQU #IRB+1           IOFF 
#XIO  EQU #XIB+2           IOFF  (DXAPO)
#ITR  EQU #DCB+3    DCLOS: ITRUN
#IC1  EQU #DCB+3    DCONT: ICON1
#IC2  EQU #IC1+1           ICON2
#ICR  EQU #DCB+3    DCRET,DNAME,DOPEN,DPURG: ICR(1) 
#ID   EQU #ICR+1                             IDSEG
#ISC  EQU #ID+1                              ISECU
#SIZ  EQU #ISC+1    DCRET: ISIZE(1) 
#SZ2  EQU #SIZ+1           ISIZE(2) 
#XRS  EQU #SIZ+2           RECSZ (DXCRE)
#TYP  EQU #SZ2+1           ITYPE
#XTY  EQU #XRS+2           ITYPE (DXCRE)
#NNM  EQU #ISC+1    DNAME: NNAME
#IOP  EQU #ISC+1    DOPEN: IOPTN
#NUR  EQU #DCB+3    DPOSN: NUR
#IR   EQU #NUR+1           IR 
#XIR  EQU #NUR+2           IR    (DXPOS)
#IL   EQU #DCB+3    DREAD,DWRIT: IL 
#NUM  EQU #IL+1                  NUM
#LEN  EQU #FCN+1    DSTAT: ILEN 
#FOR  EQU #LEN+1           IFORM
#OPT  EQU #FOR+1           IOP
#NOD  EQU #ICR+1    "FLUSH" REQUEST: NODE NUMBER
* 
* OFFSETS INTO RFA REPLY BUFFERS. 
* 
#RFD  EQU #REP      DCRET,DOPEN: RFAMD ENTRY #
#JSZ  EQU #RFD+1    DCRET: JSIZE (DXCRE)
#LOG  EQU #REP      DREAD: XLOG 
#REC  EQU #REP      DLOCF: IREC 
#RB   EQU #REC+1           IRB
#XRB  EQU #REC+2           IRB   (DXLOC)
#OFF  EQU #RB+1            IOFF 
#XOF  EQU #XRB+2           IOFF  (DXLOC)
#JSC  EQU #OFF+1           JSECT
#XJS  EQU #XOF+1           JSECT (DXLOC)
#JLU  EQU #JSC+1           JLU
#XJL  EQU #XJS+2           JLU   (DXLOC)
#JTY  EQU #JLU+1           JTY
#XJT  EQU #XJL+1           JTY   (DXLOC)
#JRC  EQU #JTY+1           JREC 
#XJR  EQU #XJT+1           JREC  (DXLOC)
#IAD  EQU #REP      DSTAT: IADD 
* 
* MAXIMUM SIZE OF RFA REQUEST/REPLY BUFFER. 
* 
#RLW  EQU #MHD+13      M A X I M U M   S I Z E   ! ! !
* 
* RFBLK-END 
      SKP 
ICLAS NOP 
RFAM  LDA B,I       GET THE CLASS 
      STA ICLAS 
      JMP INIT      GO EXECUTE THE INITIALIZATION PHASE 
      SPC 3 
      HED RFAM: ACTIVATOR * (C) HEWLETT-PACKARD CO. 1980
* 
*     WE COME HERE THE FIRST TIME WHEN THE INITIALIZATION IS COMPLETED
*     WE COME BACK HERE EACH TIME A REQUEST HAS BEEN PROCESSED. 
*     AS USUAL, WE HANG ON A CLASS WAITING FOR A REQUEST TO COME. 
*     THE CLASS HAS BEEN PASSED TO US BY LSTEN AT SYSON TIME. 
* 
GO    JSB #GET      WAIT FOR A REQUEST TO COME
      DEF *+6 
      DEF ICLAS     CLASS # 
RQBA  DEF RQB       BUFFER
      DEF C#RLW     MAXIMUM LENGTH OF THE INCOMING BUFFER 
DTBFA DEF DTBFR     DATA BUFFER ADDRESS 
      DEF D512      MAXIMUM DATA LENGTH 
      JMP GO        IGNORE ERROR RETURN 
* 
      STA RQLN      SAVE THE REQUEST LENGTH 
      LDA RQB+#FCN  GET THE FUNCTION CODE 
      SSA           CHECK FOR VALIDITY
      JMP ERR25     <0, NO GOOD 
      STA FCODE     SAVE FUNCTION CODE
      ADA UBFCN 
      SSA,RSS 
      JMP ERR25     TOO BIG, NO GOOD EITHER 
* 
*     SINCE FUNCTION CODE LOOKS OK, WE USE IT AS INDEX IN A TABLE 
*     TO GO TO THE PROPER PREPROCESSING.
* 
      LDA FCODE     GET FCODE AGAIN 
      ADA BRNCH     ADD TO THE BEGINNING OF THE BRANCH TABLE
      JMP A,I       GO EXECUTE THE PREPROCESSING
* 
      HED RFAM: ORIENTATION * (C) HEWLETT-PACKARD CO. 1980
* 
* 
*     WE WILL TRY TO DESCRIBE HERE THE FLOW OF OPERATIONS 
*     IN THIS PROGRAM.
* 
* 
* 
*  1. EACH REQUEST IS PROCESSED IN 4 PHASES:
*         - PREPROCESS
*         - FMP CALL BUILDING 
*         - EXECUTION OF THE FMP CALL 
*         - POSTPROCESS 
* 
*     THE CHOICE OF THE PROCESSOR IS MADE EACH TIME BY USING
*     THE REQUEST CODE AS AN INDEX IN A BRANCH TABLE. 
* 
* 
*  2. PREPROCESSING 
*     THE READER SHOULD FIND IN THE PREPROCESSING BRANCH TABLE
*     (BRNCH) THE LABEL AT WHICH THE CURRENT PREPROCESS WILL START. 
*     HERE IS A DESCRIPTION OF THESE PREPROCESSES.
* 
*     BRN2 USED BY DCLOS & DXCLO
*         SCAN THE RFAMD TABLE FOR OTHER USERS OF THIS FILE.
*         ONLY USER ? 
*         - YES => BRN9, GET READY FOR A REAL FILE CLOSE. 
*         - NO => BRN7, FAKE A CLOSE, SEND THE REPLY. 
* 
*     BRN8 USED FOR DPURG AND DNAME 
*         SCAN THE RFAMD LIST FOR USERS OF THIS FILE. 
*         - FILE NOT CURRENTLY USED => BRN5, PREPARE THE FMP CALL 
*         - FILE CURRENTLY USED, BUT ONLY BY US => BRN9, GET
*         CURRENT DCB, THEN BUILD THE CALL. 
*         - FILE CURRENTLY USED BY SOMEONE ELSE, RESTORE THE
*         TYPE OF THE OPEN IF NECESSARY (WE MIGHT HAVE HAD TO 
*         OPEN THE FILE TO LOCATE IT IF ICR WAS NOT SPECIFIED)
*         THEN REJECT THE REQUEST (ERR -08) 
* 
*     BRN4 USED ONLY BY DOPEN 
*         IS ICR SPECIFIED ?
*         - YES, CHECK THE LEGALITY OF THIS OPEN (BRN41)
*         REJECT (ERR -08) IF ILLEGAL.
*         - NO, SKIP THE CHECKING, IT WILL BE DONE LATER. 
*         => BRN3 
* 
*     BRN3 USED BY DCRET & DXCRE
*         GET A DCB SPACE IN CORE. SWAP AN OLD DCB IF NECESSARY.
*         GET AN RFAMD ENTRY, LINK IT TO THE LIST AND FORMAT IT.
* 
*     BRN1 USED BY DAPOS, DCONT, DLOCF, DPOSN, DREAD, DWIND,
*         DWRIT, DXREA, DXWRI, DXAPO, DXPOS, AND DXLOC. 
*         THE RFAMD ENTRY # PASSED IN THE REQUEST IS CHECKED FOR
*         FOR VALIDITY. 
*         THE ENTRY IS LOCATED. 
*         THE DCB IS BROUGHT TO CORE IF CURRENTLY ON DISC.
*         THE RFAMD IS RELINKED:
*         - IF THE DCB WAS ALREADY IN CORE, THE ENTRY IS ADVANCED 
*         ONE POSITION (I.E. INSERTED BEFORE THE ENTRY IN FRONT 
*         ITSELF).
*         - IF THE DCB HAD TO BE BROUGHT TO CORE, THE ENTRY IS
*         INSERTED AS THE "LAST" ENTRY IN THE "DCB IN CORE" PART
*         OF THE RFAMD. 
*         WE THEN GO TO PREPARE THE CALL. 
* 
*     BRN10 FOR DSTAT ONLY
*         CALL FSTAT AND GO DIRECTLY TO THE REPLY SECTION 
* 
*     BRN6 FOR FLUSH ONLY 
*         - DELETE THE PROPER RFAMD TABLE ENTRIES AND RETURN
*         TO THE DCB FREE LIST THE DCB SPACES WHICH ARE NOT 
*         ANY MORE NEEDED.
*         - MAKE A DECISION ON WETHER OR NOT WE HAVE TO CLOSE 
*         THIS FILE. IF YES, JMP BRN9 FOR STANDARD CLOSE, ELSE
*         JMP BRN7 FOR TERMINATION. 
* 
* 
*  3. FMP CALL FORMATTING.
*     THE TABLE WE WILL USE TO SELECT A PROCESSOR IS BLDTB. 
*     IN THIS PART WE ONLY SET THE ADDRESSES OF THE PARAMETERS
*     IN THE CALL BUFFER. 
* 
* 
*  4. POSTPROCESSING
*     ON COMPLETION OF THE FMP CALL WE GO TO "DONE" WHERE THE 
*     SELECTION OF THE PREPROCESSOR IS DONE THROUGH THE TABLE 
*     PSTBL.
* 
*     PST05 USED FOR DNAME AND DPURG
*         IF THE FILE WAS OPEN BEFORE THE FMP CALL AND THE CALL 
*         WAS EXECUTED WITHOUT ERROR, THE CURRENT RFAMD ENTRY 
*         IS DELETED. 
* 
*     PST04 USED FOR DCRET & DXCRE
*         IF THE ICR WAS NOT SPECIFIED IN THIS REQUEST, SET THE 
*         PROPER CRN VALUE IN THE RFAMD ENTRY.
*         IN ANY CASE, FIND THE RFAMD ENTRY # AND PASS IT TO
*         THE USER. 
*         IF DXCRE CALL, SET FMP RETURN PARAM 'JSIZE' INTO
*         REPLY BUFFER. 
* 
*     PST00 USED FOR DSTAT
*         SET THE DATA LENGTH TO 125 OR 253 WORDS.
* 
*     PST02 USED FOR DREAD &DXREA 
*         SET THE DATA LENGTH 
* 
*     PST03 USED FOR DOPEN
*         IF THE ICR WAS SPECIFIED IN THE REQUEST, THE RFAMD
*         ENTRY # IS SET IN THE REPLY BUFFER, AND THE REPLY IS SENT.
*         IF THE ICR WAS NOT SPECIFIED IN THE REQUEST, THE
*         LEGALITY OF THIS OPEN IS CHECKED, AND EITHER: 
*         - REJECTED (ERR -08) THE TYPE OF THE OPEN MAY HAVE
*         BE RESTORED 
*         - ACCEPTED, THE CRN IS SET IN THE RFAMD ENTRY AND THE ENTRY 
*         NUMBER IS SET IN THE REPLY BUFFER.
*         THE REPLY IS SENT.
* 
* 
*  5. IF THE OPERATION WAS A SUCCESSFUL CLOSE, THE CURRENT RFAMD
*     ENTRY IS DELETED. 
* 
* 
* 
* 
      HED RFAM: PREPROCESSING * (C) HEWLETT-PACKARD CO. 1980
      SPC 3 
* 
*     HERE FOR DCLOS & DXCLO
* 
BRN2  JSB ENTCK     CHECK THE VALIDITY OF THE ENTRY # 
      STA CRFAD     ENTRY # OK. A = ADDRESS OF ENTRY. 
      ADA D2        STEP TO THE FILE NAME 
      LDB FNAMA     GET THE DESTINATION ADDRESS 
      JSB .MVW      MOVE THE FILE NAME AND THE CRN
      DEF D4
      NOP 
* 
      LDA FIRST     SET THE START POINTER TO
      STA PNTR1       SEARCH FROM THE FIRST ENTRY.
* 
BRN21 JSB SERCH     FILE OPEN TO ANYONE ELSE? 
      JMP BRN9      NO, SO OK TO CLOSE
* 
*     SUCCESSFUL SEARCH. IS IT US ? 
* 
      LDA PNTR1     GET SEARCH POINTER
      CPA CRFAD     COMPARE TO CURRENT ENTRY
      RSS           YES, US, NO PROBLEM 
      JMP BRN22     NO, FAKE THE CLOSE. 
      LDA PNTR1,I   GET NEXT TO SEARCHED ENTRY
      STA PNTR1     RESET THE SEARCH POINTER
      JMP BRN21     CONTINUE TO SCAN. 
* 
BRN22 CLA           SET FOR NO ERROR
      STA IERR
      JMP BRN7      RETURN
      SPC 3 
* 
*     HERE FOR DPURG AND DNAME
* 
BRN8  JSB BRN84     SET UP FOR LIST SCAN. 
      CLB 
      STB TMPAD 
      JSB SERCH     SCAN THE LIST 
      JMP BRN5      UNSUCCESFUL SEARCH => OK. 
* 
*     IF THE FILE IS OPENED TO US AND ONLY TO US, 
*     WE ARE ALLOWED TO EXECUTE THE REQUEST.
*     PNTR1 POINTS TO THE MATCHING ENTRY
* 
      JSB US?       IS IT OUR ENTRY ? 
      JMP BRN81     NO, NOT US
      STA TMPAD     SAVE ENTRY ADDRESS
      SSB           EXCLUSIVE OPEN ?
      JMP BRN82     YES, WE ARE THE ONLY USER 
* 
      LDA A,I       GET ADDRESS OF NEXT ENTRY 
      STA PNTR1     SET THE POINTER TO CONTINUE THE SEARCH
      JSB SERCH     DO IT 
      RSS           NOBODY ELSE IN THE GAME, EXECUTE
      JMP BRN81     SOMEONE ELSE, FORGET IT 
* 
      LDA TMPAD     GET ENTRY ADDRESS 
BRN82 STA CRFAD     SET FOR DCB RETREIVAL 
      JSB FNDX      FIND THE ENTRY #
      JMP BRN91     GET THE DCB AND EXEC THE REQ. 
* 
*     SUCCESSFUL SEARCH, WE CANNOT PURGE NOR RENAME A FILE OPEN TO
*     SOMEONE ELSE. 
* 
*     THE FILE WAS FOUND TO BE CURRENTLY OPENED TO SOMEONE. 
*     TO FIND THIS WE MIGHT HAVE HAD TO OPEN THE FILE.
*     IF THE CURRENT OWNER(S) HAD IT NON-EXCLUSIVELY OPENED,
*     WE HAVE TO RESTORE THIS STATUS. 
* 
BRN81 LDA DFLFL 
      SZA,RSS       DID WE HAVE TO DO AN OPEN ? 
      JMP ERR08     NO
      LDA PNTR1     GET ADDRESS OF RFAMD ENTRY
      ADA D7        STEP TO THE NODE NUMBER 
      LDA A,I       GET IT
      SSA           "EXCLUSIVE" BIT SET ? 
      JMP ERR08     YES, WE DID NOT CHANGE ANYTHING 
* 
      CLB           SET THE DCB IN
      STB DTBFR+9     "FILE NOT OPEN" STATUS
* 
      JSB OPEN      NO, REOPEN, NON EXCLUSIVELY 
      DEF *+7 
      DEF DTBFR     USE DATA AREA AS DCB
      DEF IERR1 
      DEF RQB+#DCB   FILE NAME
      DEF D1        OPTION
      DEF RQB+#ISC  ISECU 
      DEF RQB+#ICR  ICR 
* 
      JMP ERR08     NOW, SEND ERROR 
      SPC 3 
* 
*     WE COME HERE FOR DOPEN
* 
BRN4  LDA RQB+#ICR  GET ICR 
      SZA,RSS       PRESENT ? 
      JMP BRN3      NO, WE WILL DO THE CHECKING LATER 
      JSB BRN41     YES 
      JMP BRN3      OK TO OPEN
      JMP ERR08     CANNOT OPEN 
      SPC 3 
* 
*     HERE WE WILL CREATE AN RFAMD ENTRY. 
*     THIS ENTRY WILL BE POSITIONED AT THE END OF THE 
*     LIST OF RFAMD ENTRIES POINTING TO IN-CORE-DCB'S.
*     WE WILL ALSO TAKE CARE OF FINDING A DCB SPACE AND 
*     LINKING IT TO ITS RFAMD ENTRY.
* 
BRN3  LDA BFREE     GET FREE RFAMD-LIST HEAD POINTER
      SZA,RSS       ANY FREE ENTRY ?
      JMP ERR28     NO, REJECT. 
* 
      LDA FCORE     GET FREE DCB-LIST HEAD POINTER. 
      SZA           ANY ROOM IN CORE ?
      JMP CRT1      YES, WE DONT HAVE TO SWAP ANYONE OUT. 
* 
*     SINCE THERE IS NO ROOM FOR ANOTHER DCB IN CORE AT 
*     THIS TIME, WE HAVE TO MAKE SOME ROOM. WE WILL SWAP
*     OUT THE "LAST" DCB. 
* 
      JSB WLAST     WRITE "LAST" DCB TO DISC
* 
      LDA LAST      GET THE ENTRY ADDRESS 
      INA           STEP TO "PREVIOUS" POINTER
      LDB A,I       GET ADDRESS OF PREVIOUS 
      STB LAST      RESET LAST
      ADA D7        STEP TO THE DCB POINTER 
      CLB 
      STB A,I       SET IT FOR "DCB ON DISC"
* 
      JMP CRT2
* 
CRT1  LDB FCORE,I   TAKE 1 DCB OUT OF THE 
      STB FCORE       FREE LIST AND RELINK THE LIST 
      STA LDCB      SAVE THE ADDRESS OF "OUR" DCB 
* 
*     NOW THAT WE HAVE A DCB, LET'S TAKE CARE OF THE RFAMD ENTRY. 
* 
CRT2  LDA BFREE     TAKE 1 OUT OF THE FREE LIST 
      LDB BFREE,I     AND RELINK THE FREE LIST
      STB BFREE 
* 
      STA CRFAD     SAVE ADDRESS OF OUR RFAM ENTRY
      LDB LDCB      GET DCB ADDRESS 
      ADA D8        STEP TO DCB POINTER 
      STB A,I       SET IT
      ADB D9        STEP TO OPEN FLAG AND DESTROY IT BY 
      STB B,I       BY MAKING IT DIFFERENT FROM RFAM'S IDSEG @
* 
*     NOW INSERT CRFAD IN THE LIST
* 
      LDA LAST
      SZA           IS THERE ANYTHING IN THIS LIST ?
      JMP CRT3      YES 
* 
*     CRFAD WILL BE THE 1ST ENTRY OF THE LIST.
* 
      LDB CRFAD 
      STB LAST      SET IN-CORE LIMIT 
      LDA FIRST 
      SZA,RSS       IS THE LIST EMPTY ? 
      JMP CRT21     YES 
      JSB INSRT     INSERT
      STA FIRST     RESET THE LIST HEAD 
      JMP BRN31 
* 
CRT21 STB FIRST 
      STA 1,I       NO "NEXT" 
      INB 
      STA 1,I       NO "PREVIOUS" EITHER
      JMP BRN31     ALL DONE FOR THIS CASE. 
* 
*     WE HAVE TO INSERT THE NEW ENTRY AFTER THE "LAST" ONE
* 
CRT3  CPA CRFAD     ALREADY IN PLACE? 
      JMP CRT33     YES 
      LDB CRFAD     ADDR OF CURRENT ENTRY 
      LDA LAST,I    GET NEXT(LAST)
      STA 1,I       STORE IN CURR. ENTRY
      STB LAST,I    LINK OLD LAST TO THIS ONE 
      SZA,RSS       BOTTOM? 
      JMP *+3       YES 
****
      INA 
      STB 0,I 
      INB 
      LDA LAST
      STA 1,I       PREV(CRFAD)=OLD LAST
CRT33 LDA LAST,I    GET "NEXT" OF LAST
      STA LAST      UPDATE LAST 
* 
*     AN RFAMD ENTRY IS CREATED AND LINKED INTO THE LIST. 
*     WE NOW HAVE TO FILL THE BLANKS IN THE RFAMD ENTRY.
* 
BRN31 LDB CRFAD     GET POINTER TO NEW RFAMD ENTRY. 
      ADB D2        STEP TO FILE NAME 
      LDA NAMA
      JSB .MVW      MOVE THE FILE NAME
      DEF D3
      NOP 
      LDA RQB+#ICR  GET ICR 
      STA B,I       SET IT IN CRFAD 
      LDA RQB+#ID   GET THE ID SEGMENT @ OF THE OWNER 
      INB 
      STA B,I 
      LDA RQB+#SRC  GET ORIGIN NODE 
      INB 
      STA B,I 
* 
*     ALL SET ! 
* 
      JMP BRN5
      SPC 2 
* 
*     SUBROUTINE TO SWAP OUT THE "LAST" IN-CORE DCB.
*     FIRST FIND ITS DISC ADDRESS.
* 
WLAST NOP 
      LDA LAST      GET CORE ADDRESS OF RFAMD ENTRY.
      JSB FNDX      FIND ENTRY #
      JSB CALDS     CALCULATE DISC ADDRESS
* 
      LDA LAST      NOW FIND ITS CORE ADDRESS 
      ADA D8        STEP TO DCB ADDRESS 
      LDB A,I       GET IT
      STB LDCB      SAVE
* 
      ADB D12       STEP TO FILE POSITION POINTER 
      JSB .CBX      SAVE THE ADDRESS
      LDB B,I       GET THE POINTER 
      LDA LDCB      GET THE DCB ADDRESS 
      CMA,INA       SUBTRACT FROM FILE POSITION 
      ADB A          POINTER TO FORM RELATIVE POINTER.
      JSB .STX      RETRIEVE POINTER ADR
      DEF A 
      STB A,I       SET RELATIVE POINTER INTO DCB 
* 
      JSB EXEC      NOW WRITE THE DCB 
      DEF *+7         ON THE DISC.
      DEF D2I       WRITE 
      DEF IDISC     DISC LU 
      DEF LDCB,I    CORE ADDRESS
      DEF D144      LENGTH
      DEF CTRK      TRACK # 
      DEF CSCT      SECTOR ADDRESS
* 
      JMP DSCER     DISC ERROR
* 
      JMP WLAST,I   RETURN
      SPC 3 
* 
*     PREPROCESSOR FOR FLUSH
* 
BRN6  CLA 
      STA IERR      SET FOR NO ERROR IN CASE OF NO ENTRY
      STA TMPNX     SET A FLUSHED ENTRY COUNTER 
      STA FLFLG     SET A FLUSH FLAG TO INDICATE THE
*     ABSENCE/PRESENCE OF ENTRIES CORRESPONDING TO THIS FILE
*     WHICH MUST NOT BE FLUSHED.
      LDA NAMA
      LDB FNAMA     SET THE FILE ID FOR THE SEARCH
      JSB .MVW
      DEF D4
      NOP 
      LDA FIRST 
      STA PNTR1     SEARCH FROM THE START 
      JSB BRN62 
      JMP ERR11     NO ENTRY MATCHES, GIVE "DCB" NOT OPEN 
* 
      ISZ TMPNX     INC THE ENTRY COUNTER 
      LDA PNTR1     SAVE THE ENTRY @, WE WILL 
      STA TMPAD       USE IT FOR THE CLOSE
BRN61 LDA PNTR1,I   CONTINUE THE SEARCH 
      STA PNTR1 
      JSB BRN62 
      JMP BRN64     ALL DONE
      ISZ TMPNX     ONE MORE
      LDA PNTR1 
      JSB DELET     DELETE THIS ENTRY 
      JMP BRN61     CONTINUE
* 
BRN64 LDA TMPAD 
      LDB FLFLG     GET THE FLUSH FLAG
      SZB           DO WE CLOSE THIS FILE ? 
      JMP BRN65     NO
      STA CRFAD     SET THE ENTRY ADDRESS FOR THE CLOSE 
      LDA C#ICR 
      STA RQLN
      JMP BRN9      GO FOR A CLOSE
* 
BRN65 JSB DELET     DELETE THIS ENTRY 
      JMP BRN7      AND RETURN. 
      SPC 3 
* 
*     HERE WE DO THE COMMON PART OF NEARLY EVERY REQUEST
* 
BRN1  JSB ENTCK     FIRST, CHECK THE VALIDITY OF THE ENTRY. 
      STA CRFAD     SAVE THE ADDRESS OF THE CURRENT ENTRY.
* 
*     IN THIS PART, KNOWING THE ADDRESS OF THE CURRENT RFAMD
*     ENTRY (CRFAD) WE WILL DETERMINE IF THE MATCHING DCB 
*     IS IN CORE OR ON DISC. IF THE DCB IS ON DISC, IT WILL 
*     BE BROUGHT IN TO CORE. THIS MAY REQUIRE THE SWAPPING OUT
*     OF ANOTHER DCB. 
* 
BRN9  LDA RQB+#DCB+1  GET THE ENTRY # 
BRN91 STA SWNX        AND SAVE IT FOR THE DISC ACCESS 
      LDA CRFAD     GET POINTER TO THE ENTRY. 
      ADA D8        STEP TO THE DCB POINTER 
      LDA A,I       GET IT
      SZA           IS DCB ON DISC ?
      JMP CASE1     NO
* 
*     SINCE WE HAVE TO BRING THE DCB INTO CORE, WE HAVE 
*     TO FIND ROOM FOR IT.
* 
      LDA FCORE     GET FREE DCB LIST HEAD POINTER
      SZA           ANY FREE DCB SPACE ?
      JMP SWIN1     YES, SWAP IN ONLY.
* 
*     WE WILL SWAP OUT THE "LAST" IN-CORE DCB.
* 
      JSB WLAST     WRITE "LAST" DCB TO DISC
* 
      LDB LAST
      ADB D8        STEP TO THE DCB POINTER 
      CLA 
      STA B,I       SET IT FOR DCB ON DISC
      STA TMP1      THIS FLAG MEANS THAT WE HAD TO SWAP OUT 
      JMP SWIN2 
* 
SWIN1 STA LDCB      SAVE ADDRESS OF LOCAL DCB 
      LDA LDCB,I    GET "NEXT" TO LDCB
      STA FCORE     RELINK THE DCB FREE LIST
      CCA 
      STA TMP1      SET THE FLAG TO "NO SWAP OUT" 
* 
SWIN2 LDA SWNX      GET NUMBER OF RFAMD ENTRY 
      JSB CALDS     FIND WHERE OUR DCB IS ON DISC 
* 
      JSB EXEC      GET THE DCB INTO CORE 
      DEF *+7 
      DEF D1I 
      DEF IDISC 
      DEF LDCB,I
      DEF D144      DCB LENGTH
      DEF CTRK      TRACK # 
      DEF CSCT      SECTOR NUMBER 
* 
      JMP DSCER     DISC ERROR
* 
*     NOW THAT THE DCB IS IN, RESET THE DCB POINTER IN CRFAD
*     AND THE FILE POSITION POINTER IN THE DCB. 
* 
      LDA CRFAD 
      ADA D8        STEP TO DCB POINTER 
      LDB LDCB      GET ADDRESS OF DCB
      STB A,I       SET THE POINTER 
      ADB D12       STEP TO RELATIVE FILE POSITION PTR
      LDA B,I       GET IT
      ADA LDCB      ADD DCB ADR TO FORM ABSOLUTE FILE 
      STA B,I        POSITION POINTER & SET INTO DCB. 
* 
*     NOW IS TIME TO RELINK THE RFAMD LIST. 
*     WE HAVE 3 SEPARATE CASES: 
*                       1) THE DCB WAS ALREADY IN CORE. WE SWITCH 
*                   CRFAD WITH ITS PREVIOUS ENTRY EXCEPT IF CRFAD 
*                   THE FIRST ENTRY. IF CRFAD WAS THE 2ND AND-OR
*                   LAST ENTRY, THE FIRST AND-OR LAST POINTERS
*                   HAVE TO BE RESET. 
*                       2) THE DCB WAS ON DISC AND THERE WAS ROOM 
*                   IN CORE. CRFAD IS INSERTED AFTER THE "LAST" ENTRY,
*                   AND LAST IS RESET TO POINT TO CRFAD. IF BEFORE THE
*                   INSERTION LAST=0 (I.E. THERE IS NO DCB IN CORE )
*                   THEN INSERT CRFAD BEFORE FIRST AND RESET FIRST AND
*                   LAST TO CRFAD.
*                       3) THE DCB WAS ON DISC AND THERE WAS NO ROOM
*                   IN CORE. INSERT CRFAD BEFORE LAST AND RESET LAST
*                   TO CRFAD. IF FIRST=LAST, RESET ALSO FIRST (CASE 
*                   OF ONLY ONE DCB IN CORE). 
* 
      LDA TMP1      GET FLAG
      SZA,RSS       WHAT CASE IS THIS ? 
      JMP CASE3     GUESS 
* 
*     HERE WE TREAT CASE 2
* 
      LDA LAST      GET ADDRESS OF LAST 
      SZA           LIMIT CASE ?
      JMP CASE2     NO, NORMAL CASE2
      LDA CRFAD     TAKE CRFAD OUT
      JSB COUT        OF LIST.
      LDA FIRST     INSERT IT ON TOP OF THE LIST
      JSB INSRT 
* 
      STA LAST      RESET LAST
      STA FIRST     RESET FIRST 
      JMP BRN5      ALL DONE. 
* 
*     NOW FOR REAL CASE 2 
* 
CASE2 LDA LAST,I    GET NEXT TO LAST
      CPA CRFAD     CRFAD ALREADY IN PLACE? 
      JMP CAS21     YES, NO INSERTION NECESSARY.
      LDA CRFAD 
      JSB COUT      TAKE CRFAD OUT OF ITS LIST. 
      LDA LAST,I    SET POINTER 
      JSB INSRT         OF CRFAD AFTER LAST.
* 
CAS21 STA LAST      RESET LAST. 
      JMP BRN5      ALL DONE FOR CASE2
* 
*     HERE ON CASE 3
* 
CASE3 LDA CRFAD 
      JSB COUT      TAKE CRFAD OUT OF THE LIST
      LDA LAST      SET POINTER 
      JSB INSRT         CRFAD BEFORE LAST 
      STA LAST      RESET LAST
      LDB 0 
      INA           STEP TO PREVIOUS OF CRFAD 
      LDA A,I       GET IT
      SZA,RSS       IS CRFAD FIRST NOW ?
      STB FIRST     RESET FIRST TO CRFAD. 
      JMP BRN5      GO AWAY 
* 
*     HERE FOR CASE 1 
* 
CASE1 STA LDCB      SAVE ADDRESS OF DCB 
      LDA CRFAD 
      CPA FIRST     ALREADY TOP OF LIST?
      JMP BRN5      YES, DONE 
* 
      JSB COUT      REMOVE CRFAD FROM ITS SLOT
      LDA CRFAD 
      INA 
      LDA A,I       GET PREV(CRFAD) 
      JSB INSRT       BEFORE PREVIOUS.
* 
      INA 
      LDA A,I       GET PREV(CRFAD) 
      SZA           IS CRFAD NOW FIRST ENTRY ?
      JMP CAS11     NO
      LDA CRFAD     YES, GET ITS ADDRESS AGAIN
      STA FIRST     RESET FIRST.
* 
CAS11 LDB CRFAD,I   GET ADDR OF NEXT
      LDA LAST      WAS LAST POINTING TO CRFAD
      CPA CRFAD       BEFORE THE SWITCH ? 
      STB LAST      YES, RESET LAST TO CRFAD(NEXT)
      JMP BRN5      ALL DONE
      SPC 3 
* 
*     HERE FOR DSTAT. THIS IS A SPECIAL CALL, IT DOES NOT 
*     NEED ANY DCB. SPECIAL TREATMENT.
* 
BRN10 EQU * 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      LDA RQB+#LEN  PROTECT AGAINST 
      AND B377       TOO LARGE
      STA RQB+#LEN    A DATA BUFFER.
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
      LDA RQB+#SID  GET SESSION ID WORD FROM REQ. 
      AND B377      ISOLATE DEST. SESSION ID (BITS 0-7) 
      STA TEMP      SAVE SESSION ID FOR '#ATCH' CALL
* 
      JSB #ATCH     ATTACH TO SESSION CONTROL BLOCK 
      DEF *+2 
      DEF TEMP
* 
      INA,SZA,RSS   CHECK FOR ERROR 
      JMP RSERR     "RS01" ERROR: SCB NOT FOUND 
* 
      JSB FSTAT 
      DEF FRTN
      DEF DTBFR     STATUS BUFFER 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      DEF RQB+#LEN  ILEN
      DEF RQB+#FOR  IFORM 
      DEF RQB+#OPT  IOP 
      DEF TEMP      IADD (RETURN PARAM) 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
FRTN  EQU * 
      JSB DTACH     DETACH FROM SESS. CONTROL BLOCK 
      DEF *+1 
* 
      CLA 
      STA IERR      SET FOR NO ERROR
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      LDA TEMP      SET RETURN PARAM (IADD) 
      STA RQB+#IAD   INTO REPLY BUFR. 
      LDB RQB+#LEN  SET LENGTH OF DATA BUFFER 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
      LDB D125      SET LENGTH OF DATA BUFFER 
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
      JMP PST01      & RETURN.
      SPC 3 
* 
*     HERE WE BRANCH TO THE PROPER CALL SETUP ROUTINE.
* 
BRN5  LDA FCODE     GET THE FUNCTION CODE 
      ADA JSBTB     ADD POINTER TO FMP CALL DEF-TABLE 
      LDA A,I       GET ADR OF FMP CALL 
      STA CALLI     SET IT
      LDA FCODE     GET FCODE AGAIN 
      ADA BLDTB     MAP IN "BUILD" TABLE
      JMP A,I       GO PREPARE THE CALL TO FMP
* 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      SPC 2 
* 
*     CALL BUILDERS FOR DXCLO, DXAPO, AND DXPOS 
* 
BLD15 LDA MDXCL     GET DXCLO PARAM MASK
      JMP BLD0A     GO BUILD CALL 
* 
BLD18 LDA MDXAP     GET DXAPO PARAM MASK
      JMP BLD0A     GO BUILD CALL 
* 
BLD19 LDA MDXP0     GET DXPOS PARAM MASK
      JMP BLD0A     GO BUILD CALL 
      SPC 3 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
*     CALL BUILDER FOR DAPOS,DCLOS,DCONT,DPOSN,DWIND
* 
BLD0  CLA           SET PARAM MASK FOR NO DOUBLE WORDS
BLD0A LDB PARAM     GET @ OF NEXT PARAM DEST. 
BLD02 JSB BLDCL     BUILD THE FMP CALL
* 
BLD01 STB RTNAD     SET THE RETURN ADDRESS
      JSB NOPS      CLEAN THE END OF THE BUFFER 
      JMP CALL      EXECUTE THE CALL
      SPC 2 
* 
*     BLDCL:
*     SETS PARAM ADDRESSES FROM REQUEST BUFFER INTO FMP CALL. 
*     ENTER WITH <A> = PARAM MASK (BITS CORRESPOND TO REQ BUFFER
*     PARAMS; 0=SINGLE WORD PARAM, 1=DOUBLE WORD PARAM),
*     <B> = ADR OF NEXT PARAM IN 'CALL'. RETURN WITH <B> =
*     RETURN ADR OF FMP 'CALL'. 
* 
BLDCL NOP 
      STB PARMA     SAVE PARAM DESTINATION ADR
      LDB RQLN      CALCULATE # OF PARAM WORDS IN RQST
      CMB,INB 
      ADB C#1ST 
      SZB,RSS 
      JMP BLDCN     NO PARAMS IN REQUEST
      STB CNTR1     SET # PARAM WORDS IN COUNTER
      LDB RQBA      GET CALL ADR
      ADB C#1ST     STEP TO 1ST PARAM LOC 
BLDCM STB PARMA,I   SET PARAM ADR INTO CALL 
      INB           BUMP SOURCE POINTER 
      SLA           IS SOURCE PARAM DOUBLE WORD?
      INB           YES, BUMP SOURCE POINTER AGAIN
      ISZ PARMA     BUMP DEST POINTER 
      SLA,RAR       IS SOURCE PARAM DOUBLE WORD?
      ISZ CNTR1     YES, BUMP WORD COUNTER TWICE
      ISZ CNTR1     DONE? 
      JMP BLDCM     NO, CONTINUE
BLDCN LDB PARMA     YES, SET <B> TO 'CALL' RTRN ADR 
      JMP BLDCL,I   RETURN
* 
PARMA NOP 
      SPC 3 
* 
*      CALL BUILDER FOR DCRET & DXCRE 
* 
BLD3  LDA NAMA
      STA PRAM1     SET NAME PARAM ADR INTO CALL
      LDA #SIZA 
      STA PRAM1+1   SET SIZE PARAM ADR
      LDA #TYPA 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      LDB FCODE     GET FCODE 
      CPB DXCRE     DXCRE REQUEST?
      LDA #XTYA     YES 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      STA PRAM1+2   SET TYPE PARAM ADR
* 
      LDA CRFAD     GET THE ADDRESS OF THE RFAMD ENTRY
      ADA D7        STEP TO THE NODE #
      LDB A,I       GET IT
      CCE 
      RBL,ERB       SET THE EXCLUSIVE-OPEN BIT
      STB A,I       RESTORE THE WORD
* 
      LDB PARAM 
      ADB D3        SET B TO CURRENT RETURN 
* 
*     THE FOLLOWING PART IS COMMON TO DCRET, DXCRE, DNAME, DOPEN
*     AND DPURG, IT SETS THE SECURITY CODE AND THE CRN IN THE CALL
* 
BLD31 STB TEMP      SAVE ADR OF NEXT PARAM DEST.
      LDA SECUA 
      STA TEMP,I    SET ISECU PARAM ADR INTO CALL 
      LDA CRA 
      ISZ TEMP      BUMP DEST POINTER 
      STA TEMP,I    SET ICR PARAM @ INTO CALL 
      ISZ TEMP      BUMP DEST POINTER 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      LDA FCODE     GET FCODE 
      CPA DXCRE     DXCRE REQUEST?
      RSS           YES, KEEP BUILDING
      JMP BL31A     NO, FINISHED
      LDA D0A       SET IDCBS DUMMY PLACEHOLDER 
      STA TEMP,I      INTO CALL.
      ISZ TEMP
      LDA JSIZA 
      STA TEMP,I    SET JSIZE PARAM ADR INTO CALL 
      ISZ TEMP
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
BL31A LDB TEMP      SET B TO 'CALL' RETURN ADR
      JMP BLD01     GO EXECUTE CALL 
* 
TEMP  NOP 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
JSIZA DEF JSIZE 
JSIZE BSS 2         JSIZE RETURN PARAM FOR DXCRE
D0A   DEF D0
      SPC 3 
* 
*     CALL BUILDER FOR DXLOC
* 
BLD20 LDB MDXLO     GET DXLOC REPLY PARAM MASK
      RSS           GO BUILD CALL 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      SPC 3 
* 
*     CALL BUILDER FOR DLOCF
* 
BLD4  CLB           GET LOCF REPLY PARAM MASK 
      LDA PARAM     SET 'CALL' PARAM POINTER
      STA PARMA 
      LDA DM7       SET COUNTER TO #
      STA CNTR1      OF PARAMS IN REPLY.
      LDA RQBA      CALCULATE  1ST REPLY
      ADA C#REC      PARAM ADDRESS. 
* 
BLD41 STA PARMA,I   SET REPLY PARAM ADR INTO CALL 
      INA           INCR TO NEXT REPLY PARAM ADR
      SLB,RBR       WAS REPLY PARAM A DBL WORD? 
      INA           YES, BUMP REPLY BUFR PNTR AGAIN 
      ISZ PARMA     BUMP CALL PNTR
      ISZ CNTR1     FINISHED XFRING REPLY ADRS TO CALL? 
      JMP BLD41     NO, CONTINUE LOOP 
* 
      LDB PARMA     YES, SET <B> TO NEXT-PARAM ADR
      JMP BLD01     GO EXECUTE CALL 
      SPC 3 
* 
*     CALL BUILDER FOR DNAME
* 
BLD5  LDA RQBA      GET @ OF REQUEST BUFFER 
      ADA C#DCB     STEP TO NAME
      STA PRAM1     SET @ OF NAME IN CALL 
      ADA D6        GET @ OF NNAME
      STA PRAM1+1   SET IN CALL 
      LDB PARAM 
      ADB D2        SET FOR THE REST
      LDA TMPAD     WAS THE FILE ALREADY OPEN ? 
      SZA 
      JMP BLD31     YES, DCB ADDRESS ALREADY SET
      JMP BLD81     NO, USE DATA BUFFER AS DCB SPACE. 
      SPC 3 
* 
*     CALL BUILDER FOR DOPEN
* 
BLD6  LDA RQB+#IOP  GET OPEN OPTION 
      CCE,SLA       EXCLUSIVE ? 
      JMP BLD61     NO
      LDA CRFAD     YES, GET ADDRESS OF RFAMD ENTRY 
      ADA D7          TO SET "EXCLUSIVE" FLAG IN NODE WORD. 
      LDB A,I       GET THE NODE NUMBER 
      RBL,ERB       SET THE SIGN BIT
      STB A,I       REPLACE IN THE ENTRY
* 
BLD61 LDA RQBA      GET ADR OF THE REQUEST BUFR 
      ADA C#DCB     STEP TO THE FILE NAME 
      STA PRAM1     SET IT IN THE CALL TO FMP 
      ADA D6        STEP TO THE OPEN OPTION 
      STA PRAM1+1   SET IT IN THE CALL
* 
      LDA LDCB      SET THE 
      ADA D9          DCB IN
      CLB               "FILE NOT OPEN" 
      STB A,I             STATUS
* 
      LDB PARAM 
      ADB D2        GET CURRENT RETURN ADDRESS
      JMP BLD31     GO COMPLETE THE CALL
      SPC 3 
* 
*     CALL BUILDER FOR DPURG
* 
BLD8  LDA NAMA      GET FILE NAME ADDRESS 
      STA PRAM1     SET IT IN CALL
      LDB PARAM 
      INB 
BLD81 LDA DTBFA     GET THE ADDRESS OF THE DATA BUFFER
      STA LDCB      USE IT AS THE DCB ADDRESS FOR THIS CALL 
      JMP BLD31     GO COMPLETE 
      SPC 3 
* 
*     CALL BUILDER FOR DREAD & DXREA
* 
BLD9  LDA DTBFA     GET ADDRESS OF DATA BUFFER
      STA PRAM1     SET IT IN CALL
      LDA RQBA
      ADA C#IL      GET ADDRESS OF REQUEST LENGTH 
      STA PRAM1+1   SET IN CALL 
      CLB           CLEAR RETURNED LENGTH WORD
      STB LEN        TO AVOID CONFUSION ON ERROR
      LDB LENA      ALWAYS PASS LEN BACK. GET ITS @ 
      STB PRAM1+2 
      LDA RQBA
      ADA C#NUM     GET ADR OF NUM
      STA PRAM1+3   SET INTO CALL 
      LDB PARAM     GET RETURN
      ADB D4         ADDRESS. 
      JMP BLD01     GO COMPLETE AND EXECUTE 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
* 
*     CALL BUILDER FOR DXWRI
* 
BLD17 LDA MDXWR     GET DXWRI PARAM MASK
      RSS           GO BUILD CALL 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      SPC 3 
* 
*     CALL BUILDER FOR DWRIT
* 
BLD12 CLA           A = DWRIT PARAM MASK
      LDB DTBFA 
      STB PRAM1     SET BUFFER ADDRESS IN CALL
      LDB PARAM 
      INB           GET RETURN ADDRESS
      JMP BLD02     GO COMPLETE AND EXECUTE 
      SPC 3 
      HED RFAM: POSTPROCESSING * (C) HEWLETT-PACKARD CO. 1980 
* 
*     POSTPROCESS FOR DNAME AND DPURG 
* 
PST05 LDA TMPAD     WAS IT AN ALREADY OPEN FILE ? 
      SZA,RSS 
      JMP BRN7      NO
      LDB IERR      GET COMPLETION CODE 
      SSB,RSS       ERROR ? 
      JMP DODEL     NO, DELETE THE OLD ENTRY
      LDB FCODE     YES. IF FCODE WAS A DPURG WE MUST 
      CPB DPURG      DELETE ENTRY SINCE FMP CLOSES
DODEL JSB DELET       REGARDLESS OF ERROR.
      JMP BRN7      SEND THE REPLY
      SPC 3 
* 
*     POSTPROCESS FOR DCRET AND DXCRE 
* 
PST04 LDA IERR      GET ERROR CODE RETURNED BY FMP CALL 
      SSA           ANY ERROR ? 
      JMP INDX      YES, DON'T WORRY ABOUT ALL THIS 
* 
      LDA RQB+#ICR  GET ICR 
      SSA           LU ?
      JMP PST41     YES 
      SZA           SPECIFIED ? 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      JMP PST42     YES, IT'S A CRN 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
      JMP INDX      YES, IT'S A CRN 
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
* 
      LDA LDCB,I    GET 1ST WORD OF DCB 
      AND B77       GET DISC LU 
      CMA,INA 
      STA RQB+#ICR  REPLACE IN REQST BUFR 
PST41 JSB LUCR      TRANSFORM INTO CRN
      LDA CRFAD     GET THE @ OF THE RFAMD ENTRY
      ADA D5        STEP TO THE CRN 
      STB A,I       SET IT
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
PST42 LDA FCODE     GET FCODE 
      CPA DXCRE     DXCRE CALL? 
      RSS           YES 
      JMP INDX      NO, GO DO INDEX THING 
      LDA JSIZE     SET FMP RETURN PARAM
      STA RQB+#JSZ   'JSIZE' INTO REPLY 
      LDA JSIZE+1      BUFFER.
      STA RQB+#JSZ+1
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      JMP INDX      DO THE INDEX THING
      SPC 3 
* 
*     WE COME HERE AFTER A DREAD OR DXREA 
* 
PST02 LDB LEN       GET LEN 
      STB RQB+#LOG  SAVE IN REPLY 
      SSB           SKIP IF NOT EOF 
      CLB           ELSE DO ZERO LENGTH XFER
      JMP PST01 
      SPC 3 
* 
*     WE COME HERE AFTER A CALL TO DOPEN
* 
PST03 LDA RQB+#ICR  GET ICR 
      SZA           WAS IT SPECIFIED ?
      JMP INDX      YES, PASS THE RFAMD ENTRY #, THAT'S ALL 
      LDA IERR      GET THE COMPLETION CODE 
      SSA           ERROR ? 
      JMP INDX      YES 
      LDA LDCB,I    NO, GET 1ST WORD OF DCB 
      CPA MAGLU     RTE-M "MAGIC LU" TYPE 0 FILE? 
      JMP MGLU1     YES, SET SPECIAL CODE IN RQB+8
      AND B77       ISOLATE THE DISC LU 
      CMA,INA       MAKE IT <0 (FOR LU) 
MGLU1 STA RQB+#ICR  REPLACE IT IN REQST BUFR
* 
      JSB BRN41     FIND THE LEGALITY OF THIS OPEN
      JMP PST31     LEGAL, WE ARE IN LUCK ! 
* 
*     THIS OPEN HAS BEEN FOUND TO BE ILLEGAL, THIS MEANS
*     THAT AT LEAST ONE OTHER USER HAS THIS FILE OPENED,
*     AND AT LEAST ONE OF US HAS IT OPENED EXCLUSIVELY. 
*     THE PROBLEM NOW IS TO FIND IF OUR OPEN CHANGED THE
*     TYPE OF OPEN (X/NON-X) AND TO RESTORE THE OLD TYPE
*     IF IT HAS BEEN CHANGED. 
* 
      LDA RQB+#IOP  GET OUR OPEN OPTION 
      SLA           DID WE DO AN EXCLUSIVE OPEN ? 
      JMP NOX3      NO
      LDA PNTR1     YES WE DID, GET THE ADDRESS OF THE
      ADA D7          OTHER USER'S RFAMD ENTRY. 
      LDA A,I       GET THE NODE #
      SSA           DID HE ALSO DO AN EXCLUSIVE OPEN ?
      JMP BAD03     YES, NO TYPE PROBLEM (THIS ALSO PROVES
*                             THAT HE IS THE ONLY OTHER USER OF THIS FILE)
      CLA           RESTORE THE STATUS
      STA OPT03       OF THE FILE TO NON EXCLUSIVE OPEN 
      JMP OP03
* 
NOX3  CLA,INA       SET FOR EXCLUSIVE OPEN
      STA OPT03 
      CLA 
      STA DTBFR+9   SET DCB IN NON OPEN STATUS
* 
OP03  JSB OPEN
      DEF *+7 
      DEF DTBFR     WE WILL NOT NEED THE DCB
      DEF IERR1 
      DEF RQB+#DCB  FILE NAME 
      DEF OPT03     OPTION
      DEF RQB+#ISC  ISECU 
      DEF RQB+#ICR  ICR 
* 
BAD03 LDA DM8       GET THE ERROR CODE
      STA IERR      SET IT IN THE REPLY 
* 
      LDA CRFAD     GET ADDRESS OF CURRENT RFAMD ENTRY
      JSB DELET     DELETE IT 
      JMP BRN7      SEND THE REPLY
      SPC 3 
PST31 LDA RQB+#ICR  GET THE CRN 
      LDB CRFAD     GET THE @ OF THE RFAMD ENTRY
      ADB D5        STEP TO THE ICR 
      STA B,I       SET IT
      JMP INDX      DO THE INDEX THING
      SPC 3 
* 
*     POST PROCESS FOR FLUSH
* 
PST08 LDA TMPNX     GET THE # OF FLUSHED ENTRIES
      STA IERR      SET AS COMPLETION CODE
      LDA CRFAD     DELETE THE LAST ENTRY 
      JSB DELET 
      JMP BRN7      SEND THE REPLY
      SPC 3 
* 
*     THIS WILL SET THE RFAMD ENTRY NUMBER IN THE REQUEST 
* 
INDX  LDA IERR      GET THE ERROR RETURN FROM FMP 
      SSA,RSS       ANY ERROR ? 
      JMP INDX1     NO
      LDA CRFAD     ERROR, DELETE THE ENTRY.
      JSB DELET 
      JMP BRN7
INDX1 LDA CRFAD     GET ADDRESS OF THE CURRENT RFAMD ENTRY
      JSB FNDX      CALCULATE IT'S NUMBER 
      STA RQB+#RFD  SAVE
      SPC 3 
BRN7  CLB           SET FOR NO DATA RETURNED
* 
PST01 LDA #NODE     GET LOCAL NODE #
      STA RQB+#ENO  SET AS THE ERROR LOCATION 
      STB LENGT     SET DATA LENGTH 
      LDA IERR      SET THE COMPLETION CODE 
      STA RQB+#EC2    IN THE REQST BUFR 
* 
PST1A LDA FCODE     GET THE ICODE 
      ADA LNTBL     INDEX IN THE REPLY LENGTH TABLE 
      LDA A,I       GET THE LENGTH
      STA PRMBL     SET THE LENGTH
* 
*     THE REPLY BUFFER IS READY, SEND IT BACK 
* 
      JSB #SLAV 
      DEF *+4 
      DEF PRMBL     REQST BUFR LENGTH 
      DEF DTBFR     DATA BUFFER 
      DEF LENGT     DATA BUFFER LENGTH
* 
      NOP           IGNORE THE ERROR RETURN FROM #SLAV
* 
*     IF THE OPERATION WAS A DCLOS OR DXCLO, AND IT WORKED
*     PROPERLY, WE HAVE TO DELETE THE RFAMD ENTRY.
* 
      LDA FCODE     GET OPCODE FOR THE LAST TIME
      CPA D1        DCLOS ? 
      JMP CLOS      YES 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      CPA DXCLO     DXCLO?
      JMP CLOS      YES 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      JMP PST06 
* 
* 
CLOS  LDA IERR      GET COMPLETION CODE 
      SSA           ERROR ? 
      JMP PST06     YES, DO NOT DELETE THE ENTRY
      LDA CRFAD     GET ADDRESS OF ENTRY
      JSB DELET     GO DELETE IT AND ITS DCB
* 
PST06 LDA C#RLW     GET A COUNTER 
      CMA,INA 
      STA CNTR1 
      LDA RQBA      GET ADR OF REQST BUFR 
      CLB           GET A 0 
PST07 STB A,I       CLEAN REQ-REPLY AREA
      INA 
      ISZ CNTR1 
      JMP PST07     CONTINUE
      JMP GO        GET NEXT REQUEST. 
      SPC 3 
      HED RFAM: UTILITY ROUTINES * (C) HEWLETT-PACKARD CO. 1980 
* 
*     THIS ROUTINE WILL PICK UP THE FILE NAME AND THE CARTRIDGE 
*     NUMBER FROM THE REQST BUFR AND SET THEM FOR THE CALL TO SEARCH. 
* 
*     IF AN LU IS PASSED INSTEAD OF THE CARTRIDGE #, THIS IS
*     CONVERTED TO THE CR #, WHICH IS ALSO SAVED IN RQB+8.
*     SINCE THIS ROUTINE IS CALLED JUST BEFORE A SEARCH, WE 
*     ALSO SET THE SEARCH POINTER TO THE FIRST WORD OF THE
*     RFAMD TABLE.
* 
BRN84 NOP 
      LDA RQB+#ICR  GET THE ICR PARAMETER 
      SZA,RSS       PRESENT ? 
      JMP DEFLT     NO, DEFAULT 
      CLB 
      STB DFLFL     SET THE DEFAULT FLAG
      SSA           LU ?
      JSB LUCR      YES 
      JMP OK84      NO, CRN 
* 
*     WE WANT TO FIND ON WHICH LU OUR FILE IS. WE WILL
*     DO AN EXCLUSIVE OPEN ON THIS FILE AND LOOK IN THE 
*     DCB.
*     WE COME HERE ONLY ON A DNAME OR A DPURG 
* 
DEFLT CCB 
      STB DFLFL     SET THE DEFAULT FLAG
      CLB 
      STB DTBFR+9 
* 
      LDA RQB+#SID  GET SESSION ID WORD FROM REQ. 
      AND B377      ISOLATE DEST. SESSION ID
      STA TEMP      SAVE SESSION ID FOR '#ATCH' CALL
* 
      JSB #ATCH     ATTACH TO SESSION CONTROL BLOCK 
      DEF *+2 
      DEF TEMP
* 
      INA,SZA,RSS   CHECK FOR ERROR 
      JMP RSERR     "RS01" ERROR: SCB NOT FOUND 
* 
      JSB OPEN
      DEF *+6 
      DEF DTBFR     SEND THE DCB INTO THE DATA AREA 
      DEF IERR1 
      DEF RQB+#DCB  FILE NAME 
      DEF D0        EXCLUSIVE OPEN
      DEF RQB+#ISC  ISECU 
* 
      STA TEMP      SAVE <A>
      JSB DTACH    DETACH FROM SESSION CONTROL BLOCK
      DEF *+1 
* 
      LDA TEMP      RESTORE <A> 
      SSA           SUCCESFUL OPEN ?
      JMP FMERR     DONT GO ANY FURTHER 
      LDA DTBFR     GET 1ST WORD OF DCB 
      AND B77       GET THE LU
      CMA,INA 
      STA RQB+#ICR  SET IT INTO REQST BUFR
      JSB LUCR      CONVERT TO CRN
* 
OK84  LDA NAMA      GET ADDRESS OF FILE NAME
      LDB FNAMA 
      JSB .MVW      SET THE FILE NAME FOR THE SEARCH
      DEF D4
      NOP 
      LDA FIRST     WE ALSO SET THE SEARCH POINTER
      STA PNTR1       TO THE BEGINNING OF THE TABLE 
* 
      JMP BRN84,I 
      SPC 3 
* 
*     THIS ROUTINE WILL TRANSFORM A NEGATIVE DISC LU
*     INTO A CARTRIDGE NUMBER. BOTH INPUT AND RESULTS 
*     ARE PASSED VIA RQB+#ICR. THE RESULT WILL ALSO BE
*     FOUND IN B REGISTER. IF AN ERROR IS DISCOVERED
*     WE WILL DIRECTLY JUMP TO THE ERROR ROUTINE. 
* 
LUCR  NOP 
      LDA RQB+#ICR  GET LU/CR 
      CPA MAGLU     RTE-M "MAGIC-LU" CODE?
      JMP LUCR,I    YES, JUST RETURN
      SSA,RSS       LU? 
      JMP LUCR1     NO
      CMA,INA       YES, MAKE IT POSITIVE AND 
      STA DTBFR      SET UP STATUS CALL.
* 
      JSB EXEC      GET EQUIPMENT-TYPE CODE 
      DEF *+4 
      DEF D13I
      DEF DTBFR     USE DTBFR FOR CONWD 
      DEF DTBFR+1    AND EQT5.
      JMP ERR06     ILLEGAL LU
* 
      LDA DTBFR+1   GET EQT5
      ALF,ALF 
      AND B77       ISOLATE EQUIP-TYPE CODE 
      LDB RQB+#ICR  IF DVR05 (CTU SYSTEM),
      CPA D5         RETURN WITH
      JMP LUCR,I      B = -LU.
* 
LUCR1 EQU * 
      LDA RQB+#SID  GET SESSION ID WORD FROM REQ. 
      AND B377      ISOLATE DEST. SESSION ID (BITS 0-7) 
      STA TEMP      SAVE SESSION ID FOR '#ATCH' CALL
* 
      JSB #ATCH     ATTACH TO SESSION CONTROL BLOCK 
      DEF *+2 
      DEF TEMP
* 
      INA,SZA,RSS   CHECK FOR ERROR 
      JMP RSERR     "RS01" ERROR: SCB NOT FOUND 
* 
      JSB FSTAT     GET INFO ON THE CURRENTLY 
      DEF FRTRN       MOUNTED CARTRIDGES. 
DBFAD DEF DTBFR     SEND THE INFO TO THE DATA BUFFER
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      DEF D253      MAX BUFFER LENGTH 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
FRTRN EQU * 
      JSB DTACH     DETACH FROM SESS. CONTROL BLOCK 
      DEF *+1 
* 
      LDA DBFAD     DCB BUFFER ADDR 
LP84  LDB 0,I       GET W1 OF ENTRY 
      CMB,INB 
      CPB RQB+#ICR  IS IT OUR LU? 
      JMP FND84     YES 
      SZB,RSS       END OF TABLE ?
      JMP ERR06     YES, ILLEGAL DISC LU
      ADA D4        PUSH THE ADDR TO THE NEXT ENTRY 
      JMP LP84      CONTINUE
* 
FND84 ADA D2        STEP TO THE CRN 
      LDB 0,I       GET IT
      STB RQB+#ICR  SET IT IN REQST BUFR
      JMP LUCR,I
      SPC 3 
* 
*     ROUTINE TO DELETE AN ENTRY FORM THE RFAMD TABLE AND 
*     TO LINK ITS DCB BACK INTO THE FREE LIST.
*     WHEN A CALL IS MADE TO THIS ROUTINE, A REGISTER 
*     SHOULD CONTAIN THE POINTER TO THE ENTRY TO BE DELETED.
*     THE ID SEGMENT ADDRESS ( WORD 6 ) IS SET TO ZERO AS 
*     A PROTECTION AGAINST PROGRAMS WHICH TRY TO ACCESS A 
*     FILE AFTER HAVING CLOSED IT. AFTER THIS PRECAUTION
*     IS TAKEN, ANY ATEMPT TO ACCESS THIS ENTRY WILL BE 
*     REJECTED AS AN ERROR -26. 
* 
DELET NOP 
      STA DELAD     SAVE ENTRY ADDRESS
      ADA D6        STEP TO THE ID SEG @
      CLB           ZERO THIS WORD
      STB A,I 
      ADA D2        STEP TO THE DCB POINTER.
      LDA A,I       GET THE ADDRESS 
      SZA,RSS       DCB IN CORE NOW ? 
      JMP DELT1     NO, DONT WORRY ABOUT THE DCB
* 
      LDB FCORE     GET THE POINTER TO THE 1ST FREE DCB 
      STB A,I       SET IT AS NEXT TO CURRENT DCB 
      STA FCORE     SET CURRENT DCB AS 1ST FREE DCB.
* 
      LDA LAST      WAS IT THE
      CPA DELAD       LAST DCB IN CORE ?
      INA,RSS       YES 
      JMP DELT1     NO
      LDA A,I 
      STA LAST      RESTORE "LAST"
* 
DELT1 LDA DELAD 
      JSB COUT      REMOVE RFAMD ENTRY FROM IS LIST 
* 
*     NOW INSERT IT IN THE FREE RFAMD LIST. 
* 
      LDB BFREE     GET ADDRESS OF 1ST FREE ENTRY 
      STB DELAD,I   SET AS NEXT TO CURRENT
      LDA DELAD     GET ADDRESS OF CURRENT
      STA BFREE     SET AS FIRST IN FREE LIST 
* 
      JMP DELET,I   ALL DONE, RETURN. 
      SPC 3 
* 
*     THIS ROUTINE REMOVES AN ENTRY FROM THE RFAMD LIST AND 
*     RESTORES THE LINKS AROUND IT. THE ADDRESS OF THE ENTRY
*     TO BE REMOVED IS PASSED IN A REG. THIS ROUTINE INCLUDES 
*     PROTECTION FOR REMOVAL OF FIRST OR LAST ENTRY AND 
*     CHANGE OF "FIRST" IF 1ST ENTRY IS REMOVED.
* 
COUT  NOP 
      STA DELAD 
      INA           STEP TO PREVIOUS
      LDA A,I       GET PREV(DELAD) 
      LDB DELAD,I   GET NEXT(DELAD) 
      INB           STEP TO PREV(NEXT(DELAD)) 
      STA B,I       PREV(NEXT(DELAD)) <= PREV(DELAD)
      LDB DELAD,I   GET NEXT(DELAD) 
      SZA,RSS       ANY PREV ?
      STB FIRST     NO, FIRST <= NEXT(DELAD)
      STB A,I       NEXT(PREV(DELAD)) <= NEXT(DELAD)
      JMP COUT,I    RETURN
      SPC 3 
* 
*     THIS ROUTINE WILL INSERT AN RFAMD ENTRY BEFORE THE ENTRY POINTED
*     AT BY PNTR1, THE ADDRESS OF THE ENTRY TO BE INSERTED IS IN CRFAD. 
*     PNTR1 SHOULD NOT BE = 0. THIS ROUTINE WILL TAKE CARE OF THE 
*     CASE WHERE PNTR1 POINTS TO THE FIRST ENTRY. 
* 
INSRT NOP 
      STA PNTR1     SAVE ADDRESS OF ENTRY 
      CPA CRFAD     ALREADY IN PLACE ?
      JMP INSRT,I   YES 
      INA           STEP TO PREVIOUS
      LDA A,I       GET ADDRESS OF PREVIOUS.
      LDB CRFAD 
      INB 
      STA B,I       PREV(CRFAD)<=PREV(PNTR1)
      LDB CRFAD 
      SZA           DOES PNTR1 POINT TO THE 1ST ENTRY ? 
      STB A,I       NO, NEXT(PREV(PNTR1))<=CRFAD
      LDA PNTR1 
      STA B,I       NEXT(CRFAD)<=PNTR1
      INA 
      STB A,I       PREV(PNTR1)<=CRFAD
      LDA 1         RETURN CRFAD IN A 
* 
      JMP INSRT,I   RETURN
      SPC 3 
* 
*     THIS ROUTINE WILL CALCULATE AN RFAMD ENTRY #. 
*     THE ADDRESS OF THE ENTRY IS PASSED IN THE A REGISTER. 
*     THE RESULT IS RETURNED IN A REGISTER. 
*     IS A TABLE DISCREPENCY IS DETECTED, WE JUMP TO
*     THE PROPER ERROR ROUTINE (-29)
* 
FNDX  NOP 
      STA TMPNX     SAVE THE ADDRESS
      CLB 
      CMA,INA 
      ADA END 
      SSA           IS THE ENTRY IN PART 1 ?
      JMP INDX2     NO
      LDA START     YES (A>0) 
      JMP INDX3 
* 
INDX2 LDA XSTRT     GET ADDRESS OF FWA 2ND PART 
      LDB ENT#1     GET # ENTRIES IN 1ST PART 
INDX3 STB ENTN      INITIALIZE THE NUMBER OF ENTRIES
      CMA,INA 
      ADA TMPNX     FIND THE DISTANCE FROM FIRST WORD 
      DIV D9        DIVIDE BY LENGTH OF ENTRY 
      SZB           THIS IS TO TEST THE VALIDITY OF CRFAD 
      JMP ERR29     NO GOOD !!! 
      ADA ENTN      ADD TO DISPLACEMENT 
      JMP FNDX,I    RETURN
      SPC 3 
* 
*     THIS ROUTINE CALCULATES THE DISC ADDRESS OF A DCB 
*     AND STORES IT IN CTRK AND CSCT (RESPECTIVELY TRACK
*     AND SECTOR). UPON ENTRY TO THIS ROUTINE, A CONTAINS 
*     THE NUMBER OF THE MATCHING RFAMD ENTRY. 
* 
CALDS NOP 
      CLB 
      DIV DCBTR     DIVIDE BY THE NUMBER OF DCB'S PER TRACK 
      ADA ISTRK     ADD THE # OF THE 1ST TRK
      STA CTRK      SAVE THE TRACK NUMBER 
      LDA B 
      MPY D3
      STA CSCT      SAVE THE SECTOR # 
* 
      JMP CALDS,I   RETURN
      SPC 3 
* 
*     CALLING SEQUNCE : JSB BRN41 
*                       <OK RETURN> 
*                       <CANT DO (ERR 08) RETURN> 
* 
BRN41 NOP 
      JSB BRN84     SET UP THE PARAMETERS FOR THE SCAN. 
BRN4L JSB SERCH     SCAN THE LIST.
      JMP BRN41,I   UNSUCCESFUL SEARCH => OK. 
* 
      JSB US? 
      JMP NOTUS     THIS IS NOT OUR ENTRY 
* 
*     SINCE THIS FILE IS ALREADY OPENED TO US AND WE TRY
*     TO OPEN IT AGAIN, WE WILL ACT AS THE FMP: DELETE
*     CURRENT ENTRY AND REOPEN THE FILE (IF POSSIBLE).
* 
      LDB PNTR1,I   GET NEXT TO CURRENT 
      STB PNTR1     UPDATE THE POINTER FOR THE REST OFTHE SCAN
      JSB DELET     GO DELETE THIS ENTRY
      JMP BRN4L     CONTINUE THE SCAN.
* 
NOTUS SSB           SIGN BIT SET ? (I.E. EXCLUSIVE OPEN)
      JMP ERR41     YES, FORGET ABOUT OPENING THIS ONE. 
* 
*     THE FILE HAS BEEN FOUND TO BE OPEN, BUT NOT EXCLUSIVELY 
*     ARE WE TRYING TO OPEN IT EXCLUSIVELY ?
* 
      LDA RQB+#IOP  GET OUR OPEN OPTION 
      SLA,RSS       BIT 1 SET ? 
      JMP ERR41     NO, REJECT. 
      LDA PNTR1,I   GET NEXT TO CURRENT.
      STA PNTR1     RESET SEARCH POINTER. 
      JMP BRN4L     CONTINUE THE SCAN.
* 
ERR41 ISZ BRN41     SET FOR BAD RETURN
      JMP BRN41,I 
      SPC 3 
* 
*     THIS ROUTINE WILL DO THE SPECIAL SEARCH FOR 
*     THE FLUSH PREPROCESSOR
* 
BRN62 NOP 
      JSB SERCH 
      JMP BRN62,I   UNSUCCESSFUL RETURN 
      LDB RQB+#NOD  GET THE OWNER'S NODE
      CPB DM1       FLUSH ALL ? 
      JMP BRN63     YES 
      LDA PNTR1     GET ENTRY ADDRESS 
      ADA D7        STEP TO THE NODE #
      LDA A,I       GET IT
      ELA,CLE,ERA   STRIP THE SIGN BIT
      CPA RQB+#NOD  DESIRED NODE ?
      JMP BRN63     YES 
      LDA PNTR1 
      STA FLFLG     SET THE FLUSH FLAG FOR "NO CLOSE" 
      LDA PNTR1,I   NO, CONTINUE THE SEARCH 
      STA PNTR1 
      JMP BRN62+1 
* 
BRN63 ISZ BRN62     SET FOR OK RETURN 
      JMP BRN62,I   RETURN
      SPC 3 
* 
*     THIS ROUTINE WILL SEARCH THE RFAMD TABLE FOR AN ENTRY 
*     WITH A CERTAIN FILE NAME AND CARTRIDGE NUMBER.
*     CALL:         PNTR1 SHOULD CONTAIN THE ADDRESS OF THE FIRST 
*                   ENTRY TO BE LOOKED AT.
*                   FNAME SHOULD CONTAIN THE FILE NAME AND THE
*                   CARTRIDGE NUMBER (TOTAL 4 WORDS)
*     RETURN:       PNTR1=0 => UNSUCCESSFUL SEARCH RETURN AT
*                   JSB + 1 
*                   PNTR1#0 => SUCCESSFUL SEARCH, RETURN AT JSB+2, PNTR1
*                   CONTAINS THE ADDRESS OF THE MATCHING ENTRY. 
* 
SERCH NOP 
      LDB PNTR1     GET ADDRESS OF 1ST ENTRY. 
      JMP SRC1      GO CHECK FOR END OF LIST
* 
SRCLP ADB D2        STEP TO THE 1ST NAME WORD 
      LDA FNAMA 
      JSB .CMW      COMPARE 
      DEF D4
      NOP 
      JMP SRC3      SUCCESSFUL SEARCH 
      NOP 
      LDB PNTR1,I   GET ADDRESS OF NEXT ENTRY 
      STB PNTR1     RESET RUNNING POINTER 
SRC1  SZB           END OF LIST ? 
      JMP SRCLP     NO, CONTINUE THE SEARCH 
      JMP SERCH,I   YES, UNSUCCESSFUL SEARCH
SRC3  ISZ SERCH     SET SUCCESSFUL RETURN 
      JMP SERCH,I   RETURN
      SPC 3 
* 
*     THIS ROUTINE WILL PICK UP THE RFAMD ENTRY # IN RQB+#DCB+1.
*     IT WILL CHECK FOR BOUNDS AND FOR THE OWNER ID.
*     IF ALL IS OK, RETURN AT JSB+1 WITH A REGISTER POINTING
*     TO THE ENTRY. ELSE RETURN AT ERR26. 
* 
ENTCK NOP 
      LDA RQB+#DCB+1  GET ENTRY # 
      SSA           POSITIVE ?
      JMP ERR26     NO, ILLEGAL.
      CMA 
      ADA ENT#T     COMPARE WITH TOTAL # OF ENTRIES 
      SSA 
      JMP ERR26     ENT#>TOTAL # ENTRIES
      LDB START     GET ADDRESS OF 1ST ENTRY IN LINEAR ORDER
      LDA ENT#1     GET # ENTRIES IN 1ST PART 
      CMA,INA 
      ADA RQB+#DCB+1  ADD ENTRY CURRENT ENTRY NUMBER
      SSA,RSS       IS ENTRY IN 1ST PART ?
      LDB XSTRT     NO, RESET START ADDRESS 
      STB TSTRT     SAVE
      LDA RQB+#DCB+1
      MPY D9        * ENTRY # IN ITS PART BY THE ENTRY LENGTH 
      ADA TSTRT     ADD TO START. 
* 
*     NOW, A CONTAINS A POINTER TO THE CURRENT ENTRY
* 
      LDB A 
      ADB D6        STEP TO OWNER'S ID
      LDB B,I       GET IT
      CPB RQB+#DCB  DOES IT MATCH ? 
      SZB,RSS       YES, MAKE SURE IT'S NOT ZERO
      JMP ERR26     NO, THIS IS NOT US
      LDB A 
      ADB D7        STEP TO THE NODE# 
      LDB B,I       GET IT
      ELB,CLE,ERB   STRIP SIGN BIT OFF
      CPB RQB+#SRC  DOES IT MATCH CURRENT REQUESTER'S NODE #? 
      JMP ENTCK,I   YES 
      JMP ERR26     NO, INTRUDER
      SPC 3 
* 
*     THIS ROUTINE WILL COMPARE THE OWNER ID PART OF AN 
*     RFAMD ENTRY WITH THE OWNER ID OF THE CURRENT REQUEST. 
*     CALLING SEQUENCE: 
*                   JSB US? 
*                   <NO MATCH RETURN> "PNTR1" IS IN A 
*                   <MATCH RETURN> RFAMD "NODE" IS IN B 
* 
US?   NOP 
      LDA PNTR1 
      LDB A 
      ADB D6        STEP TO OWNER'S ID
      LDB B,I       GET IT
      CPB RQB+#ID   DOES IT MATCH ? 
      RSS 
      JMP US?NO     NO, THIS IS NOT US
      LDB A 
      ADB D7        STEP TO THE NODE# 
      LDB B,I       GET IT
      ELB,CLE,ERB   STRIP SIGN BIT OFF
      CPB RQB+#SRC  DOES IT MATCH CURRENT REQUESTER'S NODE #? 
      ISZ US?       YES, SET FOR OK RETURN
US?NO LDB 0 
      ADB D7        ADDR OF RFAMD: 8TH WORD 
      LDB 1,I       GET IT (NODE) 
      JMP US?,I     RETURN
      SPC 3 
* 
*     THIS ROUTINE FILLS THE END OF THE CALL BUFFER WITH 0'S
*     THIS ROUTINE IS CALLED WITH B CONTAINING THE
*     ADDRESS OF THE 1ST WORD TO BE NOPED.
* 
NOPS  NOP 
      CLA 
NOPS1 STA B,I 
      INB 
      CPB RTN       END ? 
      JMP NOPS,I    YES 
      JMP NOPS1     NO
      SPC 3 
* 
*     THIS IS THE SKELETON OF THE FMP CALL
* 
PARAM DEF PRAM1 
* 
CALL  LDA RQB+#SID  GET SESSION ID WORD FROM REQST
      AND B377      ISOLATE DEST. SESSION ID
      STA TEMP         SESSION CONTROL BLOCK
* 
      JSB #ATCH 
      DEF *+2 
      DEF TEMP
* 
      INA,SZA,RSS   CHECK FOR ERROR 
      JMP RSERR     "RS01" ERROR: SCB NOT FOUND 
* 
      JSB CALLI,I   CALL FMP ROUTINE
RTNAD NOP           DEF RTRN
LDCB  NOP           ADDRESS OF DCB IF ANY 
      DEF IERR      ERROR 
PRAM1 REP 8         1ST 'CALL' PARAM
      NOP 
* 
DONE  JSB DTACH     DETACH FROM SESS. CONTROL BLOCK 
      DEF *+1 
* 
      LDA IERR      GET RETURNED ERROR CODE 
      SSA,RSS       DID FMP DETECT AN ERROR?
      JMP NOERR     NO
      LDA "FM"      YES, INDICATE AN FMP-DETECTED ERROR 
      STA #RPB+#EC1   IN THE REPLY. 
NOERR LDA FCODE     GET FCODE 
      ADA PSTBL     MAP IN THE POST PROCESSING TABLE
      JMP A,I 
* 
"FM"  ASC 1,FM
* 
* 
CALLI NOP           ADR OF FMP CALL 
RTN   DEF DONE
* 
* 
RSERR LDA "RS"      RETURN SPECIAL ASCII
      STA #RPB+#EC1  REMOTE SESSION MONITOR 
      LDA "01"        ERROR CODE "RS01".
      STA #RPB+#EC2 
      LDA BIT15     SET SIGN BIT IN IERR TO SIMULATE
      STA IERR       NEG ERROR CODE FOR 'CLOS'. 
      IOR #NODE     SET LOCAL NODE # AND ASCII-ERROR
      STA #RPB+#ENO   BIT INTO REPLY. 
      CLA           SET DATA LENGTH FOR 
      STA LENGT       CALL TO #SLAV.
      JMP PST1A     GO SEND REPLY 
* 
* 
"RS"  ASC 1,RS
"01"  ASC 1,01
      HED RFAM: ERROR HANDLING * (C) HEWLETT-PACKARD CO. 1980 
ERR06 LDA DM6 
      JMP FMERR 
ERR11 LDA DM11
      JMP FMERR 
ERR08 LDA DM8 
      JMP FMERR 
ERR25 EQU *         INVALID FCODE. SET TO ZERO TO 
      CLA            INSURE VALID INDEX INTO REPLY
      STA FCODE       LENGTH TABLE LATER. 
      LDA DM25
      JMP ERRXX 
ERR26 LDA DM26
      JMP ERRXX 
ERR28 LDA DM28
      JMP ERRXX 
DSCER CCA,RSS 
ERR29 LDA DM29
* 
ERRXX EQU * 
      LDB "DS"
* 
*     HERE WITH <A> = ERROR CODE, <B> = "FM" OR "DS"
* 
ERRYY EQU * 
      STA IERR      SET THE ERROR CODE IN THE REPLY 
      STB #RPB+#EC1   SAVE CATEGORY OF ERROR
      JMP BRN7      GO SHIP THE REPLY 
* 
FMERR EQU *         HERE TO REPORT "FMP" ERRORS 
      LDB "FM"
      JMP ERRYY 
"DS"  ASC 1,DS
      SPC 3 
      HED RFAM: CONSTANTS * (C) HEWLETT-PACKARD CO. 1980
A     EQU 0 
B     EQU 1 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
B13   OCT 13
MDXLO EQU B13       DXLOC REPLY PARAM MASK
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
DM29  DEC -29 
DM28  DEC -28 
DM26  DEC -26 
DM25  DEC -25 
* 
UBFCN EQU *         -(UPPER BOUND +1) OF FUNCTION CODES 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      DEC -21 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
      DEC -14 
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
* 
DM11  DEC -11 
DM9   DEC -9
DM8   DEC -8
DM7   DEC -7
DM6   DEC -6
DM1   DEC -1
D0    DEC 0 
D1    DEC 1 
D1I   OCT 100001
D2    DEC 2 
D2I   OCT 100002
D3    DEC 3 
D4    DEC 4 
D5    DEC 5 
D6    DEC 6 
D7    DEC 7 
D8    DEC 8 
D9    DEC 9 
D12   DEC 12
D13I  OCT 100015
D14   DEC 14
D99   DEC 99
D125  DEC 125 
D144  DEC 144 
D512  DEC 512 
DPURG EQU D8        FCODE FOR DPURG 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
D15   DEC 15
D253  DEC 253 
* 
MDXCL EQU D1        DXCLO PARAM MASK
MDXAP EQU D3        DXAPO PARAM MASK
MDXP0 EQU D1        DXPOS PARAM MASK
MDXWR EQU D2        DXWRI PARAM MASK
DXCRE EQU D14       DXCRE FUNCTION CODE 
DXCLO EQU D15       DXCLO FUNCTION CODE 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
XEQT  EQU 1717B 
BGLWA EQU 1777B 
SECT2 EQU 1757B 
B77   OCT 77
B377  OCT 377 
MAGLU OCT 177400    1ST DCB ENTRY FOR "M" MAGIC LU'S
START NOP           ADDRESS OF LINEAR 1ST RFAMD ENTRY 
FIRST NOP           HEAD POINTER OF THE RFAMD LIST
LAST  NOP           POINTER TO THE LAST DCB-IN-CORE RFAMD 
*                                  ENTRY
BFREE NOP           HEAD POINTER OF THE RFAMD FREE LIST 
FCORE NOP           HEAD POINTER OF THE DCB FREE LIST 
XSTRT NOP 
ENT#1 NOP           NUMBER OF RFAMD ENTRIES IN PART 1 
ENT#T NOP           NUMBER OF RFAMD ENTRIES (TOTAL) 
ISTRK NOP           ADDRESS OF DISC TRACKS CONTAINING 
IDISC NOP             THE DCB'S 
DCBTR NOP           NUMBER OF DCB'S PER TRACK 
FCODE NOP           FUNCTION CODE 
LENA  DEF LEN 
FNAMA DEF FNAME 
CRA   DEF RQB+#ICR  @ OF THE ICR
SECUA DEF RQB+#ISC  @ OF ISECU
RFMDA DEF RFAMD 
C#DCB ABS #DCB
C#1ST ABS #DCB+3    1ST RQST PARAM OFFSET 
C#ICR EQU C#1ST 
C#REC ABS #REC
C#IL  ABS #IL 
C#NUM ABS #NUM
#DCBA DEF RQB+#DCB
NAMA  EQU #DCBA 
#SIZA DEF RQB+#SIZ
#TYPA DEF RQB+#TYP
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
#XTYA DEF RQB+#XTY
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      HED RFAM: VARIABLES * (C) HEWLETT-PACKARD CO. 1980
PNTR1 NOP 
CNTR1 NOP 
TMP1  NOP 
CTRK  NOP 
CSCT  NOP 
TSTRT NOP 
FNAME BSS 4 
IERR1 NOP 
LENGT NOP 
CRFAD NOP           ADDRESS OF CURRENT RFAMD ENTRY
LEN   NOP 
ENTN  NOP 
OPT03 NOP 
PRMBL NOP 
DFLFL NOP 
IERR  NOP 
TMPAD NOP 
DELAD NOP 
RQLN  NOP           REQUEST LENGTH
TMPNX NOP 
FLFLG NOP 
SWNX  NOP 
      HED RFAM: TABLES * (C) HEWLETT-PACKARD CO. 1980 
BRNCH DEF *+1,I 
      DEF BRN1      DAPOS 
      DEF BRN2      DCLOS 
      DEF BRN1      DCONT 
      DEF BRN3      DCRET 
      DEF BRN1      DLOCF 
      DEF BRN8      DNAME 
      DEF BRN4      DOPEN 
      DEF BRN1      DPOSN 
      DEF BRN8      DPURG 
      DEF BRN1      DREAD 
      DEF BRN10     DSTAT 
      DEF BRN1      DWIND 
      DEF BRN1      DWRIT 
      DEF BRN6      FLUSH 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      DEF BRN3      DXCRE 
      DEF BRN2      DXCLO 
      DEF BRN1      DXREA 
      DEF BRN1      DXWRI 
      DEF BRN1      DXAPO 
      DEF BRN1      DXPOS 
      DEF BRN1      DXLOC 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
JSBTB DEF *+1 
      DEF APOSN 
      DEF CLOSE 
      DEF FCONT 
      DEF CREAT 
      DEF LOCF
      DEF NAMF
      DEF OPEN
      DEF POSNT 
      DEF PURGE 
      DEF READF 
      NOP 
      DEF RWNDF 
      DEF WRITF 
      DEF CLOSE     FLUSH 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      DEF ECREA 
      DEF ECLOS 
      DEF EREAD 
      DEF EWRIT 
      DEF EAPOS 
      DEF EPOSN 
      DEF ELOCF 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
BLDTB DEF *+1,I     CALL BUILDING TABLE 
      DEF BLD0      DAPOS 
      DEF BLD0      DCLOS 
      DEF BLD0      DCONT 
      DEF BLD3      DCRET 
      DEF BLD4      DLOCF 
      DEF BLD5      DNAME 
      DEF BLD6      DOPEN 
      DEF BLD0      DPOSN 
      DEF BLD8      DPURG 
      DEF BLD9      DREAD 
      NOP 
      DEF BLD0      DWIND 
      DEF BLD12     DWRIT 
      DEF BLD0      FLUSH 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      DEF BLD3      DXCRE 
      DEF BLD15     DXCLO 
      DEF BLD9      DXREA 
      DEF BLD17     DXWRI 
      DEF BLD18     DXAPO 
      DEF BLD19     DXPOS 
      DEF BLD20     DXLOC 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
      SPC 3 
LNTBL DEF *+1       REPLY LENGTH TABLE
      ABS #REP      DAPOS 
      ABS #REP      DCLOS 
      ABS #REP      DCONT 
      ABS #RFD+1    DCRET 
      ABS #JRC+1    DLOCF 
      ABS #REP      DNAME 
      ABS #RFD+1    DOPEN 
      ABS #REP      DPOSN 
      ABS #REP      DPURG 
      ABS #LOG+1    DREAD 
      ABS #REP      DSTAT 
      ABS #REP      DWIND 
      ABS #REP      DWRIT 
      ABS #REP      FLUSH 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      ABS #JSZ+2    DXCRE 
      ABS #REP      DXCLO 
      ABS #LOG+2    DXREA 
      ABS #REP      DXWRI 
      ABS #REP      DXAPO 
      ABS #REP      DXPOS 
      ABS #XJR+1    DXLOC 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      SPC 3 
PSTBL DEF *+1,I     POST PROCESSING TABLE 
      DEF BRN7      DAPOS 
      DEF BRN7      DCLOS 
      DEF BRN7      DCONT 
      DEF PST04     DCRET 
      DEF BRN7      DLOCF 
      DEF PST05     DNAME 
      DEF PST03     DOPEN 
      DEF BRN7      DPOSN 
      DEF PST05     DPURG 
      DEF PST02     DREAD 
      NOP 
      DEF BRN7      DWIND 
      DEF BRN7      DWRIT 
      DEF PST08     FLUSH 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      DEF PST04     DXCRE 
      DEF BRN7      DXCLO 
      DEF PST02     DXREA 
      DEF BRN7      DXWRI 
      DEF BRN7      DXAPO 
      DEF BRN7      DXPOS 
      DEF BRN7      DXLOC 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      HED RFAM: BUFFERS * (C) HEWLET-PACKARD CO. 1980 
* 
C#RLW ABS #RLW      MAX LEN OF REQ/REPLY BUFFER.
* 
* 
DTBFR BSS 512 
.     EQU * 
      ORG DTBFR 
MS1   ASC 17,RFAM: LIMITED BUFFER SPACE, THE NU 
      ASC 19,MBER OF FILES HAS BEEN LIMITED TO
MS1A  DEF *-2 
MS2   ASC 17,RFAM: LIMITED DISC SPACE, THE NUMB 
      ASC 19,ER OF FILES HAS BEEN LIMITED   TO
MS2A  DEF *-2 
      BSS 8         FILLER
      HED RFAM: INITIALIZATION * (C) HEWLETT-PACKARD CO. 1980 
* 
*     THIS PART IS THE INITIALIZATION. ALL CODE IN THIS 
*     SECTION MUST LIE WITHIN THE DATA BUFFER AREA 'DTBFR', 
*     AND WILL BE OVERLAYED WITH DATA LATER. IT MUST NOT
*     EXCEED THE 'DTBFR' AREA SINCE THE RFAMD AND IN-CORE 
*     DCB'S FOLLOW IMMEDIATELY AFTER. IF EXCEEDED, THE
*     'EQU' AT 'CHECK' SHOULD GIVE AN ASSEMBLY ERROR. 
* 
*     THE INITIALIZATION WORKS AS FOLLOWS:
*                   1) FIND HOW MUCH ROOM WE HAVE IN THE PROGRAM
*                      ITSELF AND AFTER THE PROGRAM, IN ITS PARTITION 
*                   2) LINK THE RFAMD TABLE, RESERVING AS MANY
*                      ENTRIES AS REQUIRED IN THE CALL FROM LSTEN 
*                   3) DEPENDING ON THE ROOM LEFT, REQUIRE DISC TRACKS
*                      FOR THE DISC RESIDENT DCB'S. 
*                   4) LINK THE IN-CORE DCB LIST. 
* 
* 
* 
*               DESCRIPTION OF AN RFAMD ENTRY 
* 
*     1) RFAMD ENTRY IN THE ACTIVE LIST (I.E. CURRENTLY USED) 
*                   W0  POINTER TO NEXT ENTRY 
*                   W1  POINTER TO PREVIOUS ENTRY 
*                   W2-W4  FILE NAME. 
*                   W5  CARTRIDGE NUMBER
*                   W6  ID SEGMENT ADDRESS !  FILE "OWNER"
*                   W7  NODE NUMBER. BIT 15!  IDENTIFICATION
*                        SET INDICATES AN 
*                        EXCLUSIVE OPEN 
*                   W8  DCB POINTER. THIS WORD IS EQUAL TO 0 IF THE 
*                         DCB IS CURRENTLY DISC RESIDENT. IT IS EQUAL 
*                         TO THE ADDRESS OF THE DCB IF THE DCB IS IN
*                         CORE. 
* 
*     2) RFAMD ENTRY IN THE FREE LIST (I.E. NOT CURRENTLY USED) 
*                   W0  POINTER TO THE NEXT ENTRY 
*                   W1-W9  DONT CARE
* 
* 
*              DESCRIPTION OF A DCB ENTRY 
* 
* 
*     1) DCB IN THE ACTIVE LIST 
*                   W0-W143  144 WORD DCB 
* 
*     2) DCB IN THE FREE LIST 
*                   W0  POINTER TO THE NEXT FREE DCB SPACE
*                   W1-W143  DONT CARE
* 
* 
*     IN ALL FOUR THREADED LISTS OF THIS PROGRAM, THE END 
*     OF LIST MARKER IS A NULL (0) POINTER TO THE NEXT ENTRY. 
* 
*     FOR THE DESCRIPTION OF THE HEAD OF LIST POINTERS, REFER 
*     TO THE "CONSTANTS" SECTION IN THE PERMANENT PART OF THIS
*     PROGRAM.
* 
      SPC 3 
INIT  JSB DTACH     (IN CASE 'DINIT' RUN FROM SESSION)
      DEF *+1 
* 
      JSB EXEC      SWAP CONTROL
      DEF *+3 
      DEF D22       SWAP ALL PARTITION
      DEF D3
* 
      JSB .DRCT     GET & SAVE DIRECT 
      DEF RQB        ADDRESS OF EXTERNAL
      STA RQBA        REQ/RPY BUFFER .
* 
* 
      LDA XEQT      GET OUR ID SEG ADR
      ADA D14       POINT TO WORD 15 ('TYPE') 
      LDA A,I       GET IT
      AND B7        ISOLATE 'TYPE' MODULO 8 
      CLB 
      CPA D1        ARE WE MEMORY RESIDENT? 
      INB           YES, SO NO DCB'S IN EXTENSION 
      STB FLG1      SET EXTENSION FLAG
* 
      LDA XEQT      GET OUR CURRENT ID SEGMENT ADDRESS
      ADA D23       POINT TO HI MAIN ADDR + 1 
      LDA 0,I       GET IT
      STA XSTRT     SAVE (XTENTION START) 
* 
      LDA FLG1      GET EXTENSION FLAG
      SZA           CAN WE HAVE DCB'S IN EXTENSION? 
      JMP INIT4     NO
      LDA XSTRT     YES, SO MAY BE ROOM FOR 
      CMA,INA        SOME DCB'S.
      ADA BGLWA     CALCULATE ROOM AVAILABLE IN EXTENSION 
      ADA DM143     FIND IF THERE IS ENOUGH 
      CLB             ROOM IN THE EXTENSION FOR AT
      SSA               LEAST ONE DCB.
      INB           NO, CAN'T HAVE DCB'S IN EXTENSION 
      STB FLG1      SET A FLAG TO INDICATE THIS 
* 
* 
      LDB #RFSZ     GET THE # OF FILES REQUESTED
      STB RFSZ
      SZB           TEST FOR <=0
      SSB           "NO SWAP" REQUEST ? 
      JMP NOSWP     YES 
* 
INIT4 CLA           INITIALIZE # RFAMD ENTRIES
      STA ENT#1 
      STA ENT#T 
* 
*     LINK THE FREE RFAMD LIST
*     THE HEAD POINTERS ARE:
*                   BFREE (FREE LIST) 
*                   FIRST (CURRENT LIST)
*                   LAST  (LAST ENTRY REFERING TO AN IN-CORE DCB) 
*                   START (ADDRESS OF THE FIRST RFAMD ENTRY IN
*                          LINEAR ORDER)
* 
      LDA RFSZ      GET THE # OF ENTRIES REQUESTED
      CMA,INA 
      STA CNTR1     USE AS COUNTER
* 
*     THE RUNNING POINTER PNTR1 IS ALREADY INITIALIZED
* 
      LDA RFMDA     GET ADDRESS OF TABLE START
      STA START 
      STA BFREE 
      STA PNTR1     SET ALL POINTERS
* 
LOOP1 LDB FLG1      GET THE "SMALL EXTENSION" FLAG
      SZB,RSS       SET ? 
      JMP LOP12     NO, NO PROBLEM
      ADA D153      SEE IF ENOUGH ROOM LEFT IN THE INTERNAL 
      CMA,INA        BUFFER FOR ONE MORE DCB & RFAMD ENTRY
      ADA END 
      SSA,RSS 
      JMP LOP13     YES, ENOUGH ROOM
      CLA           NO, NOT ENOUGH ROOM 
      LDB PNTR1 
      ADB DM9       STEP BACK TO LAST ENTRY 
      STA B,I       SET IT AS LAST ENTRY OF THE LIST
      LDA ENT#1 
      STA ENT#T     SET THE TOTAL # OF ENTRIES
      JMP TREQ      GO TAKE CARE OF SWAPPING
* 
LOP12 ADA D17 
      CMA 
      ADA END       COMPARE WITH THE END OF THE 1ST PART
      SSA           WILL THERE BE ENOUGH ROOM FOR THE NEXT
*                                    ENTRY? 
      JMP INT01     NO
LOP13 LDA PNTR1     YES GET CURRENT POINTER AGAIN 
      ADA D9        GET ADDRESS OF NEXT ENTRY 
      STA PNTR1,I   SAVE AS "NEXT" TO CURRENT ENTRY 
      STA PNTR1     PUSH CURRENT POINTER TO NEXT ENTRY
      ISZ ENT#1     INCREMENT # OF ENTRIES IN 1ST PART
* 
      ISZ CNTR1     INCREMENT REQUIRED-ENTRIES COUNTER
      JMP LOOP1     CONTINUE
      CLA           SET THE END OF LIST MARK
      LDB PNTR1 
      ADB DM9       STEP BACK TO THE LAST ENTRY 
      STA B,I 
      LDA ENT#1     GET NUMBER OF ENTRIES IN PART #1
      STA ENT#T     SAVE AS TOTAL NUMBER OF ENTRIES 
      JMP TREQ      NOW GO DO THE TRACK REQUEST IF NECESSARY
* 
      SPC 3 
* 
*     WE COME HERE IF THERE IS NOT ENOUGH ROOM IN THE FIRST 
*     PART (I.E. INSIDE THE PROGRAM) FOR THE ENTIRE RFAMD TABLE.
* 
INT01 ISZ ENT#1     INC # ENTRIES IN 1ST PART 
      LDB ENT#1 
      STB ENT#T     SET CURRENT TOTAL # ENTRIES 
      ISZ CNTR1     ALL DONE BUT ONE ?
      RSS           NO
      JMP INT04     YES, SPECIAL CASE 
      LDA XSTRT     GET ADDRESS OF THE 1ST WORD OF 2ND PART 
      STA PNTR1,I   SAVE AS "NEXT" TO CURRENT ENTRY 
      STA PNTR1     UPDATE RUNNING POINTER TO NEXT ENTRY
      JMP LOP11     CONTINUE
* 
INT04 CLA           SET THE END OF LIST MARK
      STA PNTR1,I 
      LDA XSTRT 
      STA PNTR1     RESET PNTR1 TO THE SECOND PART
      JMP TREQ      GO REQUEST TRACKS IF NECESSARY
      SPC 3 
LOP11 ADA D153      SEE IF WE HAVE ENOUGH SPACE FOR 1 DCB 
      CMA             AND ONE RFAMD ENTRY.
      ADA BGLWA     COMPARE WITH FWA SYSTEM MEMORY. 
      SSA,RSS       ENOUGH ROOM ? 
      JMP LOP21     YES 
      CLA           NO, TERMINATE THE LIST
      LDB PNTR1     STEP BACK 
      ADB DM9         TO PREVIOUS ENTRY 
      STA B,I       MARK IT AS LAST ENTRY 
      ISZ ENT#T 
      JMP TREQ      GO TAKE CARE OF THE SWAPPING. 
* 
LOP21 LDA PNTR1     GET ADDRESS OF CURRENT ENTRY AGAIN
      LDB PNTR1 
      ADA D9        STEP TO NEXT ENTRY
      STA PNTR1,I   SAVE AS "NEXT" TO CURRENT ENTRY 
      STA PNTR1     UPDATE RUNNING POINTER
      ISZ ENT#T     INC THE TOTAL NUMBER OF ENTRIES 
      ISZ CNTR1     ALL DONE ?
      JMP LOP11     NO, CONTINUE
      CLA           YES, SET THE END OF LIST MARK 
      STA B,I 
      SPC 3 
* 
*     BY THE TIME WE COME HERE, THE COMPLETE RFAMD LIST WILL BE 
*     LINKED AS A FREE LIST. PNTR1 NOW POINTS TO THE NEXT 
*     AVAILABLE WORD, I.E. THE 1ST WORD OF THE IN-CORE DCB SPACE. 
*     WE WILL NOW CALCULATE THE NUMBER OF DCB'S WE CAN KEEP IN CORE 
*     AT A TIME AND REQUEST DISC TRACK(S) IF THIS NUMBER IS LESS
*     THAN THE NUMBER OF RFAMD ENTRIES WE HAVE. 
* 
TREQ  LDA PNTR1     GET ADDRESS OF NEXT WORD
      CMA,INA 
      ADA END       FIND # OF WORDS IN 1ST PART 
      SSA,RSS 
      JMP INT02 
      CLA           A<0 => NO ROOM IN PART 1
      STA PRT1#         => NO DCB IN PART 1 
      LDA PNTR1 
      JMP INT03 
INT02 CLB           SET B FOR DIVISION
      DIV D144      DIVIDE SPACE BY LENGTH OF 1 ENTRY 
      STA PRT1#     SAVE THE INTEGER PART AS # DCB IN 1ST PART
      LDA XSTRT     GET ADDRESS OF 1ST WORD OF SECOND PART
* 
*     HERE WE LOOK AT PART 2 IN THE SAME FASHION
* 
INT03 CMA,INA 
      ADA BGLWA     GET ROOM IN XTENTION(SIGN ALREADY TESTED) 
      CLB           SET B FOR DIVISION
      DIV D144
      LDB FLG1      GET EXTENSION FLAG
      SZB           CAN WE HAVE DCB'S IN EXTENSION? 
      CLA           NO, SO SET PRT2# TO ZERO
      STA PRT2#     SAVE # DCB'S IN PART 2
      ADA PRT1#     FIND TOTAL NUMBER OF IN-CORE DCB'S
      STA TOT#      SAVE
      SPC 3 
* 
*     NOW WE DECIDE IF WE NEED ANY DISC SPACE.
* 
      LDA ENT#T      GET # OF RFAMD ENTRIES 
      CMA,INA 
      ADA TOT#      COMPARE TO # OF IN-CORE DCB'S 
      CLB           SET FOR NEXT DIVISION 
      SSA,RSS 
      JMP GREAT     A=0 OR A>0
* 
*     A>=0 :
*     I HAVE GOOD NEWS FOR YOU: WE DONT NEED ANY DISC SPACE 
*     THIS ALSO MEANS THAT THERE WILL BE NO DCB SWAPPING
*     => FASTER FILE ACCESS. GO LINK THE DCB'S
* 
*     HERE WE FIND HOW MANY TRACKS WE NEED, AND WE REQUEST
*     THEM. WE NEED 3 SECTORS (64 WORDS EACH) PER TRACK.
* 
      LDA $OPSY     FIRST WE BETTER SEE IF
      RAR,RAR        WE EVEN HAVE A SYSTEM DISC.
      SLA,RSS       DO WE?
      JMP NOSWP     NO, WE ARE IN RTE-M 
* 
      LDA TRK#      SEE IF THE TRACKS ARE ALREADY 
      SZA           ASSIGNED (SECOND TIME AROUND) 
      JMP GREAT     YES THEY ARE
* 
      LDA SECT2     GET THE NUMBER OF SECTORS PER TRACK 
      DIV D3
      STA DCBTR     SAVE THE NUMBER OF DCB'S/TRACK
      LDA ENT#T      GET # OF RFAMD ENTRIES 
      CLB 
      DIV DCBTR     DIVIDE BY THE NUMBER OF DCB'S/TRACK 
      SZB 
      INA           ROUND TO NEXT TRACK 
      IOR BIT15     SET THE NO WAIT BIT 
      STA TRK#      SAVE
* 
*     WE SET THE NO-WAIT BIT SINCE IF WE CANT GET THE TRACKS
*     WE WANT WE WILL TRY TO COMPROMISE.
* 
      JSB EXEC
      DEF *+6 
      DEF D4        TRACK REQUEST 
      DEF TRK#
      DEF ISTRK     NUMBER OF 1ST TRACK 
      DEF IDISC     LU OF DISK
      DEF ISEC      # SECTORS/TRACK (FORGET IT) 
* 
      CCA           GOOD ALLOCATION ? 
      CPA ISTRK 
      RSS 
      JMP GREAT     YES, GO LINK THE DCB'S
      SPC 3 
LOWER ADA TRK#      TRY TO SETTLE FOR ONE LESS TRACK
      STA TRK#
      SZA,RSS       IS THIS NO TRACK AT ALL ? 
      JMP NOSWP     YES! GO TO THE OPTIMISATION ROUTINE 
* 
      JSB EXEC
      DEF *+6 
      DEF D4
      DEF TRK#
      DEF ISTRK 
      DEF IDISC 
      DEF ISEC
* 
      CCA 
      CPA ISTRK     HOW WAS THIS ONE ?
      JMP LOWER     BAD, CONTINUE TO REDUCE OUR REQUEST 
      LDA TRK#      OK, NOW FIND HOW MANY DCB'S 
      MPY DCBTR       WE ARE ALLOWED TO HAVE
      STA RFSZ
      JMP INIT4     TRY AGAIN 
      SPC 3 
* 
*     WE WILL FIND HERE THE LARGEST POSSIBLE # OF ENTRIES 
*     NOT REQUIRING DCB SWAPPING. 
* 
NOSWP LDA FLG1      GET EXTENSION FLAG
      SZA           ARE DCB'S ALLOWED IN EXTENSION? 
      JMP NSWP2     NO, DEFAULT TO MINIMUM
      LDA XSTRT     YES 
      CMA,INA 
      ADA BGLWA     FIND SIZE OF INTERNAL BUFFER
      STA Y 
      LDB RFMDA 
      CMB,INB 
      ADB END       FIND THE SIZE OF THE INTERNAL BUFFER
      STB X 
      ADA B         TOTAL SIZE
      CLB 
      DIV D153      FIND IDEAL NUMBER 
      STA IDEAL     SAVE THE RESULT 
      MPY D9        FIND SIZE OF RFAMD IN THIS CONFIGURATION
      CMA,INA 
      ADA X         FIND ROOM LEFT IN 1ST BUFFER AFTER
      SSA           THE IDEAL RFAMD HAS BEEN BUILD.ANY ROOM ? 
      JMP NSWP1     NO
* 
      CLB 
      DIV D144      FIND # OF DCB'S THAT WOUD BE ALLOWED TO 
      STA IERR        BE IN INTERNAL BUFFER 
      STB IERR1 
      CLB 
      LDA Y 
      DIV D144      FIND # OF DCB'S IN EXTENSION
      ADA IERR      TOTAL # 
NSWP4 SZA,RSS       NONE ?
      JMP NSWP2     GO DEFAULT TO MINIMUM 
* 
      CPA IDEAL 
      JMP NSWP3     IDEAL, DONE 
      LDB A 
      INB 
      CPB IDEAL 
      JMP NSWP3 
      LDB IERR1     FIND REMAINDER OF PREVIOUS DIVISION 
      ADB DM10
      SSB           EASY TO IMPROVE ? 
      INA           YES 
      JMP NSWP3     DONE
* 
NSWP1 CLB 
      LDA X 
      DIV D9        GET # RFAMD ENTRIES IN 1ST PART 
      CMA,INA 
      ADA IDEAL     # ENTRIES IN EXTENSION
      STA RQLN      SAVE TEMPORARILY
      MPY D9        RFAMD SPACE IN EXTENSION
      CMA,INA 
      ADA Y         DCB SPACE IN EXTENSION
      CLB 
      DIV D144      # DCB'S IN EXTENSION
      STA IERR
      LDA RQLN
      SZA,RSS       1ST DCB STARTS AT THE BEGINNING OF XTENTION ? 
      LDB D99       YES 
      STB IERR1 
      LDA IERR      RETRIEVE # DCB'S IN EXTENSION 
      JMP NSWP4 
D23   DEC 23
* 
NSWP2 LDA D2        GET MINIMUM # DCB'S 
NSWP3 STA RFSZ
      JMP INIT4 
      SPC 3 
* 
*     HERE WE LINK THE DCB'S AS A FREE LIST 
* 
GREAT LDA PNTR1     ADDRESS OF THE FWA
      STA FCORE     SET THE HEAD-OF-THE-FREE-DCB-LIST-POINTER 
* 
      CLB 
      CPB PRT1#     DID WE FIND ROOM IN 1ST PART ?
      JMP INIT1     NO, => THERE IS ROOM IN PART 2 (ALREADY 
*                                   TESTED FOR) 
* 
      INB 
      CPB PRT1# 
      JMP INIT2     CURRENT IS LAST IN PART 1 
      LDB PRT1# 
      CMB,INB 
      STB CNTR1     SET COUNTER 
      JMP LOOP4 
* 
*     IF PNTR1 IS STILL IN THE 1ST PART, WE HAVE TO UPDATE
*     FCORE AND PNTR1 TO XSTRT. 
* 
INIT1 CMA,INA       -PNTR1
      INA 
      ADA END       FIND IF PNTR1 IS IN THE 1ST PART
      SSA 
      JMP INIT3     A<0 => PNTR1 IN 2ND PART, OK
      LDA XSTRT     GET ADDRESS OF 2ND PART 
      STA FCORE     RESET FREE DCB LIST HEAD POINTER
      STA PNTR1     RESET RUNNING POINTER 
      JMP INIT3     START LINKING 
* 
LOOP2 ADA D144      GET ADDRESS OF NEXT DCB 
      STA PNTR1,I   SET "NEXT" TO CURRENT 
      STA PNTR1     UPDATE RUNNING POINTER
LOOP4 ISZ CNTR1 
      JMP LOOP2 
* 
INIT2 LDB PRT2# 
      SZB,RSS       IS THERE ROOM IN PART 2 ? 
      JMP INIT6     NO, QUIT
      LDA XSTRT     GET ADDRESS OF FWA IN 2ND PART
      STA PNTR1,I   SAVE AS "NEXT" TO CURRENT 
      STA PNTR1     UPDATE RUNNING POINTER
* 
*     HERE WE LINK THE 2ND PART OF THE DCB FREE LIST
* 
INIT3 LDA PNTR1 
      CLB,INB       GET A 1 
      CPB PRT2#     ONLY ONE LEFT ? 
      JMP INIT6     YES, TERMINATE
* 
LOOP3 ADA D144      GET THE ADDRESS OF THE NEXT DCB 
      STA PNTR1,I   SAVE AS "NEXT" TO CURRENT 
      STA PNTR1     UPDATE RUNNING POINTER
      INB           INC COUNT 
      CPB PRT2#     DONE ?
      RSS           YES 
      JMP LOOP3     NO, CONTINUE
* 
INIT6 CLA           SET THE END OF LIST MARK
      STA PNTR1,I 
* 
*     WE WILL NOW REPORT TO THE OPERATOR THE ACTUAL NUMBER
*     OF FILES IF THIS NUMBER IS NOT WHAT WAS REQUESTED.
*     WE WILL ALSO GIVE A REASON FOR THE CHANGE.
* 
      LDA ENT#T 
      CCE 
      CPA RFSZ
      JMP INIT7 
      JSB $LIBR 
      NOP 
      STA #RFSZ     RESET #RFSZ FOR LATER RESCHEDULES 
      JSB $CVT3 
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
      INA 
      DLD A,I       SET THE # OF FILES IN THE MESSAGE 
      DST MS1A,I
      JSB EXEC
      DEF *+5 
      DEF D2        DISPLAY THE MESSAGE 
      DEF D1
      DEF MS1 
      DEF MSL1
* 
      JMP GO
* 
INIT7 LDA RFSZ
      CPA #RFSZ     CHANGE DUE TO TRACK ALLOCATION PROBLEM ?
      JMP GO        NO
      CCE 
      JSB $LIBR 
      NOP 
      STA #RFSZ 
      JSB $CVT3 
      JSB $LIBX 
      DEF *+1 
      DEF *+1 
      INA 
      DLD A,I       FORMAT THE MESSAGE
      DST MS2A,I
      JSB EXEC
      DEF *+5 
      DEF D2
      DEF D1
      DEF MS2 
      DEF MSL2
* 
      JMP GO
PRT1# NOP 
PRT2# NOP 
TOT#  NOP 
TRK#  NOP 
ISEC  NOP 
RFSZ  NOP 
* 
MSL1  DEC 36
MSL2  EQU MSL1
B7    OCT 7 
D17   DEC 17
D22   DEC 22
BIT15 OCT 100000
DM143 DEC -143
DM10  DEC -10 
D153  DEC 153 
X     NOP 
Y     NOP 
IDEAL NOP 
FLG1  NOP 
CHECK EQU .-*       WILL GIVE ERROR IF INIT TOO LARGE 
RFAMD EQU .         RFAMD'S START HERE
* 
      ORG .+306     LEAVE ROOM FOR 2 RFAMD'S & DCB'S
* 
END   DEF * 
      END RFAM
                                                                            