ASMB,Q,C
      HED FOPEN: HP 3000 RFA SUBROUTINE * (C) HEWLETT-PACKARD CO. 
      NAM FOPEN,7 91750-1X119 REV.2013 790328 MEF 
      SPC 1 
******************************************************************
*  * (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 
      ENT FOPEN,D$RFH 
* 
      EXT .ENTR,D3KMS,D$INI,D$STW,D$3BF 
      EXT D$PRM,D$NWD,D$ASC,D$RQB,D$ERR 
      SPC 2 
      UNL           NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING 
*  NAME: FOPEN
*SOURCE: 91750-18119
* RELOC: 91750-1X119
*  PGMR: DMT
      LST 
*************************  FOPEN  ************************* 
*                                                         * 
*    SOURCE: 91750-18119                                  * 
*                                                         * 
*    BINARY: 91750-1X119                                  * 
*                                                         * 
*    PROGRAMMER: JIM HARTSELL                             * 
*                                                         * 
*    DATE: AUGUST 7, 1975                                 * 
*                                                         * 
*---------------------------------------------------------* 
*                                                         * 
*   MODIFIED FOR DS/1000 ENHANCEMENTS BY DMT BEGINNING    * 
*   MARCH 26, 1979.                                       * 
*                                                         * 
*********************************************************** 
      SPC 2 
A     EQU 0 
B     EQU 1 
      SPC 2 
FOPEN NOP           ENTRY POINT.
      LDA DPRAM     CLEAR OLD PARAM ADDRESSES.
      STA ENTRY 
      LDB COUNT 
      CLA 
      STA ENTRY,I 
      ISZ ENTRY 
      INB,SZB 
      JMP *-3 
      LDA FOPEN 
      STA ENTRY 
      JMP BEGIN 
COUNT DEC -13 
* 
PRAMS NOP           FILE NAME (BYTE ARRAY)
      NOP           FOPTIONS
      NOP           AOPTIONS
      NOP           RECORD SIZE 
      NOP           DEVICE SPECS (BYTE ARRAY) 
      NOP           FORMS MESSAGE (BYTE ARRAY)
      NOP           # USER LABELS 
      NOP           BLOCK FACTOR
      NOP           # BUFFERS 
      NOP           FILE SIZE (DBL-WORD)
      NOP           # EXTENTS 
      NOP           INITALLOC 
      NOP           FILE CODE 
* 
ENTRY NOP           ENTRY POINT.
BEGIN JSB .ENTR     GET ADDRESSES OF USER PARAMS. 
DPRAM DEF PRAMS 
      CLA           CLEAR ERROR CODE FOR FCHEK. 
      CLB 
      DST D$ERR 
* 
* BUILD THE REQUEST BUFFER. BEGIN WITH SETUP OF 
* 8-WORD FIXED FORMAT HEADER FOR RFA, THEN "RFA " IN
* THE NEXT TWO WORDS. 
* 
      LDA DPRAM     POINT TO ADDR OF FIRST PARAM. 
      JSB D$INI     INITIALIZE BUFFER STUFFERS. 
* 
      JSB D$RFH     SET CLASS, STREAM, & "RFA ".
* 
      CLA,INA 
      JSB D$STW     FOPEN CODE = 1. 
* 
* MOVE USER CALL PARAMETERS TO REQUEST BUFFER.
* 
      LDA N9        MOVE DUMMY,FOPTN,AOPTN,RECSZ, 
      JSB D$PRM      DUMMY,DUMMY,ULABL,BLCKF,NUMBF. 
* 
      LDA N2        MOVE FILE SIZE
      JSB D$NWD      (DOUBLE-WORD PARAM). 
* 
      LDA N3        MOVE NUMXT,INALC,FLCOD. 
      JSB D$PRM 
* 
* SET UP PARAMETER MASK FOR 13 PARAMS: BIT 12 REPRESENTS THE
* FILENAME PARAM; BIT 0 REPRESENTS FILECODE.  IF A BIT IS SET,
* THAT PARAMETER WAS SPECIFIED IN THE CALLING SEQUENCE. 
* 
      LDA DPRAM     POINTER TO PARAM ADDRESSES. 
      STA TEMP
      LDA N13       MAX. OF 13 PARAMS.
      STA TEMP1 
      CLA,RSS 
MSK   RAL           SHIFT ACCUMULATED BITS. 
      LDB TEMP,I    SEE IF PARAM GIVEN. 
      SZB 
      IOR B1        YES. SET THE BIT. 
      ISZ TEMP
      ISZ TEMP1 
      JMP MSK       LOOP FOR 13 PARAMS. 
      STA TEMP      SAVE PRELIMINARY MASK.
* 
* FOR ASCII PARAMETERS, CHECK WHETHER A FILLER OF ZERO
* WAS GIVEN TO SPECIFY NO PARAMETER.
* 
      CLA           CLEAR (A) IN CASE PARAM NOT SPECIFIED.
      CLB           INITIALIZE RESET MASK.
      LDA PRAMS,I   GET 1ST WORD OF FILE NAME (ASCII).
      SZA,RSS 
      LDB B10K      NO FILE NAME. SET BIT 12. 
      CLA           CLEARED IN CASE NO PARAM. 
      LDA PRAMS+4,I GET 1ST WORD OF DEV NAME. 
      SZA,RSS 
      ADB B400      NO DEV NAME. SET BIT 8. 
      CLA           CLEARED IN CASE NO PARAM. 
      LDA PRAMS+5,I GET 1ST WORD OF FORMMSG.
      SZA,RSS 
      ADB B200      NO FORMMSG. SET BIT 7.
      CMB           COMPLIMENT (B), 
      LDA TEMP       GET THE PRELIMINARY MASK,
      AND B          AND CLEAR REQUIRED BITS. 
* 
      JSB D$STW     STORE MASK IN REQUEST.
      INA 
      STA NBYTS 
* 
* MOVE ASCII STRINGS TO REQUEST BUFFER. 
* 
      CLA           CLEAR BYTE POINTERS IN REQUEST. 
      LDB D$RQB 
      ADB D11 
      STA B,I         FILE NAME POINTER.
      ADB B4
      STA B,I         DEV NAME POINTER. 
      INB 
      STA B,I         FORMMSG POINTER.
* 
      LDA PRAMS     CHECK IF FILE NAME SPECIFIED. 
      LDB A,I 
      SZA 
      SZB,RSS 
      JMP SEND      NO NAME.
      LDB D$RQB     GET ADDR OF FLNAME BYTE 
      ADB D11        POINTER IN RQBUF.
      LDA NBYTS     REPLACE DUMMY VALUE WITH
      ADA N1
      STA B,I        BYTE POINTER TO ASCII STRING.
      LDA PRAMS     MOVE FILE NAME ASCII STRING 
      LDB N14 
      JSB D$ASC       TO REQUEST BUFFER.
      INA 
      STA NBYTS 
* 
      LDA PRAMS+4   CHECK IF DEV NAME SPECIFIED.
      LDB A,I 
      SZA 
      SZB,RSS 
      JMP FRMSG     NO NAME. GO CHECK FORMMSG.
      LDB D$RQB 
      ADB D15 
      LDA NBYTS     REPLACE DUMMY VALUE WITH
      ADA N1
      STA B,I        BYTE POINTER TO ASCII STRING.
      LDA PRAMS+4   MOVE DEVICE NAME. 
      LDB N4        MAX WORDS (NEG).
      JSB D$ASC 
      INA 
      STA NBYTS 
* 
FRMSG LDA PRAMS+5   CHECK IF FORMMSG SPECIFIED. 
      LDB A,I 
      SZA 
      SZB,RSS 
      JMP SEND      NO FORMMSG. 
      LDB D$RQB 
      ADB D16 
      LDA NBYTS     REPLACE DUMMY VALUE WITH
      ADA N1
      STA B,I        BYTE POINTER TO ASCII STRING.
      LDA PRAMS+5   MOVE FORMS MESSAGE. 
      LDB N25       MAX WORDS (NEG).
      JSB D$ASC 
* 
* REQUEST BUFFER READY: D3KMS WILL WRITE IT TO QUEX'S 
* I/O CLASS. USER WILL BE SUSPENDED UNTIL D3KMS'S CLASS GET 
* IS COMPLETED WHEN THE REPLY ARRIVES. D3KMS WILL RETURN
* WITH A-REG = STATUS WORD (FILE NUMBER). 
* 
SEND  JSB D3KMS     SHIP THE REQUEST BUFFER TO QUEX.
      DEF *+2 
      DEF BIT15     NO ABORT. 
      JMP ABERR     ERROR RETURN. 
* 
      AND B377      ISOLATE FILE NUMBER IN A-REG. 
      JMP ENTRY,I   RETURN TO USER. 
* 
ABERR DST D$ERR     STORE CODE FOR FCHEK RETRIEVAL. 
      CLA 
      JMP ENTRY,I   FILE NUMBER = 0.
      SPC 3 
* 
* D$RFH - COMMON SUBROUTINE FOR ALL RFA CALLS TO 3000.
* SET UP FRONT END OF REQUEST BUFFER. 
* 
D$RFH NOP 
      LDA B7        STORE MESSAGE CLASS = 7.
      STA D$3BF 
      LDA B20       STORE STREAM TYPE = 20 OCTAL. 
      STA D$3BF+2 
      LDA "RF"
      JSB D$STW     STORE "RFA ". 
      LDA "A" 
      JSB D$STW 
      JMP D$RFH,I   RETURN. 
      SPC 4 
* 
* CONSTANTS AND WORKING STORAGE.
* 
B1    OCT 1 
B4    OCT 4 
B7    OCT 7 
B20   OCT 20
B377  OCT 377 
B200  OCT 200 
B400  OCT 400 
B10K  OCT 10000 
D11   DEC 11
D15   DEC 15
D16   DEC 16
N1    DEC -1
N2    DEC -2
N3    DEC -3
N4    DEC -4
N9    DEC -9
N13   DEC -13 
N14   DEC -14 
N25   DEC -25 
"RF"  ASC 1,RF
"A"   ASC 1,A 
BIT15 OCT 100000
NBYTS OCT 0 
TEMP  NOP 
TEMP1 NOP 
* 
      END 
                                                              