ASMB,R,L,C,F,B
      HED BASIC HP6940 DEVICE SUBROUTINES  A-29102-16003 REV. C 
* 
* A6940 - REAL TIME BASIC DEVICE SUBROUTINES FOR HP6940A
* 
* SOURCE TAPE 29102-18003 REV. C
* RELOC. TAPE 29102-16003 REV. C
* 
* REVISED ON 12DEC75 BY CHRIS LEHNER
* 
* 
*     MPNRM - RESETS ALL BIT/TRAP DEFINITIONS 
*     RDBIT - INPUTS ONE BIT
*     RDWRD - INPUTS 12 BITS
*     SENSE - SETS UP A BIT/TRAP DEFINITION AND ENABLES SENSE MODE
*     WRBIT - OUTPUTS ONE BIT 
*     WRWRD - OUTPUTS 12 BITS 
*     DAC   - DIGITAL TO ANALOG OUTPUT
* 
* 
* 
      NAM A6940,7  29102-16003C  12DEC75
      ENT MPNRM,RDWRD,WRWRD,RDBIT,WRBIT,DAC 
      ENT SENSE 
      EXT .ENTR,&6940,EXEC,#GET!
      EXT ERROR,$LIBR,$LIBX 
      SUP 
      SKP 
* RDWRD INPUTS ONE WORD FROM THE 6940 
* 
CHAN1 NOP           CHANNEL TO BE READ
WORD1 NOP           ADDRESS FOR DATA
RDWRD NOP           ENTRY POINT 
      JSB .ENTR 
      DEF CHAN1 
      LDA RDWRD     SAVE RETURN 
      STA ENTRY       ADDRESS 
      LDA CHAN1,I   LOAD CHANNEL NUMBER 
      JSB #IWRD     CALL READ ROUTINE 
      AND B7777    MASK LOWER 12 BITS 
      STA WORD1,I    AND STORE DATA 
      JMP RDWRD,I   RETURN
* 
* RDBIT INPUTS ONE BIT FROM THE 6940
* 
CHAN2 NOP           CHANNEL TO BE READ
NBIT2 NOP           NUMBER OF BIT TO BE READ (0-11) 
BIT2  NOP           BIT READ (0 OR 1) 
RDBIT NOP           ENTRY POINT 
      JSB .ENTR 
      DEF CHAN2 
      LDA RDBIT     SAVE RETURN 
      STA ENTRY       ADDRESS 
      LDA NBIT2,I   FETCH BIT NUMBER
      JSB #BIT#     PRODUCE BIT MASK
      STA BIT2,I     AND SAVE IT
      LDA CHAN2,I   LOAD CHANNEL NUMBER 
      JSB #IWRD      AND READ IT
      AND BIT2,I    MASK INPUT WORD WITH BIT MASK 
      SZA           IF NOT ZERO 
      CLA,INA        SET TO 1 
      STA BIT2,I    SAVE RESULT 
      JMP RDBIT,I   RETURN
* 
* WRWRD OUTPUT ONE WORD TO THE 6940 
* 
CHANL NOP           OUTPUT CHANNEL
WORD3 NOP           OUTPUT WORD 
WRWRD NOP           ENTRY POINT 
      JSB .ENTR 
      DEF CHANL 
      LDA WRWRD     SAVE RETURN 
      STA ENTRY       ADDRESS 
      LDA WORD3,I   LOAD OUTPUT WORD
      CLB 
      JMP #OWRD     CALL OUTPUT ROUTINE 
      SKP 
* 
* WRBIT OUTPUT ONE BIT TO THE 6940
* OR IF CALLED WITH 4 PARAMETERS UPDATES THE BIT/TRAP TABLE 
* 
* FOR EVENT SENSE CARDS 
* 
CHAN4 NOP           OUTPUT CHANNEL
NBIT4 NOP           NUMBER OF OUTPUT BIT (0-11) 
BIT4  NOP           VALUE OF OUTPUT BIT 
TRAP  NOP           TRAP # USED BY "SENSE" CALL 
WRBIT NOP           ENTRY POINT 
SENSE EQU WRBIT     SENSE USES SAME ENTRY POINT 
      JSB .ENTR 
      DEF CHAN4 
      LDA CHAN4     MOVE CHANNNEL ADDRES TO 
      STA CHANL      LOCATION "CHANL" 
      LDA WRBIT     SAVE RETURN 
      STA ENTRY      ADDRESS
      LDA NBIT4,I   PRODUCE 
      JSB #BIT#      BIT MASK 
      LDB BIT4,I    BIT TO BE 
      SZB            WRITTEN ZERO?
      CCB           NO, SET BIT 
      SWP           AND/OR OUTPUT WORDS CONSIST 
      AND 1          OF COMPLEMENT OF BIT MASK
      CMB             AND BIT TO BE WRITTEN 
* 
* #OWRD TAKES THE PREVIOUS WORD WRITTEN ON "CHANL"
* AND PERFORMS AN "AND" WITH THE WORD IN "B" AND
* AN INCLUSIVE "OR" WITH THE WORD IN "A".  THE 6940 DRIVER
* IS THEN CALLED TO OUTPUT THE RESULT.
* #OWRD CHECKS "TRAP" TO SEE IF "WRBIT" WAS CALLED WITH FOUR
* 
* PARAMETERS INDICATING A SENSE CALL. 
* 
#OWRD AND B7777    MASK AND STORE LOWER 
      STA OR         12 BITS OR "OR" WORD 
      STB AND       SAVE "AND" WORD 
      CMB           ALSO GET AND SAVE 
      STB NAND       THE NAND WORD
      LDA CHANL,I   FIND TABLE ENTRY
      JSB #CHAN     GET SLOT AND BOX NUMBER 
      IOR DTE       TO USE IN CONTROL 
      STA OBUFF        WORD OF OUTPUT BUFFER
* 
      LDA ENTRY 
      STA UPDAT 
* 
      LDA TYPE
      CPA .1
      JMP TABLE 
      CPA .3
      JMP TABLE 
      LDA ADRX
      STA ADRS
      JMP FIX 
* 
TABLE CCA           COMPUTE ADDRESS 
      ADA REL#       OF 
      ADA ADR         OUTPUT
      STA ADRS         ENTRY AND SAVE 
FIX   LDA TRAP      WAS WRBIT CALLED WITH 
      SZA            FOUR PARAMETERS? 
      JMP SENS      YES, UPDATE BIT/TRAP TABLE
      LDA ADRS,I    LOAD OUTPUT STATUS
      AND AND       AND "AND WORD"
      IOR OR        OR "OR WORD"
      IOR 1         OR IN SLOT ADDRESS
      RSS 
UPDAT NOP 
      STA OBUFF+1   SAVE RESULT IN OUTPUT BUFFER
* 
      JSB $LIBR     TURN OFF INTERRUPT
      NOP            SYSTEM 
      LDA OBUFF+1   OUTPUT STATUS 
      STA ADRS,I     TO TABLE 
      JSB $LIBX     TURN ON INTERRUPT 
      DEF *+1 
      DEF *+1 
* 
OUT   JSB EXEC      CALL
      DEF *+6        6940 
      DEF .2          DRIVER TO 
      DEF LU           OUTPUT 
      DEF OBUFF         ONE WORD
      DEF .2             USING
      DEF ZERO            NORMAL WRITE
* 
      AND B204     CHECK FOR
      SZA,RSS        BAD STATUS BITS
      SZB,RSS          OR ZERO XMISSION LOG 
      JMP .ERR1        SET, GIVE ERROR 1
      JMP UPDAT,I 
* 
ADRS  NOP 
ENTRY NOP 
      SKP 
* 
*     SENS  UPDATES THE BIT/TRAP TABLE. 
* 
SENS  CCA           DOES
      ADA TYPE       CHANNEL NUMBER 
      SZA             POINT TO
      JMP ERR2         EVENT SENSE
      LDA TME           CARD OR WAS TME 
      SZA                EQUAL TO ZERO? 
      JMP ERR2      NO - GIVE ERROR 
* 
*     MAKE SURE THAT WE HAVE THE EXTERNAL STATUS
*       (THE REAL THING)
* 
      STB IBUFF+2   SAVE THE SLOT 
      ISZ ADRS      BUMP THE STATUS ADDR
      JSB CLEAR     CLEAR SENSE BIT 
      LDB TRAP,I    GET THE TRAP NUMBER 
      SSB           NEGATIVE TRAPS
      JMP ERR2       ARE ILLEGAL (SIC BIRD) 
      LDA ADRS,I     AND THE STATUS FROM THE TABLE
      CPA .M1       REAL THING? 
      JSB RESET      NOPE, GO TO STORE
      AND NAND      GET BIT TO BE SENSED
      SWP 
      CPB OR        COMPARE NEW AND OLD STATUS
      IOR BIT15       IF EQUAL SET BIT 15 
      STA TRAP#        OF THE TRAP NUMBER 
* 
      CCA           COMPUTE 
      ADA REL#       ADDRESS
      MPY .12         IN
      ADA ADR,I        BIT/TRAP 
      ADA NBIT4,I       TABLE 
      INA 
* 
      JSB $LIBR     TURN OFF INTERRUPT SYSTEM 
      NOP            TO UPDATE BIT/TRAP TABLE 
      LDB TRAP#     GET NEW TRAP
      STB 0,I        SAVE IN BIT/TRAP TABLE 
      CLA           RESET TRAP PARAMETER
      STA TRAP       ADDRESS
      JSB $LIBX     TURN INTERRUPTS 
      DEF *+1        BACK ON
      DEF *+1 
* 
*     TIME TO LEAVE 
* 
      LDA SENSE     SET RETURN
      STA CLEAR      ADDRESS IN CLEAR ROUNTINE
      LDA LU        FIX LU
      XOR B2100      TO SET SENSE BIT 
      JMP CLEAR+3     DO IT!
      SKP 
* 
*     THIS ROUTINE GETS EXTERNAL WORD FOR STATUS  
* 
RESET NOP 
      CLA           FIX INPUT ROUNTINE
      STA TME        TO READ WITHOUT GATE 
      STB TRAP#     SAVE TRAP WHILE PLAYING WITH B
      LDA IEN       PICK A CONTROL WORD 
      JSB INPUT      GET THE REAL STATUS
      AND B7777       OBTAIN LOWER 12 BITS
      IOR IBUFF+2      CRAM ON THE SLOT 
      JSB UPDAT     USE STATUS AS REF WORD
      LDA OBUFF+1 
      LDB TRAP#     RESTORE B REGISTER
      JMP RESET,I 
* 
*     NUMBERS, MASKS, AND CONSTANTS 
DTE   OCT 170140    THIS BUFFER 
ISL   OCT 170240
IEN   OCT 170640
* 
BIT15 OCT 100000
B20   OCT 20
B204  OCT 204 
B2100 OCT 2100
* 
ADRX  DEF *+1       LOCATION FOR
      NOP            DUMMY STATUS 
ZERO  NOP 
.3    DEC 3 
.5    DEC 5 
.6    DEC 6 
.12   DEC 12
.15   DEC 15
* 
.M1   DEC -1
.M9   DEC -9
.M12  DEC -12 
      SKP 
* 
* #CHAN SEARCHES 6940 CONFIGURATION TABLE FOR ADDRESS OF
* ENTRY CORRESPONDING TO THE CHANNEL NUMBER IN THE "A"
* REGISTER.  THE ADDRESS IS STORED IN "CHANL" AND THE BOX NUMBER
* IS RETURNED IN "A". 
* 
#CHAN NOP 
      CLB           IF CHANNEL NUMBER IS
      SSA,RSS        POSITIVE SET TME BIT 
      JMP #CH1        TO ZERO 
      LDB B20      ELSE, SET TME BIT
      CMA,INA       MAKE CHANNEL NUMBER POSITIVE
#CH1  STB TME       SAVE TME
      JSB #GET!     GET TABLE INFO
LU    NOP 
TYPE  NOP 
REL#  NOP 
ADR   NOP 
      SSB           ERROR?
      JMP ERR2      CHAN OUT OF RANGE 
      LDB TYPE      CHECK TYPE
      ADB .M9        TO INSURE
      SSB,RSS         LESS THEN 9 
      JMP ERR2      ELSE ERROR 2
      CLB 
      ADA .M1 
      DIV .15       GET SLOT AND UNIT 
      IOR TME 
      BLF,BLF 
      BLF 
      JMP #CHAN,I 
      SKP 
* 
*                   INPUT BUFFER
IBUFF DEC 2 
      BSS 2 
      DEC 1 
IWORD NOP 
* 
IFUNC NOP 
* 
* #IWRD READS ONE WORD FROM THE 6940.  THE CHANNEL NUMBER IS
* IN "A" AND THE WORD READ IS RETURNED IN "A" 
* 
#IWRD NOP 
      JSB #CHAN     FETCH SLOT ADDRESS AND BOX NUM. 
      IOR ISL       "OR" BOX NUMBER 
      STB IBUFF+2   STORE SLOT ADDRESS IN BUFFER
      JSB INPUT 
      JMP #IWRD,I 
* 
*     INPUT ONE WORD FROM 6940
* 
INPUT NOP 
      STA IBUFF+1 
* 
      LDB .2
      LDA TME 
      SZA 
      LDB ZERO
      STB IFUNC 
* 
      JSB EXEC      CALL
      DEF *+6        6940 
      DEF .1          DRIVER
      DEF LU           TO 
      DEF IBUFF         READ
      DEF .5             ONE
      DEF IFUNC           WORD
* 
      AND B204     CHECK FOR
      SZA,RSS        BAD STATUS BITS
      SZB,RSS           OR ZERO XMISSION LOG
      JMP ERR1
* 
      LDA IWORD     LOAD WORD READ INTO "A" 
      JMP INPUT,I   RETURN
* 
* #BIT# PRODUCES A ONE BIT IN THE POSITION SPECIFIED IN "A".
* THE RESULTING MASK IS RETURNED IN "A".
* 
RRL   RRL 16        SHIFT INSTRUCTION 
#BIT# NOP           ENTRY POINT 
      LDB 0         IF BIT
      ADB .M12       IF BIT NUMBER
      SSA,RSS        IS NEGATIVE
      SSB,RSS         OR GREATER THAN 11
      JMP ERR2         GO TO ERROR # 2
      IOR RRL       GENERATE
      STA SHIFT      SHIFT INSTRUCTION
      CLA,INA       INITIALIZE WORDS
      CLB,INB        TO BE SHIFTED
SHIFT NOP  ****THIS WORD IS REPLACED BY SHIFT INSTRUCTION**** 
      JMP #BIT#,I   RETURN
      SKP 
* 
* MPNRM TURNS OFF SENSE MODE AND CLEARS BIT PROG TABLE
* 
TOP   DEF &6940 
* 
MPNRM NOP 
      ISZ MPNRM     BUMP RETURN ADDR
      LDA TOP       GET BASE PAGE LINK
      SSA,RSS        AND CHECK FOR INDIRECT 
      JMP *+4         NO,ITS OK 
      ELA,CLE,ERA   STRIP INDIRECT BIT
      LDA 0,I        GET ADDR 
      JMP *-4         AND TEST AGAIN
      INA            TO UNIT
      STA PTR         ADDRESS 
* 
LOOP1 LDB PTR,I     GET UNIT ADDRESS
      SSB            IF NEGATIVE ONE
      JMP MPNRM,I     FINISHED, SO RETURN 
      ADB .2        BUMP POINTER
      LDA 1,I        TO 
      STA LU          GET LU
      INB           BUMP
      STB ADR1
      LDA 1,I        POINTER TO # OF EVENT
      CMA,INA 
      STA TME 
      MPY .12        BIT/PROG AND STATUS
      STA #EVNT       POSITIONS TO BE CLEARED 
      ISZ ADR1      BUMP POINTER
      LDA ADR1,I     TO OBTAIN
      INA 
      STA ADR2        EVBUF ADDR
      JSB CLEAR     CLEAR SENSE BIT 
      SKP 
* 
*     CLEAR BIT/PROG ENTRIES
* 
      CCB 
      JSB $LIBR     TURN OFF
      NOP            INTERRUPT SYSTEM 
      LDA ADR2
NRM1  STB 0,I       SET STATUS
      INA            WORDS TO -1
      ISZ TME         DONE? 
      JMP NRM1       NO,CONTINUE
      CLB           SET BIT TRAP
NRM2  STB 0,I        ENTRIES TO 
      INA             ZERO. 
      ISZ #EVNT     DONE? 
      JMP NRM2
      JSB $LIBX     RETURN SYSTEM 
      DEF *+1        TO ORG STATE 
      DEF *+1 
      ISZ PTR       BUMP ADR
      JMP LOOP1 
* 
*     6940 CONTROL CALL, SETS OR CLEARS SENSE BIT 
* 
CLEAR NOP 
      LDA LU        GET LU
      IOR B2100      FORM CLEAR 
      STA CNTL        CNTL WORD 
* 
      JSB EXEC      CLEAR 
      DEF *+3        6940 
      DEF .3          SENSE 
      DEF CNTL         BIT
      JMP CLEAR,I 
      SKP 
* 
*     ERROR ROUTINE 
* 
.ERR1 LDA OBUFF     GET OUTPUT CONTROL WRD
      AND B20        AND CHECK THE
      SZA,RSS         TME BIT 
      JMP ERR1      IF OFF JUST GIVE MESSAGE
* 
      LDA OBUFF 
      AND =B170057
      STA OBUFF 
* 
      JSB EXEC
      DEF *+6 
      DEF .2
      DEF LU
      DEF OBUFF 
      DEF .1
      DEF ZERO
* 
ERR1  CLA,INA,RSS     ERROR#1 
ERR2  LDA .2          ERROR #2
      STA ERRNM     SAVE THE ERROR NUMBER 
      JSB ERROR     CALL
      DEF *+3        BASIC
      DEF ERRNM       ERROR 
      DEF ERMES        ROUTINE
* 
      CLA           CLEAR TRAP
      STA TRAP       PARAMETER ADDRESS
      JMP ENTRY,I   RETURN
* 
ERMES DEC 5 
      ASC 3,A6940 
      SKP 
* 
*     WHATS EQUAL TO WHAT?
* 
.1    EQU IBUFF+3 
.2    EQU IBUFF 
ADR1  EQU NBIT4 
ADR2  EQU BIT4
AND   EQU WORD3 
CNTL  EQU RDWRD 
#EVNT EQU NBIT2 
ERRNM EQU #BIT# 
NAND  EQU CHAN2 
OBUFF EQU CHAN1     OUTPUT BUFFER 
OR    EQU           BIT4
PTR   EQU CHAN4 
TME   EQU #BIT# 
TRAP# EQU NBIT2 
      SKP 
* 
* 
* 
* 
* 
* 
* 
* 
* 
* "DAC" IS A DEVICE SUBROUTINE FOR THE HP6940 DIGITAL TO ANALOG 
* CONVERSION CARDS (HP69370 AND HP69321).  THE RTE DRIVER
* DVR61(LOCAL ONLY) OR DVA72(REMOTE/LOCAL DRIVER) 
* ARE CALLED FROM THIS ROUTINE THROUGH AN EXEC CALL TO PERFORM
* THE OUTPUT. 
* 
* 
* CALLING SEQUENCE: 
* 
*   CALL DAC(N,V) 
* WHERE:  N - DAC CHANNEL NUMBER (INTEGER)
*         V - OUTPUT VOLTAGE IN VOLTS OR CURRENT IN MILLIAMPERES
*             (FLOATING POINT)
      SKP 
CHAN  NOP 
VOLT  NOP 
DAC   NOP 
      JSB .ENTR     FETCH PARAMETER 
      DEF CHAN       ADDRESSES
      LDA CHAN,I    GET CHAN NUMBER 
      JSB #GET!      AND THE TABLE INFO 
ILU   NOP 
TYP   NOP 
      NOP 
      NOP 
      SSB           ERROR?
      JMP ER02
      STA CHAN
      LDA TYP       GET TYP 
      LDB DEFLM      AND LIMIT TABLE ADDR 
      CPA .5        VOLTAGE?
      JMP *+5       YES, USE FIRST LIMITS 
      ADB .2        BUMP TO CURRENT LIMITS
      CPA .6        CURRENT?
      RSS           YES, USE SECOND LIMITS
      JMP ER02      NO, BAD CHANNEL NUMBER
      STB V.OUT 
* 
      DLD VOLT,I    LOAD VOLTAGE OF CURRENT 
      FDV =F-.005   COMPUTE: -INTEGER 
      FIX            VALUE FOR DAC
      STA VOLT        AND SAVE
      ADA V.OUT,I   IF BEYOND UPPER 
      SSA            BOUND, SET OUTPUT
      JMP OVRFL       TO UPPER BOUND
      ISZ V.OUT     MOVE POINTER TO LOWER BOUND 
      LDA VOLT      IF LESS THAN
      ADA V.OUT,I    LOWER BOUND, 
      SSA,RSS         SET OUTPUT
      JMP OVRFL        TO LOWER BOUND 
      LDA VOLT      VALUE WITHIN BOUNDS SO
      CMA,INA,RSS    COMPLEMENT, MASK AND SAVE
OVRFL LDA V.OUT,I   FETCH BOUND 
      AND B7777      MASK 
      STA VOLT        AND SAVE
* 
      LDA CHAN      COMPUTE 
      ADA .M1        BOX
      CLB             AND 
      DIV =D15         SLOT ADDRESS 
      IOR =B170160  OR BOX # INTO CONTROL WORD
      STA DBUFF      AND SAVE IN OUTPUT BUFFER
      CLA           MOVE SLOT ADDRESS 
      ASR 4          TO UPPER 4 BITS
      IOR VOLT      GENERATE OUTPUT 
      STA V.OUT      DATA WORD
      JSB WRITE     DO OUTPUT 
      JMP DAC,I     RETURN
      SKP 
WRITE NOP 
      JSB EXEC      *************************** 
      DEF *+6       PERFORM 
      DEF .2         NORMAL 
      DEF ILU          WRITE
      DEF DBUFF        WITH 
      DEF .2            GATE
      DEF .1        ************************* 
* 
      AND =B204     CHECK 
      SZA,RSS        FOR BAD STATUS BITS
      SZB,RSS         OR ZERO XMISSION LOG
      RSS 
      JMP WRITE,I   NO, RETURN
* 
*     ERRORS COME HERE
* 
      LDA DBUFF     CHECK THE TME 
      AND =B20       BIT
      SZA,RSS 
      JMP ER01
      XOR DBUFF     IF SET, THEN DO CALL
      STA DBUFF      OVER AGAIN WITHOUT TME 
      JSB WRITE       SO THAT THE BOX GETS CLEARED! 
* 
ER01  CLA,INA,RSS   YES, GIVE ERROR 1 
ER02  LDA .2        ENTRY FOR ERROR 2 
      STA ERNAM     SAVE ERROR NUMBER 
      JSB ERROR     CALL
      DEF *+3        BASIC'S
      DEF ERNAM       ERROR 
      DEF ERRMS        ROUTINE
      JMP DAC,I     RETURN
* 
*     CONSTANTS,TABLE, AND BUFFER 
* 
DBUFF NOP 
V.OUT NOP 
* 
* 
ERNAM EQU DBUFF 
ERRMS OCT 3         "DAC" ERROR MESSAGE 
      ASC 2,DAC 
* 
DEFLM DEF *+1 
      OCT 3777      VOLTAGE DAC UPPER BOUND 
      OCT 174000     AND LOWER BOUND
B7777 OCT 7777      CURRENT DAC UPPER BOUND 
      NOP            AND LOWER BOUND
      END 
                                                                                                                                                                                                                        