*ASM            OCTOGRAM      T. FALLON    JANUARY  1971
                          ABS
                          ORG     /500
                    START BSI  L  SETSC           INITIALIZE SELECTOR
                          LDX  L2 MYNAM           TYPE MY NAME
                          BSI  L  MESS
                    *
                    *             R E A D   I N   T E X T
                    *
                    READ  LDX  L1 RDCDS
                          BSI  L  READR
                          LD   L  RDINT
                          BSC  L  PRINT,E         CHECK FOR LAST CARD
                    *
                          LDX   1 3               CHECK FOR END CARD
                    COMP  LD   L1 CARD-1
                          CMP  L1 END-1
                          NOP
                          MDX     NOTEQ
                          MDX   1 -1
                          MDX     COMP
                          MDX     ENDCD
                    *
                    NOTEQ LD   L  MAXSZ           CHECK FOR FULL BUFFER
                          BSC  L  READ,&
                          MDX  L  MAXSZ,-1
                          MDX     GOOD
                          LDX  L2 OVFLO
                          BSI  L  MESS            SEND OVERFLOW MESSAGE
                          BSC  L  EXIT&2
                    *
                    GOOD  BSI  L  CONCD           CONVERT CARD
                          LDX  L1 CARD
                          LDX  L2 BUFF
                          MDX  I2 INDX
                          LDX   3 64
                          BSI  L  BTOE
                          MDX  L  INDX,32
                          MDX     READ
                    *
                    *             P R O C E S S   I D   C A R D S
                    *
                    ENDCD LDX  L1 RDCDS
                          BSI  L  READR
                          LD   L  RDINT
                          BSC  L  EXIT,E
                    *
                          BSI  L  CONCD           CONVERT CARD
                          LDX  L1 CARD
                          LDX  L2 CARD
                          LDX   3 64
                          BSI  L  BTOE
                    *
                          LD   L  CARD            CONVERT NUMBER TO BINARY
                          SRA     8
                          AND  L  MSK1
                          M    L  HUND
                          SLT     16
                          STO  L  PTBUF
                          LD   L  CARD
                          AND  L  MSK1
                          M    L  TEN
                          SLT     16
                          STO  L  PTBUF&1
                          LD   L  CARD&1
                          SRA     8
                          AND  L  MSK1
                          A    L  PTBUF
                          A    L  PTBUF&1
                          A    L  ONE
                          SRA     1
                          STO  L  PAGES
                    *
                          SLT     3
                          BSI  L  CLBUF
                          LDX   1 25              MOVE ID TO PTBUF
                    MOVID LD   L1 CARD-1
                          STO  L1 PTBUF&4
                          STO  L1 PTBUF&36
                          MDX   1 -1
                          MDX     MOVID
                          LD   L  ASTSK
                          STO  L  PTBUF&32
                          LD   L  ASTSK&1
                          STO  L  PTBUF&33
                    *
                          MDX  L  IDCNT,1         CONVERT ID SEQUENCE NUMBER
                          LD   L  IDCNT
                          SRT     6
                          OR   L  EZRO
                          STO  L  PTBUF&2
                          STO  L  PTBUF&64
                          SLA     16
                          SLT     3
                          SLA     5
                          OR   L  EZRO
                          STO  L  PTBUF&3
                          STO  L  PTBUF&65
                    *
                          BSI  L  RESPG
                          LDX   1 40              PRINT ID PAGE
                          STX  L1 MAXSZ
                    PTAGN LDX  L1 PRNT
                          BSI  L  PRNTR
                          MDX  L  MAXSZ,-1
                          MDX     PTAGN
                    *
                    *             P R I N T   O C T O G R A M
                    *
                    PRINT BSI  L  RESPG           INITIALIZE NEW PAGE
                          BSI  L  CLBUF
                          LD   L  INDX
                          STO  L  SIZE
                          LDX  L1 BUFF-1
                          STX   1 LOAD&1
                    NEWLN LDX   1 32              INITIALIZE NEW LINE
                          LDX   2 32
                    LOAD  LD   L1 0               MOVE LINE
                          CMP  L  EBLKS           CHECK FOR BLANKS
                          NOP
                          MDX     NONBL
                          MDX   2 -1
                          MDX     NONBL
                    *
                          LDX  L1 SPACE           SKIP BLANK LINE
                          BSI  L  PRNTR
                          MDX     ENLIN
                    *
                    NONBL STO  L1 PTBUF-1         MOVE NON BLANKS
                          STO  L1 PTBUF&33
                          MDX   1 -1
                          MDX     LOAD
                    *
                          LDX  L1 PRNT            PRINT ONE LINE
                          BSI  L  PRNTR
                    *
                    ENLIN MDX  L  LOAD&1,32       CHECK FOR END OF PAGE
                          MDX  L  SIZE,-32
                          MDX     NEWLN
                    *
                          MDX  L  PAGES,-1        CHECK FOR END OF ID
                          MDX     PRINT
                          LD   L  RDINT
                          BSC  L  EXIT,E
                          BSC  L  ENDCD
                    *
                    EXIT  BSI  L  RESPG
                          LDX   1 0
                          BSI  I  7               RETURN TO SYSTEM
                    *
                    *             SUBROUTINE TO SETUP SELECTOR
                    *
                    SETSC DC      0
                          LDX  L1 SCINT
                          STX  L1 17
                          LDX   1 4
                          STX  L1 RDINT
                          STX  L1 PTINT
                          STX  L1 PHINT
                          BSC  I  SETSC
                    *
                    *             SELECTOR CHANNEL INTERUPT ROUTINE
                    *
                    SCINT BSS     1
                          STD     ACC             SAVE REGISTERS
                          STX   1 XR1
                    *
                          XIO     WD1
                          STO     WORD1
                          XIO     WD2
                          STO     WORD2
                          XIO     WD3
                          STO     WORD3
                          XIO     WD4
                          STO     WORD4
                          XIO     CWD2
                          XIO     POLL
                    *
                          LD      WORD1           GET CHANNEL STATUS
                          SLA     1
                          BSC  L  USP,Z&          IS UNIT STATUS PENDING
                    MERR  LDX  L2 MEMER
                          BSI  L  MESS
                          MDX     *-1
                    *
                    USP   SLA     1
                          BSC  L  MERR,Z          ANY CHANNEL ERRORS
                          LD      WORD2           GET DEVICE STATUS
                          SRT     8
                          LDX   1 3
                    FIND  CMP  L1 DVICE-1
                          MDX     NOCMP
                          MDX     NOCMP
                          SLT     8
                          STO  L1 RDINT-1
                          LDD     ACC
                          LDX  I1 XR1
                          BOSC I  SCINT           RETURN
                    NOCMP MDX   1 -1
                          MDX     FIND
                          MDX     MERR
                    *
                    *
                    DVICE DC      /C              READER
                          DC      /D              PUNCH
                          DC      /E              PRINTER
                    *
                    RDINT DC      4
                    PHINT DC      4               PUNCH INTERUPT
                    PTINT DC      4
                    *
                    WORD1 DC      0
                    WORD2 DC      0
                    WORD3 DC      0
                    WORD4 DC      0
                    XR1   DC      0               TO SAVE XR1
                    ACC   BSS  E  2               TO SAVE A AND Q REGISTERS
                    WD1   DC      0               GET SELECTOR CHANNEL STATUS
                          DC      /9708
                    WD2   DC      0               GET SELECTOR DEVICE STATUS
                          DC      /970A
                    WD3   DC      0               GET LAST CCW ADDRESS
                          DC      /970C
                    WD4   DC      0               GET CHANNEL BYTE COUNT
                          DC      /970E
                    CWD2  DC      0               RESET WORD 2
                          DC      /970B
                    POLL  DC      0               REINITIATE SELECTOR POLLING
                          DC      /9703
                    MEMER EBC     .POSSIBLE MACHINE ERROR.
                          DC      /81FF
                    *
                    *             S U B R O U T I N E   R E A D R
                    *
                    *                   ADDRESS OF CCW  IN XR1
                    *
                    READR DC      0
                          STX   1 RDIOC           SET CCW ADDRESS
                    READ1 LD   L  RDINT
                          SLA     13
                          BSC  L  READ1,-         WAIT FOR DEVICE END
                    *
                          SLA     16              ISSUE IOCC
                          STO  L  RDINT
                          XIO     RDIOC
                    *
                    READ4 LD   L  RDINT           WAIT FOR INTERUPT
                          BSC  L  READ4,-&
                          BSC  I  READR,E         RETURN IF UNIT EXCEPTION ON
                          RTE     18
                          BSC  I  READR,-         RETURN IN NO UNIT CHECK
                    *
                          RTE     2               WAIT FOR DEV END IF CH END ON
                          BSC  L  READ7,-
                    READ2 LD   L  RDINT
                          SLA     13
                          BSC  L  READ2,-
                    READ7 SLA     16
                          STO  L  RDINT
                    *
                          XIO     READ9           GET READER STATUS
                    READ5 LD   L  RDINT
                          BSC  L  READ5,-&
                    *
                          SLA     16
                          STO  L  RDINT
                          LDX   1 6               DECIDE KIND OF ERROR
                          LD      READ8
                          SLCA  1
                          LD   L1 READ6
                          STO     *&1
                          LDX  L2 0
                          BSI  L  MESS            SEND MESSAGE
                          MDX     READ1
                    *
                    READ6 DC      READA           MESSAGE ADDRESS TABLE
                          DC      READB
                          DC      READC
                          DC      READB
                          DC      READB
                          DC      READD
                          DC      READE
                    *
                    READA EBC     .READER DUPLICATE COMMAND.
                          DC      /81FF
                    READB EBC     .READER CHECK.
                          DC      /81FF
                    READC EBC     .READER VALIDITY CHECK .
                          DC      /81FF
                    READD EBC     .READER IS NOT READY .
                          DC      /81FF
                    READE EBC     .READER COMMAND REJECT .
                          DC      /81FF
                    *
                    READ8 DC      0               STATUS BYTE STORAGE
                    *
                          BSS  E
                    RDIOC DC      0               READER IOCC
                          DC      /950C
                    READ9 DC      *&1             SENSE READER IOCC
                          DC      /950C
                          DC      1
                          DC      4
                          DC      READ8
                    *
                    *             S U B R O U T I N E   P R N T R
                    *
                    *                  ADDRESS OF CCW  IN XR1
                    *
                    PRNTR DC      0
                          STX   1 PTIOC           SET CCW ADDRESS
                    PRT1  LD   L  PTINT
                          SLA     13
                          BSC  L  PRT1,-          WAIT FOR DEVICE END
                    *
                          SLA     16              ISSUE IOCC
                          STO  L  PTINT
                          XIO     PTIOC
                    *
                    PRT4  LD   L  PTINT           WAIT FOR INTERUPT
                          BSC  L  PRT4,-&
                          SLA     14
                          BSC  I  PRNTR,-         RETURN IF NO UNIT CHECK
                    *
                          SLA     16              UNIT CHECK WAS ON
                          STO  L  PTINT
                          LDX  L2 PRT6
                          BSI  L  MESS
                          MDX     PRT1
                    *
                    PTIOC BSS  E  1               PRINTER IOCC
                          DC      /950E
                    *
                    PRT6  EBC     .PRINTER IS NOT READY.
                          DC      /81FF
                    *
                    *             TAPE BCD TO EBCDIC CONVERSION TABLE
                    *
                    TABLE DC      /40             BLANK
                          DC      /F1             1
                          DC      /F2             2
                          DC      /F3             3
                          DC      /F4             4
                          DC      /F5             5
                          DC      /F6             6
                          DC      /F7             7
                          DC      /F8             8
                          DC      /F9             9
                          DC      /F0             0
                          DC      /7B             #
                          DC      /7C             @
                          DC      /40
                          DC      /40
                          DC      /40
                          DC      /40
                          DC      /61             /
                          DC      /E2             S
                          DC      /E3             T
                          DC      /E4             U
                          DC      /E5             V
                          DC      /E6             W
                          DC      /E7             X
                          DC      /E8             Y
                          DC      /E9             Z
                          DC      /50             RECORD MARK
                          DC      /6B             ,
                          DC      /6C             %
                          DC      /40
                          DC      /40
                          DC      /40
                          DC      /60             -
                          DC      /D1             J
                          DC      /D2             K
                          DC      /D3             L
                          DC      /D4             M
                          DC      /D5             N
                          DC      /D6             O
                          DC      /D7             P
                          DC      /D8             Q
                          DC      /D9             R
                          DC      /40
                          DC      /5B             $
                          DC      /5C             *
                          DC      /40
                          DC      /40
                          DC      /40
                          DC      /4E             &
                          DC      /C1             A
                          DC      /C2             B
                          DC      /C3             C
                          DC      /C4             D
                          DC      /C5             E
                          DC      /C6             F
                          DC      /C7             G
                          DC      /C8             H
                          DC      /C9             I
                          DC      /40
                          DC      /4B             .
                          DC      /4C             <
                          DC      /40
                          DC      /40
                          DC      /40
                    *
                    *             SUBROUTINE CONCD
                    *
                    *             SUBROUTINE TO CONVERT CARD IMAGES TO
                    *             6 BIT TAPE BCD.  CARD IMAGE CHARACTER
                    *             TO BE CONVERTED MUST BE IN THE ACCUMULATOR
                    *             INDEX 3 WILL BE USED.  RESULT WILL BE IN THE
                    *             ACCUMULATOR..  HEX FFC0 WILL BE PLACED IN
                    *             THE ACCUMULATOR FOR AN INVALID CHARACTER.
                    *
                    CONCD BSS     1         STORAGE OF RETURN ADDRESS
                          LDX   1 64
                    MORE  LD   L1 CARD-1
                          BSC  L  BLNK,-&         RETURN IF CHARACTER IS BLANK
                          CMP     ZERO      CHECK IF CHARACTER IS NUM ZERO
                          MDX     OTHER     BRANCH IF NOT EQUAL
                          MDX     OTHER     BRANCH IF NOT EQUAL
                          LD      TEN       SET ACC TO 6 BIT NUM ZERO
                          MDX     DONE
                    OTHER SRT     6
                          SRA     2
                          SRT     3
                          SLA     13        POSITION ZONE BITS AT LEFT
                          LDX   3 3         SET INDEX 3 TO 3
                          SLCA  3           FIND ZONE BITS
                          STX   3 ZONE      STORE ZONE BITS
                          AND     MSKA      MASK OUT SIGN BIT
                          BSC  L  INVAL,Z   BRANCH OUT IF ZONE IS INVALID
                          SLT     8         SHIFT NUMERIC BITS INTO POSITION
                          BSC  L  ATE,E     BRANCH TO ATE IF 8 BIT IS ON
                    *
                    *             PROCESS BITS 1 THRU 9 OF CARD
                    *
                          SLT     8         POSITION NUMERIC BITS FOR TESTING
                          AND     MSKB
                          LDX   3 9         SET INDEX 3 TO 9
                          SLCA  3           FIND NUMERIC BITS
                          STX   3 NUM       STORE NUMERIC BITS
                          AND     MSKA      MASK SIGN BIT OFF
                          BSC  L  INVAL,Z   BRANCH IF CHARACTER IS INVALID
                          LD      NUM       FETCH NUMERIC BITS INTO ACCUMULATOR
                          BSC  L  CALK,-&   TEST FOR NO NUMERIC BITS
                          LD      TEN       SET ACCUMULATOR TO TEN
                          MDX     CALC      BRANCH TO BUILD CHAR
                    *
                    *             PROCESS BITS 1-7 OF CARD CHAR
                    *
                    ATE   SLT     8
                          AND     MSKB
                          BSC  L  INVAL,Z&
                          LDX   3 7         SET INDEX 3 TO 7
                          SLCA  3           FIND FIRST NUMERIC BIT
                          STX   3 NUM       STORE NUMERIC BIT FOUND
                          AND     MSKA      MASK SIGN BIT OFF
                          BSC  L  INVAL,Z   BRANCH OUT ON INVALID CHAR
                          LD      NUM       LOAD NUMERIC BITS INTO ACC
                          BSC  L  YES,Z     GO TO YES IF NUM BITS NON ZERO
                          LD      EIGHT     SET ACCUMULATOR TO 8
                          MDX     CALC      GO TO CALC IF NO NUM BITS
                    YES   LD      SXTN      SET ACCUMULATOR TO 16
                    *
                    *             CALCULATE SIX BIT CHARACTER
                    *
                    CALC  S       NUM       SUB TO FIND VALUE OF NUMERIC BITS
                          STO     NUM       STORE VALUE OF NUMERIC BITS
                    CALK  LD      ZONE      LOAD ZONE BITS INTO ACCUMULATOR
                          SLA     4         POSITION ZONE BITS
                          OR      NUM       PLACE NUMERIC BITS WITH ZONE BITS
                    DONE  STO  L1 CARD-1
                    BLNK  MDX   1 -1
                          MDX     MORE
                          BSC  I  CONCD     RETURN
                    *
                    *             INVALID CHARACTER
                    *
                    INVAL SLA     16
                          MDX     DONE
                    *
                    *             CONSTANTS
                    *
                    MSKA  DC      /7F80     TO MASK SIGN BIT OFF
                    ZONE  BSS     1         ZONE BIT STORAGE
                    NUM   BSS     1         NUMERIC BIT STORAGE
                    MSKB  DC      /FE80
                    EIGHT DC      8         CONSTANT
                    SXTN  DC      16        CONSTANT
                    TEN   DC      10        CONSTANT
                    ZERO  DC      /0800     CARD IMAGE NUMERIC ZERO
                    *
                    *             CLEAR OUT PRINTER BUFFER
                    *
                    CLBUF BSS     1
                          LDX  L1 66
                          LD   L  EBLKS
                          STO  L1 PTBUF-1
                          MDX   1 -1
                          MDX     *-4
                          BSC  I  CLBUF
                    *
                    *             SUBROUTINE TO RESTORE PAGE
                    *
                    RESPG BSS     1
                          LDX  L1 REST
                          BSI  L  PRNTR
                          BSC  I  RESPG
                    *
                    *             SUB TO ISSUE SEND MESSAGE SYSTEM CALL
                    *
                    MESS  BSS     1
                          LDX   1 3
                          BSI  I  7
                          MDX     MESS&1
                          BSC  I  MESS
                    *
                    *             TAPE BCD TO EBCDIC AND PACK
                    *               X1 # INPUT FWA
                    *               X2 # OUTPUT FWA
                    *               X3 # FIELD WIDTH IN BYTES
                    *
                    BTOE  BSS     1
                          STX   1 ODD&1
                          MDX   1 1
                          STX   1 EVEN&1
                    ODD   LDX  I1 0
                          LD   L1 TABLE
                          SLA     8
                    EVEN  LDX  I1 0
                          OR   L1 TABLE
                          STO   2 0
                          MDX   2 1
                          MDX  L  ODD&1,2
                          MDX  L  EVEN&1,2
                          MDX   3 -2
                          MDX     ODD
                          BSC  I  BTOE
                    *
                    *             C O N S T A N T S
                    *
                    CARD  BSS     64
                    BUFF  BSS     1760
                    PTBUF BSS     66
                    MYNAM EBC     .*OCTOGRAM*.
                          DC      /81FF
                    OVFLO EBC     .PAGE SIZE EXCEEDED.
                          DC      /8181
                          DC      /8181
                          DC      /81FF
                    ASTSK EBC     . ** .
                    END   DC      /2010           E
                          DC      /1010           N
                          DC      /2020           D
                    SIZE  DC      0
                    INDX  DC      0
                    IDCNT DC      0               ID PAGE COUNT
                    EZRO  DC      /F0F0           EBCDIC ZEROS
                    PAGES DC      0
                    MAXSZ DC      56
                    MSK1  DC      /F
                    ONE   DC      1
                    HUND  DC      100
                    EBLKS DC      /4040
                    *
                    *             C C W   D E F I N I T I O N S
                    *
                    REST  DC      0               RESTORE PAGE
                          DC      /8B
                          DC      0
                    RDCDS DC      128             READ CARDS
                          DC      /2062
                          DC      CARD
                    SPACE DC      0               SKIP ONE LINE
                          DC      /B
                          DC      0
                    PRNT  DC      132             PRINT ONE LINE
                          DC      9
                          DC      PTBUF
                          END     START
