ASMB,R,B,L,C
* 
* 
      HED GENERAL PURPOSE REGISTER RTE DEVICE SUBROUTINE 7/74 
      NAM GPR,7    09601-16001 REV.A  740715
      ENT GPRSB,GPRMB,GPRIO 
* 
* 
* 
*     THIS SUBROUTINE OPERATES THE FOLLOWING I/O CARDS IN 
*     AN RTE ENVIRONMENT USING DVR62. 
* 
*     12554    16-BIT DUPLEX REGISTER 
*     12597     8-BIT DUPLEX REGISTER 
*     12566    16-BIT MICROCIRCUIT DUPLEX REGISTER
*     12930    16-BIT UNIVERSAL INTERFACE 
*     12551    16-BIT RELAY OUTPUT REGISTER 
* 
* 
************************************************
*                                              *
*       SOURCE TAPE:     09601-18001           *
*       RELOC. TAPE:     09601-16001           *
*       ERS:           A-09601-16001-1         *
*       LISTING:       A-09601-16001-2         *
*                                              *
************************************************
* 
*         W.M.PARRISH     7/74  REV.A       
* 
* 
* 
      SPC 3 
* 
*                  EXTERNALS
* 
      EXT ERROR,#ERRU,ERRCD 
      EXT EXEC
      EXT .ENTR 
      EXT #GPRN,#GPRT 
      EXT FLOAT 
      EXT CONV,BCD6 
      EXT .RND
      EXT .DST
      SKP 
*   THE FOLLOWING CALLS ARE AVAILABLE TO THIS SUBROUTINE: 
* 
*   GPRSB(U,F,P,S)
* 
*       U = UNIT NUMBER (1 TO NUMBER OF UNITS)
*       F = FUNCTION SELECT (0 TO 3)
*           0 = INPUT STATE OF SPECIFIED BIT
*           1 = OUTPUT STATE OF SPECIFIED BIT OR'D WITH P 
*               PREVIOUS PROGRAM WORD.
*           2 = OUTPUT STATE OF SPECIFIED BIT ALL OTHER BITS 0. 
*           3 = OUTPUT STATE OF SPECIFIED BIT ALL OTHER BITS 1. 
*       P = POSITION OF BIT IN WORD ( 0 THROUGH 15 ). 
*       S = STATE OF BIT SPECIFIED BY P (0=FALSE, 1=TRUE) 
* 
************************************************************
* 
*   GPRMB(U,F,B)
* 
*       U = UNIT NUMBER (1 TO # OF UNITS) 
*       F = FUNCTION SELECT 
*            0 = INPUT INTEGER WORD 
*            1 = OUTPUT INTEGER WORD
*            2 = INPUT BCD
*            3 = OUTPUT BCD 
*       B = BIT PATTERN 
* 
************************************************************
* 
*  GPRIO(U,F,A,B) 
* 
*       U = UNIT NUMBER (1 TO NUMBER OF UNITS)
*       F = FUNCTION SELECT 
*           0 = WORD OUT / WORD IN
*           1 = WORD OUT / BCD IN 
*           2 = BCD  OUT / WORD IN
*           3 = BCD  OUT / BCD  IN
*       A = WORD TO WRITE OUT 
*       B 	= WORD TO READ IN ON INTERRUPT 
* 
************************************************************
* 
      SKP 
* 
*     SINGLE - BIT ENTRY
* 
UNITS BSS 1 
FUNS  BSS 1 
BIT   BSS 1 
STATE BSS 1 
GPRSB NOP 
      JSB .ENTR         GET PARAMETER ADDRESS 
      DEF UNITS 
      CLA 
      STA ERRCD 
      LDA GPRSB 
      STA GPRMB         SAVE RETURN ADDRESS 
      LDA UNITS,I 
      JSB CUNIT         CHECK UNIT NUMBER FOR VALIDITY
      JSB RCONF         READ CONFIG. INFO FROM TABLE
      LDB .15 
      LDA BIT,I 
      JSB IPROC         CHECK IF BIT POSITION > 15. 
      STA BPOS
      LDA .1
      JSB ROTAT         COMPUTE BIT MASK
      STA BMASK         ... AND SAVE IT.
      LDB .3            MAX VALID FUNCTION #
      LDA FUNS,I
      SZA,RSS           FUNCTION=0? 
      JMP SINP          YES, SINGLE BIT INPUT 
      JSB IPROC         CHECK IF FUNCTION > 3 
      LDB .1
      LDA STATE,I 
      JSB IPROC         CHECK STATE (0 OR 1?) 
      SZA               ZERO? 
      LDA BMASK         ONE 
      STA BSTAT 
      LDA FUNS,I
      CLB 
      CPA .2            RESET?
      STB PWA,I         YES 
      CCB               SET?
      CPA .3
      STB PWA,I         YES 
      LDA BMASK         COMPUTE OUTPUT WORD 
      CMA 
      AND PWA,I         MASK-OUT BIT IN WORD
      ADA BSTAT         ADD NEW STATE 
      STA PWA,I         THIS WORD OUT, SAVE IN TABLE. 
      JSB WRITE         OUTPUT WORD 
      JMP GPRMB,I       RETURN
SINP  JSB IN            READ ONE WORD 
      AND BMASK         ISOLATE BIT 
      SZA               IS IT ON? 
      LDA .1            YES, RETURN A 1 
      STA STATE,I       RETURN ANSWER (0 OR 1)
      JMP GPRMB,I       RETURN
      SKP 
* 
*      MULTIPLE - BIT   CONTROL 
* 
UNITA BSS 1 
FUNA  BSS 1 
PATN  BSS 1 
GPRMB NOP 
      JSB .ENTR 
      DEF UNITA 
      CLA 
      STA ERRCD 
      LDA UNITA,I 
      JSB CUNIT         CHECK UNIT NUMBER 
      JSB RCONF         GET CONFIG INFO FROM TABLE
      LDB .3            MAX VALID FUNCTION
      LDA FUNA,I
      JSB IPROC         CHECK FUNCTION
      SLA,RSS           INPUT OR OUTPUT?
      JMP IN16          INPUT 
      LDB PATN,I
      CPA .3
      JSB TOBCD 
      STB 0 
      JSB WRITE 
      STA PWA,I         UPDATE PREV WORD THIS UNIT. 
      JMP GPRMB,I 
IN16  JSB IN            READ A WORD 
      LDB 0             PUT IT IN B REGISTER
      LDA FUNA,I        GET FUNCTION CODE 
      CPA .2            IS IT 2?
      JSB TOOCT         YES, BCD... CONVERT TO OCTAL
      STB PATN,I        RETURN THIS VALUE.
      JMP GPRMB,I       RETURN. 
      SKP 
* 
*     ENTRY TO WRITE, THEN READ ON INTERRUPT! 
* 
UNITB BSS 1 
FUNB  BSS 1 
PTNA  BSS 1 
PTNB  BSS 1 
GPRIO NOP 
      JSB .ENTR 
      DEF UNITB 
      CLA 
      STA ERRCD 
      LDA GPRIO 
      STA GPRMB           STORE RETURN ADDRESS
      LDA UNITB,I 
      JSB CUNIT           CHECK UNIT NUMBER 
      JSB RCONF           GET CONFIG. INFO FROM TABLE 
      LDB .3              MAX VALID FUNCTION CODE 
      LDA FUNB,I
      JSB IPROC           CHECK VALIDITY OF FUNCTION
      LDB PTNA,I
      ARS 
      SLA                 BCD OUT?
      JSB TOBCD          YES, CONVERT TO BCD. 
      STB WORD1 
      STB PWA,I          UPDATE PREV WORD/THIS UNIT.
      JSB OUTIN          WRITE, THEN READ.
      LDB WORD2 
      LDA FUNB,I
      SLA                BCD COMING IN? 
      JSB TOOCT          YES, CONVERT.
      STB PTNB,I         RETURN RESULT
      JMP GPRMB,I        RETURN.
      SKP 
* 
*         SUBROUTINE TO CHECK UNIT NUMBER 
*         CALLING SEQUENCE: 
*         LDA <UNIT>
*         JSB CUNIT 
* 
*         RESULT:         INVALID UNIT #   - >   ERROR 2
*                         VALID UNIT #      - > <UNIT> -> UNIT
* 
CUNIT NOP 
      STA UNIT
      CMA,INA 
      ADA #GPRN 
      SSA                    TOO LARGE? 
      JMP ERR2               YES
      LDA UNIT
      CMA,INA                ZERO OR NEGATIVE?
      SSA,RSS 
      JMP ERR2               YES
      JMP CUNIT,I 
* 
*       SUBROUTINE TO READ CONFIGURATION INFO FROM EXTERNAL TABLE.
* 
RCONF NOP 
      LDA TBLDF      GET DEF TO START OF TABLE
      SSA,RSS        I-BIT SET? 
      JMP *+4        NO 
      AND MASK       YES, STRIP OFF I BIT 
      LDA 0,I        CHAIN THROUGH INDIRECT LINK
      JMP *-4        AND CHECK AGAIN
      STA TBLAD      STORE SA OF TABLE
      LDA UNIT       UNIT NUMBER
      ADA M1         -1 
      MPY .3         OFFSET TO START OF INFO FOR THIS UNIT. 
      ADA TBLAD      A <- START OF TABLE THIS UNIT. 
      LDB 0,I 
      STB LU         LOGICAL UNIT NUMBER
      INA 
      LDB 0,I 
      STB CNFG       CONFIG INFO. 
      INA 
      STA PWA        PTR TO PREV. WORD/THIS UNIT. 
      LDB 0,I 
      JMP RCONF,I   RETURN
      SKP 
* 
*      ONE-WORD INPUT ROUTINE 
* 
IN    NOP      READ A WORD, MASK IF 8-BIT CARD, RETURN IT IN A REG. 
      LDA CNFG
      AND .1
      SZA 
      JMP ERR3          READ NOT ALLOWED ON THIS CARD.
      JSB EXEC
      DEF *+5 
      DEF .2            DVR62 ALWAYS USES WRITE-CALLS.
      DEF LU            LOGICAL UNIT NUMBER 
      DEF RQBF          READ QUEUE BUFFER.
      DEF .1            NUMBER OF ENTRIES 
      LDA CNFG
      AND .2
      SZA,RSS 
      JMP IN1          16-BIT CARD
      LDA INWD         8-BIT CARD 
      AND B377         MASK LOWER EIGHT.
      STA INWD
      JMP IN,I
IN1   LDA INWD
      JMP IN,I
RQBF  DEC 4 
      DEC 1 
      DEF INWD
INWD  BSS 1           INPUT BUFFER
      SKP 
* 
*       WRITE-OUT THE WORD IN THE A-REGISTER
*             (8-BITS FOR 8-BIT CARD) 
* 
WRITE NOP 
      STA OTWD
      JSB CKENC      SET WQBUF FOR ENCODE/NO ENC. 
      LDA CNFG
      AND .2
      SZA,RSS 
      JMP WR1   16-BIT CARD 
      LDA OTWD
      AND B377  8-BIT MASK
      STA OTWD
WR1   JSB EXEC
      DEF *+5 
      DEF .2       WRITE REQUEST
      DEF LU       LOGICAL UNIT NUMBER
      DEF WQBUF    WRITE QUEUE BUFFER 
      DEF .1       # OF ENTRIES 
      LDA OTWD
      JMP WRITE,I 
WQBUF DEC 3         TYPE 3 (READ) 
      DEC 1         OUTPUT 1 WORD 
      DEF OTWD      OUTPUT BUFFER 
OTWD  BSS 1 
* 
*      CHECK CONFIG TABLE FOR ENCODE OR FREE RUN
* 
CKENC NOP          ENTRY
      LDA CNFG
      AND .4
      SZA,RSS     BIT 2 ON? 
      JMP NENC    NO, - > NO ENCODE 
      LDA .1
      STA WQBUF+1 STORE A 1 IN QUEUE BUFF.
      JMP CKENC,I  RETURN 
NENC  CLA 
      STA WQBUF+1   STORE A 0 IN QUEUE BUFF.
      JMP CKENC,I   RETURN
      SKP 
* 
*      CHECK TO SEE IF A PARAMETER IS BETWEEN 0 AND 
*      A MAXIMUM VALUE, INCLUSIVE.
*           B REG CONTAINS MAX VALUE (DESTROYED)
*           A REG CONTAINS COMP. VALUE (PRESERVED)
* 
IPROC NOP 
      SSA 
      JMP ERR1       <0      ERROR
      CMB 
      ADB 0 
      SSB,RSS 
      JMP ERR1       > MAX   ERROR
      JMP IPROC,I 
* 
*           ERROR HANDLING
* 
ERR1  LDA .1      GENERAL PARAMETER ERROR 
      JMP ERR 
ERR2  LDA .2      ERROR ON UNIT # 
      JMP ERR 
ERR3  LDA .3      READ FROM WRITE-ONLY CARD 
      JMP ERR 
ERR4  LDA .4      BCD CONVERSION ERROR
ERR   STA ERRCD 
      JSB ERROR 
      DEF *+5 
      DEF ERRCD 
      DEF MNEM
      DEF #ERRU 
      DEF GPRMB 
      JMP GPRMB,I 
MNEM  DEC 3 
      ASC 2,GPR 
      SKP 
* 
*      CONVERT A WORD TO BCD
* 
TOBCD NOP           NUMBER TO BE CONVERTED IN B REGISTER
      SSB 
      JMP ERR1       NUMBER IS NEGATIVE 
      LDA CNFG
      AND .2
      SZA,RSS       8 OR 16 BIT CARD? 
      JMP TB16      16-BIT CARD!!!
      LDA 1         8-BIT 
      CMA,INA 
      ADA .99 
      SSA           TOO-BIG FOR 8-BIT?
      JMP ERR4
      JMP TB         NO, CONVERT
TB16  LDA 1          16-BIT 
      CMA,INA 
      ADA .9999 
      SSA           TOO-BIT FOR 16-BIT? 
      JMP ERR4      YES 
TB    LDA 1 
      CLB 
      JSB FLOAT        TO FL. PT. 
      DST TEMP
      JSB BCD6      CONVERT TO BCD
      DEF *+3       RETURN ADDRESS
      DEF TEMP      ADDRESS OF DATA 
      DEF TEMP
      LDB TEMP      RETURN BCD IN B REG.
      JMP TOBCD,I 
* 
*      CONVERT BCD TO AN OCTAL WORD.
* 
TOOCT NOP 
      STB 0 
      CLB,INB 
      BLF,BLF     SET UP B REG FOR 'CONV' 
      JSB .DST
      DEF TEMP
      JSB CONV      BCD TO F.P. 
      DEF *+2 
      DEF TEMP
      JSB .RND       F.P. TO INTEGER
      LDB 0 
      JMP TOOCT,I    RETURN 
      SKP 
* 
*      SUBROUTINE TO WRITE A WORD AND READ ANOTHER ON INTERRUPT.
*      WORD1    - >     OUT 
*      WORD2    < -     IN
* 
OUTIN NOP 
      LDA CNFG
      AND .1
      SZA 
      JMP ERR3      READ NOT ALLOWED
      LDA CNFG      CHECK IF 16 OR 8 BIT
      AND .2
      SZA,RSS      16-BIT CARD? 
      JMP OT1 
      LDA WORD1 
      AND B377    MASK LOWER 8
      STA WORD1 
OT1   JSB EXEC
      DEF *+5 
      DEF .2      WRITE REQUEST (ALWAYS FOR DVR62)
      DEF LU      LOGICAL UNIT NUMBER 
      DEF WRQBF   WRITE-READ-QUEUE-BUFFER 
      DEF .1      NUMB. ENTRIES 
      LDA CNFG
      AND .2
      SZA,RSS    8-BIT CARD 
      JMP OTEX   NO, 16 BIT 
      LDA WORD2 
      AND B377    MASK LOWER 8
      STA WORD2 
OTEX  LDA WORD2 
      JMP OUTIN,I 
* 
*  WRITE QUEUE BUFFER 
* 
WRQBF DEC 5       OUTPUT AND INPUT ON INTERRUPT CODE
      DEC 1       NUMBER OF OPERATIONS
      DEF WORD1   POINTER TO OUTPUT BUFFER
      DEF WORD2   POINTER TO INPUT  BUFFER
WORD1 BSS 1 
WORD2 BSS 1 
      SKP 
* 
*     ROTATE A NO. OF TIMES SPECIFIED IN BPOS 
* 
ROTAT NOP 
      LDB BPOS
      CMB,INB 
ROT10 SSB,INB,RSS 
      JMP ROTAT,I *EXIT 
      RAL 
      JMP ROT10 
      SPC 5 
* 
*     CONSTANTS AND STORAGE 
* 
TEMP  BSS 2 
BPOS  BSS 1 
BMASK BSS 1 
BSTAT BSS 1 
PWA   BSS 1 
LU    BSS 1 
TBLDF DEF #GPRT 
UNIT  BSS 1 
TBLAD BSS 1 
CNFG  BSS 1 
* 
* 
M1    DEC -1
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.15   DEC 15
.99   DEC 99
.9999 DEC 9999
B377  OCT 377 
MASK  OCT 77777 
      END 
                                                                                                                                                                      