KEXT     TITLE 'NIH TSO KERMIT - EXTERNAL ROUTINES AND TABLES'
*
*  THE FOLLOWING MACROS ARE USED TO BUILD THE TRANSLATE TABLES
*
*  3 TABLES ARE BUILT:
*
*     ASCII TO EBCDIC TRANSLATION TABLE
*     EBCDIC TO ASCII TRANSLATION TABLE
*     EBCDIC TO ASCII INVALID CODES TRANSLATE AND TEST TABLE
*
*  THE MACROS ARE
*
*     TTABLES - DEFINES TABLE NAMES AND DEFAULT VALUES
*     TTCH    - DEFINES ASCII/EBCDIC AND EBCDIC/ASCII TRANSLATION
*     TRCHAE  - DEFINES ASCII/EBCDIC TRANSLATION ONLY
*     TRCHEA  - DEFINES EBCDIC/ASCII TRANSLATION ONLY
*
*  IN THE TRTABLES MACRO THE OPERANDS ARE
*
*     NAME OF ASCII TO EBCDIC TRANSLATE TABLE
*     DEFAULT EBCDIC CODE FOR ASCII TO EBCDIC TRANSLATION
*     NAME OF EBCDIC TO ASCII TRANSLATE TABLE
*     DEFAULT ASCII CODE FOR EBCDIC TO ASCII TRANSLATION
*     NAME OF THE INVALID CHARACTER TABLE FOR EBCDIC TO ASCII
*
*  IN THE TTCH MACROS THE EBCDIC CODE IS GIVEN FIRST, THEN THE ASCII.
*  THE THIRD OPERAND IS AN OPTIONAL COUNT FOR A SEQUENCE OF CONSECUTIVE
*  CHARACTERS.
*
         EJECT
         MACRO
         TTABLES &AE,&AEDEF,&EA,&EADEF,&TEA
         GBLC  &TTAE,&TTEA,&TTTEA
.*
&TTAE    SETC  '&AE'
&TTEA    SETC  '&EA'
&TTTEA   SETC  '&TEA'
.*
&TTAE    DC    256AL1(&AEDEF)
&TTEA    DC    256AL1(&EADEF)
&TTTEA   DC    256AL1(4)
         MEND
*
         MACRO
         TTCH  &EBCDIC,&ASCII,&COUNT
         GBLC  &TTAE,&TTEA,&TTTEA
         LCLA  &X
.*
.LOOP    ANOP
         ORG   &TTAE+&ASCII+&X
         DC    AL1(&EBCDIC+&X)
         ORG   &TTAE+&ASCII+&X+128
         DC    AL1(&EBCDIC+&X)
         ORG   &TTEA+&EBCDIC+&X
         DC    AL1(&ASCII+&X)
         ORG   &TTTEA+&EBCDIC+&X
         DC    AL1(0)
&X       SETA  &X+1
         AIF   ('&COUNT' EQ '').END
         AIF   (&X LT &COUNT).LOOP
.END     MEND
*
         MACRO
         TTCHAE &EBCDIC,&ASCII,&COUNT
         GBLC  &TTAE,&TTEA,&TTTEA
         LCLA  &X
.*
.LOOP    ANOP
         ORG   &TTAE+&ASCII+&X
         DC    AL1(&EBCDIC+&X)
         ORG   &TTAE+&ASCII+&X+128
         DC    AL1(&EBCDIC+&X)
&X       SETA  &X+1
         AIF   ('&COUNT' EQ '').END
         AIF   (&X LT &COUNT).LOOP
.END     MEND
*
         MACRO
         TTCHEA &EBCDIC,&ASCII,&COUNT
         GBLC  &TTAE,&TTEA,&TTTEA
         LCLA  &X
.*
.LOOP    ANOP
         ORG   &TTEA+&EBCDIC+&X
         DC    AL1(&ASCII+&X)
         ORG   &TTTEA+&EBCDIC+&X
         DC    AL1(0)
&X       SETA  &X+1
         AIF   ('&COUNT' EQ '').END
         AIF   (&X LT &COUNT).LOOP
.END     MEND
         EJECT
*
*  BUILD THE TRANSLATE TABLES
*
TABLES   CSECT
         ENTRY ATOETBL,ETOATBL,ETOAERRT
         TTABLES ATOETBL,C':',ETOATBL,X'3A',ETOAERRT   DEFAULT IS COLON
         TTCH  X'00',X'00'             NUL - NULL
         TTCH  X'01',X'01'             SOH - START OF HEADER
         TTCH  X'02',X'02'             STX - START OF TEXT
         TTCH  X'03',X'03'             ETX - END OF TEXT
*
*  DUE TO A GLITCH IN TCAM, AN EBCDIC EOT (X'37') WILL NOT
*  BE SENT OUT AS AN ASCII EOT (X'04') EVEN IF THE TRANSLATE
*  TABLE IS SET UP THAT WAY.  THEREFORE NIH HAS X'33' GOING
*  TO AN EOT IN ITS OUTGOING TSO TRANSLATE TABLE.
*
         TTCHEA X'37',X'04'            EOT - END OF TRANSMISSION
         TTCHEA X'33',X'04'            EOT - END OF TRANSMISSION
         TTCHAE X'33',X'04'            EOT - END OF TRANSMISSION
         TTCH  X'2D',X'05'             ENQ - ENQUIRY
         TTCH  X'2E',X'06'             ACK - ACKNOWLEDGE
         TTCH  X'2F',X'07'             BEL - BELL
         TTCH  X'16',X'08'             BS  - BACKSPACE
         TTCH  X'05',X'09'             HT  - HORIZONTAL TAB
         TTCH  X'25',X'0A'             LF  - LINEFEED
         TTCH  X'0B',X'0B'             VT  - VERTICAL TAB
         TTCH  X'0C',X'0C'             FF  - FORM FEED
         TTCH  X'0D',X'0D'             CR  - CARRIAGE RETURN
         TTCH  X'0E',X'0E'             SO  - SHIFT OUT
         TTCH  X'0F',X'0F'             SI  - SHIFT IN
         TTCH  X'10',X'10'             DLE - DATA LINK ESCAPE
         TTCH  X'11',X'11'             DC1 - DEVICE CONTROL 1 (XON)
         TTCH  X'12',X'12'             DC2 - DEVICE CONTROL 2
         TTCH  X'35',X'13'             DC3 - DEVICE CONTROL 3 (XOFF)
         TTCH  X'3C',X'14'             DC4 - DEVICE CONTROL 4
         TTCH  X'3D',X'15'             NAK - NEGATIVE ACKNOWLEDGE
         TTCH  X'32',X'16'             SYN - SYNCHRONOUS IDLE
         TTCH  X'26',X'17'             ETB - END TRANSMISSION BLOCK
         TTCH  X'18',X'18'             CAN - CANCEL
         TTCH  X'19',X'19'             EM  - END OF MEDIUM
         TTCH  X'3F',X'1A'             SUB - SUBSTITUTE
         TTCH  X'27',X'1B'             ESC - ESCAPE
         TTCH  X'1C',X'1C'             FS  - FILE SEPARATOR
         TTCH  X'1D',X'1D'             GS  - GROUP SEPARATOR
         TTCH  X'1E',X'1E'             RS  - RECORD SEPARATOR
         TTCH  X'1F',X'1F'             US  - UNIT SEPARATOR
         TTCH  C' ',X'20'              SPACE
         TTCH  C'!',X'21'              EXCLAMATION POINT
         TTCH  C'"',X'22'              DOUBLE QUOTE
         TTCH  C'#',X'23'              POUND SIGN
         TTCH  C'$',X'24'              DOLLAR SIGN
         TTCH  C'%',X'25'              PERCENT SIGN
         TTCH  C'&&',X'26'             AMPERSAND
         TTCH  C'''',X'27'             SINGLE QUOTE
         TTCH  C'(',X'28'              LEFT PARENTHESIS
         TTCH  C')',X'29'              RIGHT PARENTHESIS
         TTCH  C'*',X'2A'              ASTERISK
         TTCH  C'+',X'2B'              PLUS SIGN
         TTCH  C',',X'2C'              COMMA
         TTCH  C'-',X'2D'              MINUS SIGN (HYPHEN)
         TTCHEA X'62',X'2D'            WYLBUR INSERTED HYPHEN
         TTCH  C'.',X'2E'              PERIOD
         TTCH  C'/',X'2F'              SLASH
         TTCH  C'0',X'30',10           DIGITS 0-9
         TTCH  C':',X'3A'              COLON
         TTCH  C';',X'3B'              SEMICOLON
         TTCH  C'<',X'3C'              LESS THAN
         TTCH  C'=',X'3D'              EQUAL SIGN
         TTCH  C'>',X'3E'              GREATER THAN
         TTCH  C'?',X'3F'              QUESTION MARK
         TTCH  C'@',X'40'              AT SIGN
         TTCH  C'A',X'41',9            UPPER CASE A-I
         TTCH  C'J',X'4A',9            UPPER CASE J-R
         TTCH  C'S',X'53',8            UPPER CASE S-Z
         TTCH  X'AD',X'5B'             LEFT SQUARE BRACKET
         TTCH  X'E0',X'5C'             BACKSLASH
         TTCH  X'BD',X'5D'             RIGHT SQUARE BRACKET
         TTCH  X'5F',X'5E'             CIRCUMFLEX (EBCDIC NOT SIGN)
         TTCHEA X'BE',X'5E'            CIRCUMFLEX
         TTCH  C'_',X'5F'              UNDERSCORE
         TTCH  X'79',X'60'             ACCENT GRAVE
         TTCH  C'a',X'61',9            LOWER CASE A-I
         TTCH  C'j',X'6A',9            LOWER CASE J-R
         TTCH  C's',X'73',8            LOWER CASE S-Z
         TTCH  X'8B',X'7B'             LEFT CURLY BRACE
         TTCHEA X'C0',X'7B'            LEFT CURLY BRACE
         TTCH  X'4F',X'7C'             VERTICAL BAR
         TTCH  X'9B',X'7D'             RIGHT CURLY BRACE
         TTCHEA X'D0',X'7D'            RIGHT CURLY BRACE
         TTCH  X'A1',X'7E'             TILDE
         TTCH  X'07',X'7F'             DEL - DELETE
         ORG
         EJECT
*
*   THIS ROUTINE RETURNS THE NAME OF THE SYSTEM WIDE PROFILE
*   USE THIS TO SET DEFAULTS FOR ALL TSO KERMIT USERS IN THE
*   SYSTEM
*
*   RETURN - REG 1 POINTS TO NAME OF SYSTEM PROFILE
*            REG 0 IS LENGTH OF STRING
*
         ENTRY SYSPRODS
SYSPRODS BALR  15,0
         USING *,15
         LA    1,SYSPROF               ADDRESS OF PROFILE NAME
         LA    0,SYSPROFL              LENGTH OF PROFILE NAME
         BR    14
         DROP  15
*
*  PLACE THE FULLY QUALIFIED DSNAME OF YOUR SYSTEM PROFILE IN SYSPROF
*
SYSPROF  DC    C'NIH.KERMIT.PROFILE.CLIST'
SYSPROFL EQU   *-SYSPROF
         EJECT
*
*   THIS ROUTINE RETURNS THE NAME OF THE USER PROFILE
*   USE THIS TO SET DEFAULTS FOR EACH TSO KERMIT USER
*
*   RETURN - REG 1 POINTS TO NAME OF USER PROFILE
*            REG 0 IS LENGTH OF STRING
*
         ENTRY USRPRODS
USRPRODS BALR  15,0
         USING *,15
         LA    1,USRPROF               ADDRESS OF PROFILE NAME
         LA    0,USRPROFL              LENGTH OF PROFILE NAME
         BR    14
         DROP  15
*
*      PLACE THE DATA SET NAME OF YOUR USER PROFILE IN USRPROF
*      THE USERID PREFIX WILL BE ADDED BY TSO KERMIT
*
USRPROF  DC    C'KERMIT.PROFILE.CLIST'
USRPROFL EQU   *-USRPROF
         EJECT
*
*   THIS ROUTINE RETURNS A NAME USED IN SET VOLUME TO INDICATE
*   THAT THE SYSTEM MAY CHOOSE THE VOLUME TO BE USED TO STORE
*   A RECEIVED DATA SET.
*
*   RETURN - REG 1 POINTS TO STRING CONTAINING NAME
*            REG 0 IS LENGTH OF STRING
*
         ENTRY XANYVOL
XANYVOL  BALR  15,0
         USING  *,15
         LA    1,ANYVOL                ADDRESS OF NAME
         LA    0,ANYVOLL               LENGTH OF NAME
         BR    14
         DROP  15
*
*  PLACE THE NAME OF YOUR CHOICE HERE
*
ANYVOL   DC    C'TMP'
ANYVOLL  EQU   *-ANYVOL
         EJECT
*
*   THIS ROUTINE RETURNS A STRING CONTAINING THE USERID
*   PREFIX THAT TSO KERMIT USES TO PREFIX DATA SET NAMES
*   UNLESS THE DATA SET NAMES ARE IN QUOTES.  UPON
*   ENTRY TO THE ROUTINE, ADDRESSES OF THE COMMAND
*   PROCESSOR PARAMETER LIST AND THE USER PROFILE TABLE ARE
*   AVAILABLE IN REGISTERS.  NIH USES STANDARD IBM CONTROL
*   BLOCKS IN THIS AREA.  INSTALLATIONS WHICH HAVE MODIFIED
*   THE WAY DATA SET NAMES ARE PREFIXED CAN MODIFY
*   THIS ROUTINE.  NIH USES THE FIELDS UPTPREX AND
*   UPTPREFL FOR PREFIX AND LENGTH RESPECTIVELY.  IF YOUR
*   INSTALLATION USES THE SAME STANDARDS, THEN NO
*   MODIFICATIONS WILL BE NECESSARY ON YOUR PART.
*
*   INPUT REG 1=A(CPPL)
*         REG 0=A(UPT)
*
*   RETURN - REG 1 POINTS TO USER PREFIX
*            REG 0 IS PREFIX LENGTH
*
         ENTRY USERID
USERID   BALR  15,0
         USING *,15
         LR    1,0
         USING UPT,1
         SR    0,0
         IC    0,UPTPREFL
         LA    1,UPTPREFX
         DROP  1
         BR    14
         EJECT
         IKJCPPL
         EJECT
         IKJUPT
         END
