ASMB
      NAM BITS,7 . 92903-16001 REV.1805  770106 
* 
*     SOURCE 92903-18004
* 
      SPC 2 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
      SPC 2 
      ENT BITS
* 
* 
* 
*     FORTRAN CALLABLE SUBROUTINE:
* 
*                   B I T S 
*                   ======= 
* 
* 
*     CALL BITS(IRW,IBUF,INDEX,IVAL,LENGRP) 
* 
*       IRW    => 1 = GET BYTE
*              => 2 = PUT BYTE
*       IBUF   => BUFFER START ADDRESS. 
*       INDEX  => ITEM NUMBER TO BE ACCESSED (FIRST=1)
*       IVAL   => INTEGER VALUE (RETURNED IF GET, 
*                                SUPPLIED IF PUT) 
*       LENGRP => BYTE LENGTH (RANGES FROM 1 TO 16) 
* 
* 
* 
* 
*     THIS ROUTINE STORES OR GETS A 'BYTE' IN OR OUT A BUFFER.
*     THE BYTE-LENGTH CAN BE FIXED TO ANY LENGTH BETWEEN
*     1 AND 16.(LIMITS INCLUDED)
*     EXECUTION TIME IS LESS THAN 260 MICRO SECS (21MX) 
* 
* 
*     PROGRAMMED:  VAN DEN BOSSCHE MARC        DEC 6-1-1977 
* 
*                   HP BRUSSELS 
* 
* 
A     EQU 0 
B     EQU 1 
ARW   DEF LOCAT 
MASK  NOP 
NMASK NOP 
LOCAT NOP 
* 
* 
* 
RW    NOP 
ABUF  NOP 
INDEX NOP 
IVAL  NOP 
GRPL  NOP 
BITS  NOP 
      LDB ARW 
      LDA =D-6
      STA R1
L.    LDA BITS,I
      ISZ BITS
      SSA,RSS 
      JMP *+4 
      ELA,CLE,ERA 
      LDA A,I 
      JMP *-4 
      STA B,I 
      INB 
      ISZ R1
      JMP L.
      LDA LOCAT 
      STA BITS
      LDA GRPL,I
      AND =B17
      IOR RRL 
      STA *+3 
      CLA 
      CCB 
DATA  NOP 
      STA MASK
      CMA 
      STA NMASK 
      CMA 
      AND IVAL,I
      STA DATA
      LDA INDEX,I 
      MPY GRPL,I
      DIV =D16
      ADA =D-1
      ADA ABUF
      STA LOCAT 
RRL   RRL 16
      SZA 
      IOR RRL 
      STA R1
      STA R3
      SZA 
      XOR =B1000
      STA R2
      LDA RW,I
      CPA =D2 
      JMP WRITE 
      DLD LOCAT,I 
R3    NOP 
      AND MASK
      STA IVAL,I
      JMP BITS,I
* 
WRITE DLD LOCAT,I 
R1    NOP 
      AND NMASK 
      IOR DATA
R2    NOP 
      DST LOCAT,I 
      JMP BITS,I
      END 
                                                                                                            