**************************************************
**************************************************
*** ID - COMPOSES LARGE BANNERS LIKE CCI UNDER ***
*** VARIOUS MODES OF OPERATION.  RE-WRITTEN    ***
*** JANUARY 1976 BY RICK ACE                   ***
***                                            ***
**************************************************
**************************************************
         PCC      0
         TITLE    'ID PROGRAM'
         SPACE    3
*                 <---------- MODES OF OPERATION ---------->
*
*                 ONLINE/BATCH                  ONLINE/BATCH
*                  FILE DCB         M:LINK      DEVICE DCB
*                 ------------------------------------------
*                 *            *             *             *
*  MODE SWITCH    *    -1      *      0      *      +1     *
*                 *            *             *             *
*    DCB RE-      *            *             *             *
*  ASSIGNMENT     *   NONE     *    'LP'     *     NONE    *
*                 *            *             *             *
*  M:DEVICE VFC   *    NO      *     YES     *      YES    *
*                 *            *             *             *
*   CARRIAGE      *            *             *             *
*    CONTROL      *    '1'     *     '1'     *     NONE    *
*                 ------------------------------------------
*
* INPUT:
*
*        ON-LINE - 8 CHARACTERS FROM TERMINAL
*
*        BATCH - 16 CHARACTERS FROM M:C
*
*        LINKED - 16 CHARACTERS FROM R12 TO R15
*
         PAGE
         SYSTEM   SIG7FDP
         SYSTEM   BPM
         SPACE    3
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         SPACE    3
         DEF      ID0,ID1,IDBITS
         REF      M:C
         PAGE
ID0      EQU      %
BUF1     TEXT     '        '        BLANK FOR TERMINAL READ
         TEXT     '        '        SOME MORE BLANKS
         RES      20-(%-BUF1)       FOR 80 CHAR READ
BUFSIZE  EQU      34*12             BANNER BUFFER
BUF      RES      BUFSIZE
MODE     DATA     0                 FILE/M:LINK/DEVICE FLAG
LINKFPT  DATA,8   3**56             FPT TO M:LDTRC BACK TO M:LINKER
RSAVE    RES      16                REGISTER SAVE AREA
         PAGE
*********************************************************
*                                                       *
*        MAKE MY OWN M:LO DCB SO THERE'S PLENTY         *
*        OF ROOM IN THERE FOR A 31-BYTE FILENAME        *
*                                                       *
*********************************************************
         SPACE    1
M:LO     DSECT
M:LO     M:DCB    FILE,SN,(TRIES,10),PASS
         ORG      BA(M:LO)+3
         DATA,1   3                 SET M:LO TO DEVICE DCB
         DATA     X'50000'+'LO'     SET OPLABEL TO LO
         PAGE
IDBITS   CSECT    1                 PATTERN DATA CSECT
ID1      CSECT    1                 ALL OTHER CSECT-1 DATA
         SPACE    3
********************************************************************
*
*        GENERATE PATTERN TABLES FOR ALL KNOWN CHARACTERS
*
********************************************************************
IDC      CNAME
         PROC
         DATA,1   LF
         USECT    IDBITS
         LIST     0
         DATA     AF
         LIST     1
         USECT    ID1
         PEND
         SPACE    3
%IDC     EQU      %
' ' IDC ,,,,
'9' IDC X'7FF7FFF0',X'07803C01',X'FFFDFFE0',X'03001800',X'FFFEFFE0'
'8' IDC X'7FF7FFF0',X'07803C01',X'BFF9FFD8',X'03C01E00',X'FFFEFFE0'
'7' IDC X'FFFFFFB0',X'18018018',X'01800C00',X'C0060060',X'03001800'
'6' IDC X'7FFFFFF0',X'01800C00',X'7FFBFFF8',X'03C01E00',X'FFFEFFE0'
'5' IDC X'FFFFFFF0',X'01800C00',X'7FFBFFE0',X'03001E00',X'FFFEFFE0'
'4' IDC X'01801C01',X'E01B0198',X'18C1861F',X'FFFFF80C',X'00600300'
'3' IDC X'7FF7FFF0',X'06003001',X'807803C0',X'03001E00',X'FFFEFFE0'
'2' IDC X'7FF7FFF0',X'06003001',X'80180300',X'600C0180',X'3FFFFFF0'
'1' IDC X'06007007',X'800C0060',X'03001800',X'C0060030',X'01800C00'
'0' IDC X'1FC1FF18',X'0D803C01',X'E00F0078',X'03C01B01',X'8FF83F80'
'Z' IDC X'FFF7FF80',X'38038038',X'03803803',X'80380380',X'3FFDFFE0'
'Y' IDC X'C033030C',X'303300F0',X'03001800',X'C0060030',X'01800C00'
'X' IDC X'E03F01CC',X'183180D8',X'03801C01',X'B018C183',X'380FC070'
'W' IDC X'C01E00F0',X'07803C01',X'E00F0078',X'E3D8DF83',X'F80F8030'
'V' IDC X'C01E00D8',X'0CC06306',X'18306303',X'180D806C',X'01C00E00'
'U' IDC X'C01E00F0',X'07803C01',X'E00F0078',X'03C01E00',X'FFFEFFE0'
'T' IDC X'FFF7FF81',X'800C0060',X'03001800',X'C0060030',X'01800C00'
'S' IDC X'7FF7FFF0',X'07800C00',X'7FF9FFE0',X'03001E00',X'FFFEFFE0'
'R' IDC X'FFF7FFF0',X'07803C01',X'FFFFFFD8',X'18C06601',X'B00D8060'
'Q' IDC X'7FC7FF30',X'1980CC06',X'60330198',X'0CC7661F',X'3FFEFF70'
'P' IDC X'FFF7FFF0',X'07803C01',X'FFFFFFD8',X'00C00600',X'30018000'
'O' IDC X'7FF7FFF0',X'07803C01',X'E00F0078',X'03C01E00',X'FFFEFFE0'
'N' IDC X'C01F00FC',X'07B03CC1',X'E30F0C78',X'33C0DE03',X'F00F8030'
'M' IDC X'C01F01FC',X'1FB1BC71',X'E10F0078',X'03C01E00',X'F0078030'
'L' IDC X'C0060030',X'01800C00',X'60030018',X'00C00600',X'FFFFFFF0'
'K' IDC X'C01E0330',X'618C0D80',X'7003801B',X'00C6060C',X'30198030'
'J' IDC X'001800C0',X'06003001',X'800C0060',X'03001E00',X'FFFEFFE0'
'I' IDC X'3FC1FE01',X'800C0060',X'03001800',X'C0060030',X'0FF07F80'
'H' IDC X'C01E00F0',X'07803C01',X'FFFFFFF8',X'03C01E00',X'F0078030'
'G' IDC X'7FF7FFF0',X'07803C00',X'600303D8',X'1FC01E01',X'FFFEFFB0'
'F' IDC X'FFFFFFF0',X'01800C00',X'7F83FC18',X'00C00600',X'30018000'
'E' IDC X'FFFFFFF0',X'01800C00',X'7F83FC18',X'00C00600',X'3FFFFFF0'
'D' IDC X'FFE7FFB0',X'07803C01',X'E00F0078',X'03C01E00',X'FFFDFFC0'
'C' IDC X'7FF7FFF0',X'07800C00',X'60030018',X'00C00600',X'FFFEFFE0'
'B' IDC X'FFF7FFF0',X'07803C01',X'FFFBFFD8',X'03C01E00',X'FFFFFFE0'
'A' IDC X'7FF7FFF0',X'07803C01',X'FFFFFFF8',X'03C01E00',X'F0078030'
'"' IDC X'1980CC06',X'60330000',X'00000000',X'00000000',X'00000000'
'=' IDC X'00000000',X'01FFFFFF',X'8000001F',X'FFFFF800',X'00000000'
'''' IDC X'06003001',X'800C0000',X'00000000',X'00000000',X'00000000'
'@' IDC X'7FF7FFF0',X'07803CF9',X'EFCF667B',X'33D99ECC',X'F7FE9FE0'
'#' IDC X'0C30619F',X'FEFFF186',X'0C30C306',X'18FFF7FF',X'9860C300'
':' IDC X'00003801',X'C00E0000',X'00000000',X'00070038',X'01C00000'
'?' IDC X'3FE3FFB0',X'07803603',X'00300700',X'E0060000',X'01800C00'
'>' IDC X'18006001',X'80060018',X'00600300',X'30030030',X'03003000'
'%' IDC X'701FC1B6',X'19F18718',X'01801801',X'8E18F986',X'D83F80E0'
',' IDC X'00000000',X'00000000',X'00000000',X'E0070018',X'00C00C00'
'/' IDC X'00180180',X'18018018',X'01801801',X'80180180',X'18018000'
'-' IDC X'00000000',X'00000000',X'7FFFFFE0',X'00000000',X'00000000'
';' IDC X'00000001',X'C00E0070',X'00000000',X'E0070018',X'00C00C00'
')' IDC X'0C003000',X'C0060030',X'01800C00',X'60030018',X'01801800'
'*' IDC X'00003009',X'902D00F0',X'7FFBFFC1',X'E0168132',X'01800000'
'%' IDC X'0601FE19',X'998C6663',X'1F803F18',X'CCC63333',X'0FF00C00'
'!' IDC X'02003803',X'E01F00F8',X'03801C00',X'40000038',X'01C00E00'
'&' IDC X'7C063031',X'80D803C0',X'1E00D80C',X'66C1E607',X'18CC7C30'
'+' IDC X'00003001',X'800C0060',X'7FFBFFC0',X'C0060030',X'01800000'
'(' IDC X'01801801',X'800C0060',X'03001800',X'C0060030',X'00C00300'
'<' IDC X'00C00C00',X'C00C00C0',X'0C006001',X'80060018',X'00600180'
'.' IDC X'00000000',X'00000000',X'00000000',X'00000038',X'01C00E00'
         SPACE    1
#IDC     EQU      BA(%)-BA(%IDC)-1  # OF RECOGNIZED CHARACTERS
*                                   (EXCLUDING BLANK)
         PAGE
         BOUND    4
*
*        MISCELLANEOUS DATA
*
Y8       DATA     X'80000000'
#13      DATA     13
BLANK    TEXT     '    '
PAGEBUF  TEXT     '1'
C%       TEXTC    'ERR/ABN READING C DEVICE'
         PAGE
START    EQU      %
************************************************
*
*        STASH REGISTERS, SET MODE FLAG
*
************************************************
         STW,R8   LINKFPT+1         SAVE POSSIBLE M:LINK FILENAME
         LCI      4                 PREPARE TO
         STM,R12  BUF1+1             SAVE POSSIBLE M:LINK DATA
         AI,R8    0                 WAS I M:LINKED TO?
         BNEZ     MODESET           YES->MODE IS ALREADY SET
         M:PC     '>'               SET ONLINE PROMPT
         MTW,-1   MODE              ASSUME FILE DCB
         LI,R0    2                 CHK ASN
         AND,R0   M:LO              FILE DCB?
         BEZ      MODESET           YES
         MTW,2    MODE              NO->SET MODE TO +1
MODESET  EQU      %
*******************************
*
*        OPEN M:LO DCB
*
*******************************
         LW,R0    MODE              M:LINK?
         BEZ      %+3               YES
         M:OPEN   M:LO,OUT,SAVE     NO->DON'T REASSIGN M:LO
         B        %+2
         M:OPEN   M:LO,(DEVICE,'LP'),OUT,SAVE   M:LINK->OPEN M:LO TO LP
*******************************************************
*
*        SET VFC FLAG IF M:LINK OR DEVICE DCB
*
*******************************************************
         M:DEVICE M:LO,VFC          IGNORED FOR FILE DCBS
***********************************************************
*
*        SPEW OUT PAGE EJECT IF FILE DCB OR M:LINK
*
***********************************************************
         LW,R0    MODE              M:LINK OR FILE DCB?
         BGZ      %+2               NO
         M:WRITE  M:LO,(BUF,PAGEBUF),(SIZE,4),WAIT
         PAGE
********************************************************
*
*        READ INPUT FROM C DEVICE IF NOT M:LINK
*
********************************************************
         LCI      2                 PREPARE TO
         LM,R0    BUF1+1             ASSUME M:LINK, GET DATA
         LW,R2    MODE              M:LINKED?
         BEZ      PRINT2            YES->ALL SET TO PRINT
         LW,R12   BLANK             PREPARE TO
         STW,R12  BUF1+1             BLANK OUT <R13>
         M:READ   M:C,(BUF,BUF1),(SIZE,80),(ERR,CBAD),(ABN,CBAD)
         LCI      2                 ASSUME ONLINE
         LM,R0    BUF1              GET 1ST 8 CHAR OF CBUF
         LC       *X'4F'            BATCH?
         BCS,12   NOTBATCH          NO->WE'RE OK
         LCI      2                 OOPS, MUST GET 2ND, 3RD WORDS
         LM,R0    BUF1+1            'CAUSE 1ST WORD = ' ID '
NOTBATCH EQU      %
**********************************************************
*
*        DETERMINE PRINT TECHNIQUE:
*
*          PRINT1 - 1 BANNER FOLLOWED BY 4 SPACES
*          PRINT2 - 1st BANNER, 4 SPACES, 2nd BANNER
*
**********************************************************
         LC       *X'4F'            BATCH?
         BCS,12   PRINT1            NO
PRINT2   BAL,R15  1ID               PRINT A BANNER
         LI,R14   4                SKIP
         BAL,R15  SPACE              12 LINES
         LCI      2                 PREPARE TO
         LM,R0    BUF1+3             GET 2nd BANNER TEXT
         BAL,R15  1ID               PRINT ANOTHER BANNER
         B        EXIT              SPLIT
         SPACE    3
PRINT1   BAL,R15  1ID               PRINT A BANNER
         LI,R14   4                 SKIP
         BAL,R15  SPACE              4 SPACES
         B        EXIT              SPLIT
         SPACE    3
*
*        ERROR READING C DEVICE
*
CBAD     M:PRINT  (MESS,C%)
         CAL1,9   3                 M:XXX
         SPACE    3
*************************
*
*        ID EXIT
*
*************************
EXIT     M:CLOSE  M:LO,SAVE         CLOSE M:LO WITH SAVE
         LW,R0    MODE              M:LINK?
         BEZ      %+2               YES
         CAL1,9   1                 NO->M:EXIT
         LCI      4
         LM,12    BUF1+1
         CAL1,8   LINKFPT           M:LDTRC BACK TO MY CALLER
         PAGE
*******************************************************
*
*        SPACE SUBROUTINE
*
*        PRINTS BLANK LINES ON M:LO
*
*        INPUT:   R14 - NUMBER OF LINES TO SKIP
*        OUTPUT:  NONE
*        LINK:    R15
*        VOLATILE: NOTHING
*
*******************************************************
         SPACE    3
SPACE    EQU      %
         M:WRITE  M:LO,(BUF,BLANK),(SIZE,4),WAIT
         BDR,R14  %-1               LOOP
         B        *R15              RETURN
         PAGE
*******************************************************************
*
*        1ID SUBROUTINE
*
*        GIVEN 8-CHARACTER REQUEST, 1ID FORMATS ANS PRINTS
*        THE CORRESPONDING 12-LINE-HIGH BANNER THROUGH THE
*        M:LO DCB
*
*        INPUT:   R0,R1 - 8-CHAR REQUEST
*        OUTPUT:  NONE
*        LINK:    R15
*        VOLATILE: NOTHING
*
*******************************************************************
         SPACE    3
*
*   INTERNAL REGISTER USAGE
*
*     R1: ADDRESS OF CURRENT BIT PATTERN WORD FOR CHARACTER
*     R4: COLUMN OF CURRENT CHARACTER
*     R5: ROW OF CURRENT CHARACTER
*     R7: REQUEST INDEX (GOES FROM 7 TO 0)
*     R8: CURRENT CHARACTER BEING PROCESSED
*     R9: SHIFTING BIT FOR INTERROGATING BIT TABLE
*     R12: INDEX INTO 13 X 12 MATRIX FOR CURRENT CHARACTER
*
*
*
1ID      EQU      %
         LCI      0                 SAVE
         STM,R0   RSAVE              REGISTERS
         LW,R0    BLANK             CLEAR
         LI,R1    BUFSIZE            THE
         STW,R0   BUF-1,R1            FORMATTING
         BDR,R1   %-1                  BUFFER
         LI,R7    7                 INIT REQUEST INDEX REG
*
*        LOOP THROUGH REQUEST
*
REQCLOOP LB,R8    RSAVE,R7          GET REQUEST CHARACTER
         LI,R1    #IDC              IDENTIFY CHARACTER
         CB,R8    %IDC,R1           GOT IT?
         BE       VALID             YUP
         BDR,R1   %-2               NO->LOOP
         B        NEXTREQC          NOT KNOWN->DEFAULT TO BLANK
*
*   A VALID CHARACTER HAS BEEN FOUND.
*   INSTALL IT IN FORMATTING BUFFER
*
VALID    MI,R1    5                 COMPUTE ADDRESS OF BIT
         AI,R1    IDBITS+4           TABLE FOR THIS CHARACTER
         LI,R12   155               BUILD MATRIX (156 CHAR'S)
         LI,R9    8                 1 BIT FOR ON/OFF CHECKING
*
*   SEE IF BIT FOR THIS MATIRX POSITION IS SET OR RESET
*
PLOOP    SCS,R9   1                 NEXT BIT IN BITTABLE
         CI,R9    1                 NEW BITTABLE WORD?
         BAZ      %+2               NO
         AI,R1    -1                YES
         CW,R9    0,R1              IS DA BIT SET, HUH???
         BAZ      NEXTPP            NO->ALL DONE WITH THIS MATRIX POS
*
*   COMPUTE ADDRESS OF MATRIX POSITION IN FORMATTING BUFFER
*
         LW,R5    R12               COPY MAT INDEX
         LI,R4    0                 XAP R4
         DW,R4    #13               COMPUTE R4=COLUMN, R5=ROW
         MI,R5    136               BUF FORMAT: ROW1-ROW2-ROW3...
         AW,R4    R5                COMPUTE BYTE DISP INTO BUF AS IF
*                                    WE WERE DOING 1ST CHARACTER
         LW,R5    R7                ADJUST BYTE DISP
         MI,R5    17                 FOR nTH CHARACTER (n FROM R7)
         AW,R4    R5                  BY THE WAY, 17=13+4
         AI,R4    1                 ADD VFC OFFSET
         STB,R8   BUF,R4            STORE BYTE IN OUTPUT BUFFER
NEXTPP   AI,R12   -1                NEXT MATRIX POSITION FOR THIS CHAR
         BGEZ     PLOOP             BRANCH IF MORE TO DO
NEXTREQC AI,R7    -1                NEXT CHARACTER
         BGEZ     REQCLOOP           IN CALLER'S REQUEST
*
*   FORMATTING IS DONE SO PRINT THE DATA
*
         LI,R2    BUF               ADDRESS OF BUFFER
         LI,R3    12                # OF LINES
WRT      M:WRITE  M:LO,(BUF,*R2),(SIZE,133),WAIT
         AI,R2    34                NEXT LINE
         BDR,R3   WRT               LOOP
*
*   ALL DONE
*
         LCI      0                 RESTORE
         LM,R0    RSAVE              REGISTERS
         B        *R15                AND RETURN
         END      START
