         SYSTEM   SIG7
         SYSTEM   BPM
**
**   PROCS
**
PUSH     CNAME
         PROC
LF       B        %+2
RETURN   SET      %
         RES      1
         STW,AF(1) %-1
         PEND
*
PULL     CNAME
         PROC
         LW,AF(1) RETURN
         PEND
**
**   REGISTERS
**
R0       EQU      0
X1       EQU      1
X2       EQU      2
X3       EQU      3
X4       EQU      4
X5       EQU      5
X6       EQU      6
X7       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
**
**   REFS
**
         REF      M:LO,M:SI
**
**   DATA
**
OUTBFS   EQU      %                 OUTPUT BUFFERS
OUTBF1   RES,1    132
OUTBND   EQU      %
OUTBSZ   EQU      (OUTBND-OUTBFS)*4
LINWID   RES      1                 LINE WIDTH
BATWID   EQU      132               BATCH PAGE WIDTH
ONLWID   EQU      72                ON-LINE PAGE WIDTH
NAMEBUF  TEXT     ' NAME = FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF.AAAAAAAA '
BUFFER   RES      1
RECNBR   RES      1                 NUMBER OF RECORDS
KEYBUF   RES      1                 ADDRESS OF KEY BUFFER
KEYLEN   RES      1                 LENGTH OF CURRENT KEY
NBRKYS   RES      1                 NUMBER OF KEYS/DISPLAY LINE
KYSLFT   RES      1                 FIELDS OPEN ON THIS LINE
MAXIX    RES      1
FLDEND   RES      1                 FIELD END
HEXOUT   RES      1                 ONLY OUTPUT HEX SWITCH.
HAVLIN   RES      1                 HAVE LINE?
KEYDSPSZ RES      1                 NUMBER OF BYTES IN DISPLAY FIELD
**
**   CONSTS
**
BLANKS   TEXT     '    '
DOTCHR   TEXT     '.'
NOKEYS   TEXT     ' *NO KEYS*'
NOFILE   TEXT     ' *NO FILE*'
CHRTBL   EQU      %
*                  0123456789ABCDEF
         TEXT     '................' 00
         TEXT     '................' 10
         TEXT     '................' 20
         TEXT     '................' 30
*                  0123456789ABCDEF
         TEXT     ' ...........<(+.' 40
         TEXT     '&.........!%*);.' 50
         TEXT     '-/........^,%.>?' 60
         TEXT     '..........:#@''="' 70
*                  0123456789ABCDEF
         TEXT     '.abcdefghi......' 80
         TEXT     '.jklmnopqr......' 90
         TEXT     '..stuvwxyz......' A0
         TEXT     '....|~..........' B0
*                  0123456789ABCDEF
         TEXT     '.ABCDEFGHI......' C0
         TEXT     '.JKLMNOPQR......' D0
         TEXT     '..STUVWXYZ......' E0
         TEXT     '0123456789......' F0
*                  0123456789ABCDEF
*
*
*
HEXTBL   EQU      %
         TEXT     '0123456789ABCDEF'
*
*
*
DC2TBL   EQU      %
         TEXT     ' 0','10','20','30','40',;
                  '50','60','70','80','90'
**
**   CODE
**
***********************************************************************
RESET%FOR%NEW%KEY  EQU %
         PUSH     R15               SAVE RETURN ADDRESS.
         BAL,R15  FLUSH%BUFFER      FLUSH PREVIOUS BUFFER.
*
         LW,R13   LINWID            CALC NUMBER OF BYTES
         AI,R13   -6                  OF USEABLE BUFFER.
*
         LW,R14   KEYLEN            CALC NUMBER OF BYTES
         SLS,R14  1
         AI,R14   2                   NEEDED TO DISPLAY KEY.
         STW,R14  KEYDSPSZ
*
         LI,R12   0                 CALC NUMBER OF KEYS
         DW,R13   R14                 PER DISPLAY LINE.
         STW,R13  NBRKYS
*
         BAL,R15  RESET%FOR%NEW%LINE
*
         LB,X3    *KEYBUF           PRINT NUMBER OF BYTES IN KEY.
         LI,X2    0
         DW,X2    =10
         LH,X3    DC2TBL,X3
         AW,X3    X2
         LI,X2    3
         STH,X3   OUTBF1,X2
*
         PULL     R15               RESTORE RETURN ADDRESS
         B        *15                 AND RETURN.
*
***********************************************************************
FLUSH%BUFFER EQU  %
*
         MTW,0    HAVLIN            IF NO LINE,
         BEZ      *R15                NOTHING TO OUTPUT.
*
         M:WRITE  M:LO,(BUF,OUTBF1),(SIZE,*LINWID),(WAIT)
*
         LI,R14   0                 HAVE NO OUTPUT LINE NOW.
         STW,R14  HAVLIN
*
         B        *R15              RETURN.
*
***********************************************************************
RESET%FOR%NEW%LINE EQU %
*
         PUSH     R15
         LW,X7    NBRKYS            CAN OUTPUT FULL LINE.
         STW,X7   KYSLFT
*
         LI,1     OUTBSZ            SET UP BYTE DESTINATION POINTER.
         SLS,1    24                SHIFT TO COUNT FIELD.
         AI,1     BA(OUTBFS)
         MBS,0    BA(BLANKS)                 BUFFER.
*
         LW,X1    RECNBR            PASS VALUE TO CONVERT.
         LI,X2    BA(OUTBF1)+1      PASS DESTINATION ADDRESS.
         LI,X3    4                 PASS SIZE OF FIELD.
         BAL,R15  BINTODEC          CONVERT RECNBR TO TEXT.
         LI,X7    6                 RESET BUFFER POSITION INDEX.
         PULL     R15
         B        *R15              RETURN.
*
***********************************************************************
PUT%KEY%IN%BUF EQU %
*
         PUSH     R15               SAVE RETURN ADDRESS.
         AW,X7    KEYDSPSZ          CAL INDEX OF NEXT FIELD'S END.
*
         CW,X7    MAXIX             IF PAST BUFFER END,
         BLE      HAVE%ROOM
         BAL,R15  FLUSH%BUFFER        GET NEW LINE READY.
         BAL,R15  RESET%FOR%NEW%LINE
         AW,X7    KEYDSPSZ          INCLUDE KEY SIZE.
*
HAVE%ROOM EQU     %
         STW,X7   FLDEND            SAVE IX OF THIS FIELD'S END.
*
         LW,X6    KEYLEN            INIT KEY INDEX.
*
         LI,R14   0                 ASSUME NOT HEX ONLY.
         CI,X6    3                 IF KEY LEN = 3
         BNE      SET%HEXOUT
         LI,X2    1
         LB,X2    *KEYBUF,X2          AND FIRST BYTE OF KEY
         LB,X2    CHRTBL,X2           IS NOT TEXT,
         CI,X2    '.'
         BNE      SET%HEXOUT
         LI,R14   1                   ONLY OUTPUT HEX.
SET%HEXOUT EQU %
         STW,R14  HEXOUT
*
GET%KEY  EQU      %
         LB,X3    *KEYBUF,X6        GET KET BYTE
         BAL,R15  XLATE%KEY%BYTE      AND TRANSLATE TO DISP BYTES.
         STB,R14  OUTBF1,X7         PUT DISP BYTES
         AI,X7    -1
         STB,R13  OUTBF1,X7           IN BUFFERS.
         AI,X7    -1
         BDR,X6   GET%KEY
*
         MTW,1    HAVLIN            HAVE SOMETHING IN LINE NOW.
         LW,X7    FLDEND            RESET FIELD END INDEX.
         PULL     R15               RESTORE RETURN ADDRESS
         B        *R15                AND RETURN.
*
***********************************************************************
XLATE%KEY%BYTE EQU %
*
         MTW,0    HEXOUT            IF HEX ONLY,
         BGZ      OUTPUT%HEX          HEX ONLY.
*
         LB,R13   CHRTBL,X3         GET CHARACTER FOR KEY BYTE.
         CI,R13   '.'               IF PRINTABLE,
         BE       %+3
         LI,R14   '.'                 NO NEED FOR CONVERSION.
         B        *R15
*
OUTPUT%HEX EQU %
         LI,X2    0                 CONVERT BYTE TO HEX.
         SCD,X2   -4                (X3) = HIGH ORDER 4 BITS.
         SCS,X2   4                 (X2) = LOW ORDER 4.
         LB,R13   HEXTBL,X3
         LB,R14   HEXTBL,X2
         B        *R15
*
***********************************************************************
***********************************************************************
**********                 BINTODEC                          **********
***********************************************************************
*D*      NAME:    BINTODEC - BINARY TO DECIMAL CONVERSION
*,*
*,*      CALL:    BAL,R15 BINTODEC
*,*               <RETURN>
*,*
*,*      INPUT:   (X1) = VALUE TO CONVERT
*,*               (X2) = BYTE ADDRESS OF DESTINATION
*,*               (X3) = SIZE OF DESTINATION FIELD
*,*               (R15)= RETURN ADDESS
*,*
*,*      OUTPUT:  ((X2) THROUGH (X2)+(X3)) = DECIMAL STRING
*,*
*,*      REGISTERS: ALL SAFE BUT X2 AND X3
*D*
***********************************************************************
*
BINTODEC EQU      %
*
*   INITIALIZE:  SAVE VOLATILE REGISTERS; SET UP POINTERS; ETC.
*
         LW,R13   X1                MOVE VALUE TO WORK REGISTER.
         AW,X2    X3                POINT PAST LAST BYTE TO BE USED.
*
*   SUCCESSIVELY CONVERT VALUE TO DECIMAL DIGITS.
*
BTD020%NEXT%DIGIT EQU %
         AI,X3    -1                ANY LEFT?
         BLZ      BTD999%EXIT       NO---CLEAN UP AND EXIT.
*
         LI,R12   0                 ZERO HIGH ORDER DIVIDEND.
         DW,R12   =10               ONES TO R12; TENS TO R13.
*
         AI,R12   '0'               CONVERT BINARY TO DECIMAL,
         AI,X2    -1                  POINT TO PROPER BYTE.
         STB,R12  0,X2                AND STORE DIGIT.
*
         AI,R13   0                 DON'T WANT LEADING ZEROS.
         BG       BTD020%NEXT%DIGIT
*
*  BLANK FILL REMAINDER OF FIELD.
*
         LI,R12   ' '
BTD050%BLANK%FILL EQU %
         AI,X3    -1                ANY MORE TO FILL?
         BLZ      BTD999%EXIT     IF NOT, CLEAN UP AND EXIT.
*
         AI,X2    -1                POINT TO PROPER BYTE
         STB,R12  0,X2                AND STORE BLANK
*
         B        BTD050%BLANK%FILL GO BACK FOR MORE.
*
*   CLEAN UP AND EXIT.
*
BTD999%EXIT EQU   %
         B        *R15              RETURN.
*
***********************************************************************
LOC%VLP%ENTRY EQU %
*
* (X3) = ADDR DCB
* (R12) = CODE OF ENTRY TO FINE     (X3) RETURNED W/ADDR OR 0
*
         SCS,R12  -8                SHIFT TO CODE FIELD.
         LW,R13   =X'FF000000'      MASK FOR CODE FIELD.
*
         LW,X3    6,X3              GET FLP.
         AND,X3   =X'1FFFF'
         BEZ      *R15              IF NONE, ENTRY CAN'T BE FOUND.
*
LOOK%AGAIN EQU    %
         CS,12    0,X3              IF CORRECT ENTRY FOUND,
         BE       *R15                RETURN.
*
         LW,X2    0,X3              GET CONTROL WORD.
         CW,X2    =X'00FF0000'      IF END OF VLP,
         BAZ      %+3
         LI,X3    0                   RETURN NO ADDRESS.
         B        *R15
*
         AND,X2   =X'FF'            ONLY WANT # WDS THIS ENTRY.
         AW,X3    X2                POSITION TO
         AI,X3    1                   ENTRY.
         B        LOOK%AGAIN
*
***********************************************************************
START    EQU      %
*
         LI,R14   0                 INITIALIZE.
         STW,R14  HAVLIN
         STW,R14  KEYLEN
         STW,R14  RECNBR
*
         M:OPEN   M:SI,(SEQUEN),(IN)
         M:OPEN   M:LO,(OUT)
*
         LI,X3    M:SI              GET ADDRESS
         LI,R12   X'01'               OF FILENAME ENTRY OF VLP.
         BAL,R15  LOC%VLP%ENTRY
         AI,X3    0
         BEZ      NO%FILE%SET
*
         LW,R15   0,X3              IF NO SIGNIFICANT
         AND,R15  =X'FF00'            WORDS,
         BNEZ     HAVE%SIG%WRDS
NO%FILE%SET EQU   %                   SAY NO FILE.
         CAL1,1   SKIP1             SKIP A LINE THEN...
         M:WRITE  M:LO,(BUF,NOFILE),(SIZE,10),(WAIT)
         B        CLOSE%FILES
*
HAVE%SIG%WRDS EQU %
         MTW,0    X'8C00'           IF ON-LINE,
         BLZ      NO%FILE%NAME        DON'T PRINT FILE NAME.
*
         AI,X3    1                 CALC BA OF NAME.
         SLS,X3   2
         LB,R13   0,X3              IF NAME LENGTH,
         BEZ      NO%FILE%NAME        IS ZERO, NO FILE NAME.
*
         SCS,R13  -8                SHIFT TO BYTE COUNT POSITION.
         LW,R12   X3                CALC SOURCE BYTE ADDR.
         AI,R12   1
         AI,R13   BA(NAMEBUF)+8     PUT NAME IN BUFFER.
         MBS,R12  0
         LW,1     R13               SAVE BA OF NEXT BYTE.
*
         LI,X3    M:SI              LOOK FOR ACCOUNT
         LI,R12   X'02'             ACCOUNT CODE.
         BAL,R15  LOC%VLP%ENTRY
         AI,X3    0                 EASY WAY OUT IF NOT FOUND.
         BEZ      NO%FILE%NAME
*
         AW,1     =X'01000000'      MOVE DOT TO NAME BUFFER.
         MBS,0    BA(DOTCHR)
*
         LW,R13   1                 NEXT FREE CHAR.
         AW,R13   =X'08000000'      # BYTES IN ACN.
         AI,X3    1                 CALC BA OF ACN
         SLS,X3   2                   AND MOVE TO NAME BUFFER.
         LW,R12   X3
         MBS,R12  0
         AI,R13   -BA(NAMEBUF)      CALC # BYTES TO OUTPUT
         B        HAVE%FILE%NAME
NO%FILE%NAME EQU  %
         LI,R13   0
HAVE%FILE%NAME EQU %
         M:WRITE  M:LO,(BUF,NAMEBUF),(SIZE,*R13),(WAIT)
,SKIP1   M:WRITE  M:LO,(BUF,NAMEBUF),(SIZE,1),(WAIT)
         LI,R14   ONLWID            ASSUME NON-LISTING DEVICE.
         LW,R13   M:LO+1            IF LISTING DEVICE,
         CI,R13   X'4000'
         BAZ      %+2
         LI,R14   BATWID              USE BATCH WIDTH.
         STW,R14  LINWID
         AI,R14   -1
         STW,R14  MAXIX
*
         LW,R14   M:SI+10           GET KEYBUF ADDRESS.
         AND,R14  =X'1FFFF'
         STW,R14  KEYBUF
*
READ%KEY EQU      %
         M:READ   M:SI,(BUF,BUFFER),(SIZE,0),(ERR,ABNERR),(ABN,ABNERR)
         MTW,1    RECNBR
*
         LB,R14   *KEYBUF           GET LENGTH OF KEY.
*
         BGZ      NOT%NULL%KEY
         M:WRITE  M:LO,(BUF,NOKEYS),(SIZE,10),(WAIT)
         B        CLOSE%FILES
*
NOT%NULL%KEY EQU  %
         CW,R14   KEYLEN            IF DIFFERENT FROM CURRENT LENGTH,
         BE       HAVE%KEY%LENGTH
         STW,R14  KEYLEN            SAVE KEY LENGTH.
         BAL,R15  RESET%FOR%NEW%KEY   SET UP FOR NEW KEY LENGTH.
*
HAVE%KEY%LENGTH EQU %
         BAL,R15  PUT%KEY%IN%BUF    PUT KEY IN BUFFER.
*
         B        READ%KEY
**
**  ERROR OR ABNORMALS.
**
ABNERR   EQU      %
         LB,R9    R10               OK IF 07-00.
         CI,R9    7
         BE       *R8
*
         CI,R9    6                 IF NOT EOF,
         BNE      OTHER%ERRORS
         BAL,R15  FLUSH%BUFFER      LIST LAST LINE IF IT EXISTS.
CLOSE%FILES EQU   %
         M:CLOSE  M:SI,(SAVE)
         M:CLOSE  M:LO,(SAVE)
         M:EXIT
**
**  OPEN M:SI ERRORS OR ABNORMALS.
**
OTHER%ERRORS EQU  %
         LW,9     10                CHECK DCB.
         AND,9    =X'1FFFF'
         CI,9     M:SI              M:SI?
         BNE      CHKLO
         LW,9     ='M:SI'
         B        DOSNAP
*
CHKLO    CI,9     M:LO
         BNE      DOSNAP
         LW,9     ='M:LO'
*
DOSNAP   M:SNAP   'BYEBYE',(RECNBR,RECNBR)
         M:EXIT
         END      START
