ASMB,Q,C
      HED FREAD: HP 3000 RFA SUBROUTINE * (C) HEWLETT-PACKARD CO. 
      NAM FREAD,7 91750-1X120 REV.2013 790412 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 1 
      ENT FREAD,FRDIR 
* 
      EXT .ENTR,D3KMS,D$INI,D$RFH,D$STW,D$PRM 
      EXT D$ERR 
      SPC 2 
      UNL           NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING 
*  NAME: FREAD
*SOURCE: 91750-18120
* RELOC: 91750-1X120
*  PGMR: DMT
      LST 
*************************  FREAD  ************************* 
*                                                         * 
*     SOURCE: 91750-18120                                 * 
*                                                         * 
*     BINARY: 91750-1X120                                 * 
*                                                         * 
*     PROGRAMMER: JIM HARTSELL                            * 
*                                                         * 
*     DATE: AUGUST 14, 1975                               * 
*                                                         * 
*---------------------------------------------------------* 
*                                                         * 
*   MODIFIED FOR DS/1000 ENHANCEMENTS BY DMT BEGINNING    * 
*   MARCH 26, 1979.                                       * 
*                                                         * 
*********************************************************** 
      SPC 2 
A     EQU 0 
B     EQU 1 
      SUP 
      SKP 
FREAD NOP           FREAD.
      JSB ENTRY 
B3    OCT 3 
* 
FRDIR NOP           FREADDIR. 
      JSB ENTRY 
      OCT 4 
* 
ENTRY NOP 
      CLA           CLEAR OLD PARAM ADDRESSES.
      STA PRAMS 
      STA PRAMS+1 
      STA PRAMS+2 
      STA PRAMS+3 
      LDA ENTRY,I   SAVE FUNCTION CODE. 
      STA FCN 
      LDA ENTRY     SET UP FOR .ENTR CALL.
      ADA N2
      LDA A,I 
      STA RETRN 
      JMP BEGIN 
* 
PRAMS NOP           FILE NUMBER.
      NOP           BUFFER ADDRESS
      NOP           BUFFER LENGTH 
      NOP           RECORD NUMBER.
* 
RETRN NOP           ENTRY POINT.
BEGIN JSB .ENTR     GET ADDRS OF USER PARAMS. 
DPRAM DEF PRAMS 
* 
      CLA           CLEAR ERROR CODE FOR FCHEK. 
      CLB 
      DST D$ERR 
      SKP 
* 
* BUILD FRONT END OF REQUEST BUFFER.
* 
      LDA DPRAM     ADDR OF 1ST PARAM TO SEND.
      JSB D$INI     INITIALIZE BUFFER STUFFERS. 
* 
      JSB D$RFH     SET UP FIXED FORMAT.
* 
      LDA FCN 
      JSB D$STW     FREAD CODE = 3, FRDIR = 4.
* 
* MOVE USER PARAMS TO REQUEST BUFFER. 
* 
      CCA 
      JSB D$PRM     MOVE FNUM.
* 
      LDA PRAMS+1   IF NO TARGET ADDR,
      SZA,RSS 
      STA PRAMS+2    ZERO TCOUNT ADDR.
      CLA           CLEAR (A) IN CASE NO PARAM. 
      LDA PRAMS+2,I STORE USER BUFFER LEN IN "TCOUNT".
      JSB D$STW      + = WORDS, - = BYTES.
* 
      LDA FCN       IF FREADDIR, STORE RECNUM.
      CPA B3
      JMP SEND
      CLA           CLEAR (A) IN CASE NO PARAM. 
      LDA PRAMS+3,I 
      JSB D$STW 
      LDA PRAMS+3   GET SECOND
      SZA            WORD OF
      INA             RECNUM. 
      LDA A,I 
      JSB D$STW 
* 
* SEND REQUEST TO 3000 BY WRITING TO QUEX'S CLASS,
* AND WAIT FOR THE REPLY. 
* 
SEND  JSB D3KMS 
      DEF *+6 
      DEF BIT15 
      DEF 0 
      DEF 0 
      DEF PRAMS+1,I 
      DEF PRAMS+2,I 
      JMP ABERR     ERROR RETURN. 
* 
*  B-REG CONTAINS NUMBER OF BYTES RECEIVED FROM 3000. 
      CLA           CLEAR A-REG IN CASE NO PARAM. 
      LDA PRAMS+2,I GET USER'S TCOUNT.
      SSA,RSS       IF SIGN BIT NOT SET,
      CLE,ERB        CHANGE BYTES TO WORDS. 
      LDA B         A-REG GETS LENGTH.
      JMP RETRN,I   NORMAL RETURN.
      SPC 2 
* 
ABERR DST D$ERR     STORE CODE FOR FCHEK RETRIEVAL. 
      CLA 
      JMP RETRN,I   RETURN. 
      SPC 3 
N2    DEC -2
BIT15 OCT 100000
FCN   NOP 
* 
      BSS 0         SIZE OF FREAD.
* 
      END 
                                                                                                                                                                                                                                                        