ASMB,C,Q,N
      IFN           * START EXTENDED FILE CODE
* 
      HED RFMST: 91750-1X166 REV 2013 (C) HEWLETT-PACKARD CO. 1980
      NAM RFMST,7 91750-1X166 REV 2013 800111 
* 
      XIF           *  END  EXTENDED FILE CODE
* 
* 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
* 
      HED RFMST: 91750-16ZZZ REV 2013 (C) HEWLETT-PACKARD CO. 1980
      NAM RFMST,7 91750-16ZZZ REV 2013 800111 
* 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
      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 4 
****************************************************************
* 
*     NAME:         RFMST 
*     SOURCE:       91750-18166 
*     RELOC:        91750-1X166 
*     PGMR:         DAN GIBBONS 
* 
*************************************************************** 
      SPC 3 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      ENT DXCRE,DXCLO,DXREA,DXWRI 
      ENT DXAPO,DXPOS,DXLOC 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      ENT DAPOS,DCLOS,DCONT,DCRET,DLOCF 
      ENT DNAME,DOPEN,DPOSN,DPURG,DREAD 
      ENT DSTAT,DWIND,DWRIT 
      EXT .ENTR,#MAST,#NODE,PGMAD 
      EXT .LDX,.LBX,.LAX,.ISX,.MVW,.SBX,.DSX
      EXT #RQB
RQB   EQU #RQB
* 
      SUP 
A     EQU 0 
B     EQU 1 
      SKP 
* 
*  THIS PROGRAM SUPPORTS ALL REMOTE FILE ACCESS (RFA) MASTER CALLS
*  IN THE DS/1000 SYSTEM.  BELOW ARE THE VALID CALLING SEQUENCES, WITH
*  OPTIONAL PARAMETERS INDICATED BY PARENTHESES: [].  OPTIONAL PARAMETER
*  "ERLOC" WHEN SPECIFIED WILL CONTAIN THE NODAL ADDRESS AT WHICH AN
*  ERROR OCCURRED (IF ANY).  THE PARAMETER "ICR" IN THE "DCRET","DNAME",
*  "DOPEN", AND "DPURG" CALLS IS A 2 WORD ARRAY WITH THE FIRST WORD EQUAL 
*  TO THE REQUIRED CARTRIDGE LABEL AND THE SECOND WORD HAVING THE FILE'S
*  NODAL ADDRESS (DEFAULT IS 0,-1).  ALL OTHER PARAMETERS HAVE THE
*  CONVENTIONAL FMP MEANINGS. 
* 
* 
*     1.  CALL DAPOS(IDCB,IERR,IREC[,IRB,IOFF,ERLOC]) 
*           SETS ABSOLUTE RECORD POSITION OF FILE TO VALUE OF "IREC"
* 
*     2.  CALL DCLOS(IDCB,IERR[,ITRUN,ERLOC]) 
*           CLOSES DCB AND OPTIONALLY TRUNCATES BASED ON "ITRUN". 
* 
*     3.  CALL DCONT(IDCB,IERR,ICON1[,ICON2,ERLOC]) 
*           PERFORMS RTE I/O CONTROL REQUEST FOR TYPE 0 (NON-DISC) FILES. 
* 
*     4.  CALL DCRET(IDCB,IERR,NAME,ISIZE,ITYPE[,ISECU,ICR,ERLOC])
*           CREATES THE NAMED FILE WITH THE SPECIFIED NUMBER OF BLOCKS. 
*           THE FILE IS LEFT OPEN EXCLUSIVELY TO THE CALLER.
* 
*     5.  CALL DLOCF(IDCB,IERR,IREC[,IRB,IOFF,JSEC,JLU,JTY,JREC,ERLOC]) 
*           FORMATS AND RETURNS LOCATION AND STATUS INFORMATION FOR 
*           THE DCB.
* 
*     6.  CALL DNAME(IDCB,IERR,NAME,NNAME[,ISECU,ICR,ERLOC])
*           RENAMES THE SPECIFIED FILE
* 
*     7.  CALL DOPEN(IDCB,IERR,NAME[,IOPTN,ISECU,ICR,ERLOC])
*           OPENS THE NAMED FILE
* 
*     8.  CALL DPOSN(IDCB,IERR,NUR[,IR,ERLOC])
*           REPOSITIONS FILE
* 
*     9.  CALL DPURG(IDCB,IERR,NAME[,ISECU,ICR,ERLOC])
*           CLOSES THE DCB AND PURGES THE FILE AND ALL ITS EXTENTS
* 
*    10.  CALL DREAD(IDCB,IERR,IBUF,IL[,LEN,NUM,ERLOC]) 
*           READS THE NEXT RECORD INTO THE USER'S BUFFER
* 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
*    11.  CALL DSTAT(ISTAT,IERR,IDEST[,ERLOC,ILEN,IFORM,IOP,IADD])
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
*    11.  CALL DSTAT(ISTAT,IERR,IDEST[,ERLOC])
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
*           RETURNS INFORMATION ON ALL MOUNTED CARTRIDGE LABELS 
*           AT THE NODE SPECIFIED BY "IDEST"
* 
*    12.  CALL DWIND(IDCB,IERR[,ERLOC]) 
*           REWINDS TYPE 0 FILES, OR SETS DISC FILE POSITION TO THE 
*           FIRST RECORD
* 
*    13.  CALL DWRIT(IDCB,IERR,IBUF,IL[,NUM,ERLOC]) 
*           WRITES THE SPECIFIED BUFFER TO THE FILE 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
* 
*     (THE FOLLOWING ARE EXTENDED FILE CALLS. THE FUNCTIONS 
*      ARE THE SAME AS DESCRIBED FOR THE CORRESPONDING NON- 
*      EXTENDED CALLS ABOVE.) 
* 
*    14.  CALL DXAPO(IDCB,IERR,IREC[,IRB,IOFF,ERLOC]) 
* 
*    15.  CALL DXCLO(IDCB,IERR[,ITRUN,ERLOC]) 
* 
*    16.  CALL DXCRE(IDCB,IERR,NAME,ISIZE,ITYPE[,ISECU,ICR,JSIZE,ERLOC])
* 
*    17.  CALL DXLOC(IDCB,IERR,IREC[,IRB,IOFF,JSEC,JLU,JTY,JREC,ERLOC]) 
* 
*    18.  CALL DXPOS(IDCB,IERR,NUR[,IR,ERLOC])
* 
*    19.  CALL DXREA(IDCB,IERR,IBUF,IL[,LEN,NUM,ERLOC]) 
* 
*    20.  CALL DXWRI(IDCB,IERR,IBUF,IL[,NUM,ERLOC]) 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      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 
* 
*                    C  A  U  T  I  O  N
* 
* 
*  IF THERE IS ANY CHANGE TO THE LAST PARAMETER OF A REQUEST
*  (OR REPLY FOR DSTAT), CHECK CALL TO $MAST AND #MAST FOR
*  SPECIFIED REQUEST LENGTH.
* 
      SPC 10
* 
*  DAPOS PERFORMS A REMOTE FMGR "APOSN" CALL
* 
DAPOS NOP 
      JSB $PREP     DO REQUEST SET-UP 
CONWD OCT 100000    FUNCTION CODE = 0 
* 
      JSB $VER3     GET & VERIFY 3RD PARAMETER
* 
      STB RQB+#IRC  SAVE IREC IN THE REQST
* 
      LDB PRAMS+3,I GET THE OPTIONAL IRB
      STB RQB+#IRB   AND STORE IN REQUEST.
      LDB PRAMS+4,I GET OPTIONAL IOFF 
      STB RQB+#IOF   AND STORE IN REQUEST.
* 
      JSB $MAST     DO #MAST CALL 
      ABS #IOF+1    REQUEST LENGTH
* 
* DPURG JOINS US HERE.
* 
DAPUR LDA PRAMS+5   GET 'ERLOC' PARAM ADR 
      JMP $POST     DO REQUEST WRAP-UP
      SKP 
* 
*  DCLOS PERFORMS A REMOTE FMGR "CLOSE" CALL
* 
DCLOS NOP 
      JSB $PREP     PERFORM PRE-PROCESSING
      OCT 100001    FUNCTION CODE = 1 
* 
      LDA PRAMS+2,I GET THE OPTIONAL ITRUN
      STA RQB+#ITR
* 
      JSB $MAST     DO #MAST CALL 
      ABS #ITR+1    REQUEST LENGTH
* 
      JMP DSX       WRAP-UP AND EXIT
      SKP 
* 
*  DCONT PERFORMS A REMOTE FMGR "FCONT" CALL
* 
DCONT NOP 
      JSB $PREP     DO REQUEST PRE-PROCESSING 
      OCT 100002    FUNCTION CODE= 2
* 
      JSB $VER3     GET & VERIFY 3RD PARAMETER ADDR 
      STB RQB+#IC1  SAVE ICON1 IN REQUEST 
* 
      LDB PRAMS+3,I GET OPTIONAL ICON2
      STB RQB+#IC2
* 
      JSB $MAST     DO #MAST CALL 
      ABS #IC2+1    REQUEST LENGTH
* 
      LDA PRAMS+4   GET 'ERLOC' PARAM ADR 
      JMP $POST     WRAP-UP AND EXIT
      SKP 
* 
*  DCRET PERFORMS A REMOTE FMGR "CREAT" CALL
* 
DCRET NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
K3    DEC 3         FUNCTION CODE = 3 
* 
      STB RQB+#ID   SET THE ID SEGMENT ADDRESS
      STB PRAMS,I     IN THE REQST AND IN THE DCB 
* 
      CPA PRAMS+4   TYPE ADDRESS PROVIDED?
      JMP PRERR     NO, PARAMETER ERROR 
      LDB PRAMS+4,I GET TYPE
      STB RQB+#TYP  SAVE IN REQST 
* 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      JSB MOVEP     MOVE REMAINING PARAMS TO REQST
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
      LDA PRAMS+5,I GET OPTIONAL ISECU
      STA RQB+#ISC
* 
      DLD PRAMS+3,I GET ISIZE (2 WORD PARAMETER)
      DST RQB+#SIZ  SAVE IN REQUEST 
* 
      LDA PRAMS+6   GET ADDRESS OF ICR
      JSB $ICR      SET-UP CR/NODE & MOVE FILE NAME 
* 
      LDA PRAMS     FINISH
      ADA K3          BUILDING
      STB A,I           THE DCB (STORE NODE)
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
* 
      JSB $MAST     DO #MAST CALL 
      ABS #TYP+1    REQUEST LENGTH
* 
      LDA PRAMS+7   GET 'ERLOC' PARAM ADR 
      JMP DOPNX     WRAP-UP AND EXIT
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      SPC 2 
MOVEP NOP           SUBR TO MOVE PARAMS TO REQST
      LDA PRAMS+5,I GET OPTIONAL ISECU
      STA RQB+#ISC
* 
      DLD PRAMS+3,I GET ISIZE (2 WORD PARAMETER)
      DST RQB+#SIZ  SAVE IN REQUEST 
* 
      LDA PRAMS+6   GET ADDRESS OF ICR
      JSB $ICR      SET-UP CR/NODE & MOVE FILE NAME 
* 
      LDA PRAMS     FINISH
      ADA K3          BUILDING
      STB A,I           THE DCB (STORE NODE)
      JMP MOVEP,I 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      SKP 
* 
*  DLOCF PERFORMS A REMOTE FMGR "LOCF" CALL 
* 
DLOCF NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100004    FUNCTION CODE = 4 
* 
      JSB $VER3     GET & VERIFY 3RD PARAMETER ADDRESS
* 
      JSB $MAST     DO #MAST CALL 
      ABS #DCB+3    REQUEST LENGTH
* 
      JSB .LDX      SET A COUNTER 
      DEF N7
LOOP1 JSB .LBX      GET A RETURNED VALUE
      DEF RQB+#JRC+1
      JSB .LAX      GET RETURN ADDRESS
      DEF PRAMS+9 
      STB A,I       PASS VALUE BACK 
      JSB .ISX      ALL DONE ?
      JMP LOOP1     NO, CONTINUE. 
* 
DLOC1 LDA PRAMS+9   GET 'ERLOC' PARAM ADR 
      JMP $POST     WRAP-UP AND EXIT
      SKP 
* 
*  DNAME PERFORMS A REMOTE FMGR "NAMF" CALL 
* 
DNAME NOP 
      JSB $PREP     PERFORM PRE-PROCESSING
      DEC 5         FUNCTION CODE = 5 
* 
      STB RQB+#ID   SET ID SEG ADDR IN REQUEST. 
* 
      LDB PRAMS+4,I SET OPTIONAL ISECU. 
      STB RQB+#ISC
* 
      LDA PRAMS+5   GET ADDR OF ICR.
      JSB $ICR      SET UP CR/NODE & MOVE FILE NAME.
* 
      LDA PRAMS+3   GET ADDRESS OF NNAME
      SZA,RSS 
      JMP PRERR     NOT PROVIDED
      LDB D#NNM 
      JSB .MVW      MOVE NEW NAME TO REQST
      DEF K3
      NOP 
* 
      JSB $MAST     DO #MAST CALL 
      ABS #NNM+3    REQUEST LENGTH
* 
      JMP DRX       WRAP-UP AND EXIT
* 
D#NNM DEF RQB+#NNM
      SKP 
* 
*  DOPEN PERFORMS A REMOTE FMGR "OPEN" CALL 
* 
DOPEN NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
K6    DEC 6         FUNCTION CODE = 6 
* 
      STB PRAMS,I   SET ID SEG ADDR IN DCB
* 
      STB RQB+#ID   SET ID SEG ADDR IN REQUEST
* 
      LDB PRAMS+4,I GET OPTIONAL ISECU
      STB RQB+#ISC  SAVE IN REQST 
* 
      LDB PRAMS+3,I GET OPTIONAL IOPTN
      STB RQB+#IOP
* 
      LDA PRAMS+5   GET ADDRESS OF ICR
      JSB $ICR      SET-UP CR/NODE & MOVE FILE NAME 
* 
      LDA PRAMS     FINISH
      ADA K3          BUILDING
      STB A,I           THE DCB.
* 
      JSB $MAST     DO #MAST CALL 
      ABS #IOP+1    REQUEST LENGTH
* 
      LDA PRAMS+6 
* 
* DCRET JOINS US HERE.
* 
DOPNX JSB .LDX      X= ADDR OF USERS 4 WORD DCB 
      DEF PRAMS 
      LDB RQB+#RFD  GET RFAMD ENTRY # 
      JSB .SBX      STORE IN 2ND WORD OF DCB
      DEF 1 
      JMP $POST     WRAP-UP AND EXIT
      SKP 
* 
*  DPOSN PERFORMS A REMOTE FMGR "POSNT" CALL
* 
DPOSN NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100007    FUNCTION CODE = 7 
* 
      JSB $VER3     GET AND VERIFY 3RD PARAM ADDR.
      STB RQB+#NUR  SAVE NUR IN REQUEST.
* 
      LDB PRAMS+3,I GET OPTIONAL IR 
      STB RQB+#IR 
* 
      JSB $MAST     DO #MAST CALL 
      ABS #IR+1      REQUEST LENGTH.
* 
DPOS1 LDA PRAMS+4   GET 'ERLOC' PARAM ADR 
      JMP $POST     WRAP-UP AND EXIT
      SKP 
* 
*  DPURG PERFORMS A REMOTE FMGR "PURGE" CALL
* 
DPURG NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      DEC 8         FUNCTION CODE = 8 
* 
      LDA PRAMS+4   GET ADDRESS OF ICR
      JSB $ICR      SET-UP CR/NODE & MOVE FILE NAME 
* 
      CLA 
      LDB PRAMS+3,I GET OPTIONAL ISECU
      STB RQB+#ISC
      JSB PGMAD     GET ID SEGMENT ADDRESS
      DEF *+2 
      DEF K0
      STA RQB+#ID   SET IT INTO REQUEST 
* 
      JSB $MAST     DO #MAST CALL 
      ABS #ISC+1    REQUEST LENGTH. 
* 
      JMP DAPUR     REST IS IN COMMON WITH DAPOS
      SKP 
* 
*  DREAD PERFORMS A REMOTE FMGR "READF" CALL
* 
DREAD NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100011    FUNCTION CODE = 9 
* 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      JSB DREA1     PROCESS NUM & IL PARAMS 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
      LDB PRAMS+5,I GET THE OPTIONAL NUM
* 
      LDA PRAMS+3,I GET IL
      STA RQB+#IL   SAVE IT IN THE REQST
      STA RDLEN      AND FOR THE "MS" CALL
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
* 
      JSB XDATA     DO COMMON DREAD/DWRIT LOGIC 
* 
DREA2 LDA PRAMS+4 
      LDB RQB+#LOG  PASS OPTIONAL LEN 
      STB A,I         IF REQUIRED BY THE USER 
* 
* DNAME JOINS US HERE.
* 
DRX   LDA PRAMS+6   GET 'ERLOC' PARAM ADR 
      JMP $POST     WRAP-UP AND EXIT
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      SPC 2 
DREA1 NOP           SUBR TO PROCESS NUM & IL
      LDB PRAMS+5,I GET THE OPTIONAL NUM
* 
      LDA PRAMS+3,I GET IL
      STA RQB+#IL   SAVE IT IN THE REQST
      STA RDLEN      AND FOR THE "MS" CALL
      JMP DREA1,I 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      SKP 
* 
*  DSTAT PERFORMS A REMOTE FMGR "FSTAT" CALL
* 
DSTAT NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
K10   DEC 10        FUNCTION CODE = 10
* 
      JSB $VER3     GET & VERIFY THE 3RD PARAMETER ADDRESS
      STB RQB+#DST  STORE "IDEST" IN REQUEST
      LDA K125      GET DATA LENGTH 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      LDA PRAMS+4,I OVERRIDE LENGTH IF ILEN PROVIDED
      STA RQB+#LEN  SET LENGTH INTO REQST 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      STA RDLEN     SET DATA READ LENGTH
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      CLA           (IN CASE PRAMS+5 OR +6 = 0) 
      LDB PRAMS+5,I GET OPTIONAL IFORM PARAM
      STB RQB+#FOR  SET IT INTO REQST 
      LDB PRAMS+6,I GET OPTIONAL IOP PARAM
      STB RQB+#OPT  SET IT INTO REQST 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
      JSB $MAST     DO #MAST CALL 
      ABS #OPT+1
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
* 
      LDA PRAMS+7   RETURN IADR TO
      LDB RQB+#IAD   USER IF PARAM
      STB A,I         WAS PROVIDED. 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
* DCLOS JOINS US HERE.
* 
DSX   LDA PRAMS+3   GET 'ERLOC' PARAM ADR 
      JMP $POST     WRAP-UP AND EXIT
      SKP 
* 
*  DWIND PERFORMS A REMOTE FMGR "RWNDF" CALL
* 
DWIND NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100013    FUNCTION CODE = 11
* 
      JSB $MAST     DO #MAST CALL 
      ABS #DCB+3
* 
      LDA PRAMS+2   GET 'ERLOC' PARAM ADR 
      JMP $POST     WRAP-UP AND EXIT
      SKP 
* 
*  DWRIT PERFORMS A REMOTE FMGR "WRITF" CALL
* 
DWRIT NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100014    FUNCTION CODE = 12
* 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      JSB DWRI1     PROCESS PARAMS
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
      LDB PRAMS+4,I GET THE OPTIONAL NUM
      LDA PRAMS+3,I GET IL
      STA RQB+#IL   STORE IN REQUEST
      INA,SZA       SKIP IF WRITE EOF 
      LDA RQB+#IL 
      STA WRLEN     SAVE WRITE LENGTH FOR MS CALL 
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
* 
      JSB XDATA     PERFORM COMMON DREAD/DWRIT LOGIC
* 
DWRI2 LDA PRAMS+5   GET 'ERLOC' PARAM ADR 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
      SKP 
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      JMP $POST     WRAP-UP AND EXIT
      SPC 2 
DWRI1 NOP           PROCESS NUM & IL PARAMS 
      LDB PRAMS+4,I GET THE OPTIONAL NUM
      LDA PRAMS+3,I GET IL
      STA RQB+#IL   STORE IN REQUEST
      INA,SZA       SKIP IF WRITE EOF 
      LDA RQB+#IL 
      STA WRLEN     SAVE WRITE LENGTH FOR MS CALL 
      JMP DWRI1,I 
      SKP 
* 
*  DXAPO PERFORMS A REMOTE FMGR "EAPOS" CALL
* 
DXAPO NOP 
      JSB $PREP     DO REQUEST SET-UP 
      OCT 100022    FUNCTION CODE = 18
* 
      JSB XVER3     GET & VERIFY IREC (DBL) 
      DST RQB+#IRC  SAVE IT IN REQST
* 
      CLA           GET DEFAULTS IN CASE
      CLB            PRAMS+3 = 0. 
      DLD PRAMS+3,I GET OPTIONAL IRB (DBL)
      DST RQB+#XIB  SET IRB INTO REQST
      CLA           (IN CASE PRAMS+4 = 0) 
      LDA PRAMS+4,I GET OPTIONAL IOF
      STA RQB+#XIO   SET IT INTO REQST
* 
      JSB $MAST     DO #MAST CALL 
      ABS #XIO+1    REQST LENGTH
* 
      JMP DAPUR     GO FINISH UP
      SKP 
* 
*  DXCLO PERFORMS A REMOTE FMGR "ECLOS" CALL
* 
DXCLO NOP 
      JSB $PREP     PERFORM PRE-PROCESSING
      OCT 100017    FUNCTION CODE = 15
* 
      CLA           GET DEFAULT IN CASE 
      CLB            PRAMS+2 = 0. 
      DLD PRAMS+2,I GET OPTIONAL ITRUN (DBL)
      DST RQB+#ITR  SET ITRUN INTO REQST
* 
      JSB $MAST     DO #MAST CALL 
      ABS #ITR+2    REQST LENGTH
* 
      JMP DSX       WRAP-UP AND EXIT
      SKP 
* 
*  DXCRE PERFORMS A REMOTE FMGR "ECREA" CALL
* 
DXCRE NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      DEC 14        FUNCTION CODE = 14
* 
      STB RQB+#ID   SET OUR ID SEG ADR INTO 
      STB PRAMS,I    REQUEST AND INTO DCB(1). 
* 
      CPA PRAMS+4   ITYPE PROVIDED? (A=0) 
      JMP PRERR     NO, PARAM ERROR 
      LDB PRAMS+4,I GET ITYPE 
      STB RQB+#XTY  SET IT INTO REQST 
* 
      JSB MOVEP     PROCESS REMAINING PARAMS
* 
      LDA PRAMS+3   MOVE RECORD SIZE (ISIZE(3)&(4)) 
      ADA K2         INTO REQUEST.
      DLD A,I 
      DST RQB+#XRS
* 
      JSB $MAST     DO #MAST CALL 
      ABS #XTY+1    REQST LENGTH
* 
      DLD RQB+#JSZ  PASS BACK 
      DST PRAMS+7,I   'JSIZE' PARAM.
* 
      LDA PRAMS+8   GET 'ERLOC' PARAM ADR 
      JMP DOPNX     WRAP-UP AND EXIT
      SPC 2 
K2    DEC 2 
      SKP 
* 
*  DXLOC PERFORMS A REMOTE FMGR "ELOCF" CALL
* 
DXLOC NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100024    FUNCTION CODE = 20
* 
      JSB $VER3     GET AND VERIFY 3RD PARAM ADR
* 
      JSB $MAST     DO #MAST CALL 
      ABS #DCB+3    REQST LENGTH
* 
      DLD RQB+#REC  PASS RETURN PARAMS
      DST PRAMS+2,I  TO USER. 
      DLD RQB+#XRB
      DST PRAMS+3,I 
      LDA RQB+#XOF
      STA PRAMS+4,I 
      DLD RQB+#XJS
      DST PRAMS+5,I 
      LDA RQB+#XJL
      STA PRAMS+6,I 
      LDA RQB+#XJT
      STA PRAMS+7,I 
      LDA RQB+#XJR
      STA PRAMS+8,I 
* 
      JMP DLOC1     GO FINISH UP
      SKP 
* 
*  DXPOS PERFORMS A REMOTE FMGR "EPOSN" CALL
* 
DXPOS NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100023    FUNCTION CODE = 19
* 
      JSB XVER3     GET & VERIFY NUR (DBL)
      DST RQB+#NUR  SET INTO REQST
* 
      CLA           (IN CASE PRAMS+3 = 0) 
      LDA PRAMS+3,I GET OPTIONAL IR PARAM 
      STA RQB+#XIR  SET IR INTO REQST 
* 
      JSB $MAST     DO #MAST CALL 
      ABS #XIR+1    REQST LENGTH
* 
      JMP DPOS1     GO FINISH UP
      SKP 
* 
*  DXREA PERFORMS A REMOTE FMGR "EREAD" CALL
* 
DXREA NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100020    FUNCTION CODE = 16
* 
      JSB DREA1     PROCESS NUM(1), IL, 
      JSB XDAT1      AND IBUF PARAMS. 
      LDA PRAMS+5   GET ADR OF 'NUM' PARAM
      JSB DXRE1     PROCESS NUM(2) PARAM
* 
      JSB $MAST     DO #MAST CALL 
      ABS #NUM+2    REQST LENGTH
* 
      JMP DREA2     GO FINISH UP
      SPC 2 
DXRE1 NOP           PROCESS NUM(2) PARAM. <A>=NUM(1) ADR. 
      SZA           PARAM SPECIFIED?
      INA           YES, STEP TO NUM(2) 
      LDA A,I       GET NUM(2), OR 0 IF NOT SPECIFIED,
      STA RQB+#NUM+1  AND SET IT INTO REQST.
      JMP DXRE1,I 
      SKP 
* 
*  DXWRI PERFORMS A REMOTE FMGR "EWRIT" CALL
* 
DXWRI NOP 
      JSB $PREP     PERFORM REQUEST PRE-PROCESSING
      OCT 100021    FUNCTION CODE = 17
* 
      JSB DWRI1     PROCESS NUM(1), IL, 
      JSB XDAT1      AND IBUF PARAMS. 
      LDA PRAMS+4   GET ADR OF 'NUM' PARAM
      JSB DXRE1     PROCESS NUM(2) PARAM
* 
      JSB $MAST     DO #MAST CALL 
      ABS #NUM+2    REQST LENGTH
* 
      JMP DWRI2     GO FINISH UP
      SKP 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
* 
* 
*  COMMON REQUEST POST-PROCESSING LOGIC. (<A>='ERLOC' PARAM ADR)
* 
$POST LDB RQB+#ENO  GET THE ERROR LOCATION
      ELB,CLE,ERB   STRIP SIGN BIT IF SET 
      STB A,I       RETURN IT (OPTIONALLY)
      LDA RQB+#EC2  ERROR CODE
      LDB RQB+#ENO  GET ERROR LOCATION AGAIN
      SSB           ASCII ERROR CODE? 
      LDA ERCNV     YES, RETURN CONVERTED ERROR CODE
* 
$PST2 STA PRAMS+1,I RETURN ERROR CODE 
      JMP CALL,I    RETURN FROM MASTER RFA CALL 
      SPC 4 
* 
*  THIS SUBROUTINE IS COMMON TO DREAD AND DWRIT 
* 
XDATA NOP 
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      JSB XDAT1     DO PART COMMON TO XTND & NON-XTND CALLS 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      UNL 
      IFZ           * START NON-EXTENDED FILE CODE
      LST 
      STB RQB+#NUM  SAVE THE OPTIONAL NUM 
      SSA           LENGTH NEGATIVE ? 
      JMP PRERR     YES, ILLEGAL
      ADA N513      IL > 512 ?
      SSA,RSS 
      JMP PRERR     YES, TOO MUCH 
* 
      CLA 
      CPA PRAMS+3   WAS "IL" SPECIFIED? 
      JMP PRERR     NO, PARAMETER ERROR 
* 
      LDA PRAMS+2   GET BUFFER ADDRESS
      STA PRAMS     SAVE FOR MS CALL SUBROUTINE 
      UNL 
      XIF           *  END  NON-EXTENDED FILE CODE
      LST 
* 
      JSB $MAST     CALL #MAST
      ABS #NUM+1
* 
      JMP XDATA,I   RETURN
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
      SPC 2 
XDAT1 NOP           PROCESS DREAD,DWRIT,DXREA,DXWRI PARAMS
      STB RQB+#NUM  SAVE THE OPTIONAL NUM 
      SSA           LENGTH NEGATIVE ? 
      JMP PRERR     YES, ILLEGAL
      ADA N513      IL > 512 ?
      SSA,RSS 
      JMP PRERR     YES, TOO MUCH 
* 
      CLA 
      CPA PRAMS+3   WAS "IL" SPECIFIED? 
      JMP PRERR     NO, PARAMETER ERROR 
* 
      LDA PRAMS+2   GET BUFFER ADDRESS
      STA PRAMS     SAVE FOR MS CALL SUBROUTINE 
      JMP XDAT1,I 
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      SKP 
* 
*  COMMON REQUEST PRE-PROCESSING ROUTINE FOR ALL MASTER RFA CALLS 
* 
$PREP NOP 
      LDB "DS"      PRIME ERROR CODE WORDS
      STB RQB+#EC1   IN CASE WE DETECT AN 
      LDB #NODE       BEFORE CALL TO #MAST. 
      STB RQB+#ENO
      CLB 
      STB RQB+#ECQ
* 
      JSB .LDX      CLEAN OUT PARAMETER AREA
      DEF K10 
LOOP  JSB .SBX
      DEF PRAMS-1 
      JSB .DSX
      JMP LOOP
* 
      LDB $PREP 
      ADB N2
      LDB B,I       GET RETURN POINT
      STB CALL      SAVE
      JMP CALL+1
* 
PRAMS REP 10
      NOP 
CALL  NOP 
      JSB .ENTR     GET ADDRESSES OF PARAMETERS 
      DEF PRAMS 
      LDA K6
      STA RQB+#STR  SET RFA STREAM
      LDA PRAMS+1 
      SZA,RSS       AT LEAST 2 PARAMETERS SPECIFIED?
      JMP CALL,I    NO, RETURN NOW! 
      LDA $PREP,I   GET FUNCTION CODE/ MOVE DCB FLAG
      ISZ $PREP 
      RAL,CLE,ERA   CLEAR SIGN BIT
      STA RQB+#FCN  SET FUNCTION CODE IN REQUEST
      SEZ,RSS       DCB MOVE REQUIRED?
      JMP $PREX     NO
* 
*   MOVE DCB TO THE REQUEST BUFFER
* 
      LDA PRAMS     GET ADDR OF DCB 
      LDB D#DCB     ADDR OF NAME FIELD IN REQUEST 
      JSB .MVW      MOVE IT 
      DEF K3
      NOP 
      LDA A,I       GET DESTINATION FROM 4TH DCB WORD 
      STA RQB+#DST  SET INTO REQUEST
* 
$PREX JSB PGMAD     GET OUR IDSEG ADR 
      DEF *+2 
      DEF NAME
      STA B         SET IT INTO <B> 
      CLA 
      STA WRLEN     INITIALIZE DATA 
      STA RDLEN      BUFFER LENGTHS FOR MS CALL 
      JMP $PREP,I   RETURN WITH <A>=0, <B>=IDSEG ADR
      SPC 2 
NAME  REP 3 
      NOP 
      SKP 
* 
*  SUBROUTINE TO PERFORM #MAST CALL 
* 
$MAST NOP 
* 
      JSB #MAST 
      DEF *+7 
      DEF CONWD 
      DEF $MAST,I   REQUEST BUFFER LENGTH 
      DEF PRAMS,I   DATA ADDRESS (IF ANY) 
      DEF WRLEN 
      DEF RDLEN 
      DEF C#RLW     MAX ALLOWED REPLY LENGTH
* 
      JMP COMER     ERROR RETURN
* 
$MSEX ISZ $MAST 
      JMP $MAST,I   RETURN
* 
*  SUBROUTINE TO SET-UP CARTRIDGE REFERENCE AND NODAL ADDRESS 
*  TO EITHER THE PASSED VALUES OR DEFAULTS
* 
$ICR  NOP 
      STA $MAST     USE $MAST LOC AS TEMP STORAGE 
      JSB $VER3     GET & VERIFY THE 3RD PARAMETER ADDRESS
      LDA PRAMS+2   GET ADDRESS OF NAME FIELD 
      LDB D#DCB     GET ADDRESS OF NAME FIELD IN REQUEST
      JSB .MVW      MOVE IT 
      DEF K3
      NOP 
      LDA $MAST     RELOAD ICR ADDRESS
      CCB           LOCAL NODE DESIGNATOR (DEFAULT) 
      DLD A,I       GET ICR & NODE
      STA RQB+#ICR  SAVE THE CARTRIDGE #
      STB RQB+#DST  SAVE THE DESTINATION NODE 
      JMP $ICR,I    RETURN
      SKP 
* 
*  COME HERE IF SIGN BIT OF RQB+#ENO WORD OF REPLY WAS SET
*  UPON RETURN FROM #MAST CALL (INDICATING ASCII ERROR CODE). 
* 
COMER LDA RQB+#EC1  GET ALPHABETIC PART OF THE ERROR
      CPA "DS"      IS IT "DS"? 
      JMP DSERR     YES 
      LDA N999      NO, REPORT IT AS A -999 ERROR 
      JMP NOTDS 
* 
DSERR LDA RQB+#EC2  GET THE NUMERICAL PART OF THE ERROR 
      AND B17         CODE AND DECODE IT
      CMA,INA       NEGATE IT 
      ADA N50 
NOTDS STA ERCNV     SAVE CONVERTED ERROR CODE 
      JMP $MSEX     RETURN
* 
ERCNV NOP           CONVERTED ERROR CODE
      SPC 3 
* 
*  SUBROUTINE TO GET & VERIFY THE 3RD PARAMETER ADDRESS 
* 
$VER3 NOP 
      CLA           ALWAYS RETURN A=0 
      CPA PRAMS+2   3RD PARAMETER ADDRESS 
      JMP PRERR     NOT SPECIFIED, GIVE ERROR 
      LDB PRAMS+2,I GET 3RD PARAMETER 
      JMP $VER3,I     & RETURN
      UNL 
      IFN           * START EXTENDED FILE CODE
      LST 
* 
*  SUBROUTINE TO VERIFY & TO SET THE 3RD DOUBLE WORD
*    PARAMETER INTO A & B REGISTERS.
* 
XVER3 NOP 
      LDA PRAMS+2   GET ADR OF 3RD PARAM
      SZA,RSS       WAS PARAM SPECIFIED?
      JMP PRERR     NO, GIVE ERROR
      DLD A,I       GET 3RD PARAM INTO A & B
      JMP XVER3,I   RETURN
      UNL 
      XIF           *  END  EXTENDED FILE CODE
      LST 
      SPC 2 
* 
PRERR LDA N10       INSUFFICIENT PARAMETERS, GIVE -10 ERROR 
      STA RQB+#EC2  SET ERROR INTO REQUEST BUFFER 
      JMP $PST2 
      SKP 
* 
*     CONSTANTS & VARIABLES 
* 
* 
"DS"  ASC 1,DS
WRLEN NOP 
RDLEN NOP 
K0    DEC 0 
B17   OCT 17
K125  DEC 125 
N2    DEC -2
N7    DEC -7
N10   DEC -10 
N50   DEC -50 
N999  DEC -999
N513  DEC -513
D#DCB DEF RQB+#DCB
* 
C#RLW ABS #RLW      MAXIMUM REQ/REPLY LENGTH. 
      SPC 3 
      END 
                                                                                                                                                                                                                            