         TITLE 'FTTHB - FILE TRANSFER FROM TERMINAL TO HOST'
***********************************************************************
*
*        F T T H B
*        FILE TRANSFER FROM TERMINAL TO HOST 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
FTTHB    START
         PRINT NOGEN,IOFF
START    DS    0H
         BALR  BASE,0
         USING *,BASE
*                                      GET SWITCHES
         GETSW
         STC   R0,SWITCHES
*                                      START MESSAGE
         TM    SWITCHES,SMSGINIT
         BNZ   GTTERM                  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
*
GTTERM   DS    0H
         LA    OUTNDX,MSGTN            GET NAME OF TERMINAL FILE
         L     INPNDX,ARBUFF
         LH    INPLEN,LRBUFF
         LA    ERRADR,ABEND
         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   MSGRDPAR+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
         EJECT
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
*
GTHOST   DS    0H
         LA    OUTNDX,MSGHN            GET NAME OF HOST FILE
         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,SAMOPENE     SAM OPEN EXTEND
         L     SCALL,AFILEIO           FILE I/O
         BALR  RETURN,SCALL
*
GTFTYPE  DS    0H                      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   MSGTPAR(1),4(INPNDX)
         OI    MSGTPAR,X'40'           UPPER CASE CHAR
         XR    WREG0,WREG0
         CLI   MSGTPAR,C'T'
         BE    GTFTYPEE
         LA    WREG0,128
         CLI   MSGTPAR,C'B'
         BNE   GTFTYPE
GTFTYPEE DS    0H                      SET RECORD LENGTH
         ST    WREG0,MAXLEN
         EJECT
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
         OI    4(INPNDX),X'C0'         EBCDIC C0--C4 = ASCII 40--44
         MVC   MSGRDPAR+SPA(1),4(INPNDX)  LENGTH BYTE IN ADA=SPA
*
         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,MSGRD            SEND PAG FOR READ
         LA    ERRADR,ERREND
         MVI   SUBRPAR1+1,SEND         SEND
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
*                                      INIT COUNTERS
         XR    WREG0,WREG0
         ST    WREG0,RECIN
         ST    WREG0,RECOUT
         ST    WREG0,BYTIN
         ST    WREG0,BYTOUT
         ST    WREG0,REPCOUNT
         ST    WREG0,OFFSETC
*                                      INIT OUT FILE BUFFER
         XR    OUTLEN,OUTLEN
         L     OUTNDX,AFBUFF
         MVC   2(2,OUTNDX),X40
         LA    OUTNDX,4(OUTNDX)
*
         XR    INPLEN,INPLEN           FORCE INITIAL RCVREC
         EJECT
*                                      MAIN LOOP
         CLI   MSGTPAR,C'T'
         BE    TEXTLOOP
         CLI   MSGTPAR,C'B'
         BE    BINLOOP
         B     ERREND
*
TEXTLOOP DS    0H
         L     SCALL,ARCVBASC          RECEIVE BYTE ASCII
         BALR  RETURN,SCALL
         CLI   RCVEOF,C'Y'
         BE    TEXTEOF
         MVI   SUBRPAR1+1,PSBYTE       PUT BYTE
         L     SCALL,APUTBTXT          PUT BYTE TEXT
         BALR  RETURN,SCALL
         CLI   TXTEOF,C'Y'
         BE    TEXTEOF
         B     TEXTLOOP
TEXTEOF  MVI   SUBRPAR1+1,PSLAST       PUT LAST BYTE (FLUSH BUFFERS)
         L     SCALL,APUTBTXT          PUT BYTE TEXT
         BALR  RETURN,SCALL
         B     CLOSEALL
*
BINLOOP  DS    0H
         L     SCALL,ARCVBASC          RECEIVE BYTE ASCII
         BALR  RETURN,SCALL
         CLI   RCVEOF,C'Y'
         BE    BINEOF
         MVI   SUBRPAR1+1,PSBYTE       PUT BYTE
         L     SCALL,APUTBBIN          PUT BYTE BINARY
         BALR  RETURN,SCALL
         B     BINLOOP
BINEOF   MVI   SUBRPAR1+1,PSLAST       PUT LAST BYTE (FLUSH BUFFERS)
         L     SCALL,APUTBBIN          PUT BYTE BINARY
         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,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,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,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,RECOUT
         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'FTTHB: FILE TRANFER '
         DC    C'FROM TERMINAL (EP9750) '
         DC    C'TO HOST (BS2000) '
         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   *
*
MSGTN    DC    Y(MSGTNE-MSGTN)
         DC    AL3(0)
         DC    C'NAME OF SOURCE 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   *
*
MSGHN    DC    Y(MSGHNE-MSGHN)
         DC    AL3(0)
         DC    C'NAME OF TARGET FILE AT     HOST (BS2000) : '
MSGHNE   EQU   *
MSGHNPAR DS    CL44                    BS2000 FILE ID
MSGHNEE  EQU   *
*
MSGT     DC    Y(MSGTE-MSGT)
         DC    AL3(0)
         DC    C'TYPE OF FILE (T=TEXT, 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'274081D57C'           PAG: PAR60D
MSGOPPAR DC    X'00C1F8D6C100007C'     GBF = OPEN
         DC    CL16' '                 NAME, EXTENSION
         DC    X'5A'                   END OF PAG
         DC    X'274081C87C'           PAG: PAR00D
         DC    X'406A00C100000000'     GEF = LA6; BYPASS
         DC    X'5A'                   END OF PAG
MSGOPE   EQU   *
*
         EJECT
MSGRD    DC    Y(MSGRDE-MSGRD)
         DC    AL3(0)
         DC    X'2740817C7C'           PAG: PAR00L
         DC    X'C500C4004A000000'     LOCK
         DC    X'5A'                   END OF PAG
         DC    X'274081D57C'           PAG: PAR60D
MSGRDPAR DC    X'00C1F8D9C100007C'     GBF = READ
         DC    X'5A'                   END OF PAG
         DC    X'27912740D4'           P, P20
         DC    X'27406A2786'           LA6, DUE1
         DC    X'2791'                 P
MSGRDE   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'274081D57C'           PAG: PAR60D
MSGCLPAR DC    X'00C1F8C3C100007C'     GBF = CLOSE
         DC    X'5A'                   END OF PAG
         DC    X'274081C87C'           PAG: PAR00D
         DC    X'406A00C100000000'     GEF = LA6; BYPASS
         DC    X'5A'                   END OF PAG
MSGCLE   EQU   *
*
MSGNE    DC    Y(MSGNEE-MSGNE)
         DC    AL3(0)
         DC    C'FTTHB: NORMAL END'
MSGNEE   EQU   *
MSGAE    DC    Y(MSGAEE-MSGAE)
         DC    AL3(0)
         DC    C'FTTHB: 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
H0       DC    H'0'
H1       DC    H'1'
H2       DC    H'2'
H4       DC    H'4'
H7       DC    H'7'
X40      DC    XL2'4040'
WBYT1    DS    C
ERRSW    DC    C'N'                    ERROR SWITCH
RCVEOF   DC    C'N'                    RECEIVE END
TXTEOF   DC    C'N'                    END OF TEXT FILE
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
RECOUT   DS    F
BYTOUT   DS    F
RECIN    DS    F
BYTIN    DS    F
INPLAST  DS    F
MAXLEN   DC    F'0'                    MAX RECORD LENGTH FOR OUT FILE
*                                         0 = TEXT FILE
REPCOUNT DS    F                       REPEAT COUNT
*                                           0 = NO REPEAT
*                                         < 0 = REPEAT COUNT MISSING
OFFSETR  DC    F'29'                   ADJUSTMENT FACTOR
OFFSETC  DS    F                       OFFSET FOR TRANSMISSION CHAR
OFFDC1   DC    F'-32'
OFFDC2   DC    F'0'
OFFDC3   DC    X'00000060'
OFFDC4   DC    X'00000080'
*                                      ASCII CONTROL CHARACTERS
ASCIISP  DC    X'00000020'
ASCIILF  DC    X'0000000A'
ASCIIDC1 DC    X'00000011'
ASCIIDC2 DC    X'00000012'
ASCIIDC3 DC    X'00000013'
ASCIIDC4 DC    X'00000014'
ASCIIDCK DC    X'0000001A'
ASCIIEOF DC    X'0000001A'
*
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)
APUTBBIN DC    A(PUTBBIN)
APUTBTXT DC    A(PUTBTEXT)
APUTRRAW DC    A(PUTRRAW)
ARCVBASC DC    A(RCVBASC)
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
**********************************************************************
*
* PUT BYTE IN BINARY FORMAT.
* 1 TO 1 ASCII IMAGE OF TERMINAL FILE.
* SAM, RECFORM=V, ALL RECORDS 128 BYTES LONG.
*
**********************************************************************
PUTBBIN  DS    0H                      PUT BYTE BINARY
         USING *,SCALL
         STM   SBASE,RETURN,PBBSAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
         CLI   SUBRPAR1+1,PSLAST       LAST CALL ?
         BE    PBBLAST
         STC   CREG,0(OUTNDX)
         LA    OUTNDX,1(OUTNDX)
         LA    OUTLEN,1(OUTLEN)
         C     OUTLEN,MAXLEN
         BL    PBBEND
         L     SCALL,APUTRRAW          PUT RECORD RAW
         BALR  RETURN,SCALL
         B     PBBEND
PBBLAST  DS    0H                      PUT BYTE BINARY LAST
         LTR   OUTLEN,OUTLEN
         BZ    PBBEND                  NO RECORD PENDING
*                                      WRITE LAST RECORD
         L     SCALL,APUTRRAW          PUT RECORD RAW
         BALR  RETURN,SCALL
PBBEND   LM    SBASE,RETURN,PBBSAVE
         BR    RETURN
PBBSAVE  DS    2F
         DROP  SBASE
         EJECT
**********************************************************************
*
* PUT BYTE IN TEXT FORMAT
* EBCDIC, SAM, RECFORM=V
* ASCII BIT 2**7 IS RESET.
* LF (ASCII X'0A') LEADS TO NEW RECORD.
* ASCII X'1A' LEADS TO EOF.
*
**********************************************************************
PUTBTEXT DS    0H                      PUT BYTE TEXT
         USING *,SCALL
         STM   SBASE,RETURN,PBTSAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
         CLI   SUBRPAR1+1,PSLAST       LAST CALL ?
         BE    PBTLAST
*
         C     CREG,ASCIISP            CARE FOR ASCII CONTROL CODES
         BL    PBTCTRL
*
         L     WREG0,AEBCDIC           CONVERT TO EBCDIC
         IC    CREG,0(WREG0,CREG)
         STC   CREG,0(OUTNDX)          PUT IN BUFFER
         LA    OUTNDX,1(OUTNDX)
         LA    OUTLEN,1(OUTLEN)
         B     PBTEND
*
PBTCTRL  DS    0H
         C     CREG,ASCIILF            LINE FEED ?
         BNE   PBTEOF
*                                      AVOID RECORD LENGTH = 0
         LTR   OUTLEN,OUTLEN
         BH    PBTNZ
         MVI   0(OUTNDX),X'40'         SPACE
         LA    OUTLEN,1(OUTLEN)
PBTNZ    DS    0H
         L     SCALL,APUTRRAW          PUT RECORD RAW
         BALR  RETURN,SCALL
         B     PBTEND
*
PBTEOF   C     CREG,ASCIIEOF           EOF ?
         BNE   PBTEND
         MVI   TXTEOF,C'Y'
         B     PBTEND
PBTLAST  DS    0H                      PUT BYTE TEXT LAST
         LTR   OUTLEN,OUTLEN
         BZ    PBTEND                  NO RECORD PENDING
*                                      WRITE LAST RECORD
         L     SCALL,APUTRRAW          PUT RECORD RAW
         BALR  RETURN,SCALL
PBTEND   LM    SBASE,RETURN,PBTSAVE
         BR    RETURN
PBTSAVE  DS    2F
         DROP  SBASE
         EJECT
**********************************************************************
*
* PUT RECORD RAW (WITHOUT CONVERSION).
*
**********************************************************************
PUTRRAW  DS    0H                      PUT RECORD RAW
         USING *,SCALL
         STM   SBASE,RETURN,PRRSAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
*                                      INCREMENT COUNTERS
         L     WREG0,RECOUT
         LA    WREG0,1(WREG0)
         ST    WREG0,RECOUT
         LR    WREG0,OUTLEN
         A     WREG0,BYTOUT
         ST    WREG0,BYTOUT
*
         L     OUTNDX,AFBUFF
         LA    OUTLEN,4(OUTLEN)
         STH   OUTLEN,0(OUTNDX)
*
         MVI   SUBRPAR1+1,SAMPUT       SAM PUT
         L     SCALL,AFILEIO           FILE I/O
         BALR  RETURN,SCALL
*
         XR    OUTLEN,OUTLEN
         L     OUTNDX,AFBUFF
         LA    OUTNDX,4(OUTNDX)
*
         LM    SBASE,RETURN,PRRSAVE
         BR    RETURN
PRRSAVE  DS    2F
         DROP  SBASE
         EJECT
**********************************************************************
*
* RECEIVE BYTE IN ASCII FORMAT.
* AT END SET RCVEOF TO C'Y'.
* CONVERT TRANSPARENT AND COMPRESSED LINE FORMAT TO ORIGINAL ASCII.
*
**********************************************************************
RCVBASC  DS    0H                      RECEIVE BYTE ASCII
         USING *,SCALL
         STM   SBASE,RETURN,RBASAVE
         DROP  SCALL
         BALR  SBASE,R0
         USING *,SBASE
RBALOOP  DS    0H
         XR    CREG,CREG
         LTR   INPLEN,INPLEN           END OF RECORD ?
         BH    REPSEQ                  NO
         BAL   RETURN,RCVREC           YES, GET NEXT RECORD
         CLI   RCVEOF,C'Y'             END OF FILE ?
         BE    RBAEND                  YES, END
*
REPSEQ   DS    0H                      CARE FOR REPEAT SEQUENCE
         L     WREG0,REPCOUNT
         LTR   WREG0,WREG0
         BZ    RBABUFF                 NO REPEAT SEQUENCE
         BH    RBAREP                  IN REPEAT SEQUENCE
*                                      GET REPEAT COUNT
         IC    CREG,0(INPNDX)
         L     WREG0,AASCII
         IC    CREG,0(WREG0,CREG)
         LA    INPNDX,1(INPNDX)
         BCTR  INPLEN,R0
         S     CREG,OFFSETR
         ST    CREG,REPCOUNT
         B     RBALOOP
*
RBAREP   DS    0H                      REPEAT CURRENT CHARACTER
         BCTR  WREG0,R0
         ST    WREG0,REPCOUNT
         IC    CREG,0(INPNDX)
         L     WREG0,AASCII
         IC    CREG,0(WREG0,CREG)
         B     RBAANALY
*
RBABUFF  DS    0H                      GET CHAR FROM BUFFER
         IC    CREG,0(INPNDX)
         L     WREG0,AASCII
         IC    CREG,0(WREG0,CREG)
         LA    INPNDX,1(INPNDX)
         BCTR  INPLEN,R0
         B     RBAANALY
         EJECT
RBAANALY DS    0H                      CARE FOR TRANSMISSION CONTROL
         C     CREG,ASCIISP
         BL    RBADC1
         A     CREG,OFFSETC
         B     RBAEND
*
RBADC1   C     CREG,ASCIIDC1
         BNE   RBADC2
         L     CREG,OFFDC1
         ST    CREG,OFFSETC
         B     RBALOOP
*
RBADC2   C     CREG,ASCIIDC2
         BNE   RBADC3
         L     CREG,OFFDC2
         ST    CREG,OFFSETC
         B     RBALOOP
*
RBADC3   C     CREG,ASCIIDC3
         BNE   RBADC4
         L     CREG,OFFDC3
         ST    CREG,OFFSETC
         B     RBALOOP
*
RBADC4   C     CREG,ASCIIDC4
         BNE   RBADCK
         L     CREG,OFFDC4
         ST    CREG,OFFSETC
         B     RBALOOP
*
RBADCK   C     CREG,ASCIIDCK
         BNE   RBALOOP
         XR    CREG,CREG               INDIC: REPEAT COUNT MISSING
         BCTR  CREG,R0
         ST    CREG,REPCOUNT
         B     RBALOOP
RBAEND   LM    SBASE,RETURN,RBASAVE
         BR    RETURN
RBASAVE  DS    2F
         EJECT
**********************************************************************
*
* RECEIVE RECORD FROM TERMINAL
* WILL ONLY BE CALLED BY RCVBASC (RECEIVE BYTE ASCII)
*
**********************************************************************
RCVREC   DS    0H                      RECEIVE RECORD FROM TERMINAL
         ST    RETURN,RRSAVE
         ST    OUTNDX,RRSAVE1
         LA    OUTNDX,MSGPK
         L     INPNDX,ARBUFF
         LH    INPLEN,LRBUFF
         LA    ERRADR,ERREND
         MVI   SUBRPAR1+1,SENDRECV     SEND/RECEIVE
         L     SCALL,ATERMIO           TERMINAL I/O
         BALR  RETURN,SCALL
         L     OUTNDX,RRSAVE1
*
         LH    INPLEN,0(INPNDX)        SKIP RECORD HEADER
         SH    INPLEN,H4               4 BYTES LENGTH FIELD
         AH    INPNDX,H4
         LTR   INPLEN,INPLEN
         BNH   RREOF                   NO DATA = END OF TRANSMISSION
*                                      INCREMENT COUNTERS
         LR    WREG0,INPLEN
         A     WREG0,BYTIN
         ST    WREG0,BYTIN
         L     WREG0,RECIN
         LA    WREG0,1(WREG0)
         ST    WREG0,RECIN
         B     RREND
RREOF    MVI   RCVEOF,C'Y'
RREND    L     RETURN,RRSAVE
         BR    RETURN
RRSAVE   DS    F
RRSAVE1  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 ONLY BY RCVBASC.
* MUST AGREE WITH THE TRANSLATION TABLE IN THE PDN.
* TRANSLATE FROM EBCDIC.DF.03 TO ASCII (DIN 66003/ISO 646).
* CF. BS1000 BS2000 TRANSDATA PDN, SYSTEMS STANDARDS
*     REFERENCE MANUAL, FEB. 1984, ORDER NO.: U1551-J-Z55-1-7600.
* 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 BY PUTBTEXT FOR TEXT FILES.
* TRANSLATE FROM ASCII TO EBCDIC.
* MAY BE CHANGED TO ACCOUNT FOR SPECIAL CODES SUCH AS IBM-PC.
* RANGES X'00'-X'7F' AND X'80'-X'FF' IDENTICAL.
*
**********************************************************************
*
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'00010203372D2E2F1605250B0C0D0E0F' 80
         DC    X'101112133C3D322618193F271C1D1E1F' 90
         DC    X'405A7F7B5B6C507D4D5D5C4E6B604B61' A0
         DC    X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' B0
         DC    X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' C0
         DC    X'D7D8D9E2E3E4E5E6E7E8E9BBBCBD6A6D' D0
         DC    X'4A818283848586878889919293949596' E0
         DC    X'979899A2A3A4A5A6A7A8A9FB4FFDFF07' 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
FBUFFL   DS    H
         DS    H
         DS    4096C
*
         END   STA