       REM           INDEXABLE BCD PRINT SUBROUTINE.
*THIS  SUBROUTINE USES THREE SYMBOLS, THEY ARE...
       REM           SPLAT, THE FIRST WORD OF THE ROUTINE
       REM           CI, USED FOR CARD IMAGE, 26 LOCATION
       REM           SUBET, THE CONTENTS OF XRC ARE STORED
       REM                     IN THE ADDRESS OF SUBET.
*CONDTION  OF THE ACC, MQ, AND ACC OVERFLOW
*TRIGGER  IS NOT GUARANTEED ON EXIT FROM THIS ROUTINE.
       REM           THE PRINTER ON CHANNEL A IS USED
       REM           YOU MAY ENTER SPLAT+1 IF YOU HAVE
       REM           ALREADY GIVEN WRIT SELECT.
       REM           THE RCHA INSTRUCTION IS AT SPLAT+60.
       REM           THERE IS NO CHANNEL DELAY IN THE
       REM           SUBROUTINE, THEREFORE TAKE CARE NOT
       REM           TO USE CI UNTIL AFTER 12 ROW-RIGTH
       REM           HAS BEEN WRITTEN. FOR THIS REASON,
       REM           YOU MUST GIVE WRS FOR EACH ENTRY
       REM           OR ENTER AT SPLAT.
SPLAT  WPRA          GET GOING
       SXA SPLAT+61,1
       SXA SPLAT+62,2
       SXA SUBET,4   SAVE ORGINAL XRC.
       NZT 1,4       IF CONTROL WORD ZERO.
       SPACE
*5
       TRA 2,4       RETURN
       CAL 1,4       GET NON-ZERO WORD
       SLW SPLAT+85  SAVE CONTROL WORD
       PDX 0,1       TYPE WHEEL NO.
       TXL SPLAT+65,1,0 IF DECR. ZERO, GET
       REM           NEW CONTROL WORD
       SPACE
*10
       SXD *+2,4     GET EXIT ADDRESS
       PAC 0,2       BY ADDING TWOS COMP.
       TXI *+1,2,0   OF N TO XRC.
       SXA SPLAT+63,2 EXIT VALUE.
       REM SET BIT INDEX TO STARTING WHEEL
       SXA *+3,1     FOR SHIFTING
       SPACE
*15
       AXT 1,3       1 TO XRA AND XRB
       CAL SPLAT+82  BIT INDEX TO P
       LGR 0,1       SHIFT TO STARTING POINT
       TNZ *+3       IF ACC IS ZERO, SET FOR
       STQ SPLAT+83  RIGHT ROW, AND MAKE
       SPACE
*20
       TXI *+2,2,1   XRB A DUECE
       SLW SPLAT+83  OTHERWISE, LEFT ROW.
       AXT 26,1
       STZ CI+26,1   CLEAR CARD IMAGE
       TIX *-1,1,1
       SPACE
       REM FORM CARD IMAGE.
       SPACE
*25
       TIX *+1,4,1   ADDRESS OF FIRST WORD.
       AXT 6,1       CHARACTER COUNT.
       LDQ 1,4       GET THE WORD.
       REM           SOME PEOPLE NEVER
       REM           DO, YOU KNOW
       SXA SPLAT+54,1 SAVE CHARACTER COUNT.
       PXD           CLEAR ACC
       SPACE 
*30
       LGL 2         ZONE
       ALS 1         TIMES 2
       PAX 0,1
       SXA SPLAT+45,1 FOR FUTURE REFERENCE.
       CLM
       SPACE
*35
       LGL 4         DIGIT
       ALS 1         TIMES 2
       SLW CI        TEMP0
       CAL SPLAT+83  BIT INDEX
       NZT CI        IS DIGIT ZERO.
       SPACE 
*40
       TXH SPLAT+80,1,0 IS ZERO ZONE TOO.
       LXA CI,1      OK, PROCEED
       TXH SPLAT+48,1,24 CHECK FOR ILLEGAL
       TXH SPLAT+78,1,20 SPECIAL CHARACTER.
       ORS* SPLAT+92,2 XRB PICKS LEFT OR RIGHT.
       SPACE
*45
       AXT 0,1       ZONE AGAIN.
       TXL *+2,1,0   NOTHING FOR ZERO ZONE
       ORS* SPLAT+90,2 PLACE ZONE BIT.
       SPACE
       REM  COLUMN SET.
       SPACE
       ARS 1         SET BIT INDEX TO 
       TNZ *+4       NEXT COLUMN, IF ANY.
       SPACE
*50
       TXH SPLAT+60,2,1 IF BX ZERO,+XRB 1, STOP
       SPACE
       CAL SPLAT+82  IF NOT, SET TO RIGHT
       TXI *+1,2,1   ROW AND PROCEED.
       SLW SPLAT+83  BX READY FOR NEXT COLUMN.
       AXT 0,1       MORE CHARACTERS.
       SPACE 
*55
       TIX SPLAT+28,1,1 NEXT COLUMN
       LXA SPLAT+85,1 MORE WORDS MAYBE.
       TNX *+3,1,1    IF NOT, STOP.
       SXA SPLAT+85,1 YUMMY, GO GET EM.
       TXI SPLAT+25
       SPACE
       REM FIFTEEN MEN ON A DEAD MANS CHEST.
       SPACE
*60
       RCHA SPLAT+84  LET HER RIP
       AXT 0,1
       AXT 0,2
       AXT 0,4
       TRA 2,4         EXIT
       SPACE 2
       REM  GET NEW CONTROL WORD FROM SOMPLACE
       SPACE 2
*65
       SXA SPLAT+63,4 FOR EXIT
       LXA SPLAT+61,1 RESTORE XRA
       NZT* SPLAT+85 IF CONTROL WORD ZERO
       TRA SPLAT+61  RETURN.
       CAL SPLAT+85  OLD CONTROL WORD
       SPACE
*70
       STT *+1       BRING OUT INDEX
       SXD *+2,0     REGISTER, IF ONE IS TAGED.
       PAC 0,4
       TXI *+1,4,0   GET EFFECTIVE ADDRESS.
       CAL 0,4       NEW CONTROL WORD.
       SPACE
*75
       PDX 0,1       TYPE WHEEL ID.
       SLW SPLAT+85
       TXI SPLAT+14,4,1 PROCEED
       SPACE
       REM YOUR AN OLD SMOOOTHY.
       SPACE
       ORS* SPLAT+88,2 PUT EIGTH IN, TAKE
       TIX SPLAT+44,1,16 16 OUTM, - GOOD BUSINESS
       SPACE 
*80
       TXL SPLAT+47,1,4 IF NOT BLANK, SET ZONE.
       TRA SPLAT+48    BLANK.
       SPACE
       MZE             FOR BIT INDEX.
       HTR             DYNAMIC BIT INDEX.
       IOCD CI+2,,24   BUFFER COMMAND
       SPACE 
*85
       HTR             SPECIAL SALON FOR
       REM             THE CONTROL WORD
       HTR CI+5
       HTR CI+4        BROW ADDRESSES
       HTR CI+27,1
       HTR CI+26,1     ZONE ROW ADDRESSES
       SPACE
*90  
       HTR CI+21,1
       HTR CI+20,1     DIGIG ROW ADDRESSES
       SPACE
CI     BSS 26
SUBET  BSS 1
       SPACE
       REM   TO WRITE PUNCH, USE TSX CRNCH,4.
       SPACE
CRNCH  WPUA
       TRA SPLAT+1
       SPACE
IOC    EQU 2892
CTX    EQU 2890
IOCT   EQU 2883
CTRL1  EQU 2880
CTRL2  EQU 2881
CTRL3  EQU 2882
       END
