         TITLE 'FTHTB - FILE TRANSFER FROM HOST TO TERMINAL'
***********************************************************************
*
*        F T H T B
*        FILE TRANSFER FROM HOST TO TERMINAL IN BYPASS MODE
*        VERSION 1985-MAY-28. COPYRIGHT (C) 1985, LOGICS GMBH.
*        TERMINAL: LOGICS 9750-EMULATION EP9750 VERSION MARCH 1984.
*        HOST: SIEMENS BS2000.
*
***********************************************************************
*        REGISTER EQUATES
R0       EQU   0
R1       EQU   1
ERRADR   EQU   3                       ERROR ADDRESS
INPNDX   EQU   4                       INPUT INDEX
OUTNDX   EQU   5                       OUTPUT INDEX
INPLEN   EQU   6                       INPUT LENGTH
OUTLEN   EQU   7                       OUTPUT LENGTH
WREG0    EQU   8                       WORK REGISTER 0
WREG1    EQU   9                       WORK REGISTER 1
CREG     EQU   10                      CONTAINS CURRENT CHAR
BASE     EQU   11                      BASE REGISTER
DBASE    EQU   12                      BASE REGISTER FOR DSECTS
SBASE    EQU   13                      BASE REGISTER FOR SUBROUTINES
RETURN   EQU   14                      RETURN ADDRESS
SCALL    EQU   15                      SUBROUTINE CALL REGISTER
*        EQUATES FOR PARX0L/D
KAN      EQU   0
PBH      EQU   1
GAD      EQU   2
GBF      EQU   3
SPA      EQU   4
RB1      EQU   5
RB2      EQU   6
DRI      EQU   7
NAM      EQU   8
EXT      EQU   16
*
         MACRO
         CSEND
.*       CSECT END (BEFORE DSECT)
         GBLC  &CSNAME
&CSNAME  SETC  '&SYSECT'
         MEND
         MACRO
         CSBEG
.*       CSECT BEGIN (AFTER DSECT)
         GBLC  &CSNAME
&CSNAME  CSECT ,
         MEND
         EJECT
FTHTB    START
         PRINT NOGEN,IOFF
START    DS    0H
         BALR  BASE,0
         USING *,BASE
*                                      GET SWITCHES
         GETSW
         STC   R0,SWITCHES
*                                      START MESSAGE
         TM    SWITCHES,SMSGINIT
         BNZ   GTHOST                  SUPPRESS
*
         LA    OUTNDX,MSGID            PROGRAMM ID
         LA    ERRADR,ABEND
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         LA    OUTNDX,MSGVER           VERSION
         LA    ERRADR,ABEND
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
*                                      HOST FILE
GTHOST   DS    0H
*                                      GET NAME OF HOST FILE
         LA    OUTNDX,MSGHN
         L     INPNDX,ARBUFF
         LH    INPLEN,LRBUFF
         LA    ERRADR,ABEND
         MVI   SUBRPAR1+1,DISACC       DISPLAY/ACCEPT
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
*                                      OPEN HOST FILE
         L     INPNDX,ARBUFF
         MVI   SUBRPAR1+1,SAMOPENI     SAM OPEN INPUT
         L     SCALL,AFILEIO           FILE I/O
         BALR  RETURN,SCALL
         EJECT
GTTERM   DS    0H
         LA    OUTNDX,MSGTN            GET NAME OF TERMINAL FILE
         L     INPNDX,ARBUFF
         LH    INPLEN,LRBUFF
         LA    ERRADR,ERREND
         MVI   SUBRPAR1+1,DISACC       DISPLAY/ACCEPT
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         LH    INPLEN,0(INPNDX)
         LR    WREG0,INPNDX
         AR    WREG0,INPLEN
         ST    WREG0,INPLAST
         LA    INPNDX,4(INPNDX)
*                                      ANALYZE AND MOVE TO PAG
         XR    OUTNDX,OUTNDX
         CLI   1(INPNDX),':'
         BNE   GTNNAM
         MVC   MSGOPPAR+DRI(1),0(INPNDX)
         MVC   MSGWRPAR+DRI(1),0(INPNDX)
         MVC   MSGCLPAR+DRI(1),0(INPNDX)
         LA    INPNDX,2(INPNDX)
GTNNAM   C     INPNDX,INPLAST
         BNL   GTNEND
         IC    WREG0,0(INPNDX)
         STC   WREG0,WBYT1
         CLI   WBYT1,'.'
         BE    GTNEXT
         CH    OUTNDX,H7
         BH    GTNTRUNC
         STC   WREG0,MSGOPPAR+NAM(OUTNDX)
GTNTRUNC LA    INPNDX,1(INPNDX)
         LA    OUTNDX,1(OUTNDX)
         B     GTNNAM
GTNEXT   LA    INPNDX,1(INPNDX)
         XR    OUTNDX,OUTNDX
GTNEXTL  C     INPNDX,INPLAST
         BNL   GTNEND
         CH    OUTNDX,H2
         BH    GTNEND
         IC    WREG0,0(INPNDX)
         STC   WREG0,MSGOPPAR+EXT(OUTNDX)
         LA    INPNDX,1(INPNDX)
         LA    OUTNDX,1(OUTNDX)
         B     GTNEXTL
GTNEND   DS    0H
         MVC   MSGTNDRI(1),MSGOPPAR+DRI
         MVC   MSGTNNAM(8),MSGOPPAR+NAM
         MVC   MSGTNEXT(3),MSGOPPAR+EXT
         EJECT
GTFTYPE  DS    0H                      FILE TYPE
*                                      GET FILE TYPE
         LA    OUTNDX,MSGT
         L     INPNDX,ARBUFF
         LH    INPLEN,LRBUFF
         LA    ERRADR,ERREND
         MVI   SUBRPAR1+1,DISACC       DISPLAY/ACCEPT
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
*                                      ANALYZE FILE TYPE
         MVC   FILETYPE(1),4(INPNDX)
         OI    FILETYPE,X'40'          LOWER --> UPPER CASE
         CLI   FILETYPE,C'T'
         BE    GTFTYPEE
         CLI   FILETYPE,C'S'
         BE    GTFTYPEE
         CLI   FILETYPE,C'B'
         BE    GTFTYPEE
         B     GTFTYPE
GTFTYPEE DS    0H
         MVC   MSGTPAR(1),FILETYPE
*
GTBSIZE  DS    0H                      GET TRANSFER BLOCK SIZE
         LA    OUTNDX,MSGS
         L     INPNDX,ARBUFF
         LH    INPLEN,LRBUFF
         LA    ERRADR,ERREND
         MVI   SUBRPAR1+1,DISACC       DISPLAY/ACCEPT
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
*                                      ANALYZE INPUT
         MVC   MSGSPAR(1),4(INPNDX)
         CLI   4(INPNDX),C'0'
         BL    GTBSIZE
         CLI   4(INPNDX),C'4'
         BH    GTBSIZE
         NI    4(INPNDX),X'0F'         LOW NIBBLE
         XR    WREG0,WREG0
         IC    WREG0,4(INPNDX)
         SLL   WREG0,2
         L     WREG0,OUTMAX0(WREG0)
         ST    WREG0,OUTMAX
*
         LA    OUTNDX,MSGOP            OPEN TERMINAL FILE
         LA    ERRADR,ERREND
         MVI   SUBRPAR1+1,SEND         SEND
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         LA    OUTNDX,MSGWR            SEND PAG FOR WRITE
         LA    ERRADR,ERREND
         MVI   SUBRPAR1+1,SEND         SEND
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         EJECT
*                                      INIT COUNTERS
         XR    WREG0,WREG0
         ST    WREG0,RECIN
         ST    WREG0,RECOUT
         ST    WREG0,BYTIN
         ST    WREG0,BYTOUT
*                                      FORCE FIRST GET
         L     INPNDX,AFBUFF
         ST    INPNDX,INPLAST
*                                      OUT BUFFER
         L     OUTNDX,ARBUFF
         MVC   0(MSGPKE-MSGPK,OUTNDX),MSGPK
         LH    OUTLEN,MSGPK
         AR    OUTNDX,OUTLEN
*                                      MAIN LOOP
         CLI   FILETYPE,C'T'
         BE    TEXTLOOP
         CLI   FILETYPE,C'S'
         BE    SPOOLOOP
         CLI   FILETYPE,C'B'
         BE    BINLOOP
         B     ERREND
*
TEXTLOOP DS    0H
SPOOLOOP DS    0H
         L     SCALL,AGETBTS           GET BYTE TEXT/SPOOL
         BALR  RETURN,SCALL
         CLI   GBTSEOF,C'Y'
         BE    TEXTEOF
         MVI   SUBRPAR1+1,PSBYTE       PUT BYTE
         L     SCALL,ASNDBASC          SEND BYTE ASCII
         BALR  RETURN,SCALL
         B     TEXTLOOP
TEXTEOF  DS    0H
         IC    CREG,ASEOF              ASCII EOF CHARACTER
         MVI   SUBRPAR1+1,PSBYTE       PUT BYTE
         L     SCALL,ASNDBASC          SEND BYTE ASCII
         BALR  RETURN,SCALL
         MVI   SUBRPAR1+1,PSLAST       PUT LAST BYTE (FLUSH BUFFERS)
         L     SCALL,ASNDBASC          SEND BYTE ASCII
         BALR  RETURN,SCALL
         B     CLOSEALL
*
BINLOOP  DS    0H
         L     SCALL,AGETBBIN          GET BYTE BINARY
         BALR  RETURN,SCALL
         CLI   GBBEOF,C'Y'
         BE    BINEOF
         MVI   SUBRPAR1+1,PSBYTE       PUT BYTE
         L     SCALL,ASNDBASC          SEND BYTE ASCII
         BALR  RETURN,SCALL
         B     BINLOOP
BINEOF   MVI   SUBRPAR1+1,PSLAST       PUT LAST BYTE (FLUSH BUFFERS)
         L     SCALL,ASNDBASC          SEND BYTE ASCII
         BALR  RETURN,SCALL
         B     CLOSEALL
         EJECT
ERREND   DS    0H
         MVI   ERRSW,C'Y'
*        B     CLOSEALL
CLOSEALL DS    0H
         MVI   SUBRPAR1+1,SAMCLOSE     CLOSE HOST FILE
         L     SCALL,AFILEIO           FILE I/O
         BALR  RETURN,SCALL
*
         LA    OUTNDX,MSGCL            CLOSE TERMINAL FILE
         LA    ERRADR,ABEND
         MVI   SUBRPAR1+1,SEND         SEND
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         CLI   ERRSW,C'Y'
         BE    ABEND
*                                      FINAL MESSAGES
         TM    SWITCHES,SMSGFINL
         BNZ   TERM                    SUPPRESS
*
         LA    ERRADR,ABEND
         LA    OUTNDX,MSGID            PROGRAM ID
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         LA    ERRADR,ABEND
         LA    OUTNDX,MSGVER           VERSION
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         LA    ERRADR,ABEND
         LA    OUTNDX,MSGHN            HOST FILE NAME
         LA    OUTLEN,MSGHNEE-MSGHN
         STH   OUTLEN,MSGHN
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         LA    ERRADR,ABEND
         LA    OUTNDX,MSGTN            TERMINAL FILE NAME
         LA    OUTLEN,MSGTNEE-MSGTN
         STH   OUTLEN,MSGTN
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         LA    ERRADR,ABEND
         LA    OUTNDX,MSGT             TYPE OF FILE
         LA    OUTLEN,MSGTEE-MSGT
         STH   OUTLEN,MSGT
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         LA    ERRADR,ABEND
         LA    OUTNDX,MSGS             SIZE OF BLOCK
         LA    OUTLEN,MSGSEE-MSGS
         STH   OUTLEN,MSGS
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         EJECT
*                                      MOVE COUNTERS TO MESSAGE
         LA    INPNDX,RECIN
         LA    OUTNDX,MSGCNNUM
         LA    INPLEN,2
CVDLOOP  DS    0H
         L     WREG0,0(INPNDX)
         CVD   WREG0,DWORD
         UNPK  0(7,OUTNDX),DWORD+4(4)
         OI    6(OUTNDX),X'F0'
         LA    INPNDX,4(INPNDX)
         LA    OUTNDX,8(OUTNDX)
         BCT   INPLEN,CVDLOOP
*
         LA    OUTNDX,MSGCN            NUMBER OR RECORDS RECEIVED
         LA    ERRADR,NORMEND
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
*
NORMEND  DS    0H
         LA    OUTNDX,MSGNE            NORMAL END
         LA    ERRADR,TERM
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         B     TERM
ABEND    DS    0H
         LA    OUTNDX,MSGAE            ABNORMAL END
         LA    ERRADR,TERM
         MVI   SUBRPAR1+1,DISPLAY      DISPLAY
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
TERM     TERM
         EJECT
*
MSGID    DC    Y(MSGIDE-MSGID)
         DC    AL3(0)
         DC    C'FTHTB: FILE TRANFER '
         DC    C'FROM HOST (BS2000) '
         DC    C'TO TERMINAL (EP9750) '
         DC    C'IN BYPASS MODE'
MSGIDE   EQU   *
*
MSGVER   DC    Y(MSGVERE-MSGVER)
         DC    AL3(0)
         DC    C'VERSION 1985-MAY-28. '
         DC    C'COPYRIGHT (C) 1985, LOGICS GMBH'
MSGVERE  EQU   *
*
MSGHN    DC    Y(MSGHNE-MSGHN)
         DC    AL3(0)
         DC    C'NAME OF SOURCE FILE AT     HOST (BS2000) : '
MSGHNE   EQU   *
MSGHNPAR DS    CL44                    BS2000 FILE ID
MSGHNEE  EQU   *
*
MSGTN    DC    Y(MSGTNE-MSGTN)
         DC    AL3(0)
         DC    C'NAME OF TARGET FILE AT TERMINAL (EP9750) : '
MSGTNE   EQU   *
MSGTNPAR EQU   *                       CP/M FILE ID
MSGTNDRI DC    C'1'
         DC    C':'
MSGTNNAM DC    C'12345678'
         DC    C'.'
MSGTNEXT DC    C'123'
MSGTNEE  EQU   *
*
MSGT     DC    Y(MSGTE-MSGT)
         DC    AL3(0)
         DC    C'TYPE OF FILE (T=TEXT, S=SPOOL, B=BINARY) : '
MSGTE    EQU   *
MSGTPAR  DC    C'1'
MSGTEE   EQU   *
*
MSGS     DC    Y(MSGSE-MSGS)
         DC    AL3(0)
         DC    C'TRANSFER BLOCK SIZE (SMALL=0,..,4=LARGE) : '
MSGSE    EQU   *
MSGSPAR  DC    C'1'
MSGSEE   EQU   *
*
MSGOP    DC    Y(MSGOPE-MSGOP)
         DC    AL3(0)
         DC    X'274081D67C'           PAG: PAR70D
MSGOPPAR DC    X'00C1F8D6C100007C'     GBF = OPEN
         DC    CL16' '                 NAME, EXTENSION
         DC    X'5A'                   END OF PAG
         DC    X'274081C87C'           PAG, PAR00D
         DC    X'406D00C100000000'     GEF = LA7, BYPASS
         DC    X'5A'                   END OF PAG
MSGOPE   EQU   *
*
         EJECT
MSGWR    DC    Y(MSGWRE-MSGWR)
         DC    AL3(0)
         DC    X'2740817C7C'           PAG: PAR00L
         DC    X'C500C4004A000000'     LOCK
         DC    X'5A'                   END OF PAG
         DC    X'274081D67C'           PAG: PAR70D
MSGWRPAR DC    X'00C1F8E6C100007C'     GBF = WRITE
         DC    X'5A'                   END OF PAG
         DC    X'27912740D4'           P, P20
         DC    X'27406D'               LA7
         DC    X'2791'                 P
MSGWRE   EQU   *
*
MSGPK    DC    Y(MSGPKE-MSGPK)
         DC    AL3(0)
         DC    X'2740817C7C'           PAG: PAR00L
         DC    X'C500C4004A000000'     LOCK
         DC    X'5A'                   END OF PAG
         DC    X'274081C87C'           PAG, PAR00D
         DC    X'40D400C100000000'     GEF = P20, BYPASS
         DC    X'5A'                   END OF PAG
MSGPKE   EQU   *
*
MSGCL    DC    Y(MSGCLE-MSGCL)
         DC    AL3(0)
         DC    X'274081D67C'           PAG: PAR70D
MSGCLPAR DC    X'00C1F8C3C100007C'     GBF = CLOSE
         DC    X'5A'                   END OF PAG
         DC    X'274081C87C'           PAG, PAR00D
         DC    X'406D00C100000000'     GEF = LA7, BYPASS
         DC    X'5A'                   END OF PAG
MSGCLE   EQU   *
*
MSGNE    DC    Y(MSGNEE-MSGNE)
         DC    AL3(0)
         DC    C'FTHTB: NORMAL END'
MSGNEE   EQU   *
*
MSGAE    DC    Y(MSGAEE-MSGAE)
         DC    AL3(0)
         DC    C'FTHTB: ABNORMAL END'
MSGAEE   EQU   *
*
MSGCN    DC    Y(MSGCNE-MSGCN)
         DC    AL3(0)
         DC    C'HOST FILE SIZE (NUMBER OF RECORDS/BYTES) : '
MSGCNNUM DC    C'1234567/1234567.'
MSGCNE   EQU   *
*
         EJECT
DWORD    DS    D
F15      DC    F'15'
H0       DC    H'0'
H1       DC    H'1'
H2       DC    H'2'
H4       DC    H'4'
H7       DC    H'7'
H28      DC    H'28'
H32      DC    H'32'
H96      DC    H'96'
H99      DC    H'99'
H100     DC    H'100'
H128     DC    H'128'
X40      DC    XL2'4040'
ASEOF    DC    X'1A'
WBYT1    DS    C
ERRSW    DC    C'N'
GBTSEOF  DC    C'N'
GBBEOF   DC    C'N'
GRREOF   DC    C'N'
FIOEOF   DC    C'N'
*
SWITCHES DC    X'00'                   INIT VIA GETSW
SMSGINIT EQU   X'01'                   SUPPRESS INITIAL MESSAGES
SMSGDSAC EQU   X'02'                   USE ACCEPT INSTEAD OF DISPACCP
SMSGFINL EQU   X'04'                   SUPPRESS FINAL MESSAGES
*                                      COUNTERS
RECIN    DS    F
BYTIN    DS    F
RECOUT   DS    F
BYTOUT   DS    F
INPLAST  DS    F
*
OUTMAX   DS    F                       TRANSFER BUFFER SIZE
OUTMAX0  DC    F'254'
OUTMAX1  DC    F'510'
OUTMAX2  DC    F'1022'
OUTMAX3  DC    F'2046'
OUTMAX4  DC    F'4094'
*
FILETYPE DC    C'T'                    TYPE OF FILE: T/S/B
*
SUBRPAR1 DC    H'0'                    SUBROUTINE PARAMETER 1
PSBYTE   EQU   X'00'                   PUT/SEND BYTE (NORMAL CALL)
PSLAST   EQU   X'01'                   PUT/SEND LAST (FLUSH BUFFERS)
AGETBTS  DC    A(GETBTS)
AGETBBIN DC    A(GETBBIN)
AGETRRAW DC    A(GETRRAW)
ASNDBASC DC    A(SNDBASC)
AFILEIO  DC    A(FILEIO)
ATERMIO  DC    A(TERMIO)
AASCII   DC    A(ASCII)
AEBCDIC  DC    A(EBCDIC)
ARBUFF   DC    A(RBUFF)
LRBUFF   DC    Y(L'RBUFF)
AFBUFF   DC    A(FBUFF)
LFBUFF   DC    Y(L'FBUFF)
         EJECT
**********************************************************************
*
* GET BYTE TEXT/SPOOL
* AT END SET GBTSEOF TO C'Y'.
* STRIP OFF TRAILING SPACES.
* AT END OF RECORD, INSERT CR LF (ASCII X'0D0A').
* IF SPOOL FILE, CONVERT FIRST BYTE OF RECORD (PRINT CONTROL CHAR.)
*    TO FF (ASCII X'0C) OR N X LF (ASCII X'0A) AND INSERT BEFORE OR
*    AFTER RECORD.
* EBCDIC-ASCII TRANSLATION REPLACES UNDEFINED CHARACTERS BY DEL.
*
**********************************************************************
GETBTS   DS    0H                      GET BYTE TEXT/SPOOL
         USING *,SCALL
         STM   SBASE,RETURN,GBTSSAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
GBTSBEG  DS    0H
         XR    CREG,CREG
         XR    WREG0,WREG0
         CLI   LFCNTBEF,X'00'          LF BEFORE PRINTING ?
         BE    NOLFBEF
         IC    CREG,ASLF               RETURN LF
         IC    WREG0,LFCNTBEF          DECREMENT COUNTER
         BCTR  WREG0,R0
         STC   WREG0,LFCNTBEF
         B     GBTSEND
NOLFBEF  DS    0H                      NO LF BEFORE PRINTING
         CLI   FFCNTBEF,X'00'          FF BEFORE PRINTING ?
         BE    NOFFBEF
         IC    CREG,ASFF               RETURN FF
         IC    WREG0,FFCNTBEF          DECREMENT COUNTER
         BCTR  WREG0,R0
         STC   WREG0,FFCNTBEF
         B     GBTSEND
NOFFBEF  DS    0H                      NO FF BEFORE PRINTING
         C     INPNDX,INPLAST          LAST CHARACTER IN BUFFER ?
         BL    GBTSOK
         CLI   CRCNTAFT,X'00'          CR AFTER PRINTING ?
         BE    NOCRAFT
         IC    CREG,ASCR               RETURN CR
         IC    WREG0,CRCNTAFT          DECREMENT COUNTER
         BCTR  WREG0,R0
         STC   WREG0,CRCNTAFT
         B     GBTSEND
         EJECT
NOCRAFT  DS    0H                      NO CR AFTER PRINTING
         CLI   LFCNTAFT,X'00'          LF AFTER PRINTING ?
         BE    NOLFAFT
         IC    CREG,ASLF               RETURN LF
         IC    WREG0,LFCNTAFT          DECREMENT COUNTER
         BCTR  WREG0,R0
         STC   WREG0,LFCNTAFT
         B     GBTSEND
NOLFAFT  DS    0H                      NO LF AFTER PRINTING
         CLI   FFCNTAFT,X'00'          FF AFTER PRINTING ?
         BE    NOFFAFT
         IC    CREG,ASFF               RETURN FF
         IC    WREG0,FFCNTAFT          DECREMENT COUNTER
         BCTR  WREG0,R0
         STC   WREG0,FFCNTAFT
         B     GBTSEND
NOFFAFT  DS    0H                      NO FF AFTER PRINTING
         L     SCALL,AGETRRAW          GET NEXT RECORD
         BALR  RETURN,SCALL
         CLI   GRREOF,C'Y'             EOF ?
         BNE   STRIPTSP                NO, STRIP TRAILING SPACES
         MVI   GBTSEOF,C'Y'            EOF
         B     GBTSEND
STRIPTSP DS    0H                      STRIP OFF TRAILING SPACES
         L     WREG0,INPLAST           POINT TO END
STRIPDEC BCTR  WREG0,R0                DECREMENT POINTER
         CR    WREG0,INPNDX            BACK TO START OF RECORD ?
         BL    STRIPEND                YES
         CLI   0(WREG0),X'40'          SPACE ?
         BE    STRIPDEC                YES, DO MORE
STRIPEND LA    WREG0,1(WREG0)          NO, INCREMENT POINTER
         ST    WREG0,INPLAST           AND UPDATE INPLAST
*                                      DETERMINE PRINT CONTROL CHAR
         MVI   PRNCC,X'40'             DEFAULT PRINT CONTROL CHAR
         CLI   FILETYPE,C'S'
         BE    SPOOL1ST
         B     PRNCTRL                 TEXT FILE, USE DEFAULT
         EJECT
SPOOL1ST DS    0H                      GET 1ST CHAR OF SPOOL REC
         C     INPNDX,INPLAST          EMPTY ? (NO TRAILING SP!)
         BNL   PRNCTRL                 YES, USE DEFAULT = SPACE
         MVC   PRNCC,0(INPNDX)         GET 1ST CHAR AS PRINT CC
         LA    INPNDX,1(INPNDX)        INCREMENT POINTER
PRNCTRL  DS    0H                      ANALYZE PRINT CONTROL CHAR
         TM    PRNCC,X'40'             2**6 SET ?
         BZ    PRNCCAFT                NO, CC AFTER PRINTING
PRNCCBEF DS    0H                      CC BEFORE PRINTING
         TM    PRNCC,X'80'             2**7 SET ?
         BZ    PRNLFBEF                NO, LF BEFORE PRINTING
PRNFFBEF DS    0H                      FF BEFORE PRINTING
         MVI   FFCNTBEF,X'01'          1 FF BEFORE PRINTING
         MVI   CRCNTAFT,X'01'          1 CR AFTER PRINTING
         MVI   LFCNTAFT,X'01'          1 LF AFTER PRINTING
         B     PRNCCEND
PRNLFBEF DS    0H                      LF BEFORE PRINTING
         IC    WREG0,PRNCC
         N     WREG0,F15               USE 2**0, 2**1 AND 2**2 AS
         STC   WREG0,LFCNTBEF          N LF BEFORE PRINTING
         MVI   CRCNTAFT,X'01'          1 CR AFTER PRINTING
         MVI   LFCNTAFT,X'01'          1 LF AFTER PRINTING
         B     PRNCCEND
PRNCCAFT DS    0H                      CC AFTER PRINTING
         TM    PRNCC,X'80'             2**7 SET ?
         BZ    PRNLFAFT                NO, LF AFTER PRINTING
PRNFFAFT DS    0H                      FF AFTER PRINTING
         MVI   CRCNTAFT,X'01'          1 CR AFTER PRINTING
         MVI   LFCNTAFT,X'01'          1 LF AFTER PRINTING
         MVI   FFCNTAFT,X'01'          1 FF AFTER PRINTING
         B     PRNCCEND
PRNLFAFT DS    0H                      LF AFTER PRINTING
         MVI   CRCNTAFT,X'01'          1 CR AFTER PRINTING
         IC    WREG0,PRNCC
         N     WREG0,F15               USE 2**0, 2**1 AND 2**2 AS
         STC   WREG0,LFCNTAFT          N LF AFTER PRINTING
         B     PRNCCEND
PRNCCEND DS    0H                      END PRINT CC ANALYSIS
         B     GBTSBEG                 GO BACK TO RETURN 1ST CHAR
GBTSOK   DS    0H                      POINTERS OK
         XR    CREG,CREG
         IC    CREG,0(INPNDX)          GET NEXT CHARACTER
         L     WREG0,AASCII
         IC    CREG,0(WREG0,CREG)
         LA    INPNDX,1(INPNDX)
GBTSEND  LM    SBASE,RETURN,GBTSSAVE
         BR    RETURN
GBTSSAVE DS    2F
LFCNTBEF DC    X'00'         LINE FEED COUNT BEFORE PRINTING
FFCNTBEF DC    X'00'         FORM FEED COUNT BEFORE PRINTING
CRCNTAFT DC    X'00'         CARRIAGE RETURN COUNT AFTER PRINTING
LFCNTAFT DC    X'00'         LINE FEED COUNT AFTER PRINTING
FFCNTAFT DC    X'00'         FORM FEED COUNT AFTER PRINTING
PRNCC    DS    X             PRINT CONTROL CHARACTER
ASCR     DC    X'0D'         ASCII CARRIAGE RETURN
ASLF     DC    X'0A'         ASCII LINE FEED
ASFF     DC    X'0C'         ASCII FORM FEED
         DROP  SBASE
         EJECT
**********************************************************************
*
* GET BYTE BINARY
* HOST FILE IS READ AND TRANSFERRED 1 TO 1.
*
**********************************************************************
GETBBIN  DS    0H                      GET BYTE BINARY
         USING *,SCALL
         STM   SBASE,RETURN,GBBSAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
         C     INPNDX,INPLAST
         BL    GBBOK
         L     SCALL,AGETRRAW          GET NEXT RECORD
         BALR  RETURN,SCALL
         CLI   GRREOF,C'Y'
         BNE   GBBOK
         MVI   GBBEOF,C'Y'
         B     GBBEND
GBBOK    DS    0H
         XR    CREG,CREG
         IC    CREG,0(INPNDX)
         LA    INPNDX,1(INPNDX)
GBBEND   LM    SBASE,RETURN,GBBSAVE
         BR    RETURN
GBBSAVE  DS    2F
         DROP  SBASE
         EJECT
**********************************************************************
*
* GET RECORD RAW (WITHOUT CONVERSION).
*
**********************************************************************
GETRRAW  DS    0H                      GET RECORD RAW
         USING *,SCALL
         STM   SBASE,RETURN,GRRSAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
*                                      GET RECORD FROM FILE
         L     INPNDX,AFBUFF
         MVI   SUBRPAR1+1,SAMGET       SAM GET
         L     SCALL,AFILEIO           FILE I/O
         BALR  RETURN,SCALL
         CLI   FIOEOF,C'Y'             EOF ?
         BE    GRREOFX
*
         LH    INPLEN,0(INPNDX)
         SH    INPLEN,H4
         LA    INPNDX,4(INPNDX)
         LR    WREG0,INPNDX
         AR    WREG0,INPLEN
         ST    WREG0,INPLAST
*                                      INCREMENT COUNTERS
         L     WREG0,RECIN
         LA    WREG0,1(WREG0)
         ST    WREG0,RECIN
         LR    WREG0,INPLEN
         A     WREG0,BYTIN
         ST    WREG0,BYTIN
         B     GRREND
*
GRREOFX  MVI   GRREOF,C'Y'
         B     GRREND
GRREND   LM    SBASE,RETURN,GRRSAVE
         BR    RETURN
GRRSAVE  DS    2F
         DROP  SBASE
         EJECT
**********************************************************************
*
* SEND BYTE ASCII
* SNDBASC CONVERTS X'00'-X'7F' TO TRANSPARENT FORMAT X'20'-X'7F'.
* SNDBCOMP (SEND BYTE COMPRESSED) COMPRESSES ALL CHARACTERS.
* SNDBRAW (SEND BYTE RAW) BLOCKS TO THE SPECIFIED BUFFER LENGTH.
* SNDREC (SEND RECORD) SENDS A RECORD TO THE TERMINAL.
*
**********************************************************************
SNDBASC  DS    0H                      SEND BYTE ASCII
         USING *,SCALL
         STM   SBASE,RETURN,SBASAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
         CLI   SUBRPAR1+1,PSLAST       LAST CALL ?
         BE    SBALAST
         STC   CREG,SBACHAR
         CLI   SBACHAR,X'20'
         BNL   RANGEN1
         MVI   CURRANGE,DC1
         AH    CREG,H32
         B     CMPRANGE
RANGEN1  DS    0H
         CLI   SBACHAR,X'80'
         BNL   RANGEN2
         MVI   CURRANGE,DC2
         B     CMPRANGE
RANGEN2  DS    0H
         CLI   SBACHAR,X'A0'
         BNL   RANGEN3
         MVI   CURRANGE,DC3
         SH    CREG,H96
         B     CMPRANGE
RANGEN3  DS    0H
         MVI   CURRANGE,DC4
         SH    CREG,H128
*        B     CMPRANGE
CMPRANGE DS    0H
         STC   CREG,SBACHAR
         CLC   OLDRANGE,CURRANGE
         BE    RANGEOK
         IC    CREG,CURRANGE
         BAL   RETURN,SNDBCOMP
RANGEOK  DS    0H
         MVC   OLDRANGE,CURRANGE
         IC    CREG,SBACHAR
         BAL   RETURN,SNDBCOMP
         B     SBAEND
*
SBALAST  DS    0H                      SEND BYTE ASCII LAST
         MVI   SUBRPAR1+1,PSLAST       PUT LAST BYTE (FLUSH BUFFERS)
         BAL   RETURN,SNDBCOMP
SBAEND   LM    SBASE,RETURN,SBASAVE
         BR    RETURN
         EJECT
SBASAVE  DS    2F
OLDRANGE DC    X'FF'
CURRANGE DC    X'00'
SBACHAR  DS    X
DC1      EQU   X'11'
DC2      EQU   X'12'
DC3      EQU   X'13'
DC4      EQU   X'14'
**********************************************************************
*
* SEND BYTE COMPRESSED; WILL ONLY BE CALLED BY SNDBASC.
*
**********************************************************************
SNDBCOMP DS    0H                      SEND BYTE COMPRESSED
         ST    RETURN,SBCSAVE
         CLI   SUBRPAR1+1,PSLAST       LAST CALL ?
         BE    SBCLAST
         STC   CREG,SBCCURCH
         CLC   SBCCOUNT,H0
         BNE   SBCCNTOK
         MVC   SBCCOUNT,H1
         B     SBCEND
SBCCNTOK DS    0H
         CLC   SBCCURCH,SBCOLDCH
         BNE   SBCOUT
         LH    WREG0,SBCCOUNT
         LA    WREG0,1(WREG0)
         STH   WREG0,SBCCOUNT
         CLC   SBCCOUNT,H100
         BL    SBCEND
* OLD CHARACTER NOT EQUAL TO CURRENT CHARACTER OR COUNT = 100
SBCOUT   DS    0H
         CLC   SBCCOUNT,H4
         BNL   SBCNL4
SBCLOOP  IC    CREG,SBCOLDCH
         BAL   RETURN,SNDBRAW
         LH    WREG0,SBCCOUNT
         BCTR  WREG0,R0
         STH   WREG0,SBCCOUNT
         CH    WREG0,H0
         BNE   SBCLOOP
         MVC   SBCCOUNT,H1
         B     SBCEND
SBCNL4   DS    0H
         CLC   SBCCOUNT,H100
         BNE   SBCN100
         MVC   SBCCOUNT,H99
SBCN100  DS    0H
         IC    CREG,XDCK
         BAL   RETURN,SNDBRAW
         LH    CREG,SBCCOUNT
         AH    CREG,H28
         BAL   RETURN,SNDBRAW
         IC    CREG,SBCOLDCH
         BAL   RETURN,SNDBRAW
         MVC   SBCCOUNT,H1
         B     SBCEND
         EJECT
SBCLAST  DS    0H                      SEND BYTE COMPRESSED LAST
         MVI   SUBRPAR1+1,PSBYTE       PUT BYTE
         CLC   SBCCOUNT,H4
         BNL   SBCLNL4
SBCLLOOP IC    CREG,SBCOLDCH
         BAL   RETURN,SNDBRAW
         LH    WREG0,SBCCOUNT
         BCTR  WREG0,R0
         STH   WREG0,SBCCOUNT
         CH    WREG0,H0
         BNE   SBCLLOOP
         B     SBCLEND
SBCLNL4  DS    0H
         IC    CREG,XDCK
         BAL   RETURN,SNDBRAW
         LH    CREG,SBCCOUNT
         AH    CREG,H28
         BAL   RETURN,SNDBRAW
         IC    CREG,SBCOLDCH
         BAL   RETURN,SNDBRAW
SBCLEND  MVI   SUBRPAR1+1,PSLAST       PUT LAST BYTE (FLUSH BUFFERS)
         BAL   RETURN,SNDBRAW
SBCEND   MVC   SBCOLDCH,SBCCURCH
         L     RETURN,SBCSAVE
         BR    RETURN
SBCSAVE  DS    F
SBCCOUNT DC    H'0'
SBCOLDCH DC    X'0'
SBCCURCH DC    X'0'
XDCK     DC    X'1A'
         EJECT
**********************************************************************
*
* SEND BYTE RAW; WILL ONLY BE CALLED BY SNDBCOMP.
*
**********************************************************************
SNDBRAW  DS    0H                      SEND BYTE RAW
         ST    RETURN,SBRSAVE
         CLI   SUBRPAR1+1,PSLAST       LAST CALL ?
         BE    SBRLAST
         L     WREG0,AEBCDIC
         IC    CREG,0(WREG0,CREG)
         STC   CREG,0(OUTNDX)
         LA    OUTNDX,1(OUTNDX)
         LA    OUTLEN,1(OUTLEN)
         C     OUTLEN,OUTMAX
         BNH   SBREND
         BAL   RETURN,SNDREC
         B     SBREND
SBRLAST  DS    0H                      SEND BYTE RAW LAST
         CH    OUTLEN,MSGPK
         BNH   SBREND
         BAL   RETURN,SNDREC
SBREND   L     RETURN,SBRSAVE
         BR    RETURN
SBRSAVE  DS    F
**********************************************************************
*
* SEND RECORD; WILL ONLY BE CALLED BY SNDBRAW.
*
**********************************************************************
SNDREC   DS    0H                      SEND RECORD
         ST    RETURN,SRSAVE
*                                      INCREMENT COUNTERS
         L     WREG0,RECOUT
         LA    WREG0,1(WREG0)
         ST    WREG0,RECOUT
         LR    WREG0,OUTLEN
         A     WREG0,BYTOUT
         SH    WREG0,MSGPK
         ST    WREG0,BYTOUT
*                                      PREPARE OUTPUT BUFFER
         L     OUTNDX,ARBUFF
         STH   OUTLEN,0(OUTNDX)
         LA    ERRADR,ERREND
         MVI   SUBRPAR1+1,SEND         SEND
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
*                                      RESET OUTBUT BUFFER
         L     OUTNDX,ARBUFF
         LH    OUTLEN,MSGPK
         AR    OUTNDX,OUTLEN
         L     RETURN,SRSAVE
         BR    RETURN
SRSAVE   DS    F
         DROP  SBASE
         EJECT
**********************************************************************
*
* SYSTEM DEPENDENT FILE I/O
*
* SAMOPENI: OPEN INPUT, SAM FILE
* SAMOPENE: OPEN EXTEND, SAM FILE
* SAMCLOSE: CLOSE SAM FILE
* SAMGET:   GET NEXT RECORD FROM SAM FILE
* SAMPUT:   PUT NEXT RECORD IN SAM FILE
*
* INPUT PARAMETERS USED:
*
* SAMOPENI/E: INPNDX CONTAINS ADDRESS OF FILE NAME
* SAMGET:     INPNDX CONTAINS ADDRESS OF BUFFER
* SAMPUT:     OUTNDX CONTAINS ADDRESS OF BUFFER
*
* OTHER REGISTERS USED: R0, R1, DBASE
* SAMOPENI/E: OUTLEN CHANGED
*
**********************************************************************
FILEIO   DS    0H
         USING *,SCALL
         STM   SBASE,RETURN,FIO$SAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
         USING ID1FCB,DBASE
         LH    WREG0,SUBRPAR1
         B     FIO$BEG(WREG0)
FIO$BEG  DS    0H
SAMOPENI EQU   *-FIO$BEG
         B     FIO$SOI
SAMOPENE EQU   *-FIO$BEG
         B     FIO$SOE
SAMCLOSE EQU   *-FIO$BEG
         B     FIO$SC
SAMGET   EQU   *-FIO$BEG
         B     FIO$SG
SAMPUT   EQU   *-FIO$BEG
         B     FIO$SP
*
FIO$SOI  DS    0H                      SAM OPEN INPUT
         LA    DBASE,FIO$FCB
         MVI   ID1OPEN,ID1INPUT
         B     FIO$SO
FIO$SOE  DS    0H                      SAM OPEN EXTENDED
         LA    DBASE,FIO$FCB
         MVI   ID1OPEN,ID1EXTEN
         B     FIO$SO
         EJECT
         USING IDBPFLPL,DBASE
FIO$SO   DS    0H                      SAM OPEN
         LA    DBASE,FIO$FILE+4
         NI    IDBIND2,X'FF'-IDBFCBTY
         OI    IDBIND2,IDBSAM
FIO$OPEN DS    0H
         LH    OUTLEN,0(INPNDX)
         SH    OUTLEN,H4
         CH    OUTLEN,H0
         BNE   FIO$NMOK
         LH    OUTLEN,H1
         MVI   4(INPNDX),C' '
FIO$NMOK SH    OUTLEN,H1
         EX    OUTLEN,FIO$MVC
         MVC   MSGHNPAR(44),IDBFILE
         CNOP  0,4
FIO$FILE FILE  X,LINK=LINKFIO
         LA    R1,FIO$FCB
         XR    R0,R0
         OPEN  (1),(0)
         B     FIO$END
FIO$MVC  MVC   IDBFILE(0),4(INPNDX)
         DROP  DBASE
*
FIO$SC   DS    0H
         CLOSE FIO$FCB
         B     FIO$END
*
FIO$SG   DS    0H
         LR    R0,INPNDX
         LA    R1,FIO$FCB
         GET   (1),(0)
         B     FIO$END
*
FIO$SP   DS    0H
         LR    R0,OUTNDX
         LA    R1,FIO$FCB
         PUT   (1),(0)
         B     FIO$END
*
FIO$EOF  DS    0H
         MVI   FIOEOF,C'Y'
         B     FIO$END
*
FIO$END  LM    SBASE,RETURN,FIO$SAVE
         BR    RETURN
FIO$SAVE DS    2F
         DS    0F
FIO$FCB  FCB   FCBTYPE=,LINK=LINKFIO,EXIT=FIO$EXLS
FIO$EXLS EXLST ERROPT=ERREND,COMMON=ERREND,EOFADDR=FIO$EOF
*        PRINT GEN
         CSEND ,
         IDPFL D, GENERATE NAMES FOR FILE MACRO
         IDFCB D, GENERATE NAMES FOR FCB MACRO
         CSBEG ,
         DROP  SBASE
         EJECT
**********************************************************************
*
* SYSTEM DEPENDENT TERMINAL I/O
*
* ACCEPT:   RECEIVE MESSAGE FROM TERMINAL IN LINE MODE
* RECEIVE:  RECEIVE MESSAGE FROM TERMINAL IN FORMAT MODE
* DISPLAY:  SEND MESSAGE TO TERMINAL IN LINE MODE
* SEND:     SEND MESSAGE TO TERMINAL IN FORMAT MODE
* DISPACCP: TANDEM DISPLAY/ACCEPT
* SENDRECV: TANDEM SEND/RECEIVE
*
* INPUT PARAMETERS USED:
*
* INPNDX:   ADDRESS OF INPUT BUFFER
* INPLEN:   LENGTH OF INPUT BUFFER
* OUTNDX:   ADDRESS OF OUTPUT BUFFER
* ERRADR:   ADDRESS OF ERROR ROUTINE
*
* ACCEPT:   INPNDX   INPLEN
* RECEIVE:  INPNDX   INPLEN
* DISPLAY:                    OUTNDX   ERRADR
* SEND:                       OUTNDX   ERRADR
* DISPACCP: INPNDX   INPLEN   OUTNDX   ERRADR
* SENDRECV: INPNDX   INPLEN   OUTNDX   ERRADR
*
* OTHER REGISTERS USED: R1, DBASE, RETURN
*
**********************************************************************
TERMIO   DS    0H
         USING *,SCALL
         STM   SBASE,RETURN,TIO$SAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
         USING CUPAB,DBASE
         LH    WREG0,SUBRPAR1
         B     TIO$BEG(WREG0)
TIO$BEG  DS    0H
ACCEPT   EQU   *-TIO$BEG
         B     TIO$A
RECEIVE  EQU   *-TIO$BEG
         B     TIO$R
DISPLAY  EQU   *-TIO$BEG
         B     TIO$D
SEND     EQU   *-TIO$BEG
         B     TIO$S
DISPACCP EQU   *-TIO$BEG
         B     TIO$DA
SENDRECV EQU   *-TIO$BEG
         B     TIO$SR
DISACC   EQU   *-TIO$BEG
         B     TIO$DASW
*
TIO$DASW DS    0H
         TM    SWITCHES,SMSGDSAC
         BZ    TIO$DA
         B     TIO$A
         EJECT
*
TIO$A    DS    0H
         LA    DBASE,CUPABDS
         ST    INPNDX,CURAREAW
         MVI   CUREDIT1,CRD1COMP
         MVI   CUREDIT2,X'00'
         STH   INPLEN,CURALEN
         B     T$RDATA
TIO$R    DS    0H
         LA    DBASE,CUPABDS
         ST    INPNDX,CURAREAW
         MVI   CUREDIT1,CRD1LNET+CRD1PHYS
         MVI   CUREDIT2,X'00'
         STH   INPLEN,CURALEN
*        B     T$RDATA
T$RDATA  DS    0H
         LA    R1,CURAREAW
         RDATA (1)
         B     TIO$END
TIO$D    DS    0H
         LA    DBASE,CUPABDS
         ST    OUTNDX,CUWMSGW
         MVI   CUWEDIT1,CWR1COMP
         ST    ERRADR,CUWERRW
         MVI   CUWEDIT2,X'00'
         B     T$WROUT
TIO$S    DS    0H
         LA    DBASE,CUPABDS
         ST    OUTNDX,CUWMSGW
         MVI   CUWEDIT1,CWR1LNET+CWR1PHYS
         ST    ERRADR,CUWERRW
         MVI   CUWEDIT2,X'00'
*        B     T$WROUT
T$WROUT  DS    0H
         LA    R1,CUWMSGW
         WROUT (1)
         B     TIO$END
         EJECT
*
TIO$DA   DS    0H
         LA    DBASE,CUPABDS
         ST    OUTNDX,CUBMSGW
         MVI   CUBOEDT1,CWR1COMP
         MVI   CUBOEDT2,X'00'
         ST    INPNDX,CUBAREAW
         MVI   CUBIEDT1,CRD1BACK
         MVI   CUBIEDT2,X'00'
         STH   INPLEN,CUBALEN
         ST    ERRADR,CUBERRW
         B     T$WRTRD
TIO$SR   DS    0H
         LA    DBASE,CUPABDS
         ST    OUTNDX,CUBMSGW
         MVI   CUBOEDT1,CWR1LNET+CWR1PHYS
         MVI   CUBOEDT2,X'00'
         ST    INPNDX,CUBAREAW
         MVI   CUBIEDT1,CRD1LNET+CRD1BACK+CRD1LCT+CRD1PHYS
         MVI   CUBIEDT2,X'00'
         STH   INPLEN,CUBALEN
         ST    ERRADR,CUBERRW
*        B     T$WRTRD
T$WRTRD  DS    0H
         LA    R1,CUBMSGW
         WRTRD (1)
         B     TIO$END
         DROP  DBASE
CUPABDS  DS    4F
         CSEND ,
         CUPAB D GENERATE DSECT FOR RDATA, WROUT AND WRTRD MACROS
         CSBEG ,
TIO$END  LM    SBASE,RETURN,TIO$SAVE
         BR    RETURN
TIO$SAVE DS    2F
         DROP  SBASE
         EJECT
**********************************************************************
*
* CODE-TRANSLATION TABLE USED BY GETBTS FOR TEXT AND SPOOL FILES.
* TRANSLATE FROM EBCDIC TO ASCII.
* MAY BE CHANGED TO ACCOUNT FOR SPECIAL CODES SUCH AS IBM-PC.
* UNDEFINED CHARACTERS REPLACED BY DEL (ASCII X'7F').
*
**********************************************************************
*
ASCII    DS    0CL256                  TRANSLATE EBCDIC --> ASCII
*                0 1 2 3 4 5 6 7 8 9 A B C D E F
         DC    X'000102037F097F7F7F7F7F0B0C0D0E0F' 00
         DC    X'101112137F7F087F18197F7F1C1D1E1F' 10
         DC    X'7F7F7F7F7F0A171B7F7F7F7F7F050607' 20
         DC    X'7F7F167F7F7F7F047F7F7F7F14157F1A' 30
         DC    X'207F7F7F7F7F7F7F7F7F602E3C282B7C' 40
         DC    X'267F7F7F7F7F7F7F7F7F21242A293B7F' 50
         DC    X'2D2F7F7F7F7F7F7F7F7F5E2C255F3E3F' 60
         DC    X'7F7F7F7F7F7F7F7F7F7F3A2340273D22' 70
         DC    X'7F6162636465666768697F7F7F7F7F7F' 80
         DC    X'7F6A6B6C6D6E6F7071727F7F7F7F7F7F' 90
         DC    X'7F7F737475767778797A7F7F7F7F7F7F' A0
         DC    X'7F7F7F7F7F7F7F7F7F7F7F5B5C5D7F7F' B0
         DC    X'7F4142434445464748497F7F7F7F7F7F' C0
         DC    X'7F4A4B4C4D4E4F5051527F7F7F7F7F7F' D0
         DC    X'7F7F535455565758595A7F7F7F7F7F7F' E0
         DC    X'303132333435363738397F7B7F7D7F7E' F0
*
**********************************************************************
*
* CODE-TRANSLATION TABLE USED ONLY BY SNDBRAW.
* MUST AGREE WITH THE TRANSLATION TABLE IN THE PDN.
* TRANSLATE FROM ASCII (DIN 66003/ISO 646) TO EBCDIC.DF.03.
* CF. BS1000 BS2000 TRANSDATA PDN, SYSTEMS STANDARDS
*     REFERENCE MANUAL, FEB. 1984, ORDER NO.: U1551-J-Z55-1-7600.
* UNDEFINED CHARACTERS REPLACED BY DEL (EBCDIC X'07').
*
**********************************************************************
*
EBCDIC   DS    0CL256                  TRANSLATE ASCII --> EBCDIC
*                0 1 2 3 4 5 6 7 8 9 A B C D E F
         DC    X'00010203372D2E2F1605250B0C0D0E0F' 00
         DC    X'101112133C3D322618193F271C1D1E1F' 10
         DC    X'405A7F7B5B6C507D4D5D5C4E6B604B61' 20
         DC    X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 30
         DC    X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 40
         DC    X'D7D8D9E2E3E4E5E6E7E8E9BBBCBD6A6D' 50
         DC    X'4A818283848586878889919293949596' 60
         DC    X'979899A2A3A4A5A6A7A8A9FB4FFDFF07' 70
         DC    X'07070707070707070707070707070707' 80
         DC    X'07070707070707070707070707070707' 90
         DC    X'07070707070707070707070707070707' A0
         DC    X'07070707070707070707070707070707' B0
         DC    X'07070707070707070707070707070707' C0
         DC    X'07070707070707070707070707070707' D0
         DC    X'07070707070707070707070707070707' E0
         DC    X'07070707070707070707070707070707' F0
*
RBUFF    DS    0CL4100
RBUFFL   DS    H
         DS    H
         DS    4096C
*
FBUFF    DS    0CL4100
FBUFFL   DS    H
         DS    H
         DS    4096C
         END   START
       DS    4096C
*
FBUFF    DS    0CL4100
FB