ASMB,R,L,C
      HED FWRIT 91741-16013 REV 1840 780612 * (C) HEWLETT-PACKARD CO. 1978
      NAM FWRIT,7 91741-16013 REV 1840 780612 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. 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 FWRIT,FWDIR,FUPDT 
* 
      EXT .ENTR,D3KMS,D$INI,D$RFH,D$STW,D$PRM 
      EXT D$RQB,D$ERR,D$WDC 
* 
* FWRIT 
* SOURCE: 91741-18013 
* BINARY: 91741-16013 
* JIM HARTSELL
* AUG. 13, 1975 
* 
D     EQU 256       MAX. LENGTH OF DATA BLOCK (WORDS).
A     EQU 0 
B     EQU 1 
* 
FWRIT NOP           FWRITE. 
      JSB ENTRY 
      OCT 6 
* 
FWDIR NOP           FWRITEDIR.
      JSB ENTRY 
B7    OCT 7 
* 
FUPDT NOP           FUPDATE.
      JSB ENTRY 
B12   OCT 12
* 
ENTRY NOP 
      LDA ENTRY,I   SAVE FUNCTION CODE. 
      STA FCN 
      CLA           CLEAR OLD PARAM ADDRESSES.
      STA PRAMS 
      STA PRAMS+1 
      STA PRAMS+2 
      STA PRAMS+3 
      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           CONTROL WORD OR RECNUM. 
* 
RETRN NOP           ENTRY POINT.
BEGIN JSB .ENTR     GET ADDRS OF USER PARAMS. 
DPRAM DEF PRAMS 
* 
      CLA           CLEAR ERROR CODE FOR FCHECK.
      CLB 
      DST D$ERR 
* 
* 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     FWRIT = 6, FWDIR = 7, FUPDT = 12. 
* 
* MOVE USER PARAMS TO REQUEST BUFFER. 
* 
      CCA 
      JSB D$PRM     MOVE FNUM.
* 
      LDA PRAMS+1   IF NO TARGET ADDR,
      SZA,RSS 
      STA PRAMS+2    CLEAR TCOUNT ADDR. 
      CLA 
      JSB D$STW     STORE DUMMY TCOUNT FOR NOW. 
      LDA D5        INITIALIZE LENGTH OF  
      STA APEND      APPENDAGE TO 5 WORDS.
* 
      LDA FCN       IF UPDATE, NO MORE PARAMS.
      CPA B12 
      JMP STWD
* 
      ISZ APEND     CHANGE APPENDAGE TO 6.
      CLA           CLEAR (A) IN CASE NO PARAM. 
      LDA PRAMS+3,I 
      JSB D$STW     MOVE CONTROL WORD OR RECNUM.
* 
      CLA           CLEAR (A) IN CASE NO PARAM. 
      LDA PRAMS+3 
      SZA 
      INA 
      LDA A,I 
      LDB FCN       IF FWRITEDIR, STORE WORD 2 OF RECNUM. 
      CPB B7
      RSS 
      JMP STWD
      JSB D$STW 
      ISZ APEND     CHANGE APPENDAGE TO 7.
* 
STWD  JSB D$WDC     SET WORD COUNT. 
* 
* MOVE USER DATA TO REQUEST BUFFER. BLOCK IT OUT. 
* 
      LDA PRAMS+1   SET POINTER TO USER DATA. 
      STA TBUF
* 
      CLA           CLEAR (A) IN CASE NO PARAM. 
      LDA PRAMS+2,I GET USER BUFFER LENGTH. 
      SSA,RSS        + = WORDS, - = BYTES.
      RAL           WORDS. CONVERT. 
      SSA           BYTES. MAKE POSITIVE. 
      CMA,INA 
      STA TCNT      TOTAL DATA BYTES TO SEND. 
      CMA,INA       STORE "TCOUNT" IN REQUEST.
      LDB D$RQB 
      ADB D12 
      STA B,I 
* 
      SZA           SKIP MOVE IF NO DATA. 
      JSB MOVE      MOVE 1ST BLOCK TO REQ BUFFER. 
* 
      CLA           SET APPENDAGE = 0.
      STA APEND 
      LDA TCNT
      SZA,RSS       IF ALL DATA MOVED,
      JMP SEND       TELL D3KMS THERE IS SINGLE REPLY.
* 
      LDB D$RQB     CONTINUATION BLOCKS REQUIRED. 
      ADB D2
      LDA B,I 
      IOR BIT13     SET CONTINUATION BIT IN STREAM WORD.
      STA B,I 
      CLA,INA        TELL D3KMS THERE ARE MULT. BLOCKS. 
* 
* SEND REQ TO 3000 BY WRITING TO QUEX'S CLASS.
* 
SEND  IOR BIT15     STORE CONTROL WORD FOR D3KMS. 
      STA CONWD     (NO-ABORT BIT SET)
* 
      JSB D3KMS     SHIP REQUEST BUFFER TO QUEX,
      DEF *+2        AND WAIT FOR INTERMEDIATE
      DEF CONWD      OR FINAL REPLY.
      JMP ABERR     ERROR RETURN. 
* 
      LDB TCNT      IF ALL DATA OUT, WE HAVE
      SZB,RSS        RECEIVED THE REPLY.
      JMP RETRN,I   RETURN. (A) = STATUS WORD.
* 
      LDB D$RQB     IF CONTINUATION 
      ADB D2         BIT IS NOT 
      LDA B,I         SET, ERROR
      AND BIT13        CONDITION! 
      SZA,RSS           RETURN. USER
      JMP RETRN,I       GETS REASON VIA ICC.
* 
* MORE DATA... SHIP OUT NEXT BLOCK. 
* 
      LDA B,I       CLEAR REPLY BIT.
      ELA,CLE,ERA 
      STA B,I 
* 
      JSB MOVE      MOVE SOME MORE DATA TO REQUEST. 
* 
      LDA D2
      LDB TCNT
      SZB           IF MORE DATA, KEEP CONTIN. BIT. 
      JMP SEND       CALL D3KMS WITH RCODE = 2. 
* 
      LDB D$RQB     THIS IS LAST BLOCK. 
      ADB D2
      LDA B,I 
      AND NOT13     CLEAR CONTINUATION BIT. 
      STA B,I 
      LDA D3        TELL D3KMS THIS IS LAST BLOCK.
      JMP SEND
* 
ABERR DST D$ERR     STORE CODE FOR FCHEK RETRIEVAL. 
      CLA 
      JMP RETRN,I   RETURN. 
      SKP 
* 
* SUBROUTINE TO STORE # BYTES LEFT TO SEND IN REQ 
* BUFFER AND MOVE NEXT BLOCK OF USER DATA (REMAINING
* BYTES UP TO MAX). STORE ADJUSTED BYTE COUNTER (N) 
* IN REQUEST. ON EXIT, TCNT IS REMAINING # DATA 
* BYTES OR ZERO.
* 
MOVE  NOP 
      LDA D$RQB     INITIALIZE BYTE COUNTER (N).
      ADA B7
      LDA A,I 
      STA BYTCT 
      LDB D$RQB 
      ADB D8
* 
      ADB APEND     SET ADDR OF DATA IN RQBUF.
      STB RQPTR 
      LDA MAXSZ 
      STA TEMP      SET LIMIT OF MAX WORDS. 
* 
LOOP  LDA TBUF,I    MOVE DATA FROM USER TO REQUEST. 
      STA RQPTR,I 
      ISZ TBUF
      ISZ RQPTR 
      ISZ BYTCT     ADD 2 TO BYTE COUNTER (N).
      ISZ BYTCT 
      LDA TCNT      DECREMENT TOTAL DATA BYTES LEFT.
      ADA N2
      STA TCNT
      CMA,INA       NEGATE. 
      SSA,RSS       IF 0 OR 1,
      JMP ADJ        ALL USER DATA MOVED, 
      ISZ TEMP
      JMP LOOP       ELSE LOOP TILL DONE. 
      JMP STBYT     REACHED LIMIT OF MAX WORDS. 
* 
ADJ   CMA,INA       ADJUST BYTE COUNTER (N) 
      ADA BYTCT      IF ODD # DATA BYTES. 
      STA BYTCT 
* 
STBYT LDA D$RQB     STORE BYTE COUNT (N). 
      ADA B7
      LDB BYTCT 
      STB A,I 
      LDA TCNT      IF TCNT = -1, MAKE IT 0.
      CPA N1
      CLA 
      STA TCNT
* 
      JMP MOVE,I    RETURN. 
      SKP 
* 
* CONSTANTS AND WORKING STORAGE.
* 
D2    DEC 2 
D3    DEC 3 
D5    DEC 5 
D8    DEC 8 
D12   DEC 12
N1    DEC -1
N2    DEC -2
BIT13 OCT 20000 
NOT13 OCT 157777
BIT15 OCT 100000
FCN   NOP 
CONWD NOP 
TBUF  NOP 
TCNT  NOP 
BYTCT NOP 
RQPTR NOP 
TEMP  NOP 
APEND OCT 0 
MAXSZ ABS -D
* 
      END 
                    