ASMB,R,L,C
*     NAME:   R/W$  
*     SOURCE: 92064-18193 
*     RELOC:  92064-16059 
*     PGMR:   G.A.A.
*     MOD:    G.L.M 
* 
*  ***************************************************************
*  * (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 HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
* 
* 
      NAM R/W$,7  92064-16059  REV.1650  760801 
* 
      HED R/W$
      EXT EXEC
      ENT R/W$
      ENT D$XFR 
      ENT D.R 
* 
*  R/W$        WRITES THE CURRENT SECTOR BLOCK IF IT HAS
*              BEEN WRITTEN ON OR READS UNCONDITIONALLY.
* 
*        CALL SEQUENCE: 
* 
*                   SET E=0 FOR WRITE  E=1 FOR READ 
*     LDB DCB       SET B TO DCB ADDRESS
*     JSB R/W$
*     JMP DERR      ERROR RETURN (A = -1) 
*                   NORMAL RETURN 
* 
R/W$  NOP 
      STB RC        SAVE THE DCB ADDRESS
      ADB .7        INDEX TO THE BLOCK SIZE 
      LDA B,I       FETCH THE BLOCK SIZE
      ARS,ALR       CLEAR THE LEAST AND SIGN BITS 
      ADB .6        INDEX TO THE WRITTEN ON FLAG
      STB WOFLG     SAVE ITS ADDRESS
      ADB .3        INDEX TO THE BUFFER ADDRESS 
      STB BUFA      SET IN CALL 
      LDB WOFLG,I   GET THE WRITTEN ON FLAG 
      SEZ,SLB,RSS    IF NOT WRITTEN ON (SKIP ON READ) 
      JMP EXIT       EXIT 
      LDB RC        GET THE DCB ADDRESS 
      JSB D$XFR     DO THE TRANSFER 
BUFA  NOP 
      JMP R/W$,I    ERROR - RETURN
      LDB RC        GET THE REQUEST CODE
      CCE,SLB,RSS   IF THIS IS A WRITE CALL 
EXIT  CLA,CLE       CLEAR THE IN CORE FLAGS 
      ERA,ALS       CLEAR WRITTEN ON FLAG AND SET IF READ 
      STA WOFLG,I   RESET 
      ISZ R/W$      TAKE OK 
      JMP R/W$,I    EXIT
      SPC 2 
.2    DEC 2 
.3    DEC 3 
.6    DEC 6 
.7    DEC 7 
.8    DEC 8 
RC    NOP 
TRACK NOP           AT TRACK
SECT  NOP           AND SECTOR
LU    NOP 
WOFLG NOP 
B77   OCT 77
      SPC 2 
*     DISC TRANSFER CALL SEQUENCE 
* 
*     E=0  FOR WRITE
*     E=1  FOR READ 
*     B=  DCB ADDRESS 
*     A=  LENGTH (NO. OF WORDS) 
*     JSB D$XFR     CALL TO HERE
*     DEF BUFR      BUFFER ADDRESS (MUST BE DIRECT) 
*     JMP ERR       ERROR RETURN  (A=-1)
*     NORMAL RETURN 
      SPC 2 
D$XFR NOP           ENTRY POINT 
      STA LSAVE     SAVE LENGTH 
      CLA,SEZ,INA,RSS  SET UP THE REQUEST CODE
      INA               AND 
      STA RC              SET IT
      LDA B,I       CONFIGURE THE CON WORD
      AND B77 
* 
*  MUST HAVE "Z" OPTION TO RUN IN RTE 2/3 SYSTEM
* 
      IFZ 
      ADA PRC 
      XIF 
* 
      STA LU
      ADB .8        GET THE NUMBER OF SECTORS PER TRACK 
      STB #SC/T     ADDRESS AND SAVE IT 
      ADB .2        GET THE TRACK ADDRESS 
      DLD B,I       AND 
      DST TRACK     SAVE IT 
      LDA D$XFR,I   GET THE BUFFER ADDRESS
      STA BUF       SAVE IT 
      ISZ D$XFR     STEP TO ERROR RETURN ADDRESS
      LDA B         GET THE SECTOR ADDRESS TO A 
      CMA,INA       SET NEGATIVE AND
NXTR  ADA #SC/T,I   CACULATE NUMBER OF WORDS LEFT ON THIS 
      ASL 6         ON THIS TRACK 
      STA #WORD     SET FOR TRANSFER
      CMA,INA       SET MAX COUNT NEGATIVE
      LDB LSAVE     GET REMAINING COUNT 
      ADA B         AND SUBTRACT
      SSA           IF LESS THAN REST OF TRACK
      STB #WORD      RESET COUNT TO RIGHT NUMBER
      STA LSAVE     SET REMAING WORDS FOR NEXT TIME 
      JSB EXEC      CALL EXEC TO
      DEF ERTS
      DEF RC        WRITE/READ
      DEF LU        FROM THE DISC 
BUF   NOP           AT THE SPECIFIED BUFFER 
      DEF #WORD     SIZE
      DEF TRACK     TRACK AND 
      DEF SECT       SECTOR 
ERTS  CCA           SET UP FOR ERROR EXIT 
      CPB #WORD     ERROR?
      CLA,RSS       NO ERROR SKIP 
      JMP D$XFR,I   ERROR RETURN
      ADB BUF       UP DATE THE BUFFER
      STB BUF       ADDRESS 
      STA SECT      SET THE SECTOR ADDRESS FOR NEW TRACK
      ISZ TRACK     STEP THE TRACK ADDRESS
      LDB LSAVE     GET THE REMAINING LENGTH
      CMB,SSB,INB,SZB CHECK IF ANY LEFT 
      JMP NXTR      NO CONTINUE XFER
      ISZ D$XFR     END SO
      JMP D$XFR,I   MAKE THE NORMAL RETURN
      SPC 2 
LSAVE NOP 
#SC/T NOP 
#WORD NOP 
A     EQU 0 
B     EQU 1 
      UNL 
* 
      IFZ 
* 
PRC   OCT 74000 
* 
      XIF 
* 
      LST 
D.R   ASC 3,D.RTR 
      SPC 1 
END   EQU * 
      SPC 1 
      END 
                                                                                                                                                                                                                                        