ASMB,C,Q  
      HED RFMST: 91740-16039 REV 2001 (C) HEWLETT-PACKARD C0. 1980
      NAM RFMST,7 91740-16039 REV 2001 791024 
      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:       91740-18039 
*     RELOC:        91740-16039 
*     PGMR:         DAN GIBBONS   
* 
* 
*     MODIFIED BY:
* 
*************************************************************** 
      SPC 3 
      ENT DAPOS,DCLOS,DCONT,DCRET,DLOCF 
      ENT DNAME,DOPEN,DPOSN,DPURG,DREAD 
      ENT DSTAT,DWIND,DWRIT 
      EXT .ENTR,D65MS 
* 
      SUP 
      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 SPEDIFIED 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
* 
*    11.  CALL DSTAT(ISTAT,IERR,IDEST[,ERLOC])
*           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 
* 
      SKP 
      SPC 3 
* 
*  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 REQST+8   SAVE IREC IN THE REQST
* 
      LDB PRAMS+4,I GET OPTIONAL IOFF 
      LDA PRAMS+3,I GET THE OPTIONAL IRB
* 
DAPUR DST REQST+9   STORE INTO REQUEST BUFFER 
* 
      JSB $MS65     DO D65MS CALL 
      DEC 11        REQUEST LENGTH
* 
      LDA PRAMS+5 
      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 REQST+8 
* 
      JSB $MS65     DO D65MS CALL 
      DEC 9         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
* 
*  BELOW CODE IS COMMON TO DCONT AND DPOSN
DCOPS JSB $VER3     GET & VERIFY 3RD PARAMETER ADDR 
      STB REQST+8   SAVE ICON1 (OR NUR) IN REQUEST
* 
      LDB PRAMS+3,I GET OPTIONAL ICON2/ IR
      STB REQST+9 
* 
      JSB $MS65     DO D65MS CALL 
      DEC 10        REQUEST LENGTH
* 
      LDA PRAMS+4 
      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 REQST+9   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 REQST+13  SAVE IN REQST 
* 
      LDA PRAMS+5,I GET OPTIONAL ISECU
      STA REQST+10
* 
      DLD PRAMS+3,I GET ISIZE (2 WORD PARAMETER)
NNAMA EQU *+1 
      DST REQST+11  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 0,I           THE DCB (STORE NODE)
* 
      JSB $MS65     DO D65MS CALL 
K14   DEC 14        REQUEST LENGTH = 14 
* 
      LDA PRAMS+7 
      JMP DOPNX     WRAP-UP AND EXIT
      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 $MS65     DO D65MS CALL 
      DEC 8         REQUEST LENGTH
* 
      LDX N7        SET A COUNTER 
LOOP1 LBX REQST+14  GET A RETURNED VALUE
      LAX PRAMS+9   GET RETURN ADDRESS
      STB 0,I       PASS VALUE BACK 
      ISX           ALL DONE ?
      JMP LOOP1     NO, CONTINUE. 
* 
      LDA PRAMS+9 
      JMP $POST     WRAP-UP AND EXIT
      SKP 
* 
*  DNAME PERFORMS A REMOTE FMGR "NAMF" CALL 
* 
DNAME NOP 
      JSB $PREP     PERFORM PRE-PROCESSING
K5    DEC 5         FUNCTION CODE = 5 
* 
      JMP DNOPN     DO LOGIC COMMON TO DOPEN
* 
DNNAM LDA PRAMS+3   GET ADDRESS OF NNAME
      SZA,RSS 
      JMP PRERR     NOT PROVIDED
      LDB NNAMA 
      MVW K3        MOVE NEW NAME TO REQST
* 
      JSB $MS65     DO D65MS CALL 
      DEC 14        REQUEST LENGTH
* 
      JMP DRX       WRAP-UP AND EXIT
      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
* 
DNOPN STB REQST+9   SET ID SEG ADDR IN REQUEST
* 
      LDB PRAMS+4,I GET OPTIONAL ISECU
      STB REQST+10  SAVE IN REQST 
* 
      LDB PRAMS+3,I GET OPTIONAL ITRUN
      STB REQST+11
* 
      LDA PRAMS+5   GET ADDRESS OF ICR
      JSB $ICR      SET-UP CR/NODE & MOVE FILE NAME 
* 
      LDA REQST+4 
      CPA K5        DOING "DNAME"?
      JMP DNNAM     YES 
* 
      LDA PRAMS     FINISH
      ADA K3          BUILDING
      STB 0,I           THE DCB.
* 
      JSB $MS65     DO D65MS CALL 
      DEC 12        REQUEST LENGTH
* 
      LDA PRAMS+6 
* 
DOPNX LDX PRAMS     X= ADDR OF USERS 4 WORD DCB 
      LDB REQST+7   GET RFAMD ENTRY # 
      SBX 1         STORE IN 2ND WORD OF DCB
      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 
* 
      JMP DCOPS     REST IS IN COMMON WITH DCONT
      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
      LDA XEQT      GET ID SEGMENT ADDRESS
* 
      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 
* 
      LDB PRAMS+5,I GET THE OPTIONAL NUM
* 
      LDA PRAMS+3,I GET IL
      STA REQST+8   SAVE IT IN THE REQST
      STA RDLEN      AND FOR THE "MS" CALL
* 
      JSB XDATA     DO COMMON DREAD/DWRIT LOGIC 
* 
      LDA PRAMS+4 
      LDB REQST+7   PASS OPTIONAL LEN 
      STB 0,I         IF REQUIRED BY THE USER 
* 
DRX   LDA PRAMS+6 
      JMP $POST     WRAP-UP AND EXIT
      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 REQST+3   STORE "IDEST" IN REQUEST
      LDA K125
      STA RDLEN     SET DATA READ LENGTH = 125
* 
      JSB $MS65     DO D65MS CALL 
      DEC 7 
* 
DSX   LDA PRAMS+3 
      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 $MS65     DO D65MS CALL 
      DEC 8 
* 
      LDA PRAMS+2 
      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
* 
      LDB PRAMS+4,I GET THE OPTIONAL NUM
      LDA PRAMS+3,I GET IL
      STA REQST+8   STORE IN REQUEST
      INA,SZA       SKIP IF WRITE EOF 
      LDA REQST+8 
      STA WRLEN     SAVE WRITE LENGTH FOR MS CALL 
* 
      JSB XDATA     PERFORM COMMON DREAD/DWRIT LOGIC
* 
      LDA PRAMS+5 
      SKP 
* 
*  COMMON REQUEST POST-PROCESSING LOGIC 
* 
$POST LDB REQST+6   GET THE ERROR LOCATION
      STB 0,I       RETURN IT (OPTIONALLY)
      LDA REQST+5   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 
      STB REQST+9   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 
* 
      JSB $MS65     CALL D65MS
      DEC 10
* 
      JMP XDATA,I   RETURN
      SKP 
* 
*  COMMON REQUEST PRE-PROCESSING ROUTINE FOR ALL MASTER RFA CALLS 
* 
$PREP NOP 
* 
      CLB           CLEAN OUT PARAMETER AREA
      LDX K10 
LOOP  SBX PRAMS-1 
      DSX 
      JMP LOOP
* 
      LDB $PREP 
      ADB N2
      LDB 1,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 REQST     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 REQST+4   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 NAMA      ADDR OF NAME FIELD IN REQUEST 
      MVW K3        MOVE IT 
      LDA 0,I       GET DESTINATION FROM 4TH DCB WORD 
      STA REQST+3   SET INTO REQUEST
*  RETURN WITH B= XEQT, A= 0
$PREX LDB XEQT
      CLA 
      STA WRLEN     INITIALIZE DATA 
      STA RDLEN      BUFFER LENGTHS FOR MS CALL 
      JMP $PREP,I   RETURN
      SKP 4 
* 
*  SUBROUTINE TO PERFORM D65MS CALL 
* 
$MS65 NOP 
      JSB D65MS 
      DEF *+8 
      DEF CONWD 
      DEF REQST     REQUEST BUFFER
      DEF $MS65,I 
      DEF PRAMS,I   DATA ADDRESS (IF ANY) 
      DEF WRLEN 
      DEF RDLEN 
      DEF K14       MAX ALLOWED REPLY LENGTH
* 
      JMP COMER     ERROR RETURN
* 
$MSEX ISZ $MS65 
      JMP $MS65,I   RETURN
* 
*  SUBROUTINE TO SET-UP CARTRIDGE REFERENCE AND NODAL ADDRESS 
*  TO EITHER THE PASSED VALUES OR DEFAULTS
* 
$ICR  NOP 
      STA $MS65 
      JSB $VER3     GET & VERIFY THE 3RD PARAMETER ADDRESS
      LDA PRAMS+2   GET ADDRESS OF NAME FIELD 
      LDB NAMA      GET ADDRESS OF NAME FIELD IN REQUEST
      MVW K3        MOVE IT 
      LDA $MS65     RELOAD ICR ADDRESS
      CCB           LOCAL NODE DESIGNATOR (DEFAULT) 
      SZA,RSS       **** TEMPORARY INSTRUCTIONS UNTIL ****
      JMP *+3       **** THE 21MX-XE IS FIXED!        ****
      DLD 0,I       GET ICR & NODE
      STA REQST+8   SAVE THE CARTRIDGE #
      STB REQST+3   SAVE THE DESTINATION NODE 
      JMP $ICR,I    RETURN
      SKP 
COMER LDA REQST+4   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 REQST+5   GET THE NUMERICAL PART OF THE ERROR 
      AND B17         CODE AND DECODE IT
      CMA,INA       NEGATE IT 
      ADA N50 
NOTDS LDB REQST+6   GET ERROR LOCATION
      ELB,CLE,ERB   STRIP THE SIGN BIT
NAMA  EQU *+1 
      DST REQST+5   RESTORE THE ERROR LOCATION
      JMP $MSEX     RETURN
* 
"DS"  ASC 1,DS
N999  DEC -999
      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
      SPC 2 
* 
PRERR LDA N10       INSUFFICIENT PAAMETERS, GIVE -10 ERROR
      JMP $PST2 
      SKP 
* 
*     CONSTANTS & VARIABLES 
* 
XEQT  EQU 1717B 
* 
WRLEN NOP 
RDLEN NOP 
B17   OCT 17
K125  DEC 125 
N2    DEC -2
N7    DEC -7
N10   DEC -10 
N50   DEC -50 
N513  DEC -513
* 
REQST REP 14
      NOP 
      SPC 3 
      END