Columbia Kermit/kermit.zip/ibmtsonih/tsnker.alp

Text File | 2020-01-01 | 236KB | 8,104 lines

KERMIT: TITLE 'NIH TSO KERMIT';
SUBTITLE 'MACRO DEFINITIONS';
MACRO &&L: CHAR &®  % MAKES INTEGER PRINTABLE
&&L:
    AI &®,32;
MEND;
MACRO &&L: BCCTYPE &&LIT;  % SETS BLOCK CHECK TYPE
&&L:
MVI LEVELCK,&&LIT;  % BCC LEVEL CHECKING
MVI BCCLEN+1,&&LIT;
MEND;

MACRO &&L: BUMPSEQ &®  % INCREMENTS SEQUENCE NUMBER
&&L:
LH &®,SEQNUM;  % GET PREVIOUS SEQ NUMBER
STH &®,OLDSEQ;
AI &®,1;  % INCREMENT IT
N  &®,MOD64;  % GET  MOD 64
STH &®,SEQNUM;
MEND;
 %   SPSPACK - PASS PARAMETERS TO SPACK
MACRO &&L: SPSPACK &&PTYPE,&&PNUM,&&SDATALEN,&®  % n
&&L:
MVI PTYPE,&&PTYPE;  % PACKET TYPE
LH &®,&&PNUM;
CHAR &®  % MAKE IT A CHARACTER
STC &®,PNUM;
MMVC PUTLEN,&&SDATALEN,2;  % DATA LEN OF SEND PACK
MEND;

MACRO &&L: RPSPACK &&SMARK,&&PTYPE,&&PNUM,&&SDATALEN,&&PTRDATA;  % n
&&L:
MMVC &&SMARK,SSOH;  % SOH PACKET FOR PACKET
MEND;
MACRO &&L: BUMPRTRY &®  % INCREMENT RETRY
&&L:
L &®,NUMTRY;  % GET RETRY COUNT
AI &®,1;  % INCREMENT BY 1
ST &®,NUMTRY;
MEND;
MACRO &&L: BUMPOTRY &®  % INCREMENT RETRY
&&L:
L &®,OLDTRY;  % GET RETRY COUNT
AI &®,1;  % INCREMENT BY 1
ST &®,OLDTRY;
MEND;
MACRO &&L: ZEROSEQ;  % ZERO OUT  RETRY
&&L:
MVI OLDSEQ,0;
MVI OLDSEQ,63;  % FORMER NUMBER
MZC SEQNUM,L'SEQNUM;  % GET RETRY COUNT
MEND;
MACRO &&L: ZERORTRY;  % ZERO OUT  RETRY
&&L:
MMVC OLDTRY,NUMTRY,4;
MZC NUMTRY,L'NUMTRY;  % GET RETRY COUNT
MEND;

MACRO &&L: ZEROSDAT;  % ZERO OUT  LENGTH OF DATA TO PUT
&&L:
MZC PUTLEN,2;  % ZERO LENGTH OF DATA TO PUT
MEND;

MACRO &&L: LENCALC &®1;
&&L:
LH &®1,BCCLEN;  % LEN OF BCC
AH &®1,PUTLEN;
AI &®1,YLEN;  % HEADER LENGTH
MEND;

MACRO &&L: MAKESLEN &&LIT,&®1;
&&L:
LI &®1,&&LIT;  % GET THE LITERAL
STH &®1,PUTLEN;
MEND;

MACRO &&L: UNCHAR &®  % TRANSFORMS PRINTABLE TO INTEGER
&&L:
    SI  &®,32;
MEND;
MACRO &&L: PACKTYPE &&LIT;  % MOVES PACKET TYPE   USED BY SPACK
&&L:
    MVI TYPE,&&LIT;
MEND;

MACRO &&L: CNTLLOC &&STORAGE;  % MAKES CNTL CHAR PRINT
&&L:
XI &&STORAGE,X'40';
MEND;

MACRO &&L: MOVEALL;  % MOVE ALL DATA
&&L:
LR VR0,VR1;
SR VR0,XRB;  % LENGTH
LR VR1,XRB;  % SET UP POINTER FOR SUB
CCALL PUTEM,A;  % SUB PUTS IN
AR VR1,VR0;  % VR1-> BACK WHERE WAS
%LH XRB,RDATALEN;
%SR XRB,VR0;
%STH XRB,RDATALEN;  % UPDATE GET LENGTH
DECREGDD XRB,VR0;  % DECREMENT COUNTER

MEND;


MACRO &&L: ACKIT &®  % ACKNOWLEDGE PACKET
&&L:
MMVC PNUM,RSEQ,1;  % MOVE SEQUENCE NUMBER
ADCONLEN &®,YLEN,PLEN;  % COMPUTE LENGTH
MVI PTYPE,YCOMLIT;  % YACK TYPE
CCALL SPACK,A;
ZR &®
IC &®,RSEQ;  % GET SEQUENCE NUMBER
UNCHAR &®  % MAKE INTEGER
STH &®,RECSEQ;  % STORE OFF COUNTER
MEND;

MACRO &&L: NACKIT &®  % NEGATIVE ACKNOWLEDGE PACKET
&&L:
MMVC PHDR,SSOH;  % PUT IN START OF HEADER
MMVC PNUM,RSEQ,1;  % MOVE SEQUENCE NUMBER
ADCONLEN &®,NLEN,PLEN;  % COMPUTE LENGTH
MVI PTYPE,NCOMLIT;  % NACK TYPE
CCALL SPACK,A;
MEND;
MACRO &&L: NACKPACK &&SEQ,&®  % NEGATIVE ACKNOWLEDGE PACKET
&&L:
SPSPACK AN,&&SEQ,ZERO,&®  % N PACKET,SEND PARAMETERS FOR SPACK
CCALL SPACK,A;
MEND;
MACRO &&L: SERVNACK &®  % NEGATIVE ACKNOWLEDGE PACKET
&&L:
MMVC PHDR,SSOH;  % PUT IN START OF HEADER
MVI PNUM,X'20';  % MOVE SERVER 0 NUMBER
ADCONLEN &®,NLEN,PLEN;  % COMPUTE LENGTH
MVI PTYPE,NCOMLIT;  % NACK TYPE
CCALL SPACK,A;
MEND;
MACRO &&L: ACKPACK &&SEQ,&®  % POSTIVE ACKNOWLEDGE PACKET
&&L:
SPSPACK AY,&&SEQ,ZERO,&®  % N PACKET,SEND PARAMETERS FOR SPACK
CCALL SPACK,A;
MEND;

MACRO &&L: ZAP8BIT &&STORAGE;  % MAKES CNTL CHAR PRINT
&&L:
NI &&STORAGE,X'7F';
MEND;

MACRO &&L: CNTLREG &®
&&L:
    X &®,O1H;  % XOR '64'
MEND;
MACRO &&L: ADCONLEN &®1,&&LITEQU,&&PACLEN;
&&L:
LI &®1,&&LITEQU;
% CHAR &®1;  % MAKE IT ALPHA INTEGER
MMVC PUTLEN,=X'0000',2;
STC &®1,&&PACLEN;
MEND;

MACRO &&L: DECRDATA &®1,&&LIT;
&&L:     % THIS MACRO DECREMENT RDATALEN + UPDATES RDATAADD
LH &®1,RDATALEN;
SI &®1,&&LIT;
STH &®1,RDATALEN;
L &®1,RDATAADD;
AI &®1,&&LIT;
ST &®1,RDATAADD;
MEND;

MACRO &&L: DECREGDD &®1,&®2;
&&L: %THIS MACRO DECREMENT RDATALEN UPDATES RDATAADD USING REGISTERS
L &®1,RDATAADD;
AR &®1,&®2;
ST &®1,RDATAADD;
LH &®1,RDATALEN;
SR &®1,&®2;
STH &®1,RDATALEN;
MEND;
BAL;  % FOR MACRO DEFINITIONS
         MACRO
&LAB     WRTERM &MSG
         LCLC   &MS
         LCLA   &LN
&MS      SETC  '&MSG'
&LN      SETA  K'&MS
&LN      SETA  &LN-2
&LAB     TPUT =C&MS,&LN
         MEND
         MACRO
&LAB     ERRORCON &MSG
         LCLC   &MS
         LCLA   &LN
&MS      SETC  '&MSG'
&LN      SETA  K'&MS
&LN      SETA  &LN-2
&LAB     LA 1,=C&MS
         LA 0,&LN
         MEND
         MACRO
&LAB     PROMPT &MSG
         LCLC   &MS
         LCLA   &LN
&MS      SETC  '&MSG'
&LN      SETA  K'&MS
&LN      SETA  &LN-2
&LAB     TPUT =C&MS,&LN,ASIS
         MEND
         MACRO
         RDTERM &BUFF
         TGET &BUFF,130
         MEND
ALP;
SUBTITLE 'DEFINITIONS';
COPY CPARMGBL;  % COPY GLOBAL SYMBOLS
KERMIT: CSETUP MDC=YES,S99=YES;

SPLEVEL SET=1;  % INSURE MVS/370 MACRO EXPANSIONS
EJECT;
WA: AREA; BEGIN
CSA VRE,HIGHR,EQU=(WAVRF,VRF);
WASIZE: AREAEND; END;
EJECT;
IKJCPPL;
IKJLSD;
IKJGTPB;
IKJUPT;
IKJPSCB;
IKJTAIE;
KERMIT: CSECT;
EJECT;
AD: EQU 68;  % DATA PACKET (ASCII 'D')
AN: EQU 78;  % NAK
AZ: EQU 90;  % EOF PACKET
AS: EQU 83;  % INIT PACKET
AY: EQU 89;  % ACK
AF: EQU 70;  % FILE PACKET
AB: EQU 66;  % BREAK PACKET
AE: EQU 69;  % ERROR PACKET
AX: EQU 88;

ERCOD: EQU 12;  % MEANS EOF WITH 'FSREAD'

FLG1: EQU X'80';  % IS FILE THE FIRST OR NOT
FLG2: EQU X'40';  % OVERWRITE SENT FILENAME?
FLG3: EQU X'20';  % ONE = SENT ONLY PARTIAL RECORD
FLG4: EQU X'10';  % NAK FROM MICRO(0) OR RPACK(1)?
FLG5: EQU X'08';  % ALLOCATED MORE SPACE (DMSFREE)
FLGBIN: EQU X'04';  % BINARY FILE TRANSFER

BIT8ON: EQU X'80';  % MASK FOR CHECKING AND TURNING
BIT8OFF: EQU X'7F';  % BITS ON OR OFF !!

QUOTEYES: EQU X'01';  % SWITCH FOR EIGHT BIT QUOTING
FILEWRIT: EQU X'80';  % FILE WRITE OCCURRED ?
SUBTITLE 'KERMCNTL';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%     MODULE NAME   -   KERMCNTL
%
%
%     FUNCTION-  THE DRIVER MODULE FOR KERMIT TSO
%
%
%
%     INPUTS -   NONE
%
%
%
%
%     OUTPUTS-   KERMIT PROCESSING COMPLETED
%
%
%     RETURN
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

OSENTER (14,12),SAVE=SAVECNTL,FORWARD=YES;
L XRF,PARMSADD;
LA XRG,4095(,XRF);  % SET UP STORAGE BASE REGS

         USING PARMS,XRF;
         USING PARMS+4095,XRG;
ST STKR,OSAVE;  % NEW STACK POINTER
LA STKR,STACK;  % INTERNAL STACK
ST VR1,CPPLADD;  % ADDRESS OF COMMAND PROCESSOR PARAMETER LIST
USE VR1 AS CPPL IN BEGIN
L XRA,CPPLUPT;  % FOR PUT GET STUFF
ST XRA,UPTADD;
L XRA,CPPLECT;
ST XRA,ECTADD;
MMVC CBUFFADD,CPPLCBUF,4;  % ADDRESS TO COMMAND
END;  % OF CPPL BLOCK

L VR1,CPPLADD;  % ADDRESS OF COMMAND PROCESSOR PARMETER LIST
L VR0,UPTADD;  % ADDRESS OF UPT
CALL USERID;  % EXTERNAL ROUTINE RETURNS ADDRESS AND LENGTH
                % OF USER PREFIX IN VR1 & VR0 RESPECTIVELY
IF <CI VR0,44; CC H> THEN BEGIN  % REAL PROBLEMS CAN NOT GET USER ID
WRTERM 'Length of user prefix greater than 44.'_
       '  Check USERID external routine.';
WRTERM 'Must terminate';
GOTO DOEXIT;
END;
ST VR1,USERPREA;  % STORE OFF PREFIX ADDRESS
STH VR0,USERPREL;  % LENGTH OF PREFIX

L XRD,STAXOLD;  % SAVE THE REPLACE
L XRB,STAXADD;  % PARMETER EXIT ROUTINE ADDRESS
L XRC,STAXLADD;  % PARM LIST  ADDRESS
STAX (XRB),DEFER=NO,REPLACE=YES,MF=(E,(XRD));
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));

LOAD EP=TSOLNK;
ST VR0,TSOADD;  % STORE OFF ADDRESS
L XRB,TGETADD;  % ADDRESS OF TGET MODULE
IDENTIFY EP=KERMTGET,ENTRY=(XRB);

IF <RNZ  VRF> THEN BEGIN  % ERROR IN IDENTIFY
TPUT =C'ERROR IN IDENTIFY',17;
END;

LOAD EP=IKJGETL;  % GET LINE ROUTINE ADDRESS
ST VR0,GETLINAD;  % STORE IT OFF
ATTACH EP=KERMTGET,PARAM=((XRF));
IF <RNZ VRF> THEN BEGIN
TPUT =C'ERROR IN ATTACH ',16;
END;

ST VR1,TASKADD;  % STORE OFF ADDRESS FOR DETACH

LOAD EP=IKJSTCK;  % STACK ROUTINE
ST VR0,STACKADD;  % STORE OFF POINTER TO STACK ROUTINE
CCALL STCKMOD,A;  % STACK ROUTINE TO CHECK FOR PARAMETER ON ENTRY

CALL EDINIT,(EDCNTRL,EDRETURN);  % INITIALIZATION FOR ED ROUTINES

 CCALL KRESET,A;  % INITALIZATION SUB

CCALL PROFILES,A;  % EXECUTES SYSTEM AND USER PROFILES


%WRTERM ' ';  % BLANK LINE
WRTERM 'NIH TSO KERMIT VERSION 1.1A';  % VERSION LOGON
%WRTERM ' ';  % BLANK LINE
MAINLOOP: FOREVER DO BEGIN  % MAIN LOOP
DO BEGIN  % LOOP IF NO INPUT
%PROMPT: ;  % MAIN PROMPT FOR PROGRAM
ZF STOPF;  % ZERO STOP FLAG INCASE IT WAS SET
IF <TF  SENDDSNF> THEN CALL EDCLOS,(EDCNTRL,EDRETURN);  % CLOSE INPUT
IF <TF RECVDSNF> THEN CALL EDCLOS,(EDCNTRL,EDRETURN);  %CLOSE OUTPUT

%  PROMPT      'KERMIT-TSO> ';  % MAIN PROMPT FOR PROGRAM
%             RDTERM INPUT;  % GET INPUT FROM USER
CCALL PROMPTIT,A;
LH VR1,INPUT;  % SET UP FOR DEBLANK
SI VR1,4;  % SUBTRACT OFF HEADER
END UNTIL <RNZ VR1>;  % IF NO INPUT REPROMPT


SCINIT INPUT+4,(VR1);  % SET UP SCANNER
SCTYPE NEW=1;
SCERROR NEW=PARSEERR;

SCANBLCK: DO BEGIN SCAN *;  % SCAN OFF FUNCTIONS

   SCKW  (RECEIVE,REC,R),DOREC;  % RECEIVE COMMAND
  SCKW  (SEND,S),DOSEND;  % SEND COMMAND - 44 CHAR
       SCKW  SHOW,DOSHOW;  % SHOW COMMAND
       SCKW  (ST,STATUS),DOSTATUS;  % STATUS COMMAND
       SCKW  EXIT,DOQUIT;  % EXIT COMMAND -
       SCKW  END,DOQUIT;  % END ALSO QUIT  COMMAND -
       SCKW  QUIT,DOQUIT;  % QUIT COMMAND -
       SCKW  SERVER,DOSERVER;  % SERVER COMMAND -
       SCKW  ?,DOQUES;  % QUESTION COMMAND -
       SCKW  HELP,DOHELP;  % HELP COMMAND -
       SCKW  RESET,DORESET;  % RESET COMMAND -
       SCKW  SET,DOSET;  % SET COMMAND -
       SCKW  TSO,DOTSO;  % TSO COMMAND -
SCKW TEST,DOTEST;  %
   SCKW  EXECUTE,DOEXEC;  % EXEC COMMAND -
       SCKW  (KERMIT,K),DOKERM;  % FOR EXEC COMMANDS TO CRUCOMVENT TSO
SCKW STOP,STOPHELP;  % COMMAND ONLY USED TO STOP TRANSFER
       SCKW ,INVALKEY;  % UNKNOWN COMMAND -
       SCANEND;

PARSEERR:
WRTERM 'Unknown TSO KERMIT command';

NEXT OF MAINLOOP;


DOREC:
<CCALL KRECEIVE,A>;  % WE HAVE A RECEIVE COM
NEXT OF MAINLOOP;
DOSEND:
               <CCALL KSEND,A>;  % WE HAVE A SEND COMMAND
NEXT OF MAINLOOP;
DOSHOW:
               <CCALL KSHOW,A>;  % WE HAVE A SHOW COMMAND
NEXT OF MAINLOOP;
DOSTATUS:
SCTELL;
IF <RP VR0> THEN BEGIN
WRTERM 'STATUS displays messages that tell what happened during the';
WRTERM 'last file transfer operation.';
END
ELSE <CCALL KSTATUS,A>;  % WE HAVE A STATUS COMMAND
NEXT OF MAINLOOP;
DOTEST:
 %IF YOUR SYSTEM PROGRAMMER THEN BEGIN
SF TESTF;
SCAN;
%SCANEND;
IF <MCLC 0(VR1),=C'OFF',3> THEN BEGIN
ZF TESTF;
CLOSE TESTFILE;
END
ELSE BEGIN
DATA BEGIN
TESTX: DC C'ALLOC FI(TESTFILE) DS(KERMIT.TESTFILE)'
END;

TESTXLEN:   EQU *-TESTX;
LI VR0,TESTXLEN;
%CCALL TSOCMD,A,VR1=TESTX;

OPEN (TESTFILE,(INPUT));
IF ^<OPENP TESTFILE> THEN BEGIN
WRTERM 'UNABLE TO OPENTEST FILE';
END;
END;
% END;
NEXT OF MAINLOOP;
DORESET:
SCAN *;
SCKW ?,RESETHLP;
SCKW HELP,RESETHLP;
SCANEND;

               <CCALL KRESET,A>;  % WE HAVE A RESET COMMAND
NEXT OF MAINLOOP;
DOKERM:
SCAN *;
SCKW ?,KERHELP;
SCKW ,*,B;  % PAST ON THROUGH
SCANEND;
NEXT OF SCANBLCK;
KERHELP :
WRTERM 'The KERMIT command allows TSO KERMIT to process TSO KERMIT';
WRTERM 'SET comands from an EXEC (CLIST) data set.';
WRTERM 'Any TSO KERMIT SET command '_
'in an EXEC data set must be prefixed by KERMIT.';
NEXT OF MAINLOOP;
RESETHLP:
WRTERM 'RESET resets TSO KERMIT options to initial defaults.';
NEXT OF MAINLOOP;
DOHELP:
SCTELL;
IF <RP VR0> THEN BEGIN
WRTERM 'HELP tells how to use the TSO KERMIT help facility to get';
WRTERM 'information about TSO KERMIT commands.';
END
ELSE BEGIN  % WE HAVE A HELP COMMAND
WRTERM 'Enter ? at prompt to receive list of commands.';
WRTERM 'Enter ? after a command to receive list of operands.';
                END;  % OF HELP

NEXT OF MAINLOOP;

DOQUES:
                BEGIN  % WE HAVE A ? COMMAND
CCALL MAINHELP,A;  % HELP ROUTINE

NEXT OF MAINLOOP;
END;  % OF QUESTION BLOCK
DOSET:
              <CCALL KSET,A>;  % WE HAVE A SET COMMAND
NEXT OF MAINLOOP;
STOPHELP:
WRTERM 'STOP is used to abort a file transfer currently in progress.';
NEXT OF MAINLOOP;

DOEXEC:     % EXEC A FILE FULL OF KERMIT COMMANDS
IF <CI VR0,7> THEN <MMVC 4(VR1),=C'   ',3>;
SCBACK;  % BACK UP TO INCLUDE COMMAND
SCTELL;  % GET REMAINDER
ST VR1,TSOCMDA;
STH VR0,TSOCMDL;
SCAN;
DO BEGIN SCAN *;  % CHECK FOR HELP REQUEST
   SCKW ?,EXECHELP;
   SCKW ,SENDEXEC;
   SCANEND;
END;
WRTERM 'EXECUTE command requires a data set name of TSO KERMIT'_
       ' commands.';
NEXT OF MAINLOOP;
EXECHELP:
WRTERM 'The EXECUTE command processes a data set containing TSO '_
       'KERMIT commands.  The only parameter is the';
WRTERM 'name of the data set.';
NEXT OF MAINLOOP;
SENDEXEC:

CCALL TSOCMD,A,VR1=L:TSOCMDA,VR0=LH:TSOCMDL;  % LET TSO FEED
NEXT OF MAINLOOP;
DOTSO:
SCTELL;

DEBLANK VR1,VR0,XRA;  % DEBLANK STRING
IF <RNP VR0> THEN BEGIN  % NO PARMS
% NO MESSAGE
WRTERM 'TSO Command requires a command string ';
NEXT OF MAINLOOP;

END
ELSE BEGIN
UNTIL ^<CLI 0(VR1),C' '>
DO BEGIN
SI VR0,1;  % DECREMENT COUNTER
AI VR1,1;
END;
IF <CI VR0,1> & <CLI 0(VR1),C'?'> THEN BEGIN

TSOHELP:
WRTERM _
'The TSO command is followed (on the same line) by a TSO command'_
       ' to be executed.';
NEXT OF MAINLOOP;
END
ELSE BEGIN

TSOKEY:       CCALL TSOCMD,A;  % WE HAVE A TSO COMMAND
END;
END;
NEXT OF MAINLOOP;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

DOQUIT:
DO BEGIN
SCAN *;
SCKW (HELP,?),EXITHELP;
SCKW ,BADEXIT;
SCANEND;

GOTO DOEXIT;  % REALLY WANT TO LEAVE

EXITHELP:
WRTERM 'END, EXIT, and QUIT terminate TSO KERMIT '_
'and return the user to TSO.';
NEXT OF MAINLOOP;

BADEXIT:
WRTERM 'No parameters except HELP for QUIT or END ';
NEXT OF MAINLOOP;
END;  % OF QUIT BLOCK


DOSERVER:
DO BEGIN
SCAN *;
SCKW (HELP,?),SERVHELP;
SCKW ,BADSERV;
SCANEND;

SF SERVERF;  % TURN ON SERVER INDICATOR
CCALL SERVER,A;  % ENGAGE SERVER SLAVE MODE


ZF SERVERF;  % TURN OFF SERVER INDICATOR
GOTO DOEXIT IF <TF LOGOUT>;  % IF LOGPOFF GET OUT

NEXT OF MAINLOOP;

SERVHELP:
WRTERM 'The SERVER command invokes TSO KERMIT '_
    'as a slave server of the microcomputer.';
WRTERM 'While TSO KERMIT is in server mode, all commands are'_
' normally';
WRTERM 'issued to the microcomputer only.  However, '_
'TSO KERMIT will recognize';
WRTERM '"FINISH" as a command to leave server mode.';
NEXT OF MAINLOOP;

BADSERV:
WRTERM 'No parameters except ? for SERVER';
NEXT OF MAINLOOP;
END;  % OF SERV BLOCK


%                 INVALID     COMMAND
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
INVALKEY:
WRTERM 'Invalid TSO KERMIT Command.'_
       '  Type in HELP if you need assistance.';

END;  % OF SCANBLCK
END;  % OF FOREVER MAIN DO LOOP
DOEXIT:
IF <TF  SENDDSNF> THEN CALL EDCLOS,(EDCNTRL,EDRETURN);  % CLOSE INPUT
IF <TF RECVDSNF> THEN CALL EDCLOS,(EDCNTRL,EDRETURN);  %CLOSE OUTPUT
IF <OPENP DEBUG> THEN CLOSE DEBUG;  % CLOSE FILES
CALL EDTERM,(EDCNTRL,EDRETURN);  % TERMINATE ED ROUTINE PROCESSING
DETACH TASKADD;  % RELEASE AYSN TGET READ ROUTINE

FREEMAIN RC,SP=18;  % FREE TAB BUFFER

L STKR,OSAVE;  % RESTORE STACK POINTER
ZR VRF;  % OK PROCESSING FOR CP
OSEXIT (14,14),(0,12),SAVE=SAVECNTL;

SAVECNTL:  DC  18F'0';  % SAVE AREA

USE VRF AS STAXEXIT IN BEGIN

STAXEXIT: DS  0H;
% THE STAX EXIT HERE DO NOTHING BUT KEEP GOING BR ON 14
RGOTO 14;  % GO REG 14
%
END;  % OF USING


PARMSADD:    DC   A(PARMS);  % ADDRESS OF STORAGE
LTORG;
STAXLIST: STAX 0,DEFER=NO,REPLACE=NO,MF=L;
STAXOLDL: STAX 0,DEFER=NO,REPLACE=YES,MF=L;
EXORG;
SUBTITLE 'MAINHELP';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%MOD: MAINHELP
% FUNCTION: PRINTS HELPS FOR DRIVER LOOP
% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
MAINHELP: CENTER VRE,HIGHR,ENTRY=NO;
WRTERM 'Legal commands are: ';
WRTERM ' ';
WRTERM 'RECEIVE uploads a data set (file) from the micro'_
 'computer to the mainframe';
WRTERM 'SEND downloads a data set (file) from the mainframe '_
  'to the microcomputer';
WRTERM 'STOP aborts a file transfer in progress '_
       '(valid only during file transfer)';
WRTERM 'STATUS displays the status of the last file transfer';
WRTERM 'SERVER invokes TSO KERMIT as a slave server';
WRTERM 'END terminates TSO KERMIT and returns user to TSO ';
WRTERM 'QUIT and EXIT are synonyms of END';
WRTERM 'SET changes KERMIT protocol and data set options ';
WRTERM 'SHOW displays the current KERMIT option settings ';
WRTERM 'RESET reinitializes KERMIT to default settings ';
WRTERM 'HELP tells how to use the TSO KERMIT help facility';
WRTERM 'TSO issues a command to TSO';
WRTERM 'EXEC reads a data set of TSO KERMIT commands '_
       '(a TSO CLIST)';
WRTERM 'KERMIT allows TSO KERMIT EXEC files to process the '_
       'TSO KERMIT SET commands';
WRTERM '(must prefix each SET cmd)';
WRTERM ' ';  % BLANK LINE
WRTERM 'TSO KERMIT executes a profile containing TSO KERMIT'_
        ' commands at program startup.  ';
WRTERM 'KERMIT.PROFILE.CLIST is the profile data set name.';
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'PROMPTIT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: PROMPIT
% FUNCTION: DO A PUT GET FOR INPUT AT THE TERMINAT
% INPUT : NONE
% OUTPUT: INFO MOVED INTO INPUT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROMPTIT: CENTER VRE,HIGHR,ENTRY=NO;
L XRA,UPTADD;
L XRB,ECTADD;
DO BEGIN
L 15,GETLINAD;  % ENTRY POINT FOR GETLINE ROUTINES
GETLINE PARM=APGPB,UPT=(XRA),ECT=(XRB),ECB=ECBGETLN,_
     TERMGET=(EDIT,NOWAIT),ENTRY=(15),_
        MF=(E,IOPLADS);
PROMPCAS: CASE VRF MAX 36 MIN 0 CHECK;
0: BEGIN  % LINE FROM TERMINAL
%PROMPT      'KERMIT-TSO> ';  % MAIN PROMPT FOR PROGRAM
ZR VRF;  % ZERO RETURN AFTER TPUT
 END;  % JUST FALL OUT

4: BEGIN  % INPUT FROM STACK - CLIST ETC
% JUST FALL OUT DON'T ISSUE PROMPT;
  END;

8: ;  % EOD JUST FALL THROUGH

12: BEGIN  % NO INPUT ISSUE PROMPT AND WAIT
  PROMPT      'KERMIT-TSO> ';  % MAIN PROMPT FOR PROGRAM
L 15,GETLINAD;  % ENTRY POINT FOR GETLINE ROUTINES
GETLINE PARM=APGPB,UPT=(XRA),ECT=(XRB),ECB=ECBGETLN,_
     TERMGET=(EDIT,WAIT),_
        ENTRY=(15),MF=(E,IOPLADS);
NEXT OF PROMPCAS;
END;
16 THRU 36: ;  % FALL THROUGH
ENDCASE
ELSE WRTERM 'UNKNOWN VALUE RETURNED FROM GETLINE';
END UNTIL <CI VRF,0> | <CI VRF,4>;
DATA BEGIN
APGPB:   GETLINE MF=L;
END;
LA XRA,APGPB;
USE XRA AS GTPB IN L VR1,GTPBIBUF;
LH XRB,0(VR1);  %  LENGTH OF STUFF
EXI XRB,MMVC,INPUT,(VR1),0,INCR=YES,DECR=YES;
%O XRB,=X'01000000';  % OR LENGTH  PER GTWTMP MANUAL PAGE 12-79
FREEMAIN RC,LV=(XRB),A=(VR1),SP=1;  % FREE UP THE INPUT BUFFER
SI XRB,4 ; % REMOVE LENGTH
EXI XRB,MTR,INPUT+4,UPPER,*-*,INCR=YES,DECR=YES ; % UPPER CASE

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'KERMIT WORKING STORAGE';
PARMS:    DS        0H;  % GLOBAL DATA LIST;
TESTFILE: DCB DDNAME=TESTFILE,DSORG=PS,MACRF=(GL),_
               EODAD=KLUDGCIT,LRECL=264,RECFM=VB,BLKSIZE=2048;
TESTEOF:    DC    A(KLUDGCIT);  % IN RPACK ROUTINE
%KEROUT: DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84,_
%               RECFM=VB;
DEBUG:  DCB DDNAME=DEBUG,DSORG=PS,MACRF=(PM),LRECL=260,BLKSIZE=2048,_
               RECFM=VB;
%MODDCBF: DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=80,_
%               RECFM=FB;
%MODDCBFL: EQU *-MODDCBF;
%MODDCBV: DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84,_
%               RECFM=VB;
%MODDCBVL: EQU *-MODDCBV;
DF SAMEPKTF,RECFLAG,SENDFLAG,SHOWFLAG,DATAFLAG,_ % DEFINE FLAGS
   STOPF,STURNRND,RTURNRND;
DF QUITFLAG,HELPFLAG,SETFLAG,EXITFLAG,QUESFLAG,_% DEFINE FLAGS
   PREFPDSF,ACKX,ACKZ;  % FOR ACK WITH X DATA OR Z DATA
DF DBUGFLAG,TESTF,BIT8FLAG,CRFLAG,QUOFLAG,QUO8FLAG,KINEOF,_
   LOGOUT;
DF SENDDSNF,RECVDSNF,EDITF,TABF,TABFOUND,FORWARDF,HIGHBITF,REPTF;
DF FORWARD,SERVERF,TIMERF,WARNINGF,PDSF,ASTERISK,_
   FULLQUOF,PREFXQUO;  % MORE FLAGS
DF WARNTPCK,FULLQDSN  ;
STAXADD:     DC    A(STAXEXIT);  % ADDRESS OF STAX ROUTINE
STAXLADD:    DC    A(STAXLIST);  % ADDRESS OF STAX PARM LIST
STAXOLD:    DC    A(STAXOLDL);
UPTADD:   DS   A;  % ADDRESS OF UPT FROM CPPL
STACKADD:   DS  A;  % ADDRESS OF STACK MODULE
CBUFFADD:   DS  A;  % ADDRESS OF CPPLCBUFF ON LOG IN
ECTADD:   DS  A;  % ADDRESS OF ECT FROM CPPL
ECBGETLN:  DC  F'0';  % PUT GET ECB
OLD:   DC  F'1';  % OUT PUT LINE DESCRIPTOR ONLY ONE ON CHAIN
%      DC  F'1';  % NUMBER OF MESSAGE SEGMENTS ONLY ONE
       DC  A(PROMPT);  % MESSAGE TO PUT OUT
PROMPT:    DC  H'17';  % LENGTH OF MESSAGE
           DC  H'0';  % FOR PROMPT
           DC  C' KERMIT-TSO> ';  % THE PROMPT MESSAGE
IOPLADS:   DC  4F'0';  % INPUT OUPUT PARM LIST PUT GET
PUTADD:   DC       A(PDATA);  % ADDRESS POINTER
TGETADD:  DC   A(KERMTGET);  % ADDRESS FOR ATTACH
PUTLEN:   DC       H'0';  % NUMBER OF CHARACTERS IN DATA
LASTTAB:  DC       H'0';  % LAST TAB FOR SENDS
TABADDR: DS         A;  % ADDRESS OF TABBING BUFFER
LASTADDR:  DS      A;  % ADDRESS OF PLACE IN REC BUFFER TABBING
ECBREAD:  DC   F'0';
TASKADD:    DS    A;  % ASYNC TASK ADDRESS
ECBTGET:   DC    F'0';
ECBTREAD:  EQU   X'AA';  % DO A READ
ECBTIMER:  EQU   X'BB';  % TIME OUT ECB
TABCNT: DS         H;  % TAB COUNTER
GETADD:  DC    A(BUF);  % ADDRESS OF GET BUFER
TSOADD:  DS     A;  % TSO ADDRESS OF LOAD MOD
GETLINAD: DS    A;  % ADDRESS OF GET LINE ROUTINE
CPPLADD:  DS      A;  % ADDRESS OF COMMAND PROCESSOR PARM LIST
GETLEN:  DS    H;  % LENGTH OF GET BUFFER
ADDBUF:  DC         A(BUF);  % ADDRESS OF BUFFER
BUFADCON:   DC      A(BUF);  % ADDRESS OF BUFFER
TGETBUFA:   DC  A(TGETBUFF);
TGETLEN:   DS   F;  % LENGTH OF RECEIVED DATA FROM TGET
SETADD:  DC        A(SETLABEL);  % ADDRESS OF SET AREA
BUFADD:  DS         F;  % POINTER TO PLACE IN BUF
BUFCNT:  DS         H;  % NUMBER OF CHARACTERS IN BUFCNT
RDATALEN:  DS    H;  % COUNTER OF RECEIVED DATA
RDATAADD:  DS    F;  % ADDRESS POINTER TO DATA
DACKRC:   DS    F;  % RETURN FROM DYNAL ALLOCATE
MAXPUT:   DC       H'91';  % MAX CHARACTERS TO PUT
MAXWRITE: DS       H;  % MAXIMUM SIZE OF WRITE TO DISK
BCCLEN:      DC        H'1';  % LEN OF VARIOUS BCC CHECKING
OLDBCC:   DC    H'0';  % SAVE BCC VALUE
TRFBCC:   DS       X;  % TRANSFER BCC
LFCR:     DC        X'234D234A';  % LIN FEE C R
LFCRLEN:  EQU  *-LFCR;
REPTBUFF:  DS         CL120;  % BUFFER FOR REPEAT CHARACTER
OLDSEQ:   DS        H;  % PREVIOUS SEQ NUMBER
SNDPKT:   DS        CL130;  % SEND THIS TO MICRO;
         ORG       SNDPKT;
PHDR:     DS        X;
PLEN:     DS        X;
PNUM:     DS        X;
PTYPE:    DS        X;
PDATA:    DS        0C;
         ORG       ,;
RECPKT:   DS        CL130;  % RECEIVE THIS FROM MICRO;
ORG      RECPKT;
RMARK:   DS    X;  % RECEIVE MARK
RLEN:    DS    X;  % RECEIVE LENGTH
RSEQ:    DS    X;  % RECEIVE SEQUENCE NUMBER
RTYPE:   DS    X;  % RECEIVE TYPE
% THESE LENGTHS ARE FOR FIXED LENGTH MESSAGES
YLEN:     EQU *-RSEQ;  % ACK LENGTH
NLEN:     EQU *-RSEQ;  % NACK LENGTH
 ZLEN:     EQU *-RSEQ;  % EOF PACKET  LENGTH
CLEN:     EQU *-RSEQ;  % COMPLETE PACKET  LENGTH
BLEN:     EQU *-RSEQ;  % EOT PACKET  LENGTH
ALEN:     EQU *-RSEQ;  % ABORT PACKET  LENGTH
RDATA:   DS    0C;
         ORG ,;  % RESET ORG COUNTER
LSDAT:    DS        F;  % SEND PACKET SIZE;
LRDAT:    DS        F;  % RECEIVE PACKET SIZE;
EDCNTRL:   DS       F;  % FOR EDIT ROUTINES
EDRETURN:  DS       F;  % RETURN CODE
EDTYPE:    DS       F;  % EDIT TYPE
EDCOL1:    DS       F;  % 1ST COLUMN POSTION
EDCOL2:    DS       F;  % 2ND COLUMN POSITION
EDLMAX2:   DC       F'132';  % MAX OF LINE
EDLENACT:  DS       F;  % AMOUNT RECEIVEDD
EDLINE:    DS       CL132;  % DATA FROM ERROR MESSAGE
EDLINENO: DS        F;  % LINENUMBER RETURNED FROM EDGET
EDPNTR:   DS        F;  % POINTER TO DATA ADDRESS
EDLINEN:  DC       XL4'FFFFFFFF';  % LINE NUMBER OF PUT AUTO
EDLINER:  DS       F;  % LINE NUMBER RETURNED FROM PUT
EDLEN:    DS       F;  % LENGTH FOR PUT
OTHERLEN:      DS    H;  % USED IN FILL DPCK
SEQNUM:  DS           H;  % NUMBER OF PACKET
RPSEQ:   DS           H;  % REC PACKET NUMBER
RECLEN:  DS           H;  % LENGTH OF REC DATA
RECPNTR: DS           F;  % POINTER TO RECEIVED DATA
LENERROR:   DC XL4'FFFFFFEE';  % LENGTH ERROR
FLAGS:    DC        X'00';  % USE TO TEST OUR FLAGS;
FLAGS2:   DC        X'00';  % USE TO TEST OUR FLAGS2;
NAME:     DC        18X'20';  % NAME OF FILE(S) TO SEND;
         DS        0F;
         DS        0F;
INPUT:    DS        CL130;  % INPUT BUFFER;
INPUT2:    DS        CL130;  % INPUT BUFFER;
         DS        0F;
         DS        F;  % RDW FOR VARIABLE RECORDS;
         DS        F;  % RDW FOR VARIABLE RECORDS;
N:        DC        F'0';  % SEND PACKET NUMBER;
NUM:      DC        F'0';  % RECEIVE PACKET NUMBER;
RETRY:    DC        F'20';  % RETRY COUNTER
NUMTRY:   DC        F'0';  % TRIAL COUNTER FOR TRANSFERS;
OLDTRY:   DS        F;  % COUNTER FOR PREVIOUS PACKET;
STORLOC:  DS        F;  % POINTER TO EXTRA STORAGE;
MAXPACK:  DC        F'94';  % MAX PACKET SIZE;
RECL:     DS        F;  % RECORD LEN (IF RECFM = V);
RPSIZ:    DC        F'94';  % MAX RECEIVE PACKET SIZE;
DSSIZ:    DC        F'40';  % DEFAULT MAX SEND PACKET SIZE
MAXTRY:   DC        F'5';  % NO. OF TIMES TO RETRY PACKET
IMXTRY:   DC        F'16';  % NO. OF INITIAL TRIALS ALLOWE
SIZE:     DS        F;  % MAX SIZE FOR SEND DATA;
CRTLINE#:   DS  H;  % SCREEN LINE NUMBER IN SHOW
MAXCRC#:    DC  H'11';  % MAX LINES ON SCREEN FOR SHOW AT PRESENT
RECSEQ:     DC  H'0';  % NUMBER COUNTER
DEL:      DC        F'127';  % OCTAL 177 (DELETE CHAR);
MOD64:    DC        XL4'0000003F';  % MODUL 64
ASCIIONE: DC        X'31';  % ASCII LIT 1
ASCII2: DC        X'32';  % ASCII LIT 1
ASCII3: DC        X'33';  % ASCII LIT 1
ZERO:     DC        F'0';
ONE:      DC        F'1';
ONETHOU:      DC        F'1000';
FIVE:     DC        F'5';
SIX:      DC        F'6';
TWO:      DC        F'2';
THREE:    DC   F'3';  % CONSTANT FOR EDSETS
FOUR:     DC   F'4';  % "
ONEOONE:  DC        F'101';  %  FOR EDIT ROUTINES
TEN:    DC  F'10';
SPACE:    DC        F'32';  % ASCII SPACE;
O1H:      DC        F'64';  % OCTAL 100;
O2H:      DC        F'128';  % OCTAL 200;
SAVPL:    DC        F'0';  % POINTER WITHIN BUF,INIT=0;
RSAVPL:   DC        F'0';  % POINTER IN 'PTCHR',INIT=0;
RCRCREAL: DS        H;  % RECEIVE CHARACTER
DQUOTE:   DC        X'23';  % DEFAULT QUOTE CHARACTER = #;
QUOCHAR:  DS        X;  % QOUTE CHAR WE'LL SEND;
RQUO:     DS        X;  % MICRO'S QUOTE CHAR;
DOT:      DC       C'.';  % DOT FOR DS NAME SCAN
DBINQC:   DC    X'26';  % DEFAULT 8 BIT QUOTE CHAR = &
BINQC:    DC    X'26';  % 8 BIT QUOTE CHARACTER
DTABCHAR: DC        X'09';  % ASCII HT
TABCHAR:  DS        X;  % TABCHAR
TABCHAR#: DC        X'49';  % ASCII HT+ CNTL QUOTE VALUE
TEMP:     DS        D;  % TEMPORARY SPACE;
         DS        0D;
SDAT:     DS        CL130;  % TEMP PLACE FOR SEND DATA;
RDAT:     DS        CL130;  % TEMP PLACE FOR RECEIVE DATA;
FILNAML:  DS    H;  % LENGTH OF FILENAME;
FILNAM:   DS        CL18;  % SEND/REC FILENAME;
STATE:    DS        C;  % OUR CURRENT STATE;
DEOL:     DC        X'0D';  % DEFAULT END OF PACKET (CR);
REOL:     DS        X'0D';  % EOL CHAR I NEED (CR);
SEOL:     DS        X'0D';  % EOL I'LL SEND;
QBINCHAR:     DC        X'26';  % EIGHTTH BIT QUOTE CHARA
DQBIN:    DC        X'26';  % EIGHTTH BIT QUOTE CHARACTER;
DREPT:    DC        X'7E';  % ASCII ~
REPTCHAR:    DS     X;  % CHARACTER USED FOR REPEAT QUOTING
DCAPA1:   DC        X'0';  % CAPABILITIES ZERO NOW
DSOH:     DC        X'01';  % DEFAULT START OF HEADER (CTL
RSOH:     DS        X;  % RECEIVE START OF HEADER;
SSOH:     DS        X;  % SEND START OF HEADER;
DLRECL:   DC        H'504';  % DEFAULT LRECL SIZE OF 80;
LRECL:    DS        H'255';  % LRECL PROGRAM WILL USE;
DBLKSIZE: DC        H'6356';  % DEFAULT BLKSIZE OF 6356;
BLKSIZE:  DS        H;  % BLKSIZE PROGRAM WILL USE;
DTRACK:   DC        F'5';  % DEFAULT SPACE ALLOCATION;
DRECFM:   DC    CL2'VB';  % W       DEFAULT WITH VARIE RECFM;
RFM:      DC        CL2'UB';  % RECFM PROGRAM WILL USE;
RRECFM:      DS        C;  % REC FORMAT OF FILE IN USE
VOLUME:   DC        CL7'TMP    ';  % JDW  VOLUME FOR ALLOCATE;
OUTUNIT:  DC        CL8'FILE    ';  % FOR DYNAL
OUTSTATS: DS        X;  % STATUS FOR DYNAL
OUTNDISP: DS        X;  % NORMAL DISPOSITION DYNAL
OUTCDISP: DS        X;  % CONDITIONAL DISPOSITION DYNAL
DATA:     DC        CL7'TEXT   ';  % JDW  DATA TYPE BIN OR TEXT;
% DALRTVOL: DS        CL6;  % VOL SERIAL OF RETURNED DYNAL
BLIP:     DS        X;  % SAVE USER'S BLIP CHAR;
LINSIZ:   DS        F;  % SAVE USER'S CONSOLE LINESIZE
%STYPE:    DS        C;  % TYPE OF PACKET SENT;
%RTYPE:    DS        C;  % TYPE OF PACKET RECEIVED;

READSAVE: DS        4F;
WRITSAVE: DS        4F;
PARSELST: DS        3F;  % PTRS TO OPERAND STACK;
PTRTBL:   DS        15F;  % OPERAND STACK;
PTRTBLL:  EQU       *-PTRTBL;  % LENGTH OF PTRTBL;
DBLWRK:   DS        D;
IDSYS:    DC        F'2';  % MVS TSO;
DDNAME:   DC        CL8' ';  % DDNAME TO ALLOCATE;
DSNAME:   DC        CL80' ';  % DSNAME TO ALLOCATE;
DSMEMBER: DC        CL8' ';  % MEMBER NAME
DSNAMEX:  DC        CL80' ';  % WRKBUFFER;
MEMBER:   DC        CL8' ';  % MEMBER NAME FOR PDS ALLOC;
LASTDSN:   DC        CL44' ';  % FOR THE WILDCARD SEND
DISP1:    DC        F'2';  % DISP (0=NEW,1=OLD,2=SHR);
DISP2:    DC        F'3';  % DISP (0=UNCAT,1=CAT,3=KEEP);
INOUT:    DC        F'2';  % 0=INPUT,1=OUTPUT,2=INOUT);
RECFMX:   DC        F'1';  % 1=FB,2=VBS;
BLKSIZEX: DC        F'3600';  % FOR NEW DATA SETS ONLY;
LRECLX:   DC        F'80';  % ....;
DEV:      DC        CL8'FILE ';  % DEVICE;
TRACK:    DC        F'20';  % # TRACKS TO ALLOC FOR NEW DS
DYNALCRC: DC        F'0';  % RETURN CODE FROM FUNCTION;
VOLAD:    DC        F'0';  % ADDRESS OF VOLUME FOR DYNAL;
WRKBUFF:  DS        CL280;
PREFIX:   DC   CL44'       ';  % USERS DSET PREFIX FROM SET
PREFIXL:  DC H'0';  % PREFIX LENGTH-1;
PREFMEM:  DS CL8;  % MEMBER NAME FOR PDS PREFIX
PREFMEML: DC H'0';  % LENGTH OF PREFIX PDS MEMBER
DSNPFIX:  DC  CL44' ';  % PREFIX IF WILDCARD SEND
DSNPFL:   DC  H'0';  % PREFIX LENGTH
DSNSFIX:  DC  CL44' ';  % SUFFIX LENGTH
DSNSFL:   DC  H'0';  % SUFFIX LENGTH
MATCHDSN:  DC CL44' ';  % NAME TO MATCH
MATCHDSL:   DS  H;  % LENGTH OF MATCHNAME
DDELAY:   DC        F'2000';  % DEFAULT DELAY TIME;
DELAY:    DS        F;  % DELAY TIME;
         DC   CL8'CRC*****';  % DUMP BUSTERS
BCC:     DS   F;  % FOR BCC COMP
TIMEOUT: DC   F'8';  % TIMEOUT FOR OTHER KERMIT
TIMEOUT2: DC   F'800';  % TIMEOUT FOR OTHER KERMIT
RTIMEOUT: DC   F'800';  % RDATA TIMEOUT
ATIMEOUT: DC   F'50';  % ATTACH TIMEOUT
SERVTOUT: DC   F'3000';  % SERVER TIMEOUT FOR NACKING 30 SECONDS
SERVWAIT: DC  F'720000' ; % SERVER LOGOFF AFTER SIXTY MINUTES
SERVTIME: DC F'0' ; % TIME BUFFER FOR SERVER
STURNTIM:  DC   F'100';  % SEND TURN TABLE
RTURNTIM:  DC   F'100';  % RECEIVE TURN TABLE
DSNLEN:  DS   H;  % LENGTH OF DSNAME
DSNADD:  DS   A;  % ADDRESS OF DSNAME
PARM1:   DC    F'1';  % NO DUMP - TSO COMMAND =1
PARM2:   DS    CL255;  % COMMAND STRING
PARM3:   DC    F'0';  % LENGTH OF COMMAND STRING
PARM4:   DS    F;  % RETURN CODE HERE
PARM5:   DS    F;  % SERVICE RETURN CODE
PARM6:   DS    F;  % ABEND CODE
KERMDDNM:   DS    CL8;  % DDNAME BUFFER
DSNSIZE: EQU 44;  % LEN OF DSNAME
LEVELCK: DC   X'01';  % ASCII BCC LEVEL CH 1
HIGHBCC: DC  X'03';  % HIGHEST BCC WE SUPPORT
DBCC:   DC  X'03';  % DEFAULT BCC CHECKING
BLANKS:    DC    100CL1' ';  % BLANKS
ASCBLANK:    DC    100XL1'20';  % BLANKS
AAAAIII: DS XL7;  % USER ACCOUNT AND INITIALS
          DC CL1'.';  % DOT FOR THE DSNAME
USERPREA: DC   A(AAAAIII);
USERPREL: DC   H'7';  % LENGTH OF USER PREFIX
TMPDISKA: DC   A(TMPVOLID);  % INSTALLATION DEFAULT DISK DRIVE NAME
TMPDISKL: DC   H'3';  % LENGTH OF TMP NAME
TMPVOLID:  DC   CL3'TMP';  % REMOVEME
TSOCMDA:  DS   A;  % ADDRESS OF TSO COMMAND TO ISSUE
TSOCMDL:  DS   H;  % LENGTH OF TSO COMMAND
XUSERPRO: AREA H,DSECT=NO;
          DC CL3'EX ';
USERPROF:   DS 0X;  % LABEL FOR USERPROFILE NAME
          DC C'KERMIT.PROFILE.CLIST';
USERPROL:    EQU *-USERPROF;  % LENGTH OF NAME
XUSERPRL: EQU *-XUSERPRO;  % LENGTH OF COMMAND
AREAEND;  % LENGTH OF COMMAND

XSYSPRO: AREA H,DSECT=NO;
        DC CL3'EX ';  % EXECUTE COMMAND FOR PROFILE OF SYSTEM
        DC  CL1'"';  % QUOTE AROUND DSNAME
        DC  CL1'"';  % QUOTE AROUND DSNAME
XSYSPROL: AREAEND 0X;
STATBUFF:   DC  CL256' ';  % FINAL STATUS OF KERMIT
CATDSPTR:    DS    A;  % ADDRESS OF PLACE IN CATALOG BUFFER
STATLEN:    DS  H;
WARNBUFF:  DC  CL255' ';  % WARNING BUFFER
WARNLEN:   DS  H;
WARNAD1:    DC   A(0);  % WARNING BEGINNING OF CHAIN
WARNADL:    DC   A(0);  % ADDRESS OF LAST WARNING ENTRY
SUCESSCC:   DC   C'TSO KERMIT completed successfully';
ATOEVCON:   DC   V(ATOETBL);  % ASCII TO EBCIDIC TRANSLATE TABLE
ETOAVCON:   DC   V(ETOATBL);  % EBCIDIC TO ASCII TRANSLATE TABLE ADD
ETOAERRV:   DC   V(ETOAERRT);  % TABLE OF UNTRANSLATABLE CHARACTERS
BAL;
*;  % TABLE TO TRANSLATE TO UPPER CASE
*;
UPPER    DC    256AL1(*-UPPER)
         ORG   UPPER+X'81'
         DC    C'ABCDEFGHI'
         ORG   UPPER+X'91'
         DC    C'JKLMNOPQR'
         ORG   UPPER+X'A2'
         DC    C'STUVWXYZ'
         ORG
*;  % THIS IS THE ASCII TO EBCDIC TABLE
ATOE     DC        X'00010203372D2E2F1605250B0C0D0E0F'
         DC        X'101112133C3D322618193F271C1D1E1F'
         DC        X'405A7F7B5B6C507D4D5D5C4E6B604B61'
         DC        X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
         DC        X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
         DC        X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'    NIH JDW
         DC        X'79818283848586878889919293949596'    NIH JDW
         DC        X'979899A2A3A4A5A6A7A8A98B4F9BA107'    NIH JDW
         DC        X'00010203372D2E2F1605250B0C0D0E0F'    NIH JDW
         DC        X'101112133C3D322618193F271C1D1E1F'    NIH JDW
         DC        X'405A7F7B5B6C507D4D5D5C4E6B604B61'    NIH JDW
         DC        X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'    NIH JDW
         DC        X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'    NIH JDW
         DC        X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'    NIH JDW
         DC        X'79818283848586878889919293949596'    NIH JDW
         DC        X'979899A2A3A4A5A6A7A8A98B4F9BA107'    NIH JDW
*THIS IS THE EBCDIC TO ASCII CONVERSION TABLE
*CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A X'3A'
*                 0 1 2 3 4 5 6 7 8 9 A B C D E F
ETOA     DC    X'000102033A093A7F3A3A3A0B0C0D0E0F' 0  EBCDIC
         DC    X'101112133A0A080018193A3A1C1D1E1F' 1  TO            NI
         DC    X'3A3A3A3A3A0A171B3A3A3A3A3A050607' 2  ASCII
         DC    X'3A3A163A3A3A3A043A3A3A3A14153A1A' 3                NI
         DC    X'203A3A3A3A3A3A3A3A3A3A2E3C282B7C' 4                NI
         DC    X'263A3A3A3A3A3A3A3A3A21242A293B5E' 5                NI
         DC    X'2D2F2D3A3A3A3A3A3A3A3A2C255F3E3F' 6                NI
         DC    X'3A3A3A3A3A3A3A3A3A603A2340273D22' 7                NI
         DC    X'3A6162636465666768693A7B3A3A3A3A' 8
         DC    X'3A6A6B6C6D6E6F7071723A7D3A3A3A3A' 9
         DC    X'3A7E737475767778797A3A3A3A5B3A3A' A                NI
         DC    X'3A3A3A3A3A3A3A3A3A3A3A3A3A5D5E3A' B                NI
         DC    X'3A4142434445464748493A3A3A3A3A3A' C
         DC    X'3A4A4B4C4D4E4F5051523A3A3A3A3A3A' D
         DC    X'5C3A535455565758595A3A3A3A3A3A3A' E                NI
         DC    X'303132333435363738393A3A3A3A3A3A' F
         SPACE 1
*
*  THIS IS TABLE FOR SEARCHING FOR SPECIAL CHARACTER
*  QUOTING - TRT FOR QUOTE,BINARY, OR REPEAT
RECTABLE DC    256X'00'
*
ALP;
TMPDSMES: AREA H,DSECT=NO;
DC C'Data set ';
TMPDSN:  DS CL44;
DC C' is on Volume ';
TMPVOL: DS CL6;  % RETURN ED VOL SERIAL NUMBER
TMPMSL: AREAEND;
BAL;
DATASET CAMLST     NAME,DSNAME,,WRKBUFF
DELDSN  CAMLST SCRATCH,DSNAME,,WRKBUFF,,OVRD
UNCAT   CAMLST UNCAT,DSNAME
ALP;
PARMLEN1:     EQU *-PARMS;
WORK2:   DS    0F;  % WORK AREA 2

DDSN:      DS      CL44;  % DELETE DSNAME
VOLIST:    DC      H'1';  % ONE VOLUME ON LIST
TSOVOL:    DS      CL6;  % VOLUME
KERMVA: VAREA;  % THE V AREA FOR MACROS
KERMBUFF:    DS     CL80;  % BUFFER FOR VOUT
SCT: DS 0F; SCT;
STACK: DS 1024X'FF';
OSAVE: DC A(0);
%%WORKING STORAGE

%% SOME LITS FOR SEND TABLE
SENDTBL: AREA F,DSECT=NO;
         DC  256AL1(0);  % FILL ARRAY WITH ZEROS
ORG SENDTBL;
         DC  32AL1(ASCIIQUO);  % CONTROL QUOTE
ORG SENDTBL+127;
         DC  AL1(ASCIIQUO);  % THE DELETE CHARACTER
ORG SENDTBL+128;  % CONTROL + 8BIT
          DC    32AL1(ASCIQUO8);  % CONTROL + 8BIT
        DC 95AL1(ASCI8BIT);
ORG SENDTBL+255;  % CONTROL + 8BIT
           DC   AL1(ASCIQUO8);  % CONTROL + 8BIT
SENDTBLL: AREAEND;
REPTABLE: AREA F,DSECT=NO;  % THESE LENGTHS ARE ALEAST THE NUMBER
       DC  256AL1(4);  % FILL ARRAY WITH 4'S WORTH WHILE TO QUOTE
ORG REPTABLE;  % LESS THAN THESE WOULDN'T BE WORTHWHILE
         DC  32AL1(3);  % CONTROL QUOTE
ORG REPTABLE+127;
         DC  AL1(3);  % THE DELETE CHARACTER
ORG REPTABLE+128;  % CONTROL + 8BIT
          DC    32AL1(2);  % CONTROL + 8BIT
        DC 95AL1(3);
ORG REPTABLE+255;  % CONTROL + 8BIT
           DC   AL1(2);  % CONTROL + 8BIT
REPTABLL: AREAEND;

TABTBLAD:   DC  A(TABTABLE);  % ADDRESS OF TAB TABLE
TABWRKA:    DS  D;  % WORK AREA FOR TAB ROUTINE
TABTABLE:   AREA H,DSECT=NO;  % HALF WORD TABLE OF TAB SETS
       DC 256AL1(0);
TABTLEN: AREAEND;

ASTRKTBL:   AREA H,DSECT=NO;  % SHACT TABLE FOR ********** IN WILDCAR
       DC 256AL1(0);
ORG ASTRKTBL+C'*';  % THE "*"
DC AL1(4);
ORG   ,;  % RESET COUNTER
AREAEND;
SERVCOMM:   AREA F,DSECT=NO;  % TABLE FOR SERVER COMMANDS
       DC 256AL1(0);  % ZERO TABLE
ORG SERVCOMM+YOFF;
     DC AL1(YCASE);  % ACK PACKET
ORG SERVCOMM+NOFF;
     DC AL1(NCASE);  % NACK PACKET
ORG SERVCOMM+GOFF;
     DC AL1(GCASE);  % SERVER GENERIC COMMANDS
ORG SERVCOMM+R2OFF;
     DC AL1(R2CASE);  % SERVER GET  COMMAND
ORG SERVCOMM+IOFF;
     DC AL1(ICASE);  % SERVER I PACKET
ORG SERVCOMM+ROFF;
     DC AL1(SCASE);  % SENDINIT PACKET
ORG   ,;  % RESET COUNTER
AREAEND;

COMMAND:   AREA F,DSECT=NO;  % TABLE FOR COMMANDS
       DC 256AL1(0);  % ZERO TABLE
ORG COMMAND+YOFF;
     DC AL1(YCASE);  % ACK PACKET
ORG COMMAND+NOFF;
     DC AL1(NCASE);  % NACK PACKET
ORG COMMAND+FOFF;
     DC AL1(FCASE);  % FILE INIT  PACKET
ORG COMMAND+DOFF;
     DC AL1(DCASE);  % DATA PACKET
ORG COMMAND+ZOFF;
     DC AL1(ZCASE);  % EOF PACKET
ORG COMMAND+COFF;
     DC AL1(CCASE);  % COMPLETEPACKET
ORG COMMAND+BOFF;
     DC AL1(BCASE);  % EOT PACKET
ORG COMMAND+EOFF;
     DC AL1(ECASE);  % ERROR PACKET
ORG COMMAND+AOFF;
     DC AL1(ACASE);  % ABORT PACKET
ORG COMMAND+ROFF;
     DC AL1(SCASE);  % SENDINIT PACKET
ORG   ,;  % RESET COUNTER
AREAEND;
KOUTADDR:      DC    A(KERMVOUT);  % ADDRESS OF OUTPUT
ADDSTATA:      DC     A(ADSTATUS);  % ROUTINE TO ADD TO STATUS BUFFER
ASCILITS: AREA H,DSECT=NO;  % TABLE OF VALUES FOR SHOW ROUTINE
       DC   CL3'NUL';
       DC   CL3'SOH';
       DC   CL3'STX';
       DC   CL3'ETX';
       DC   CL3'EOT';
       DC   CL3'ENQ';
       DC   CL3'ACK';
       DC   CL3'BEL';
       DC   CL3'BS ';
       DC   CL3'HT ';
       DC   CL3'LF ';
       DC   CL3'VT ';
       DC   CL3'FF ';
       DC   CL3'CR ';
       DC   CL3'SO ';
       DC   CL3'SI ';
       DC   CL3'DLE';
       DC   CL3'DC1';
       DC   CL3'DC2';
       DC   CL3'DC3';
       DC   CL3'DC4';
       DC   CL3'NAK';
       DC   CL3'SYN';
       DC   CL3'ETB';
       DC   CL3'CAN';
       DC   CL3'EM ';
       DC   CL3'SUB';
       DC   CL3'ESC';
       DC   CL3'FS ';
       DC   CL3'GS ';
       DC   CL3'RS ';
       DC   CL3'US ';
ASCLITLN: AREAEND;
ASCCNTLC: AREA H,DSECT=NO;  % TABLE FOR CONTROL CHARACTER IN SHOW
       DC   CL2'^@';
       DC   CL2'^A';
       DC   CL2'^B';
       DC   CL2'^C';
       DC   CL2'^D';
       DC   CL2'^E';
       DC   CL2'^F';
       DC   CL2'^G';
       DC   CL2'^H';
       DC   CL2'^I';
       DC   CL2'^J';
       DC   CL2'^K';
       DC   CL2'^L';
       DC   CL2'^M';
       DC   CL2'^N';
       DC   CL2'^O';
       DC   CL2'^P';
       DC   CL2'^Q';
       DC   CL2'^R';
       DC   CL2'^S';
       DC   CL2'^T';
       DC   CL2'^U';
       DC   CL2'^V';
       DC   CL2'^W';
       DC   CL2'^X';
       DC   CL2'^Y';
       DC   CL2'^Z';
       DC   CL2'^[';
       DC   CL2'^\';
       DC   CL2'^]';
       DC   CL2'^^';
       DC   CL2'^_';
       DC   CL2'^`';
ASCCNTLL: AREAEND;
CRCCONAD:   DC    A(CRCCONST);  % ADDRESS OF CRC TABLE
NOQUADD:   DC    A(NOQUOTE);  % TABLE FOR CONTROL CHARACTERS
CIRPARM: AREA F,DSECT=NO;
CIROPT:    DC    X'02';  % OPTION GET NEX LEVEL DATA SET NAME AND VOL
        DC    2AL1(0);  % RESERVED BY SYSTEM
CIRLOCRC:  DC    AL1(0);  % LOCATE RETURN CODE
CIRSRCH:  DC    A(LASTDSN);  % SEARCH ARG ADDRESS OF LAST DATA SET NAME
CIRCVOL:   DC    F'0';  % ADDRESS OF VOL ALWAYS 0 FORCE CAT LOOKUP
CIRWA:     DC    A(USERWORK);  % USER WORK AREA
CIRSAVE:   DC    A(SAVECAT);  % SAVE AREA FOR MACRO
CIRPSWD:   DC    F'0';  % ADDRESS OF PASSWORD
AREAEND;

SAVECAT:   DC  18F'0';  % SAVE AREA FOR CATALOG ROUTINE
CRCCONST: AREA H,DSECT=NO;  % BCC VALUE CONSTANTS
% GIVEN BY DIVIDING ANY GIVEN BYTE VALUE BY
% THE CCITT POLYNOMIAL X^16+X^12+X^5+1
% THIS VALUE IS THE REMAINDER
%
  DC AL2(0);  % 0
  DC AL2(4489);  % 1
  DC AL2(8978);  % 2
  DC AL2(12955);  % 0
  DC AL2(17956);  % 0
  DC AL2(22445);  % 0
  DC AL2(25910);  % 0
  DC AL2(29887);  % 0
  DC AL2(35912);  % 0
  DC AL2(40385);  % 0
  DC AL2(44890);  % 0
  DC AL2(48851);  % 0
  DC AL2(51820);  % 0
  DC AL2(56293);  % 0
  DC AL2(59774);  % 0
  DC AL2(63735);  % 0
  DC AL2(4225);  % 0
  DC AL2(264);  % 0
  DC AL2(13203);  % 0
  DC AL2(8730);  % 0
  DC AL2(22181);  % 0
  DC AL2(18220);  % 0
  DC AL2(30135);  % 0
  DC AL2(25662);  % 0
  DC AL2(40137);  % 0
  DC AL2(36160);  % 0
  DC AL2(49115);  % 0
  DC AL2(44626);  % 0
  DC AL2(56045);  % 0
  DC AL2(52068);  % 0
  DC AL2(63999);  % 0
  DC AL2(59510);  % 0
  DC AL2(8450);  % 0
  DC AL2(12427);  % 0
  DC AL2(528);  % 0
  DC AL2(5017);  % 0
  DC AL2(26406);  % 0
  DC AL2(30383);  % 0
  DC AL2(17460);  % 0
  DC AL2(21949);  % 0
  DC AL2(44362);  % 0
  DC AL2(48323);  % 0
  DC AL2(36440);  % 0
  DC AL2(40913);  % 0
  DC AL2(60270);  % 0
  DC AL2(64231);  % 0
  DC AL2(51324);  % 0
  DC AL2(55797);  % 0
  DC AL2(12675);  % 0
  DC AL2(8202);  % 0
  DC AL2(4753);  % 0
  DC AL2(792);  % 0
  DC AL2(30631);  % 0
  DC AL2(26158);  % 0
  DC AL2(21685);  % 0
  DC AL2(17724);  % 0
  DC AL2(48587);  % 0
  DC AL2(44098);  % 0
  DC AL2(40665);  % 0
  DC AL2(36688);  % 0
  DC AL2(64495);  % 0
  DC AL2(60006);  % 0
  DC AL2(55549);  % 0
  DC AL2(51572);  % 0
  DC AL2(16900);  % 0
  DC AL2(21389);  % 0
  DC AL2(24854);  % 0
  DC AL2(28831);  % 0
  DC AL2(1056);  % 0
  DC AL2(5545);  % 0
  DC AL2(10034);  % 0
  DC AL2(14011);  % 0
  DC AL2(52812);  % 0
  DC AL2(57285);  % 0
  DC AL2(60766);  % 0
  DC AL2(64727);  % 0
  DC AL2(34920);  % 0
  DC AL2(39393);  % 0
  DC AL2(43898);  % 0
  DC AL2(47859);  % 0
  DC AL2(21125);  % 0
  DC AL2(17164);  % 0
  DC AL2(29079);  % 0
  DC AL2(24606);  % 0
  DC AL2(5281);  % 0
  DC AL2(1320);  % 0
  DC AL2(14259);  % 0
  DC AL2(9786);  % 0
  DC AL2(57037);  % 0
  DC AL2(53060);  % 0
  DC AL2(64991);  % 0
  DC AL2(60502);  % 0
  DC AL2(39145);  % 0
  DC AL2(35168);  % 0
  DC AL2(48123);  % 0
  DC AL2(43634);  % 0
  DC AL2(25350);  % 0
  DC AL2(29327);  % 0
  DC AL2(16404);  % 0
  DC AL2(20893);  % 0
  DC AL2(9506);  % 0
  DC AL2(13483);  % 0
  DC AL2(1584);  % 0
  DC AL2(6073);  % 0
  DC AL2(61262);  % 0
  DC AL2(65223);  % 0
  DC AL2(52316);  % 0
  DC AL2(56789);  % 0
  DC AL2(43370);  % 0
  DC AL2(47331);  % 0
  DC AL2(35448);  % 0
  DC AL2(39921);  % 0
  DC AL2(29575);  % 0
  DC AL2(25102);  % 0
  DC AL2(20629);  % 0
  DC AL2(16668);  % 0
  DC AL2(13731);  % 0
  DC AL2(9258);  % 0
  DC AL2(5809);  % 0
  DC AL2(1848);  % 0
  DC AL2(65487);  % 0
  DC AL2(60998);  % 0
  DC AL2(56541);  % 0
  DC AL2(52564);  % 0
  DC AL2(47595);  % 0
  DC AL2(43106);  % 0
  DC AL2(39673);  % 0
  DC AL2(35696);  % 0
  DC AL2(33800);  % 0
  DC AL2(38273);  % 0
  DC AL2(42778);  % 0
  DC AL2(46739);  % 0
  DC AL2(49708);  % 0
  DC AL2(54181);  % 0
  DC AL2(57662);  % 0
  DC AL2(61623);  % 0
  DC AL2(2112);  % 0
  DC AL2(6601);  % 0
  DC AL2(11090);  % 0
  DC AL2(15067);  % 0
  DC AL2(20068);  % 0
  DC AL2(24557);  % 0
  DC AL2(28022);  % 0
  DC AL2(31999);  % 0
  DC AL2(38025);  % 0
  DC AL2(34048);  % 0
  DC AL2(47003);  % 0
  DC AL2(42514);  % 0
  DC AL2(53933);  % 0
  DC AL2(49956);  % 0
  DC AL2(61887);  % 0
  DC AL2(57398);  % 0
  DC AL2(6337);  % 0
  DC AL2(2376);  % 0
  DC AL2(15315);  % 0
  DC AL2(10842);  % 0
  DC AL2(24293);  % 0
  DC AL2(20332);  % 0
  DC AL2(32247);  % 0
  DC AL2(27774);  % 0
  DC AL2(42250);  % 0
  DC AL2(46211);  % 0
  DC AL2(34328);  % 0
  DC AL2(38801);  % 0
  DC AL2(58158);  % 0
  DC AL2(62119);  % 0
  DC AL2(49212);  % 0
  DC AL2(53685);  % 0
  DC AL2(10562);  % 0
  DC AL2(14539);  % 0
  DC AL2(2640);  % 0
  DC AL2(7129);  % 0
  DC AL2(28518);  % 0
  DC AL2(32495);  % 0
  DC AL2(19572);  % 0
  DC AL2(24061);  % 0
  DC AL2(46475);  % 0
  DC AL2(41986);  % 0
  DC AL2(38553);  % 0
  DC AL2(34576);  % 0
  DC AL2(62383);  % 0
  DC AL2(57894);  % 0
  DC AL2(53437);  % 0
  DC AL2(49460);  % 0
  DC AL2(14787);  % 0
  DC AL2(10314);  % 0
  DC AL2(6865);  % 0
  DC AL2(2904);  % 0
  DC AL2(32743);  % 0
  DC AL2(28270);  % 0
  DC AL2(23797);  % 0
  DC AL2(19836);  % 0
  DC AL2(50700);  % 0
  DC AL2(55173);  % 0
  DC AL2(58654);  % 0
  DC AL2(62615);  % 0
  DC AL2(32808);  % 0
  DC AL2(37281);  % 0
  DC AL2(41786);  % 0
  DC AL2(45747);  % 0
  DC AL2(19012);  % 0
  DC AL2(23501);  % 0
  DC AL2(26966);  % 0
  DC AL2(30943);  % 0
  DC AL2(3168);  % 0
  DC AL2(7657);  % 0
  DC AL2(12146);  % 0
  DC AL2(16123);  % 0
  DC AL2(54925);  % 0
  DC AL2(50948);  % 0
  DC AL2(62879);  % 0
  DC AL2(58390);  % 0
  DC AL2(37033);  % 0
  DC AL2(33056);  % 0
  DC AL2(46011);  % 0
  DC AL2(41522);  % 0
  DC AL2(23237);  % 0
  DC AL2(19276);  % 0
  DC AL2(31191);  % 0
  DC AL2(26718);  % 0
  DC AL2(7393);  % 0
  DC AL2(3432);  % 0
  DC AL2(16371);  % 0
  DC AL2(11898);  % 0
  DC AL2(59150);  % 0
  DC AL2(63111);  % 0
  DC AL2(50204);  % 0
  DC AL2(54677);  % 0
  DC AL2(41258);  % 0
  DC AL2(45219);  % 0
  DC AL2(33336);  % 0
  DC AL2(37809);  % 0
  DC AL2(27462);  % 0
  DC AL2(31439);  % 0
  DC AL2(18516);  % 0
  DC AL2(23005);  % 0
  DC AL2(11618);  % 0
  DC AL2(15595);  % 0
  DC AL2(3696);  % 0
  DC AL2(8185);  % 0
  DC AL2(63375);  % 0
  DC AL2(58886);  % 0
  DC AL2(54429);  % 0
  DC AL2(50452);  % 0
  DC AL2(45483);  % 0
  DC AL2(40994);  % 0
  DC AL2(37561);  % 0
  DC AL2(33584);  % 0
  DC AL2(31687);  % 0
  DC AL2(27214);  % 0
  DC AL2(22741);  % 0
  DC AL2(18780);  % 0
  DC AL2(15843);  % 0
  DC AL2(11370);  % 0
  DC AL2(7921);  % 0
  DC AL2(3960);  % 0
AREAEND;

%%WORKING STORAGE END
SUBTITLE 'KRESET';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%      INITIALIZATION ROUTINE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
KRESET:
CENTER VRE,HIGHR,ENTRY=NO;
BAL;
         XC        N,N                 SET VARIABLES TO ZERO
         XC        NUM,NUM
         XC        LSDAT,LSDAT
         XC        LRDAT,LRDAT
         MVI       FLAGS,X'00'         CLEAR ALL FLAGS
         XC        SAVPL,SAVPL
         XC        RSAVPL,RSAVPL
         XC        NUMTRY,NUMTRY
         MVC       FILNAM,=18X'20'     BLANK OUT FILNAM & NAME
         MVC       NAME,=18X'20'
         XC        OLDTRY,OLDTRY
         XC        SIZE,SIZE
         XC        TEMP,TEMP
         XC        STORLOC,STORLOC
         MVC       DELAY,DDELAY        SET DEFAULT DELAY
         MVC       LRECL(2),DLRECL     SET DEFAULTS, JUST IN CASE
         MVC       BLKSIZE(2),DBLKSIZE SET DEFAULTS, JUST IN CASE
         MVC       TRACK,DTRACK        DEFAULT SPACE OF 5 TRACKS
         MVC       RFM(2),DRECFM
         MVC       QUOCHAR(1),DQUOTE
         MVC        TABCHAR(1),DTABCHAR  TAB CHARACTER
         MVC       RQUO(1),DQUOTE
         MVC       REOL(1),DEOL
         MVC       SEOL(1),DEOL
         MVC       SSOH(1),DSOH
         MVC       RSOH(1),DSOH
         MVC      BINQC(1),DQBIN         EIGTH BIT QUOTE CHARACTER
         MVI       STATE,C' '
*        MVI       STYPE,C' '
         MVI       RTYPE,C' '
*
ALP;  % RETURN TO ALP LAND

MZC TABTABLE,TABTLEN;  % ZERO TAB TABLE
LA XRA,TABTABLE;  % POINT AT TABLE
LI VR1,10;  % TEN ENTRIES IBM STYLE
LI VR0,9;  % 9 FIRST ENTRY EACH 8 UNITS LONG
DO BEGIN
STH VR0,0(,XRA);  % PUT IN TABLE
AI VR0,8;  % NEXT ENTRY
AI XRA,2 % NEXT POINT IN BUFFER
END FOR VR1;

MZC RECTABLE,256;  % ZERO RECTABLE
MMVC SENDTBL,SENDTLIT,256;  % INITIALIZE BOTH TABLES
MMVC REPTCHAR,DREPT,1;  % MOVE IN DEFAULT VALUE FOR REPEAT PREFIX
MZC PREFIXL,2;  % NO PREFIX SET
ZF PREFXQUO;  % QUOTED PREFIX
SF EDITF;  % DEFAULT AS EDIT FILE

MMVC EDTYPE,=F'1',4;  % TURN OFF LINE NUMBERS
MMVC HIGHBCC,DBCC,1;  % SET BCC CHECK LEVEL
SF TIMERF;  % TURN ON TIMER
MMVC DATA,=C'TEXT  ',6;
ZF DATAFLAG;
MMVC PHDR,SSOH,1;  % INITIALIZE START O HEADER
CALL XANYVOL;  % EXTERNAL ROUTINE GIVES THE SYSTEM
             %   SYMBOL FOR SYSTEM SELECTING THE VOLUMRE
 %  ON UPLOADED DATA SET (E.G SET VOL TMP - SYSTEM SELECTS
ST VR1,TMPDISKA;
STH VR0,TMPDISKL;
LR XRA,VR0;
MFC VOLUME,L'VOLUME;
EXI XRA,MMVC,VOLUME,0(VR1),*-*,INCR=YES,DECR=YES;

CEXIT VRE,HIGHR;
         LTORG;
KWRDSECT: AREA ,0X;
COPY KWR;
AREAEND;
SENDTLIT: AREA F,DSECT=NO;
         DC  256AL1(0);  % FILL ARRAY WITH ZEROS
ORG SENDTLIT;
         DC  32AL1(ASCIIQUO);  % CONTROL QUOTE
ORG SENDTLIT+127;
         DC  AL1(ASCIIQUO);  % THE DELETE CHARACTER
ORG SENDTLIT+128;  % CONTROL + 8BIT
          DC    32AL1(ASCIQUO8);  % CONTROL + 8BIT
        DC 95AL1(ASCI8BIT);
ORG SENDTLIT+255;  % CONTROL + 8BIT
           DC   AL1(ASCIQUO8);  % CONTROL + 8BIT
SENDTLTL: AREAEND;
SUBTITLE 'PROFILES';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  MODULE NAME - PROFILES
%  FUNCTION - EXECUTE SYSTEM AND USER PROFILES IF ANY VIA LOCATE
% INPUTS NONE
% OUTPUTS EXECTION OF PROFILE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROFILES:
CENTER VRE,HIGHR,ENTRY=NO;
MFC DSNAME,44;

% NOW CHECK IF THERE IS A USER PROFILE
LH XRA,USERPREL;  % LENGTH OF USER PREFIX
L XRB,USERPREA;  % USER PREFIX NAME
EXI XRA,MMVC,DSNAME,0(XRB),*-*,INCR=YES,DECR=YES;  % USER  + "."
LA VR1,DSNAME;
AR VR1,XRA;
MVI 0(VR1),C'.';  % PUT IN DOT AFTER USER CODE
AI VR1,1;
MMVC 0(VR1),USERPROF,USERPROL;
LOCATE DATASET;
IF <RZ VRF> THEN BEGIN  % DATASET EXISTS - SO EXECUTE IT VIA TSO
LI VR0,XUSERPRL;  % LENGTH OF COMMAND
CCALL TSOCMD,A,VR1=XUSERPRO;  % EXECUTE THE PROFILE COMMAND
END;
MFC DSNAME,44;
% FIRST CHECK IF THERE IS A SYSTEM PROFILE
CALL SYSPRODS;  % CALL EXTERNAL ROUTINE FOR NAME OF SYSTEM PROFILE
IF <RP VR0> & <CLI VR0,45; CC L> THEN BEGIN  % MUST HAVE LENGTH
LR XRA,VR1;  % POINTER TO SYSTEM PROFILE
LR XRB,VR0;  % LENGTH OF SYSTEM PROFILE
EXI XRB,MMVC,DSNAME,0(XRA),*-*,INCR=YES,DECR=YES;
LOCATE DATASET;
IF <RZ VRF> THEN BEGIN  % DATASET EXISTS - SO EXECUTE IT VIA TSO
LR VR0,XRB;  % LENGTH OF COMMAND
AI VR0,5;  % LENGTH OF DSN + EX + QUOTES AND BLANKS
EXI XRB,MMVC,EXDSN,0(XRA),*-*,INCR=YES,DECR=YES;
LA VR1,EXDSN;
AR VR1,XRB;
MVI 0(VR1),C'''';
CCALL TSOCMD,A,VR1=EXBUFFER;  % EXECUTE THE PROFILE COMMAND
END;
MFC DSNAME,44;
END;  % OF POSITIVE RETURN ON SYSTEM PROFILE

DATA BEGIN
EXBUFFER:
DC CL3'EX ';  % THE EXECUTE COMMAND
DC CL1'''';  % QUOTE AROUND SYSTEM PROFILE
EXDSN: DS   CL46;  % FOR DATA SET NAME
END;

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'STCKMOD';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: STCKMOD
% FUNCTION: CALLS THE STACK MACRO TO PUT INPUT ON STACK
%           IF ONE EXISTS ON THE COMMAND LINE OF CP
%  RETURN   : ITEM STACKED ON INPUT STACK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
STCKMOD:
CENTER VRE,HIGHR,ENTRY=NO;
L XRA,CBUFFADD;  % ADDRESS
LH XRB,0(XRA);  % LOAD LENGTH OF COMMAND STRING
SI XRB,4;  % SUB OFF FOUR FOR HEADER
LH XRC,2(XRA);  % LOAD OFFSET FOR PARAMETER
SR XRB,XRC;  % SEE IF A PARAMETER EXISTS
IF <RP XRB> THEN BEGIN  % WE HAVE ONE
AI XRA,4;  % POINT TO BEGINING OF COMMAND STRING
AR XRA,XRC;  % INDEX TO BEGINNING OF PARAMETER
%  NOW XRA-> PARAMETER
%   AND XRB= THE LENGTH

LA VR0,16(,XRB);  % THE LENGTH
O VR0,=AL1(78,0,0,0);  % SUBPOOL 78  WHERE THE STACK WANTS IT
GETMAIN R,LV=(0);  % GET THE CORE
LR XRC,VR1;  % ADDRESS
MZC 0(XRC),16;  % CLEAR LSD
USE XRC AS LSD IN BEGIN
AI VR1,16;  % INCREMENT PAST LSD
ST VR1,LSDADATA; ST VR1,LSDANEXT;  % PLANT BUFFER ADDRESS
STH XRB,LSDRCLEN;  % PLANT RECORD LENGTH
STH XRB,LSDTOTLN;  % PLANT TOTAL LENGTH
END;
EXI XRB,MMVC,0(VR1),0(XRA),*-*,INCR=YES,DECR=NO;
L XRA,UPTADD;  % UPTADDRESS
L XRB,ECTADD;  % ECT ADDRESS
L VRF,STACKADD;
STACK STORAGE=((XRC),SOURCE),ENTRY=(15),MF=(E,IOPLADS),_
PARM=STACKLST,UPT=(XRA),ECT=(XRB),ECB=ECBGETLN;
DATA BEGIN
STACKLST: STACK MF=L;
END;  % THAT'S ALL FOLKS
END;  % OF SOMETHING TO STACK
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'KSET';

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%     MODULE NAME   -   KSET
%
%
%     FUNCTION-  MODULE SETS VARIOUS KERMIT OPTIONS
%               WHICH ARE DISPLAYED VIA THE SHOW COMMAND
%
%
%     INPUTS -   THE BUFFER 'INPUT' CONTAINS A COMMAND STRING
%
%
%
%
%     OUTPUTS-   CORRECTLY SET OPTIONS
%
%
%     RETURN
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KSET: ;
CENTER VRE,HIGHR,ENTRY=NO;

LA XRC,*+4095;
USING *+4095-4,XRC;
%USING *+4095,XRC;
L XRD,SETADD;
LA XRE,4095(,XRD);
USING SETLABEL+4095,XRE;  % LITERALS ADDRESSIBILITY
USING SETLABEL,XRD;  % ADDRESSIBILITY
SCERROR NEW=SETERROR;  % ROUTINE FOR SCANNER ERROR
VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN;  % INIT VAREA FOR OUTPUT
SETBLCK: DO BEGIN  % MAINLY TO FALL OUT

       SCAN   *;  % SCAN FOR SPECIFIC SET COMMAND
       SCKW  DATA,SETDATA,J;  % DATA COMMAND
       SCKW  BLOCK,SETBLOCK,J;  % BLOCK COMMAND
       SCKW  DEBUG,SETDBUG,J;  % DEBUG COMMAND
       SCKW  (HELP,?),SETHELP;  % HELP COMMAND
       SCKW  BIT8,SETBIT8,J;  % 8 BIT QUOTING Y/N COMMAND
       SCKW  EDIT,SETEDIT,J;  % EDIT DATA SET OPTIONS
       SCKW  (TAB,TABS),SETTAB,J;  % TAB OPTIONS
       SCKW  (SER,SERVER),SETSER,J;  % SERVER MODE OPTIONS
       SCKW  (TIME,TIMER),SETTIME,J;  % ENABLE TIMEOUT FEATURE
       SCKW  LRECL,SETLRECL,P;  % LRECL COMMAND
       SCKW  BLKSIZE,SETBLK,P,LIMIT=AL1(5);  % BLKSIZE COMMAND
       SCKW  SPACE,SETSPACE,P;  % SPACE COMMAND
       SCKW  DELAY,SETDELAY,P;  % DELAY COMMAND
       SCKW  REOL,SETREOL,P,LIMIT=AL1(3);  % RECEIVE  EOL COMMAND
       SCKW  SEOL,SETSEOL,P,LIMIT=AL1(3);  % SEND     EOL COMMAND
       SCKW  SOH,SETSOH,P,LIMIT=AL1(3);  % SOH COMMAND
       SCKW  (P,PACK,PACKET),SETPACK,P;  % RECEIVE  PACKET COMMAND
       SCKW  RECFM,SETRECFM,P,LIMIT=AL1(2);  % RECFM COMMAND
       SCKW  CQUOTE,SETQUOTE,P,LIMIT=AL1(3);  % QUOTE COMMAND
       SCKW  VOLUME,SETVOL,P,LIMIT=AL1(7);  % VOL COMMAND
       SCKW  BQUOTE,SETBINQC,P,LIMIT=AL1(3);  %  BINARY QUOTE   COMMAND
       SCKW  RQUOTE,SETREPTQ,P,LIMIT=AL1(3);  %  REPEAT QUOTE   COMMAND
       SCKW NUMBERED,DONUMBER;  % NUMBERING COMMAND
       SCKW PREFIX,DOPREFIX;  % PREFIX COMMAND
       SCKW NOPREFIX,NOPREFIX;  % PREFIX COMMAND
SCKW TURNAROUND,DOTURNRN,J;
       SCKW  ,BADSETKY;  % UNKNOWN KEYWORD
SCANEND;  % END OF SCANNING
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 NO PARM ERROR HERE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
WRTERM 'Parameter required for the Set command  ';

% drop into help message

%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET HELP TELLS VARIOUS SET OPTIONS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETHELP:

WRTERM 'SET command options are ';
WRTERM ' ';  % BLANK LINE
WRTERM 'Data set attributes    ';
WRTERM 'DATA - Specifies text or binary file processing.';
WRTERM 'EDIT - Selects WYLBUR edit format or'_
   ' non-edit format for received text';
WRTERM  'data sets.';
WRTERM 'NUMBERED - Controls line numbering in non-edit '_
'format text data sets.';
WRTERM 'TABS - Controls tab processing (tabs to spaces '_
       'receiving, vice-versa sending).';
WRTERM 'RECFM - Record format for received data set'_
   ' (non-edit format only).';
WRTERM 'LRECL - Logical record length for received data set'_
   ' (non-edit format only).';
WRTERM 'BLKSIZE - Block size for received data set'_
   ' (non-edit format only).';
WRTERM 'SPACE - Space allocation for received data set in tracks.';
WRTERM 'VOLUME - Disk volume to store received data set.';
WRTERM 'PREFIX - Prefix to be appended to the start of data'_
       ' set names.';
WRTERM 'NOPREFIX - Cancels a previously set prefix.';
WRTERM ' ';
WRTERM 'Protocol Attributes ';
WRTERM 'DELAY - Timing value for delay before starting send.';
WRTERM 'TIMER - Timeout on received packets.';
WRTERM 'BLOCK - Type of block checking on packets.';
WRTERM 'PACKET - Packet size.';
WRTERM 'CQUOTE - Quote character for control characters.';
WRTERM 'BQUOTE - Quote character for 8th bit quoting.';
WRTERM 'RQUOTE - Quote character for repeat count quoting.';
WRTERM 'SOH - First character of packet.';
WRTERM 'SEOL - Character appended to the end of sent packets.';
WRTERM 'REOL - Character expected at the end of received packets.';
WRTERM 'DEBUG - Sends log of all KERMIT packets '_
'and disk I/O to a data set.';
WRTERM ' ';
WRTERM 'Specific information on each item is '_
       'available by "SET item ?".';

        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET DATA   FUNCTION     BINARY OR TEXT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETDATA:
        SCKW  ?,DATAHELP;  % USER NEEDS INFO
        SCKW  (B,BINARY),BINON;  % TURN ON INDICATOR
        SCKW  (TEXT,T),BINOFF;  % TURN OFF
        SCKW   ,DATAERR;  % MISSING PARM

BINON:
        SF DATAFLAG;  % TURN ON BINARY INDICATOR
        MMVC DATA,=C'BINARY',6;
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%

BINOFF:
        ZF DATAFLAG;  % TURN OFF BINARY INDICATOR
        MMVC DATA,=C'TEXT  ',6;
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
DATAHELP:
WRTERM 'Sets TEXT (ASCII-EBCDIC conversion) '_
'or BINARY (no conversion)';
WRTERM 'processing of data.';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
DATAERR:
WRTERM 'Valid options for data are binary or text ';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%     SET BLOCK CHECK TYPE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SETBLOCK:
       SCKW 1,SETBCC,CODE=AL1(1);
       SCKW 2,SETBCC,CODE=AL1(2);
       SCKW 3,SETBCC,CODE=AL1(3);
       SCKW CRC,SETBCC,CODE=AL1(3);
       SCKW (HELP,?),BCCHELP;
       SCKW ,BCCSETER;

SETBCC:
STC VRE,HIGHBCC;  % STORE OFF THE VALUE
EXIT FROM SETBLCK;
%
BCCHELP:
WRTERM 'Specifies which type of block checking is used.';
BCCSETER :
WRTERM 'Valid options are 1 (1-byte checksum), 2 (2-byte checksum),';
WRTERM '3 (3 byte cyclic redundancy check), or CRC '_
'(synonym for 3).';

EXIT FROM SETBLCK;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET BIT8   FUNCTION     ON OR OFF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETBIT8:
        SCKW  ?,BIT8HELP;  % USER NEEDS INFO
        SCKW  ON,BITON8;  % TURN ON INDICATOR
        SCKW  OFF,BITOFF8;  % TURN OFF
        SCKW   ,BIT8ERR;  % MISSING PARM

BITON8:
        SF BIT8FLAG;  % TURN ON WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%

BITOFF8:
        ZF BIT8FLAG;  % TURN OFF WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
BIT8HELP:
WRTERM 'BIT8 either on/off';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
BIT8ERR:
WRTERM 'BIT8 turns on/off eighth bit quoting ';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET EDIT   FUNCTION     ON OR OFF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETEDIT:
        SCKW  ?,EDITHELP;  % USER NEEDS INFO
        SCKW  ON,EDITON;  % TURN ON INDICATOR
        SCKW  OFF,EDITOFF;  % TURN OFF
        SCKW   ,EDITERR;  % MISSING PARM

EDITON:
        SF EDITF;  % TURN ON WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%

EDITOFF:
        ZF EDITF;  % TURN OFF WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
EDITHELP:
WRTERM 'Controls use of WYLBUR edit format for received data sets.';
WRTERM 'Valid options are ON and OFF (default ON).';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
EDITERR:
WRTERM 'Valid SET EDIT parameters are on, off, or help ';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET TIME   FUNCTION     ON OR OFF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETTIME:
        SCKW  ?,TIMEHELP;  % USER NEEDS INFO
        SCKW  ON,TIMEON;  % TURN ON INDICATOR
        SCKW  OFF,TIMEOFF;  % TURN OFF
SCKW ,TIMEINT,I,;  % GETS ACTUAL VALUE OF TIME FOR TIMER
        SCKW   ,TIMEERR;  % MISSING PARM

TIMEON:
        SF TIMERF;  % TURN ON WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%

TIMEOFF:
        ZF TIMERF;  % TURN OFF WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
TIMEHELP:
WRTERM _
'Controls timeout processing for received packets.  TSO KERMIT ';
WRTERM _
'sends a NAK packet after timeout interval expires.  After ';
WRTERM _
'20 retries, TSO KERMIT terminates the file transfer.  Valid';
WRTERM _
'are OFF (turns off timeout), ON (turns on timeout), or the number';
WRTERM _
'of seconds to be used for the timeout interval.';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
TIMEINT:
IF <CI VRF,TIMERTOP; CC H> THEN BEGIN
WRTERM 'Too large a value for timer - 3600 seconds max';
END  % OF ERROR
ELSE BEGIN
MI VRF,100;  % STIMER MACRO USES 100'S OF SECONDS
ST VRF,RTIMEOUT;
SF TIMERF;
END;
EXIT FROM SETBLCK;

TIMEERR:
WRTERM 'Valid SET TIME parameters are on, off, or help ';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET TAB   FUNCTION     ON OR OFF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETTAB:
        SCKW  ?,TABHELP;  % USER NEEDS INFO
        SCKW  ON,TABON;  % TURN ON INDICATOR
        SCKW  OFF,TABOFF;  % TURN OFF
        SCKW   ,TABSCN,B;  % CALL SCAN TAB ROUTINE

TABON:
FREEMAIN RC,SP=18;  % FREE TAB BUFFER
        SF TABF;  % TURN ON WORD INDICATOR
LA XRA,TABTABLE;  % STANDARD TABLE
ST XRA,TABTBLAD;  % STORE IN ADDRESS THAT TAB ROUTINES USE
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%

TABOFF:
FREEMAIN RC,SP=18;  % FREE TAB BUFFER
        ZF TABF;  % TURN OFF WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
TABHELP:
WRTERM _
'Controls TAB processing on upload or download of text files.'_
'  OFF disables';
WRTERM _
'TAB processing.  ON assumes tabs are set every 8 positions on the ';
WRTERM _
'microcomputer and changes tabs to blanks in received data sets and';
WRTERM _
'blanks to tabs in transmitted data sets.  Tab positions may also ';
WRTERM _
'be specified as "column", "column+interval*count" '_
'to set a tab at';
WRTERM '"column" and every "interval" columns for "count" times,';
WRTERM '"and/or column+interval/max"'_
 ' to set a tab "interval" columns through ';
WRTERM 'column "max".';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
TABSCN:
CCALL SCANTABS,A;
IF <RNZ VRF> THEN  % ISSUE MESSAGE ON ERROR
WRTERM 'Invalid SET TAB parameters.  Type SET TAB ? for information.'
ELSE SF TABF;  % INDICATE TABBING
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET SERVER   FUNCTION     ON OR OFF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETSER:
        SCKW  ?,SERHELP;  % USER NEEDS INFO
        SCKW  ON,SERON;  % TURN ON INDICATOR
        SCKW  OFF,SEROFF;  % TURN OFF
        SCKW   ,SERERR;  % MISSING PARM

SERON:
        SF SERVERF;  % TURN ON WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%

SEROFF:
        ZF SERVERF;  % TURN OFF WORD INDICATOR
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
SERHELP:
WRTERM 'The SERVER command enables SERVER processing '_
'TSO KERMIT becomes a slave to micro KERMIT . ';

WRTERM 'No set commands available while in Server mode ';
WRTERM 'the pc KERMIT issuses a logoff to the Server  ';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
SERERR:
WRTERM 'Valid SET SERVER parameters are on, off, or help ';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET DEBUG   FUNCTION     ON OR OFF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETDBUG:
        SCKW  ?,DBUGHELP;  % USER NEEDS INFO
        SCKW  ON,DBUGON;  % TURN ON INDICATOR
        SCKW  OFF,DBUGOFF;  % TURN OFF
        SCKW   ,DBUGERR;  % MISSING PARM

DBUGON:
        SF DBUGFLAG;  % TURN ON WORD INDICATOR
   %   OPEN FILE IF CLOSED
IF ^<OPENP DEBUG> THEN BEGIN  % FILE OPEN
     OPEN (DEBUG,(OUTPUT));
IF ^<OPENP DEBUG> THEN BEGIN  % FILE OPEN
WRTERM 'Unable to open DEBUG - DEBUG disabled';
        ZF DBUGFLAG;  % TURN OFF WORD INDICATOR
END;  % OF ERROR OPEN
END;  % OF OPEN BLOCK

        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%

DBUGOFF:
        ZF DBUGFLAG;  % TURN OFF WORD INDICATOR
       % CLOSE FILE IF OPEN
IF <OPENP DEBUG> THEN CLOSE DEBUG;  % FILE CLOSE
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
DBUGHELP:
WRTERM 'SET DEBUG ON dumps all received and sent packets';
 % 'all data set';
WRTERM 'plus all data set I/O to a VB data set.';
WRTERM 'The user must allocate the DD name DEBUG '_
'to a sequential data set.';
WRTERM 'SET DEBUG OFF (default) closes debug data set (if open) ';
WRTERM  'and turns off debugging information.';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
DBUGERR:
WRTERM 'Only valid debug options are on/off ';
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET VOLUME   SERIAL NUMBER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETVOL:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
VOLHELP:
WRTERM 'Specifies which disk volume will be used for the'_
' received data set.';
WRTERM 'VOLUME requires a 6 character volume serial number (e.g.'_
 ' FILE24).';
%WRTERM 'TMP means that any TMP volume may be used.';
L XRA,TMPDISKA;
LH XRB,TMPDISKL;
LA VR1,WRKBUFF;
EXI XRB,MMVC,WRKBUFF,0(XRA),*-*,INCR=YES,DECR=YES;
AR VR1,XRB;
MMVC 0(VR1),=C' means that any ',16;
AI VR1,16;
EXI XRB,MMVC,0(VR1),0(XRA),*-*,INCR=YES,DECR=YES;
AR VR1,XRB;
MMVC 0(VR1),=C' volume will be used.',21;
AI VR1,21;
LR VR0,VR1;
LA VR1,WRKBUFF;
SR VR0,VR1;
TPUT (VR1),(VR0);
END  % OF HELP
ELSE BEGIN
IF ^<CI VR0,6> THEN BEGIN  % MUST HAVE 6 CHARACTER VOLUME
L XRA,TMPDISKA;  % ADDRESS OF DEFAULT DISK
LH XRB,TMPDISKL;
IF <EXI XRB,MCLC,0(VR1),0(XRA),*-*,INCR=YES,DECR=YES> THEN BEGIN
MFC VOLUME,L'VOLUME;
EXI XRB,MMVC,VOLUME,0(XRA),*-*,INCR=YES,DECR=YES;
END
ELSE BEGIN  % ERROR
VOLERR:
WRTERM 'VOLUME must have 6 character length';
END;  % ERROR
END
ELSE BEGIN  % A GOOD 6 SERIAL
MMVC VOLUME,0(VR1),6;  % CHANGE VOLUME
MVI VOLUME+6,C' ';  % BLANK LAST
END;  % OF GOOD
END;  % OF NON HELP
%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET RECFM   V OR F
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETRECFM:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
RECFMHLP:
WRTERM 'Record format for received non-edit format data set.';
WRTERM 'Valid Record formats are F, FB, V, VB, VBS or U (default VB).';
%
END  % OF HELP
ELSE BEGIN
LR XRA,VR0;  % GET LENGTH
IF <CLI 0(VR1),C'F'>  |   % MUST HAVE F CHARACTER RECFM   OR
 <CLI 0(VR1),C'U'>     |        % MUST HAVE U CHARACTER RECFM
 <CLI 0(VR1),C'V'> THEN BEGIN  % MUST HAVE V CHARACTER RECFM
IF <CI VR0,1> THEN MVI RFM+1,C' ' % BLANK IT OUT
ELSE <GOTO RECFMERR IF <CLI 1(VR1),C'B'; CC NE>>;  % JUMP OUT
EXI XRA,MMVC,RFM,0(VR1),0,DECR=YES;  % CHANGE RECFM
END
ELSE BEGIN  % RECFM  ERROR
RECFMERR:
WRTERM 'Valid Record formats are F, FB, V, VB ,VBS or U (default VB)';
END;  % OF GOOD
END;  % OF NON HELP
%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET QUOTE CHARACTER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETQUOTE:
SCINIT (VR1),(VR0);
SCAN *;
SCKW (HELP,?),CQUOTHLP;
SCKW ,CQUOTNUM,PI,LIMIT=AL1(127);
SCKW ,CQUOTCHK,P,LIMIT=AL1(1);
SCKW ,CQUOTBAD;
SCANEND;
EXIT FROM SETBLCK;

CQUOTHLP:
WRTERM 'CQUOTE character (default #) is used for prefixing'_
  ' characters with a value lower ';
WRTERM 'than 32 decimal in  ASCII. Value must be between 33-62 '_
 'or 96-126 decimal,';
WRTERM 'indicating the ASCII code for the character.'_
       '  The actual character may';
WRTERM 'also be specified.';
%
EXIT FROM SETBLCK;
CQUOTCHK:
L XRA,ETOAVCON;  % ADDRESS OF TABLE
MTR 0(VR1),0(XRA),1;  % GET ASCII CHARACTER
LOADB VRF,0(VR1);  % LOAD IT
                   % NOW DROP INTO CHECK
CQUOTNUM: % NUMBER IN VRF
CCALL CHKCNTL,A,VR0=1;
IF <RNZ VRF>  THEN
BEGIN  % UNVALID VALUE
CQUOTBAD:
WRTERM 'Invalid value - must be between 33-62 - ASCII '_
 'Or 96-126 ASCII ';
END;  % OF ERROR VALUE

%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%     SET BINARY QUOTE CHARACTER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETBINQC:
SCINIT (VR1),(VR0);
SCAN *;
SCKW (HELP,?),BQUOTHLP;
SCKW ,BQUOTNUM,PI,LIMIT=AL1(127);
SCKW ,BQUOTCHK,P,LIMIT=AL1(1);
SCKW ,BQUOTBAD;
SCANEND;
EXIT FROM SETBLCK;

BQUOTHLP:
TPUT =C'8th bit quote character (default &&) is used for ',48;
WRTERM  'prefixing characters that have their 8th bit on.';
WRTERM 'Value must be between 33-62 '_
 'or 96-126 decimal,';
WRTERM 'indicating the ASCII code for the character.';
WRTERM 'The actual character may also be specified.';
%
EXIT FROM SETBLCK;
BQUOTCHK:
L XRA,ETOAVCON;  % ADDRESS OF TABLE
MTR 0(VR1),0(XRA),1;  % GET ASCII CHARACTER
LOADB VRF,0(VR1);  % LOAD IT
BQUOTNUM: % NUMBER IN VRF
CCALL CHKCNTL,A,VR0=2;
IF <RNZ VRF> THEN  BEGIN  % UNVALID VALUE
BQUOTBAD:
WRTERM 'Invalid value - must be between 33-62 - ASCII ';
WRTERM 'Or 96-126 ASCII ';
END;  % OF ERROR VALUE

%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%     SET REPEAT QUOTE CHARACTER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETREPTQ:
SCINIT (VR1),(VR0);
SCAN *;
SCKW (HELP,?),RQUOTHLP;
SCKW ,RQUOTNUM,PI,LIMIT=AL1(127);
SCKW ,RQUOTCHK,P,LIMIT=AL1(1);
SCKW ,RQUOTBAD;
SCANEND;
EXIT FROM SETBLCK;

RQUOTHLP:
WRTERM 'Repeat quote character (default ~) is used for ';
WRTERM  'prefixing repeated characters.';
WRTERM 'Value must be between 33-62 '_
 'or 96-126 decimal,';
WRTERM 'indicating the ASCII code for the character.';
WRTERM 'The actual character may also be specified.';
EXIT FROM SETBLCK;
RQUOTCHK:
L XRA,ETOAVCON;  % ADDRESS OF TABLE
MTR 0(VR1),0(XRA),1;  % GET ASCII CHARACTER
LOADB VRF,0(VR1);  % LOAD IT
                   % NOW DROP INTO CHECK
RQUOTNUM: % NUMBER IN VRF
CCALL CHKCNTL,A,VR0=3;
IF <RNZ VRF>  THEN   BEGIN
RQUOTBAD:
WRTERM 'Invalid value - must be between 33-62 - ASCII ';
WRTERM 'Or 96-126 ASCII ';
END;  % OF ERROR VALUE

%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET BLOCKING
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETBLK:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
BLKHELP:
WRTERM 'Block size for received non-edit format data set '_
 '(default 6356, max 32760).';
%
END  % OF HELP
ELSE BEGIN
CVDTB (VR1),(VR0);  % CONVERT THE EBCDIC TO BINARY
IF <RMZ VRF> | <CI VRF,32767; CC NL> THEN BEGIN  % 32767 HIGHEST VALUE
BLKERR:
WRTERM 'BLOCKING HIGHEST VALUE = 32767';
END

ELSE BEGIN  % A GOOD 1 BLK
STH VRF,BLKSIZE;  % STORE IF OFFF
END;  % OF SELECT BEGIN
END;  % OF NON HELP
%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET LRECL
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETLRECL:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
LRECLHLP:
WRTERM 'Logical record length for received non-edit format data set';
WRTERM '(default 504, max 32760).';
%
END  % OF HELP
ELSE BEGIN
CVDTB (VR1),(VR0);  % CONVERT THE EBCDIC TO BINARY
IF <RMZ VRF> | <CI VRF,32761; CC NL> THEN BEGIN  % 32760 HIGHEST VALUE
LRECLERR:
WRTERM 'LRECL  HIGHEST VALUE = 32760-CAN`T BE 0 OR MINUS';
END
ELSE BEGIN  % A GOOD  LRECL
STH VRF,LRECL;  % STORE IF OFFF
END;  % OF GOOD
END;  % OF NON HELP
%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET DELAY BEFORE SEND INIT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETDELAY:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
DELAYHLP:
WRTERM 'Specifies number of seconds (default 20)'_
' that TSO KERMIT waits before the ';
WRTERM 'first packet is sent by the SEND command.';
%
END  % OF HELP
ELSE BEGIN
CVDTB (VR1),(VR0);  % CONVERT THE EBCDIC TO BINARY
IF <RMZ VRF> | <CI VRF,32767; CC NL> THEN BEGIN  % 32767 HIGHEST VALUE
DELAYERR:
WRTERM 'DELAY  HIGHEST VALUE = 32767-CAN`T BE 0 OR MINUS';
END
ELSE BEGIN  % A GOOD  DELAY
MI VRF,100;  % PUT IN 100TH OF SECONDS
ST VRF,DELAY;  % STORE IF OFFF
END;  % OF GOOD
END;  % OF NON HELP
%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET SOH START-OF-HEADER  CHARACTER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETSOH:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
SOHHELP:
WRTERM 'Sets the Start-of-header character sent at the start of'_
' each transmitted packet ';
WRTERM 'and expected at the start of each received packet.';
WRTERM 'May be specified as decimal value of ASCII '_
         'code (0-31), ASCII control character ';
WRTERM 'name (e.g., SOH), or in control key notation (e.g., ^A).';
%
END  % OF HELP
ELSE BEGIN
%CVDTB (VR1),(VR0);  % CONVERT THE EBCDIC TO BINARY
CCALL SETCNTLS,A;
IF <RM VRF> | <CI VRF,32; CC NL> THEN BEGIN  % 31 HIGHEST VALUE
SOHERR:

WRTERM 'Valid Values 0-31 decimal';
END
ELSE BEGIN  % A GOOD 1 SOH
STC VRF,SSOH;  % STORE IF OFFF
STC VRF,RSOH;  % RECEIVE SOH
STC VRF,PHDR;  % STORE OFF IN SEND PACKET
END;  % OF GOOD
END;  % OF NON HELP
%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET EOL END-OF-LINE  CHARACTER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETSEOL:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
WRTERM 'The End-of-line control character '_
   'sent at the end of each transmitted packet.';
WRTERM 'May be specified as decimal value of ASCII '_
         'code (0-31), ASCII control character ';
WRTERM 'name (e.g., CR), or in control key notation (e.g., ^M).';
%
END  % OF HELP
ELSE BEGIN
CCALL SETCNTLS,A;
IF <RM VRF> | <CI VRF,32; CC NL> THEN BEGIN  % 31 HIGHEST VALUE
EOLERR:

WRTERM 'Valid Values 0-31 decimal';
END
ELSE BEGIN  % A GOOD 1 EOL
STC VRF,SEOL;  % STORE IF OFFF
END;  % OF GOOD
END;  % OF NON HELP
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SETREOL:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
WRTERM 'The End-of-line control character '_
   'expected at the end of each received packet.';
WRTERM 'May be specified as decimal value of ASCII '_
         'code (0-31), ASCII control character ';
WRTERM 'name (e.g., CR), or in control key notation (e.g., ^M).';
%
END  % OF HELP
ELSE BEGIN
CCALL SETCNTLS,A;
IF <RM VRF> | <CI VRF,32; CC NL> THEN BEGIN  % 31 HIGHEST VALUE
%EOLERR:

WRTERM 'Valid Values 0-31 decimal';
END
ELSE BEGIN  % A GOOD 1 EOL
STC VRF,REOL;  % RECEIVE EOL
END;  % OF GOOD
END;  % OF NON HELP
%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET RECEIVE PACKET LENGTH
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETPACK:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
PACKHELP:
WRTERM 'Sets the maximum packet length'_
  '.  Valid Values are 26-94 decimal.';
%
END  % OF HELP
ELSE BEGIN
CVDTB (VR1),(VR0);  % CONVERT THE EBCDIC TO BINARY
IF <CI VRF,26; CC NL> & <CI VRF,94; CC NH> THEN BEGIN  % 94 HIGHEST VALU
ST VRF,RPSIZ;  % STORE IF OFFF
END
ELSE BEGIN  % A ERROR PACKET SIZE
PACKERR:
WRTERM 'Valid Values 26-94 decimal';
END;  % OF GOOD
END;  % OF NON HELP
%
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 SET SPACE -TRACK ALLOCATIONS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETSPACE:
IF <CLI 0(VR1),C'?'> | <MCLC 0(VR1),=C'HELP',4> THEN BEGIN
SPACEHLP:
WRTERM 'Space allocation for received data sets'_
' in tracks (default 5, max 32767).';
%
END  % OF HELP
ELSE BEGIN
CVDTB (VR1),(VR0);  % CONVERT THE EBCDIC TO BINARY
IF <RMZ VRF> | <CI VRF,32767; CC NL> THEN BEGIN  % 32767 HIGHEST VALUE
SPACEERR:
WRTERM 'HIGHEST TRACK VALUE = 32767';
END
ELSE BEGIN  % A GOOD 1 SPACE
ST VRF,TRACK;  % STORE IF OFFF
END;  % OF GOOD
END;  % OF NON HELP
        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%     SET NUMBERS - COLUMN POSITIONS WYL/TSO
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
DONUMBER: % COL NUMBERS

CCALL SCANNUMS,A;  % SET UP NUMBERING

        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%     SET PREFIX - PREFIX USED FOR DATA SET NAME
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
DOPREFIX:
SCTELL;  % GET REMAINDER OF STRING


CCALL SETPREFX,A;

EXIT FROM SETBLCK;  % BLOW THIS POP STAND
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%     SET NOPREFIX
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
NOPREFIX:  % DISABLE PREFIX
SCTELL;
IF <RP VR0> THEN BEGIN
SCAN *;
     SCKW (HELP,?),NOPREFHP;
SCANEND;  % OTHER PARAMETERS
WRTERM 'NOPREFIX has no parameters execept HELP or ?';
EXIT FROM SETBLCK;
NOPREFHP: % HELP EM OUT
WRTERM 'NOPREFIX cancels prefixing a data set name on send or'_
' receive.';
EXIT FROM SETBLCK;
END;  % OF MORE TO SCAN
MZC PREFIXL,2;  % EASY AY
ZF PREFPDSF;
ZF PREFXQUO;

EXIT FROM SETBLCK;  % BLOW THIS POP STAND
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                 INVALID  SET    COMMAND
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
BADSETKY:
WRTERM 'Invalid Set Command '_
'Type in "SET HELP" if you need assistance.';

        EXIT FROM SETBLCK;  % DROP OUT OF SET BLOCK
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% TURNAROUND TIME
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
DOTURNRN:
SCKW SON,STRNDON;
SCKW SOFF,STRNDOFF;

SCKW ROFF,RTRNDOFF;
SCKW RON,RTRNDON;
STRNDON: SF STURNRND;
EXIT FROM SETBLCK;
STRNDOFF: ZF STURNRND;
EXIT FROM SETBLCK;
RTRNDON: SF RTURNRND;
EXIT FROM SETBLCK;
RTRNDOFF: ZF RTURNRND;
EXIT FROM SETBLCK;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%               SCAN ERROR ROUTINE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
SETERROR:     %    SCAN ERROR ROUTINE
SELECT FIRST;
<CI VRF,SCTCUE>: <VSEG KERMVA,'  Missing parameter for command Set '>;
<CI VRF,SCTCLXM>:
<SCLAST; VSEG KERMVA,'  Parameter too long for command Set '>;
ENDSEL
ELSE BEGIN
VSEG KERMVA,'Illegal value for SET command';
END;
SCLAST;  % GET LAST TOKEN SCANNNED
VSEG KERMVA,(VR1),(VR0);  % PLACE IN BUFFER\
VOUT KERMVA;  % PRINT IT
SETLABEL:   DS   0H;  % USING LABEL

END;  % OF SET BLOCK
CEXIT VRE,HIGHR;


LTORG;
EXORG;
DROP XRD;  % FREE LITERAL REG
DROP XRE;  % FREE LITERAL REG
DROP XRC;  % FREE ADDRESSIBILTY REG
TIMERTOP:     EQU    3600;  % TOP LIMIT FOR TIMER

SUBTITLE 'SETPREFX';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5
%  MOD: SETPREFX
%  FUNCTION:  SET PREFIX TO DATA SET NAME FOR UPLOAD
%              OR DOWNLOAD
%  INPUT:     VR1-> STRING
%             VR0= LENGTH OF STRING
%  OUTPUT:    VARIABLE PREFIX FILLED AND FLAGS SET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SETPREFX:
CENTER VRE,HIGHR,ENTRY=NO;

ZF PREFXQUO;
ZF PREFPDSF;
MZC PREFIXL,2;
MZC PREFMEML,2;  % ZERO OUT LENGTHS
SCINIT (VR1),(VR0);
SCERROR NEW=SCPREERR;
SCANPREF: DO BEGIN SCAN *;
     SCKW ?,PREFHELP;  % INFORMATION ON PREFIX
         SCKW ,QPREFIX,QS,LIMIT=AL1(54);  % IF QUOTED DATA SET NAME
         SCKW ,UNQPFIX,LIMIT=AL1(44);  % REGULAR DSN
         SCKW ,SCPREERR,CODE=AL1(8);  % TOO LONG PREFIX

UNQPFIX:
% MTRT   TEST FOR ILLEGAL CHARACTERS IN DATA SET NAME
LR XRB,VR0;  % LENGTH
EXI XRB,MMVC,PREFIX,0(VR1),*-*,INCR=YES,DECR=YES;  % SAVE DATA SET NAME)
STH XRB,PREFIXL;  % STORE OFF LENGTH

BEGIN SCAN *;
      SCKW ,PREMEM,PS;  % SEE IF MEMBER EXISTS FOR PDS
      SCKW ,*,B;  % ALL DONE BABY

PREFHELP:
WRTERM _
'PREFIX sets a data set name prefix for SEND and RECEIVE.';
WRTERM _
'The parameter is the prefix.  No prefix is the default.';
WRTERM _
'The prefix may also indicate a PDS.  SET PRE FILE() causes SEND';
WRTERM 'and RECEIVE data set to use the PDS FILE.';
WRTERM 'NOPREFIX cancels prefixing a data set name on send or'_
' receive.';
        EXIT;  % DROP OUT OF BLOCK

PREMEM:
DEBLANK VR1,VR0;
%MTRT TEST FOR VALID DSN AGAIN

IF <RZ VR0> THEN SF PREFPDSF  % HAVE A PDS
ELSE BEGIN
SCPUSH;
SCINIT (VR1),(VR0);
SCAN;
LR XRA,VR0;  % LENGTH FOR EXECUTE
IF <CI VR0,8; CC H> THEN BEGIN  % MEMBER NAME TOO LONG
WRTERM 'Member name excedes 8 characters';
MZC PREFIXL,2;  % ERROR CITY
EXIT;  % SPLIT THE BLOCK
END;  % OF ERROR BLOCK
EXI XRA,MMVC,PREFMEM,0(VR1),*-*,INCR=YES,DECR=YES;
STH XRA,PREFMEML;  % LENGTH OF PREFIX MEMBER
SCDONE;  % ERROR IF MORE JUNK ON LINE
SF PREFPDSF;  % INDICATE WE HAVE A PDS   PREFIX
SCPOP;
END;  % OF ZERO LENGTH ELSE
SCANEND; END;

EXIT;

QPREFIX:
SCPUSH;
SCINIT (VR1),(VR0);
% SAME THING AS FOR UNQUOTED NAME
SF PREFXQUO;  % INDICATE A QUOTED PREFIX
GOTO SCANPREF;  % A BIT KLUDGEY FOR NOW
SCDONE;
SCPOP;
EXIT;
SCANEND;
 % DROPS THRU HERE
WRTERM 'PREFIX requires a parameter for the prefix of data set';
WRTERM 'names.  Enter "SET PREFIX ?" for a more information.';
END;
DATA BEGIN  % NOTHING SPECIFIED
SCPREERR: % ERROR ROUTINE
IF <CI VRE,8> THEN LR VRF,VRE;  % LENGTH ERROR
SELECT FIRST;
<CI VRF,SCTCUBQ>: WRTERM 'Unbalanced Quotes on Prefix';
<CI VRF,SCTCUBP>: WRTERM 'Unbalanced Parentheses on Prefix';
<CI VRF,SCTCIXM>: WRTERM 'Exceeds the limits of possible prefix';
ENDSEL
ELSE WRTERM 'Error in scan of Prefix';
END;  % OF THEN
STPREXIT: CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'SCANNUMS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: SCANNUMS
% FUNCTION: SETS UP NUMBER COMMAND
%
SCANNUMS:
CENTER VRE,HIGHR,ENTRY=NO;
SCERROR NEW=BADNUM;
NUMBLCK: DO BEGIN  % A BLOCK TO FALL OUT OF

SCAN *;
SCKW ,NUMSOME;
SCANEND;

WRTERM 'NUMBER command requires parameter ';
WRTERM 'enter SET NUMBERED HELP for more information ';
EXIT FROM NUMBLCK;

NUMSOME:  % WE HAVE SOMETHING HERE
SCBACK;  % RESET POINTERS
SCPUSH;  % STORE OFF SCANNER POINTERS
CALL EDSET,(EDCNTRL,EDRETURN,FOUR,ONE,TEMP,EDLEN);  % INSERT


MVI EDTYPE,X'FF';  % BLAST NUMBER BIT
SCNUMBLK: DO BEGIN

SCAN *;

SCKW ,DOCOL1,PI;  % LOOK FOR COLUMN NUMBER
SCKW OFF,OFFCOLS;  % NO NUMBERING
SCKW (HELP,?),NUMHELP;  % HELP COMMAND
SCKW (ON,WYLBUR),DOWYL;  % WYLBUR
SCKW TSO,TSONUM;  % TSO NUMBERING
SCKW OVERLAY,NUMOVER;  % OVERLAY NUMBERS OPTION
SCKW INSERT,NUMINSER;  % NUMBERING INSERT
SCKW MERGE,NUMMERGE;  % MERGE NUMBERS
SCKW ,BADNUM;  % UNKNOWN COMMAND

SCANEND;

EXIT FROM NUMBLCK;

BADNUM:
WRTERM 'Illegal Parameter for the SET NUMBERED command ';
MMVC EDTYPE,=F'2',4;  % RESTORE DEFAULT
EXIT FROM NUMBLCK;

NUMHELP:
MVI EDTYPE,0;  % ZERO BYTE

WRTERM 'Controls line numbering in non-edit format text data sets.';
WRTERM 'Valid Options are: ';
WRTERM ' OFF indicates unnumbered ';
WRTERM ' ON or WYLBUR indicates a data set with '_
       'WYLBUR line numbers in default columns';
WRTERM ' WYLBUR m/n indicates '_
'line numbers in columns m through n';
WRTERM ' TSO indicates '_
       'TSO line numbers in default columns';
WRTERM ' TSO m/n indicates TSO '_
       'line numbers in columns m through n';
WRTERM _
 'Default columns for line numbers are the last 8 for data sets';
WRTERM 'with fixed length records, and the firest 8 for data sets';
WRTERM 'with variable length records.';

EXIT FROM NUMBLCK;

DOCOL1:

ST VRF,EDCOL1;  % STORE OFF FIRST COLUMN

SCAN *;  % LOOK FOR ENDING COLUMN POSITION

SCKW ,DOCOL2,PI;  % NEED NEXT COLUMN
SCKW ,COLERR;
SCANEND;

WRTERM 'required second number column omitted ';
EXIT FROM NUMBLCK;

COLERR:
WRTERM 'the second column number must be a non zero integer';
EXIT FROM NUMBLCK;

DOCOL2:
ST VRF,EDCOL2;  % STORE OFF SECOND COLUMN

SELECT FIRST;
<MCLC EDTYPE,=F'2',4>: MVI EDTYPE+3,X'3';
<MCLC EDTYPE,=F'4',4>: MVI EDTYPE+3,X'5';
ENDSEL;


DOWYL: % SET UP WYLBUR NUMBERING
IF <CLI EDTYPE,X'FF'> THEN MMVC EDTYPE,=F'2',4 % WYLBUR DEFAULTS
ELSE MMVC EDTYPE,=F'3',4;  % WE HAVE COLUMN POSTIONS

NEXT OF SCNUMBLK;  % SCAN SOMEMORE


TSONUM: % SET UP TSO NUMBERING
IF <CLI EDTYPE,X'FF'> THEN MMVC EDTYPE,=F'4',4 % TSO DEFAULTS
ELSE MMVC EDTYPE,=F'5',4;  % WE HAVE COLUMN POSTIONS

NEXT OF SCNUMBLK;  % SCAN SOMEMORE
NUMOVER:   % OVERLAY NUMBERING

CALL EDSET,(EDCNTRL,EDRETURN,FOUR,TWO,TEMP,EDLEN);  % OVERLAY
NEXT OF SCNUMBLK;  % SCAN SOMEMORE
NUMINSER:   %INSERT NUMBERING

CALL EDSET,(EDCNTRL,EDRETURN,FOUR,ONE,TEMP,EDLEN);  % INSERT
NEXT OF SCNUMBLK;  % SCAN SOMEMORE

NUMMERGE: % MERGE NUMBERS


CALL EDSET,(EDCNTRL,EDRETURN,FOUR,THREE,TEMP,EDLEN);  % MERGE
NEXT OF SCNUMBLK;  % SCAN SOMEMORE
OFFCOLS: % TURN OFF NUMBERING
MMVC EDTYPE,=F'1',4;  % TURN OFF LINE NUMBERS

EXIT FROM NUMBLCK;

END;  % OF SCAN BLOCK
END;  % OF NUMBLCK
CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'SCANTABS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SCANTABS
% FUNCTION : Scans a parameter string for tab values
%            get memory for table,
% INPUT:     none - scanner already called just scan away
%
%
% OUTPUT :  VRF=0 good entries in table (TABTBLAD) VRF=4 ERROR
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SCANTABS:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
SCANTBLK: DO BEGIN  % MAIN BLOCK TO FALL OUT OF
SCTYPE NEW=0;
SCERROR NEW=BADTABS;
GETMAIN RC,LV=256,SP=18;  % GET POOL FOR BUFFER
IF <CI VRF,4> THEN BEGIN
WRTERM 'Not enough memory for tab routine';

EXIT FROM SCANTBLK;
END;
MZC 0(VR1),256;  % ZERO OUT TAB BUFFER
LR XRA,VR1;  % POINT TO ADDRESS
ST VR1,TEMP;  % STORE ADDRESS OF STORAGE
LI XRB,NUMTABS;  % SET FIELD SIZE
LR XRC,XRA;
ZR XRE;  % INDENT
ZR XRD;  % LENGTH

TTABSCAN: DO BEGIN SCAN *;
   SCKW ,TTABSTAB,(PI),LIMIT=AL1(255);
   SCKW INDENT,TTABSIND,(P,I),LIMIT=AL2(32767);
   SCKW LENGTH,TTABSLEN,(P,PI),LIMIT=AL2(32767);
       SCKW  (TAB,TABS),0;  % CONTINUE SCAN
   SCKW ,BADTABS;

   %  INDENT

   TTABSIND:
   LR XRE,VRF;
   SCRTN;

   %  LENGTH

   TTABSLEN:
   LR XRD,VRF;
   SCRTN;

   %  TAB POSITION

   TTABSTAB:
   CBAL RTNR,TTABPUT;  % STORE TAB POSITION
   BEGIN SCAN *;
      SCKW '+',TTABPLUS,(P,PI),LIMIT=AL1(255);
      SCKW ,*,B;

      TTABPLUS:
      ST VRF,TABWRKA+4;  % SAVE INCREMENT
      BEGIN SCAN *;
         SCKW '/',TTABSLSH,(P,PI),LIMIT=AL1(255);
         SCKW '*',TTABSTAR,(P,PI),LIMIT=AL1(255);
         SCKW ,*;
         SCANEND; END;
      IF <RP VR0> THEN BEGIN
         VSEG KERMVA,(VR1),(VR0);
         VSEG KERMVA,': ';
         END;
      WRTERM '"/" OR "*" REQUIRED WITH "+"';
      LI VRF,4; EXIT FROM SCANTBLK;
      TTABSLSH:
      LR VRE,VRF;  % SAVE LIMIT
      LR VR1,XRC; SI VR1,2; LH VRF,0(VR1);  % LAST TAB JDW
      IF <CR VRF,VRE; CC NL> THEN BEGIN
         WRTERM 'LIMIT LESS THAN STARTING TAB POSITION';
         LI VRF,4; EXIT FROM SCANTBLK;
         END;
      FOREVER DO BEGIN
         A VRF,TABWRKA+4;  % ADD INCREMENT
         NEXT OF TTABSCAN IF <CR VRF,VRE; CC H>;
         CBAL RTNR,TTABPUT;  % STORE TAB
         END;

      TTABSTAR:
      LR VRE,VRF;  % SAVE LIMIT
      LR VR1,XRC; SI VR1,2; LH VRF,0(VR1);  % LAST TAB JDW
      FOR VRE DO BEGIN
         A VRF,TABWRKA+4;  % ADD INCREMENT
         CBAL RTNR,TTABPUT;  % STORE TAB
         END;
      SCANEND; END;
   NEXT OF TTABSCAN;

   TTABPUT:
   IF <CI VRF,255; CC H> THEN BEGIN  % TAB TOO LARGE
      WRTERM 'TAB POSITION GREATER THAN 255';
      LI VRF,4; EXIT FROM SCANTBLK;
      END;
   SI XRB,1;  % DECR COUNT
   IF <RM XRB> THEN BEGIN
      WRTERM 'MORE THAN NUMTABS TABS SPECIFIED';
      LI VRF,4; EXIT FROM SCANTBLK;
      END;
   STH VRF,0(,XRC);  % PUT TAB IN AREA      JDW
   AI XRC,2;  % JDW
   RGOTO RTNR;
   SCANEND; END;

IF ^<MCLC 0(XRA),=H'0',2> THEN BEGIN  % TABS WERE SPECIFIED
   LI VR0,NUMTABS;
   DO BEGIN  % SORT INTO ASCENDING ORDER
      ZR XRB;  % SET SWAP SWITCH OFF
      LR XRC,VR0; SI XRC,1;  % SET LIMIT
      LR XRD,XRA;  % POINT AT TABS
      FOR XRC DO BEGIN
         EXIT IF <MCLC 2(XRD),=H'0',2>;  % NO MORE TABS
         LH VRF,0(,XRD);  % PICK UP TAB
         IF <CH VRF,2(XRD); CC H> THEN BEGIN  % OUT OF ORDER
            LA XRB,2(,XRD); SR XRB,XRA;  % SET SWAP SWITCH
            MMVC 0(XRD),2(XRD),2; STH VRF,2(,XRD);  % SWAP
            END
         ELSE IF <CC E> THEN BEGIN
            WRTERM 'TWO TABS SPECIFIED AT SAME COLUMN';
            LI VRF,4; EXIT FROM SCANTBLK;
            END;
         AI XRD,2;
         END;
      LTR VR0,XRB;  % NEW LIMIT
      NEXT IF <CC P>;
      END;

   %  ADD IN INDENT, CHECK MARGIN

   LR XRB,XRA;
   LI XRC,NUMTABS;
   DO BEGIN
      LH VR0,0(XRB);  % NEXT TAB     JDW
      EXIT IF <RZ VR0>;  % NO MORE
      AR VR0,XRE;  % ADD INDENT
      IF <CI VR0,255; CC H> THEN BEGIN
         WRTERM 'TAB PLUS INDENT GREATER THAN 255';
         LI VRF,4; EXIT FROM SCANTBLK;
         END;
      STH VR0,0(,XRB);
      AI XRB,2;
      END FOR XRC;
   END
ELSE BEGIN  % NO TABS SPECIFIED
WRTERM 'No tabs were specified';
LI VRF,4; EXIT FROM SCANTBLK;
END;
MMVC TABTBLAD,TEMP,4;  % SUCCESSFUL RETURN UPDATE TAB TABLE POINTER

ZR VRF;
END;  % OF SCANTBLK
SCTYPE NEW=1;
DATA BEGIN
BADTABS: LI VRF,4;
END;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;
NUMTABS:    EQU  125;  % ALLOW THIS MANY TABS
SUBTITLE 'KSEND';

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%     MODULE NAME   -   KSEND
%
%
%     FUNCTION-   DRIVER FOR SEND COMMAND DYNAL, OPEN,
%     FORMATS PACKETS, FILE HEADER, EOF ETC
%
%
%     INPUTS -
%
%
%
%
%     OUTPUTS-
%
%
%     RETURN
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KSEND: ;
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LA XRC,SNDPKT;
USE XRC AS PACKET IN BEGIN  % DSECT FOR INIT
LA XRD,DATABUFF;
USE XRD AS SENDIDST IN BEGIN
SENDBLCK: DO BEGIN  % GLOBAL SEND BLOCK
MZC STATLEN,2;  % ZERO OUT STATUS LENGTH
ZF WARNINGF;
SCTYPE NEW=1;  % SCAN ACROSS * IN CASE WILD CARD SEND
MVI STATE,SEND;  % SEND BLOCK STATE
BCCTYPE 1;  % 1 BCC BYTE AT END

SCERROR NEW=SENDERR;  % SCAN OFF DSN

   SCAN *;
   SCKW ?,SENDHELP;  % INFO
   SCKW ,SEND1ST,B,LIMIT=AL1(44);  % DSN
   SCANEND;
%  IF HERE NO DSNAME
WRTERM 'SEND Command requires a dsname ';
   EXIT FROM SENDBLCK;  % LEAVE SEND

SENDHELP:
WRTERM _
'SEND sends a data set (file) to the microcomputer.  A corresponding';
WRTERM 'RECEIVE command must be issued to the microcomputer KERMIT'_
' after the SEND to';
WRTERM 'TSO KERMIT.  The parameter is the data set name '_
   'for the data set to be';
WRTERM 'transmitted.  The data set must be cataloged.';
   EXIT FROM SENDBLCK;  % LEAVE SEND

SENDERR:
SELECT FIRST;
<CI VRF,SCTCLXM>: ERRORCON  'Data Set Name maximum 44 letters ';
<CI VRF,SCTCUBQ>: ERRORCON  'Unbalanced quotes in Data Set Name';
ENDSEL
ELSE <ERRORCON 'Error in data set name'>;
CCALL ERRPACK,A;
IF <TF SERVERF> THEN BEGIN
CCALL SABORT,A,VR0=LH:RPSEQ;
END
ELSE TPUT (VR1),(VR0);
EXIT FROM SENDBLCK;  % ERROR EXIT
SEND1ST:  % THE BEEF
SCTELL;  % HOW MUCH IS LEFT ?
DEBLANK VR1,VR0,XRA,TYPE=BOTH;  % STRIP OFF BLANKS
% STORE OFF POINTERS IN CASE MORE FILES
ST VR1,DSNADD;  % ADDRESS OF DSNAME
STH VR0,DSNLEN;  % LENGTH OF SCANNED NAME

CCALL SCANDSN,A;  % ROUTINE SETS UP DSNAME
CASE VRF MIN 0 MAX 20 CHECK;
0: BEGIN  % A GOOD RETURN;
END;
4: BEGIN  % GOOD RETURN PLUS PDS
% SF PDS;
END;
8: BEGIN  % WILD CARD
END;
12: BEGIN  % NO LENGTH
ERRORCON 'No length on data set name';
CCALL ERRPACK,A;
MVI STATE,SESTATE;
IF ^<TF SERVERF> THEN TPUT (VR1),(VR0)
ELSE BEGIN
CCALL SABORT,A,VR0=LH:RPSEQ;  % ABORT
END;
END;
16: BEGIN  % ILLEGAL NAME
ERRORCON 'Non standard data set name';
CCALL ERRPACK,A;
MVI STATE,SESTATE;
IF ^<TF SERVERF> THEN TPUT (VR1),(VR0)
ELSE BEGIN
CCALL SABORT,A,VR0=LH:RPSEQ;  % ABORT
END;
EXIT FROM SENDBLCK;
END;
20: BEGIN  % NO MATCHING ENTRIES FROM WILD CARD
ERRORCON 'No matches in catalog for wildcard';
CCALL ERRPACK,A;
MVI STATE,SESTATE;
IF ^<TF SERVERF> THEN TPUT (VR1),(VR0)
ELSE BEGIN
CCALL SABORT,A,VR0=LH:RPSEQ;  % ABORT
END;
EXIT FROM SENDBLCK;
END;
ENDCASE ELSE
BEGIN  % ILLEGAL RETURN
ERRORCON 'Illegal data set name.  Extra data on line.';
CCALL ERRPACK,A;
MVI STATE,SESTATE;
IF ^<TF SERVERF> THEN TPUT (VR1),(VR0)
ELSE BEGIN
CCALL SABORT,A,VR0=LH:RPSEQ;  % ABORT
END;
EXIT FROM SENDBLCK;
END;
CCALL OPENSDSN,A;  % Open next sendfile
IF ^<TF SENDDSNF> THEN BEGIN
IF <TF SERVERF> THEN BEGIN

CCALL SABORT,A,VR0=LH:RPSEQ;  % ABORT
END
ELSE <LH VR0,STATLEN; TPUT STATBUFF,(VR0)>;  % OUTPYUT TO SCREEN
EXIT FROM SENDBLCK;
END;  % OF OPEN ERROR

IF <TF TABF> THEN BEGIN
GETMAIN RC,LV=66000,SP=8;  % GET POOL FOR BUFFER
IF <CI VRF,4> THEN BEGIN
WRTERM 'GET MAIN TAB ERROR ON SEND';
END;

MMVC TABCNT,=H'0',2;  % INITIALIZE TAB COUNTER

ST VR1,TABADDR;  % TAB ADDRESS
END;  % OF TABBING

IF ^<TF SERVERF> THEN BEGIN  % TIMER ONLY IF NO SERVER MODE
VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN;
VSEG KERMVA,'  Waiting ';  % build message
L VR1,DELAY;  % SET UP DELAY FOR STIMER
ZR VR0;
DI VR0,100;
LR XRA,VR1;
CVBTD TEMP,0,(XRA);  % CONVERT TO PRINT
VSEG KERMVA,(VR1),(VR0);
VSEG KERMVA,' seconds before sending. ';
VOUT KERMVA;  % OUT PUT MESSAGE

STIMER WAIT,BINTVL=DELAY;  % SET TIMER
END;  % OF NON SERVER TIMER

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% CALL THE SEND SWITCH TABLE DRIVER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

CCALL SENDSW,A;


%L VR1,RPSIZ;  % PACKET SIZE
%SI VR1,2;  % SUBTRACT HEADER
%SH VR1,BCCLEN;  % % SUB OFF BCC LENGH THEN
%STH VR1,MAXPUT;  % MAX DATA SIZE FOR PUT

END;  % OF SENDBLCK
IF <TF TABF> THEN FREEMAIN RC,SP=8;  % FREE THE BUFFER

SCTYPE NEW=1;  % RETURN SCANNER TO NORMAL MODE

USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

END;  % OF DSECT
END;  % OF DSECT SENDINIT
SUBTITLE 'SENDSW';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SENDSW
% FUNCTION :  THIS ROUTINE DRIVES THE SEND MODULES,
%            EACH ROUTINE CHANGES THE STATE
% INPUT:
%
%
% OUTPUT :
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SENDSW:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
%MVI HIGHBCC,3;  % INDICATE BLOCK CHECK TYPE
ZEROSEQ;  % ZERO SEQUENCE NUMBER
ZERORTRY;  % ZERO RETRY
MVI STATE,SISTATE;  % SEND INIT STATE
SSWTBLCK: DO BEGIN  % LOOP TILL EXIT
SELECT FIRST;
<TF STOPF>: <CCALL STOPPROC,A; EXIT FROM SSWTBLCK>;  % USER STOP
<CLI STATE,SISTATE>: CCALL SINIT,A;
<CLI STATE,SFSTATE>: CCALL SFILE,A;  % FILE HEADER PACKET
<CLI STATE,SDSTATE>: CCALL SDATA,A;  % SEND DATA PACKETS
<CLI STATE,SZSTATE>: CCALL SEOF,A;  % SEND EOF
<CLI STATE,SBSTATE>: CCALL SEOT,A;  % END OF TRANSMISSION
<CLI STATE,SESTATE>: BEGIN  % ABORT
CCALL SABORT,A,VR0=LH:SEQNUM; EXIT FROM SSWTBLCK;  % ABORT
END;
<CLI STATE,RESTATE>: <CCALL RABORT,A; EXIT FROM SSWTBLCK>;  % ABORT
<CLI STATE,CSTATE>: EXIT FROM SSWTBLCK;  % COMPLETE STATE SPLIT
ENDSEL;
END FOREVER;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'SINIT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SINIT
% FUNCTION : Sends the SEND INIT  packet  and receives
%            the rinit packet , each sets the options
% INPUT:     none
%
%
% OUTPUT :  state = either 'F' file header   || 'S' TRY AGAIN
%           plus options are set (i.e quotes,repeat, etc)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SINIT:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
ZF ACKX;
ZF ACKZ;
BUMPRTRY XRA;  % Increment retry counter
IF <MCLC NUMTRY,RETRY,4; CC NL> THEN  % Retry exceeded
MVI STATE,SESTATE  % Send abort state
ELSE SINITBLK: DO BEGIN  % Send end of transmisision block
MMVC TRFBCC,HIGHBCC,1;
LI VR0,SENDINIL;
CCALL SPAR,A,VR1=PDATA;  % CALL ROUTINE THAT BUILDS PACK
SPSPACK AS,SEQNUM,PUTLEN,VR0;  % S PACKET,SEND PARAMETERS FOR SPACK
TCLEARQ INPUT;  % CLEAR INPUT BUFFER
CCALL SPACK,A;
CCALL RPACK,A;
EXIT IF <RNZ VRF> | <TF STOPF>;  % Leave if Timeout or Bad BCC
ZR XRA;  % clear for the case
MTRT RTYPE,COMMAND,1;  % Scan command type
DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK;
NCASE: BEGIN  % Got a nack
LH XRA,RPSEQ;  % Load received sequence number
IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1;  % see if nack for pack+1
STH XRA,RPSEQ;  % STORE IN CASE NACK FOR SEQ+1
IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>;  % Ok yack case next
END;  % of nack
YCASE: BEGIN  % ACK
EXIT IF ^<MCLC SEQNUM,RPSEQ,2>;  % Wrong packet number
ZERORTRY;  % % Zero retry counter
BUMPSEQ VR0;  % Increment packet counter
LH VR0,RECLEN;  % Length of data
CCALL RPAR,A,VR1=RDATA;  % %%FIXME
SELECT FIRST;
<CLI TRFBCC,1>: BCCTYPE 1;
<CLI TRFBCC,2>: BCCTYPE 2;
<CLI TRFBCC,3>: BCCTYPE 3;
ENDSEL;
MZC PUTLEN,2;
MVI STATE,SFSTATE;  % SEND FILE HEADER  STATE
END;  % OF ACK
ECASE: BEGIN  % Error abort
MVI STATE,RESTATE;  % RECEIVED ABORT
END;
ENDCASE
ELSE BEGIN
ERRORCON 'Illegal packet type received ';
CCALL ERRPACK,A;  % PUT IN BUFFERS
MVI STATE,SESTATE;  % ABORT
END;
END;  % OK RETRY
END;  % of SINITBLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'SPAR';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SPAR
% FUNCTION : Builds the send  init packet
%
% INPUT:     none
%
%
% OUTPUT :  formatted data area of send init packet
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SPAR:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

L VR1,NOQUADD;  % LOAD ADDRESS OF CHARACTERS NOT QUOTED
XC 0(255,VR1),0(VR1);  % CLEAR BUFFER
LA XRC,SNDPKT;
USE XRC AS PACKET IN BEGIN  % DSECT FOR INIT
%%LOAD XRD FROM VR1 - AS DESECT POINTER
LA XRD,DATABUFF;
USE XRD AS SENDIDST IN BEGIN
SINITLAB:
SENDIBLK: DO BEGIN  % A BLOCK TO FALL OUT OFF

%LI VR1,SENDINIL;  % SEND INIT DSECT LENGTH   %%FIX MAKE VR0
STH VR0,PUTLEN;  % LENGTH FOR PUT

MMVC RCRCREAL,BCCLEN,2;  % STORE OF BCC
BCCTYPE 1;
L VR1,RPSIZ;  % PACKET SIZE
CHAR VR1;  % CHARACTER FUNCTION
STC VR1,MAXL;

L VR1,TIMEOUT;  % NUMBER OF SECONDS FOR KERM TO TIMEOUT
CHAR VR1;  % CHARACTER FUNCTION
STC VR1,TIME;

MVI NPAD,X'20';  % MOVE " " FOR NPAD

MVI PADC,X'40';  % MOVE " " FOR PADC

ZR VR1; IC VR1,REOL;  % EOL CHARACTER
CHAR VR1;  % PRINTABLE FUNCTION
STC VR1,EOLCHAR;

MMVC QCTL,QUOCHAR;  % MOVE QUOTE CHARACTER

MMVC QBIN,BINQC;

SELECT FIRST;
<CLI TRFBCC,1>: MMVC CHKT,ASCIIONE,1;  % BCC LEVEL 1 CHECK
<CLI TRFBCC,2>: MMVC CHKT,ASCII2,1;  % BCC LEVEL 2 CHECK
<CLI TRFBCC,3>: MMVC CHKT,ASCII3,1;  % BCC LEVEL 3 CHECK
ENDSEL;

%%REPT  REPEAT CHARACTER

MMVC REPT,REPTCHAR,1;  % PUT IN REPEAT FUNCTION

%%CAPA BIT MAP OF CAPABILITIES

ZR VR1;
IC VR1,DCAPA1;  % CAPABILITIES BYTE
CHAR VR1;  % ASCII SPACE
STC VR1,CAPA1;  % NO CAPA FUNCTION NOW

END;  % OF DSECT
END;  % OF DSECT
END;  % OF DSECT
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'RPAR';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : RPAR
% FUNCTION : Takes the received init packet and set options
%            to what we accept (e.g. 8th bit , repeat quoting,etc)
% INPUT:     none
%
%
% OUTPUT :  correctly set options
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RPAR:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

LA XRA,RDATA;
USE XRA AS RECINIT IN BEGIN
LI XRB,SENDINIL;  % LENGTH OF OUR SEND INIT
SR XRB,VR0;  % LENGTH OF DATA SENT
IF <RP XRB> THEN BEGIN
SELECT;
<CI XRB,4; CC NL>: MVI RQBIN,AN;  % NO BINARY QUOTING
<CI XRB,2; CC NL>: MMVC RCHKT,ASCIIONE,1;  % LEVEL ONE CHECK
<CI XRB,3; CC NL>: MVI RREPT,C' ';  % NO REPT
<CI XRB,1; CC NL>: MVI RCAPA1,C' ';
ENDSEL;
END;
SELECT FIRST;
<MCLC RCHKT,ASCIIONE,1>: BEGIN
MVI TRFBCC,1;  % 1 BCC BYTE AT END
END;

<MCLC RCHKT,ASCII2,1>: BEGIN
IF <CLI HIGHBCC,2; CC L> THEN BEGIN
MMVC RCHKT,ASCIIONE,1;
NEXT;
END;
MVI TRFBCC,2;  % 2 BCC BYTE AT END
END;
<MCLC RCHKT,ASCII3,1>: BEGIN

IF <CLI HIGHBCC,3; CC L> THEN BEGIN
MMVC RCHKT,ASCII2,1;
NEXT;
END;
MVI TRFBCC,3;  % 3 BCC BYTE AT END
END;
ENDSEL;
ZR VR0; IC VR0,RMAXL;  % LOAD IN LENGTH
UNCHAR VR0;  % CHANGE IT TO AN INTEGER
SI VR0,2;  % SEQ & TYPE BYTES
ZR VR1; IC VR1,TRFBCC;  % GET BCC LENGTH OF PROPOSED TRANSFER
SR VR0,VR1;
STH VR0,MAXPUT;  % STORE IT OFF
IF <CLI STATE,RISTATE> THEN LA VR1,RECTABLE
ELSE LA VR1,SENDTBL;  % POINTER TO TRANSLATE TABLE
IF <MCLC RREPT,REPTCHAR> THEN BEGIN  % WE HAVE REPT PREFIXING
SF REPTF;  % TURN ON INDICATOR
ZR VR0; IC VR0,REPTCHAR;  % LOAD LITERAL FOR CASE STATEMENT
AR VR1,VR0;  % POINT TO PLACE IN TABLE
 % LI VR0,ASCIIQUO;  % LOAD HASH  % REMOVE ME IF IT WORKS
IF <CLI STATE,RISTATE> THEN LI VR0,CASEREPT  % REPEAT QUOTING
ELSE BEGIN
LI VR0,NOQUOQUO;  % LOAD HASH   DON'T QUOTE REPT CHAR
STC VR0,0(VR1);  % QUOTE FOR HASH IN TABLE
AI VR1,X'80';  % POINT TO HIGH ORDER COMPLEMENT
LI VR0,NOQUOQU8;
END;
STC VR0,0(VR1);
END
ELSE BEGIN
ZF REPTF;  % NO REPEAT COUNTING POSSIBLE
ZR VR0; IC VR0,REPTCHAR;  % LOAD LITERAL FOR CASE STATEMENT
AR VR1,VR0;  % POINT TO PLACE IN TABLE
MVI 0(VR1),0;  % QUOTE FOR HASH IN TABLE
AI VR1,X'80';  % POINT TO HIGH ORDER
MVI 0(VR1),ASCI8BIT;
END;  % OF NO REPT CHARACTER
IF <CLI STATE,RISTATE> THEN LA VR1,RECTABLE
ELSE LA VR1,SENDTBL;  % POINTER TO TRANSLATE TABLE
IF <MCLC RQCTL,QUOCHAR,1> THEN BEGIN  % QUOTE CHARACTER PREFIXING

ZR VR0; IC VR0,QUOCHAR;  % LOAD LITERAL FOR CASE STATEMENT
AR VR1,VR0;  % POINT TO PLACE IN TABLE
 % LI VR0,ASCIIQUO;  % LOAD HASH  % REMOVE ME IF IT WORKS
LI VR0,NOQUOQUO;  % LOAD HASH   DON'T QUOTE REPT CHAR
IF <CLI STATE,RISTATE> THEN LI VR0,CASEQUO
ELSE BEGIN
STC VR0,0(VR1);  % QUOTE FOR HASH IN TABLE
AI VR1,X'80';  % POINT TO HIGH ORDER COMPLEMENT
LI VR0,NOQUOQU8;
END;
STC VR0,0(VR1);
END
ELSE BEGIN

ZR VR0; IC VR0,QUOCHAR;  % LOAD LITERAL FOR CASE STATEMENT
AR VR1,VR0;  % POINT TO PLACE IN TABLE
MVI 0(VR1),0;  % QUOTE FOR HASH IN TABLE

AI VR1,X'80';  % POINT TO HIGH ORDER
MVI 0(VR1),ASCI8BIT;
%%% RESTORE HIGH ORDER QUOTE
END;  % OF QUOTE CHARACTER
IF <CLI STATE,RISTATE> THEN LA VR1,RECTABLE
ELSE LA VR1,SENDTBL;  % POINTER TO TRANSLATE TABLE
IF <CLI RQBIN,AY> | %ASCII Y
<MCLC RQBIN,BINQC,1> THEN BEGIN  % WE HAVE 8BIT PREFIXING

ZR VR0; IC VR0,BINQC;  % LOAD LITERAL FOR CASE STATEMENT
AR VR1,VR0;  % POINT TO PLACE IN TABLE
 % LI VR0,ASCIIQUO;  % LOAD HASH  % REMOVE ME IF IT WORKS
IF <CLI STATE,RISTATE> THEN LI VR0,CASE8BIT
ELSE BEGIN
LI VR0,NOQUOQUO;  % LOAD HASH   DON'T QUOTE REPT CHAR
STC VR0,0(VR1);  % QUOTE FOR HASH IN TABLE
AI VR1,X'80';  % POINT TO HIGH ORDER COMPLEMENT
LI VR0,NOQUOQU8;
END;
STC VR0,0(VR1);
END
ELSE BEGIN

IF <MCLC DATA,=C'BINARY',6> THEN BEGIN
ERRORCON 'Your PC Kermit does not support 8 bit quote'_
         ' binary transfer impossible';
CCALL ERRPACK,A;
MVI STATE,SESTATE;  % ABORT STATE
END;
ZR VR0; IC VR0,BINQC;  % LOAD LITERAL FOR CASE STATEMENT
AR VR1,VR0;  % POINT TO PLACE IN TABLE
MVI 0(VR1),0;  % QUOTE FOR HASH IN TABLE
AI VR1,X'80';  % POINT TO HIGH ORDER
MVI 0(VR1),ASCI8BIT;
END;  % OF NO REPT CHARACTER
END;  % OF DSECT

ZR VRF;  % SET RETURN CODE
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'SFILE';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SFILE
% FUNCTION : Sends the File Header packet
%            changes states on ack or nack
% INPUT:     none
%
%
% OUTPUT :  state = either 'D' send data || 'F' same || 'E' error
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SFILE:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
BUMPRTRY XRA;  % Increment retry counter
IF <MCLC NUMTRY,RETRY,4; CC NL> THEN  % Retry exceeded
MVI STATE,SESTATE  % Send abort state
ELSE FDSNBLCK: DO BEGIN  % Send end of file block
CCALL KFILENAM,A,VR1=DSNAME,VR0=LH:DSNLEN,VRF=DSNAMEX;  % LEGAL DSN
LH VR0,PUTLEN;
MZC PUTLEN,2;
LA VR1,PDATA; ST VR1,PUTADD; MZC PUTLEN;  % INIT FOR NEXT ROUTINE
CCALL SENDDATA,A,VR1=DSNAMEX;
SPSPACK AF,SEQNUM,PUTLEN,VR0;  % FILE PACKET  SPACK

CCALL SPACK,A;
CCALL RPACK,A;
EXIT IF <RNZ VRF> | <TF STOPF>;  % Leave if Timeout or Bad BCC
ZR XRA;  % clear for the case
MTRT RTYPE,COMMAND,1;  % Scan command type
DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK;
NCASE: BEGIN  % Got a nack
LH XRA,RPSEQ;  % Load received sequence number
IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1;  % see if nack for pack+1
STH XRA,RPSEQ;  % STORE IN CASE NACK FOR SEQ+1
IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>;  % Ok yack case next
END;  % of nack
YCASE: BEGIN  % ACK
EXIT IF ^<MCLC SEQNUM,RPSEQ,2>;  % Wrong packet number
ZERORTRY;  % % Zero retry counter
BUMPSEQ VR0;  % Increment packet counter
MZC PUTLEN,2;  % ZERO OUT PUT LENGTH
LA XRA,PDATA;
ST XRA,PUTADD;  % RESTORE PUT POINTER
MZC OTHERLEN,2;  % ZERO EOR
MZC EDLENACT,4;  % ZERO LENGTH OF RECEIVED DATA
CCALL FILLDPCK,A;
IF <RZ VRF> THEN BEGIN
IF <CLI STATE,SFSTATE> THEN MVI STATE,SDSTATE;  % ELSE OTHER STATE

END
ELSE MVI STATE,SZSTATE;  % SEND DATA STATE
END;  % OF ACK
ECASE: BEGIN  % Error abort
MVI STATE,RESTATE;  % RECEIVED ABORT
END;
ENDCASE
ELSE BEGIN
ERRORCON 'Illegal packet type received ';
CCALL ERRPACK,A;  % PUT IN BUFFERS
MVI STATE,SESTATE;  % ABORT
END;
END;  % OK RETRY
END;  % of FDSNBLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'KFILENAM';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : KFILENAM
% FUNCTION : Formats data set name for the kermit standard
%            for the F packet on a send (download)
% INPUT:     none
%
%
% OUTPUT :  updata packet pointer and length
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KFILENAM:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LR XRC,VRF;  % PLACE TO STORE FILENAME
LH VRF,DSNLEN;  % LENGTH OF DSNAME
LA VR0,DOT;  % LOOK FOR 1ST DOT IN DATA SET NAME
LA VR1,DSNAME;
LH XRA,DSNLEN;  % LENGTH
AR VR1,VRF;  % POINT TO LAST
LCR VRF,VRF;  % COUNT BACKWARDS FOR THE FIRST DOT
LI XRB,2;
FOR XRB DO BEGIN  % LOOP UNTIL LAST DOT

CCALL FINDCHAR,A;
%% IF ZERO EXIT
IF <RP VRF> THEN BEGIN
SR XRA,VRF;  % MINUS BEGINNING NAME
SR VR1,VRF;  % POINT 1 AFTER DOT
LR VRF,XRA;  % RESTORE LENGTH FOR NEXT LOOK
LCR VRF,VRF;  % INDICATE COUNT BACKWARDS
END;  % OF ANOTHER DOT
END;  % NO MORE DOTS
AI XRA,2;  % LENGTH PLUS DOT
LH XRB,DSNLEN;  % LENGTH
LA VR1,DSNAME;
AR VR1,XRA;  % PONIT AFTER DOT
SR XRB,XRA;  % GET LENGTH
L XRA,ETOAVCON;
IF <CI XRB,12; CC H> THEN LI XRB,12;  % MAXIMUM LENGTH OF DSNAME
EXI XRB,MMVC,0(XRC),0(VR1),0,INCR=YES,DECR=YES;
EXI XRB,MTR,0(XRC),0(XRA),*-*,DECR=YES,INCR=YES;  % TRANSLATE ETOA
STH XRB,PUTLEN;  % LENGTH OF DATA

USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'SDATA';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SDATA
% FUNCTION : Sends data  packet   calls filldpck build packets
%
% INPUT:     none
%
%
% OUTPUT :  state = either 'D' more data   || 'Z' EOF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SDATA:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
BUMPRTRY XRA;  % Increment retry counter
IF <MCLC NUMTRY,RETRY,4; CC NL> THEN  % Retry exceeded
MVI STATE,SESTATE  % Send abort state
ELSE DO BEGIN  % Send data block
SPSPACK AD,SEQNUM,PUTLEN,VR0;  % D PACKET,SEND PARAMETERS FOR SPACK
CCALL SPACK,A;
CCALL RPACK,A;
EXIT IF <RNZ VRF> | <TF STOPF>;  % Leave if Timeout or Bad BCC
ZR XRA;  % clear for the case
MTRT RTYPE,COMMAND,1;  % Scan command type
DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK;
NCASE: BEGIN  % Got a nack
LH XRA,RPSEQ;  % Load received sequence number
IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1;  % see if nack for pack+1
STH XRA,RPSEQ;  % STORE IN CASE NACK FOR SEQ+1
IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>;  % Ok yack case next
END;  % of nack
YCASE: BEGIN  % ACK
EXIT IF ^<MCLC SEQNUM,RPSEQ,2>;  % Wrong packet number
ZERORTRY;  % % Zero retry counter
BUMPSEQ VR0;  % Increment packet counter
MZC PUTLEN,2;  % ZERO OUT PUT LENGTH
LA XRA,PDATA;
ST XRA,PUTADD;  % RESTORE PUT POINTER
IF <MCLC RECLEN,=H'1',2> THEN BEGIN
IF <CLI RDATA,AX> | <CLI RDATA,AZ> THEN BEGIN
IF <CLI RDATA,AX> THEN SF ACKX;
IF <CLI RDATA,AZ> THEN SF ACKZ;
MVI STATE,SZSTATE;
EXIT;
END;
END;
CCALL FILLDPCK,A;
IF <RZ VRF> THEN MVI STATE,SDSTATE  % More data
ELSE MVI STATE,SZSTATE;  % End of file
END;  % OF ACK
ECASE: BEGIN  % Error abort
MVI STATE,RESTATE;  % RECEIVED ABORT
END;
ENDCASE
ELSE BEGIN
ERRORCON 'Illegal packet type received ';
CCALL ERRPACK,A;  % PUT IN BUFFERS
MVI STATE,SESTATE;  % ABORT
END;
END;  % OK RETRY
END;  % of SDATABLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'FILLDPCK';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : FILLDPCK
% FUNCTION :   FILLS A SEND PACKET WITH DATA FROM KERIN
%              CALLS KGETREC & PUT BUFF WHEN NEEDED SEND FUNCTIONS
% INPUT:       NONE
%
%
% OUTPUT :     VRF=0 SUCCESSFUL, VRF=KERIN EOF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
FILLDPCK:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
ZR VRF;
FDPBLCK: FOREVER  DO BEGIN  % LOOP UNTIL PACKET FULL OR EOF

IF ^<MCLC OTHERLEN,ZERO,2> THEN BEGIN  % WE HAVE TO PUT CRLF
CCALL PUTBUFF,A,VR1=LFCR,VR0=LFCRLEN;  % PUT IT IN
MZC OTHERLEN,2;  % ZERO OUT
END;  % OF OTHER LENGTH
IF <MCLC EDLENACT,ZERO,4>  THEN BEGIN
IF <TF KINEOF> THEN BEGIN  % EOF ALREADY OCCURED
IF ^<MCLC PUTLEN,ZERO,2> THEN ZR VRF  % EOF BUT STUFF TO PUT
ELSE LI VRF,KERINEOF;
EXIT FROM FDPBLCK;
END;
CCALL GETAREC,A;  % READS A RECORD

IF <RNZ VRF> THEN BEGIN  % EOF OR ERROR
IF <CI VRF,KERINEOF> THEN BEGIN  % ALL DONE
SF KINEOF;  % INDICATE EOF
IF ^<MCLC PUTLEN,ZERO,2> THEN ZR VRF;  % EOF BUT STUFF STILL TO PUT
END  % OF EOF RETURN
ELSE MVI STATE,SESTATE;  % OTHER ERROR ABORT
EXIT FROM FDPBLCK;
END;
END;  % READ A RECORD

IF <TF TABF> THEN BEGIN  % IF TABBING PUT IN
CCALL PUTTABS,A;  % IF TABBING PUT IN
END;  % OF TABBING
% EOF FOR TEXT FILES
L VR0,EDLENACT;  % LENGTH
L VR1,EDPNTR;  % POINT TO PLACE IN RECORD TO PUT
ZR VRF;
IF ^<MCLC EDLENACT,ZERO,4> THEN CCALL SENDDATA,A;
IF <RZ VRF> THEN BEGIN
MZC EDLENACT,4;  % ZERO OUT COUNTER
IF <MCLC DATA,=C'TEXT',4> THEN BEGIN  % PUT EOF
EXIT FROM FDPBLCK IF <TF KINEOF>;  % CRLF ALREADY IN BUFFER
IF <MCLC OTHERLEN,ZERO,2> THEN BEGIN  % WE NEED EOF
MMVC OTHERLEN,=H'2',2;
CCALL CHECKLEN,A,VR0=4;  % SEE IF BUFFFER BIG ENOUGH
IF <RNZ VRF> THEN <ZR VRF; EXIT FROM FDPBLCK>;
END ELSE MZC OTHERLEN,2;  % JUST DID CRLF
END;  % OF TEXT
END  % OF ALL DATA PUT
ELSE BEGIN  % UPDATE POINTERS
L XRA,EDPNTR;  % POINTER TO DATA
L XRB,EDLENACT;  % LENGTH OF DATA
AR XRA,XRB;  % POINT TO LAST CHARACTER PLUS ONE
SR XRA,VRF;  % POINT TO REMAINING CHARACTERS
ST XRA,EDPNTR;
ST VRF,EDLENACT;  % UPDATA LENGTH AND POINTERS
ZR VRF;  % INDICATE OK
EXIT FROM FDPBLCK;
END;
END;  % OF FDPBLCK

IF ^<CI VRF,KERINEOF> THEN ZR VRF;  % NON EOF
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
CEXIT VRE,HIGHR;
LTORG;
EXORG;
KERINEOF:  EQU 4;

SUBTITLE 'GETAREC';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : GETAREC
% FUNCTION :   READS A RECORD FROM DATA SET KERIN FOR
%              DOWNLOADING USING EDIT ROUTINE
% INPUT:       NONE
%
% OUTPUT:   VRF=0 GOOD RECORD VRF=KERINEOF - END OF FILE
%           VRF=READERR  - SOME OTHER FATAL ERROR
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
GETAREC:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

CALL EDGETL,(EDCNTRL,EDRETURN,EDLINENO,EDPNTR,EDLENACT);

IF ^<MCLC EDRETURN,ZERO,4> THEN BEGIN  % FILE READ FAIL
IF <MCLC EDRETURN,ONE> THEN LI VRF,KERINEOF  % END OF FILE
ELSE BEGIN  % FILE READ ERRORS
CALL EDMSG,(EDCNTRL,EDRETURN,EDLINE,EDLMAX2,EDLENACT);
L VR0,EDLENACT;
IF <CI VR0,90; CC H> THEN LI VR0,90;  % SET UP LENGTH
CCALL ERRPACK,A,VR1=EDLINE;
LI VRF,KERINERR;  % ERROR
MVI STATE,SESTATE;  % ABORT IT
END;
END  % OF ERROR IN READING
ELSE BEGIN  % OK READ - TRANSLATE TO ASCII FOR KERIN STANDARDS
L VR0,EDLENACT;  % LENGTH OF DATA
LR XRB,VR0;  % FOR EXECUTE

IF <RP XRB> THEN BEGIN
L XRE,EDPNTR;  % SET UP POINTER TO GET BUF
IF <MCLC DATA,=C'TEXT',4> THEN BEGIN
LR XRA,XRB;
L XRC,ETOAVCON;
DO BEGIN  % LOOP UNTIL NO MORE
IF <CI XRA,255; CC H> THEN <LI XRB,255; SI XRA,255>
ELSE <LR XRB,XRA; ZR XRA>;
CCALL CHKETOA,A,VR1=(XRE),VR0=(XRB);  % SEE IF UNTRANSLATABLE CHARS
EXI XRB,TR,0(*-*,XRE),0(XRC),DECR=YES,INCR=YES;
AI XRE,255;
END UNTIL <RZ XRA>;  % LOOP ALONG

END;  % TEXT
END;  % A POSITIVE AMOUNT OF DATA
ZR VRF;  % INDICATE A GOOD READ
END;  % OF GOOD READ
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
CEXIT VRE,HIGHR;
LTORG;


KERINERR:     EQU  8;  % READ ERROR
SUBTITLE 'SEOF';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SEOF
% FUNCTION : Sends the end-of-file packet
%            changes states on ack or nack
% INPUT:     none
%
%
% OUTPUT :  state = either 'z' eof || 'f' new file || 'B' EOT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SEOF:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
BUMPRTRY XRA;  % Increment retry counter
IF <MCLC NUMTRY,RETRY,4; CC NL> THEN  % Retry exceeded
MVI STATE,SESTATE  % Send abort state
ELSE SEOFBLCK: DO BEGIN  % Send end of file block
SPSPACK AZ,SEQNUM,ZERO,VR0;  % Z PACKET,SEND PARAMETERS FOR SPACK
SELECT FIRST;
<TF ACKX>: <LA XRA,PDATA; MVI 0(XRA),AD; MMVC PUTLEN,=H'1',2; ZF ACKX>;
<TF ACKZ>: <LA XRA,PDATA; MVI 0(XRA),AD; MMVC PUTLEN,=H'1',2>;
ENDSEL;

CCALL SPACK,A;
CCALL RPACK,A;
EXIT IF <RNZ VRF> | <TF STOPF>;  % Leave if Timeout or Bad BCC
ZR XRA;  % clear for the case
MTRT RTYPE,COMMAND,1;  % Scan command type
DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK;
NCASE: BEGIN  % Got a nack
LH XRA,RPSEQ;  % Load received sequence number
IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1;  % see if nack for pack+1
STH XRA,RPSEQ;  % STORE IN CASE NACK FOR SEQ+1
IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>;  % Ok yack case next
END;  % of nack
YCASE: BEGIN  % ACK
EXIT IF ^<MCLC SEQNUM,RPSEQ,2>;  % Wrong packet number
ZERORTRY;  % % Zero retry counter
BUMPSEQ VR0;  % Increment packet counter
CCALL CLOSESDS,A;  % Close input file
IF <TF ASTERISK> & ^<TF ACKZ> THEN BEGIN  % Wild card or multiple send
CCALL NEXTFILE,A;
IF ^<CI VRF,ENDCAT> THEN BEGIN
CCALL OPENSDSN,A;  % Open next sendfile
IF ^<TF SENDDSNF> THEN BEGIN
ERRORCON 'Can not next file for down load';
CCALL ERRPACK,A;
END  % OF OPEN ERROR
ELSE <MVI STATE,SFSTATE; EXIT>;  % SUCCESSFUL FILE OPEN
END;
END;  % of wildcard
MVI STATE,SBSTATE;
END;  % OF ACK
ECASE: BEGIN  % Error abort
MVI STATE,RESTATE;  % RECEIVED ABORT
END;
ENDCASE
ELSE BEGIN
ERRORCON 'Illegal packet type received ';
CCALL ERRPACK,A;  % PUT IN BUFFERS
MVI STATE,SESTATE;  % ABORT
END;
END;  % OK RETRY
END;  % of SEOFBLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'SEOT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SEOT
% FUNCTION : Sends the end-of-transmission packet
%            changes states on ack or nack
% INPUT:     none
%
%
% OUTPUT :  state = either 'C' complete  || 'B' EOT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SEOT:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
BUMPRTRY XRA;  % Increment retry counter
IF <MCLC NUMTRY,RETRY,4; CC NL> THEN  % Retry exceeded
MVI STATE,SESTATE  % Send abort state
ELSE SEOTBLCK: DO BEGIN  % Send end of transmisision block
SPSPACK AB,SEQNUM,ZERO,VR0;  % B PACKET,SEND PARAMETERS FOR SPACK
SELECT FIRST;
<TF WARNINGF>: <L XRA,RECPNTR; MVI 0(XRA),AX; MMVC PUTLEN,=H'1',2>;
ENDSEL;

CCALL SPACK,A;
CCALL RPACK,A;
EXIT IF <RNZ VRF> | <TF STOPF>;  % Leave if Timeout or Bad BCC
ZR XRA;  % clear for the case
MTRT RTYPE,COMMAND,1;  % Scan command type
DO BEGIN CASE XRA MAX ECASE MIN NCASE CHECK;
NCASE: BEGIN  % Got a nack
LH XRA,RPSEQ;  % Load received sequence number
IF <RZ XRA> THEN LI XRA,63 ELSE SI XRA,1;  % see if nack for pack+1
STH XRA,RPSEQ;  % STORE IN CASE NACK FOR SEQ+1
IF <CH XRA,SEQNUM> THEN <LI XRA,YCASE; NEXT>;  % Ok yack case next
END;  % of nack
YCASE: BEGIN  % ACK
EXIT IF ^<MCLC SEQNUM,RPSEQ,2>;  % Wrong packet number
ZERORTRY;  % % Zero retry counter
BUMPSEQ VR0;  % Increment packet counter
MVI STATE,CSTATE;  % COMLETE STATE
END;  % OF ACK
ECASE: BEGIN  % Error abort
MVI STATE,RESTATE;  % RECEIVED ABORT
END;
ENDCASE
ELSE BEGIN
ERRORCON 'Illegal packet type received ';
CCALL ERRPACK,A;  % PUT IN BUFFERS
MVI STATE,SESTATE;  % SEND ABORT    STATE
END;
END;  % OK RETRY
END;  % of SEOTBLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

ASCIIREG:   EQU    0;  % EQUATES FOR TABLE
ASCIIQUO:   EQU    4;  % QUOTE CHARACTER
ASCIQUO8:   EQU    8;  % " + BIT 8 ON
ASCI8BIT:   EQU    12;  % BIT 8 ON
REPTQUO:  EQU 16;  % REPTCHARACTER
NOQUOQUO:  EQU   20;
NOQUOQU8:  EQU   24;

% ASCII OFFSETS INTO TABLE
YOFF:     EQU    X'59';
NOFF:     EQU    X'4E';
FOFF:     EQU    X'46';
DOFF:     EQU    X'44';
ZOFF:     EQU    X'5A';
COFF:     EQU    X'43';
BOFF:     EQU    X'42';
EOFF:     EQU    X'45';
AOFF:     EQU    X'41';
R2OFF:     EQU     X'52';  % ASCII I SERVER GET COMM
IOFF:     EQU     X'49';  % ASCII I SERVER GET COMM
GOFF:     EQU     X'47';  %ASCII G;
ROFF:     EQU     SCOMLIT;
% ASCII COMMAND LITERALS
YCOMLIT:     EQU    X'59';
NCOMLIT:     EQU    X'4E';
FCOMLIT:     EQU    X'46';
DCOMLIT:     EQU    X'44';
ZCOMLIT:     EQU    X'5A';
CCOMLIT:     EQU    X'43';
BCOMLIT:     EQU    X'42';
ECOMLIT:     EQU    X'45';
ACOMLIT:     EQU    X'45';
%ACOMLIT:     EQU    X'41';
SCOMLIT:     EQU    X'53';
 %   EQUATES FOR A CASE STATEMENT INDEAL1 FOR PACKET TYPE
YCASE:  EQU  8;  % ACK     T  PACKET
NCASE:  EQU  4;  % NACK  PACKET
ECASE:  EQU  12;  % ERROR PACKET
FCASE:  EQU  32;  % FILE INIT  PACKET
DCASE:  EQU  16;  % DATA PACKET
ZCASE:  EQU  20;  % EOF PACKET
CCASE:  EQU  24;  % COMPLETEPACKET
BCASE:  EQU  28;  % EOT PACKET
ACASE:  EQU  36;  % ABORT PACKET
SCASE:  EQU  40;  % SENDINIT PACKET
R2CASE:  EQU  44;  % SERVER GET  PACKET
GCASE:  EQU  48;  % SERVER GENERIC COMMMAND PACKET
ICASE:  EQU  52;  % SERVER I PACKET

%  VARIOUS KERMIT SEND STATES

SFSTATE:  EQU  12;  % SEND  FILE INIT  PACKET
SDSTATE:  EQU  16;  % SEND  % DATA PACKET
SZSTATE:  EQU  20;  % SEND   EOF PACKET
CSTATE:  EQU  24;  % COMPLETEPACKET
SBSTATE:  EQU  28;  % SEND EOT PACKET
ASTATE:  EQU  36;  % ABORT PACKET
SESTATE:  EQU  36;  % SEND ABORT PACKET
RESTATE:  EQU  44;  % RECEIVED ABORT PACKET
SISTATE:  EQU  40;  % SENDINIT PACKET

%  VARIOUS KERMIT RECEIVE STATES

RFSTATE:  EQU  12;  % RECEIVE  FILE HEADER  PACKET
RDSTATE:  EQU  16;  % RECEIVE  % DATA PACKET
RZSTATE:  EQU  20;  % RECEIVE   EOF PACKET
RBSTATE:  EQU  28;  % RECEIVE EOT PACKET
RISTATE:  EQU  56;  % RECEIVE INIT PACKET
RSTATE:  EQU  40;  % RECEIVE PACKET
R2STATE:  EQU 44;  % GET PACKET FOR SERVER MODE
GSTATE:   EQU 48;  % GENERIC SERVER COMMANDS
ISTATE:  EQU 52;  % I PACKET

SEND:    EQU    60;  % IN SEND COMMAND MODE
RECEIVE: EQU    64;  % IN RECEIVE COMMAND MODE
SUBTITLE 'SENDDATA';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  MOD NAME : SENDDATA
%  FUNCTION: BREAK RECORDS INTO PACKET - CALLED BY KSEND
%  INPUT : VR1-> DATA STRING
%           VR0=LENGTH OF STRING TO SEND IN PACKETS
%  OUTPUT: A PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SENDDATA:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LR  XRB,VR0;  % LENGTH OF DATA
LR XRE,VR1;  % POINTER TO BEGINNING OF THE STRING
SDATABLK: UNTIL <RNP XRB> DO BEGIN
IF <TF REPTF> THEN BEGIN
LR VR1,XRE;
ZR XRA;  % FOR TRT TEST
CCALL CNTXCHAR,A,VR0=(VR1),VRF=(XRB);  % CHECK FOR MATCHES
MTRT 0(VR1),REPTABLE,1;
IF <CR XRA,VRF; CC L> THEN BEGIN  % IF ENUFF WORTH QUOTING BEGIN
IF <CI VRF,94; CC H> THEN LI VRF,94;  % NINE FOUR HIGHEST KERMIT NUMBER
ZR XRA;
MTRT 0(VR1),SENDTBL,1;  % WHAT TYPE OF CHARACTER
CASE XRA MAX 24 MIN 0 CHECK;  % CHECK IF BUFFER LARGE ENOUGH
0: LI VR0,3;
4,20,ASCI8BIT: LI VR0,4;
ASCIQUO8,24: LI VR0,5;
ENDCASE;
LR XRC,VRF;  % SAVE LENGTH OF MATCHES IN CASE NEEDED
CCALL CHECKLEN,A;
EXIT FROM SDATABLK IF <RNZ VRF>;  % NO MORE ROOM IN PACKET
LR VRF,XRC;  % RESTORE LENGTH OF CHARACTERS TO QUOTE
MMVC 0(VR1),REPTCHAR,1;
CHAR VRF;  % MAKE IT A KERMIT INTEGER
STC VRF,1(VR1);  % PUT IN THE COUNT
UNCHAR VRF;
CCALL PUTBUFF,A,VR0=2;  % PUT THE TWO IN
SI VRF,1;  % DECREMENT COUNT  % BIT KLUDGE
SR XRB,VRF;
AR XRE,VRF;  % MOVE POINTER;
END;
END;  % OF REPEAT
ZR XRA;
MTRT 0(XRE),SENDTBL,1;  % SCAN FOR CERTAIN CHARACTER
CASE XRA MAX 24 MIN 0 CHECK;
0: BEGIN  % MOVE EM ALL
CCALL CHECKLEN,A,VR0=1;  % SET ANY ROOM LEFT
EXIT FROM SDATABLK IF <RNZ VRF>;  % NO MORE ROOM IN PACKET
END;  % OF ALL MOVE
ASCIIQUO: BEGIN

LI VR0,2;
CCALL CHECKLEN,A;
EXIT FROM SDATABLK IF <RNZ VRF>;  % NO MORE ROOM IN PACKET
LI VR0,1;  % ONE CHARACTER PUT
CCALL PUTBUFF,A,VR1=QUOCHAR;  % PUT IN THE CONTROL QUOTE CHARACTER
CNTLLOC 0(XRE);  % MACRO FOR CONTROL CHARACTERS
          END;
ASCIQUO8: BEGIN

LI VR0,3;  % THREE CHARACTERS NON SPLIT
CCALL CHECKLEN,A;
EXIT FROM SDATABLK IF <RNZ VRF>;  % NO MORE ROOM IN PACKET
LI VR0,1;  % ONE CHARACTER PUT
CCALL PUTBUFF,A,VR1=BINQC;  % PUT IN THE BINARY QUOTE CHARACTER
CCALL PUTBUFF,A,VR1=QUOCHAR;  % PUT IN THE CONTROL QUOTE CHARACTER
CNTLLOC 0(XRE);  % MACRO FOR CONTROL CHARACTERS
ZAP8BIT 0(XRE);  % MACRO FOR ZERO HIGH ORDER

          END;  % 2 QUOTE BITS
ASCI8BIT: BEGIN  % HIGH ORDER BIT ON

LI VR0,2;
CCALL CHECKLEN,A;
EXIT FROM SDATABLK IF <RNZ VRF>;  % NO MORE ROOM IN PACKET
LI VR0,1;  % ONE CHARACTER PUT
CCALL PUTBUFF,A,VR1=BINQC;  % PUT IN THE BINARY QUOTE CHARACTER
ZAP8BIT 0(XRE);  % KILL HIGH ORDER BIT

          END;

REPTQUO: BEGIN
WRTERM 'REPT CASE DONT BELONG LUCY';
ZR XRA;  % FOR CASE
        % REGISTER 1 POINTS TO REPT CHAR
LA XRD,2(,VR1);  % POINT TO CHARACTER

MTRT 0(XRD),SENDTBL,1;  % TEST ONE CHARACTER
CASE XRA MAX 24 MIN 0 CHECK;

0: BEGIN  % NO OTHER QUOTING NECESSARY
LI VR0,3;
END;  % OF NO OTHER QUOTE NECESSARY

      4,16 :  BEGIN  % NEED ONE
LI VR0,4;
CNTLLOC 0(XRD);  % MACRO FOR CONTROL CHARACTERS
END;  % END OF QUOTE CASE


8: BEGIN  % NEED ONE   ASCII + HIGH ORDER BIT ON
LI VR0,5;

CNTLLOC 0(XRD);  % MACRO FOR CONTROL CHARACTERS
ZAP8BIT 0(XRD);  % MACRO FOR ZERO HIGH ORDER
END;  % END OF  HIGH BIT&  QUOTE CASE

     12 : BEGIN  % NEED ONE
LI VR0,4;

ZAP8BIT 0(XRD);  % MACRO FOR ZERO HIGH ORDER
END;  % END OF QUOTE CASE
20: BEGIN  % A QUOTE CHARACTER THAT NOTHING SHOULD BE DONE TO
LI VR0,4;
LI XRA,ASCIIQUO;  % SINGLE QUOTE IT
END;
24: BEGIN  % SAME AS ABOVE BUT IT'S HIGH ORDER COUNTER PART
LI VR0,5;
ZAP8BIT 0(XRD);  % ZAP HIGH ORDER
LI XRA,ASCIQUO8;  % FAKE OUT NEXT SECTION
END;

ENDCASE;

CCALL CHECKLEN,A;  % MUST ALL BE ONE UNIT
EXIT FROM SDATABLK IF <RNZ VRF>;  % NO MORE ROOM IN PACKET
LR VR1,XRD;
SI VR1,2;  % BACK UP
LI VR0,2;  % PUT IN REPEAT AND COUNT
CCALL PUTBUFF,A;  % DO IT

LI VR0,1;
CASE XRA MAX REPTQUO MIN 0 CHECK;
0: ;  % DO NOTHING FALL OUT
ASCIIQUO: BEGIN
CCALL PUTBUFF,A,VR1=QUOCHAR;
END;
ASCIQUO8: BEGIN
CCALL PUTBUFF,A,VR1=BINQC;  % THE BINARY QUOTE CHARACTER
CCALL PUTBUFF,A,VR1=QUOCHAR;
END;
ASCI8BIT: BEGIN
CCALL PUTBUFF,A,VR1=BINQC;  % THE BINARY QUOTE CHARACTER
% THE HIGH ORDER BIT IS ON
END;
REPTQUO: ;  % JUST DROP THROUGH

ENDCASE;

%

LR VR1,XRD;  % POINT TO THE CHARACTER
CCALL PUTBUFF,A;  % PUT IT IN THE OUTPUT BUFFER

SI VR1,1;  % BACK UP TO LENGTH
ZR XRD; IC XRD,0(VR1);
UNCHAR XRD;  % MAKE IT AN INTEGER

AR XRE,XRD;  % INCREMENT COUNTER
SR XRB,XRD;  % DECRENT LENGTH
END;  % OF REPT CASE
20: BEGIN  % A QUOTE CHARACTER
LI VR0,2;
CCALL CHECKLEN,A;
EXIT FROM SDATABLK IF <RNZ VRF>;  % NO MORE ROOM IN PACKET
LI VR0,1;
CCALL PUTBUFF,A,VR1=QUOCHAR;
END;

24: BEGIN  % A HIGH ORDER QUOTE CHARACTER
LI VR0,3;
CCALL CHECKLEN,A;
EXIT FROM SDATABLK IF <RNZ VRF>;  % NO MORE ROOM IN PACKET
LI VR0,1;
CCALL PUTBUFF,A,VR1=BINQC;
CCALL PUTBUFF,A,VR1=QUOCHAR;
ZAP8BIT 0(XRE);
END;
          ENDCASE;
CCALL PUTBUFF,A,VR1=(XRE),VR0=1;  % PUT IT IN THE BUFFER
AI XRE,1;  % POINT TO NEXT CHARACTER
SI XRB,1;  % DECREMENT THE LENGTH REGISTER
END;
LR VRF,XRB;  % REMAINING CHARACTERS
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'PUTTABS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  MODULE : PUTTABS
%  FUNCTION : PUTS TABS INTO RECORD
%            CALLED BY FILLDPCK;
%  INPUT: NONE
%  OUTPUT : THE RECORD BUFFER WITH TAB CHARACTERS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
PUTTABS:
CENTER VRE,HIGHR,ENTRY=NO;

MZC TABCNT,2;  % ZERO TAB COUNTER
ZF TABFOUND;  % ZERO FLAG

ZR XRD;  % ACCUMULATOR

L VR0,EDPNTR;  % ADDRESS OF POINTER
L XRE,EDLENACT;  % LENGTH OF DATA RECEIVED
L XRA,TABTBLAD;  % POINTER TO ARRAY OF TABS
MMVC LASTTAB,=H'1';  % INTIALIZE LAST TAB
ST VR0,LASTADDR;  % LAST ADDRESS OF MOVE



TABBLCK: UNTIL <MCLC 0(XRA),=H'0',2> % UNTIL NO MORE TABS
DO BEGIN
%
L VR1,EDPNTR;  % POINTER TO RECORD  BUFFER
LH XRB,0(,XRA);  % LOAD TAB CHARACTER
SI XRB,1;  % ONE LESS FOR COMPARE
EXIT FROM TABBLCK IF <C XRB,EDLENACT; CC H>;  % EXIT IF TOO LONG
AI XRB,1;  % RESTORE TAB CHARACTER
AR VR1,XRB;  % POINT AT TAB PLACE

SI VR1,2;  % BACK UP IN STRING AT LEAST TWO CHARACTS FOR WORTH WHILE

LR VRF,XRB;  % SET UP LENGTH TO SCAN
SH VRF,LASTTAB;  % "
STH XRB,LASTTAB;  % PUT

LR XRB,VRF;  % LENGTH OF STRING



LCR VRF,VRF;  % LOAD COMP TO MAKE ROUTINE COUNT BACKWARD
CCALL CNTXCHAR,A,VR0=ASCBLANK;

IF <CI VRF,2; CC NL> THEN BEGIN  % FOUND TWO BLANKS
SF TABFOUND;


LR XRE,VRF;  % STORE OFF NUMBER OF BLANKS
SR XRB,VRF;  % UNTABBED ONES
L VR0,LASTADDR;  % LAST ADDRESS IN NON TAB BUFFER
L VR1,TABADDR;  % ADDRESS OF TAB BUFFER
AH VR1,TABCNT;  % NEXT PLACE TO BE

L VRF,EDPNTR;
AH VRF,0(XRA);  % POINT TO END OF CHAIN
SI VRF,1;  % KNOCK OFF ONE REGARDLESS
SR VRF,XRE;  % SUB OFF NUMBER OF BLANKS
S VRF,LASTADDR;  % SUB OFF FOR TOTAL TO MOVE
CCALL MVCXCHAR,A;  % MOVE UNTABBED ONES

AR VR1,VRF;  % POINT TO NEXT ENTRY
MMVC 0(VR1),TABCHAR,1;  % PUT IN TAB CHARACTER
AH VRF,TABCNT;
AI VRF,1;  % ONE FOR THE TAB CHARACTER COMING UP
STH VRF,TABCNT;  % INCREMENT TAB COUNTER
L VR0,EDPNTR;
AH VR0,0(XRA);  % ADD TAB
SI VR0,1;  % FOR CORRECT ADDRESS
ST VR0,LASTADDR;  % PLACE TO MOVE FROM



END;  % OF BLANKS
AI XRA,2;  % MOVE POINTER TO NEXT IN TAB TABLE
END;  % OF TABBLCK
IF <TF TABFOUND> THEN BEGIN

L VRF,EDLENACT;
L VR0,LASTADDR;
S VR0,EDPNTR;  % NUMBER ALREADY IN BUFFER
SR VRF,VR0;  % REMAINDER TO PUT


IF <RP VRF> THEN BEGIN  % A POSITIVE REMAINDER
L VR1,TABADDR;  % TAB BUFFER
AH VR1,TABCNT;  % COUNT IN BUFFER
L VR0,LASTADDR;  % FROM ADDRESS
CCALL MVCXCHAR,A;  % MOVE THE CHARACTERS LEFT
END;  % OF POSITIVE NUMBER
AH VRF,TABCNT;
ST VRF,EDLENACT;
MMVC EDPNTR,TABADDR,4;  % REINIT ADDRESS
END;  % OF FOUND A TAB

TABEXIT: CEXIT VRE,HIGHR;
LTORG;
EXORG;


SUBTITLE 'REPTCNT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : REPTCNT
% FUNCTION: SCANS BUFFER FOR LIKE CHARACTERS PUT IN REPTCHAR
%           PLUS LENGTH, PLUS CHAR
% ON RETURN R15 - EQUALS LENGTH OF STRING
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
REPTCNT: ;
CENTER VRE,HIGHR,ENTRY=NO;
LR XRB,VR0;  % LENGTH OF STRING

REPTBLCK: DO BEGIN  % BLOCK TO DROP OUT OF
WHILE <CI XRB,2; CC NL> DO BEGIN  % LOOP LOOKS THROUGH STRING
DO BEGIN
EXIT FROM REPTBLCK IF <CI XRB,2; CC L>;
ZR XRA;  % ZERO CASE STATEMENT
LR VR0,VR1;  % POINT TO SAME PLACE FOR CHECK

% CASE TO PUT IN REPEAT CHARACTER
MTRT 0(VR1),REPTABLE,1;  % NUMBER NEEDED FOR WORTHWHILE QUOTING
LR VRF,XRB;  % LOAD UP NUMBER OF CHARACTERS
CCALL CNTXCHAR,A;  % COUNT NUMBER OF MATCHES
LR XRC,VR1;  % POINTER
AR XRC,VRF;  % POINTER TO NEXT POSITION
AI VR1,1;  % INCREMENT POINTER
SI XRB,1;  % SUBTRACT COUNTER
END UNTIL <CR VRF,XRA; CC NL>;  % LOOP TILL WE FIND OK ONE
SI VR1,1;  % POINT BACK
SR XRB,VRF;  % SUBTRACT THE NUMBER EFFECTED
AI XRB,1;  % ADD IN ONE THAT WE SUBBED OFF ABOVE
LR XRA,VRF;  % GET LENGTH
DO BEGIN  % % 94 MAXIMUM NUMBER OF CHARACTERS
IF <CI XRA,94; CC H> THEN BEGIN  % TOO LARGE
LI VRF,94;  % MAX VALUE ACCORDING TO KERMIT STANDARDS
SI XRA,94;
END  % OF>94
ELSE BEGIN
LR VRF,XRA;  % LENGTH
ZR XRA;  % INDICATE NO MORE
END;

MMVC 0(VR1),REPTCHAR,1;
CHAR VRF;  % MAKE THE INTEGER A CHARACTER
STC VRF,1(VR1);  % STORE OFF LENGTH
% THE CHARACTER IS ALREADY IN STRING SO WE JUST LEAVE IT
%
UNCHAR VRF;  % MAKE INTEGER AGAIN
AR VR1,VRF;  % INCREMENT POINTER TO NEXT REPT PLACE
END UNTIL <RNP XRA>;  % LOOP THRU WHILE> 94

LR VR1,XRC;  % RESTORE POINTER


END;  % OF WHILE
END;  % OF REPTBLCK

REPTEXIT: CEXIT VRE,HIGHR;
LTORG;
EXORG;


SUBTITLE 'SCANDSN';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: SCANDSN
% FUNCTION: SCANS A STRING TO SET UP DATA SET NAME
% INPUT: VR1-> POINTER TO STRING
%        VR0 = LENGTH OF STRING
% OUTPUT: DSNAME VARIABLE FILLED IN
%         MEMBER NAME FILLED (IF PDS)
% RETURN:  VRF=0 - GOOD RETURN WITH DSNAME FILLED IN
%              4 -  "    "      "     " & MEMBER " " + PDS
%              8    "    "   + A WILD CARD -"*"
%              12 - VR0=0 ON ENTRY
%              16 - ERROR ON DS NAME
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SCANDSN:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
SCERROR NEW=SCDSNERR;
ZF PDSF;  % ASSUME NOT A PDS
ZR VRF;
MFC DSNAME,44;
DEBLANK VR1,VR0,XRA,ZERO=NO;  % DEBLANK STRING
MFC DSMEMBER,8;  % ZERO MEMBER NAME
IF ^<<CLI STATE,SEND> | <CLI STATE,RECEIVE>> | %NOTHING

<TF SERVERF> % ALWAYS PASS THROUGH FOR SERVER
THEN BEGIN
%%% CHECK NOW FOR REPEAT AND STRANGE CHARACTERS
MMVC MAXWRITE,=X'7FFF',2;  % MAXVALUE
MZC BUFCNT,2;  % ZERO OUT BUFFER COUNTER
MMVC ADDBUF,BUFADCON,4;  % ADDRESS OF BUFFER
MMVC TEMP,DATA,7;
MMVC DATA,=C'BINARY',7;
LR XRA,VR0;
L XRC,ETOAVCON;
EXI XRA,MTR,0(VR1),0(XRC),*-*,INCR=YES,DECR=YES;
CCALL KGETBUFF,A;
MMVC DATA,TEMP,7;
LH VR0,BUFCNT;  % NUMBER OF CHARACTERS
L VR1,ADDBUF;  % ADDRESS OF BEGINNING OF STRING
L XRC,ATOEVCON;
LR XRA,VR0;
EXI XRA,MTR,0(VR1),0(XRC),*-*,INCR=YES,DECR=YES;
%  ST VR1,DSNADD ;
%  STH VR0,DSNLEN ;
END;
SCANDSBK: DO BEGIN  % BLOCK TO FALL OUT OF IF NECESSARY
STH VR0,TEMP;  % STORE OFF LENGTH
LR XRA,VR0;  % LENGTH IN REGISTER
LR XRB,VR1;  % POINTER TO STRING
CCALL SCANASRK,A;  % ROUTINE LOOKS FOR ASTERISK
IF <TF ASTERISK> THEN BEGIN
IF <<CLI STATE,RFSTATE> | <CLI STATE,RECEIVE>>  %NO WILDCARD RECEIVE
THEN BEGIN
LI VRF,8;  % WILDCARD
EXIT FROM SCANDSBK;
END;
CCALL CATLOOK,A;  % LOOK INTO CATALOG
IF <RZ VRF> THEN CCALL NEXTFILE,A;  % SEE IF ENTRY EXISTS IN CATALOG
EXIT FROM SCANDSBK;
END;  % OF * BLOCK

LA XRC,DSNAME;
IF ^<TF PREFXQUO> THEN BEGIN
L XRB,USERPREA;  % POINTER TO USER PREFIX
LH XRA,USERPREL;  % LENGTH OF PREFIX
EXI XRA,MMVC,0(XRC),0(XRB),*-*,INCR=YES,DECR=YES; AR XRC,XRA;
MVI 0(XRC),C'.';  % PUT IN THE DOT
AI XRC,1;  % MOVE POINTER TO DATA SET NAME
END;
IF <MCLC PREFIXL,=H'0',2; CC H> THEN BEGIN
LH XRB,PREFIXL;
EXI XRB,MMVC,0(XRC),PREFIX,*-*,INCR=YES,DECR=YES;
AR XRC,XRB;
END;
SCINIT (VR1),(VR0);
SCANDSN1: DO BEGIN SCAN *;
         SCKW ,QDSN,QS;  % IF QUOTED DATA SET NAME
         SCKW ,UNQDSN;  % REGULAR DSN

UNQDSN:
% MTRT   TEST FOR ILLEGAL CHARACTERS IN DATA SET NAME
IF <TF PREFPDSF> THEN BEGIN
SCBACK;
GOTO UNQMEM;  % A PDS PREFIX FILL IN THE MEMBER
END;  % OF PREFIX PDS

LR XRB,VR0;  % LENGTH
EXI XRB,MMVC,0(XRC),0(VR1),*-*,INCR=YES,DECR=YES;  % SAVE DATA SET NAME)

BEGIN SCAN *;
      SCKW ,UNQMEM,PS;  % SEE IF MEMBER EXISTS FOR PDS
      SCKW ,*,B;  % ALL DONE BABY

UNQMEM:
DEBLANK VR1,VR0;
%MTRT TEST FOR VALID DSN AGAIN

SCPUSH;
SCINIT (VR1),(VR0);
SCAN;

IF <CI VR0,8; CC H> THEN LI VR0,8;
LR XRA,VR0;  % LENGTH FOR EXECUTE
IF <RZ XRA> THEN BEGIN  % NOTHING FOR MEMBER
IF ^<TF SERVERF> THEN WRTERM 'Member name excedes 8 characters'
ELSE BEGIN
ERRORCON 'No member name specified';
CCALL ERRPACK,A;
MVI STATE,ASTATE;
END;  % OF NON SERVER
LI VRF,BADDSN;  % ERROR ON NAME
EXIT;  % SPLIT THE BLOCK
END;  % OF ERROR BLOCK
EXI XRA,MMVC,DSMEMBER,0(VR1),*-*,INCR=YES,DECR=YES;

LA VR0,DOT;  % LOOK FOR DOTS
LI VRF,8;  % MEMBER NAME LENGTH
CCALL FINDCHAR,A,VR1=DSMEMBER;
IF <RNZ VRF> THEN BEGIN
SI VRF,1; AR VR1,VRF; SI VRF,8; LCR VRF,VRF;
LA VR0,BLANKS;  % MOVE IN BLANKS
CCALL MVCXCHAR,A;
END;  % OF FIXING MEMBER NAME
SCDONE;  % ERROR IF MORE JUNK ON LINE
SF PDSF;  % INDICATE WE HAVE A PDS
SCPOP;
SCANEND; END;

EXIT;

QDSN:
SCPUSH;
SCINIT (VR1),(VR0);
% SAME THING AS FOR UNQUOTED NAME

MFC DSNAME,44;  % BLANK IT
MFC DSMEMBER,8;
LA XRC,DSNAME;  % FOR THE PUT
% GOTO SCANDSN1;  % A BIT KLUDGEY FOR NOW
SCAN;
% MTRT   TEST FOR ILLEGAL CHARACTERS IN DATA SET NAME
LR XRB,VR0;  % LENGTH
EXI XRB,MMVC,0(XRC),0(VR1),*-*,INCR=YES,DECR=YES;  % SAVE DATA SET NAME)

SCAN *;
      SCKW ,UNQMEM,PS;  % SEE IF MEMBER EXISTS FOR PDS
      SCKW ,*,B;  % ALL DONE BABY
SCDONE;
SCPOP;
EXIT;
SCANEND;
SCANEND; END;
DATA BEGIN  % NOTHING SPECIFIED
IF ^<TF SERVERF> THEN WRTERM 'nothing specified for data set name'
ELSE BEGIN
ERRORCON 'Nothing specified for data set name to send';
CCALL ERRPACK,A;
MVI STATE,ASTATE;
END;
END;  % OF THEN
END;  % OF SCANDSBK GLOBAL BLOCK
IF <RZ VRF> THEN BEGIN

ST VRF,TEMP;  % STORE RETURN CODE
LA VR1,DSNAME;  % NOW WE FIND LENGTH OF  DATA SET
AI VR1,43;  % POINT TO END
LI VRF,44;  % NUMBER OF  CHARACTERS IN DATA SET NAME
LCR VRF,VRF;  % INDICATE COUNT BACKWARDS
LA VR0,BLANKS;  % LOOK FOR NON BLANKS
CCALL CNTXCHAR,A;
LI VR1,44;
SR VR1,VRF;  % LENGTH OF DATA SET NAME
STH VR1,DSNLEN;  % STORE OFF LENGTH FIELD
CCALL VALIDDSN,A,VR1=DSNAME,VR0=LH:DSNLEN,VRF=DSMEMBER;
% L VRF,TEMP;  % RESTORE COMP CODE
END;
DATA BEGIN
SCDSNERR: LI VRF,BADDSN;
END;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
SCDSNEND: CEXIT VRE,HIGHR;
LTORG;
EXORG;
BADDSN:    EQU    16;
PDSDSN:    EQU     8;
CATFILE:   EQU    4;  % FILE RETURN FROM CATALOG
GOODDSN:   EQU     0;
SUBTITLE 'VALIDDSN';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : VALIDDSN
% FUNCTION : CHECKS A STRING FOR A VALID 370/VS DSNAME
%
% INPUT:   VR0-> LENGTH OF DSNAME
%          VR1-> POINTER TO DATASET NAME
%          VRF = POINTER TO MEMBER NAME IF PDS
% OUTPUT : REG VRF =0 GOOD DSNAME ELSE BAD DATA SET NAME
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
VALIDDSN:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LR XRB,VR1;  % POINTER TO DSNAME
LR XRC,VR0;  % LENGTH
LR XRE,VRF;  % MEMBER POINTER
ZR XRA;  % BLAST REG2 FOR TRT
LI VRF,BADDSN;  % ASSUME BAD
DOSYNTAX: DO BEGIN  % BLOCK OF ROUTINE
IF <TF PDSF> THEN  BEGIN
EXIT FROM DOSYNTAX IF <MTRT 0(XRE),MEMTABLE,8; CC NZ>;
EXIT FROM DOSYNTAX IF
<<CLI 0(XRE),C'A'; CC L> | <CLI 0(XRE),C'Z'; CC H>>
& ^<CLI 0(XRE),C'#'> & ^<CLI 0(XRE),C'@'> & ^<CLI 0(XRE),C'$'>;
END;  % OF PDS
EXI XRC,MTRT,0(XRB),DSNTABLE,*-*,INCR=YES,DECR=YES;  % CHECK BAD CHAR
EXIT FROM DOSYNTAX IF <RNZ XRA>;
FOREVER DO BEGIN  % CHECK THE REST
EXIT FROM DOSYNTAX IF
<<CLI 0(XRB),C'A'; CC L> | <CLI 0(XRB),C'Z'; CC H>>
& ^<CLI 0(XRB),C'#'> & ^<CLI 0(XRB),C'@'> & ^<CLI 0(XRB),C'$'>;
LR VR1,XRC;  % SAVE COUNT
DO BEGIN
   EXIT IF <CLI 0(XRB),C'.'>;
   AI XRB,1;
END FOR XRC;
EXIT FROM DOSYNTAX IF <SR VR1,XRC; CI VR1,8; CC H>;  % ONLY 8 BETWEEN
EXIT IF <RNP XRC>;  % NO MO
AI XRB,1;
SI XRC,1;  % SKIP OVER .
EXIT FROM DOSYNTAX IF <RNP XRC>;
END;  % OF FOREVER
ZR VRF;  % INDICATE GOOD RETURN CODE
END;  % OF MAIN BLOCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

% TABLES FOR LEGAL DATA SET NAME
DSNTABLE:  DC 256AL1(BADDSN); BEGIN
   ORG DSNTABLE+C'A'; DC 9X'00';  % A-I
   ORG DSNTABLE+C'J'; DC 9X'00';  % J-R
   ORG DSNTABLE+C'S'; DC 8X'00';  % S-Z
   ORG DSNTABLE+C'@'; DC X'00';  % NATIONAL @
   ORG DSNTABLE+C'#'; DC X'00';  % NATIONAL #
   ORG DSNTABLE+C'$'; DC X'00';  % NATIONAL $
   ORG DSNTABLE+C'.'; DC X'00';  % NATIONAL .
   ORG DSNTABLE+C'-'; DC X'00';  % NATIONAL -
   ORG DSNTABLE+C'0'; DC 10X'00';  % 0-9
   ORG DSNTABLE+X'C0'; DC X'00';  % PLUS ZERO
   ORG;
   END;

% TABLES FOR LEGAL DATA SET MEMBER NAME
MEMTABLE:  DC 256AL1(BADDSN); BEGIN
   ORG MEMTABLE+C'A'; DC 9X'00';  % A-I
   ORG MEMTABLE+C'J'; DC 9X'00';  % J-R
   ORG MEMTABLE+C'S'; DC 8X'00';  % S-Z
   ORG MEMTABLE+C'@'; DC X'00';  % NATIONAL @
   ORG MEMTABLE+C' '; DC X'00';  % A BLANK AT THE END
   ORG MEMTABLE+C'#'; DC X'00';  % NATIONAL #
   ORG MEMTABLE+C'$'; DC X'00';  % NATIONAL $
   ORG MEMTABLE+C'0'; DC 10X'00';  % 0-9
   ORG;
   END;

SUBTITLE 'SCANASRK';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE: SCANASRK
% FUNCTION : SEARCHES SEND DATASET NAME FOR * FOR WILDCARD SEND
% INPUT : VR1->STRING
%         VR0=LENGTH OF NAME
% OUTPUT: FILLED IN SUFFIX OR/AND PREFIX
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SCANASRK:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
ASKBLCK:DO BEGIN % BLOCK TO FALL OUT OF
MZC DSNPFL,2;  % ZERO LENGTH OF PREFIX
MZC DSNSFL,2;  % "    "     "   SUFFIX
MFC LASTDSN,44;  % ZERO OUT OLD
ZF FULLQDSN ; %
IF <TF PREFXQUO> THEN <MMVC LASTDSN,PREFIX,8> % QUOTED PREFIX
ELSE BEGIN  % MOVE IN ACCOUNT INITIALS
LA XRC,LASTDSN;  % POINT AT DATA SET NAME
L XRB,USERPREA;  % POINTER TO USER PREFIX
LH XRA,USERPREL;  % LENGTH OF PREFIX
EXI XRA,MMVC,0(XRC),0(XRB),*-*,INCR=YES,DECR=YES; AR XRC,XRA;
MVI 0(XRC),C'.';  % PUT IN THE DOT
END;
ZR VRF;  % ZERO RETURN CODE
% DEBLANK (VR1),(VR0)
IF <CI VR0,1> & <CLI 0(VR1),C'*'> THEN SF ASTERISK  % SEND ALL
ELSE BEGIN  % NOT A TOTAL SCAN
LR XRE,VR1;  % LOAD ADDRESS POINTER
LR XRB,VR0;  % LOAD FOR EXECUTE
ZR XRA;  % ZERO FOR CASE
EXI XRB,MTRT,0(XRE),ASTRKTBL,*-*,INCR=YES,DECR=YES;
CASE XRA MAX 4 MIN 0 CHECK;
0: <ZF ASTERISK>;  % END OF IT NOT A WILDCARD (IE NO *) JUST FALL OUT
4: BEGIN  % WE HAVE AN ASTERISK
  SF ASTERISK;  % TURN ON ASTERISK INDICATOR
LR XRC,VR1 ; % STORE LOCATION OF ASTERISK
 % CHECK FOR FULLY QUOTED DATA SET NAME WITH ASTERISK
SCPUSH ;
SCINIT (XRE),(XRB) ;
SCAN * ;
SCKW ,FQDSN,QS ;
SCKW ,*,B ;

FQDSN:
SF FULLQDSN ; % FULLY QUOTED DATA SET NAME
 % SINCE FULLY QUALIFIED RELOAD
LR XRE,VR1;  % LOAD ADDRESS POINTER
LR XRB,VR0;  % LOAD FOR EXECUTE
ZR XRA;  % ZERO FOR CASE
EXI XRB,MTRT,0(XRE),ASTRKTBL,*-*,INCR=YES,DECR=YES;

LR XRA,VR1 ;
SR XRA,XRE ; % NUMBER OF SCANNED CHARACTERS
IF ^<CLI 7(XRE),C'.'> | % BETTER BE A DOT
   <CI XRA,8;CC L> THEN BEGIN % TOO FEW CHARACTERS
%                               FOR FULL QUALIFIED DSN
ERRORCON 'Illegal fully quoted data set name with wildcard';
CCALL ERRPACK,A ;
IF <TF SERVERF> THEN CCALL SABORT,A,VR0=LH:RPSEQ
ELSE TPUT (VR1),(VR0) ; %

LI VRF,24 ;
EXIT FROM ASKBLCK ;
END
ELSE BEGIN

MFC LASTDSN,44 ;
MMVC LASTDSN,0(XRE),8 ; % THIS SETS UP THE CATALOG NAME
END ;

SCANEND ; %
SCPOP ;

IF ^<TF FULLQDSN> THEN LR VR1,XRC ; % RESTORE ASTERISK POINTER
LR VR0,VR1;
SR VR0,XRE;  % TOTAL CHARACTERS SCANED
IF <RP VR0> THEN BEGIN  % STORE OFF BEGINNINGS
STH VR0,DSNPFL;  % PREFIX LENGTH;
LR XRA,VR0;  % FOR EXECUTE
EXI XRA,MMVC,DSNPFIX,0(XRE),*-*,INCR=YES,DECR=YES;  % MOVE IT
END;  % OF PREFIX
SR XRB,VR0;  % SUBTRACT TO SEE IF REMAINDER
SI XRB,1;  % SUBTRACT ONE FOR ASTERISK ITSELF
IF <RP XRB> THEN BEGIN  % STORE OFF LAST
STH XRB,DSNSFL;  % SUFFIX LENGTH
EXI XRB,MMVC,DSNSFIX,1(VR1),*-*,INCR=YES,DECR=YES;
END;  % OF SUFFIX



END;  % OF ASTERISK FOUND
ENDCASE ELSE WRTERM 'ERROR IN  CASE OF ASTERISK';
END;  % OF ELSE NON TOTAL * SEND
END ; % OF ASKBLCK

USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'NEXTFILE';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%MODULE : NEXTFILE
%FUNCTION: CALLS TSO CATALOG TO FIND THE NEXT ENTRY AFTER
%          DSNAME, CHECKS AGAINST PREFIX AND SUFFIX CRITERIA
%          AND RETURNS MATCH IF EXISTS IN DSNAME ELSE BLOCKS
%          IT OUT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
NEXTFILE:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

% IF DSNPFL = 45 THEN WE SEND ALL IN CATALOG
%
L XRC,CATDSPTR;  % POINTER TO PLACE IN CATALOG
USE XRC AS CATDSET IN BEGIN  % DATASET DSECT
DO BEGIN  % LOOP THROUGH CATALOG
SELECT FIRST;
<CLI TYPEBYTE,C'A'>: CATBLCK1: DO  BEGIN  % FOUND SOMETHING
% MMVC LASTDSN,RETURNDS,44;  % MOVE OVER DSNAME
LH XRA,MATCHDSL;  % LOAD PREFIX LENGTH
IF <RP XRA> THEN BEGIN
EXI XRA,MCLC,CATDNAME,MATCHDSN,*-*,DECR=YES,INCR=YES;
IF <CC => THEN BEGIN  % FOUND A MATCH FOR DATASET NAME
IF <MCLC DSNSFL,=H'0',2; CC H> THEN BEGIN  % CHECK SUFFIX
LA VR0,BLANKS;  % POINT TO BLANKS
LI VRF,44;  % LENGTH OF DSNAME
CCALL FINDCHAR,A,VR1=CATDNAME;  % FIND FIRST BLANK
IF <RZ VRF> THEN LI VRF,44 ELSE SI VRF,1;  % LENGTH OF DSN
SH VRF,DSNSFL;
AR VR1,VRF;  % POINTER TO SUFFIX BEGINNING
LH VRF,DSNSFL;
EXI VRF,MCLC,0(VR1),DSNSFIX,*-*,INCR=YES,DECR=YES;
IF ^<CC => THEN BEGIN
LI VRF,NOFILE;
EXIT FROM CATBLCK1;
END;
END;  % OF SUFFIX
MMVC DSNAME,CATDNAME,44;
LI VRF,FILEMTCH;
LI XRB,44;  % INDEX FOR DSNAME
LA VR1,DSNAME;
AI VR1,43;  % POINT TO LAST CHARACTER IN DSNAME
UNTIL <CLI 0(VR1),C' '; CC NE> | <RZ XRB> DO BEGIN
SI XRB,1;  % DECREMENT COUNTER
SI VR1,1;
END;
IF <CLI 0(VR1),C'.'> THEN <MVI 0(VR1),C' '; SI XRB,1>;  % NO DOTS LAST
STH XRB,DSNLEN;  % STORE LENGTH OF DSNAME
END
ELSE LI VRF,NOFILE;  % NO MATCH KEEP SCANNING
END;
END;  % OF FOUND SOMETHING
%%%% INVERT DSNAME & PREFIX SCAN BACKWARDS
<CLI TYPEBYTE,X'FF'>: BEGIN  % END OF CHAIN
LI VRF,ENDCAT;  % END OF CATALOG NO MORE MATCHES
END;  % OF 4 CASE

ENDSEL ELSE WRTERM 'WRONG BYTE TYPE IN CAT';
AI XRC,45;  % INDEX TO NEXT POINT IN CATALOG
END UNTIL <CI VRF,FILEMTCH> | <CI VRF,ENDCAT>;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

ST XRC,CATDSPTR;  % STORE OFF POINTER FOR NEXT TIME
CEXIT VRE,HIGHR;
LTORG;
EXORG;
END;  % OF DSECT FOR DSNAME
FILEMTCH:    EQU    0;
NOFILE:      EQU    4;  % NO FILE FOUND
ENDCAT:   EQU   20;
SUBTITLE 'BLDMATCH';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE:  BLDMATCH
% FUNCTION: BUILDS A DATASET NAME FOR THE COMPARE FROM CATALOG
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
BLDMATCH:
CENTER VRE,HIGHR,ENTRY=NO;
MFC MATCHDSN,44;  % ZERO OUT
ZR XRA;  % LENGTH COUNTER
LA XRB,MATCHDSN;  % POINTER
IF ^<TF FULLQDSN> THEN BEGIN % FULLY QUALIFIED WILD CARD
IF ^<TF PREFXQUO> THEN BEGIN
L XRC,USERPREA;  % POINTER TO USER PREFIX
LH XRA,USERPREL;  % LENGTH OF PREFIX
EXI XRA,MMVC,0(XRB),0(XRC),*-*,INCR=YES,DECR=YES;
AR XRB,XRA;  % % INCREMENT POINTER
MVI 0(XRB),C'.';  % PUT IN THE DOT
AI XRB,1; AI XRA,1;  % INCRMENT POINT AND COUNTERS
END;
IF <MCLC PREFIXL,=H'0',2; CC H> THEN BEGIN
LH XRC,PREFIXL;
AR XRA,XRC;  % LENGTH
EXI XRC,MMVC,0(XRB),PREFIX,*-*,INCR=YES,DECR=YES;
AR XRB,XRC;  % MOVE POINTER
END;

END ; % OF NOT FULLY QUALIFIED
IF <MCLC DSNPFL,=H'0',2; CC H> THEN BEGIN
LH XRC,DSNPFL;
AR XRA,XRC;  % LENGTH
EXI XRC,MMVC,0(XRB),DSNPFIX,*-*,INCR=YES,DECR=YES;
AR XRB,XRC;  % MOVE POINTER
END;
STH XRA,MATCHDSL;
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'CNTXCHAR';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : CNTXCHAR
% FUNCTION : COMPARES A STRING TO A CHARACTER FOR A LENGTH
%            AND RETURNS IN REG 15 THE NUMBER OF MATCHES
% INPUT:   VR0-> THE CHARACTER TO CHECK
%          VR1-> THE STRING TO CHECK AGAINST
%          VRF = LENGTH OF VR1 STRING
% OUTPUT : REG VRF CONTAINS THE NUMBER OF CHARACTERS THAT MATCH
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
CNTXCHAR:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LR  XRB,VR0;  % LOAD ADDRESS OF CHARACTER TO CHECK AGAINST
LR XRA,VRF;  % LOAD COUNTER
LTR XRA,XRA;
IF <CC M> THEN <ZF FORWARDF; LCR XRA,XRA> ELSE SF FORWARDF;
                                    % OR BACKWARD IF HIGH ORGER

ZR VRF;  % ZERO COUNTER
FOR XRA DO

BEGIN

EXIT IF ^<MCLC 0(VR1),0(XRB),1>;  % LEAVE LOOP ON NOT EQUAL
AI VRF,1;  % BUMP ACCUMULATOR
IF <TF FORWARDF> THEN AI VR1,1  % INCREMENT POINTER
ELSE SI VR1,1;  % BACK UP IF NEGATIVE COUNT


END;  % OF FOR LOOP

USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'FINDCHAR';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : FINDCHAR
% FUNCTION : FINDS  A CHARACTER IN A STRING FOR A LENGTH
%            AND RETURNS IN REG 15 THE RELATIVE POSITION
% INPUT:   VR0-> THE CHARACTER TO FIND
%          VR1-> THE STRING TO CHECK AGAINST
%          VRF = LENGTH OF VR1 STRING
% OUTPUT : REG VRF CONTAINS THE RELATIVE POSITION CHARACTERS
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
FINDCHAR:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LR  XRB,VR0;  % LOAD ADDRESS OF CHARACTER TO CHECK AGAINST
LR XRA,VRF;  % LOAD COUNTER
LTR XRA,XRA;
IF <CC M> THEN <ZF FORWARDF; LCR XRA,XRA> ELSE SF FORWARDF;
                                    % OR BACKWARD IF HIGH ORGER
LR XRC,XRA;  % SAVE COUNT
AI XRC,1;  % ONE MORE
LI VRF,1;  % ZERO COUNTER
FOR XRA DO

BEGIN

EXIT IF <MCLC 0(VR1),0(XRB),1>;  % LEAVE LOOP ON  EQUAL
AI VRF,1;  % BUMP ACCUMULATOR
IF <TF FORWARDF> THEN AI VR1,1  % INCREMENT POINTER
ELSE SI VR1,1;  % BACK UP IF NEGATIVE COUNT


END;  % OF FOR LOOP
IF <CR XRC,VRF> THEN <ZR VRF>;  % ZERO IF NOTHING FOUND
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;



SUBTITLE 'MFCXCHAR';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : MFCXCHAR
% FUNCTION : FILLS A STRING WITH A CHARACTER FOR A LENGTH
% INPUT:   VR0-> THE FILL CHARACTER
%          VR1-> THE BUFFER TO FILL
%          VRF = LENGTH OF VR1 STRING
% OUTPUT : THE STRING HAS CHARACTER FILLED
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
MFCXCHAR:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LR XRB,VR0;  % ADDRESS POINTER
LR XRA,VRF;  % ACCUMLATOR IF > 255

DO BEGIN  % LOOP IF > 255

IF <CI XRA,255; CC H> THEN <ZR VRF; LI VRF,255; SI XRA,255>
ELSE ZR XRA;

IF <RP VRF> THEN BEGIN


MMVC 0(VR1),0(XRB),1;  % MOVE FIRST CHARACTER
SI VRF,1;  % DECREMENT ACCUMULATOR
IF <RP VRF> THEN EXI VRF,MMVC,1(VR1),0(VR1),*-*,DECR=YES;  % MOVE EM


END;  % OF POSITIVE LOOP

END UNTIL <RZ XRA>;  % UNTIL ALL DONE


CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'MVCXCHAR';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : MVCXCHAR
% FUNCTION : MOVES VR0-> TO VR1->FOR A LENGTH
% INPUT:   VR0-> THE FROM ADDRESS
%          VR1-> THE BUFFER TO PUT
%          VRF = LENGTH OF VR1 STRING
% OUTPUT : THE STRING HAS CHARACTER FILLED
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
MVCXCHAR:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

LR XRA,VRF;  % ACCUMLATOR IF > 255
LR XRB,VR0;  % ADDRESS OF FROM

DO BEGIN  % LOOP IF > 255

IF <CI XRA,255; CC H> THEN <ZR VRF; LI VRF,255; SI XRA,255>
ELSE <LR VRF,XRA; ZR XRA>;

IF <RP VRF> THEN BEGIN


EXI VRF,MMVC,0(VR1),0(XRB),*-*,DECR=YES;  % MOVE EM
AI XRB,255;  % MOVE ADDRESSES
AI VR1,255;


END;  % OF POSITIVE LOOP

END UNTIL <RZ XRA>;  % UNTIL ALL DONE


CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'CATLOOK';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%MODULE : CATLOOK
%FUNCTION: CALLS TSO CATALOG TO FIND THE  ENTRY LASTDSN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
CATLOOK:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

%
LA VR1,CIRPARM;  % ADDRESS OF PARAMETER BLOCK
DO BEGIN  % SEARCH THROUGH CATALOG FOR A MATCH UNTIL EOF
DS    0H;
LINK EP=IKJEHCIR;  % ,LSEARCH=NO;  % CALL CATALOG ROUTINE
LOOKCASE: CASE VRF MAX 12 MIN 0;
0: BEGIN  % FOUND SOMETHING
% MMVC LASTDSN,RETURNDS,44;  % MOVE OVER DSNAME
L XRA,CIRWA;  % LOAD ADDRESS OF RETURNED CATALOG BUFFER
MMVC 2(XRA),=H'0',2;  % ZERO OUT LENGTH IN CAT BUFFER
AI XRA,4;  % INCREMENT PAST COUNT BYTES
ST XRA,CATDSPTR;  % STORE OFF POINTER TO BUFFER
CCALL BLDMATCH,A;  % BUILD PREFIX FOR DSNAME
END;  % OF FOUND SOMETHING
%%%% INVERT DSNAME & PREFIX SCAN BACKWARDS
4: BEGIN  % LOCATE FAIL
IF <CLI CIRLOCRC,X'08'> THEN  BEGIN  % END OF CHAIN
LI VRF,NOFILE;  % END OF CATALOG NO MORE MATCHES
END;
IF <CLI CIRLOCRC,X'08'> THEN  BEGIN  % END OF CHAIN
END;
END;  % OF 4 CASE
12: BEGIN
WRTERM ' VOL BY LOCATE ERROR';
END;
ENDCASE;

END;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'CHECKLEN';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   MODULE NAME -CHECKLEN
%
%   FUNCTION - USED BY KSEND, QUOTED PACKETS CAN'T BE SPLIT
%   VR0 - NUMBER OF CHARACTER TO PUT -
%      VRF=0 ON RETURN RETURN IF BUFF
%         LARGE ENOUGH, ELSE VRF =4
%
CHECKLEN:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

LH XRA,MAXPUT;  % MAX LENGTH OF BUFFER
SH XRA,PUTLEN;  % GET REMAINDER
IF <CR XRA,VR0; CC L> THEN LI VRF,4  %  TOO SMALL   TO FIT
ELSE ZR VRF;  % ENOUGH ROOM GO AHEAD AND PUT IT

USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'SERVER';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SERVER
% FUNCTION : SERVER SLAVE MODE ENABLED  RECEIVES COMMANDS
% INPUT:   NONE - WAITS ON PACKETS
%
%
% OUTPUT : NONE - PERFORMS FUNCTIONS TILL L PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SERVER:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
USE XRC AS PACKET IN BEGIN  % ADRESSABLE DSECT
ZF LOGOUT ;
LA XRC,RECPKT;  % RECEIVE PACKET ADDRESS
WRTERM ' Now entering SERVER mode - type FINISH or LOGOUT on micro'_
        ' to halt SERVER';

SERVBLCK: WHILE <TF SERVERF> DO BEGIN  % SERVER BLOCK

% CALL TIMER SO SERVER CAN TIME OUT USER AFTER SERVWAIT TIME
TIME BIN ; % GET TIME IN BINARY
A VR0,SERVWAIT ; % BUMP CURRENT TIME BY TIME TO WAIT
ST VR0,SERVTIME ; % STORE IT OFF

ZF STOPF;  % ZERO STOP FLAG
BCCTYPE 1;  % 1 BCC BYTE AT END
L XRA,RTIMEOUT;  % SAVE TIMEOUT

MMVC RTIMEOUT,SERVTOUT,4;  % SERVER TIME OUT

DO BEGIN  % UNTIL WE GET SOMETHING
CCALL RPACK,A;  % GET THE PACKET

EXIT FROM SERVBLCK IF ^<TF SERVERF>;
NEXT OF SERVBLCK IF <TF STOPF>;
IF <RNZ VRF> THEN BEGIN  % RESPOND TO PACKET
MZC OLDSEQ,2;  % ZERO OUT SEQUENCE NUMBER
MMVC OLDBCC,BCCLEN,2;  % STORE OFF OLD BCC
MVI BCCLEN+1,1;  % TYPE 1 BCC FOR SERVER TIMEOUT
SERVNACK XRB;  % RESPOND TO PACKET
MMVC BCCLEN,OLDBCC,2;  % RESTORE BCC
LR XRB,VRF ; % STORE OLD VALUE

% CHECK TIMER FOR EXTENDED TIME OUT
TIME BIN ;
LR VRF,XRB ; % RESTORE RPACK VALUE

IF <C VR0,SERVTIME ; CC H> THEN BEGIN
SF LOGOUT ; % INDICATE TO LOGUSER OFF

MMVC TEMP,=C'LOGOFF ',7 ; %
CCALL TSOCMD,A,VR1=TEMP,VR0=7 ; % STACK LOGOFF COMMAND
ZF SERVERF ;


WRTERM 'The SERVER has exceeded its timeout and is logged off';

EXIT FROM SERVBLCK ;
END ;

END;  % OF NACK TIMEOUT
END UNTIL <RZ VRF>;  % LOOP TILL WE GET A GOOD INPUT


ST XRA,RTIMEOUT;  % REPLACE THE READ TIME OUT

ZR XRA;  % ZERO REG FOR CASE STATEMEN5T


MTRT RTYPE,SERVCOMM,1;  % SERVER COMMAND TYPE

CASE XRA MAX ISTATE MIN 0 CHECK;
0 THRU ACASE: BEGIN  % THE REST
       MVI STATE,ASTATE;  % ABORT
ERRORCON 'Illegal Packet type for SERVER ';
CCALL ERRPACK,A;  % SET UP FOR ERROR PROCESSING

       END;  % REST CASE

RSTATE: BEGIN  % WE RECEIVED AN SEND INIT PACKET

CCALL KRECEIVE,A,;  % CALL RECEIVE ROUTINE;

       END;  % RSTATE CASE
R2STATE: BEGIN  % WE RECEIVED A GET PACKT
IC XRA,RLEN;  % LENGTH OF PACKET-2
UNCHAR XRA;  % MAKE INTEGER
SH XRA,BCCLEN;  % TAKE OFF BCCLENGTH
SI XRA,2;  % SUB OFF TYPE & SEQ BYTE
L XRB,ATOEVCON;
EXI XRA,TR,RDATA(*-*),0(XRB),DECR=YES,INCR=YES;
EXI XRA,TR,RDATA(*-*),UPPER,DECR=YES,INCR=YES;  % UPPER
% HENCE LEFT WITH DSN LENGTH
EXI XRA,MMVC,DSNAMEX,RDATA,0,DECR=YES,INCR=YES;  % MOVE THE NAME

LR VR0,XRA;  % LOAD LENGTH OF DSNAME
SCINIT DSNAMEX,(XRA);
SCTYPE NEW=1;

CCALL KSEND,A,VR1=DSNAMEX;  % SET UP

         END;  % GETCASE
GSTATE: BEGIN  % A SERVER GENERIC COMMAND
        SELECT FIRST;
<CLI RDATA,X'4C'>: BEGIN  % LOGOFF COMMAND
MMVC TEMP,=C'LOGOFF ',7;
LI VR0,7;
CCALL TSOCMD,A,VR1=TEMP;  % LOGOUT
SF LOGOUT ;
ZF SERVERF;  % GOOD BYE KERMIE
ACKIT VR0;
END;  % OF LOGOFF
<CLI RDATA,X'46'>: BEGIN  % FINISH SERVER COMMAND
ZF SERVERF;  % FINISH SERVER COMMAND
ACKIT VR0;
END;
     ENDSEL
     ELSE BEGIN
ERRORCON 'Unimplemented SERVER Commmand';
CCALL ERRPACK,A;  % SET UP FOR ERROR PROCESSING
       MVI STATE,SESTATE;  % ABORT
CCALL SABORT,A,VR0=LH:RPSEQ;  % SEND ABOR
     END;  % OF SELECT
END;  % OF CASE

ISTATE: BEGIN  % WE RECEIVED AN I PACKET
MVI RTYPE,ROFF;  % SEND INIT PACKET FOR SUB
BCCTYPE 1;  % BLOCK CHECK TYPE
ZEROSEQ;  % ZERO SEQUENCE NUMBER
ZERORTRY;  % ZERO RETRY
MVI STATE,RISTATE;  % SEND INIT STATE

%UNTIL <CLI STATE,RFSTATE> | <MCLC RETRY,NUMTRY; CC L>  |
%<CLI STATE,SESTATE> | <CLI STATE,RESTATE>
CCALL RINIT,A;  % CALL RECEIVE INIT

IF <CLI STATE,SESTATE> THEN CCALL SABORT,A,VR0=LH:RPSEQ;  % SEND ABOR
       END;  % ISTATE CASE
       ENDCASE
       ELSE BEGIN
ERRORCON 'Unknown Server packet type';
CCALL ERRPACK,A;  % SET UP FOR ERROR PROCESSING
       MVI STATE,ASTATE;  % ABORT
MMVC PHDR,RSOH,1;  % SOH
MMVC PNUM,RSEQ,1;
       END;  % OF ERROR CASE
END;  % OF SERVER BLOCK   LOOP FOREVER UNTIL END PACKET
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
END;  % OF ADDRESSIBILITY DSECT
% CHECH WHETHER LOGOFF
IF ^<TF LOGOUT> THEN BEGIN

LI VR0,100;  % 1 SECOND FOR TIMER
ST VR0,TEMP;
STIMER WAIT,BINTVL=TEMP;  % WAIT FOR ONE SECOND IN ORDER NOT TO LOSE
                           % THE PROMPT
END ;
CEXIT VRE,HIGHR;  % OUT OF SERVER
LTORG;
EXORG;

SUBTITLE 'KSHOW';

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%     MODULE NAME   -   KSHOW
%
%
%     FUNCTION-   LISTS THE CURRENT ENVIORNMENT OF THE SET COMMAND
%
%
%
%     INPUTS -   NONE EXCEPT POSSIBLE '?' / OR HELP
%
%
%
%
%     OUTPUTS-  SCREEN OUTPUT OF CURRENT OPTIONS
%
%
%     RETURN
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KSHOW: ;
CENTER VRE,HIGHR,ENTRY=NO;
SHOWBLCK: DO BEGIN  % BLOCK TO FALL THRU

SCERROR NEW=SHOWSCAN;  % SET UP FOR SCDONE IF MORE TOKENS
    SCAN  *;
   SCKW (STATUS,STA),SHOWBEG;  % UP TOP IF STATUS REQUEST
    SCKW (?,HELP),SHOWHELP;
    SCKW ,SHOWSCAN;  % NO OTHER PARMS
    SCANEND;  % ERROR

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SHOWBEG:  % LABEL FOR END
%%%%%    HEADER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN;  % INIT VAREA FOR OUTPUT

WRTERM ' ';  % BLANK LINE
VSEG KERMVA,'Data Set Attributes ';  % column 1 title
CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40

VSEG KERMVA,'Protocol Attributes';  % column 2 title
VOUT KERMVA;  % OUTPUT IT

%WRTERM ' ';  % A BLANK LINE

MMVC CRTLINE#,=H'1',2;  % INITIAL CRT LINE TO FIRST

DO BEGIN  % UNTIL CRTLINE# = TOTALCRT

SELECT;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,2>: BEGIN  % EDIT

IF <TF EDITF> THEN VSEG KERMVA,'EDIT (WYLBUR edit format data set): on'
ELSE VSEG KERMVA,'EDIT (Non Edit format data set): off';

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,4>: BEGIN  % TABS

VSEG KERMVA,'TABS: ';
IF <TF TABF> THEN VSEG KERMVA,'on' ELSE VSEG KERMVA,'off';

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,3>: BEGIN  % Number function
VSEG KERMVA,'NUMBERED ';
VSEG KERMVA,'(line nos.): ';
SELECT FIRST;
<MCLC EDTYPE,=F'1',4>: BEGIN
VSEG KERMVA,'off';
END;
<MCLC EDTYPE,=F'2',4>: VSEG KERMVA,'WYLBUR';
<MCLC EDTYPE,=F'3',4>: VSEG KERMVA,'(numbered in cols): WYLBUR XX/YYY';
<MCLC EDTYPE,=F'4',4>: VSEG KERMVA,'(TSO default numbers): TSO';
<MCLC EDTYPE,=F'5',4>: VSEG KERMVA,'(numbered in cols): TSO COL/COL';
ENDSEL;


END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,1>: BEGIN  % DATA
              % DATA TEXT OR BINARY
VSEG KERMVA,'DATA: ';
IF <MCLC DATA,=C'TEXT',4> THEN VSEG KERMVA,'Text'
ELSE VSEG KERMVA,'Binary';

END;  % OF SELECT BEGIN

<CLI CRTLINE#+1,5>: BEGIN  % RECFM
VSEG KERMVA,'RECFM (Record format): ';
IF <CLI RFM,C'U'> THEN
VSEG KERMVA,RFM,1       % MOVE IN REC FORMAT
ELSE VSEG KERMVA,RFM,2;  % MOVE IN REC FORMAT

END;  % OF SELECT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,6>: BEGIN  % LRECL
VSEG KERMVA,'LRECL (Logical record length): ';
CVBTD TEMP,0,LH:LRECL;  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % LREC IN TO BUFFER

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,7>: BEGIN  % BLKSIZE

VSEG KERMVA,'BLKSIZE (Block size): ';
CVBTD TEMP,0,LH:BLKSIZE;  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % BLKSIZE IN TO BUFFER

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,8>: BEGIN  % SPACE

VSEG KERMVA,'SPACE (Space allocation): ';
CVBTD TEMP,0,L:TRACK;  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % TRACK IN TO BUFFER
VSEG KERMVA,' tracks ';

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,9>: BEGIN  % VOLUME
VSEG KERMVA,'VOLUME: ';  % DEFAULT DISK IF ANY
VSEG KERMVA,VOLUME,7;  % DISK DRIVE

END;  % OF SELECT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,10>: BEGIN  % PREFIX

VSEG KERMVA,'PREFIX: ';
LH VR0,PREFIXL;  % CONVERT BINARY TO DEC
IF <RZ VR0> THEN VSEG KERMVA,'No prefix' ELSE BEGIN
IF <TF PREFXQUO> THEN BEGIN
ST VR0,TEMP;  % STORE OFF NUMBER OF CHARACTERS
VSEG KERMVA,'"';
L VR0,TEMP;  % RESTORE LENGTH
END;  % OF QUOTED PREFIX
VSEG KERMVA,PREFIX,(VR0);  % PREFIX IN TO BUFFER

IF <TF PREFXQUO> THEN VSEG KERMVA,'"';
END;
END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,5>: BEGIN  % QUOTE

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'CQUOTE (Control quote character): ';
MVC TEMP(1),QUOCHAR;  % MOVE TO WORK AREA
L XRA,ATOEVCON; TR   TEMP(1),0(XRA);  % PUT IN EBCDIC
VSEG KERMVA,TEMP,1;

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,8>: BEGIN  % SOH

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'SOH (Start of Header): ';
CVBTD TEMP,0,LOADB:SSOH;  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % SOH CHAR IN TO BUFFER
CCALL SHOWASCI,A,VR1=SSOH;

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,9>: BEGIN  % SEOL

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'SEOL (Send End-of-line): ';
CVBTD TEMP,0,LOADB:SEOL;  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % EOL CHAR IN TO BUFFER
CCALL SHOWASCI,A,VR1=SEOL;

END;  % OF SELECT BEGIN
<CLI CRTLINE#+1,10>: BEGIN  % REOL

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'REOL (Receive End-of-line): ';
CVBTD TEMP,0,LOADB:REOL;  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % EOL CHAR IN TO BUFFER
CCALL SHOWASCI,A,VR1=REOL;

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,6>: BEGIN  % BINARY QUOTE

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'BQUOTE (Binary quote character): ';
MVC TEMP(1),BINQC;  % MOVE TO WORK AREA
L XRA,ATOEVCON; TR   TEMP(1),0(XRA);  % PUT IN EBCDIC
VSEG KERMVA,TEMP,1;

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,7>: BEGIN  % REPEAT QUOTE

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'RQUOTE (Repeat quote character): ';
MVC TEMP(1),REPTCHAR;  % MOVE TO WORK AREA
L XRA,ATOEVCON; TR   TEMP(1),0(XRA);  % PUT IN EBCDIC
VSEG KERMVA,TEMP,1;

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,4>: BEGIN  % PACKET SIZE

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'PACKET (Receive packet size): ';
CVBTD TEMP,0,L:RPSIZ;  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % RECEIVE SIZE  INTO BUFFER

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,1>: BEGIN  % DELAY

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'DELAY (after SEND): ';
L VR1,DELAY;  % DELAY TIME
ZR VR0;
D  VR0,=F'100';
LR VRF,VR1;  % SET UP FOR MACRO
CVBTD TEMP,0,(VRF);  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % DELAY TIME INTO BUFFER
VSEG KERMVA,' seconds ';

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,11>: BEGIN  % DEBUG

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'DEBUG: ';
IF <TF DBUGFLAG> THEN VSEG KERMVA,'on' ELSE VSEG KERMVA,'off';

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,2>: BEGIN  % TIMER

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'TIMER (Timeout interval): ';
IF ^<TF TIMERF> THEN VSEG KERMVA,'off' ELSE BEGIN
 VSEG KERMVA,'on (';
L VR1,RTIMEOUT;  % TIMEOUT TIME  TIME
ZR VR0;
D  VR0,=F'100';
LR VRF,VR1;  % SET UP FOR MACRO
CVBTD TEMP,0,(VRF);  % CONVERT BINARY TO DEC
VSEG KERMVA,(VR1),(VR0);  % DELAY TIME INTO BUFFER
VSEG KERMVA,' seconds)';
END;  % OF TIMER FLAG

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
<CLI CRTLINE#+1,3>: BEGIN  % BLOCK CHECK TYPE

CCALL ALIGN,A;  % ADJUSTS THE COLUMNS TO 40
VSEG KERMVA,'BLOCK (Block check type): ';
SELECT FIRST;
<CLI HIGHBCC,1>: VSEG KERMVA,'1';
<CLI HIGHBCC,2>: VSEG KERMVA,'2';
<CLI HIGHBCC,3>: VSEG KERMVA,'3 (CRC)';
ENDSEL;

END;  % OF SELECT BEGIN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ENDSEL;
LH XRA,CRTLINE#;
AI XRA,1;
STH XRA,CRTLINE#;  % BUMP IT

        VOUT KERMVA;  % OUTPUT IT
END UNTIL <MCLC CRTLINE#,MAXCRC#,2; CC H>;  % END OF MAIN LOOP


    EXIT FROM SHOWBLCK;
SHOWSCAN: DO BEGIN  % IF REMAINING TOKENS ERROR OR HELP
WRTERM 'Valid options are SHOW STATUS or HELP';
    EXIT FROM SHOWBLCK;  % FALL OUT
SHOWHELP:
WRTERM 'The SHOW command lists the current option settings.';
WRTERM 'The options may be changed with the SET command.';
END;  % OF SCDONE
END;  % OF SHOWBLCK
 %VSEG KERMVA,')';
 %WRTERM ' ';  % BLANK
CEXIT VRE,HIGHR;

SAVESHOW:  DC  18F'0';  % SAVE AREA
%TEMP:  DC  CL15;  % A WORK BUFFER  ALREADY DEFINED
OUTLEN:      EQU         80;  % OUTPUT LINE LENGTH

LTORG;
EXORG;

SUBTITLE 'SHOWASCI';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE SHOWASCI
% FUNCTION - VSEGS THE ASCII AKCRONYM FOR ITS BINARY CONTER PART
% INPUT - VR1 -> 1 BYTE HEX
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SHOWASCI: CENTER VRE,HIGHR,ENTRY=NO;
LR XRB,VR1;
ZR XRA;
IC XRA,0(VR1);  % LOAD THE CHARACTER
VSEG KERMVA,' (';
LA VR1,ASCILITS;  % POINT TO BEGINNING OF TABLE
MH XRA,=H'3';  % INDEX INTO TABLE
AR VR1,XRA;  % "
IF <CLI 2(VR1),C' '> THEN VSEG KERMVA,(VR1),2   % PUT INTO VSEG
ELSE VSEG KERMVA,(VR1),3;  % PUT INTO VSEG
VSEG KERMVA,',';
LR VR1,XRB;  % RESTORE POINTER TO BYTE FOR NEXT SUB
CCALL SHOWCNTL,A;  % PUTS VALUE IN CONTROL NOTATION (EG ^A=X'01')
VSEG KERMVA,')';
CEXIT VRE,HIGHR;
LTORG;
SUBTITLE 'SHOWCNTL';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE SHOWCNTL
% FUNCTION - VSEGS THE ASCII CONTROL FOR ITS BINARY CONTER PART
% INPUT - VR1 -> 1 BYTE HEX
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SHOWCNTL: CENTER VRE,HIGHR,ENTRY=NO;
ZR XRA;
IC XRA,0(VR1);  % LOAD THE CHARACTER
%VSEG KERMVA,' (';
LA VR1,ASCCNTLC;  % POINT TO BEGINNING OF TABLE
MH XRA,=H'2';  % INDEX INTO TABLE
AR VR1,XRA;  % "
VSEG KERMVA,(VR1),2;  % PUT INTO VSEG
%ELSE VSEG KERMVA,(VR1),3;  % PUT INTO VSEG

%VSEG KERMVA,')';
CEXIT VRE,HIGHR;
LTORG;
SUBTITLE 'KERMVOUT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%                   OUT PUT ROUTINE FOR VSEG
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KERMVOUT: CENTER VRE,HIGHR,ENTRY=NO;
        TPUT (VR1),(VR0),R;  % OUTPUT IT
CEXIT VRE,HIGHR;
SUBTITLE 'ADSTATUS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  MOD: ADSTATUS
% FUNCTION : LINKS AN ENTRY INTO STATUS MESSAGE CHAIN
% INPUT : VR1-> BUFFER
%         VR0=  L'BUFFER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ADSTATUS:
CENTER VRE,HIGHR,ENTRY=NO;
LR XRA,VR0;
EXI XRA,MMVC,STATBUFF,0(VR1),*-*,INCR=YES,DECR=YES;
STH VR0,STATLEN;
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'GETTABS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE- GETTABS
% FUNCTION - COUNT THE NUMBER OF SPACES TO NEXT TAB PLACE
% INPUTS - NONE
% OUTPUT - VRF= NUMBER OF SPACES/BLANKS TO PUT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
GETTABS:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

ZR VRF;  % ZERO RETURN
LH XRA,BUFCNT;  % NUMBER OF CHARACTERS ALREADY IN OUT BUFFER
L VR1,TABTBLAD;  % TABLE OF TAB CHARACTERS
GETTABLK: UNTIL <MCLC 0(VR1),ZERO,2>
DO BEGIN  % TAB BLOCK
IF <CH XRA,0(,VR1); CC L> THEN BEGIN  % COUNT LESS THAN TAB
LH VRF,0(,VR1);  % LOAD THE TAB POINTER FROM CHAIN
SR VRF,XRA;  % SUBTRACT BUFCNT
SI VRF,1;  % ONE EXTRA FOR GOOD MEASURE
EXIT FROM GETTABLK IF <RP VRF>;  % LEAVE IF POSITIVE
END;  % OF FOUND THE TAB ENTRY
AI VR1,2;  % INCREMENT POINTER TO NEXT TAB ITEM
END;  % OUT OF TABTABLE

USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'ALIGN ';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%               ALIGNS TO 40 COLUMNS THE BUFFER IN VSEG IN SET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ALIGN: CENTER VRE,HIGHR,ENTRY=NO;
VTELL KERMVA;  % VR1 => KERMVA VR0=LENGTH
ZR XRA;
LI XRA,40;
SR XRA,VR0;
IF <RP XRA> THEN BEGIN
VSEG KERMVA,BLANKS,LA:0(,XRA);  % PUT BLANKS IN
END;
CEXIT VRE,HIGHR;
LTORG;


SUBTITLE 'TSOCMD';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   MOD NAME - TSOCMD
%
%   FUNCTION - USE TSO SERVICE COMMAND TO PASS A TSO
%   STRING TO TSO
%
%   INPUTS - VR1 = ADDRESS OF STRING
%            VR0 = LENGTH OF STRING
%   RETURN - VR15 = 0 IF OK ELSE ADDRESS OF PARM4
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

TSOCMD:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

LR XRA,VR0;  % LOAD REG FOR EXECUTE MOVE
ST VR0,PARM3;  % STORE OFF LENGTH FIELD


EXI XRA,MMVC,PARM2,0(VR1),*-*,DECR=YES,INCR=YES;
% THIS STATEMENT MOVES DATA TO PARM FIELD


BAL;

  L 15,TSOADD  LOAD ROUTINE ADDRESS
   CALL (15),(PARM1,PARM2,PARM3,PARM4,PARM5,PARM6),VL

ALP;
IF <RZ VRF> THEN BEGIN
LA VRF,PARM4;
END;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'KRPACK';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD:  RPACK
% FUNCTION : GETS A PACKET OF DATA FROM REMOTE KERMIT
%            VIA ROUTINE KERMTGET - TIMEOUT ROUTINE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RPACK:   % RECEIVE PACKET FROM MICRO
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

LA XRC,RECPKT;
USE XRC AS PACKET IN BEGIN  % ADDRESSIBLE DSECT
RPACKBLK: DO BEGIN
ZR VRF;  % GOOD RETURN CODE
IF <TF TESTF> THEN BEGIN  % READ FROM FILE
GET TESTFILE;
ST VR1,TGETBUFA;  % STORE OFF ADDRESS
MZC TGETLEN,4;  % KLUDGE TO THE MOON
MMVC TGETLEN+2,0(VR1),2;  % KLUDGE TO THE MOON
%MTR 0(VR1),ETOA,130;  % KLUDGE CITY FOR READING TEST FILES
ZR VRF;
GOTO JUMPOVER;
END;

IF <TF TIMERF> | <TF SERVERF> THEN BEGIN  % ALWAYS NEED TIMER SERVER
% SET TIMER


STIMER REAL,TIMEEXIT,BINTVL=RTIMEOUT;
END;

IF <TF RTURNRND> THEN STIMER WAIT,BINTVL=RTURNTIM;  % TURNAROUND

POST ECBREAD,ECBTREAD;  % TELL ASYNC SUB TO GO FOR IT

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
TESTECB: WAIT ECB=ECBTGET;
MVI ECBTGET,0;  % ZERO HIGH ORDER
IF <CLI ECBTGET+3,ECBTREAD> THEN BEGIN  % TGET READ POSTED
IF <TF TIMERF> THEN TTIMER CANCEL;
ZR VRF;  % ZERO RETURN REGISTER
END
ELSE BEGIN
IF <CLI ECBTGET+3,ECBTIMER> THEN BEGIN  % TIMER-ECB POSTED
DETACH TASKADD;  % BLOW OFF TASK
MZC ECBREAD,4;  % ZERO OUT READ ECB
L XRB,TGETADD;  % ADDRESS OF TGET MODULE
IDENTIFY EP=KERMTGET,ENTRY=(XRB);

IF <RNZ  VRF> THEN BEGIN  % ERROR IN IDENTIFY
IF ^<CI VRF,4> THEN BEGIN
TPUT =C'ERROR IN IDENTIFY',17;
    DC F'0';  % BLOWUP
END;
END;
DELETE EP=KERMTGET   ;
% THEN REATTACH
ATTACH EP=KERMTGET,PARAM=((XRF));
IF <RNZ VRF> THEN BEGIN
END;
ST VR1,TASKADD;  % STORE OFF ADDRESS FOR DETACH
LI VRF,TIMERROR;  % TIME OUT LITERAL FOR RETURN CODE
EXIT FROM RPACKBLK;  % GET OUT
END
ELSE BEGIN
ERRORCON  'UNKNOWN POST VALUE ECB';
CCALL ERRPACK,A;  % PUT IN ERROR BUFFER
MVI TYPE,ACOMLIT;  % ABORT LITERAL
EXIT FROM RPACKBLK;
END;
END;



JUMPOVER: ;  % LABEL TO SKIP TO
L XRA,TGETBUFA;
IF <<MCLC 0(XRA),=C'stop',4> |
<MCLC 0(XRA),=C'STOP',4>> THEN BEGIN  % GET OUT user wants to stop
KLUDGCIT: IF <TF TIMERF> THEN TTIMER CANCEL;
SF STOPF;  % STOP
ERRORCON 'User entered STOP.  Transfer aborted.';
CCALL ERRPACK,A;
LI VRF,STOPFLAG;  % FOR RETURN CODE
EXIT FROM RPACKBLK;
END;
IF <TF SERVERF> THEN BEGIN
 % VIOLATE KERMIT HEURISTICS HERE BECAUSE THEY SAY TO

IF <<MCLC 0(XRA),=C'finish',6> |           % GET OUT IF SERVER
<MCLC 0(XRA),=C'FINISH',6>> THEN BEGIN  % GET OUT IF SERVER
ZF SERVERF;  % TURN OFF SERVER
ZR VRF;  % FOR RETURN CODE
EXIT FROM RPACKBLK;  % GET OUT IF SERVER
END;

END;  % OF SERVER FUNCTIONS
IF <MCLC 0(XRA),=C'ABORT',5> THEN DC XL4'00000000';
L VR1,TGETLEN;  % LENGTH OF STUFF GOTTEN
IF <RNP VR1> THEN BEGIN
LI VRF,TGETERR;  % ERROR FROM TGET
EXIT FROM RPACKBLK;
END;  % OF TGET ERROR
FOR VR1 DO BEGIN  % LOOP THROUGH LENGTH LOOKING FOR SOH
EXIT IF <MCLC (XRA),RSOH,1>;  % FOUND SOH
AI XRA,1;  % INCREMENT POINTER
IF <CI VR1,1> THEN BEGIN
ERRORCON 'No SOH on packet';
LI VRF,NOSOH;
EXIT FROM RPACKBLK;
END;
END;  % OF FOR LOOP

MMVC RECPKT,0(XRA),130;  % MOVE TO RECPACKET


IF <RNZ VRF> THEN BEGIN

ERRORCON 'Error in Tget from  Micro ';
CCALL ERRPACK,A;  % PUT IN ERROR BUFFER
MVI TYPE,ACOMLIT;  % ABORT LITERAL
EXIT FROM RPACKBLK;

END;  % OF ERROR OF TPUT
 L XRB,ETOAVCON; MTR LEN,0(XRB),1;  % TRANSLATE TO ASCII

ZR XRB;
IC XRB,LEN;  % GET LENGTH OF PACKET
UNCHAR XRB;  % MAKE PRINTABLE
L VR1,ATOEVCON; MTR LEN,0(VR1),1;  % TRANSLATE TO ASCII
LH XRA,BCCLEN;
AI XRA,2;  % MINIMAL PACKET SIZE
IF <CR XRB,XRA; CC L> | % ERROR PACKET TOO SMALL
<C XRB,MAXPACK; CC H> THEN BEGIN  % TOO LARGE
L VRF,LENERROR;
EXIT FROM RPACKBLK;
END;  % OF LENGTH ERROR ON RECEIVE
IF <OPENP DEBUG> THEN BEGIN  % DEBUGGING ON

MZC WRKBUFF,4;  % BLAST 1ST 4 BYTES
MVI WRKBUFF+1,19;
MMVC WRKBUFF+4,=C'TGET REC PACKET',15;

PUT   DEBUG,WRKBUFF;

AI XRB,2;  % BUMP LENGTH COUNTER TO INCLUDE HEADER

EXI XRB,MVC,WRKBUFF+4(*-*),PACKET,DECR=YES,INCR=YES;

AI XRB,4;  % FOR HEADER

STH XRB,WRKBUFF;
SI XRB,6;  % ADJUST LENGTH BACK TO ORIGINAL

PUT DEBUG,WRKBUFF;  % OUTPUT AGAIN

END;  % OF DEBUG BLOCK

AI XRB,2;  % BUMP LENGTH COUNTER
L VR1,ETOAVCON;
EXI XRB,TR,PACKET(*-*),0(VR1),DECR=YES,INCR=YES;  % CHANGE TO ASCII
SI XRB,1;  % RESTORE COUNTER

% SUBTRACT 1,2, OR 3 DUE TO BCC TYPE
SH XRB,BCCLEN;
LR VR0,XRB;  % GET LENGTH FIELD

CCALL BCCCALC,A,VR1=LEN;  % BCC COMPUTATION SUB

EXIT FROM RPACKBLK IF <C VRF,=X'FFFFFFFF'>;  % SOMETHING FUNNY
ZR VRF;  % OK RETURN WE HOPE

LA XRE,PACKET+1(XRB);  % CHECK THIS LATER
LH VR1,BCCLEN;
SI VR1,1;  % DECRMENT FOR EXECUTE\

 % %CHAR VRF;  % ASCII PRINTABLE
IF ^<EX VR1,CLMCOMP> THEN BEGIN

% ERROR IN BCC CHECK
% WRTERM ' BCC ERRROR CHECK IN RPACK ';
LI VRF,BCCERROR;
EXIT FROM RPACKBLK;
END;  % OF BCC ERROR


CCALL UNPACK,A,VR1=PACKET;


END;  % OF RPACKBLK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
CEXIT VRE,HIGHR;
LTORG;
EXORG;
CLMCOMP: MCLC 0(XRE),BCC,*-*;
END;  % OF DSECT PACKET

TIMERROR:    EQU      4;  % EQUATE FOR TIME OUT RETURN

BCCERROR:   EQU    8;  % INCORRECT BCC
NOSOH:   EQU 12;
STOPFLAG:   EQU     16;  % INDICATE A STOP
TGETERR:   EQU 20;  % ERROR FROM TGET ROUTINE
              DS   0F;
SUBTITLE 'UNPACK';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : UNPACK
% FUNCTION : TAKE A RECEIVE PACKET AND DECODES THE
%           PACKET LENGTH, SEQ NUMBER, AND DOES
% INPUT:    VR1-> SOH OF PACKET
%
%
% OUTPUT :  SEQ MVC TO RSEQ,L'RDATA STH IN RECLEN
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
UNPACK:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
USE XRA AS PACKET IN BEGIN
LR XRA,VR1;  % POINT TO PACKET
ZR XRB;
IC XRB,SEQ;  % GET RECEIVE SEQ
UNCHAR XRB;  % MAKE IT AN INTEGER;
STH XRB,RPSEQ;  % STORE OFF RECEIVED SEQ NUMBER
ZR XRB;
IC XRB,LEN;  % GET LENGTH TO CALCULATE DATA
UNCHAR XRB; SI XRB,2;  % SUB SEQ AND TYPE BYTES
SH XRB,BCCLEN;  % SUB OFF BLOCK CHECK LENGTH
STH XRB,RECLEN;
LA XRB,DATABUFF;
ST XRB,RECPNTR;  % POINTER TO RECEIVED DATA
END;  % OF DSECT
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;


SUBTITLE 'TIMEEXIT';
TIMEEXIT:
BALR BASER,0;
USING *,BASER;  % ADDRESSIBLITY
L XRF,PARMACON;
POST ECBTGET,ECBTIMER;  % POST TIMER ECB
RGOTO 14;  % RETURN TO OS
PARMACON:   DC   A(PARMS);  % WORKING STORAGE
SUBTITLE 'PUT BUFFER ';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   THIS ROUTINE PLACES INFO INTO OUTPUT BUFFER
%  CALLED BY KSEND
% VR1-> GET BUFFER
% VR0 = LENGTH OF GET BUFFER
% ROUTINE PUTS ALL INTO BUFFER AND CALLS SPACK
% WHEN NECESSARY
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PUTBUFF:
CENTER VRE,HIGHR,ENTRY=NO;
ST VR1,GETADD;  % ADDRESS OF GET
STH VR0,GETLEN;  % LENGTH OF GETS
PUTBLCK:
L VR1,GETADD;
L XRB,PUTADD;
LH XRA,MAXPUT;  % GET DIFFERENCE
SH XRA,PUTLEN;  % NUMBER OF CHARACTERS IN PUT BUFF
LH XRD,GETLEN;  % LENGTH OF IN PUT

EXI XRD,MVC,0(*-*,XRB),0(VR1),DECR=YES,INCR=YES;
AR XRB,XRD;  % UPDATE PUT ADDRESS
ST XRB,PUTADD;  % STORE OFF NEW OUT ADDRESS
LH XRA,PUTLEN;
AR XRA,XRD;  % UPDATE LENGTH
STH XRA,PUTLEN;
ZR VR0;  % NO MORE CHARACTERS TO PUT DROP OUT
MZC GETLEN,2;  % ZERO GET LENGTH
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'KRECEIVE';

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%     MODULE NAME   -   KRECEIVE
%
%
%     FUNCTION-   DRIVER FOR REC COMMAND DYNAL, OPEN,
%     FORMATS PACKETS, FILE HEADER, EOF ETC
%
%
%     INPUTS -
%
%
%
%
%     OUTPUTS-
%
%
%     RETURN
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KRECEIVE: ;
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LA XRC,SNDPKT;
USE XRC AS PACKET IN BEGIN  % DSECT FOR INIT
LA XRD,DATABUFF;
USE XRD AS SENDIDST IN BEGIN
RECBLCK: DO BEGIN  % GLOBAL REC BLOCK
MVI STATE,RECEIVE;
MZC STATLEN,2;  % ZERO OUT STATUS LENGTH
ZF WARNINGF;  % NO WARNINGS YET
MFC DSNAME,44;  % CLEAR OUT DATA SET NAME
BCCTYPE 1;  % 1 BCC BYTE AT END
IF <TF SERVERF> THEN <MZC DSNLEN,2; GOTO RGETINIT>;  % SERVER STUFF
SCERROR NEW=RECERR;  % SCAN OFF DSN

   SCAN *;
   SCKW ?,RECHELP;  % INFO
   SCKW ,REC1ST,B,LIMIT=AL1(44);  % DSN
   SCANEND;
%  IF HERE NO DSNAME
MZC DSNLEN,2;  % ZERO DATA SET NAME
GOTO RGETINIT;  % A GOTO I ADMIT

   EXIT FROM RECBLCK;  % LEAVE REC

RECHELP:
WRTERM 'RECEIVE receives a data set (file) from the microcomputer.';
WRTERM   'A corresponding SEND command must '_
       'be issued to the microcomputer';
WRTERM  'KERMIT after the RECEIVE is issued to TSO KERMIT.';
WRTERM 'The parameter is the data set name '_
   'to be used for the received data set.';
WRTERM 'If the parameter is omitted, the file name from the sender '_
   'is used as';
WRTERM 'the data set name.';
   EXIT FROM RECBLCK;  % LEAVE REC

RECERR:
SELECT FIRST;
<CI VRF,SCTCLXM>: WRTERM  'Data Set Name maximum 44 letters ';
ENDSEL
ELSE <WRTERM 'ERROR IN SCANNER IN REC MOD '>;

EXIT FROM RECBLCK;  % ERROR EXIT
REC1ST:  % THE BEEF
% STORE OFF POINTERS IN CASE MORE FILES
% SCBACK;  % BACK UP IN CASE A PDS MEMBER EXISTS
SCTELL;
DEBLANK VR1,VR0,XRA,TYPE=BOTH;  % STRIP OFF BLANKS
ST VR1,DSNADD;  % ADDRESS OF DSNAME
STH VR0,DSNLEN;  % LENGTH OF SCANNED NAME
LR XRA,VR0;  % FOR EXECUTE
CCALL CHKRDSN,A;  % ROUTINE CHECKS WHEATHER VALID DSN FOR RECEIVE
IF <RZ VRF> THEN CCALL OPENRDSN,A;  % OPEN THE FILE
IF <RZ VRF> THEN BEGIN  % GOOD DATA SET

RGETINIT: % GET INIT PACKET

IF ^<TF SERVERF> THEN WRTERM 'Ready to receive files';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5
%  CALL REC FILE SWITCH TABLE DRIVER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

CCALL RECSW,A;

END
ELSE BEGIN  % COULDN'T OPENDSN
IF <TF SERVERF> THEN BEGIN
CCALL SABORT,A,LH:VR0=RPSEQ;
END
ELSE <LH VR0,STATLEN; TPUT STATBUFF,(VR0)>;
END;
END;  % OF RECBLCK




USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;
END;  % OF DSECT
END;  % OF DSECT RECINIT
SUBTITLE 'RECUNALLOCATE ';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%5
% MOD: RECUNAL
% FUN: UNALLOCATES DSNAME FOR RECEIVE MOD
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RECUNAL:
CENTER VRE,HIGHR,ENTRY=NO;
         LA XRB,DSNAME;  % GET ADDRESS OF DSNAME
         DALLIST BEGIN,MF=(E,UALLOCD2),INIT=NO; BEGIN
            DALLIST TEXT,DUNDSNAM,(0(XRB),DSNSIZE);  % DSNAME
            DALLIST TEXT,DUNUNALC,MF=L;  % FORCE UNALLOCATION
            DALLIST END; END;
         DATA BEGIN  % DYNAMIC ALLOCATION PARAMETER LIST FOR
            % UNALLOCATION BY DSNAME

            UALLOCD2:
            DALLIST BEGIN,S99VRBUN,MF=L; BEGIN
               DALLIST TEXT,DUNDSNAM,(,DSNSIZE);  % DSNAME
               DALLIST TEXT,DUNUNALC;  % FORCE UNALLOCATION
               DALLIST END; END;
            END;
CEXIT VRE,HIGHR;
LTORG;

SUBTITLE 'RECSW';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : RECSW
% FUNCTION :  THIS ROUTINE DRIVES THE RECEIVE  MODULES,
%            EACH ROUTINE CHANGES THE STATE
% INPUT:
%
%
% OUTPUT :
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RECSW:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
%MVI HIGHBCC,3;  % INDICATE BLOCK CHECK TYPE
BCCTYPE 1;  % BLOCK CHECK TYPE
ZEROSEQ;  % ZERO SEQUENCE NUMBER
ZERORTRY;  % ZERO RETRY
MVI STATE,RISTATE;  % SEND INIT STATE
RSWTBLCK: DO BEGIN  % LOOP TILL EXIT
SELECT FIRST;
<TF STOPF>: <CCALL STOPPROC,A; EXIT FROM RSWTBLCK>;  % USER STOP
<CLI STATE,RISTATE>: CCALL RINIT,A;
<CLI STATE,RFSTATE>: CCALL RFILE,A;  % FILE HEADER PACKET
<CLI STATE,RDSTATE>: CCALL RDATAMOD,A;  % GET DATA PACKETS
<CLI STATE,SESTATE>: BEGIN  % ABORT
CCALL SABORT,A,VR0=LH:RPSEQ; EXIT FROM RSWTBLCK;  % ABORT
END;
<CLI STATE,RESTATE>: <CCALL RABORT,A; EXIT FROM RSWTBLCK>;  % ABORT
<CLI STATE,CSTATE>: EXIT FROM RSWTBLCK;  % COMPLETE STATE SPLIT
ENDSEL;
END FOREVER;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'RFILE';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : RFILE
% FUNCTION : Receives the f packet and decodes it
%            changes states
% INPUT:     none
%
%
% OUTPUT :  state = either 'C' complete  || 'B' EOT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RFILE:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
BUMPRTRY XRA;  % Increment retry counter
IF <MCLC NUMTRY,RETRY,4; CC NL> THEN  % Retry exceeded
MVI STATE,SESTATE  % Send abort state
ELSE RFILBLCK: DO BEGIN  % Receive file name
CCALL RPACK,A;
EXIT IF <TF STOPF>;  % Leave if user entered stop
IF <RNZ VRF> THEN BEGIN  % NACK if Timeout or Bad BCC
NACKPACK SEQNUM,VR0;  % NACK IT
EXIT FROM RFILBLCK;
END;  % OF ERROR
ZR XRA;  % clear for the case
MTRT RTYPE,COMMAND,1;  % Scan command type
DO BEGIN CASE XRA MAX SCASE MIN ECASE CHECK;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A SENDINIT PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

SCASE: BEGIN  % SEND INIT PACKET RECEIVED
BUMPOTRY VR0;
IF <MCLC OLDTRY,RETRY,4; CC NL>  % Retry exceeded
| ^<MCLC OLDSEQ,RPSEQ,2; CC NL> THEN  % MUST BE LAST SEQ
MVI STATE,SESTATE  % Send abort state
ELSE BEGIN  % Receive file name
CCALL SPAR,A,VR1=PDATA,VR0=LH:RECLEN;  % SET PARMS
SPSPACK AY,RPSEQ,RECLEN,VR0;
CCALL SPACK,A;
MZC NUMTRY,L'NUMTRY;  % % Zero retry counter
END;
END;  % OF REC INIT

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A EOF PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ZCASE: BEGIN  % EOF PACKET RECEIVED  - CLOSE OUT
BUMPOTRY VR0;
IF <MCLC OLDTRY,RETRY,4; CC NL>  % Retry exceeded
| ^<MCLC OLDSEQ,RPSEQ,2; CC NL> THEN  % MUST BE LAST SEQ
MVI STATE,SESTATE  % Send abort state
ELSE BEGIN  % Receive file name
SPSPACK AY,RPSEQ,ZERO,VR0;
CCALL SPACK,A;
MZC NUMTRY,L'NUMTRY;  % % Zero retry counter
CCALL CLOSERDS,A;  % CLOSE THE DATA SET
END;
END;  % OF REC EOF FOR THE SECOND TIME

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A ERROR PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ECASE: BEGIN  % Error abort
MVI STATE,RESTATE;  % RECEIVED ABORT
CCALL ERRPACK,A,VR1=RDATA,VR0=LH:RECLEN;
END;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A EOT PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

BCASE: BEGIN  % End of transmission
IF ^<MCLC SEQNUM,RPSEQ,2> THEN BEGIN  % MUST BE THE RIGHT PACKET
MVI STATE,SESTATE;  % SENDAN ABORT
ERRORCON 'Illegal packet sequence for eot in rfile- must abort';
CCALL ERRPACK,A;
END  % bad sequence number
ELSE BEGIN
ACKPACK SEQNUM,VR0;  % ACK IT
MVI STATE,CSTATE;  % LA FINE
END;
END;  % OF EOT

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A FILE PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

FCASE: BEGIN  % f packet with file name - what we want
IF ^<MCLC SEQNUM,RPSEQ,2> THEN BEGIN  % MUST BE THE RIGHT PACKET
MVI STATE,SESTATE;  % SENDAN ABORT
ERRORCON 'Illegal sequence for f packet in rfile- must abort';
CCALL ERRPACK,A;
END  % bad sequence number
ELSE BEGIN
IF <MCLC DSNLEN,ZERO,2> THEN BEGIN  % GET NAME FROM PACKET
CCALL DSNPACK,A,VR1=RDATA,VR0=LH:RECLEN;  % DECODE NAME
IF <RZ VRF> THEN CCALL OPENRDSN,A;  % OPEN THE NEXT FILE
IF <RNZ VRF> THEN MVI STATE,SESTATE ; % ABORT ON BOARD
EXIT FROM RFILBLCK IF <RNZ VRF>;  % ERROR ON OPEN
END;
ACKPACK SEQNUM,VR0;  % ACK IT
MMVC OLDTRY,NUMTRY,4;  % KEEP OLD COUNTER
ZERORTRY;  % A GOOD PACKET
BUMPSEQ VR0;  % NEXT SEQ NUMBER
MZC BUFCNT,2;  % ZERO BUFFER COUNTER
MZC DSNLEN,2;  % ZERO LENGTH OF DSN FOR NEXT ONE
L VR1,ADDBUF;  % BEGINNING OF BUFFER
ST VR1,BUFADD;  % POINTER TO PLACE IN BUFFER
ZF CRFLAG,QUO8FLAG;
MVI STATE,RDSTATE;  % CHANGE DATA TO RECEIVE DATA
END;  % OF GOOD F PACKET
END;  % OF F PACKET
ENDCASE
ELSE BEGIN

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED AN ILLEGAL PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ERRORCON 'Illegal packet type for rfile - transfer aborted';
CCALL ERRPACK,A;  % PUT IN BUFFERS
MVI STATE,SESTATE;  % SEND ABORT    STATE
END;
END;  % OK RETRY
END;  % of RFILBLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'RDATAMOD';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : RDATAMOD
% FUNCTION : Receives data packet and decodes them
%            also receives eof
% INPUT:     none
%
%
% OUTPUT :  state = either 'C' complete  || 'B' EOT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RDATAMOD:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
BUMPRTRY XRA;  % Increment retry counter
IF <MCLC NUMTRY,RETRY,4; CC NL> THEN  % Retry exceeded
MVI STATE,SESTATE  % Send abort state
ELSE RDATBLCK: DO BEGIN  % Receive file name
CCALL RPACK,A;
EXIT IF <TF STOPF>;  % Leave if user entered stop
IF <RNZ VRF> THEN BEGIN  % NACK if Timeout or Bad BCC
NACKPACK SEQNUM,VR0;  % NACK IT
EXIT FROM RDATBLCK;
END;  % OF ERROR
ZR XRA;  % clear for the case
MTRT RTYPE,COMMAND,1;  % Scan command type
DO BEGIN CASE XRA MAX FCASE MIN ECASE CHECK;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A FILE HEADER PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

FCASE: BEGIN  % FILE HEADER PACKET RECEIVED
BUMPOTRY VR0;
IF <MCLC OLDTRY,RETRY,4; CC NL>  % Retry exceeded
| ^<MCLC OLDSEQ,RPSEQ,2; CC NL> THEN  % MUST BE LAST SEQ
MVI STATE,SESTATE  % Send abort state
ELSE BEGIN  % Receive file name
SPSPACK AY,RPSEQ,ZERO,VR0;
CCALL SPACK,A;
MZC NUMTRY,L'NUMTRY;  % % Zero retry counter
END;
END;  % OF REC FILE HEADER

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A ERROR PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ECASE: BEGIN  % Error abort
MVI STATE,RESTATE;  % RECEIVED ABORT
CCALL ERRPACK,A,VR1=RDATA,VR0=LH:RECLEN;
END;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A EOF PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ZCASE: BEGIN  % End of file
IF ^<MCLC SEQNUM,RPSEQ,2> THEN BEGIN  % MUST BE THE RIGHT PACKET
MVI STATE,SESTATE;  % SENDAN ABORT
ERRORCON 'Illegal packet sequence for eof in rdata- must abort';
CCALL ERRPACK,A;
END  % bad sequence number
ELSE BEGIN
ACKPACK SEQNUM,VR0;  % ACK IT
BUMPSEQ VR0;
IF <MCLC BUFCNT,=H'0',2; CC H> THEN BEGIN  % SOMETHING TO WRITE
CCALL WRITEFIL,A;
%IF <MCLC DATA,=C'BINARY',6> THEN CCALL WRITEFIL,A;  % old
END;  % OF SOMETHING TO WRITE
IF <TF RECVDSNF> THEN CCALL CLOSERDS,A;  % CLOSE THE FILE
MVI STATE,RFSTATE;  % WE'RE DONE HERE
END;
END;  % OF EOT

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED A DATA PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

DCASE: BEGIN  % D packet with data - what we want
IF ^<MCLC SEQNUM,RPSEQ,2> THEN BEGIN  % WRONG PACKET NUMBER
BUMPOTRY VR0;
IF <MCLC OLDTRY,RETRY,4; CC L> THEN BEGIN  % HAVEN'T EXCEED RETRY
IF <MCLC OLDSEQ,RPSEQ,2> THEN BEGIN  % PREVIOUS PACKNUM JUST ACK
ACKPACK RPSEQ,VR0;  % ACK OLD ONE
MZC NUMTRY,L'NUMTRY;
EXIT FROM RDATBLCK;
END;
END;
MVI STATE,SESTATE;  % SENDAN ABORT
ERRORCON 'sequence error for D packet in rdata- must abort';
CCALL ERRPACK,A;
END  % bad sequence number
ELSE BEGIN
CCALL KGETBUFF,A,VR1=RDATA,VR0=LH:RECLEN;  % DECODE PACKET
ACKPACK SEQNUM,VR0;  % ACK IT
MMVC OLDTRY,NUMTRY,4;  % KEEP OLD COUNTER
ZERORTRY;  % A GOOD PACKET
BUMPSEQ VR0;  % NEXT SEQ NUMBER
END;
END;  % OF GOOD F PACKET
ENDCASE
ELSE BEGIN

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   RECEIVED AN ILLEGAL PACKET
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

ERRORCON 'Illegal packet type for rdata - transfer aborted';
CCALL ERRPACK,A;  % PUT IN BUFFERS
MVI STATE,SESTATE;  % SEND ABORT    STATE
END;
END;  % OK RETRY
END;  % of RDATBLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'RINIT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : RINIT
% FUNCTION : Receives the Send init packet and decodes it
%            changes states
% INPUT:     none
%
%
% OUTPUT :  state = either 'C' complete  || 'B' EOT
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RINIT:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
BUMPRTRY XRA;  % Increment retry counter
IF <MCLC NUMTRY,RETRY,4; CC NL> THEN  % Retry exceeded
MVI STATE,SESTATE  % Send abort state
ELSE RINIBLCK: DO BEGIN  % Send end of transmisision block
BCCTYPE 1;  % LOOK FOR 1 BCC ON REC INIT PACKET
IF ^<TF SERVERF> THEN CCALL RPACK,A;
EXIT IF <TF STOPF>;  % Leave if user entered stop
IF <RNZ VRF> THEN BEGIN  % NACK if Timeout or Bad BCC
NACKPACK SEQNUM,VR0;  % NACK IT
EXIT FROM RINIBLCK;
END;  % OF ERROR
ZR XRA;  % clear for the case
MTRT RTYPE,COMMAND,1;  % Scan command type
DO BEGIN CASE XRA MAX SCASE MIN ECASE CHECK;
RSTATE: BEGIN  % SEND INIT PACKET RECEIVED
CCALL RPAR,A,VR1=RDATA,VR0=LH:RECLEN;  % GET PARMS
CCALL SPAR,A,VR1=PDATA,VR0=LH:RECLEN;  % SET PARMS
SPSPACK AY,SEQNUM,RECLEN,VR0;
CCALL SPACK,A;
SELECT FIRST;
<CLI TRFBCC,1>: BCCTYPE 1;
<CLI TRFBCC,2>: BCCTYPE 2;
<CLI TRFBCC,3>: BCCTYPE 3;
ENDSEL;
ZERORTRY;  % % Zero retry counter
BUMPSEQ VR0;  % Increment packet counter
MVI STATE,RFSTATE;  % NEXT STATE  REC FILE HEADER
END;  % OF ACK
ECASE: BEGIN  % Error abort
MVI STATE,RESTATE;  % RECEIVED ABORT
CCALL ERRPACK,A,VR1=RDATA,VR0=LH:RECLEN;
END;
ENDCASE
ELSE BEGIN
ERRORCON 'Illegal packet type for rec init - transfer aborted';
CCALL ERRPACK,A;  % PUT IN BUFFERS
MVI STATE,SESTATE;  % SEND ABORT    STATE
END;
END;  % OK RETRY
END;  % of RINIBLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'DSNPACK';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : DSNPACK
% FUNCTION : Scans data set name from a received packet
%            calls scandsn to check if ok
% INPUT:     VR1-> DATA SET NAME
%            VR0=LENGTH OF DATA SET NAME
%
% OUTPUT :  VRF=0 A GOOD DSNAME ELSE INVALID NAME
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
DSNPACK:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
IF <RP VR0> THEN BEGIN  % GET NAME FROM SENDER
LR XRA,VR0;
L XRB,ATOEVCON;
EXI XRA,TR,0((*-*),VR1),0(XRB),DECR=YES,INCR=YES;
EXI XRA,TR,0((*-*),VR1),UPPER,DECR=YES,INCR=YES;  % UPPER

LA XRB,0(XRA,VR1);  % SET UP TO SCAN OFF BAD CHARACTERS
SI XRB,1;  % ONE LESS
WHILE <<CLI 0(XRB),C' '> | <CLI 0(XRB),C'.'>> DO
BEGIN  SI XRA,1; SI XRB,1; END;

LR VR0,XRA;  % LENGTH
END;  % OF NON LENGTH
CCALL CHKRDSN,A;  % CHECK THE DSNAME
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'CHKRDSN';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : CHKRDSN
% FUNCTION : Checks for a valid  data set name for a received
%            file calls scandsn to check if ok
% INPUT:     VR1-> DATA SET NAME
%            VR0=LENGTH OF DATA SET NAME
%
% OUTPUT :  VRF=0 A GOOD DSNAME ELSE INVALID NAME
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
CHKRDSN:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
CCALL SCANDSN,A;  % SET UP DATA SET NAME
CASE VRF MIN 0 MAX 20 CHECK;
0: BEGIN  % A GOOD RETURN;
END;
4: BEGIN  % GOOD RETURN PLUS PDS
ZR VRF;
END;
8: BEGIN  % WILD CARD
ERRORCON 'Asterisk illegal on receive - just leave blank';
END;
12: BEGIN  % NO LENGTH
ERRORCON 'No length on data set name';
END;
16: BEGIN  % ILLEGAL NAME
ERRORCON 'Non-standard data set name  ';
% LR XRA,VR0 ;
% EXI XRA,MMVC,OUTMESS,0(VR1),*-*,INCR=YES,DECR=YES ;
% LA VR1,OUTMESS ; % SET UP BUFFER
% AR VR1,XRA ;
% LH XRA,DSNLEN ;
% L XRB,DSNADD ;
% EXI XRA,MMVC,0(VR1),0(XRB),*-*,INCR=YES,DECR=YES ;
% AR VR0,XRA ; % GET LENGHT
% LA VR1,OUTMESS ;
END;
20: BEGIN  % NO MATCHING ENTRIES FROM WILD CARD
ERRORCON 'No matches in catalog for wildcard';
END;
ENDCASE ELSE
BEGIN  % ILLEGAL RETURN
ERRORCON 'Illegal data set name return';
END;
IF <RZ VRF> THEN BEGIN
LOCATE DATASET;  % DOES IT EXIT
IF <RZ VRF> THEN BEGIN  % DATASET EXISTS
IF ^<TF PDSF> THEN BEGIN  % PDS MUST EXIST
IF <TF SERVERF> THEN BEGIN
ERRORCON 'Data set exists - in server mode this causes termination';
CCALL ERRPACK,A;  % PUT IN OUTPUT BUFFER
MMVC TEMP,=C'NO',2;  % MAKE NEXT SECTION ABORT
END  % OF SERVER FUNCTION
ELSE BEGIN  % NON SERVER
WRTERM 'Data set exists - reply "YES" to destroy old file ';
TGET TEMP,3;
MTR TEMP,UPPER,3;  % UPSHIFT IT
END;  % OF NON SERVER
IF <MCLC TEMP,=C'YES',3> THEN BEGIN

SCRATCH DELDSN;  % DESTROY THE DATA SET

CATALOG UNCAT;  % UNCATALOGE IT
ZR VRF;  % GOOD RETURN
END  % OF NON PDS

ELSE BEGIN
ERRORCON 'Data set already exists';
CCALL ERRPACK,A;
MVI STATE,SESTATE;  % ABORT
LI VRF,4;  % ERROR RETURN
END;
END  % OF DELETION
ELSE BEGIN
   % ABORT THE SUCKER
% MVI STATE,SESTATE;
LI VRF,0;  %  GOOD  PDS - DO BUILDL HERE
END;  % OF NO
END  % OF EXISTIN G DATA SET
ELSE BEGIN
IF <TF PDSF> THEN BEGIN  % PDS'S MUST EXIST
ERRORCON 'PDS directory must exist - will create member -'_
         'must abort';
IF <TF SERVERF> THEN CCALL ERRPACK,A ELSE TPUT (VR1),(VR0);
MVI STATE,SESTATE;
LI VRF,4;  % NO GOOD
END  % PDS

ELSE ZR VRF;  % GOOD RETURN FOR NON-EXISTENT DATA SET
END;  % NON EXISTENT DATA SET
END  % GOOD VRF
ELSE BEGIN  % BAD DSN
CCALL ERRPACK,A;
END;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
OUTMESS: DS CL92 ;
LTORG;
EXORG;

SUBTITLE 'KGETBUFF';

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%     MODULE NAME   -   KGETBUFF
%
%
%     FUNCTION-   TAKES DATA VR1-> DATA
%            VR0=LENGTH    SEARCHES FOR QUOTE CHARACTES
%           UPDATES OUTPUT BUFFER, CALLS PUTEM WHICH WRITES FILE
%          AND PLACES ITEMS IN BUFFER
%     INPUTS -
%
%
%
%
%     OUTPUTS-
%
%
%     RETURN
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KGETBUFF: ;
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;


ST VR1,RDATAADD;
STH VR0,RDATALEN;

UNTIL <MCLC RDATALEN,=X'0000'> DO BEGIN

L XRB,RDATAADD;
LR VR1,XRB;
LH XRE,RDATALEN;
ZR XRA;  % ZERO FOR CASE IF NONE FOUND

EXI XRE,MTRT,0(XRB),RECTABLE,*-*,DECR=YES,INCR=YES;

% SEARCH FOR CONTROL CHARACTERS

CASELOOP: DO BEGIN
CASE XRA MAX CASEREPT MIN 0 CHECK;

0: BEGIN  % MOVE EM ALL
LR VR0,XRE;
CCALL PUTEM,A;  % PUT ALL IN OUT BUFFER
MZC RDATALEN,2;  % ZERO COUNTER
END;

CASEQUO: BEGIN  % A QUOTE CHARACTER
IF ^<CR VR1,XRB> THEN MOVEALL;  % MOVE OTHER STUFF
%IF <MCLC RDATALEN,=X'0001',2> THEN <SF QUOFLAG; MZC RDATALEN,2>
DO BEGIN
AI VR1,1;  % POINT TO CHARACTER
IF <MCLC DATA,=C'TEXT',4> THEN BEGIN
SELECT FIRST;
<CLI 0(VR1),X'4D'>: BEGIN
IF <MCLC 1(VR1),LFCR+2,2> |
<<CLI 1(VR1),X'26'> &  <MCLC 2(VR1),LFCR+2,2>> THEN BEGIN
CCALL WRITEFIL,A;
IF <CLI 1(VR1),X'26'> THEN DECRDATA VR0,5
ELSE DECRDATA VR0,4;
EXIT FROM CASELOOP;
END
ELSE BEGIN
CNTLLOC 0(VR1);  % PUT IT IN
ZR VR0;
LI VR0,1;
CCALL PUTEM,A;  % STICK IT IN BUFFER
IF <MCLC RDATALEN,=H'2',2> THEN SF CRFLAG ELSE ZF CRFLAG;
DECRDATA VR0,2;
EXIT FROM CASELOOP;
END;  % OF LFCR

END;
<CLI 0(VR1),X'4A'>: BEGIN
IF <TF CRFLAG> THEN BEGIN
LH VR0,BUFCNT;
SI VR0,1;  % CNTL LF LAST CHARACTER OMIT
STH VR0,BUFCNT;
CCALL WRITEFIL,A;
DECRDATA VR0,2;
EXIT FROM CASELOOP;
END
ELSE BEGIN
CNTLLOC 0(VR1);
LI VR0,1;
CCALL PUTEM,A;
DECRDATA VR0,2;
EXIT FROM CASELOOP;
END;  % OF ELSE

END;
<MCLC 0(VR1),TABCHAR#,1>:      BEGIN
IF <TF TABF> THEN BEGIN  % TAB FUNCTION


CCALL GETTABS,A;  % ROUTINE RETURNS NUMBER OF BLANKS NECESSARY
IF <RP VRF> THEN BEGIN
LR VR0,VRF;  % NUMBER OF BLANKS
CCALL PUTEM,A,VR1=ASCBLANK;  % PUT ASCII BLANKS IN FILE
END;  % OF TABBING EXISTS

DECRDATA VR0,2;  % DECREMENT BY TWO

EXIT FROM CASELOOP;

END;
END;  % OF SELECT

ENDSEL;
END;  % OF TEXT
SELECT FIRST;
<MCLC 0(VR1),QUOCHAR,1>: ;  % JUST DROP OUT CONTROL
<MCLC 0(VR1),BINQC,1>: ;  % DONT CNTL QUOTES
<MCLC 0(VR1),REPTCHAR,1>: DO IF ^<TF REPTF> THEN CNTLLOC 0(VR1);
ENDSEL

ELSE CNTLLOC 0(VR1);  % IT'S A CONTROL CHARACTER
LI VR0,1;
CCALL PUTEM,A;  % PUT IT IN BUFFER
AR VR1,VR0;
ST VR1,RDATAADD;  % NEW ADD ADDRESS
LH VR0,RDATALEN;
SI VR0,2;
STH VR0,RDATALEN;  % STORE OFF NEW LENGTH

END;  % OF ELSE SELECT
END;

CASE8BIT: BEGIN
IF ^<CR VR1,XRB> THEN MOVEALL;  % MOVE OTHER STUFF
EIGHTBLK: DO BEGIN
AI VR1,1;  % POINT TO CHARACTER
IF <MCLC DATA,=C'TEXT',4> THEN BEGIN
CCALL ATOE8BIT,A  ; % ERROR NO REAL HIGH ORDER BITS ON
DECRDATA VR0,1 ; %
EXIT FROM EIGHTBLK ; % LEAVE BLOCK
END ;

IF <MCLC 0(VR1),QUOCHAR,1> THEN BEGIN
IF <MCLC RDATALEN,=X'0003'; CC NL> THEN BEGIN
DECRDATA VR0,3;  % DECREMENT RDATA
AI VR1,1;
END
ELSE BEGIN
SF QUO8FLAG;
SF QUOFLAG;
MZC RDATALEN,2;  % OUTTA HERE
EXIT FROM CASELOOP;
END;  % OF ONLY 2 LEFT AND QUOTED
SELECT FIRST;
<MCLC 0(VR1),QUOCHAR,1>: ;  % JUST DROP OUT CONTROL
<MCLC 0(VR1),BINQC,1>: ;  % DONT CNTL QUOTES
<MCLC 0(VR1),REPTCHAR,1>: DO IF ^<TF REPTF> THEN CNTLLOC 0(VR1);
ENDSEL

ELSE CNTLLOC 0(VR1);  % IT'S A CONTROL CHARACTER
END  % OF QUOTE CHARACTER
ELSE BEGIN  % ANY OTHER CHARACTER DECR = 2
LH VR0,RDATALEN;
SI VR0,2;
STH VR0,RDATALEN;
END;
OI 0(VR1),X'80';  % OR TURN ON HIGH ORDER BIT
ZR VR0;
LI VR0,1;  % ONE CHARACTER
CCALL PUTEM,A;
AI VR1,1;  % INCREMENT TO NEXT
ST VR1,RDATAADD;  % POINTER TO NEX

END;  % OF ELSE
END;  % CASE8BIT

CASEREPT:   BEGIN  % REPEAT CHARACTER
IF <MCLC RDATALEN,=H'3'; CC L> THEN BEGIN  % NOT ENOUGH
WRTERM 'ERROR IN REPEAT COUNT IN RECEIVE';
END
ELSE BEGIN
IF ^<CR VR1,XRB> THEN MOVEALL;  % MOVE OTHER STUFF
AI VR1,1;  % POINT TO LENGTH CHARACTER
ZR VR0; IC VR0,0(VR1);
UNCHAR VR0;  % GET THE LENGTH
IF <CI VR0,94; CC H> | <RNP VR0> THEN BEGIN  % SIZE ERROR
WRTERM 'REPEAT COUNT TOO LARGE ON RECEIVE 94 MAXIMUM';
END;  % OF TOO LARGE
AI VR1,1;  % POINT TO NEXT
ZR XRA; LI XRA,3;  % DEFAULT LENGTH TO DECREMENT
ZF HIGHBITF;  % TURN OFF FLAG
SELECT;
<MCLC 0(VR1),BINQC,1>: BEGIN  % 8 BIT QUOTING
AI VR1,1;  % MOVE POINTER
AI XRA,1;  % DECREMENT LENGTH
SF HIGHBITF;  % SET 8 BIT INDICATOR
END;  % 8 BIT SELECT

<MCLC 0(VR1),QUOCHAR,1>: BEGIN  % A CNTRL CHARACTER
AI XRA,1;  % BUMP DECREMENT COUNTER
AI VR1,1;  % POINT TO CHARACTER
SELECT FIRST;
<CLI 0(VR1),X'7E'>: ;  % JUST DROP THROUGH DEL CHARACTER

<MCLC 0(VR1),QUOCHAR,1>: BEGIN  % JUST DROP OUT CONTROL
%IF <TF HIGHBITF> THEN CNTLLOC 0(VR1);  %
END;
<MCLC 0(VR1),BINQC,1>: BEGIN  % DONT CNTL QUOTES
%IF <TF HIGHBITF> THEN CNTLLOC 0(VR1);  %
END;
<MCLC 0(VR1),TABCHAR#,1>: BEGIN  % DONT CNTL QUOTES
IF ^<TF HIGHBITF> THEN BEGIN
IF <TF TABF> & <MCLC DATA,=C'TEXT',4> THEN BEGIN  % TAB FUNCTION
ZR XRB; LR XRB,VR0;  % LOAD COUNT FOR FOR STATEMENT
FOR XRB DO BEGIN  % LOOP THROUGH NUMBER OF TABS
CCALL GETTABS,A;  % ROUTINE RETURNS NUMBER OF BLANKS NECESSARY
IF <RP VRF> THEN BEGIN
LR VR0,VRF;  % NUMBER OF BLANKS
CCALL PUTEM,A,VR1=ASCBLANK;  % PUT ASCII BLANKS IN FILE
END;  % OF TABBING EXISTS
END;  % OF FOR LOOP FOR XRB TIMES
DECRDATA VR0,4;  % DECREMENT BY TWO

EXIT FROM CASELOOP;

END
ELSE CNTLLOC 0(VR1);  % CONTROL IT
END  % OF NON HIGH ORDER ON
ELSE CNTLLOC 0(VR1);  % CONTROL IT
END;  % END OF TAB
<MCLC 0(VR1),REPTCHAR,1>: DO IF ^<TF REPTF> THEN CNTLLOC 0(VR1);
ENDSEL
ELSE CNTLLOC 0(VR1);  % CONTROL IT
END;  % OF SECOND SELECT

ENDSEL;
IF <TF HIGHBITF> THEN BEGIN  % TURN ON HIGH BIT
IF ^<MCLC DATA,=C'TEXT',4> THEN OI 0(VR1),X'80'  % TURN ON HIGH BIT
ELSE CCALL ATOE8BIT,A;
END;  % CHECK FOR CONVERSION ERRORS
SELECT FIRST;
<CI XRA,3>: DECRDATA XRA,3;  % 3 CHARACTERS
<CI XRA,4>: DECRDATA XRA,4;  % 4 CHARACTERS
<CI XRA,5>: DECRDATA XRA,5;  % 5 CHARACTERS
ENDSEL;
LR XRA,VR0;  % LENGTH TO REPEAT
IF <RP XRA> THEN BEGIN
SI XRA,1;  % ONE LESS CAUSE ALREADY USED ONE
MMVC REPTBUFF,0(VR1),1;  % PUT IN FIRST CHARACTER
EXI XRA,MMVC,REPTBUFF+1,REPTBUFF,*-*,DECR=YES;  % PUT IN REPEATS
CCALL PUTEM,A,VR1=REPTBUFF;  % PUT EM IN OUTPUT BUFFER

END;
END;  % OF LONG ENOUGH
EXIT FROM CASELOOP;
END;  % OF REPEAT CASE


ENDCASE
ELSE BEGIN
WRTERM ' ERROR IN GETBUF SUB CASE ';
END;
END;  % OF CASE LOOP

LH VR0,RDATALEN;  % PICK UP LENGTH
END;  % OF UNTIL 0 DATA
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;

%    SOME EQUATES
CASEQUO:    EQU  4;  % HASH FOR TABLE
CASE8BIT:    EQU  8;  % HASH FOR TABLE 8BIT
CASEREPT:    EQU  12;  % HASH FOR REPEAT CHARACTER
SUBTITLE 'PUTEM ';
%%%%%%%%%%%%%%%%%%%%%%%%%%
%   MODULE PUTEM
%%%%%%%%%%%%%%%%%%%%%%%%%%

PUTEM:
CENTER VRE,HIGHR,ENTRY=NO;

IF <TF QUO8FLAG> THEN <OI 0(VR1),X'80'; ZF QUO8FLAG>;  % QUOTE LAST
LR XRA,VR0;  % LOAD FOR EXECUTE AND LATER
L XRB,ADDBUF;  % ADDRESS OF BUFFER
AH XRB,BUFCNT;  % INCREMENT INTO BUFFER

LR XRE,VR0;  % LENGTH IF TOO LONG
DO BEGIN
IF <CLI XRE,255; CC H> THEN <LI XRA,255; SI XRE,255>
ELSE <LR XRA,XRE; ZR XRE;>;


EXI XRA,MMVC,0(XRB),0(VR1),*-*,INCR=YES,DECR=YES;

IF <MCLC DATA,=C'TEXT',4>  THEN  BEGIN
L XRC,ATOEVCON;
EXI XRA,MTR,0(XRB),0(XRC),*-*,INCR=YES,DECR=YES;  % TRANSLATE IT
END;  % OF TEXT
END;  % OF TRANSLATES
LR XRA,VR0;  % RESTORE
AH XRA,BUFCNT;  % INCREMENT BUFFER COUNTER

STH XRA,BUFCNT;

%SELECT FIRST;
IF <CH XRA,MAXWRITE; CC H> THEN  BEGIN  % MORE CHAR THAN LRECL SIZE

% IF BINARY WRITE - IF TEXT TRUNCATION ONLY RIGHT ON REQUEST

%IF <MCLC DATA,=C'BINARY',6> THEN BEGIN
MMVC BUFCNT,MAXWRITE,2;  % WRITE MAXWRITE'S WORTH
CCALL WRITEFIL,A;  % OUTPUT THE RECORD
SH XRA,MAXWRITE;  % GET REMAINDER
L XRB,ADDBUF;
LR VR1,XRB;  % SET UP FOR MOVE
AH XRB,MAXWRITE;  % INDEX FOR MOVE
EXI XRA,MMVC,0(VR1),0(XRB),*-*,INCR=YES,DECR=YES;
% SH XRA,LRECL;  % SUB OFF LRECL
STH XRA,BUFCNT;  % UPDATE BUF COUNTER
%END;  % OF BINARY - TEXT JUST FALLS THROUGH
%
END;  % OF MORE CHARACTERS

%<CH XRA,MAXWRITE; CC =>: BEGIN  % MAXWRITE EQUALS CHARACTERS
%
%%IF <MCLC DATA,=C'BINARY',6> THEN BEGIN
%CCALL WRITEFIL,A;  % OUTPUT THE RECORD
%MZC BUFCNT,2;  % ZERO COUNTER
%%END;  % OF BINARY - TEXT JUST FALLS THROUGH
%END;  % OF EQUAL SELECT
%
%<CH XRA,MAXWRITE; CC L>: ;  % NO OP JUST FALL THRU

%ENDSEL;
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'OPENSDSN';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : OPENSDSN
% FUNCTION :   OPENS AND ALLOCATES THE DATA SET KERIN
%              CALLED BY SEND FUNCTIONS
% INPUT:       NONE
%
%
% OUTPUT :     VRF=0 GOOD OPEN, VRF=4 ERROR
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
OPENSDSN:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
KINBLCK: DO BEGIN

MMVC KERMDDNM,=C'KERIN   ',8;  % SET UP DDNAME
IF ^<TF PDSF> THEN  BEGIN  % A REGULAR DATA SET
   DALLIST BEGIN,MF=(E,KFILEIN),INIT=NO; BEGIN
      DALLIST TEXT,DALDDNAM,(KERMDDNM,8);  % DDNAME
      DALLIST TEXT,DALDSNAM,(DSNAME,DSNSIZE);  % DSNAME
      DALLIST TEXT,DALSTATS,(X'08',1,'STC');  % STATUS SHARE
      DALLIST END; END;
      END
      ELSE  BEGIN  % A PDS MEMBER
   DALLIST BEGIN,MF=(E,KFPDSIN),INIT=NO; BEGIN
      DALLIST TEXT,DALDDNAM,(KERMDDNM,8);  % DDNAME
      DALLIST TEXT,DALDSNAM,(DSNAME,DSNSIZE);  % DSNAME
      DALLIST TEXT,DALSTATS,(X'08',1,'STC');  % STATUS SHARE
      DALLIST TEXT,DALMEMBR,(DSMEMBER,8);  % MEMBER NAME
      DALLIST END; END;
      END;  % PDS
ST VRF,DACKRC;  % RETURN CODE FROM ALLOCATE
   IF <RNZ VRF> THEN BEGIN  % ERROR IN ALLOCATION?
IF <TF PDSF> THEN L VR1,KFPDSIN
ELSE L VR1,KFILEIN;  % POINT TO DYNAL BLOCK
IF <CI VRF,16> & <MCLC 4(VR1),=X'035C0002',4> THEN BEGIN
ERRORCON 'Non-Standard MVS data set name' ;
CCALL ERRPACK,A ;
MVI STATE,ASTATE ;
IF ^<TF SERVERF> THEN TPUT (VR1),(VR0) ;
END
ELSE CCALL DYNERR,A;  % CALL ERROR ROUTINE

EXIT FROM KINBLCK;
      END;
DATA BEGIN  % DYNAMIC ALLOCATION PARAMETER LIST FOR INPUT DATA SET

      KFILEIN:
      DALLIST BEGIN,S99VRBAL,_
      FLAGS1=(S99NOMNT),_
      ERROR=KERMERR,INFO=KERMINFO,MF=L; BEGIN
         DALLIST TEXT,DALDDNAM,(,8);  % DDNAME
         DOUDSNAM:
         DALLIST TEXT,DALDSNAM,(,DSNSIZE);  % DSNAME
         DALLIST TEXT,DALSTATS,X'08';  % STATUS
         DALLIST END; END;
      KFPDSIN:
      DALLIST BEGIN,S99VRBAL,_
      FLAGS1=(S99NOMNT),_
      ERROR=KPDSERR,INFO=KPDSINFO,MF=L; BEGIN
         DALLIST TEXT,DALDDNAM,(,8);  % DDNAME
         DALLIST TEXT,DALDSNAM,(,DSNSIZE);  % DSNAME
         DALLIST TEXT,DALSTATS,X'08';  % STATUS
        DALLIST TEXT,DALMEMBR,(,8);  % PDS MEMBER
         DALLIST END; END;
      END;

% MAKE SURE NON EDIT FORMAT

IF <MCLC DATA,=C'BINARY',6> THEN BEGIN
CALL EDSET,(EDCNTRL,EDRETURN,SIX,TWO,TEMP,EDLEN);

END ;
CALL EDOPEN,(EDCNTRL,EDRETURN,KERMDDNM,ONE);
IF ^<MCLC EDRETURN,ZERO,4> THEN BEGIN  % FILE OPEN FAIL
ZF SENDDSNF;  % INDICATE NOT OPEN
CALL EDMSG,(EDCNTRL,EDRETURN,EDLINE,EDLMAX2,EDLENACT);
L VR0,EDLENACT;
CCALL ERRPACK,A,VR1=EDLINE;  % OUTPUT IT
LI VRF,4;  % ABORT IT
EXIT FROM KINBLCK;
END
ELSE SF SENDDSNF;  % OPEN INDICATOR
ZF KINEOF;  % END OF FILE INDICATOR
CALL EDSHOW,(EDCNTRL,EDRETURN,ONEOONE,TEMP,EDLINE,EDLMAX2,EDLENACT);

SELECT FIRST;
<CLI EDLINE,C'V'>: MVI RRECFM,C'V';
<CLI EDLINE,C'F'>: MVI RRECFM,C'F';
<CLI EDLINE,C'U'>: MVI RRECFM,C'U';
ENDSEL
ELSE BEGIN

ERRORCON '  Only V, U  and F RECFM supported  ';
CCALL ERRPACK,A;  % PUT IN BUFFER
MVI STATE,ASTATE;  % ABORT IT
LI VRF,4;  % ERROR

END;  % ELSE SELECT
ZR VRF;  % INDICATE A GOOD OPEN
END;  % OF KINBLCK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;



SUBTITLE 'OPENRDSN';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : OPENRDSN
% FUNCTION :   OPENS   DATA SET KEROUT FOR DOWNLOAD TO MICRO
%              GETS SPACE FOR FILE BUFFER
% INPUT:       OPENS DSNAME AND IF PDS DSMEMBER
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
OPENRDSN:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

OPENOBLK: DO BEGIN  % BLOCK TO FALL OUT OF
MMVC KERMDDNM,=C'KEROUT  ',8;  % SET UP DDNAME

IF ^<TF PDSF> THEN BEGIN  % NON PDS

LH VR0,LRECL;
ST VR0,TEMP;
CALL EDSET,(EDCNTRL,EDRETURN,ONE,TEMP,TEMP,EDLEN);  % LRECL
LH VR0,BLKSIZE;
ST VR0,TEMP;
CALL EDSET,(EDCNTRL,EDRETURN,TWO,TEMP,TEMP,EDLEN);  % BLKSIZE
IF <TF EDITF> & ^<MCLC DATA,=C'BINARY',6> THEN BEGIN
CALL EDSET,(EDCNTRL,EDRETURN,SIX,ONE,TEMP,EDLEN);
END
ELSE  % NON EDIT FORMAT
CALL EDSET,(EDCNTRL,EDRETURN,SIX,TWO,TEMP,EDLEN);
IF <CLI RFM,C'U'> | <CLI RFM+1,C' '>  THEN  % UNDEFINED OR UNBLOCKED
CALL EDSET,(EDCNTRL,EDRETURN,ONEOONE,TEMP,RFM,ONE)
ELSE  CALL EDSET,(EDCNTRL,EDRETURN,ONEOONE,TEMP,RFM,TWO);

% CALL EDNGEN,(EDCNTRL,EDRETURN,TWO,ONE,ONE);  %
END;  % ON NON PDS
LOCATE DATASET;  % DOES IT EXIST
IF <RZ VRF> THEN BEGIN  % DATASET EXISTS
IF ^<TF PDSF> THEN BEGIN
ERRORCON 'Data set already exists';
CCALL ERRPACK,A;
MVI STATE,SESTATE;
EXIT FROM OPENOBLK;  % NO FILE
END;  % ON NON PDS
END;  % OF NO
IF <TF PDSF> THEN BEGIN
MVI OUTSTATS,X'01';  % ANOLD VOLUME
MVI OUTNDISP,X'08';  % DISPOSITION CATALOG
MVI OUTCDISP,X'08';  % DISPOSITION KEEP
END
ELSE BEGIN
MVI OUTSTATS,X'04';  % A NEW VOLUME
MVI OUTNDISP,X'02';  % DISPOSITION CATALOG
MVI OUTCDISP,X'02';  % DISPOSITION CATALOG
END;
IF <MCLC DATA,=C'BINARY'> THEN BEGIN  % NO LINE NUMBERS
CALL EDNCOL,(EDCNTRL,EDRETURN,ONE,EDCOL1,EDCOL2);
END  % OF BINARY FILE
ELSE BEGIN  % TEXT FILE
IF ^<TF EDITF> THEN
CALL EDNCOL,(EDCNTRL,EDRETURN,EDTYPE,EDCOL1,EDCOL2);
IF ^<MCLC EDTYPE,ONE,4> THEN BEGIN

CALL EDNGEN,(EDCNTRL,EDRETURN,TWO,ONETHOU,ONETHOU);
END;
END;  % OF TEXT FILE
CCALL KRDYNAL,A;  % CALL DYNAL SUB

IF <RNZ VRF> THEN BEGIN  % ERROR IN DYNAL
MVI STATE,SESTATE;
EXIT FROM OPENOBLK;  % NONE ZERO PROBLEM
END;  % OF DYNAL ERROR


CALL EDOPEN,(EDCNTRL,EDRETURN,KERMDDNM,ONEOONE);  % OUTPUT
IF ^<MCLC EDRETURN,ZERO,4> THEN BEGIN  % FILE OPEN FAIL
CALL EDMSG,(EDCNTRL,EDRETURN,EDLINE,EDLMAX2,EDLENACT);
L VR0,EDLENACT;  % LENGTH OF MESSAGE
CCALL ERRPACK,A,VR1=EDLINE;  % PUT IN OUTPUT BUFFER
MVI STATE,SESTATE;  % ABORT IT
EXIT FROM OPENOBLK;
END
ELSE SF RECVDSNF;  % OPEN FLAG INDICATOR

CALL EDSHOW,(EDCNTRL,EDRETURN,ONEOONE,TEMP,EDLINE,EDLMAX2,EDLENACT);
MMVC RRECFM,EDLINE,1;  % RETURNED REC FORMAT

CALL EDSHOW,(EDCNTRL,EDRETURN,THREE,TEMP,EDLINE,EDLMAX2,EDLENACT);
MMVC MAXWRITE,TEMP+2,2;  % SIZE OF BUFFER

AI XRA,200;  % EXTRA SPACE FOR BUFFER

GETMAIN RC,LV=32777,SP=7;  % GET MAIN FOR WORKBUFFER

IF <RNZ VRF> THEN BEGIN

ERRORCON ' GET MAIN ERROR - NO ENOUGH REGION FOR RECEIVE BUFFER ';
CCALL ERRPACK,A;
MVI STATE,SESTATE;
END;  % OF FAILED GETMAIN

ST VR1,ADDBUF;  % ADDRESS OF STORAGE

END;  % OF OPENOBLK

USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
CEXIT VRE,HIGHR;
LTORG;
SUBTITLE 'KRDYNAL';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   MODULE - R DYNAL
%   FUNCTION - PERFORMS DYNAMIC ALLOCATION
% FOR RECEIVE MODULE
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
KRDYNAL:

CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
ZR VRF;  % ZERO REGISTER
IF <TF PDSF> THEN BEGIN  % WE HAVE A PDS
MZC LTRK,4;  % TRACKS
MZC LPRIME,4;
MZC LSECND,4;
MZC LRLSE,4;
MZC LVLSER,4;
MMVC PDSMEM1,PDSMEM2,4;  % INDICATE MEMBER
MMVC PDSORG1,PDSORG2,4;
END  % OF PDS
ELSE BEGIN
MZC PDSMEM1,4;  % INDICATE NO MEMBER
MZC PDSORG1,4;
MMVC LTRK,TTRK,4;  % TRACKS
MMVC LPRIME,TPRIME,4;
MMVC LSECND,TSECND,4;
MMVC LRLSE,TRLSE,4;
L XRA,TMPDISKA;
LH XRB,TMPDISKL;
LA VR1,VOLUME;
IF <EXI XRB,MCLC,0(XRA),0(VR1),*-*,INCR=YES,DECR=YES> THEN BEGIN
AR VR1,XRB;  % POINT TO END
LI XRC,6;  % VOL LENGTH
SR XRC,XRB;  % REMAINING BLANKS
IF <EXI XRC,MCLC,0(VR1),BLANKS,*-*,INCR=YES,DECR=YES> THEN
MZC LVLSER,4      % LET SYSTEM FIND THE VOLUME
ELSE MMVC LVLSER,TVLSER,4;
END
ELSE MMVC LVLSER,TVLSER,4;
END;  % OF NON PDS
DO BEGIN
   DALLIST BEGIN,MF=(E,NOVOL),INIT=NO; BEGIN  % LET SYSTEM SELECT
      DALLIST TEXT,DALDDNAM,(KERMDDNM,8);  % DDNAME
      DALLIST TEXT,DALDSNAM,(DSNAME,DSNSIZE);  % DSNAME
      DALLIST TEXT,DALMEMBR,(DSMEMBER,8);  % MEMBER NAME
%      DALLIST TEXT,DALUNIT,(OUTUNIT,8);  % UNIT ADDRESS
      DALLIST TEXT,DALSTATS,(OUTSTATS,1);  % STATUS
      DALLIST TEXT,DALNDISP,(OUTNDISP,1);  % NORMAL DISPOSITION
      DALLIST TEXT,DALCDISP,(OUTCDISP,1);  % CONDITIONAL DISPOSITION
      DALLIST TEXT,DALTRK,MF=L;  % SPACE IN TRACKS
      DALLIST TEXT,DALPRIME,(TRACK+1,3);  % PRIMARY SPACE
      DALLIST TEXT,DALSECND,(TRACK+1,3);  % SECONDARY SPACE
      DALLIST TEXT,DALRLSE,MF=L;  % RELEASE UNUSED SPACE (RLSE)
      DALLIST TEXT,DALRTVOL,(,6);  % VOLUME SERIAL NUMBER IS TO BE
      DALLIST TEXT,DALDSORG,(PO,2);
      DALLIST TEXT,DALVLSER,(VOLUME,6);  % VOLUME SERIAL NUMBER
      DALLIST END; END;
      END;

ST VRF,DACKRC;  % RETURN CODE FROM ALLOCATE
   DATA BEGIN  % DYNAMIC ALLOCATION PARAMETER LIST FOR OUTPUT DATA SET

      NOVOL:
      DALLIST BEGIN,S99VRBAL,_
      FLAGS1=(S99NOMNT),_
      ERROR=DEFERR,INFO=DEFINFO,MF=L; BEGIN
         DALLIST TEXT,DALDDNAM,(,8);  % DDNAME
         DALLIST TEXT,DALDSNAM,(,DSNSIZE);  % DSNAME
PDSMEM1:
        DALLIST TEXT,DALMEMBR,(,8);  % PDS MEMBER
%         DALLIST TEXT,DALUNIT,(,8);  % UNIT ADDRESS
         DALLIST TEXT,DALSTATS,(,1);  % STATUS
         DALLIST TEXT,DALNDISP,(,1);  % NORMAL DISPOSITION
         DALLIST TEXT,DALCDISP,(,1);  % CONDITIONAL DISPOSITION
LTRK:   % TRACKS
         DALLIST TEXT,DALTRK;  % SPACE IN TRACKS
LPRIME:
         DALLIST TEXT,DALPRIME,(,3);  % PRIMARY SPACE
LSECND:
         DALLIST TEXT,DALSECND,(,3);  % SECONDARY SPACE
LRLSE:
         DALLIST TEXT,DALRLSE,MF=L;  % RELEASE UNUSED SPACE (RLSE)
RECVOL:
         DALLIST TEXT,DALRTVOL,(,6);  % RETURN VOLUME SERIAL
PDSORG1:
        DALLIST TEXT,DALDSORG,(,2);
LVLSER:
         DALLIST TEXT,DALVLSER,(,6);  % VOLUME SERIAL NUMBER
         DALLIST END; END;
      END;
MMVC TSOVOL,RECVOL+6,6;  % RETURNED VOLUME NAME

%END;  % OF DEFAULT
DATA BEGIN  % A SPECIFIC VOLUME
DO BEGIN
   DALLIST BEGIN,MF=(E,MOVEOUT),INIT=NO; BEGIN
      DALLIST TEXT,DALDDNAM,(KERMDDNM,8);  % DDNAME
      DALLIST TEXT,DALDSNAM,(DSNAME,DSNSIZE);  % DSNAME
      DALLIST TEXT,DALMEMBR,(DSMEMBER,8);  % MEMBER NAME
%      DALLIST TEXT,DALUNIT,(OUTUNIT,8);  % UNIT ADDRESS
      DALLIST TEXT,DALVLSER,(VOLUME,6);  % VOLUME SERIAL NUMBER
      DALLIST TEXT,DALSTATS,(OUTSTATS,1);  % STATUS
      DALLIST TEXT,DALNDISP,(OUTNDISP,1);  % NORMAL DISPOSITION
      DALLIST TEXT,DALCDISP,(OUTCDISP,1);  % CONDITIONAL DISPOSITION
      DALLIST TEXT,DALTRK,MF=L;  % SPACE IN TRACKS
      DALLIST TEXT,DALPRIME,(TRACK+1,3);  % PRIMARY SPACE
      DALLIST TEXT,DALSECND,(TRACK+1,3);  % SECONDARY SPACE
      DALLIST TEXT,DALRLSE,MF=L;  % RELEASE UNUSED SPACE (RLSE)
      % FROM DATA SET ASSOCIATED WITH THIS DDNAME
      % RETURNED
      DALLIST END; END;
      END;

ST VRF,DACKRC;  % RETURN CODE FROM ALLOCATE
   DATA BEGIN  % DYNAMIC ALLOCATION PARAMETER LIST FOR OUTPUT DATA SET

      MOVEOUT:
      DALLIST BEGIN,S99VRBAL,_
      FLAGS1=(S99NOMNT),_
      ERROR=MOUTERR,INFO=MOUTINFO,MF=L; BEGIN
         DALLIST TEXT,DALDDNAM,(,8);  % DDNAME
         DALLIST TEXT,DALDSNAM,(,DSNSIZE);  % DSNAME
PDSMEM2:
        DALLIST TEXT,DALMEMBR,(,8);  % PDS MEMBER
%         DALLIST TEXT,DALUNIT,(,8);  % UNIT ADDRESS
TVLSER:
         DALLIST TEXT,DALVLSER,(,6);  % VOLUME SERIAL NUMBER
         DALLIST TEXT,DALSTATS,(,1);  % STATUS
         DALLIST TEXT,DALNDISP,(,1);  % NORMAL DISPOSITION
         DALLIST TEXT,DALCDISP,(,1);  % CONDITIONAL DISPOSITION
TTRK:
         DALLIST TEXT,DALTRK;  % SPACE IN TRACKS
TPRIME:
         DALLIST TEXT,DALPRIME,(,3);  % PRIMARY SPACE
TSECND:
         DALLIST TEXT,DALSECND,(,3);  % SECONDARY SPACE
TRLSE:
         DALLIST TEXT,DALRLSE,MF=L;  % RELEASE UNUSED SPACE (RLSE)
PDSORG2:
        DALLIST TEXT,DALDSORG,(,2);
         DALLIST END; END;
      END;






END;

ST VRF,TEMP+4;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
ST VRF,DACKRC;  % RETURN CODE FROM ALLOCATE
   IF <RNZ VRF> THEN BEGIN  % ERROR IN ALLOCATION?
L VR1,NOVOL;

CCALL DYNERR,A;  % CALL ERROR SUB

%WRTERM 'Error in Dynamic Allocation REC CMD '_
%'Unable to allocate file  ';
%CVBTX TEMP,4,TEMP+4;
%VSEG KERMVA,'Dynamic reg 15 return ';
%VSEG KERMVA,TEMP,4;
%VOUT KERMVA;
%VSEG KERMVA,'The dynamic error code = ';
%CVBTX TEMP,4,MOUTERR;
%VSEG KERMVA,TEMP,4;
%VOUT KERMVA;
%VSEG KERMVA,'The dynamic info code = ';
%CVBTX TEMP,4,MOUTINFO;
%VSEG KERMVA,TEMP,4;
%VOUT KERMVA;
%MVI STATE,ASTATE;  % ABORT IT
      END;

RDYNEXIT: CEXIT VRE,HIGHR;
LTORG;
EXORG;
PDSORGTL:   DC     X'003C0001';
PO:        DC     X'0200';  % PARTIONED DS

SUBTITLE 'DYNERR';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%   MODULE - DYNERR
%   FUNCTION - CALLS MACROS FOR DYNAL ROUTINES
%   INPUT VR1-> DYNAL REQUEST BLOCK
%   OUTPUT SCREEN INFORMATION
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
DYNERR:
CENTER VRE,HIGHR,ENTRY=NO;

ST VR1,TEMP;  % STORE OFF REGS
VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN;
   DALMSG DALLIST=TEMP,RC=DACKRC,MF=(E,DALMSG);  % OBTAIN TEXT OF
DATA BEGIN

DALMSG: DALMSG MSG1=DAIRMSG1,MSG1LEN=DAIRLEN1,MSG2=DAIRMSG2,_
MSG2LEN=DAIRLEN2,MF=L;  % PARAMETER LIST FOR OBTAINING DYNAMIC
END;  % OF DATA
   % DYNAMIC ALLOCATION ERROR MESSAGE
   LH VR0,DAIRLEN1;  % GET LENGTH OF FIRST MESSAGE
LR XRA,VR0;  % SAVE THE REGISTER
   IF <RP VR0> THEN BEGIN  % ANY MESSAGE PRESENT?
LA VR1,DAIRMSG1;
UNTIL <CLI 0(VR1),C' '> DO <SI VR0,1; AI VR1,1>;
UNTIL <CLI 0(VR1),C' '; CC NE> DO <SI VR0,1; AI VR1,1>;
CCALL ERRPACK,A;
%IF ^<TF SERVERF> THEN VOUT KERMVA,DAIRMSG1,(VR0);  % OF FIRST DYNAMIC
%STH XRA,STATLEN;  % STATUS ROUTINE
%LR XRA,VR0;  % STATUS REGISTER
%EXI XRA,MMVC,STATBUFF,DAIRMSG1,*-*,INCR=YES,DECR=YES;
%CCALL ERRPACK,A,VR1=STATBUFF;  % PUT IT IN ERROR PACK
      % ALLOCATION ERROR MESSAGE
      END;
   LH VR0,DAIRLEN2;  % GET LENGTH OF SECOND MESSAGE
   IF <RP VR0> THEN BEGIN  % ANY MESSAGE PRESENT?
%IF ^<TF SERVERF> THEN VOUT KERMVA,DAIRMSG2,(VR0);  %TEXT SECOND DYNAMIC
      % ALLOCATION ERROR MESSAGE
      END;

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'WRITEFIL';
WRITEFIL:
CENTER VRE,HIGHR,ENTRY=NO;

%%%%%%%%%%%%%% PUT TO FILE
LH XRB,BUFCNT;  % NUMBER TO PUT


IF <RNM XRB> THEN BEGIN  % IF WE HAVE SOMETHING TO PUT
ST XRB,EDLEN;  % NUMBER OF CHARACTERS TO PUT
L XRA,ADDBUF;  % ADDRESS OF BUFFER

CALL EDPUT,(EDCNTRL,EDRETURN,EDLINEN,EDLINER,(XRA),EDLEN);

IF ^<MCLC EDRETURN,ZERO,4> THEN BEGIN  % FILE OPEN FAIL
CALL EDMSG,(EDCNTRL,EDRETURN,EDLINE,EDLMAX2,EDLENACT);
CCALL ERRPACK,A,VR1=EDLINE,VR0=L:EDLENACT;  % OUTPUT IT
END;

IF <OPENP DEBUG> THEN BEGIN
DATA  BEGIN
DBMSG1:  DC C'QSAM PUT';
         DS 4CL1;  % INCLUDE FOR WORD SIZE
DBMSG1L: EQU *-DBMSG1;
END;
ZR VR1;
LI VR1,DBMSG1L;
STH VR1,WRKBUFF;
MZC WRKBUFF+2,2;  % ZERO REST
MMVC WRKBUFF+4,DBMSG1,8;
PUT DEBUG,WRKBUFF;  % OUT PUT IT
AI XRB,4;  % INCLUDE FOUR FOR HEADER
LR VR1,XRB;  % RESTORE LENGTH
IF <CH VR1,DEBUG+(DCBLRECL-IHADCB); CC H> THEN
LH VR1,DEBUG+(DCBLRECL-IHADCB);
IF <CI VR1,255; CC H> THEN <LI VR1,255>;
EXI VR1,MMVC,BUF,(XRA),0,INCR=YES,DECR=YES;  % MOVE IT OVER
STH VR1,BUF-4;  % STORE OFF LENGTH
MZC BUF-2,2;
PUT DEBUG,BUF-4;
LR VR1,XRB;  % RESTORE LENGTH
END;  % OF DEBUG

END;  % OF SOMETHING TO PUYT

IF <MCLC DATA,=C'TEXT',4> THEN MZC BUFCNT,2;  % ZERO BUFFER COUNT
L VR1,ADDBUF;
ST VR1,BUFADD;


CEXIT VRE,HIGHR;
LTORG;
EXORG;

SUBTITLE 'KSPACK';
SPACK:   % SEND PACKET TO MICRO
CENTER VRE,HIGHR,ENTRY=NO;


LA XRC,SNDPKT;
USE XRC AS PACKET IN BEGIN  % ADRESSABLE DSECT

SPACKBLK: DO BEGIN

MMVC MARK,SSOH,1;  % MOVE IN SEND START OF HEADER


LENCALC XRB;  % CALCULATE THE LENGTH
CHAR XRB;
STC XRB,LEN;  % PUT IN LENGTH
UNCHAR XRB;  % NUMERIC
AI XRB,1;  % ONE MORE FOR THE LENGTH BYTE
SH XRB,BCCLEN;  % GET RID OF BCC FOR SUB
LR VR0,XRB;  % SET UP FOR SUB

CCALL BCCCALC,A,VR1=LEN;  % BCC COMPUTATION SUB

EXIT FROM SPACKBLK IF <C VRF,=X'FFFFFFFF'>;  % SOMETHING FUNNY

LENCALC XRB;  % LENGTH
AI XRB,2;  % INCLUDE FIRST TWO BYTES
LA VR1,PACKET;
SH VR1,BCCLEN;
AR VR1,XRB;  % ONE LESS
LH XRA,BCCLEN;  % LENGTH FOR STM

SI XRA,1;  % DECREMENT FOR EXECUTE
EX XRA,STOREBCC;  % ST BCC
L VRF,ATOEVCON;
EXI XRB,MTR,PACKET,0(VRF),*-*,DECR=YES,INCR=YES;  % TRANSLATE TO EBCIDIC

IF <OPENP DEBUG> THEN BEGIN  % DEBUGGING ON

MZC WRKBUFF,4;  % BLAST 1ST 4 BYTES
MVI WRKBUFF+1,20;
MMVC WRKBUFF+4,=C'TPUT SEND PACKET',16;

PUT   DEBUG,WRKBUFF;

AI XRB,4;  % BUMP LENGTH COUNTER TO INCLUDE HEADER

STH XRB,WRKBUFF;
EXI XRB,MVC,WRKBUFF+4(*-*),PACKET,DECR=YES,INCR=YES;

SI XRB,4;  % ADJUST LENGTH BACK TO ORIGINAL

PUT DEBUG,WRKBUFF;  % OUTPUT AGAIN

END;  % OF DEBUG BLOCK

 LA XRA,SNDPKT;
 AR XRA,XRB;  % LENGTH OF PACKET
 MMVC 0(XRA),SEOL,1;  % PUT ON EOL CHARACTER
L VRF,ATOEVCON; MTR 0(XRA),0(VRF),1;  % TRANSLATE TO EBCIDIC FOR TCAM
 AI XRB,1;  % BUMP LENGTH FOR PUT
IF <TF STURNRND> THEN BEGIN
STIMER WAIT,BINTVL=STURNTIM;
END;

TPUT SNDPKT,(XRB),CONTROL;  % THE BEEF

IF <RNZ VRF> THEN BEGIN

ERRORCON 'Error in Tput to Micro ';
CCALL ERRPACK,A;

END;  % OF ERROR OF TPUT
L VRF,ETOAVCON;
EXI XRB,TR,PACKET(*-*),0(VRF),DECR=YES,INCR=YES;  % TRANSLATE TO EBCIDIC

END;  % OF SPACKBLK
CEXIT VRE,HIGHR;
LTORG;
EXORG;
STOREBCC: MMVC 0(VR1),BCC,*-*;  % ST BCC
END;  % OF DSECT PACKET

SUBTITLE 'BCCCALC';
BCCCALC:   % BCC CHECKING ROUTINE

%  VR1 = PACKET ADDRESS
%  VR0 = PACKET LENGTH LESS BCC
%  VRF = BCC CHECK RETURN

CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
LH XRA,BCCLEN;  % LEVEL CHECKING

ZR VRF;  % ZERO REG TO HOLD BCC

SELECT FIRST;
<CI XRA,1>: BEGIN  % LEVEL 1 BCC CHECKING

DO BEGIN
ZR XRB;
IC XRB,0(VR1);  % OFFSET 1 FOR MARK
AR VRF,XRB;  % BUMP ACCUMULATOR
AI VR1,1;  % INCREMENT
END FOR VR0;

ST VRF,TEMP;  % STORE OFF FOR ADD
N VRF,=X'000000C0';  % MOD 192
M VRE,ONE;  % CARRY OVER SIGN BIT
D VRE,O1H;  % MOD 64
A VRF,TEMP;  % ADD THE TWO VALUES
N VRF,MOD64;  % MOD 64

CHAR VRF;
STC VRF,BCC;  % STORE IT OFF

            END;  % LEVEL 1

<CI XRA,2>: BEGIN  % LEVEL 2 BCC CHECKING
%SI XRB,2;  % SUB 2 FOR BCC
DO BEGIN
ZR XRB;
IC XRB,0(VR1);  % OFFSET 1 FOR MARK
AR VRF,XRB;  % BUMP ACCUMULATOR
AI VR1,1;  % INCREMENT
END FOR VR0;
LR XRB,VRF;  % SAVE OFF TOTAL
% FIRST CHARACTER IN BCC BITS 11-6 OF TOTAL
N XRB,=X'00000FFF';  % TURN OFF ALL BUT 12 BITS
SRL XRB,6;  % SHIFT OVER 6 BITS
CHAR XRB;  % MAKE IT PRINTALBE
STC XRB,BCC;  % STORE OFF 1ST CHARACTER

N VRF,=X'0000003F';  % ONLY LAST 6 BITS
CHAR VRF;  % THE CHARACTER FUNCTION
STC VRF,BCC+1;  % STORE IT OFF

LA VRF,BCC;  % RETURN ADDRESS OF BCC IN VRF


            END;  % LEVEL 2

 <CI XRA,3>: BEGIN  % LEVEL 3 CRC CHECKING
    ZR VRF;  % VRF CRC VALUE - ORIGINALLY 0
    DO BEGIN
       ZR XRB;
       LR XRC,VRF;  % GET SET UP FOR XOR
       N XRC,=X'000000FF';  % BLAST ALL BUT LAST BYTE
       IC XRB,0(VR1);  % OFFSET 1 FOR MARK
       XR XRC,XRB;  % X-OR CRC WITH BYTE

       SRL VRF,8;  % SHIFT CRC REG 8 BIT TO THE RIGHT

       L XRB,CRCCONAD;  % CRC CONSTANT TABLE CRC CCITT

       AR XRB,XRC;
       AR XRB,XRC;  % ADD INDEX TWICE SINCE ALL VALUES ARE HALFWORD

       ICM XRC,3,0(XRB);  % LOAD HALF WORD

       N XRC,=X'0000FFFF';  % TURN OFF HIGH ORDER

       XR VRF,XRC;  % REMAINING CRC VALUE

       AI VR1,1;  % INCREMENT
       END FOR VR0;
    LR XRB,VRF;  % SAVE OFF TOTAL
    % FIRST CHARACTER IN CRC BITS 11-6 OF TOTAL
    N XRB,=X'0000FFFF';  % TURN OFF ALL BUT 16 BITS
    SRL XRB,12;  % SHIFT OVER 12BITS
    CHAR XRB;  % MAKE IT PRINTALBE
    STC XRB,BCC;  % STORE OFF 1ST CHARACTER  (B12-B15)

    LR XRB,VRF;  % RESTORE REGISTER
    % SECOND CHARACTER IN CRC BITS 11-6 OF TOTAL
    N XRB,=X'00000FFF';  % TURN OFF ALL BUT 12 BITS
    SRL XRB,6;  % SHIFT OVER 6 BITS
    CHAR XRB;  % MAKE IT PRINTALBE
    STC XRB,BCC+1;  % STORE OFF 2ND CHARACTER

    N VRF,=X'0000003F';  % ONLY LAST 6 BITS
    CHAR VRF;  % THE CHARACTER FUNCTION
    STC VRF,BCC+2;  % STORE IT OFF

    LA VRF,BCC;  % RETURN ADDRESS OF BCC IN VRF


    END;  % LEVEL 3

ENDSEL;  % CRC SELECTION


USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
BCCEXIT: CEXIT VRE,HIGHR;

LTORG;
EXORG;
SUBTITLE 'CHKETOA';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: CHKETOA
% FUNCTION: CHECKS EBCDIC TEXT FILE FOR UNVALID ASCII CHARACTERS
% INPUT: VR1=>POINTS TO STRING
%        VR0= LENGTH OF STRING / ALWAYS LESS THAN 256
% OUTPUT: MESSAGE OUTPUT-FLAGS SET
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
CHKETOA:
CENTER VRE,HIGHR,ENTRY=NO;
LR XRB,VR0;  % LENGTH FOR EXECUTE
ZR XRA;
LR VRF,VR1;  % POINT OT STRING
L XRC,ETOAERRV;  % ADDRESS OF ETOA ERROR TABLE
EXI XRB,MTRT,0(VRF),0(XRC),*-*,INCR=YES,DECR=YES;
IF <RNZ XRA> THEN BEGIN
SF WARNINGF;
MVC WARNBUFF,=C'EDCDIC characterdoes not have ASCII equivalent.';
MMVC WARNLEN,=H'48',2;
END;  % OF TRANSLATE ERROR
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'STOPPROC';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : STOPPROC
% FUNCTION :   CLOSES OPENED  DATA SEST KERIN
%              OR KEROUT - USER ENTERED STOP
% INPUT:       NONE
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
STOPPROC:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
IF <TF SENDDSNF> THEN CCALL CLOSESDS,A;
IF <TF RECVDSNF> THEN CCALL CLOSERDS,A;
ZF STOPF;  % RESET STOP FLAG
CEXIT VRE,HIGHR;
LTORG;


SUBTITLE 'SABORT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : SABORT
% FUNCTION :   SENDS AN ABORT PACKET TO THE OTHER KERMIT
%              DATA OF PACKET ALREADY ENTERED
% INPUT:       NONE
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SABORT:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
STH VR0,TEMP;
IF <MCLC OLDTRY,RETRY,4; CC NL> |
<MCLC NUMTRY,RETRY,4; CC NL> THEN BEGIN  % Retry exceeded
ERRORCON 'Retry count exceeded - transfer aborted';
CCALL ERRPACK,A;  % PUT IT IN BUFFER
END;  % OF EXCEEDED RETRY
SPSPACK AE,TEMP,PUTLEN,VR0;  % INIT SEND BUFFER
CCALL SPACK,A;  % FIRE AWAY
CCALL STOPPROC,A;  % CLOSES FILES
CEXIT VRE,HIGHR;
LTORG;


SUBTITLE 'RABORT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : RABORT
% FUNCTION :   ACKS AN ABORT PACKET RECEIVED FROM THE OTHER KERMIT
%              MOST DON'T REQUIRE THIS BUT JUST IN CASE
% INPUT:       NONE
%
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
RABORT:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
SPSPACK AY,SEQNUM,ZERO,VR0;  % INIT SEND BUFFER
CCALL SPACK,A;  % FIRE AWAY
LH VR0,RECLEN;
IF <CI VR0,255; CC H> THEN LI VR0,255;
IF <RP VR0> THEN BEGIN
LR XRB,VR0;
L XRA,ATOEVCON; EXI XRB,MTR,RDATA,0(XRA),*-*,DECR=YES;
END;
IF <RP VR0> THEN CCALL ERRPACK,A,VR1=RDATA;  % PUT IN STATUS BUFFER


CCALL STOPPROC,A;
CEXIT VRE,HIGHR;
LTORG;

SUBTITLE 'CLOSESDS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : CLOSESDS
% FUNCTION :   CLOSES AND DEALLOCATES THE DATA SET KERIN
%              CALLED BY SEND FUNCTIONS AND ABORT PROCESSING
% INPUT:       NONE
%
%
% OUTPUT :     NONE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
CLOSESDS:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

IF <TF SENDDSNF> THEN BEGIN  % CLOSE INPUT FILE
CALL EDCLOS,(EDCNTRL,EDRETURN);  % CLOSE INPUT FILE
ZF SENDDSNF;  % OPEN FILE INDICATOR
END;  % OF CLOSE KERIN
         LA XRB,DSNAME;  % GET ADDRESS OF DSNAME
         DALLIST BEGIN,MF=(E,UALLOCDS),INIT=NO; BEGIN
      DALLIST TEXT,DALDDNAM,(KERMDDNM,8);  % DDNAME
            DALLIST TEXT,DUNUNALC,MF=L;  % FORCE UNALLOCATION
            DALLIST END; END;
         DATA BEGIN  % DYNAMIC ALLOCATION PARAMETER LIST FOR
            % UNALLOCATION BY DSNAME

            UALLOCDS:
            DALLIST BEGIN,S99VRBUN,MF=L; BEGIN
         DALLIST TEXT,DALDDNAM,(,8);  % DDNAME
               DALLIST TEXT,DUNUNALC;  % FORCE UNALLOCATION
               DALLIST END; END;
            END;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;


SUBTITLE 'CLOSERDS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : CLOSERDS
% FUNCTION :   CLOSES THE DATA SET KEROUT USED BY RECEIVE
%              THE UPLOADED FILE, CALLS RECUNAL FOR DEALLOCATION
% INPUT:       NONE
%
%
% OUTPUT :     NONE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
CLOSERDS:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;

IF <TF RECVDSNF> THEN BEGIN  % CLOSE INPUT FILE
CALL EDCLOS,(EDCNTRL,EDRETURN);  % CLOSE INPUT FILE
ZF RECVDSNF;
L XRA,TMPDISKA;
LH XRB,TMPDISKL;
IF <EXI XRB,MCLC,VOLUME,0(XRA),*-*,INCR=YES,DECR=YES> &
<MCLC STATLEN,=H'0',2> THEN DO BEGIN
%VINIT KERMVA,L:ADDSTATA,KERMBUFF,L'KERMBUFF;
%VSEG KERMVA,'Data set ';
MMVC TMPDSN,DSNAME,44;
EXIT IF <CLI STATE,SESTATE> | <CLI STATE,RESTATE>;
MMVC TMPVOL,TSOVOL,6;  % RETURN ED VOL SERIAL NUMBER
LI VR0,TMPMSL;
CCALL ADSTATUS,A,VR1=TMPDSMES;
%VOUT KERMVA;
END;  % OF DEFAULT

END;  % OF CLOSE KEROUT
CCALL RECUNAL,A;  % UNALLOCATE DS


FREEMAIN RU,SP=7;  % FREE THE BUFFER   ATTEMPT  % %NO; ON ORG CHECK
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;



SUBTITLE 'KERMTGET';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  MODULE : KERMTGET
%  FUNCTION: TIMER ON ALL READS THIS SUB IS ATTACHED
%  ECB'S CONTROL TIMING FLOW
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KERMTGET:
OSENTER (14,12);
L XRF,PARMADD2;  % SET UP BASE REGISTER
L XRB,STAXADD;  % PARMETER EXIT ROUTINE ADDRESS
L XRC,STAXLADD;  % PARM LIST  ADDRESS
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));
STAX (XRB),DEFER=NO,REPLACE=NO,MF=(E,(XRC));
FOREVER DO BEGIN  % LOOP ALL DAY
WAIT ECB=ECBREAD;
MZC ECBREAD,4;  % ZERO ECB
L VR1,TGETBUFA;  % ADDRESS OF BUFFER TO PUT IN
LI VR0,32767;  % MAX VALUE OF TGET ( ALTHOUGH TCAM'S 4 K)
TGET (VR1),(VR0),ASIS;
IF <RZ VRF> | <CI VRF,18> THEN ST VR1,TGETLEN  % LENGTH OF RECEIVED
ELSE BEGIN  % ERROR
ZR VRF;
SI VRF,1;
ST VRF,TGETLEN;
END;
POST ECBTGET,ECBTREAD;  % TELL EM WE READ IT

END;  % OF FOREVER DO

OSEXIT (14,12);
LTORG;
PARMADD2:    DC   A(PARMS);  % ADDRESS OF STORAGE

SUBTITLE 'ERRPACK';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: ERRPACK
% FUNCTION: SEND ERROR PACKETS
% INPUT: R1-> MESSAGE STRING
%        VR0=LENGTH OF MESSAGE
% OUTPUT: PRESPARED AND SEND PACKET
%   MAYBE WAIT ONt( NACK THEN BLOCK OFF
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ERRPACK:
CENTER VRE,HIGHR,ENTRY=NO;

IF <CH VR0,MAXPUT; CC H> THEN LH VR0,MAXPUT;  % IN CASE TOO BIG
DEBLANK VR1,VR0,XRA,BOTH;  % DEBLANK ERROR PACKET
% SET UP DSECT FOR SEND PACKET
LR XRA,VR0;  % LENGTH FOR EXECUTE
EXI XRA,MMVC,PDATA,0(VR1),*-*,INCR=YES,DECR=YES;
STH XRA,PUTLEN;
EXI XRA,MMVC,STATBUFF,PDATA,*-*,INCR=YES,DECR=YES;  % FINAL STATUS
STH XRA,STATLEN;  % LENGTH OF BUFFER
L XRB,ETOAVCON;
EXI XRA,TR,PDATA(*-*),0(XRB),DECR=YES,INCR=YES;  % TRANSLATE TO ASCII
MVI PTYPE,ACOMLIT;  % ABORT LITERAL INTO PACKET
%
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'ATOEERRS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: ATOEERRS
% FUNCTION: SETS ERROR BUFFER FOR ASCII TO EBCDIC CONVERSION MESSAGE
% INPUT: NONE
%
% OUTPUT: NONE
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ATOEERRS:
CENTER VRE,HIGHR,ENTRY=NO;
SF WARNINGF;
MVC WARNBUFF,=C'Invalid characters for ASCII to EBCDIC translation.';
MMVC WARNLEN,=H'51',2;
SF WARNTPCK ;
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'ATOE8BIT';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: ATOE8BIT
% FUNCTION: SETS ERROR BUFFER FOR ASCII TO EBCDIC CONVERSION MESSAGE
% INPUT: VR1=> CHARACTER
%
% OUTPUT: CHARACTER CONVERSION
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ATOE8BIT:
CENTER VRE,HIGHR,ENTRY=NO;
SF WARNINGF;
MVC WARNBUFF,=C'Eighth bit on for ASCII to EBCDIC translation.';
MMVC WARNLEN,=H'47',2;
SF WARNTPCK ;

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'CHKCNTL';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MODULE : CHKCNTL
% FUNCTION :   CHECKS A NUMBER FOR A VALID QUOTE CHARACTER
%              CHECKS RANGE AND OTHER QUOTES
% INPUT:       VRF= NUMBER (BINARY) VR0=1 - CQUOTE
%              VR0=2 - BQUOTE  VR0=3   RQUOTE
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
CHKCNTL:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
SELECT FIRST;
<CLM VRF,1,QUOCHAR>: % User entered same just fall through
BEGIN
IF ^<CI VR0,1> THEN  % QUOTE CHARACTER
WRTERM _
 'Character entered matches CQUOTE character.  Change it first.';
ZR VRF;
END;
<CLM VRF,1,BINQC>: BEGIN  % User entered Quote like other
IF ^<CI VR0,2> THEN  % BQUOTE CHARACTER
WRTERM _
 'Character entered matches BQUOTE character.  Change it first.';
ZR VRF;
END;
<CLM VRF,1,REPTCHAR>: BEGIN  % User entered Quote like other
IF ^<CI VR0,3> THEN  % CQUOTE CHARACTER
WRTERM _
 'Character entered matches RQUOTE character.  Change it first.';
ZR VRF;
END;
<<CI VRF,32; CC L> | % Check whether number is in range
<<CLI VRF,63; CC H> & <CLI VRF,95; CC L>>>: ;  % ILLEGAL JUST FALL OUT
ENDSEL
ELSE BEGIN  % We actually have a good quote character
% Now take old values out of tables
SELECT FIRST;  % NOW PICK UP CHARACTER THAT WE'RE QUOTING
<CI VR0,1>: LA XRA,QUOCHAR;
<CI VR0,2>: LA XRA,BINQC;
<CI VR0,3>: LA XRA,REPTCHAR;
ENDSEL;

LOADB VR0,0(XRA);
LA VR1,SENDTBL;
AR VR1,VR0;  % POINT TO PLACE IN TABLE
MVI 0(VR1),0;  % QUOTE FOR HASH IN TABLE
AI VR1,X'80';  % POINT TO HIGH ORDER
MVI 0(VR1),ASCI8BIT;

LA VR1,RECTABLE;
AR VR1,VR0;  % POINT TO PLACE IN TABLE
MVI 0(VR1),0;  % QUOTE FOR HASH IN TABLE
STC VRF,0(XRA);  % STORE THE QUOTE CHARACTER
ZR VRF;  % INDICATE GOOD RETURN





END;
USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF

CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'KSTATUS ';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% MOD: KSTATUS
% FUNCTION: OUTPUT A MESSAGE TO THE TERM CONCERNING WARNINGS
%           AND THE FINAL COMPLETION CODE OF THE PROGRAM
%  INPUT:   STATBUFF CONTAINS THE MESSAGE
%           STATLEN IS THE LENGTH OF MESSAGE
%  OUTPUT:  SCREEN MESSAGE
% RETURN : NONE
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
KSTATUS:
CENTER VRE,HIGHR,ENTRY=NO;
VINIT KERMVA,L:KOUTADDR,KERMBUFF,OUTLEN;
VSEG KERMVA,'                        TSO KERMIT Status Report';
VOUT KERMVA;  % OUTPUT HEADER FOR STATUS REPORT
IF <TF WARNINGF> THEN BEGIN  % WARNINGS ISSUED
LA VR1,WARNBUFF;
LH VR0,WARNLEN;

VSEG KERMVA,(VR1),(VR0);
VOUT KERMVA;  % OUTPUT IT TO SCREEN
END;
LA VR1,STATBUFF;
LH VR0,STATLEN;
IF <RZ VR0> THEN VSEG KERMVA,SUCESSCC,L'SUCESSCC  % GOOD RETURN
ELSE VSEG KERMVA,(VR1),(VR0);
VOUT KERMVA;  % OUTPUT IT TO SCREEN
CEXIT VRE,HIGHR;
LTORG;
EXORG;
SUBTITLE 'SETCNTLS';
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%  MOD: SETCNTLS
%  FUNCTION: SCAN FOR "^" FORMAT SET PARAMETERS
%             (E.G. ^A = =X'01'    )
%  INPUT: VR1=> STRING
%        VR0=LENGTH
%  OUTPUT: VRF= CONVERTED NUMBER - NEGATIVE NUMBERS= ILLEGAL
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SETCNTLS:
CENTER VRE,HIGHR,WASIZE,ENTRY=NO;
  SCPUSH;
ZR VRF;
SCINIT (VR1),(VR0);  % REINITIALIZE SCANNER
SCAN *;
       SCKW ,STORCNTL,I,LIMIT=AL1(32);  % HIGHEST NUMBER
       SCKW  ^,CNTLETTR;  % A CNTL LETTER (E.G. ^A = X'01')

       SCKW NUL,*,CODE=AL1(0);
       SCKW SOH,*,CODE=AL1(1);
       SCKW STX,*,CODE=AL1(2);
       SCKW ETX,*,CODE=AL1(3);
       SCKW EOT,*,CODE=AL1(4);
       SCKW ENQ,*,CODE=AL1(5);
       SCKW ACK,*,CODE=AL1(6);
       SCKW BEL,*,CODE=AL1(7);
       SCKW BS,*,CODE=AL1(8);
       SCKW HT,*,CODE=AL1(9);
       SCKW LF,*,CODE=AL1(10);
       SCKW VT,*,CODE=AL1(11);
       SCKW FF,*,CODE=AL1(12);
       SCKW CR,*,CODE=AL1(13);
       SCKW SO,*,CODE=AL1(14);
       SCKW SI,*,CODE=AL1(15);
       SCKW DLE,*,CODE=AL1(16);
       SCKW DC1,*,CODE=AL1(17);
       SCKW DC2,*,CODE=AL1(18);
       SCKW DC3,*,CODE=AL1(19);
       SCKW DC4,*,CODE=AL1(20);
       SCKW NAK,*,CODE=AL1(21);
       SCKW SYN,*,CODE=AL1(22);
       SCKW ETB,*,CODE=AL1(23);
       SCKW CAN,*,CODE=AL1(24);
       SCKW EM,*,CODE=AL1(25);
       SCKW SUB,*,CODE=AL1(26);
       SCKW ESC,*,CODE=AL1(27);
       SCKW FS,*,CODE=AL1(28);
       SCKW GS,*,CODE=AL1(29);
       SCKW RS,*,CODE=AL1(30);
       SCKW US,*,CODE=AL1(31);
       SCKW ,*,CODE=AL1(-1);  % ILLEGAL VALUE
SCANEND;
DATA BEGIN  % START OF ANTHER SCAN
CNTLETTR: ;
SCPOP;
SCTELL;
IF <CI VR0,1> THEN BEGIN  % IS THERE ONE CHARACTER
SCINIT (VR1),(VR0);
SCAN *;

       SCKW @,*,CODE=AL1(0);
       SCKW A,*,CODE=AL1(1);
       SCKW B,*,CODE=AL1(2);
       SCKW C,*,CODE=AL1(3);
       SCKW D,*,CODE=AL1(4);
       SCKW E,*,CODE=AL1(5);
       SCKW F,*,CODE=AL1(6);
       SCKW G,*,CODE=AL1(7);
       SCKW H,*,CODE=AL1(8);
       SCKW I,*,CODE=AL1(9);
       SCKW J,*,CODE=AL1(10);
       SCKW K,*,CODE=AL1(11);
       SCKW L,*,CODE=AL1(12);
       SCKW M,*,CODE=AL1(13);
       SCKW N,*,CODE=AL1(14);
       SCKW O,*,CODE=AL1(15);
       SCKW P,*,CODE=AL1(16);
       SCKW Q,*,CODE=AL1(17);
       SCKW R,*,CODE=AL1(18);
       SCKW S,*,CODE=AL1(19);
       SCKW T,*,CODE=AL1(20);
       SCKW U,*,CODE=AL1(21);
       SCKW V,*,CODE=AL1(22);
       SCKW W,*,CODE=AL1(23);
       SCKW X,*,CODE=AL1(24);
       SCKW Y,*,CODE=AL1(25);
       SCKW Z,*,CODE=AL1(26);
       SCKW [,*,CODE=AL1(27);
       SCKW \,*,CODE=AL1(28);
       SCKW ],*,CODE=AL1(29);
       SCKW ,*,CODE=AL1(30);
       SCKW _,*,CODE=AL1(31);
       SCKW ,*,CODE=AL1(-1);
SCANEND;
END  % OF ONE CHARACTER TO SCAN
ELSE <ZR VRE; SI VRE,1>;  % ERROR RETURN
SCPUSH;
END;  % OF BLOCK

LR VRF,VRE;  % LOAD VALUE IN RETURN REGISTER
STORCNTL: USE WAR AS WA IN ST VRF,WAVRF;  % STORE VRF
 SCPOP;  % RESTORE SCANNER
CEXIT VRE,HIGHR;
LTORG;
SUBTITLE 'DSECTS AND BIG BUFFERS';
NOTOUCH: DC        F'0';  % WORD FOR LRECL
BUF:     DS        CL32000;  % DISK READ INTO HERE;
TGETBUFF:  DS    CL33000;  % LENTH OF TGET BUFFER
USERWORK: AREA H,DSECT=NO;
LENWK:     DC    H'32004';  % LENGTH OF WORKAREA
DATALEN:   DC    H'0';  % LENGTH OF RETURNED DATA
RETURNDS:  DS    CL32000;  % DATA SET NAME
VOLJUNK:   DC    15AL1(0);  % VOL INFO
AREAEND;
NOQUOTE: AREA F,DSECT=NO;
DC 256AL1(0);  % TABLE FOR NON QUOTED CHARACTERS
AREAEND;
% DSECTS FOR PACKETS
PACKET:  AREA F,DSECT=YES;
MARK:  DS     X;  % ^A SOH CHARACTER
LEN:   DS     X;  % LENGTH OF PACKET-2
SEQ:   DS     X;  % 0-63 (MOD 64) SEQUENCE NUMBER
TYPE:  DS     X;  % PACKET TYPE
DATABUFF:  DS     CL92;  % MAX PACKET DATABUFF
PACKETL: AREAEND;
SPACKET:  AREA F,DSECT=YES;
SMARK:  DS     X;  % ^A SOH CHARACTER
SLEN:   DS     X;  % LENGTH OF PACKET-2
SSEQ:   DS     X;  % 0-63 (MOD 64) SEQUENCE NUMBER
STYPE:  DS     X;  % PACKET TYPE
SDATABUF:  DS     CL92;  % MAX PACKET DATABUFF
SPACKETL: AREAEND;

SENDIDST: AREA H,DSECT=YES;
MAXL:  DS     X;  % MAX PACKET LENGTH MAX 94
TIME:  DS     X;  % TIMEOUT FOR RECIEVER
NPAD:  DS     X;  % NUMBER OF PAD CHARS (0)
PADC:  DS     X;  % THE CONTROL CHAR OF PAD
EOLCHAR:   DS     X;  % CHARACTER TO TERMINATE IN PACK
QCTL:  DS     X;  % ASCII QUOTE CHAR
QBIN:  DS     X;  % ASCII BIN QUOTE CHAR
CHKT:  DS     X;  % CHARACTER CHECKING
REPT:  DS     X;  % PREFIX REPEAT CHAR
CAPA1: DS     X;  % CAPABILITIES
SENDINIL: AREAEND;
%%DSECTS END
RECINIT: AREA H,DSECT=YES;
RMAXL:  DS     X;  % MAX PACKET LENGTH MAX 94
RTIME:  DS     X;  % TIMEOUT FOR RECIEVER
RNPAD:  DS     X;  % NUMBER OF PAD CHARS (0)
RPADC:  DS     X;  % THE CONTROL CHAR OF PAD
REOLCHAR:   DS     X;  % CHARACTER TO TERMINATE IN PACK
RQCTL:  DS     X;  % ASCII QUOTE CHAR
RQBIN:  DS     X;  % ASCII BIN QUOTE CHAR
RCHKT:  DS     X;  % CHARACTER CHECKING
RREPT:  DS     X;  % PREFIX REPEAT CHAR
RCAPA1: DS     X;  % CAPABILITIES
RECINIL: AREAEND;

DCBD: AREA F,DSECT=YES;
DCBD      DSORG=(PS),DEVD=DA;
DCBDL: AREAEND;
CATDSET: AREA ,DSECT=YES;
TYPEBYTE:   DS   XL1;  % TYPE BYTE WE WANT ONLY A'S
CATDNAME:   DS  44CL1;  % DATA SET NAME
AREAEND;

END;