ASMB,R,L,C,F,B
      HED ISA EVENT SENSE    A-92413-16008 REV. A 
* 
* EVSNS -   EVENT  SENSE  DEVICE SUBROUTINES FOR HP6940A
* 
* SOURCE TAPE 92413-18008 
* RELOC. TAPE 92413-16008 
* 
* 
* 
* 
      NAM EVSNS,7  92413-16008A  07MAY75
      ENT MPNRM,EVSNS 
      EXT .ENTR,&6940,#GET!,EXEC
      EXT $LIBR,$LIBX 
      SUP 
* 
* 
*  EVSNS SETS UP A BIT/PROG DEFINTITON AND ENABLES SENSE MODE 
*  FOR THE HP6940.  PARAMETERS ARE CHANNEL, NUMBER OF OUTPUT
*  BIT, VALUE OF OUTPUT BIT, PROG   USED BY EVSNS CALL, AND 
*  ERROR RETURN.  ERR=1 IS NORMAL: 2 IS TIMEOUT: 3 IS BAD 
*  CHANNEL OR BIT ADDRESS.
* 
* 
      SKP 
CHANL NOP           OUTPUT CHANNEL
NBIT4 NOP           NUMBER OF OUTPUT BIT (0-11) 
BIT4  NOP           VALUE OF OUTPUT BIT 
PROG  NOP           PROG   USED BY "EVSNS" CALL 
ERR   NOP 
EVSNS NOP           ENTRY POINT 
      JSB .ENTR 
      DEF CHANL 
      CLA,INA       CLEAR ERROR PARAMETER 
      STA ERR,I 
      LDA CHANL,I 
      JSB TABLE 
* 
      LDA TYPE      EVENT SENSE 
      CPA .1         OR 
      RSS             DIGITAL 
      JMP DIGIN        INPUT CARD?
* 
      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 B          OF COMPLEMENT OF BIT MASK
      CMB             AND BIT TO BE WRITTEN 
      AND B7777    MASK AND STORE LOWER 
      STA OR         12 BITS OR "OR" WORD 
      STB AND       SAVE "AND" WORD 
      CMB           COMPLEMENT AND
      STB NAND       SAVE NAND WORD 
* 
      LDA ADR       COMPUTE ADDRESS 
      ADA REL#       OF OUTPUT
      STA ADRS         ENTRY AND SAVE 
      SKP 
      JSB CLEAR     CLEAR SENSE BIT 
      LDB PROG,I    GET PROGRAM 
      LDA ADRS,I     AND GET THE PROGRAM
      CPA .M1         BEEN USED YET?
      JSB RESET     NO, GET REAL STATUS 
* 
      AND NAND      GET BIT TO BE SENSED
      SWP 
      CPB OR        COMPARE NEW AND OLD STATUS
      IOR BIT15      IF EQUAL SET BIT 15
      STA PROG        SAVE THE PROGRAM FOR LATER
* 
* 
*     COMPUTE ADDRS IN BIT/PROG(PROG) TABLE 
* 
      CCA           COMPUTE 
      ADA REL#      ADDR
      MPY .12         IN
      ADA ADR,I        BIT/PROG 
      ADA NBIT4,I       TABLE 
      INA 
      STA ADR 
* 
*     IF THE FIRST CHAR IS A NULL (0'S) THEN GIVE ERR3
*      (NULL FIRST CHAR IS A BASIC TRAP NUMBER! ) 
* 
* 
UPDAT LDA PROG
      SZA,RSS 
      JMP *+4 
      AND UPMSK     SEE IF
      SZA,RSS        BASIC, 
      JMP ERR3      IF SO, GIVE ERROR 
      AND =B77777 
      CPA ASC0      COMPARE TO
      RSS            ASCII ZERO 
      JMP *+3 
      CLA           IF SO, MUST MEAN
      STA PROG       TO CLEAR PROG ENTRY
* 
      JSB $LIBR     TURN OFF INTERRUPTS 
      NOP 
      LDB PROG      GET NEW PROG
      STB ADR,I        SAVE IN BIT/PROG TABLE 
      JSB $LIBX     TURN BACK ON INTERRUPTS 
      DEF *+1 
      DEF *+1 
* 
*     TIME TO LEAVE 
* 
      LDA EVSNS 
      STA CLEAR 
      LDA LU
      XOR B2100 
      JMP CLEAR+3 
      SKP 
* 
*     GET TABLE VALUES
* 
TABLE NOP 
      JSB #GET!     GET TABLE VALUES
LU    NOP           STORAGE 
TYPE  NOP            FOR
REL#  NOP             TABLE 
ADR   NOP              VALUES 
      SSB           ERROR?
      JMP ERR3      CHAN OUT OF RANGE 
* 
      CLB 
      ADA .M1 
      DIV .15 
      BLF,BLF       MOVE SLOT 
      BLF            TO MSB'S 
      STB SLOT        AND STORE 
      JMP TABLE,I 
      SKP 
* 
*     THIS ROUNTINE GETS THE EXTERNAL WORD FOR STATUS 
* 
RESET NOP 
      JSB EXEC
      DEF *+6       READ
      DEF .1         EXTERNAL 
      DEF LU          WORD
      DEF IBUFF        WITHOUT
      DEF .5             A
      DEF .2             GATE 
* 
      AND B204
      SZA,RSS       CHECK FOR BAD STATUS BITS 
      SZB,RSS        OR ZERO XMISSION LOG 
      JMP ERR2        DEVICE ERROR
* 
      LDA =B170140  PUT OUTPUT CNTL WORD
      STA OBUFF      INTO THE BUFFER
      LDA IWORD     GET WORD
      AND B7777      MASK LOWER BITS
      IOR SLOT        STICK IN SLOT 
      STA OBUFF+1      SAVE 
* 
*     OUTPUT STATUS TO TABLE
* 
      JSB $LIBR     TURN OFF INTERRUPTS 
      NOP 
      STA ADRS,I
      JSB $LIBX     TURN ON INTERRUPT SYSTEM
      DEF *+1 
      DEF *+1 
* 
*     MAKE THE REFERENCE WORD THE EXTERNAL STATUS AND RETURN
* 
      JSB WRITE 
      LDA OBUFF+1   RESTORE 
      LDB PROG,I     REGISTERS
      JMP RESET,I 
* 
*     WRITE ROUNTINE
* 
WRITE NOP 
      JSB EXEC      WRITE 
      DEF *+6        STATUS 
      DEF .2          TO
      DEF LU           EVSNS
      DEF OBUFF         CARD
      DEF .2             WITH 
      DEF .1              HANDSHAKE 
* 
      AND B204      CHECK FOR 
      SZA,RSS        BAD STATUS BITS
      SZB,RSS         OR ZERO XMISSION LOG
      JMP ERR2
      JMP WRITE,I 
* 
*     CONSTANTS 
* 
M12   DEC -12 
.M1   DEC -1
.0    DEC 0 
.3    DEC 3 
.5    OCT 5 
.8    DEC 8 
.12   DEC 12
.15   DEC 15
* 
B204  OCT 204 
B2100 OCT 2100
B7777 OCT 7777
UPMSK OCT 177400
BIT15 OCT 100000
ASC0  OCT 30000 
* 
*     INPUT BUFFER
* 
IBUFF DEC 2 
      OCT 170640
SLOT  NOP 
.1    DEC 1 
IWORD NOP 
* 
*     OUTPUT BUFFER 
* 
OBUFF OCT 170140
      NOP 
* 
NAND  NOP 
      SKP 
* 
*     DIGIN 
* 
DIGIN CPA .2        IF DIG IN CHAN
      JMP CLR        SKIP NEXT PART 
* 
      CPA .8         IF NOT COUNTER 
      RSS 
      JMP ERR3       CHANNEL ERROR
      LDA .M1       GET 
      ADA REL#       THE
      ADA ADR         DIGITAL 
      LDA 0,I          INPUT
      CMA,INA           CHANNEL 
      JSB TABLE         INFO
CLR   JSB CLEAR 
* 
*     ENABLE DIGITAL INPUT CARD 
* 
      LDA =B170240
      STA OBUFF 
      LDA SLOT
      STA OBUFF+1 
      JSB WRITE 
* 
*     COMPUTE ADDR
* 
      CCA           FIND
      ADA ADR        THE TABLE
      ADA REL#        ADDRESS 
      STA ADR 
      LDB PROG,I
      STB PROG
      JMP UPDAT 
      SKP 
* 
* #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 A         IF BIT
      ADB M12       IF BIT NUMBER 
      SSA,RSS        IS NEGATIVE
      SSB,RSS         OR GREATER THAN 11
      JMP ERR3         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
* 
PTR   NOP           TABLE POINTER 
ADR1  NOP 
ADR2  NOP           ADDR OF EV BUFF(PROG NAMES) 
TOP   DEF &6940 
#EVNT NOP 
* 
MPNRM NOP 
      ISZ MPNRM 
      LDA TOP       GET BASE PAGE LINK
      SSA,RSS        AND CHECK FOR INDIRECT 
      JMP *+4         NO,ITS OK 
      ELA,CLE,ERA   STRIP INDIRECT BIT
      LDA A,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       AND SAVE POINTER 
      LDA 1,I       MAKE # EVSNS CARDS
      CMA,INA        NEGATIVE 
      STA TME         AND SAVE
      CMA,INA       MAKE POSITIVE AGAIN 
      MPY .12        MULTIPLY BY 12,
      LDB ADR1        GET ADDRESS AGAIN 
      ADB .2           BUMP BY TWO TO 
      ADA 1,I           ADD # OF DIG IN 
      CMA,INA,SZA,RSS MAKE COUNT NEGATIVE 
      JMP NEXT       AND IF ZERO TRY AGAIN
      STA #EVNT     SAVE THE COUNT
      ISZ ADR1      GET THE EVENT 
      LDA ADR1,I     BUFFER 
      SZA,RSS         IF ZERO,
      JMP NO.EV        TRY DIG IN 
      INA           BUMP THE ADDRESS TO SKIP
      STA ADR2       THE DEF, AND SAVE IT 
      JSB CLEAR     CLEAR SENSE BIT 
* 
* 
*     CLEAR BIT/PROG ENTRIES
* 
      CCB 
      JSB $LIBR CLEAR INTERRUPT 
      NOP            AND FENCES 
      LDA ADR2
NRM1  STB A,I       CLEAR ENTRY 
      INA           BUMP POINTER
      ISZ TME       DONE? 
      JMP NRM1       NO,CONTINUE
      CLB 
NRM2  STB A,I 
      INA 
      ISZ #EVNT 
      JMP NRM2
      JSB $LIBX     RETURN SYSTEM 
      DEF *+1        TO ORG STATE 
      DEF *+1 
* 
NEXT  ISZ PTR       BUMP ADR
      JMP LOOP1     AND CONTINUE
* 
*     IF NO EVENT, TRY DIGITAL INPUT
* 
NO.EV LDA ADR1      GET POINTER 
      ADA .2         BUMP POINTER 
      LDA 0,I         GET BUFFER ADDR 
      SZA,RSS       NO DIG? 
      JMP NEXT       TRY NEXT 6940
      CLB 
* 
      JSB $LIBR     TURN OFF INTERRUPTS 
      NOP 
NRM3  STB 0,I 
      INA 
      ISZ #EVNT 
      JMP NRM3
      JSB $LIBX 
      DEF *+1 
      DEF NEXT      TRY NEXT
*     CLEAR SENSE BIT 
* 
CLEAR NOP 
      LDA LU
      IOR B2100 
      STA CNTL
      JSB EXEC
      DEF *+3 
      DEF .3
      DEF CNTL
      JMP CLEAR,I 
      SKP 
* 
*     ERRORS
* 
ERR3  ISZ ERR,I         ERROR # 3 
ERR2  ISZ ERR,I        ERROR # 2
      JMP EVSNS,I   RETURN
* 
*     WHAT'S EQUAL TO WHAT
* 
A     EQU 0 
B     EQU 1 
OR    NOP           OUTPUT "OR" WORD
AND   EQU OBUFF+1   OUTPUT "AND" WORD 
TME   NOP 
ADRS  EQU MPNRM 
CNTL  EQU CHANL 
.2    DEC 2 
      END 
                                                                                                                                                                                                                                                          