ASMB,R,L,C
      HED FREAD 91741-16012 REV 1740 770317 * (C) HEWLETT-PACKARD CO. 1977
      NAM FREAD,7 91741-16012 REV 1740 770317 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 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$RQB,D$ERR,D$WDC 
* 
* FREAD 
* SOURCE: 91741-18012 
* BINARY: 91741-16012 
* JIM HARTSELL
* AUG. 14, 1975 
* 
A     EQU 0 
B     EQU 1 
* 
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 STWD
      CLA           CLEAR (A) IN CASE NO PARAM. 
      LDA PRAMS+3,I 
      JSB D$STW 
      CLA           CLEAR (A) IN CASE NO PARAM. 
      LDA PRAMS+3 
      SZA 
      INA 
      LDA A,I 
      JSB D$STW 
* 
STWD  JSB D$WDC     SET WORD COUNT. 
      LDA N4        SET APPENDAGE LENGTH = 4 BYTES. 
      STA APEND 
* 
* SEND REQUEST TO 3000 BY WRITING TO QUEX'S CLASS,
* AND WAIT FOR THE REPLIES (MAY BE SEVERAL).
* 
      LDA PRAMS+1   SET ADDR OF USER DATA BUFFER. 
      STA TBUF
      CLA 
      STA TCNT      CLEAR RECEIVED BYTE COUNT (LOG).
* 
      INA           SIGNAL FOR MULTIPLE REPLIES.
SN/RC IOR BIT15     STORE CONTROL WORD FOR D3KMS. 
      STA CONWD     HAS NO-ABORT BIT SET. 
* 
      JSB D3KMS     SHIP REQUEST BUFFER TO QUEX,
      DEF *+2        AND WAIT FOR DATA REPLY. 
      DEF CONWD 
      JMP ABERR     ERROR RETURN. 
* 
      LDA CONWD     WAS LAST CALL TO RELEASE
      AND B377
      CPA B4        CLASS ONLY? 
      JMP DONE      YES.
* 
      LDA D$RQB     CHECK IF ANY DATA WAS 
      ADA B7         RECEIVED.
      LDA A,I 
      ADA APEND 
      SZA,RSS 
      JMP CONBT     READ ERROR - NO DATA. 
* 
* PASS RECEIVED DATA BLOCK BACK TO USER.
* 
      JSB MOVE      MOVE DATA TO USER BUFFER. 
* 
CONBT LDA D$RQB     IS CONTINUATION BIT SET?
      ADA B2
      LDA A,I 
      RAL,RAL 
      SSA 
      JMP DMREP     YES.
      LDA B4        NO. DE-ALLOC CLASS. 
      JMP SN/RC 
* 
DMREP LDB D$RQB     SET UP "REPLY". 
      LDA B,I       STORE COUNT AND MSG CLASS.
      AND B377
      IOR LB10
      STA B,I 
      ADB B2
      LDA B,I       CLEAR REPLY BIT.
      ELA,CLE,ERA 
      STA B,I 
      ADB B2
      LDA B,I       REVERSE PROCESS NUMBERS.
      ALF,ALF 
      STA B,I 
      ADB B3
      CLA           CLEAR BYTE COUNT. 
      STA B,I 
      STA APEND     SET APPENDAGE LEN = 0.
* 
      LDA B2        TELL D3KMS TO LOOK FOR MORE.
      JMP SN/RC     GO GET NEXT DATA BLOCK. 
* 
DONE  LDA TCNT      RETURN TO USER WITH 
      LDB PRAMS+2    (A) = + WORDS OR + BYTES 
      SZB,RSS 
      JMP RETRN,I 
      LDB B,I 
      SSB            DEPENDING ON HIS BUFLEN. 
      JMP RETRN,I 
      INA 
      CLE,ERA 
      JMP RETRN,I 
* 
ABERR DST D$ERR     STORE CODE FOR FCHEK RETRIEVAL. 
      CLA 
      JMP RETRN,I   RETURN. 
      SPC 3 
* 
* SUBROUTINE TO MOVE A BLOCK OF DATA FROM REPLY 
* BUFFER TO USER BUFFER.
* ENTRY: (A) = + # DATA BYTES IN THIS REPLY.
* EXIT WITH TCNT = TOTAL BYTES RECEIVED.
* 
MOVE  NOP 
      LDB A        ACCUMULATE LOG.
      ADB TCNT
      STB TCNT
      INA          (A) = + BYTES. 
      CLE,ERA 
      CMA,INA 
      STA TEMP     NEG. # WORDS TO MOVE.
* 
      LDA APEND    COMPUTE ADDR OF REPLY DATA.
      CMA,INA 
      ARS 
      LDB D$RQB 
      ADB D8
      ADB A 
      STB RQPTR     ADDRESS OF REPLY DATA.
* 
LOOP  LDA RQPTR,I   MOVE WORD FROM REPLY
      STA TBUF,I     TO USER BUFFER.
      ISZ RQPTR     BUMP POINTERS.
      ISZ TBUF
* 
      ISZ TEMP
      JMP LOOP      LOOP TILL DONE. 
      JMP MOVE,I
      SKP 
* 
* CONSTANTS AND WORKING STORAGE.
* 
B2    OCT 2 
B4    OCT 4 
B7    OCT 7 
D8    DEC 8 
N2    DEC -2
N4    DEC -4
LB10  OCT 4000
B377  OCT 377 
BIT15 OCT 100000
APEND NOP 
FCN   NOP 
CONWD NOP 
TCNT  NOP 
TBUF  NOP 
TEMP  NOP 
RQPTR NOP 
* 
      END 
                                                                                                                                                                                                          