VM/CMS kermit source
Barry Lustig
barry at muddcs.UUCP
Fri Oct 26 09:44:51 AEST 1984
A number of people have requested that I post the CMS kermit source if
I manage to get ahold of it. Well I have managed to get ahold of it so
here it is. Bye the way, I have brought it up on a 4341 and tried to
talk to it with a UN*X kermit. Unfortunately I haven't had any luck getting
it to talk.
Barry
------------------------------
Barry Lustig
Harvey Mudd College
UUCP: {ihnp4,allegra,seismo}!scgvaxd!muddcs!barry
ARPA: muddcs!barry at ucla-cs
PHONE: At the moment --- (714) 621-8000 x8225
CUT HERE
-------------------------------------------------------------
: to unbundle, "sh" this file -- DO NOT use csh
: SHAR archive format. Archive created Thu Oct 25 14:33:41 PDT 1984
echo x - cmskermit.asm
sed 's/^X//' > cmskermit.asm <<'+FUNKY+STUFF+'
XKERMIT TITLE 'KERMIT-CMS'
XKERMIT CSECT
X* KERMIT -
X*
X* Kermit - KL10 Error-free Reciprocol Micro Interface Transfer
X* Version 1.0
X*
X* This program is the IBM VM/CMS side of a file transfer system.
X* It can be used to transfer files between a micro and a system
X* running under VM/CMS.
X* See the KERMIT manual for the complete program specifications
X* to which this program and any other component of the system
X* must adhere.
X*
X* Daphne Tzoar, Columbia University Center for Computing Activities
X* March 1982
X* Updates:
X* June: Only allow Kermit to run on an ASCII terminal. Else, stop
X* execution. Also, check padding when receiving file in
X* fixed format. If only pad one character, pad the balance
X* via the "EX" option, else skip that command.
X* August: Change "FSREAD" when sending to allow a maximum of 133, not
X* the full buffer size since need two spaces for CRLF.
X* 4/7/83: Fix maximum number of tries on init (to 16), set timeout
X* value to 8, and do "CTL" function to padding character
X* in SINIT (not CHAR).
X*
X* Please address all comments and questions to:
X* 716 Watson
X* 612 W. 115th St.
X* NY,NY, 10025
X* (212) 280-3703
X*
X* Copyright (C) 1982 Columbia University
X*
X* Permission is granted to any individual or institution to copy
X* or use this program, except for explicitly commercial purposes.
X*
X* Note that this is an experimental version; all changes should
X* be forwarded to the author.
X*
X EJECT
X* REGISTER USAGE -
X* R1 -
X* R2 -
X* R3 -
X* R4 -
X* R5 -
X* R6 -
X* R7 -
X* R8 -
X* R9 -
X* R10 -
X* R11 - BASE REGISTER FOR GLOBAL DATA AREA
X* R12 - PROGRAM BASE
X* R13 - SAVE AREA
X* R14 - SUBROUTINE LINKAGE
X* R15 - SUBROUTINE LINKAGE
X*
X* EXTERNAL MACROS/MODULES CALLED -
X* The following MACLIBs should be GLOBAL'd:
X* CMSBSE, CMSLIB
X*
X* The following external routines are called:
X* NEXTFST ASSEMBLE
X* WILD ASSEMBLE
X*
X*
X SPACE
X* PRINT NOGEN
X REGEQU
X FSTD DSECT WILL NEED FOR NEXTFST ROUTINE
X ADT DSECT
X NUCON DSECT USE IN TOKENIZER ROUTINE
X EXTSECT DSECT USE WHEN TURNING BLIP OFF
X SPACE
XSOH EQU X'01' ^a FOR START OF HEADER CHAR
XAD EQU 68 DATA PACKET (ASCII 'D')
XAN EQU 78 NAK
XAZ EQU 90 EOF PACKET
XAS EQU 83 INIT PACKET
XAY EQU 89 ACK
XAF EQU 70 FILE PACKET
XAB EQU 66 BREAK PACKET
XAE EQU 69 ERROR PACKET
XERCOD EQU 12 MEANS EOF WITH 'FSREAD'
XFLG1 EQU X'80' IS FILE THE FIRST OR NOT
XFLG2 EQU X'40' OVERWRITE SENT FILENAME?
XFLG3 EQU X'20' ONE = SENT ONLY PARTIAL RECORD
XFLG4 EQU X'10' NAK FROM MICRO(0) OR RPACK(1)?
XFLG5 EQU X'08' ALLOCATED MORE SPACE (DMSFREE)
X EJECT
XKERMIT CSECT
X STM R14,R12,12(R13)
X BALR R12,0
X USING *,R12
X LA R14,KSAVE
X ST R13,4(R14)
X ST R14,8(R13)
X LR R13,R14
X*
X* USE R11 AS BASE REGISTER FOR THE SHARED DATA AREA
X L R11,=A(PARMS)
X USING PARMS,R11
X LR R6,R1 HOLD ON TO CONSOLE BUFFER
X SR R2,R2
X S R2,ONE GET INFO BY USING ADDR -1
X DC X'83230024' GET LINESIZE DATA - DIAG 24
X XC TEMP,TEMP
X ST R4,TEMP
X CLC TEMP(2),=X'8020' CHECK DEVICE TYPE
X BNE BADDEV MUST BE AN ASCII TERMINAL
X XC LINSIZ,LINSIZ
X STC R4,LINSIZ+3 SAVE THE LINESIZE
X LA R7,=C'TERM LINES 130'
X LA R8,14
X DIAG 7,8,8 SET TO HIGHEST POSSIBLE VALUE
X USING NUCON,0 FOR TOKENIZER
X L R7,AEXTSECT LOC OF CMS ROUTINE EXTSECT
X USING EXTSECT,R7
X MVC BLIP(1),TIMCHAR SAVE USER'S BLIP CHAR
X DMSEXS MVI,TIMCHAR,X'00' TURN OFF BLIP FOR NOW
X DROP R7
X L R15,=A(INIT)
X BALR R14,R15 CALL THE INITIALIZATION
X SR R15,R15 ZERO RC INITIALLY (IF EXIT)
X LA R6,8(R6)
X CLC 0(8,R6),=8X'FF' ALL COMMAND ON ONE LINE?
X BNE NOPRO NO PROMPT IF YES
XPROMPT WRTERM 'KERMIT-CMS>',EDIT=NO
X RDTERM INPUT
X DMSKEY NUCLEUS
X LA R1,INPUT R1 GETS ADDRESS OF STRING
X L R0,=F'130' R0 GETS THE LENGTH
X L R15,ASCANN
X BALR R14,R15 DO TOKENIZING
X LR R6,R1 SAVE ADDR OF TOKENIZED LIST
X DMSKEY RESET
XNOPRO MVI ERRNUM,X'FF' RESET ERROR FOR THIS TIME
X CLI 0(R6),C'E' CHECK FOR 'EXIT' COMMAND
X BE LEAVE
X CLI 0(R6),C'Q' CHECK FOR 'QUIT' COMMAND
X BE LEAVE
X CLC 0(8,R6),=8X'FF' BARE CARRIAGE RETURN?
X BE PROMPT IGNORE IT
X CLI 0(R6),C'?' NEED HELP ?
X BNE SETCHK
X WRTERM 'Legal Commands are: '
X WRTERM 'Receive, Send, Help, Exit, Quit, Set, Status, Show,*
X CMS, CP'
X B PROMPT
XSETCHK CLC 0(3,R6),=CL3'SET' IS IT THE SET COMMAND ?
X BE STSWITCH
X CLC 0(6,R6),=C'STATUS' IS IT THE STATUS COMMAND?
X BE STATSW
X CLC 0(3,R6),=C'SHO' IS IT THE SHOW COMMAND?
X BE SHOSW
X CLC 0(4,R6),=C'HELP' NEED HELP ?
X BE HELPSW
X CLC 0(3,R6),=C'CMS' CMS COMMAND?
X BE SYSCMD
X CLC 0(2,R6),=C'CP' CP COMMAND?
X BE SYSCMD
X OI FLAGS,FLG1 SET FLG1 - IT'S THE FIRST FILE
X NI FLAGS,X'FF'-FLG2 TURN OFF OVERWRITE FLAG (INIT)
X XC NFSENT,NFSENT NUMBER OF FILES SENT (= 0)
X CLC 0(3,R6),=C'REC'
X BNE SS MAYBE IT'S A SEND COMMAND
X LA R6,8(R6) PICK UP NEXT TOKEN
X CLI 0(R6),C'?' NEED HELP?
X BNE RR2
X WRTERM 'Specify filename with format: [fn ft [fm]]'
X B PROMPT
XRR2 CLC 0(8,R6),=8X'FF' NO MORE WORDS ?
X BE RSWITCH NO MORE, GO READ
X CLI 0(R6),C'=' IS IT " = = FM" ?
X BNE RREG
X CLI 8(R6),C'=' IS FT ALSO '=' ?
X BNE BADFT MUST BE AN '='
X CLI 16(R6),X'FF' NO FM GIVEN - ASSUME A1
X BE RSWITCH
X MVC FM(2),16(R6) USE FM THEY SPECIFIED
X B RSWITCH
XRREG CLI 0(R6),C'*' NO WILDCARDS HERE
X BNE RR3
X WRTERM 'Illegal file name'
X B PROMPT
XRR3 MVC FILNAM,=18X'20' BLANK IT OUT
X MVC FILNAM(8),0(R6) GET FN
X LA R6,8(R6) GET NEXT TOKEN
X CLI 0(R6),C'*' NOT ALLOWED
X BE BADFT
X CLI 0(R6),C'=' NOT ALLOWED
X BE BADFT
X CLC 0(8,R6),=8X'FF' NO MORE ?
X BNE RR
XBADFT WRTERM 'Illegal File Type'
X B PROMPT
XRR MVC FILNAM+8(8),0(R6) GET FTYPE
X OI FLAGS,FLG2 OVERWRITE RECEIVED FNAME
X MVC FILNAM+16(2),DFM DEFAULT FMODE,JUST IN CASE
X LA R6,8(R6) LOOK FOR FMODE
X CLC 0(8,R6),=8X'FF' IS IT THERE ?
X BE RSWITCH
X CLI 0(R6),C'*' NOT ALLOWED IN FM
X BE BADFM
X MVC FILNAM+16(2),0(R6) GET FMODE
X B RSWITCH GO TO READ PORTION
XBADFM WRTERM 'Illegal file mode'
X B PROMPT
XSS CLC 0(3,R6),=C'SEN'
X BNE ERR UNRECOGNIZED COMMAND
X LA R6,8(R6) PICK UP NEXT WORD
X CLI 0(R6),C'?' NEED HELP?
X BNE SS2
X WRTERM 'Specify filename(s) with format: fn ft [fm]'
X B PROMPT
XSS2 CLC 0(8,R6),=8X'FF' NO MORE DATA ?
X BNE SNAM
X WRTERM 'Specify File Name'
X B PROMPT TRY AGAIN
XSNAM MVC NAME,=18X'20' BLANK IT OUT
X MVC FILNAM,=18X'20' BLANK IT OUT TOO
X MVC NAME(8),0(R6) PICK UP THE FNAME
X LA R6,8(R6) MOVE TO NEXT TOKEN
X CLC 0(8,R6),=8X'FF' NO MORE DATA ?
X BNE STYP
X WRTERM 'Specify File Type'
X B PROMPT
XSTYP MVC NAME+8(8),0(R6) PICK UP THE FTYPE
X MVC NAME+16(2),DFM DEFAULT FMODE,JUST IN CASE
X LA R6,8(R6) LOOK FOR FMODE
X CLC 0(8,R6),=8X'FF' IS IT THERE?
X BE SSWITCH
X MVC NAME+16(2),0(R6) GET FMODE
X CLI 0(R6),C'*' WAS IT A WILDCARD?
X BNE SSWITCH NO PROBLEM IF NOT
X CLI 1(R6),C' ' NEED "**" OR "*NUMBER"
X BNE SSWITCH
X MVI NAME+17,C'*' SET "* " TO "**"
X B SSWITCH
XERR WRTERM 'Invalid command'
X B PROMPT INVALID COMMAND - TRY AGAIN
X SPACE 3
XSSWITCH EQU *
X LA 1,=C'SET LINEDIT OFF'
X LA 0,15 15 CHAR COMMAND
X DIAG 1,0,8 SHOW IT'S A CP COMMAND
X L R15,=A(SEND)
X BALR R14,R15 CALL SEND PORTION
X LTR R5,R15 CHECK RETURN CODE
X BNZ LINON
X MVI ERRNUM,X'FF' WORKED OK
XLINON LA 1,=C'SET LINEDIT ON'
X LA 0,14
X DIAG 1,0,8
X MVC OLDERR(1),ERRNUM ERROR SETTING OF THIS RUN
X TM FLAGS,FLG5 GOT EXTRA SPACE?
X BNO SSW1 NOPE, JUST LEAVE
X LA R0,4096/8 AMOUNT OF SPACE WE GOT
X L R1,STORLOC FIND IT & FREE IT
X DMSFRET DWORDS=(0),LOC=(1),ERR=*,MSG=NO
X NI FLAGS,X'FF'-FLG5 TURN OFF EXTRA SPACE FLAG
XSSW1 LTR R5,R5 CHECK THE RETCODE
X BZ PROMPT ALL OKAY
X WRTERM 'Error in sending file. Try again.'
X B PROMPT ERROR - TRY AGAIN
XRSWITCH EQU *
X LA 1,=C'SET LINEDIT OFF'
X LA 0,15 15 CHAR COMMAND
X DIAG 1,0,8 SHOW IT'S A CP COMMAND
X L R15,=A(RECEIVE)
X BALR R14,R15 CALL RECEIVE PORTION
X LTR R5,R15 CHECK RETURN CODE
X BNZ LNON
X MVI ERRNUM,X'FF'
XLNON LA 1,=C'SET LINEDIT ON'
X LA 0,14
X DIAG 1,0,8
X MVC OLDERR(1),ERRNUM ERROR SETTING OF THIS RUN
X LTR R5,R5 CHECK THE RETCODE
X BZ PROMPT ALL OKAY
X WRTERM 'Error in receiving file. Try again.'
X B PROMPT ERROR - TRY AGAIN
XSTSWITCH EQU *
X L R15,=A(SET)
X BALR R14,R15 CALL "SET" SUBROUTINE
X LTR R15,R15 CHECK RETCODE
X BZ PROMPT
X WRTERM 'Illegal Set Command'
X B PROMPT
XSHOSW EQU *
X L R15,=A(SHOW)
X BALR R14,R15 CALL "SHOW" SUBROUTINE
X LTR R15,R15 CHECK RETCODE
X BZ PROMPT
X WRTERM 'Illegal Show Command'
X B PROMPT
XSTATSW EQU *
X CLI 8(R6),C'?' NEED HELP?
X BNE GIVSTAT
X WRTERM 'Confirm with a carriage return'
X B PROMPT
XGIVSTAT CLI OLDERR,X'FF' WAS THERE AN ERROR LAST TIME?
X BNE FAIL
X WRTERM 'Kermit completed successfully'
X B PROMPT
XFAIL SR R5,R5
X IC R5,OLDERR GET OFFSET INTO ERROR TABLE
X M R4,=F'20' OFFSET := ERRNUM * 20
X LA R5,ERRTAB(R5)
X WRTERM (R5),20 PRINT ERROR MSG ON SCREEN
X B PROMPT AND LEAVE
XHELPSW CLI 8(R6),C'?' NEED HELP?
X BNE GIVHLP
X WRTERM 'Confirm with a carriage return'
X B PROMPT
XGIVHLP LA R1,HLPMSG GET LOCATION OF HELP MESSAGE
X SVC 202 SUPERVISOR CALL
X DC AL4(*+8) PRINT ERR MSG IF FAILED
X B PROMPT RETURN IF NO
X WRTERM 'No help available'
X B PROMPT
XSYSCMD CLI 8(R6),C'?' NEED HELP?
X BNE GIVSYS
X WRTERM 'Issue a CMS/CP command'
X B PROMPT
XGIVSYS CLC 8(8,R6),=8X'FF' ANY COMMAND?
X BE SYSERR DIE IF NO
X LA R1,0(R6) REST OF THE CMS COMMAND
X CLC 0(3,R6),=C'CMS' CMS OR CP COMMAND?
X BNE GIVSVC
X LA R1,8(R6) IGNORE THE "CMS" PART
XGIVSVC SVC 202 ISSUE THE COMMAND
X DC AL4(*+8) PRINT ERR MSG IF FAILED
X B PROMPT
X LR R5,R15 GET RETCODE
X LINEDIT TEXT='Command rc equals ........',SUB=(DEC,(R5))
X B PROMPT
XSYSERR WRTERM 'No command supplied'
X B PROMPT
XLEAVE CLI 8(R6),C'?' NEED HELP?
X BNE KRET NO, JUST LEAVE
X WRTERM 'Confirm with a carriage return'
X B PROMPT
XBADDEV WRTERM 'An Ascii terminal must be used.'
X B RET
XKRET EQU *
X USING NUCON,0 USE TO RESET BLIP
X L R7,AEXTSECT ADDR OF EXTSECT
X USING EXTSECT,R7 RESTORE USER'S BLIP CHAR
X DMSEXS MVC,TIMCHAR(1),BLIP
X DROP R7
X* RESTORE USER'S TERMINAL LINESIZE
X LINEDIT TEXT='TERM LINES ........',SUB=(DECA,LINSIZ), *
X DOT=NO,DISP=CPCOMM
XRET EQU *
X L R13,4(R13)
X L R14,12(R13)
X LM R0,R12,20(R13)
X BR R14
X*
XKSAVE DS 18F KERMIT'S SAVE AREA
X LTORG
X DROP R11
X DROP R12 NO LONGER NEED THEM
X EJECT
XINIT CSECT
X STM R14,R12,12(R13)
X BALR R12,0
X USING *,R12
X LA R14,ISAVE
X ST R13,4(R14)
X ST R14,8(R13)
X LR R13,R14
X*
X* INITIALIZE VARIABLES THAT GET CHANGED DURING EXECUTION
X* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA LIST
X L R11,=A(PARMS)
X USING PARMS,R11
X XC SNDPKT,SNDPKT CLEAR OUT THESE BUFFERS
X XC RECPKT,RECPKT
X XC INPUT,INPUT
X LA R0,BUF
X LA R1,L'BUF ; CLEAR OUT THE BUFFER.
X SR R15,R15
X MVCL R0,R14
X LA R0,RBUF
X LA R1,L'RBUF
X SR R15,R15
X MVCL R0,R14
X XC FSENT,FSENT
X XC SDAT,SDAT
X XC RDAT,RDAT
X XC N,N SET VARIABLES TO ZERO
X XC NUM,NUM
X XC LSDAT,LSDAT
X XC LRDAT,LRDAT
X MVI FLAGS,X'00' CLEAR ALL FLAGS
X XC SAVPL,SAVPL
X XC RSAVPL,RSAVPL
X XC NUMTRY,NUMTRY
X MVC FILNAM,=18X'20' BLANK OUT FILNAM & NAME
X MVC NAME,=18X'20'
X MVI PREV,X'00'
X MVI ERRNUM,X'FF' SET TO NO ERROR FOR NOW
X MVI OLDERR,X'FF' SAME HERE
X MVC FST(4),=X'FF000000'
X MVC ADT(4),=X'FF000000'
X XC PKVAR,PKVAR ZERO IT OUT
X XC OLDTRY,OLDTRY
X XC SPSIZ,SPSIZ
X XC SIZE,SIZE
X XC TEMP,TEMP
X XC NFSENT,NFSENT ZERO FILES SENT,INITIALLY
X XC STORLOC,STORLOC
X MVC LRECL(1),DLRECL SET DEFAULTS, JUST IN CASE
X MVC RFM(1),DRECFM
X MVC FM(2),DFM
X MVC QUOCHAR(1),DQUOTE
X MVC RQUO(1),DQUOTE
X MVC REOL(1),DEOL
X MVC SEOL(1),DEOL
X MVI STATE,C' '
X MVI STYPE,C' '
X MVI RTYPE,C' '
X*
XINITRET L R13,4(R13)
X L R14,12(R13)
X LM R0,R12,20(R13)
X BR R14
XISAVE DS 18F
X LTORG
X DROP R11
X DROP R12
X EJECT
XPARMS CSECT GLOBAL DATA LIST
XSNDPKT DS CL130 SEND THIS TO MICRO
X ORG SNDPKT
XPHDR DS X
XPLEN DS X
XPNUM DS X
XPTYPE DS X
XPDATA DS 0C
X ORG ,
XRECPKT DS CL130 RECEIVE THIS FROM MICRO
XLSDAT DS F SEND PACKET SIZE
XLRDAT DS F RECEIVE PACKET SIZE
XFLAGS DC X'00' USE TO TEST OUR FLAGS
XFILINFO DC A(NAME) DATA FOR "NEXTFST" ROUTINE
X DC A(ADT)
X DC X'80',AL3(FST)
XHLPMSG DC CL8'HELP' USE FOR CMS 'HELP' COMMAND
X DC CL8'KERMIT' TOKENIZE TO 8 CHARACTERS
X DC 8X'FF' NO MORE INFO
XNAME DC 18X'20' NAME OF FILE(S) TO SEND
X DS 0F
XFST DC X'FF',AL3(0) USE FOR "NEXTFST" ROUTINE
XADT DC X'FF',AL3(0) THIS TOO
X DS 0F
XINPUT DS CL130 INPUT BUFFER
X DS 0F
XBUF DS CL260 FSREAD INTO HERE
XRBUF DS CL260 FSWRITE FROM HERE
XFSENT DS CL160 TABLE OF FILES SENT SO FAR
XN DC F'0' SEND PACKET NUMBER
XNUM DC F'0' RECEIVE PACKET NUMBER
XNUMTRY DC F'0' TRIAL COUNTER FOR TRANSFERS
XOLDTRY DS F COUNTER FOR PREVIOUS PACKET
XNFSENT DC F'0' NUMBER OF FILES SENT
XSTORLOC DS F POINTER TO EXTRA STORAGE
XMAXPACK DC F'94' MAX PACKET SIZE
XRECL DS F RECORD LEN (IF RECFM = V)
XRPSIZ DC F'94' MAX RECEIVE PACKET SIZE
XDSSIZ DC F'40' DEFAULT MAX SEND PACKET SIZE
XSPSIZ DS F SEND PACKET SIZE
XMAXTRY DC F'5' NO. OF TIMES TO RETRY PACKET
XIMXTRY DC F'16' NO. OF INITIAL TRIALS ALLOWED
XSIZE DS F MAX SIZE FOR SEND DATA
XDEL DC F'127' OCTAL 177 (DELETE CHAR)
XZERO DC F'0'
XONE DC F'1'
XFIVE DC F'5'
XTWO DC F'2'
XSPACE DC F'32' ASCII SPACE
XO1H DC F'64' OCTAL 100
XO2H DC F'128' OCTAL 200
XSAVPL DC F'0' POINTER WITHIN BUF,INIT=0
XRSAVPL DC F'0' POINTER IN 'PTCHR',INIT=0
XDQUOTE DC X'23' DEFAULT QUOTE CHARACTER = #
XQUOCHAR DS X QOUTE CHAR WE'LL SEND
XRQUO DS X MICRO'S QUOTE CHAR
XTEMP DS F TEMPORARY SPACE
X DS 0D
XPKVAR DS D USE FOR PICKING UP INTEGER
XSDAT DS CL130 TEMP PLACE FOR SEND DATA
XRDAT DS CL130 TEMP PLACE FOR RECEIVE DATA
XFILNAM DS CL18 SEND/REC FILENAME
XSTATE DS C OUR CURRENT STATE
XDFM DC CL2'A1' DEFAULT FILEMODE
XFM DS CL2 FILEMODE USER WANTS
XDEOL DC X'0D' DEFAULT END OF PACKET (CR)
XREOL DS X EOL CHAR I NEED (CR)
XSEOL DS X EOL I'LL SEND
XDLRECL DC X'50' DEFAULT LRECL SIZE OF 80
XLRECL DS X LRECL PROGRAM WILL USE
XDRECFM DC C'V' DEFAULT WITH VARIABLE RECFM
XRFM DS C RECFM PROGRAM WILL USE
XPREV DS C PREVIOUS CHAR REC (IN PTCHR)
XBLIP DS X SAVE USER'S BLIP CHAR
XLINSIZ DS F SAVE USER'S CONSOLE LINESIZE
XERRNUM DS X ERROR NUMBER,IN CASE WE DIE
XOLDERR DS X ERROR OF PREVIOUS EXECUTION
XSTYPE DS C TYPE OF PACKET SENT
XRTYPE DS C TYPE OF PACKET RECEIVED
X* THIS IS THE ASCII TO EBCDIC TABLE
XATOE DC X'00010203372D2E2F1605250B0C0D0E0F'
X DC X'101112133C3D322618193F271C1D1E1F'
X DC X'405A7F7B5B6C507D4D5D5C4E6B604B61'
X DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
X DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
X DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'
X DC X'79818283848586878889919293949596'
X DC X'979899A2A3A4A5A6A7A8A9C04FD0A107'
X*THIS IS THE EBCDIC TO ASCII CONVERSION TABLE
X*CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A NULL
XETOA DC X'000102030009007F0000000B0C0D0E0F'
X DC X'1011121300000800181900001C1D1E1F'
X DC X'00000000000A171B0000000000050607'
X DC X'0000160000000004000000001415001A'
X DC X'20000000000000000000002E3C282B7C'
X DC X'2600000000000000000021242A293B5E'
X DC X'2D2F00000000000000007C2C255F3E3F'
X DC X'000000000000000000603A2340273D22'
X DC X'00616263646566676869007B00000000'
X DC X'006A6B6C6D6E6F707172007D00000000'
X DC X'007E737475767778797A0000005B0000'
X DC X'000000000000000000000000005D0000'
X DC X'7B414243444546474849000000000000'
X DC X'7D4A4B4C4D4E4F505152000000000000'
X DC X'5C00535455565758595A000000000000'
X DC X'303132333435363738397C0000000000'
X*
X* TABLE OF ERROR MESSAGES (IN CASE WE ABORT)
XERRTAB DC CL20'Bad send-packet size' ERR MSG #0
X DC CL20'Bad message number' ERR MSG #1
X DC CL20'Unrecognized state' ERR MSG #2
X DC CL20'No SOH encountered' ERR MSG #3
X DC CL20'Bad character count' ERR MSG #4
X DC CL20'Bad checksum' ERR MSG #5
X DC CL20'Disk is full' ERR MSG #6
X DC CL20'Illegal packet type' ERR MSG #7
X DC CL20'Lost a packet' ERR MSG #8
X DC CL20'Micro sent a NAK' ERR MSG #9
X DC CL20'Micro aborted' ERR MSG #10
X DC CL20'Illegal file name' ERR MSG #11
X DC CL20'Invalid lrecl' ERR MSG #12
X DC CL20'Permanent I/O error' ERR MSG #13
X DC CL20'Disk is read-only' ERR MSG #14
X DC CL20'Recfm conflict' ERR MSG #15
X DC CL20'Err allocating space' ERR MSG #16
X LTORG
X EJECT
XSET CSECT
X STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
X BALR R12,0 ESTABLISH ADDRESSABILITY
X USING *,R12
X LA R14,SETSAVE ADDRESS OF MY SAVE AREA
X ST R13,4(R14) SAVE CALLER'S
X ST R14,8(R13)
X LR R13,R14
X* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
X L R11,=A(PARMS)
X USING PARMS,R11 ESTABLISH ADDRESSABILITY
X LA R6,8(R6) PICK UP NEXT TOKEN
X CLI 0(R6),C'?' NEED HELP ?
X BNE NOQ
X WRTERM 'Recfm, End-of-Line, Quote, Lrecl, Packet-size'
X B SETOK
XNOQ CLC 0(5,R6),=CL5'RECFM'
X BNE NOREC
X LA R6,8(R6) PICK UP RECORD FORMAT
X CLI 0(R6),C'?'
X BNE CHKFM
X WRTERM 'f or v (default of v)'
X B SETOK
XCHKFM CLI 0(R6),C'V' REDUNDANT
X BE FMSET
X CLI 0(R6),C'F' FIXED FORMAT?
X BNE RECERR
XFMSET MVC RFM(1),0(R6) PICK UP RECFM
X B SETOK
XRECERR WRTERM 'Fixed and variable files only'
X B SETERR
XNOREC CLC 0(5,R6),=C'QUOTE' QUOTE CHARACTER
X BNE NOQUO
X LA R6,8(R6) GET NEXT TOKEN
X CLI 0(R6),X'FF' VALUE NOT SUPPLIED?
X BNE GIVQ
X WRTERM '?not confirmed'
X B SETERR
XGIVQ CLC 0(2,R6),=C'? '
X BNE GETQUO
X WRTERM 'a single character'
X B SETOK
XGETQUO MVC QUOCHAR(1),0(R6) SET NEW QUOTE CHAR
X TR QUOCHAR(1),ETOA GET ASCII FORM
X CLI 1(R6),C' ' IS IT ONLY ONE CHAR?
X BE ISQOK
X WRTERM 'one character only'
X B SETERR
XISQOK CLI QUOCHAR,X'21' CAN'T BE LESS THAN 32
X BL BADQUO
X CLI QUOCHAR,X'7E' CAN'T BE LARGER THAN 126
X BH BADQUO
X CLI QUOCHAR,X'3E' HAS TO BE BETWEEN 32-62
X BNH SETOK
X CLI QUOCHAR,X'60' OR BETWEEN 96-126
X BNL SETOK
XBADQUO WRTERM 'Must fall between 41-76,140,or 173-176 (octal).'
X B SETERR
XNOQUO CLC 0(5,R6),=C'LRECL' LRECL SIZE
X BNE NORCL
X LA R6,8(R6) PICK UP NEXT TOKEN
X CLI 0(R6),C'?' HELP ?
X BNE GETREC
X WRTERM 'Logical Record Length (default of 80).'
X B SETOK
XGETREC CLI 0(R6),X'FF' NO VALUE GIVEN
X BNE CALC
X WRTERM '?not confirmed'
X B SETERR
XCALC CLI 0(R6),X'F0' MUST BE >= TO 0
X BL BADREC
X CLI 0(R6),X'F9' MUST BE <= TO 9
X BH BADREC
X XC PKVAR,PKVAR EMPTY IT OUT
X SR R4,R4 LENGTH OF NUMBER
X CLI 1(R6),C' ' TWO DIGITS?
X BNE CALC2
X EX R4,PCK
X B TST
XCALC2 LA R4,1(R4) ADD ONE
X CLI 2(R6),C' ' THREE DIGITS?
X BNE CALC3
X EX R4,PCK
X B TST
XCALC3 LA R4,1(R4) IS THERE AN ERROR?
X CLI 3(R6),C' '
X BNE BADREC
X EX R4,PCK
XTST CVB R7,PKVAR
X C R7,=X'00000085' MAX OF 133 FOR LRECL
X BH BADREC
X STC R7,LRECL SET THE LRECL VALUE
X B SETOK
XBADREC WRTERM 'A number with a maximum of 133.'
X B SETERR
XNORCL CLC 0(3,R6),=C'END' EOL CHARACTER
X BNE NOEND
X LA R6,8(R6) NEXT TOKEN
X CLI 0(R6),X'FF' NOT DATA
X BNE EOLCHAR
X WRTERM '?not confirmed'
X B SETERR
XEOLCHAR CLI 0(R6),C'?' NEED HELP?
X BNE GETEOL
X WRTERM 'A two digit number between 00 and 31 (dec).'
X B SETOK
XGETEOL CLI 0(R6),X'F0' MUST BE >= TO 0
X BL BADEOL
X CLI 0(R6),X'F9' MUST BE <= TO 9
X BH BADEOL
X XC PKVAR,PKVAR USE TO CONVERT VALUE
X CLI 1(R6),C' ' INPUT MUST BE TWO CHARS
X BE BADEOL
X CLI 2(R6),C' ' TWO CHARS, AT MAX
X BNE BADEOL
X PACK PKVAR(8),0(2,R6) PICK UP TWO CHARACTERS
X CVB R7,PKVAR PUT PACKED DECIMAL INTO REG
X C R7,=X'0000001F' MAX OF 31 DECIMAL
X BH BADEOL
X STC R7,SEOL SET SEND EOL VALUE
X B SETOK
XBADEOL WRTERM 'Must be a two digit value less than 31 (dec).'
X B SETERR
XNOEND CLC 0(3,R6),=C'PAC' CHANGE RECEIVE PACKET SIZE
X BNE SETERR
X LA R6,8(R6) GET NEXT TOKEN
X CLI 0(R6),X'FF' NO DATA
X BNE GETPAC
X WRTERM '?not confirmed'
X B SETERR
XGETPAC CLI 0(R6),C'?' NEED HELP?
X BNE CALC4
X WRTERM 'Receive packet size (range: 26-94 decimal).'
X B SETOK
XCALC4 CLI 0(R6),X'F0' MUST BE >= TO 0
X BL BADPAC
X CLI 0(R6),X'F9' MUST BE <= TO 9
X BH BADPAC
X XC PKVAR,PKVAR USE TO CONVERT VALUE
X CLI 1(R6),C' ' INPUT MUST BE TWO CHARS
X BE BADPAC
X CLI 2(R6),C' ' TWO CHARS, AT MAX
X BNE BADPAC
X PACK PKVAR(8),0(2,R6) PICK UP TWO CHARS
X CVB R7,PKVAR PUT PACKED DECIMAL INTO REG
X C R7,=F'26' THIS IS MIN
X BL BADPAC
X C R7,MAXPACK THIS IS THE MAX
X BH BADPAC
X ST R7,RPSIZ USE THIS VALUE NOW
X B SETOK
XBADPAC WRTERM 'Must be between 26-94 (decimal).'
XSETERR MVC QUOCHAR(1),DQUOTE RESET VALUE, JUST IN CASE
X LA R15,4 SET A NON-ZERO RETCODE
X B SETRET
XSETOK SR R15,R15 RETCODE OF 0
X*
XSETRET L R13,4(R13)
X L R14,12(R13)
X LM R0,R12,20(R13)
X BR R14
XSETSAVE DS 18F
XPCK PACK PKVAR(8),0(0,R6)
X LTORG
X DROP R11
X DROP R12
X EJECT
XSHOW CSECT
X STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
X BALR R12,0 ESTABLISH ADDRESSABILITY
X USING *,R12
X LA R14,SHOWSAVE ADDRESS OF MY SAVE AREA
X ST R13,4(R14) SAVE CALLER'S
X ST R14,8(R13)
X LR R13,R14
X* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
X L R11,=A(PARMS)
X USING PARMS,R11 ESTABLISH ADDRESSABILITY
X LA R6,8(R6) PICK UP NEXT TOKEN
X CLI 0(R6),C'?' NEED HELP ?
X BNE SHOREC
X WRTERM 'Recfm, End-of-Line, Quote, Lrecl, Packet-size'
X B SHOWOK
XSHOREC CLC 0(5,R6),=CL5'RECFM'
X BNE SHOQUO
X LINEDIT TEXT='The record format is ..',SUB=(CHARA,(RFM,1))
X B SHOWOK
XSHOQUO CLC 0(5,R6),=C'QUOTE'
X BNE SHORCL
X TR QUOCHAR(1),ATOE GET EBCDIC VERSION
X LINEDIT TEXT='The quote character is ..', *
X SUB=(CHARA,(QUOCHAR,1))
X TR QUOCHAR(1),ETOA KEEP THE ASCII FORM AROUND
X B SHOWOK
XSHORCL CLC 0(5,R6),=C'LRECL'
X BNE SHOEND
X SR R4,R4 ZERO IT OUT
X IC R4,LRECL
X LINEDIT TEXT='Lrecl is ........',SUB=(DEC,(R4))
X B SHOWOK
XSHOEND CLC 0(3,R6),=C'END'
X BNE SHOPAC
X SR R4,R4 ZERO IT OUT
X IC R4,SEOL
X LINEDIT TEXT='End-of-Line character is ...... (decimal)', *
X SUB=(DEC,(R4))
X B SHOWOK
XSHOPAC CLC 0(3,R6),=C'PAC' PACKET LENGTH ?
X BNE SHOWERR
X LINEDIT TEXT='Receive packet size is ........ (decimal)', *
X SUB=(DECA,RPSIZ)
X B SHOWOK
XSHOWERR LA R15,4 SET A NON-ZERO RETCODE
X B SHOWRET
XSHOWOK SR R15,R15 ZERO RETCODE
X*
XSHOWRET L R13,4(R13)
X L R14,12(R13)
X LM R0,R12,20(R13)
X BR R14
XSHOWSAVE DS 18F
X LTORG
X DROP R11
X DROP R12
X EJECT
XSEND CSECT
X STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
X BALR R12,0 ESTABLISH ADDRESSABILITY
X USING *,R12
X LA R14,SENDSAVE ADDRESS OF MY SAVE AREA
X ST R13,4(R14) SAVE CALLER'S
X ST R14,8(R13)
X LR R13,R14
X* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
X L R11,=A(PARMS)
X USING PARMS,R11 ESTABLISH ADDRESSABILITY
X MVI STATE,C'S'
X SR R3,R3
X ST R3,N
X ST R3,NUMTRY
X MVC FST(4),=X'FF000000' INITIALIZATION STUFF
X MVC ADT(4),=X'FF000000' HERE TOO,IN CASE OF RETRY
XNXTFIL LA R1,FILINFO STUFF NEED TO GET FNAME(S)
X L R15,=V(NEXTFST)
X BALR R14,R15 GET NEXT/FIRST FILE
X LTR R5,R15 COPY RETCODE
X BNZ NOFIND RETCODE OF ZERO = ALL OK
X L R9,FST GET INFO FROM FSTTABLE
X USING FSTD,R9
X MVC FILNAM(8),FSTFNAME GET FNAME
X MVC FILNAM+8(8),FSTFTYPE
X MVC FILNAM+16(2),FSTFMODE
X L R9,ADT
X USING ADTSECT,R9
X LA R5,ADTM
X MVC FILNAM+16(1),0(R5) GET CORRECT FMODE
X LA R5,FSENT TABLE W/FILES SENT SO FAR
X LR R7,R5 KEEP TRACK OF TABLE
X LA R7,160(R7) HERE, WE'RE PAST THE TABLE
X L R4,NFSENT HOW MANY SENT SO FAR
XFILLOOP LTR R4,R4
X BZ OKSND
X BCTR R4,0 DECREMENT COUNTER
X CLC 0(16,R5),FILNAM SENT ALREADY?
X BE NXTFIL DON'T RESEND
X LA R5,16(R5) CHECK NEXT FILE
X CR R5,R7
X BNE FILLOOP
X L R5,STORLOC SEARCH HERE NOW
X B FILLOOP
XOKSND TM FLAGS,FLG1 IS THIS THE FIRST FILE?
X BNO SLOOP ONLY WAIT 10 SECS IF YES
X NI FLAGS,X'FF'-FLG1 TURN OFF FIRST FILE FLAG
X LA 1,=C'SL 10 SEC' SLEEP BEFORE SENDING
X LA 0,9 COMMAND LENGTH IS 9
X DIAG 1,0,8 SHOW IT'S A CP COMMAND
XSLOOP CLI STATE,C'D' SEND DATA STATE
X BE SDATA
X CLI STATE,C'F' SEND FILE STATE
X BE SFILE
X CLI STATE,C'S' SEND INIT STATE
X BE SINIT
X CLI STATE,C'Z' END OF FILE STATE
X BE SEOF
X CLI STATE,C'B' SEND BREAK STATE
X BE SBREAK
X CLI STATE,C'C' COMPLETE STATE
X BE COMPLETE
X CLI STATE,C'A' ABORT STATE
X BE ABORT ERROR - GO TO ABORT STATE
X MVI ERRNUM,X'02' UNRECOGNIZED STATE
X B ABORT OTHERWISE, DIE
XSINIT CLC NUMTRY,IMXTRY SEE IF CAN SEND
X BL OK1 YES WE CAN
X MVI STATE,C'A' NOPE, GO INTO ABORT STATE
X B SLOOP
XOK1 L R5,SPACE MAKE CHARACTER PRINTABLE
X A R5,RPSIZ ADD REC PACKET SIZE
X STC R5,SDAT ADD SIZE INFO TO BUFFER
X L R5,SPACE
X A R5,=F'8' 8 FOR TIMEOUT
X STC R5,SDAT+1
X L R5,SPACE SEND ZERO + " " FOR NPAD
X STC R5,SDAT+2 WE'RE THE SLOW GUYS
X SR R5,R5 PAD WITH NULLS
X L R3,O1H
X XR R5,R3 CTL FUNCTION (XOR WITH 64)
X STC R5,SDAT+3 DON'T NEED PADCHAR EITHER
X SR R5,R5 ZERO IT OUT FOR NEXT TWO GUYS
X IC R5,REOL EOL CHAR I NEED
X A R5,SPACE MAKE PRINTABLE
X STC R5,SDAT+4
X IC R5,QUOCHAR MY QUOTE CHAR
X STC R5,SDAT+5
X L R3,NUMTRY
X LA R3,1(R3) INCREMENT TRIAL COUNTER
X ST R3,NUMTRY
X MVI STYPE,AS PACKET TYPE = SEND INITIATE
X MVC LSDAT(4),=F'6' BUFFER SIZE FOR THIS SEND
X L R4,DSSIZ GET DEFAULT SPSIZ
X S R4,FIVE FOR NOW, USE DEFAULT SPSIZ....
X ST R4,SIZE ....TO SET VALUE OF SIZE
X L R15,=A(SPACK) GET ADDRESS OF ROUTINE 'SPACK'
X BALR 14,15 SAVE * AND GO TO SPACK
X CLI STATE,C'A'
X BE ABORT
X L 15,=A(RPACK) GET ADDRESS OF 'RPACK'
X BALR 14,15 SAVE * AND GO TO RPACK
X CLI RTYPE,AE ERROR PACKET?
X BNE Y1 NO, THEN MAYBE AN ACK
X MVI ERRNUM,X'0A' MICRO DIED
X MVI STATE,C'A' AND DIE
X B SLOOP
XY1 CLI RTYPE,AY SEE IF GOT ACK
X BNE N1 MAYBE IT'S 'N'
X CLC N,NUM CHECK MESSAGE NUMBERS
X BE AOK1
X MVI ERRNUM,X'08' PACKET LOST
X B SLOOP
XAOK1 SR R4,R4 ZERO OUT REGISTER
X IC R4,RDAT USE SPSIZ THE MICRO WANTS
X S R4,SPACE SUBTRACT THE ' '
X C R4,=F'26' BUFFER HAS TO BE >= 26
X BNL CH1 SO FAR, SO GOOD
X MVI STATE,C'A' ABORT THEN
X MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR
X B SLOOP
XCH1 C R4,MAXPACK MAX PACKET SIZE
X BNH CH2 CONTINUE IF <= TO MAX
X MVI STATE,C'A' DIE
X MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR
X B SLOOP
XCH2 STC R4,SPSIZ+3 USE SPSIZ THE MICRO WANTS
X S R4,FIVE
X ST R4,SIZE SET SIZE TO SPSIZ-5
X CLC LRDAT(4),=F'4' USING DEFAULTS?
X BNH NOCHG YUP
X LA R5,RDAT POINTER TO THE BUFFER
X SR R7,R7
X IC R7,4(R5) SEOL MICRO WANTS
X S R7,SPACE UNCHAR (IE - SUBTRACT SPACE)
X STC R7,SEOL
XNOCHG MVI STATE,C'F' PUT INTO SEND FILE STATE
X XC NUMTRY,NUMTRY RESET TO ZERO
X L R3,N
X LA R3,1(R3) ADD ONE
X ST R3,N STORE VALUE INCREMENTED BY 1
X NC N(4),=X'0000003F' MASK TO GET MOD 64
X B SLOOP
XN1 CLI RTYPE,AN SEE IF IT'S 'N'
X BNE AB1 IF NOT, DIE
X TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED?
X BO SLOOP LEAVE ERR MSG AS IS IF I DID
X MVI ERRNUM,X'09' MICRO NAK'ED
X B SLOOP
XAB1 MVI STATE,C'A' ELSE, ABORT
X MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE
X B SLOOP
XSFILE CLC NUMTRY,MAXTRY EXCEEDED NO. OF TRIES ALLOWED?
X BL OK2 NOPE, STILL OK
X MVI STATE,C'A' ABORT IF YES
X B SLOOP
XOK2 TR FILNAM,ETOA
X LA R4,FILNAM BEGINNING OF BUFFER
X SR R1,R1
X TRT FILNAM(8),PARSE SEND A DOT INSTEAD OF PARSES
X BNZ SP
X L R4,=F'8' FUDGE THE LENGTH
X B SP2
XSP SR R1,R4 WHERE THE TRT STOPPED
X LR R4,R1 HAVE LENGTH OF THE FN
XSP2 LR R5,R4 COUNTER FOR LENTH OF FILNAM
X BCTR R4,0 ONE LESS FOR 'EX' COMMAND
X EX R4,FIRST PICK UP THE FN
X LA R4,SDAT(R5) PUT THE DOT HERE
X MVI 0(R4),X'2E' ADD AN ASCII DOT
X LA R5,1(R5) ADD ONE TO COUNTER
X LA R4,FILNAM
X LA R4,8(R4) NEXT AREA OF THE FILNAM
X SR R1,R1
X TRT FILNAM+8(8),PARSE
X BNZ SP3
X L R4,=F'8' FUDGE THE LENGTH
X B SP4
XSP3 SR R1,R4
X LR R4,R1 WHERE WE STOPPED
XSP4 LA R7,SDAT(R5) NEXT FREE SPOT
X AR R5,R4 LENGTH OF NAME WITH DOT
X BCTR R4,0 MINUS ONE FOR THE 'EX'
X EX R4,SECOND PICK UP FT
X L R3,NUMTRY
X LA R3,1(R3) INCREMENT TRIAL COUNTER
X ST R3,NUMTRY
X MVI STYPE,AF PACKET TYPE = FILE HEADER
X ST R5,LSDAT SET BUFFER SIZE
X TR FILNAM,ATOE
X L R3,NFSENT
X LR R4,R3 SAVE VALUE
X C R4,=F'10' NEED MORE SPACE?
X BE ADDSP
X BH ADDSP2
X M R2,=F'16' GET OFFSET INTO TABLE
X LA R3,FSENT(R3) POINTER INTO TABLE
X MVC 0(16,R3),FILNAM SAVE FILENAME YOU'RE SENDING
X LA R4,1(R4) INCREMENT NUMBER OF FILES SENT
X ST R4,NFSENT
X B SNDFIL
XADDSP LA R0,4096/8 GET 4K BLOCK
X DMSFREE DWORDS=(0),ERR=ERRSP,MSG=NO
X ST R1,STORLOC POINTS TO EXTRA DATA AREA
X OI FLAGS,FLG5 GOT MORE SPACE (TURN ON FLAG)
XADDSP2 LR R3,R4 GET CORRECT LENGTH AGAIN
X S R3,=F'10' GET PROPER POINTER
X M R2,=F'16' OFFSET INTO TABLE
X A R3,STORLOC LOC IN TABLE
X MVC 0(16,R3),FILNAM SAVE FILENAME
X LA R4,1(R4) INCREMENT FILE COUNTER
X ST R4,NFSENT
X B SNDFIL
XERRSP MVI ERRNUM,X'10' ERR ALLOCATING MORE SPACE
X MVI STATE,C'A' ABORT NOW
X B SLOOP
XSNDFIL L R15,=A(SPACK) GET ADDRESS OF 'SPACK'
X BALR 14,15 SAVE * AND GO TO SPACK
X CLI STATE,C'A'
X BE ABORT
X L 15,=A(RPACK) GET ADDRESS OF 'RPACK'
X BALR 14,15 SAVE * AND GO TO RPACK
X CLI RTYPE,AE ERROR PACKET?
X BNE Y2 MAYBE AN ACK
X MVI ERRNUM,X'0A' MICRO DIED
X MVI STATE,C'A' SO WE DO TOO
X B SLOOP
XY2 CLI RTYPE,AY SEE IF GOT ACK
X BNE N2 MAYBE GOT AN 'N'
X CLC N,NUM DO WE HAVE THE CORRECT ACK?
X BE AOK2
X MVI ERRNUM,X'08' MISSING A PACKET SOMEWHERE
X B SLOOP
XAOK2 MVI STATE,C'D' PREPARE FOR SEND-DATA STATE
X XC NUMTRY,NUMTRY RESET COUNTER
X L R3,N
X LA R3,1(R3) ADD ONE
X ST R3,N STORE INCREMENTED VALUE
X NC N(4),=X'0000003F' MASK TO GET MOD 64
X L 15,=A(GTCHR)
X BALR 14,15 DO GET-CHAR AND COME BACK
X B SLOOP
XN2 CLI RTYPE,AN
X BNE AB2 ELSE, DIE
X TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED?
X BO SLOOP LEAVE ERR MSG AS IS IF I DID
X MVI ERRNUM,X'09' MICRO NAK'ED
X B SLOOP
XAB2 MVI STATE,C'A' ELSE, ABORT
X MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE
X B SLOOP
XSDATA CLC NUMTRY,MAXTRY CAN WE DO IT?
X BL OK4 YES
X MVI STATE,C'A' ELSE ABORT
X B SLOOP
XOK4 L R3,NUMTRY
X LA R3,1(R3) INCREMENT COUNTER
X ST R3,NUMTRY
X MVI STYPE,AD PACKET TYPE = DATA
X L R15,=A(SPACK)
X BALR 14,15 GO TO SPACK AND RETURN
X CLI STATE,C'A'
X BE ABORT
X L 15,=A(RPACK)
X BALR 14,15 SAME FOR RPACK
X CLI RTYPE,AE ERROR PACKET?
X BNE Y4 MAYBE AN ACK
X MVI ERRNUM,X'0A' MICRO DIED
X MVI STATE,C'A' SO WE DO TOO
X B SLOOP
XY4 CLI RTYPE,AY SEE IF GOT 'ACK'
X BNE N4 SEE IF IT'S AN 'N'
X CLC N,NUM DO WE HAVE THE CORRECT ACK?
X BE AOK4
X MVI ERRNUM,X'08' MISSING A PACKET
X B SLOOP
XAOK4 XC NUMTRY,NUMTRY RESET COUNTER
X L R3,N
X LA R3,1(R3) INCREMENT COUNTER
X ST R3,N
X NC N(4),=X'0000003F' MASK TO GET MOD 64
X L 15,=A(GTCHR)
X BALR 14,15 DO GET-CHAR AND RETURN
X B SLOOP
XN4 CLI RTYPE,AN
X BNE AB4
X TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED?
X BO SLOOP LEAVE ERR MSG AS IS IF I DID
X MVI ERRNUM,X'09' MICRO NAK'ED
X B SLOOP
XAB4 MVI STATE,C'A'
X MVI ERRNUM,X'07' ILLEGAL PACKET TYPE
X B SLOOP
XSEOF CLC NUMTRY,MAXTRY CAN WE DO IT?
X BL OK5 BRANCH IF YES
X MVI STATE,C'A' ABORT IF NO
X B SLOOP
XOK5 L R3,NUMTRY
X LA R3,1(R3) ADD ONE
X ST R3,NUMTRY STORE INCREMENTED COUNTER
X MVI STYPE,AZ PACKET TYPE = EOF
X XC LSDAT,LSDAT LENGTH OF ZERO
X L R15,=A(SPACK)
X BALR 14,15 SAVE * AND GO TO SPACK
X CLI STATE,C'A'
X BE ABORT
X L 15,=A(RPACK)
X BALR 14,15 SAME FOR RPACK
X CLI RTYPE,AE ERROR PACKET?
X BNE Y5 MAYBE AN ACK
X MVI ERRNUM,X'0A' MICRO DIED
X MVI STATE,C'A' SO WE DO TOO
X B SLOOP
XY5 CLI RTYPE,AY CHECK FOR 'ACK'
X BNE N5 MAYBE WAS A 'NAK'
X CLC N,NUM CORRECT ACK?
X BE AOK5
X MVI ERRNUM,X'08' LOST A PACKET
X B SLOOP
XAOK5 L R3,N
X LA R3,1(R3) ADD ONE
X ST R3,N STORE VALUE INCREMENTED BY 1
X NC N(4),=X'0000003F' MASK TO GET MOD 64
X MVI STATE,C'F' SET TO SEND FILE FOR NOW
X B NXTFIL GET-NEXT-FILE
XNOFIND TM FLAGS,FLG1 DID IT DIE ON FIRST TRY?
X BNO DIEOK NO ONES == NOT FIRST
X WRTERM 'File not found'
X MVI STATE,C'A' ABORT THIS ONE
X B SLOOP
XDIEOK MVI STATE,C'B' BREAK CONNECTION
X B SLOOP
XN5 CLI RTYPE,AN
X BNE AB5 DIE IF NOT A NAK
X TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED?
X BO SLOOP LEAVE ERR MSG AS IS IF I DID
X MVI ERRNUM,X'09' MICRO NAK'ED
X B SLOOP
XAB5 MVI STATE,C'A' ELSE, ABORT
X MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE
X B SLOOP
XSBREAK CLC NUMTRY,MAXTRY OVER OUR LIMIT?
X BL OK6 BRANCH IF NO
X MVI STATE,C'A' ABORT IF YES
X B SLOOP
XOK6 L R3,NUMTRY
X LA R3,1(R3) ADD ONE
X ST R3,NUMTRY INCREMEMTED TRIAL COUNTER
X MVI STYPE,AB PACKET TYPE = BREAK
X XC LSDAT,LSDAT LENGTH = ZERO
X L R15,=A(SPACK)
X BALR 14,15 SAVE * AND GO TO SPACK
X CLI STATE,C'A'
X BE ABORT
X L 15,=A(RPACK)
X BALR 14,15 SAVE * AND GO TO RPACK
X CLI RTYPE,AE ERROR PACKET?
X BNE Y6 MAYBE AN ACK
X MVI ERRNUM,X'0A' MICRO DIED
X MVI STATE,C'A' THEN WE DO TOO
X B SLOOP
XY6 CLI RTYPE,AY CHECK FOR ACK
X BNE N6 CHECK FOR 'N'
X CLC N,NUM CORRECT ACK?
X BE AOK6
X MVI ERRNUM,X'08' LOST A PACKET
X B SLOOP
XAOK6 MVI STATE,C'C' COMPLETED STATE
X B SLOOP
XN6 CLI RTYPE,AN CHECK FOR 'N'
X BNE AB6 DIE IF NOT A NAK
X TM FLAGS,FLG4 DID MICRO NAK OR I REJECTED?
X BO SLOOP LEAVE ERR MSG AS IS IF I DID
X MVI ERRNUM,X'09' MICRO NAK'ED
X B SLOOP
XAB6 MVI STATE,C'A' ELSE,ABORT
X MVI ERRNUM,X'07' UNRECOGNIZED PACKET TYPE
X B SLOOP
XGTCHR LA R3,FILNAM GET ADDRESS OF 'FILNAM'
X FSOPEN (R3),FORM=E OPEN FILE FOR I/O
X TM FLAGS,FLG3 SEE IF THERE'S STUFF IN BUF
X BO STUFF ONES -> STUFF'S THERE
X FSREAD (R3),BUFFER=BUF,BSIZE=256,FORM=E
X LTR R4,R15 PUT RESULT OF READ IN R4
X BZ OK8
X C R4,=A(ERCOD) RETCODE OF 12 MEANS EOF
X BNE ERR1 TRY IT AGAIN
X MVI STATE,C'Z' MAKE TO EOF STATE
X FSCLOSE (R3) CLOSE FILE
X BR R14
XERR1 MVI STATE,C'A' ABORT ON FILE SYSTEM ERROR
X MVI ERRNUM,X'0C' INVALID RECORD LENGTH
X C R4,=F'8' WAS OUR GUESS RIGHT?
X BER R14 IF YES, RETURN
X MVI ERRNUM,X'0D' ELSE, GOT AN I/O ERROR
X BR R14
XOK8 LR R5,R0 GET NUMBER OF BYTES READ IN
X LR R4,R5 SAVE ALSO IN R4
X BCTR R4,0 SUBTRACT 1 FOR EX COMMAND
X EX R4,TRANS EBCDIC TO ASCII TRANSLATION
X LA R8,BUF GET LOCATION OF BUFFER INPUT
X LA R9,BUF(R4) LAST POSITION IN THAT BUFFER
XX4 CLI 0(R9),X'20' IS THIS A BLANK?
X BNE X5 NO, FOUND LAST CHAR OF LINE
X BCTR R9,0
X CR R9,R8
X BNL X4 FIND LAST CHAR
X SR R5,R5 ALL BLANKS
X B FOO
XX5 SR R9,R8
X LR R5,R9 LENGTH OF LINE
X LA R5,1(R5) ADD ONE
XFOO LA R9,BUF(R5) FIRST BLANK SPACE AFTER DATA
X MVC 0(1,R9),=X'0D' ADD ASCII CR
X LA R9,1(R9) INCREMENT POINTER
X MVC 0(1,R9),=X'0A' AND ADD ASCII LF
X LA R5,2(R5) TWO EXTRA BYTES OF DATA NOW
X ST R5,RECL LRECL + 2 (FOR CRLF)
X SR R8,R8 ZERO OUT INDEX FOR BUF
XSTUFF SR R9,R9 SAME FOR INDEX FOR SDAT
X SR R10,R10 CHARACTER COUNTER
X SR R5,R5 WILL HOLD QUOCHAR
X IC R5,QUOCHAR
X L R8,SAVPL WHERE WE LEFT OFF
X C R8,RECL SEE IF ARE AT LIMIT
X BNL FULL2 LEAVE IF REACHED OR EXCEEDED
X SR R7,R7
XLOOP IC R7,BUF(R8) PICK UP BYTE
X CR R7,R5 IS IT THE QUOTE CHARACTER?
X BE SPECIAL
X C R7,DEL IS IT THE CHARDEL?
X BE SPECIAL
X C R7,SPACE IS IT A CONTROL CHARACTER?
X BL SPECIAL
X B ADDIT
XSPECIAL L R4,SIZE MUNGE VALUE WHILE IN R4
X SR R4,R10 FIND DIF BETWWEN THE TWO
X C R4,TWO SEE IF HAVE AT LEAST 2 BYTES
X BNL ROOM YES,CAN ADD
X STC R10,LSDAT+3 SET LSDAT TO VAL OF COUNTER
X OI FLAGS,FLG3 SET FLAG TO SHOW STUFF'S THERE
X ST R8,SAVPL SAVE PLACE IN BUF
X BR 14 LEAVE THIS ROUTINE
XROOM LA R4,SDAT(R9) WHERE IT'S GOING
X MVC 0(1,R4),QUOCHAR MOVE QUOTE CHAR THERE
X LA R9,1(R9) INCREMENT SDAT COUNTER
X LA R10,1(R10) INCREMENT CHARACTER COUNTER
X CR R7,R5 DON'T ADD ^O100 TO THIS
X BE ADDIT IT'S ALREADY PRINTABLE
X A R7,O1H ADD ^O100 TO CHAR
X N R7,=X'0000007F' GET MOD ^O200
XADDIT STC R7,SDAT(R9) ADD THE CHARACTER
X LA R9,1(R9) INCREMENT SDAT COUNTER
X LA R8,1(R8) INCREMENT BUF COUNTER
X LA R10,1(R10) INCREMENT CHARACTER COUNTER
X C R8,RECL SEE IF REACHED LIMIT
X BNL FULL2
X C R9,SIZE SEE IF REACHED LIMIT
X BNL FULL
X B LOOP
XFULL EQU *
X STC R10,LSDAT+3 THIS ONE TOO
X ST R8,SAVPL HERE TOO
X OI FLAGS,FLG3 TURN ON FLAG - STUFF IN BUF
X BR 14
XFULL2 EQU *
X STC R10,LSDAT+3 THIS ONE TOO
X XC SAVPL,SAVPL RESET THIS
X NI FLAGS,X'FF'-FLG3 TURN OFF LEFTOVER DATA FLAG
X BR 14
X*
XABORT LA R3,FILNAM
X FSCLOSE (R3) CLOSE THE FILE
X TM FLAGS,FLG1 DYING ON FILE-NOT-FOUND?
X BO NOERRP IF SO, THEN NO ERROR PACKET
X CLI ERRNUM,X'0A' DID THE MICRO DIE?
X BE NOERRP NO ERROR PACKET IF SO
X MVI STYPE,AE ERROR PACKET
X MVC LSDAT(4),=F'20' ALL MSGS ARE THIS LONG
X MVC N(4),NUM SYNCH PACKET NUMBERS
X SR R5,R5
X IC R5,ERRNUM GET RIGHT MESSAGE NUMBER
X M R4,=F'20' OFFSET := ERRNUM * 20
X LA R5,ERRTAB(R5)
X MVC SDAT(20),0(R5) SPACK NEEDS THE DATA HERE
X TR SDAT(20),ETOA
X L R15,=A(SPACK)
X BALR R14,R15 SEND ERROR PACKET & DIE
XNOERRP LA R15,4 SET NON-ZERO RETCODE
X B SENDRET PREPARE TO LEAVE
XCOMPLETE SR R15,R15 ZERO WILL BE RETCODE
XSENDRET L R13,4(R13)
X L R14,12(R13)
X LM R0,R12,20(R13)
X BR R14
XSENDSAVE DS 18F
XTRANS TR BUF(0),ETOA EBCDIC TO ASCII TRANSLATION
XTRNS TR SNDPKT(0),ATOE BACK FROM ASCII TO EBCDIC
XPARSE DC 32X'00'
X DC X'01' STOP ON A SPACE
X DC 223X'00'
XFIRST MVC SDAT(0),FILNAM PICK UP THE FN
XSECOND MVC 0(0,R7),FILNAM+8 PICK UP FT
X LTORG
X DROP R11
X DROP R12 DON'T NEED THEM ANYMORE
X EJECT
XSPACK CSECT
X STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
X BALR R12,0 ESTABLISH ADDRESSABILITY
X USING *,R12
X LA R14,SPSAVE ADDRESS OF MY SAVE AREA
X ST R13,4(R14) SAVE CALLER'S
X ST R14,8(R13)
X LR R13,R14
X* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
X L R11,=A(PARMS)
X USING PARMS,R11 ESTABLISH ADDRESSABILITY
X SR R9,R9
X MVI PHDR,SOH ADD CONTROL-A TO PACKET
X CLC LSDAT,SIZE NEED DATA SIZE <= SPSIZ-5
X BNH FINE
X MVI ERRNUM,X'00' DATA SIZE EXCEEDS MAX LIMIT
X MVI STATE,C'A' ABORT ON THIS
X B SPRET
XFINE L R4,=F'35' USE ^o43 TO OFFSET DATA
X A R4,LSDAT ADD IT TO LSDAT
X STC R4,PLEN
X AR R9,R4 AND THEN ADD IT TO CHECKSUM
X CLC N,ZERO CHECK IF N IS VALID
X BNL T1 OK IF >= TO 0
X MVI ERRNUM,X'01' ILLEGAL MESSAGE NUMBER
X MVI STATE,C'A'
X B SPRET
XT1 CLC N,O1H SEE IF IS <= OCTAL 100
X BNH T2
X MVI ERRNUM,X'01' ILLEGAL MESSAGE NUMBER
X MVI STATE,C'A'
X B SPRET
XT2 L R4,SPACE OFFSET THIS VALUE TOO
X A R4,N ADD IT TO N
X ST R4,TEMP
X MVC PNUM(1),TEMP+3
X A R9,TEMP AND ADD TO CHECKSUM
X CLI STYPE,X'41' ASCII 'A'
X BL T3 CAN'T BE LESS THAN THIS
X CLI STYPE,X'5A' ASCII 'Z'
X BNH T4 CAN'T BE GREATER
XT3 MVI ERRNUM,X'07' ILLEGAL PACKET TYPE
X MVI STATE,C'A' DIE ON THIS
X B SPRET
XT4 MVC PTYPE(1),STYPE ADD MESSAGE TYPE
X SR R2,R2 ZERO IT OUT
X IC R2,STYPE
X AR R9,R2 ADD TO CHECKSUM
X L R6,LSDAT HOW MUCH DATA
X LTR R6,R6 TEST IT OUT
X BZ NODAT
X SR R5,R5 USE TO GET DATA
X SR R3,R3 USE TO HOLD DATA
XDATCHK IC R3,SDAT(R5) PICK UP CHAR
X AR R9,R3 ADD TO CHECKSUM
X LA R5,1(R5) BUMP POINTER
X BCTR R6,0
X LTR R6,R6 MORE DATA?
X BNZ DATCHK
XNODAT L R6,LSDAT WILL NEED THIS LATER
X LR R7,R6 MUNGE WHILE IN R7
X BCTR R7,0 SUBTRACT 1 FOR EX FUNCTION
X EX R7,MOVE MOVE THE DATA TO SNDPKT
X ST R9,TEMP WE'LL NEED THIS SOON
X N R9,=X'000000C0' GET MOD 192
X M R8,ONE CARRY OVER THE SIGN BIT
X D R8,O1H GET MOD 64
X A R9,TEMP ADD THE TWO VALUES
X N R9,=X'0000003F' GET MOD 64 OF CHECKSUM
X A R9,SPACE ADD OFFSET
X STC R9,PDATA(R6) ADD CHECKSUM AFTER DATA
X LA R6,1(R6) MOVE POINTER
X IC R9,SEOL ADD SEND END OF PACKET CHAR
X STC R9,PDATA(R6)
X LA R6,5(R6) VALUE OF LSDAT+5
X TR SNDPKT(130),ATOE SEND IN EBCDIC
X WRTERM SNDPKT,(R6),EDIT=NO
XSPRET L R13,4(R13)
X L R14,12(R13)
X LM R0,R12,20(R13)
X BR 14
XSPSAVE DS 18F
XMOVE MVC PDATA(0),SDAT
X LTORG
X DROP R11
X DROP R12 DON'T NEED THEM ANYMORE
X EJECT
XRPACK CSECT
X STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
X BALR R12,0 ESTABLISH ADDRESSABILITY
X USING *,R12
X LA R14,RPSAVE ADDRESS OF MY SAVE AREA
X ST R13,4(R14) SAVE CALLER'S
X ST R14,8(R13)
X LR R13,R14
X* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
X L R11,=A(PARMS)
X USING PARMS,R11 ESTABLISH ADDRESSABILITY
X RDTERM RECPKT,EDIT=NO
X TR RECPKT(130),ETOA
X NI FLAGS,X'FF'-FLG4 ASSUME MICRO'LL NAK-NOT RPACK
X SR R8,R8 INDEX REG FOR RECPKT
X SR R5,R5 CHECKSUM REGISTER
XTRY LA R7,RECPKT(R8) ADDRESS OF CHARACTER
X CLI 0(R7),SOH IS IT CONTROL-A
X BE READIN YES; SO FAR, SO GOOD
X LA R8,1(R8) TRY NEXT CHARACTER
X C R8,=F'130' SEE IF EXCEED BUFFER
X BL TRY
X MVI ERRNUM,X'03' NO "SOH" ERROR
X B BADP
XREADIN SR R9,R9 ZERO OUT INDEX REG FOR RDAT
X LA R8,1(R8) INCREMENT COUNTER
X LA R7,RECPKT(R8) PICK UP LOC OF CHAR COUNT
X CLI 0(R7),SOH IS IT CONTROL-A
X BE READIN START OVER
X CLC 0(1,R7),DQUOTE COUNT+' '+3 AND ^d35
X BNL CONT CONTINUE IF >=
X MVI ERRNUM,X'04' BAD LENGTH ATTRIBUTE
X B BADP
XCONT IC R5,0(R7) START CHECKSUM
X LR R7,R5 MUNGE IN R7 TO GET LRDAT
X S R7,=F'35' LENGTH OF DATA
X STC R7,LRDAT+3
X LA R8,1(R8) INCREMENT
X SR R7,R7 ZERO IT OUT
X IC R7,RECPKT(R8) PICK UP PACKET NUMBER
X C R7,=A(SOH) IS IT CONTROL-A
X BE READIN
X AR R5,R7 ADD TO CHECKSUM
X S R7,SPACE SUBTRACT THE ' '
X STC R7,NUM+3 NUM := RECEIVED PACKET NO.
X LA R8,1(R8) INCREMENT COUNTER
X IC R7,RECPKT(R8) PICK UP MESSAGE TYPE
X C R7,=A(SOH) IS IT CONTROL-A
X BE READIN
X AR R5,R7 ADD TO CHECKSUM
X STC R7,RTYPE PUT INTO RTYPE
X LA R8,1(R8) GO TO NEXT BYTE
X L R4,LRDAT COUNTER TO GET ALL DATA
XLUP C R4,ZERO SEE IF PICKED UP ALL DATA
X BE FIN
X XC TEMP,TEMP ZERO IT OUT
X LA R7,RECPKT(R8) NEXT LOCATION IN BUFFER
X MVC TEMP+3(1),0(R7) PICK UP NEXT BYTE
X CLI TEMP+3,SOH IS IT CONTROL-A
X BE READIN
X LA R7,RDAT(R9) WHERE THE DATA'S GOING
X MVC 0(1,R7),TEMP+3 AND MOVE IT
X A R5,TEMP ADD TO CHECKSUM
X LA R8,1(R8) ADD ONE
X LA R9,1(R9) ADD ONE
X BCTR R4,0 DECREMENT COUNTER
X B LUP
XFIN SR R7,R7 ZERO OUT REGISTER
X IC R7,RECPKT(R8) GET CHECKSUM
X C R7,=A(SOH) IS IT CONTROL-A
X BE READIN
X ST R5,TEMP WE'LL NEED THIS SOON
X N R5,=X'000000C0' GET MOD 192
X M R4,ONE CARRY OVER THE SIGN BIT
X D R4,O1H GET MOD 64
X A R5,TEMP ADD THE TWO VALUES
X N R5,=X'0000003F' GET MOD 64
X A R5,SPACE ADD OFFSET
X CR R5,R7 COMPUTED VS RECEIVED CHECKSUM
X BE RPRET
X LINEDIT TEXT='CHK SB ...',SUB=(HEX,(R5))
X MVI ERRNUM,X'05' BAD CHECKSUM ERROR
XBADP MVI RTYPE,AN RETURN A NAK
X OI FLAGS,FLG4 RPACK NAK'ED THE PACKET
XRPRET L R13,4(R13)
X L R14,12(R13)
X LM R0,R12,20(R13)
X BR 14
XRPSAVE DS 18F
X LTORG
X DROP R11
X DROP R12 DON'T NEED THEM ANYMORE
X EJECT
XRECEIVE CSECT
X STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
X BALR R12,0 ESTABLISH ADDRESSABILITY
X USING *,R12
X LA R14,RECSAVE ADDRESS OF MY SAVE AREA
X ST R13,4(R14) SAVE CALLER'S
X ST R14,8(R13)
X LR R13,R14
X* USE R11 AS BASE REGISTER FOR THE GLOBAL DATA AREA, 'PARMS'
X L R11,=A(PARMS)
X USING PARMS,R11
X SR R6,R6 GET ZERO
X ST R6,NUMTRY ZERO THIS OUT
X ST R6,N HERE TOO
X MVI STATE,C'R' SET TO RECEIVE STATE
XRLOOP CLI STATE,C'D' RECEIVE DATA STATE
X BE RDATA
X CLI STATE,C'F' RECEIVE FILE STATE
X BE RFILE
X CLI STATE,C'R' RECEIVE INIT STATE
X BE RINIT
X CLI STATE,C'C' COMPLETE STATE
X BE RCOMP
X CLI STATE,C'A' ABORT STATE
X BE RABORT
X MVI ERRNUM,X'02' UNRECOGNIZED STATE
X B RABORT ELSE, DIE
XRINIT CLC NUMTRY,IMXTRY SEE IF CAN RECEIVE
X BL ROK1 YES, WE CAN
X MVI STATE,C'A' NOPE, GO INTO ABORT STATE
X B RLOOP
XROK1 L R3,NUMTRY
X LA R3,1(R3) INCREMENT TRIAL COUNTER
X ST R3,NUMTRY
X L R4,DSSIZ DEFAULT SEND PACKET SIZE
X S R4,FIVE USE DEFAULT TO SET "SIZE"
X ST R4,SIZE IN CASE WE DIE BEFORE IT'S SET
X L R15,=A(RPACK) GET INIT INFORMATION
X BALR R14,R15
X CLI RTYPE,AE ERROR PACKET?
X BNE RY1 ALL OK
X MVI ERRNUM,X'0A' MICRO DIED
X MVI STATE,C'A' SO WE DO TOO
X B RLOOP
XRY1 CLI RTYPE,AS IS IT A SEND-INIT PACKET
X BNE RN1 MAYBE IT GOT CLOBBERED
X SR R4,R4 ZERO OUT REGISTER
X IC R4,RDAT GET FIRST CHARACTER
X S R4,SPACE SUBTRACT THE ' '
X C R4,=F'26' MIN SPACK SIZE
X BNL RCH1 SO FAR, SO GOOD
X MVI STATE,C'A' ELSE, ABORT
X MVI ERRNUM,X'00' INVALID DATA-PACKET-SIZE ERROR
X B RLOOP
XRCH1 C R4,MAXPACK MAX PACKET SIZE
X BNH RCH2
X MVI STATE,C'A' ABORT IF SIZE IS ILLEGAL
X MVI ERRNUM,X'00' BAD SEND DATA LENGTH
X B RLOOP
XRCH2 STC R4,SPSIZ+3 USE THE VALUE AS SEND SIZE
X S R4,FIVE
X ST R4,SIZE SET IT TO SPSIZ-5
X CLC LRDAT(4),=F'4' USING ALL DEFAULTS ?
X BNH NOCH YUP
X LA R5,RDAT POINT TO THE BUFFER
X SR R7,R7
X IC R7,4(R5) SEOL THE MICRO WANTS
X S R7,SPACE UNCHAR (SUBTRACT ' ')
X STC R7,SEOL
X CLC LRDAT(4),FIVE ANY MORE DATA?
X BNH NOCH JUST USE DEFAULTS
X MVC RQUO(1),5(R5) SET NEW QUOCHAR VALUE
XNOCH MVC N(4),NUM SYNCH PACKET NUMBERS
X MVI STYPE,AY SET MESSAGE TYPE TO ACK
X MVC LSDAT(4),=F'6' SET LENGTH OF DATA SENDING
X L R5,SPACE MAKE CHARACTER PRINTABLE
X A R5,RPSIZ ADD REC PACKET SIZE
X STC R5,SDAT ADD SIZE INFO TO BUFFER
X L R5,SPACE
X A R5,=F'8' 8 FOR TIMEOUT
X STC R5,SDAT+1
X L R5,SPACE SEND ZERO + " " FOR NPAD
X STC R5,SDAT+2 WE'RE THE SLOW GUYS
X SR R5,R5 PAD WITH NULLS
X L R3,O1H
X XR R5,R3 CTL FUNCTION (XOR WITH 64)
X STC R5,SDAT+3 DON'T NEED PADCHAR EITHER
X SR R5,R5 ZERO IT OUT FOR NEXT TWO GUYS
X IC R5,REOL EOL CHAR I NEED
X A R5,SPACE MAKE PRINTABLE
X STC R5,SDAT+4
X IC R5,QUOCHAR MY QUOTE CHAR
X STC R5,SDAT+5
X L R15,=A(SPACK) ADDRESS OF SPACK
X BALR R14,R15 SAVE * AND GO TO SPACK
X CLI STATE,C'A'
X BE RABORT
X MVI STATE,C'F' SET TO RECEIVE FILE STATE
X MVC OLDTRY(4),NUMTRY SAVE TRIAL COUNTER
X XC NUMTRY,NUMTRY RESET COUNTER TO ZERO
X L R3,N
X LA R3,1(R3) ADD ONE
X ST R3,N STORE VALUE INCREMENTED BY 1
X NC N(4),=X'0000003F' MASK TO GET MOD 64
X B RLOOP
XRN1 CLI RTYPE,AN MAYBE IT'S A NAK
X BNE RSELSE
X MVI STYPE,AN SEND A NAK PACKET
X XC LSDAT,LSDAT NO DATA
X L R15,=A(SPACK)
X BALR R14,R15
X B RLOOP
XRSELSE MVI STATE,C'A' ELSE,ABORT
X MVI ERRNUM,X'07' ILLEGAL PACKET TYPE
X B RLOOP
XRFILE CLC NUMTRY,MAXTRY EXCEEDED NO. OF TRIALS ALLOWED
X BL ROK2 NOPE, STILL OK
X MVI STATE,C'A' ABORT IF YES
X B RLOOP
XROK2 L R3,NUMTRY
X LA R3,1(R3) INCREMENT TRIAL COUNTER
X ST R3,NUMTRY
X L R15,=A(RPACK) GET ADDRESS OF RPACK
X BALR R14,R15 GO THERE AND RETURN WHEN DONE
X CLI RTYPE,AE ERROR PACKET?
X BNE RY2 MAYBE AN ACK
X MVI ERRNUM,X'0A' MICRO DIED
X MVI STATE,C'A' SO WE DO TOO
X B RLOOP
XRY2 CLI RTYPE,AS STILL IN INIT STATE?
X BNE RNZ TRY FOR AN EOF
X CLC OLDTRY,MAXTRY CAN WE TRY AGAIN?
X BL ROLD
X MVI STATE,C'A' ELSE, ABORT
X B RLOOP
XROLD L R3,OLDTRY
X LA R3,1(R3) INCREMENT COUNTER
X ST R3,OLDTRY
X L R3,N GET PACKET NUMBER SENT
X BCTR R3,0 SUBTRACT ONE FROM IT
X C R3,NUM NUM MUST EQUAL N-1
X BE RNUM
X MVI ERRNUM,X'08' PREVIOUS PACKET MISSING
X B RNAK SEND A NAK
XRNUM MVI STYPE,AY ACK PACKET
X ST R3,N MAKE SEND SEQ NO. = N-1
X MVC LSDAT(4),=F'6' SET DATA LENGTH VARIABLE
X L R15,=A(SPACK)
X BALR R14,R15 GO TO SPACK AND RETURN
X CLI STATE,C'A'
X BE RABORT
X L R4,N
X LA R4,1(R4) ADD ONE
X ST R4,N RESTORE N TO PROPER VALUE
X XC NUMTRY,NUMTRY RESET COUNTER TO ZERO
X B RLOOP
XRNZ CLI RTYPE,AZ
X BNE RNF MAYBE IT'S AN 'F'
X CLC OLDTRY,MAXTRY CAN WE TRY AGAIN?
X BL ROLD2
X MVI STATE,C'A' ELSE,ABORT
X B RLOOP
XROLD2 L R3,OLDTRY
X LA R3,1(R3) INCREMENT COUNTER
X ST R3,OLDTRY
X L R3,N GET PACKET NUMBER SENT
X BCTR R3,0 SUBTRACT ONE FROM IT
X C R3,NUM NUM MUST EQUAL N-1
X BE RNUM2
X MVI ERRNUM,X'08' PREVIOUS PACKET MISSING
X B RNAK SEND A NAK
XRNUM2 MVI STYPE,AY ACK PACKET
X ST R3,N SEND SEQ := N-1
X XC LSDAT,LSDAT NO DATA
X L R15,=A(SPACK)
X BALR R14,R15
X CLI STATE,C'A'
X BE RABORT
X L R4,N
X LA R4,1(R4) ADD ONE
X ST R4,N RESTORE N TO PROPER VALUE
X LA R3,FILNAM
X FSCLOSE (R3) CLOSE FILE WHEN DONE
X XC NUMTRY,NUMTRY RESET COUNTER TO ZERO
X B RLOOP
XRNF CLI RTYPE,AF
X BNE RNB WELL, IT'S NOT A FNAME
X CLC NUM,N THEY HAVE TO BE EQUAL
X BE RNUM3
X MVI ERRNUM,X'08' PREVIOUS PACKET MISSING
X B RNAK SEND A NAK
XRNUM3 MVI STYPE,AY ACK PACKET
X XC LSDAT,LSDAT NO DATA
X TM FLAGS,FLG2 OVERWRITE THE NAME SENT?
X BO OVER YUP,WE DO
X L R5,LRDAT GET SIZE OF FILNAM
X LTR R5,R5 CHECK LENGTH
X BZ SAYNO DIE IF NO FILENAME
X SR R9,R9 USE AS POINTER WITHIN BUFFER
X LA R9,RDAT(R9) GET LOC OF FIRST CHAR
X LR R8,R9
XREMDOT CLC 0(1,R9),=X'2E' LOOK FOR THE DOT
X BE DOT FOUND IT
X LA R9,1(R9) NEXT POSITION
X LR R10,R9
X SR R10,R8 GET LENGTH OF NAME SO FAR
X CR R10,R5 AT END OF FN?
X BL REMDOT NO,KEEP LOOKING
X B SAYNO DIE IF NO DOT AT ALL
XDOT LR R5,R9 SAVE OUR PLACE
X LA R5,1(R5) NEXT CHARACTER
X SR R9,R8 GET LENGTH OF FNAME
X LR R4,R9 SAVE LENGTH ATTRIBUTE
X BCTR R4,0
X C R9,=F'8' MAX OF 8 CHARACTERS
X BNH DOT2
X L R9,=F'8' TRUNCATE EXTRA LETTERS
XDOT2 BCTR R9,0 FOR EX COMMAND
X LTR R9,R9 CHECK LENGTH
X BM SAYNO DIE IF IT'S ZERO
X MVC FILNAM,=18X'20' INITIALIZE TO BLANKS
X EX R9,GETFN GET FILNAM
X L R7,LRDAT GET LENGTH OF WHOLE NAME
X SR R7,R4 AND GET LENGTH OF FTYPE
X S R7,=F'3'
X LTR R7,R7 CHECK LENGTH
X BM SAYNO DIE IF ZERO
X C R7,=F'7' MAX IS 8 (7 + 1 FOR 'EX')
X BNH DOT3
X L R7,=F'7' TRUNCATE EXTRA LETTERS
XDOT3 EX R7,GETFT GET FTYPE
X TR FILNAM(18),ATOE NEED IT IN EBCDIC
X MVC FILNAM+16(2),FM ADD DEFAULT FMODE
XOVER L R15,=A(SPACK)
X BALR R14,R15 SEND ACK
X CLI STATE,C'A'
X BE RABORT
X OC FILNAM,=CL18' ' UPPERCASE FILENAME
X LA R3,FILNAM
X FSOPEN (R3),FORM=E
X MVC OLDTRY(4),NUMTRY KEEP NUMTRY FOR LATER
X XC NUMTRY,NUMTRY RESET TO ZERO
X L R3,N
X LA R3,1(R3) ADD ONE
X ST R3,N INCREMENT COUNTER
X NC N(4),=X'0000003F' MASK TO GET MOD 64
X MVI STATE,C'D' DATA RECEIVE STATE
X B RLOOP
XRNB CLI RTYPE,AB SEE IF IT'S A BREAK
X BNE RNN MAYBE GOT A NAK
X CLC NUM,N
X BE RNUM4
X MVI ERRNUM,X'08' PREVIOUS PACKET MISSING
X B RNAK SEND A NAK
XRNUM4 MVI STYPE,AY ACK PACKET
X XC LSDAT,LSDAT NO DATA
X L R15,=A(SPACK)
X BALR R14,R15
X CLI STATE,C'A'
X BE RABORT
X MVI STATE,C'C' COMPLETE STATE
X B RLOOP
XRNN CLI RTYPE,AN SEE IF GOT A NAK
X BNE RNELSE
XRNAK MVI STYPE,AN SEND A NAK PACKET
X XC LSDAT,LSDAT NO DATA
X L R15,=A(SPACK)
X BALR R14,R15
X B RLOOP DO NOTHING ON A NAK
XRNELSE MVI STATE,C'A' ABORT OTHERWISE
X MVI ERRNUM,X'07' ILLEGAL PACKET TYPE
X B RLOOP
XRDATA CLC NUMTRY,MAXTRY HAVE WE EXCEEDED OUR LIMIT?
X BL ROK3
X MVI STATE,C'A' ELSE, ABORT
X B RLOOP
XROK3 L R4,NUMTRY
X LA R4,1(R4) INCREMENT
X ST R4,NUMTRY SAVE INCREMENTED COUNTER
X L R15,=A(RPACK)
X BALR R14,R15 CALL RPACK
X CLI RTYPE,AE ERROR PACKET?
X BNE RY3 MAYBE AN ACK
X MVI ERRNUM,X'0A' MICRO DIED
X MVI STATE,C'A' WE ABORT TOO
X B RLOOP
XRY3 CLI RTYPE,AD IS THIS A DATA PACKET?
X BNE RDF MAYBE IT'S AN FNAME PACKET
X CLC N,NUM CHECK FOR RIGHT PACKET
X BNE DIF
X L R15,=A(PTCHR)
X BALR R14,R15 PUT CHARACTERS INTO FILE
X LTR R7,R7 CHECK FOR NO ERROR
X BZ OKWR NO ERROR
X MVI STATE,C'A' ABORT ON FILE SYSTEM ERROR
X B RLOOP
XOKWR MVI STYPE,AY ACK PACKET
X XC LSDAT,LSDAT NO DATA
X L R15,=A(SPACK)
X BALR R14,R15
X CLI STATE,C'A'
X BE RABORT
X MVC OLDTRY(4),NUMTRY SAVE NUMTRY'S VALUE IN OLDTRY
X XC NUMTRY,NUMTRY RESET NUMTRY
X L R3,N
X LA R3,1(R3)
X ST R3,N INCREMENT COUNTER
X NC N(4),=X'0000003F' MASK TO GET MOD 64
X B RLOOP
XDIF CLC OLDTRY,MAXTRY CAN WE DO IT?
X BL DIFNUM
X MVI STATE,C'A' AND ABORT
X B RLOOP
XDIFNUM L R4,OLDTRY
X LA R4,1(R4)
X ST R4,OLDTRY INCREMENT THIS COUNTER
X L R4,N
X BCTR R4,0
X C R4,NUM NUM MUST EQUAL N-1
X BE DIFOK
X MVI ERRNUM,X'08' PREVIOUS PACKET MISSING
X B RDN1 SEND A NAK
XDIFOK XC NUMTRY,NUMTRY RESET COUNTER TO ZERO
X MVI STYPE,AY ACK PACKET
X XC LSDAT,LSDAT NO DATA
X ST R4,N SET N TO N-1 TO RESEND PACKET
X L R15,=A(SPACK)
X BALR R14,R15 SEND THE PACKET
X CLI STATE,C'A'
X BE RABORT
X L R4,N
X LA R4,1(R4) ADD ONE
X ST R4,N RESTORE N TO PROPER VALUE
X B RLOOP AND RETURN
XRDF CLI RTYPE,AF SENDING FILENAME AGAIN?
X BNE RDZ
X CLC OLDTRY,MAXTRY CAN WE DO IT?
X BL FILOVER TRYING IT AGAIN
X MVI STATE,C'A' IF NO, ABORT
X B RLOOP
XFILOVER L R4,OLDTRY
X LA R4,1(R4)
X ST R4,OLDTRY SAVE INCREMENTED VALUE
X L R4,N
X BCTR R4,0 NEED VALUE OF N-1
X C R4,NUM N-1 MUST EQUAL NUM
X BE FILOK
X MVI ERRNUM,X'08' PREVIOUS PACKET MISSING
X B RDN1 SEND A NAK
XFILOK XC NUMTRY,NUMTRY RESET TO ZERO
X XC LSDAT,LSDAT NO DATA
X MVI STYPE,AY ACK PACKET AGAIN
X ST R4,N SET N TO N-1 FOR NOW
X TM FLAGS,FLG2 OVERWRITE THE NAME SENT?
X BO OVRWRT YUP, WE DO
X L R5,LRDAT GET SIZE OF FILNAM
X LTR R5,R5 CHECK LENGTH
X BZ SAYNO DIE IF NO FILENAME
X SR R9,R9 USE AS POINTER WITHIN BUFFER
X LA R9,RDAT(R9) GET LOC OF FIRST CHAR
X LR R8,R9
XRMDOT CLC 0(1,R9),=X'2E' LOOK FOR THE DOT
X BE ADOT FOUND IT
X LA R9,1(R9) NEXT POSITION
X LR R10,R9
X SR R10,R8 GET LENGTH OF NAME SO FAR
X CR R10,R5 AT THE END OF THE FILNAM ?
X BL RMDOT NO,KEEP LOOKING
X B SAYNO DIE IF NO DOT AT ALL
XADOT LR R5,R9 SAVE OUR PLACE
X LA R5,1(R5) NEXT CHARACTER
X SR R9,R8 GET LENGTH OF FNAME
X LR R6,R9 SAVE LENGTH ATTRIBUTE
X BCTR R6,0
X C R9,=F'8' MAX OF 8 CHARACTERS
X BNH DT2
X L R9,=F'8' TRUNCATE EXTRA LETTERS
XDT2 BCTR R9,0 FOR EX COMMAND
X LTR R9,R9 CHECK LENGTH
X BM SAYNO DIE IF IT'S ZERO
X MVC FILNAM,=18X'20' INITIALIZE TO BLANKS
X EX R9,GETFN GET FILNAM
X L R7,LRDAT GET LENGTH OF WHOLE NAME
X SR R7,R6 AND GET LENGTH OF FTYPE
X S R7,=F'3'
X LTR R7,R7 CHECK LENGTH
X BM SAYNO DIE IF ZERO
X C R7,=F'7' MAX IS 8 (7 + 1 FOR 'EX')
X BNH DT3
X L R7,=F'7' TRUNCATE EXTRA LETTERS
XDT3 EX R7,GETFT GET FTYPE
X TR FILNAM(18),ATOE NEED IT IN EBCDIC
X MVC FILNAM+16(2),FM ADD DEFAULT FMODE
XOVRWRT L R15,=A(SPACK)
X BALR R14,R15
X CLI STATE,C'A'
X BE RABORT
X OC FILNAM,=CL18' ' UPPERCASE FILENAME
X LA R3,FILNAM GET FILE NAME
X FSOPEN (R3),FORM=E OPEN FILE FOR WRITING
X L R4,N
X LA R4,1(R4) ADD ONE
X ST R4,N RESTORE N TO PROPER VALUE
X B RLOOP AND RETURN
XRDZ CLI RTYPE,AZ IS THIS AN EOF PACKET?
X BNE RDN
X CLC N,NUM ARE THEY EQUAL
X BE RDOK
X MVI ERRNUM,X'08' PREVIOUS PACKET MISSING
X B RDN1 SEND A NAK
XRDOK MVI STYPE,AY ACK THE PACKET
X XC LSDAT,LSDAT NO DATA
X L R15,=A(SPACK)
X BALR R14,R15
X LA R3,FILNAM
X FSCLOSE (R3)
X MVC OLDTRY(4),NUMTRY SAVE NUMTRY'S VALUE HERE
X XC NUMTRY,NUMTRY AND RESET COUNTER
X L R3,N
X LA R3,1(R3)
X ST R3,N STORE VALUE INCREMENTED BY 1
X NC N(4),=X'0000003F' MASK TO GET MOD 64
X MVI STATE,C'F' TRY FOR ANOTHER FILE
X B RLOOP
XRDN CLI RTYPE,AN DO WE NEED TO SEND A NAK?
X BNE RDELSE
XRDN1 MVI STYPE,AN SEND A NAK
X XC LSDAT,LSDAT NO DATA
X L R15,=A(SPACK)
X BALR R14,R15
X B RLOOP
XRDELSE MVI STATE,C'A' UNRECOGNIZED PACKET - ABORT
X MVI ERRNUM,X'07' ILLEGAL PACKET TYPE
X B RLOOP
XSAYNO MVI STYPE,AN SEND A NAK PACKET
X XC LSDAT,LSDAT NO DATA
X MVI ERRNUM,X'0B' ILLEGAL FILENAME ERROR
X L R15,=A(SPACK)
X BALR R14,R15
X B RLOOP
XPTCHR SR R4,R4 USE TO HOLD QUOCHAR
X SR R6,R6 USE TO HOLD LRECL
X SR R8,R8 COUNTER WITHIN RDAT
X L R9,RSAVPL COUNTER WITHIN RBUF
X IC R4,RQUO
X IC R6,LRECL
X L R5,LRDAT COUNTER TO GET ALL DATA
XRLUP SR R7,R7 USE TO PICK UP CHAR
X LTR R5,R5 MORE DATA LEFT?
X BNZ MOR LEAVE IF ALL DONE
X CLI PREV,X'4D' ARE WE IN MIDDLE OF LINE?
X BER R14 LEAVE IF NOT
X ST R9,RSAVPL SAVE OUR PLACE
X SR R7,R7 ZERO RETCODE
X BR R14
XMOR BCTR R5,0 DECREMENT CHAR COUNTER
X IC R7,RDAT(R8) GET DATA FROM RDAT
X CR R7,R4 IS IT THE QUOTE CHARACTER?
X BNE REGULAR
X BCTR R5,0 DECREMENT CHAR COUNT
X LA R8,1(R8) MOVE POINTER
X IC R7,RDAT(R8) PICK UP SPECIAL CHAR
X C R7,=X'0000004D' IS IT A CR? (CHAR(CR))
X BNE NOCR WRITE OUT RECORD IF YES
X MVI PREV,X'4D' JUST HAD A CR
X LA R8,1(R8) IGNORE CONTROL CHAR
X B RFIN
XNOCR C R7,=X'0000004A' HOW ABOUT A LF? (CHAR(LF))
X BNE NOLF IF YES, WRITE OUT RECORD
X LA R8,1(R8) IGNORE CONTROL CHAR
X CLI PREV,X'4D' WAS LAST THING CR?
X BNE RFIN NOPE, THEN KEEP ON
X B RLUP IGNORE LF IF PREV=CR
XNOLF CR R7,R4 IS IT THE QUOCHAR
X BE REGULAR DON'T CONVERT IF IT IS
X A R7,O1H ADD ^O100
X N R7,=X'0000007F' GET MOD ^O200
XREGULAR STC R7,RBUF(R9) STORE CHAR IN RBUF
X LA R9,1(R9) MOVE RBUF COUNTER
X LA R8,1(R8) MOVE RDAT COUNTER
X MVI PREV,X'00' BLANK OUT CR IF WAS THERE
X C R9,=F'255' ONLY 256 CHARS ALLOWED
X BNH RLUP AND CONTINUE
X LR R10,R9 USE MAX LENGTH OF 256
X B WRFIL AND WRITE TO FILE
XRFIN LTR R10,R9 GET DATA SIZE
X BZ FUDGE GOTTA FAKE A BLANK LINE
X C R7,=X'0000004D' IS IT A CR? (CHAR(CR))
X BE WRFIL
X C R7,=X'0000004A' HOW ABOUT A LF? (CHAR(LF))
X BE WRFIL
X ST R10,RSAVPL SAVE DATA RECEIVED SO FAR
X SR R7,R7 ZERO RETCODE
X BR 14
XFUDGE MVI RBUF,X'20' MAKE FIRST CHAR A SPACE
X LA R10,1(R10) LENGTH OF ONE
XWRFIL XC RSAVPL,RSAVPL RESET THE POINTER
X TR RBUF(256),ATOE MAKE EBCDIC AGAIN
X LA R3,FILNAM
X CLI RFM,C'V' IS IT VARIABLE FORMAT?
X BE VAR
X CR R10,R6
X BH PUR IGNORE DATA AFTER LRECL VALUE
X CR R10,R6 PAD OUT TO LRECL SIZE ?
X BE VAR NOPE, IT'S OK.
X LR R2,R6 GET LRECL SIZE
X SR R2,R10 PAD WITH THIS MANY SPACES
X BCTR R2,0 MINUS ONE FOR THE 'EX'
X LA R9,RBUF(R10) START PADDING HERE
X MVI 0(R9),C' ' PUT IN THE FIRST SPACE
X LTR R2,R2
X BZ PUR DON'T PAD IF SIZE DIF WAS ONE
X BCTR R2,0 SUBRTRACT SPACE WE JUST ADDED
X EX R2,PAD PAD OUT BUFFER
XPUR LR R10,R6 LENGTH HAS TO BE THIS SIZE
XVAR SR R6,R6
X IC R6,RFM RECFM HAS TO BE IN A REGISTER
X FSWRITE (R3),BUFFER=RBUF,BSIZE=(R10),RECFM=(R6),FORM=E
X LR R7,R15 CHECK THE RETCODE
X SR R9,R9 START AT BEGINNING OF RBUF
X LTR R7,R7 CHECK RETCODE
X BZ RLUP GET NEXT LINE IF OK
X C R7,=A(ERCOD) IS THE DISK READ-ONLY?
X BNE WRERR1
X MVI ERRNUM,X'0E'
X BR R14
XWRERR1 MVI ERRNUM,X'0F' ASSUME A RECFM CONFLICT
X C R7,=F'16' FILE EXISTS W/DIF RECFM
X BER R14
X MVI ERRNUM,X'06' DISK FULL ERROR
X BR R14
X*
XRABORT LA R3,FILNAM
X FSCLOSE (R3) CLOSE OPEN FILE
X CLI ERRNUM,X'0A' DID THE MICRO DIE?
X BE RNOERRP NO ERROR PACKET IF SO
X MVI STYPE,AE ERROR PACKET
X MVC LSDAT(4),=F'20' ALL MSGS ARE THIS LONG
X MVC N(4),NUM SYNCH PACKET NUMBERS
X SR R5,R5
X IC R5,ERRNUM
X M R4,=F'20' OFFSET := ERRNUM * 20
X LA R5,ERRTAB(R5)
X MVC SDAT(20),0(R5) SPACK NEEDS THE DATA HERE
X TR SDAT(20),ETOA
X L R15,=A(SPACK)
X BALR R14,R15 SEND ERROR PACKET & DIE
XRNOERRP LA R15,4 SET A NON-ZERO RETCODE
X B RECRET PREPARE TO LEAVE
XRCOMP SR R15,R15 RETCODE OF ZERO
XRECRET L R13,4(R13)
X L R14,12(R13)
X LM R0,R12,20(R13)
X BR 14
XRECSAVE DS 18F
XGETFN MVC FILNAM(0),RDAT PICK UP FNAME
XGETFT MVC FILNAM+8(0),0(R5) PICK UP FTYPE
XPAD MVC 1(0,R9),0(R9) PAD OUT WITH SPACES
X LTORG
X DROP R11
X DROP R12 DON'T NEED THEM ANYMORE
X END KERMIT
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 92982 Oct 23 16:35 cmskermit.asm (as sent)'
chmod u=rw,g=rw,o=rw cmskermit.asm
ls -l cmskermit.asm
echo x - cmskermit.doc
sed 's/^X//' > cmskermit.doc <<'+FUNKY+STUFF+'
XRevised: 2/8/83 KERMIT-CMS
X
X
X1. Introduction
X
X KERMIT is a set of programs that transfer files between computers over normal
Xterminal communication lines. It implements the "KL10 Error-Free Reciprocol
XMicrocomputer Interchange over TTY-Lines" protocol. Originally designed to be
Xused between a microcomputer and the DEC-20, the protocol will also transfer
Xfiles to and from a microcomputer and the IBM 4341 systems running under
XVM/CMS.
X
X KERMIT transfers data by creating packets with information regarding the type
Xof packet being sent, it's length, a packet number, and a checksum to determine
Xwhether the data has been modified during transmission. If a packet is lost or
Xgarbled, KERMIT will attempt to resend it.
X
X You must be using an ASCII terminal to run Kermit-CMS.
X
X Please note that this document should be used in conjunction with the Kermit
Xmanual, and assumes you have read the sections pertaining to the SuperBrain
Xmicrocomputer. For more information regarding the manual, see the Reference
XSection at the end of this report.
X
X2. CMS Command Syntax and Options
X
X
X
X
X
XKERMIT [ options ]
X
X
X
X
XAlternatively, you can simply type a carriage return after issuing the
XKERMIT command.
X
Xoptions:
X
X Send
X
X Receive
X
X Set
X
X Show
X
X Status
X
X CMS
X
X CP
X
X Help
X CUCCA User Services Technical Note [1]
X Revised: 2/8/83 KERMIT-CMS
X
X
X
X Exit
X
X Quit
X
X ?
X
X
X
X
X
X2.1. CMS KERMIT Command Options
X
XSEND FN FT [FM] Send the specified file(s), using * or % as the wildcard
X characters (* will match any number of characters while %
X matches only one). Kermit-CMS assumes the file is located on
X the A disk, and sets the filemode to A1. If, however, the file
X is located on a different disk, the filemode must be cited.
X Also, note that if you use * for the filemode, Kermit-CMS will
X send only the first file that matches. Examples:
X
X The command SEND CEN SPSS will send CEN SPSS A1. To
X send the same file located on your B disk, you must
X specify: SEND CEN SPSS B. SEND * FORTRAN will send all
X fortran files on your A disk. SEND ABC% EXEC will send
X all exec files with a four letter filename beginning
X with ABC. If you have the file PLOT SAS on your A disk
X and your B disk, SEND PLOT SAS * will send PLOT SAS A1.
X
XRECEIVE [FN FT [FM]]
X Receive the file(s) sent from the micro. If a file
X specification is not included, Kermit-CMS will use the name(s)
X specified by the remote host. Use the file specification to
X indicate a different filename or a disk other than the A disk
X (in this case, the file name and type must also be supplied or
X = = FM can be used.) Examples:
X
X To receive files using the filename(s) sent by the
X micro, use: RECEIVE. To save the file under a
X different name, specify: RECEIVE ABC FORTRAN. To save
X the file under the same name but on the B disk,
X specify: RECEIVE ABC FORTRAN B, or RECEIVE = = B.
X
XSET <parameter> <value>
X Set the parameter to the specified value. Legal Set commands
X are:
X
X RECFM <c>
X Denotes the record format to be used when creating the
X file. Only fixed and variable length records are
X allowed, where variable is the default. Indicate the
X desired record format by either an F or a V.
X CUCCA User Services Technical Note [2]
X Revised: 2/8/83 KERMIT-CMS
X
X
X LRECL <d>
X Indicates the logical record length. The default is
X set to 80, and the maximum allowed is 133.
X
X QUOTE <c>
X The quote character you wish to use in place of the
X default (#). It must be a single, printable character
X from among the following: 33-62, 96, or 123-126
X (decimal).
X
X END <d> Indicates the end-of-line character you choose to send.
X The default is a CR (ASCII 13), but can be set to any
X two digit number between 00 and 31 (dec).
X
X PAC <d> Allows the user to specify the packet size the micro
X should use when sending to Kermit-CMS. The range is
X 26-94 (decimal), where 94 is the default.
X
XSHOW <parameter>
X Displays the current value of any variable that can be changed
X via the SET command.
X
XSTATUS Returns the status of the previous execution of Kermit-CMS.
X Therefore, STATUS will either display the message "Kermit
X completed successfully", or the last error encountered prior to
X aborting.
X
XCMS Issues a CMS command from within Kermit-CMS.
X
XCP Issues a CP command from within Kermit-CMS.
X
XHELP Displays a message that briefly explains Kermit-CMS commands.
X
XEXIT from Kermit-CMS.
X
XQUIT Same as EXIT.
X
X? Lists all legal Kermit-CMS commands.
X
X3. Examples under CMS
X
X Here is a brief example of how to use the SuperBrain in conjunction with
XKermit-CMS to send a file to the SuperBrain.
X
X
X
X
X
X
X
X
X
X CUCCA User Services Technical Note [3]
X Revised: 2/8/83 KERMIT-CMS
X
X
X
X B>A:kermit
X
X Kermit-80>set loc on ; Indicate half duplex
X Kermit-80>set ibm on ; Cause line turn around wait
X Kermit-80>set baud
X
X [ Kermit-80 will list 15 baud rates - choose the appropriate one ]
X
X Kermit-80>connect
X
X [ The micro will act as a regular terminal from now on.]
X [ Login here as you normally would, and run Kermit-CMS.]
X
X kermit
X KERMIT-CMS>?
X Legal Commands are:
X Receive, Send, Help, Exit, Quit, Set, Status, Show, CMS, CP
X KERMIT-CMS>send finger database ; Send this file
X ^]C ; Return to the micro
X ; by typing <escape>]C
X
X Kermit-80>
X Kermit-80>receive ; Micro receives the file
X
X [the file is sent .......]
X
X Kermit-80>connect
X
X KERMIT-CMS>status
X Kermit completed successfully
X KERMIT-CMS>ex
X R;
X
X .logoff
X CONNECT= 00:00:52 VIRTCPU= 000:00.42 TOTCPU= 000:01.21
X LOGOFF AT 17:13:20 EST WEDNESDAY 03/31/82
X ^]C
X
X Kermit-80>exit
X B>
X
X In order to send a file from the SuperBrain to the 4341 repeat the above
Xprocedure swapping the command SEND with RECEIVE and vice versa.
X
X4. VS1 JCL
X
X Not applicable
X
X
X
X
X CUCCA User Services Technical Note [4]
X Revised: 2/8/83 KERMIT-CMS
X
X
X5. Examples under VS1
X
X Not applicable
X
X6. Additional Information
X
X 1. The commands are supplied with a help option, so a question mark can
X be typed to get the appropriate format or a list of options. The
X question mark, however, must be followed by a carriage return;
X Kermit-CMS will respond and display the prompt again. For instance,
X SET ? will list all valid options for the SET command.
X
X 2. When receiving files, if the record format is fixed, any record
X longer than the logical record length will be truncated. If the
X record format is variable, the record length can be as high as 133.
X For sending files, the maximum record length is 133.
X
X 3. Before connecting to the 4341, three flags must be set. You should
X set the IBM flag on, set the LOCAL-ECHO flag on (used to indicate
X half duplex), and specify the baud rate you will be using. To turn
X a flag on, type to the micro's prompt "Set XXX On" where XXX is the
X flag name. Indicate the baud rate by typing "Set baud", and choose
X from among a list the SuperBrain supplies. These flags will remain
X in effect as long as you do not exit from the micro's version of
X Kermit. See the example of a session for further clarification.
X
X 4. Note that "(" and ")" act as word separators on the input line.
X Therefore, if you try to set the quote character to "(*" or "*(",
X for example, only the first character will be used.
X
X 5. The current version of Kermit-CMS does not support timeouts. The
X user, therefore, should hit the carriage return key after a long
X period of inactivity (that is, when the screen display does not
X change.)
X
X 6. Since the micro does not send an error packet when it aborts,
X Kermit-CMS does not know the micro has stopped sending it
X information. Therefore, when you connect back to the IBM,
X Kermit-CMS may still be sending packets (they will appear on the
X screen). The user must hit a carriage return until Kermit-CMS has
X sent the maximum number of packets allowed and aborts. The error
X message, however, will not indicate that communication stopped
X because the micro aborted, but rather that no start of header
X character was found.
X
X 7. The minimum send packet size Kermit-CMS will allow is 26. This is
X necessary to avoid an error while sending the filename or an error
X packet. If the micro tries to set the value to be less than 26,
X Kermit-CMS will immediately abort with an error of "Bad send-packet
X size."
X
X 8. During the initialization process with the micro, Kermit-CMS sends
X CUCCA User Services Technical Note [5]
X Revised: 2/8/83 KERMIT-CMS
X
X
X all six pieces of information (that is, the receive packet size, the
X timeout data, the number of padding characters, the character used
X for padding, the line terminator, and the quote character.) When
X receiving this data from the micro, Kermit-CMS ignores the data
X regarding timeouts and padding; they do not effect the program's
X execution. Therefore, if the quote and end-of-line characters used
X are the defaults, the micro need only send Kermit-CMS its buffer
X size. Only if the defaults are not used must ALL the information be
X sent (since the data is organized positionally). If, however, the
X micro sends all the information even when not required, Kermit-CMS
X will simply ignore the irrelevant portion.
X
X 9. When sending packets to Kermit-CMS, the micro must use a carriage
X return as the end-of-line character. CMS requires a carriage return
X to terminate a read from the terminal; thus, if any other character
X is used, Kermit-CMS will never get the packets.
X
X 10. While the COMTEN translates all incoming characters to EBCDIC,
X Kermit-CMS translates the data it reads back to ASCII (characters
X not representable in ASCII are replaced by a null). Not only is it
X easier to work with ASCII characters, but it makes things more
X consistent throughout the many versions of Kermit. When the packets
X are sent to the micro, Kermit-CMS converts all data back to EBCDIC.
X The ASCII to EBCDIC translation table can be found in Appendix V of
X the Kermit manual.
X
X
X6.1. Error Messages
X
X Kermit-CMS supplies the micro and the user with numerous error messages. If
Xthe execution must be aborted, an error packet is sent to the micro before
XKermit-CMS stops. The same message can be retrieved via the STATUS command
Xwhen Kermit-CMS returns and displays the prompt. If Kermit-CMS aborted because
Xthe maximum amount of retries was exceeded (20 on initialization packets and 5
Xon others), the error message will display the most recent error (i.e. - the
Xlast NAK Kermit-CMS encountered). If execution stops because the micro
Xaborted, the error message will convey that to the user, but it is the micro's
Xresponsibility to pinpoint the error. The messages Kermit-CMS gives are as
Xfollows :
X
X "Bad send-packet size"
X Sent when the micro attempts to set its receive buffer size
X to a value that is less than 26 (the minimum that Kermit-CMS
X will accept) or larger than 94, the maximum. It will also
X occur if Kermit-CMS tries to send a packet that is larger
X than the maximum specified.
X
X "Bad message number"
X If the packet number is less than zero or greater than 63
X (at which point it should "wrap around" back to zero).
X
X "Illegal packet type"
X CUCCA User Services Technical Note [6]
X Revised: 2/8/83 KERMIT-CMS
X
X
X This message is returned if the packet type does not fall
X between A-Z.
X
X "Unrecognized State"
X If Kermit-CMS is in a state not previously defined by the
X protocol, it will abort with this message.
X
X "No SOH encountered"
X This error arises if Kermit-CMS reads the entire packet
X without encountering an SOH character (^A.) The result is
X that it sends a NAK to the micro, and marks this error as
X the most recent one.
X
X "Bad Checksum"
X If the checksum calculated by Kermit-CMS does not match the
X one sent by the micro, Kermit-CMS NAK's the packet and flags
X this error.
X
X "Bad character count"
X This error is set if Kermit-CMS receives a packet whose size
X is illegal (that is, if the size parameter was garbled
X during transmission of the packet.)
X
X "Micro sent a NAK"
X Keep track of who rejected the packet.
X
X "Lost a packet"
X When a packet is received and the sequence number is
X different from the number Kermit-CMS expected, the packet is
X NAK'ed.
X
X "Micro aborted"
X Tells you that the micro aborted unexpectedly.
X
X "Illegal file name"
X When receiving the name of the file from the micro,
X Kermit-CMS expects it to be in the format
X 'filename.filetype'. If the filename, filetype, or dot is
X missing, Kermit-CMS will reject (NAK) the packet. Also, if
X either the filename or filetype exceeds eight characters, it
X will be truncated.
X
X "Invalid lrecl"
X Kermit-CMS will abort on any file-system error it encounters
X when reading from the file it is to send. It can only send
X files with variable or fixed length record formats,
X therefore, Wylbur Edit or Packed format files will cause an
X error.
X
X "Permanent I/O error"
X This signifies a permanent I/O error that occured when
X reading from an existing file. Execution is aborted
X CUCCA User Services Technical Note [7]
X Revised: 2/8/83 KERMIT-CMS
X
X
X immediately.
X
X "Disk is read-only"
X This error arises when there is an attempt to write on a
X read-only disk.
X
X "Recfm conflict"
X If a filename conflict arises, Kermit-CMS will append the
X received file to the existing one, provided the record
X formats of the two are the same. Otherwise, this error will
X cause a halt of the execution.
X
X "Disk is full"
X Refers to any error regarding limitations on a user's
X storage space. Most likely, it signifies that the receiving
X disk is full, but the error can also mean that the maximum
X number of files allowed has been reached, or virtual storage
X capacity has been exceeded, and so on.
X
X "Err allocating space"
X Kermit-CMS keeps a table of all files it has sent to the
X micro, allocating extra space if more than ten files are
X sent at one time. If there is an error obtaining more
X space, Kermit-CMS will abort with this message.
X
X7. Reference
X
X For a more detailed explanation of Kermit or information regarding the
XSuperbrain, consult the Kermit manual, Kermit Users Guide and Specification.
XThe manual is available in the Reference Library, Room 109 Computer Center for
X$3.50.
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X CUCCA User Services Technical Note [8]
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 17635 Oct 23 16:35 cmskermit.doc (as sent)'
chmod u=rw,g=rw,o=rw cmskermit.doc
ls -l cmskermit.doc
echo x - cmskermit.hlp
sed 's/^X//' > cmskermit.hlp <<'+FUNKY+STUFF+'
XKERMIT is a family of programs that do reliable file transfer between
Xcomputers over TTY lines. These are the commands for the IBM VM/CMS
Xversion.
X
XSEND Sends a file or file group from the IBM to the remote
X host. The name of each file is passed to the remote host in
X a special control packet, so that the remote host can store
X it with the same name. Wildcarding of files is allowed.
X
XRECEIVE Receive a file or file group from the remote host. If an
X incoming file name is not legal, then attempt to transform it
X to a similar legal name, e.g. by deleting excessive
X characters. If the file already exists, Kermit-CMS will
X append the received file to the existing one provided the
X record formats of the two are the same.
X
XSET Establish various system-dependent parameters, such as max-
X imum packet length, logical record length, record format,etc.
X
XSHOW Display the current value of any variable that can be changed
X via the SET command.
X
XSTATUS Give information about the previous file transfer. Kermit-CMS
X will either indicate that transmission was successful, or
X display an error message.
X
XCMS Issue a CMS command from within Kermit-CMS.
X
XCP Issue a CP command from within Kermit-CMS.
X
XHELP Type this message.
X
XEXIT Exit from KERMIT back to the host operating system.
X
XQUIT Synonym for EXIT.
X
X? List all legal Kermit-CMS commands.
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 1432 Oct 23 16:35 cmskermit.hlp (as sent)'
chmod u=rw,g=rw,o=rw cmskermit.hlp
ls -l cmskermit.hlp
echo x - cmskermit.mss
sed 's/^X//' > cmskermit.mss <<'+FUNKY+STUFF+'
X at make(vmappendix)
X at case(device,x9700="@font(univers 10)")
X at comment(revised 3/31/82)
X at comment{ Kermit-CMS appendix By Daphne}
X at modify<quotation,indentation 0, above 1, below 1>
X at Define<Q,FaceCode r>
X at appendixname(name="Kermit-CMS")
X at Introduction
XKERMIT is a set of programs that transfer files between computers over
Xnormal terminal communication lines. It implements the "@u<K>L10
X at u<E>rror-@|Free @u<R>eciprocol @u<M>icrocomputer @u<I>nterchange over
X at u<T>TY-@|Lines" protocol. Originally designed to be used between a
Xmicrocomputer and the DEC-20, the protocol will also transfer files to
Xand from a microcomputer and the IBM 4341 systems running under VM/CMS.
X
XKERMIT transfers data by creating packets with information regarding
Xthe type of packet being sent, it's length, a packet number, and a
Xchecksum to determine whether the data has been modified during
Xtransmission. If a packet is lost or garbled, KERMIT will attempt
Xto resend it.
X
X at b<You must be using an ASCII terminal to run Kermit-CMS.>
X
XPlease note that this document should be used in conjunction with
Xthe Kermit manual, and assumes you have read the sections pertaining
Xto the SuperBrain microcomputer. For more information regarding the
Xmanual, see the Reference Section at the end of this report.
X at CMSSyntax
X at begin(verbatim)
X at drawline
X
XKERMIT [ options ]
X at end(verbatim)
X at drawline
X at begin(verbatim)
X
XAlternatively, you can simply type a carriage return after issuing the
XKERMIT command.
X
Xoptions:
X at tabset(1in,1.75in)
X
X@\Send
X
X@\Receive
X
X@\Set
X
X@\Show
X
X@\Status
X
X@\CMS
X
X@\CP
X
X@\Help
X
X@\Exit
X
X@\Quit
X
X@\?
X at drawline
X at end(verbatim)
X
X at subsection(CMS KERMIT Command Options)
X at begin(description)
X
XSEND FN FT [FM]@\Send the specified file(s), using * or % as the
Xwildcard characters (* will match any number of characters while %
Xmatches only one). Kermit-CMS assumes the file is located on the A
Xdisk, and sets the filemode to A1. If, however, the file is located
Xon a different disk, the filemode must be cited. Also, note that if
Xyou use * for the filemode, Kermit-CMS will send only the first file
Xthat matches. Examples:
X at begin<quotation>
X The command @q<SEND CEN SPSS> will send CEN SPSS A1. To send the same
Xfile located on your B disk, you must specify: @q<SEND CEN SPSS B>.
X at q<SEND * FORTRAN> will send all fortran files on your A disk.
X at q<SEND ABC% EXEC> will send all exec files with a four letter filename
Xbeginning with ABC.
XIf you have the file PLOT SAS on your A disk and your B disk,
X at q<SEND PLOT SAS *> will send PLOT SAS A1.
X at end<quotation>
X
XRECEIVE [FN FT [FM]]@\ Receive the file(s) sent from the micro. If a
Xfile specification is not included, Kermit-CMS will use the name(s)
Xspecified by the remote host. Use the file specification to indicate
Xa different filename or a disk other than the A disk (in this case,
Xthe file name and type must also be supplied or = = FM can be used.)
XExamples:
X at begin<Quotation>
X To receive files using the filename(s) sent by the micro, use:
X at q<RECEIVE>. To save the file under a different name, specify:
X at q<RECEIVE ABC FORTRAN>. To save the file under the same name but on the
XB disk, specify: @q<RECEIVE ABC FORTRAN B>, or @q<RECEIVE = = B>.
X at End<Quotation>
X
XSET <parameter> <value>@\ Set the parameter to the specified value.
XLegal Set commands are:
X at begin<description,leftmargin +8,indent -8>
X at index[RECFM]
XRECFM <c>@\Denotes the record format to be used when creating the
Xfile. Only fixed and variable length records are allowed, where
Xvariable is the default. Indicate the desired record format by either
Xan F or a V.
X
XLRECL <d>@\Indicates the logical record length. The default is set
Xto 80, and the maximum allowed is 133.
X
XQUOTE <c>@\The quote character you wish to use in place of the
Xdefault (#). It must be a single, printable character from among the
Xfollowing: 33-62, 96, or 123-126 (decimal).
X
XEND <d>@\Indicates the end-of-line character you choose to send. The
Xdefault is a CR (ASCII 13), but can be set to any two digit number
Xbetween 00 and 31 (dec).
X
XPAC <d>@\Allows the user to specify the packet size the micro should
Xuse when sending to Kermit-CMS. The range is 26-94 (decimal), where
X94 is the default.
X at end<description>
X
XSHOW <parameter>@\Displays the current value of any variable that can
Xbe changed via the SET command.
X
XSTATUS@\Returns the status of the previous execution of Kermit-CMS.
XTherefore, STATUS will either display the message "Kermit completed
Xsuccessfully", or the last error encountered prior to aborting.
X
XCMS@\Issues a CMS command from within Kermit-CMS.
X
XCP@\Issues a CP command from within Kermit-CMS.
X
XHELP@\Displays a message that briefly explains Kermit-CMS commands.
X
XEXIT@\from Kermit-CMS.
X
XQUIT@\Same as EXIT.
X
X?@\Lists all legal Kermit-CMS commands.
X at end(description)
X at CMSexamples
X
XHere is a brief example of how to use the SuperBrain in conjunction
Xwith Kermit-CMS to send a file to the SuperBrain.
X
X at Begin<ProgramExample>
X
XB>A:kermit
X
XKermit-80>set loc on ; Indicate half duplex
XKermit-80>set ibm on ; Cause line turn around wait
XKermit-80>set baud
X
X [ Kermit-80 will list 15 baud rates - choose the appropriate one ]
X
XKermit-80>connect
X
X [ The micro will act as a regular terminal from now on.]
X [ Login here as you normally would, and run Kermit-CMS.]
X
Xkermit
XKERMIT-CMS>?
XLegal Commands are:
XReceive, Send, Help, Exit, Quit, Set, Status, Show, CMS, CP
XKERMIT-CMS>send finger database ; Send this file
X^]C ; Return to the micro
X ; by typing <escape>]C
X
XKermit-80>
XKermit-80>receive ; Micro receives the file
X
X [the file is sent .......]
X
XKermit-80>connect
X
XKERMIT-CMS>status
XKermit completed successfully
XKERMIT-CMS>ex
XR;
X
X.logoff
XCONNECT= 00:00:52 VIRTCPU= 000:00.42 TOTCPU= 000:01.21
XLOGOFF AT 17:13:20 EST WEDNESDAY 03/31/82
X^]C
X
XKermit-80>exit
XB>
X at End<ProgramExample>
X
XIn order to send a file from the SuperBrain to the 4341 repeat the
Xabove procedure swapping the command @q<SEND> with @q<RECEIVE> and
Xvice versa.
X
X at VS1Syntax
XNot applicable
X at VS1Examples
XNot applicable
X at Additionalinfo
X
X at begin<enumerate>
XThe commands are supplied with a help option, so a question mark can
Xbe typed to get the appropriate format or a list of options. The
Xquestion mark, however, must be followed by a carriage return;
XKermit-CMS will respond and display the prompt again. For instance,
X at q<SET ?> will list all valid options for the SET command.
X
XWhen receiving files, if the record format is fixed, any record longer
Xthan the logical record length will be truncated. If the record format
Xis variable, the record length can be as high as 133. For sending
Xfiles, the maximum record length is 133.
X
XBefore connecting to the 4341, three flags must be set. You should
Xset the IBM flag on, set the LOCAL-ECHO flag on (used to indicate half
Xduplex), and specify the baud rate you will be using. To turn a flag
Xon, type to the micro's prompt "Set XXX On" where XXX is the flag
Xname. Indicate the baud rate by typing "Set baud", and choose from
Xamong a list the SuperBrain supplies. These flags will remain in
Xeffect as long as you do not exit from the micro's version of Kermit.
XSee the example of a session for further clarification.
X
XNote that "(" and ")" act as word separators on the input line.
XTherefore, if you try to set the quote character to "(*" or "*(", for
Xexample, only the first character will be used.
X
XThe current version of Kermit-CMS does not support timeouts. The
Xuser, therefore, should hit the carriage return key after a long
Xperiod of inactivity (that is, when the screen display does not
Xchange.)
X
XSince the micro does not send an error packet when it aborts,
XKermit-CMS does not know the micro has stopped sending it information.
XTherefore, when you connect back to the IBM, Kermit-CMS may still be
Xsending packets (they will appear on the screen). The user must hit a
Xcarriage return until Kermit-CMS has sent the maximum number of
Xpackets allowed and aborts. The error message, however, will not
Xindicate that communication stopped because the micro aborted, but
Xrather that no start of header character was found.
X
XThe minimum send packet size Kermit-CMS will allow is 26. This is
Xnecessary to avoid an error while sending the filename or an error
Xpacket. If the micro tries to set the value to be less than 26,
XKermit-CMS will immediately abort with an error of "Bad send-packet
Xsize."
X
XDuring the initialization process with the micro, Kermit-CMS sends
Xall six pieces of information (that is, the receive packet size, the
Xtimeout data, the number of padding characters, the character used
Xfor padding, the line terminator, and the quote character.) When
Xreceiving this data from the micro, Kermit-CMS ignores the data
Xregarding timeouts and padding; they do not effect the program's
Xexecution. Therefore, if the quote and end-of-line characters used
Xare the defaults, the micro need only send Kermit-CMS its buffer
Xsize. Only if the defaults are not used must ALL the information
Xbe sent (since the data is organized positionally). If, however,
Xthe micro sends all the information even when not required, Kermit-CMS
Xwill simply ignore the irrelevant portion.
X
XWhen sending packets to Kermit-CMS, the micro must use a carriage
Xreturn as the end-of-line character. CMS requires a carriage
Xreturn to terminate a read from the terminal; thus, if any other
Xcharacter is used, Kermit-CMS will never get the packets.
X
XWhile the COMTEN translates all incoming characters to EBCDIC,
XKermit-CMS translates the data it reads back to ASCII (characters
Xnot representable in ASCII are replaced by a null). Not only
Xis it easier to work with ASCII characters, but it makes things
Xmore consistent throughout the many versions of Kermit. When the
Xpackets are sent to the micro, Kermit-CMS converts all data back
Xto EBCDIC. The ASCII to EBCDIC translation table can be found in
XAppendix V of the Kermit manual.
X at end<enumerate>
X
X at subsection(Error Messages)
XKermit-CMS supplies the micro and the user with numerous error
Xmessages. If the execution must be aborted, an error packet is
Xsent to the micro before Kermit-CMS stops. The same message can
Xbe retrieved via the STATUS command when Kermit-CMS returns and
Xdisplays the prompt. If Kermit-CMS aborted because the maximum
Xamount of retries was exceeded (20 on initialization packets and 5 on
Xothers), the error message will display the most recent error
X(i.e. - the last NAK Kermit-CMS encountered). If execution stops
Xbecause the micro aborted, the error message will convey that to
Xthe user, but it is the micro's responsibility to pinpoint the
Xerror. The messages Kermit-CMS gives are as follows :
X
X at begin<enumerate>
X at begin<description,leftmargin +8,indent -8>
X"Bad send-packet size"@\ Sent when the micro attempts to set its
Xreceive buffer size to a value that is less than 26 (the minimum that
XKermit-CMS will accept) or larger than 94, the maximum. It will also
Xoccur if Kermit-CMS tries to send a packet that is larger than the
Xmaximum specified.
X
X"Bad message number"@\ If the packet number is less than zero or
Xgreater than 63 (at which point it should "wrap around" back to zero).
X
X"Illegal packet type"@\ This message is returned if the packet type
Xdoes not fall between A-Z.
X
X"Unrecognized State"@\ If Kermit-CMS is in a state not previously
Xdefined by the protocol, it will abort with this message.
X
X"No SOH encountered"@\ This error arises if Kermit-CMS reads the
Xentire packet without encountering an SOH character (^A.) The result
Xis that it sends a NAK to the micro, and marks this error as the most
Xrecent one.
X
X"Bad Checksum"@\ If the checksum calculated by Kermit-CMS does not
Xmatch the one sent by the micro, Kermit-CMS NAK's the packet and flags
Xthis error.
X
X"Bad character count"@\ This error is set if Kermit-CMS receives a
Xpacket whose size is illegal (that is, if the size parameter was
Xgarbled during transmission of the packet.)
X
X"Micro sent a NAK"@\ Keep track of who rejected the packet.
X
X"Lost a packet"@\ When a packet is received and the sequence number is
Xdifferent from the number Kermit-CMS expected, the packet is NAK'ed.
X
X"Micro aborted"@\ Tells you that the micro aborted unexpectedly.
X
X"Illegal file name"@\ When receiving the name of the file from the
Xmicro, Kermit-CMS expects it to be in the format 'filename.filetype'.
XIf the filename, filetype, or dot is missing, Kermit-CMS will reject
X(NAK) the packet. Also, if either the filename or filetype exceeds
Xeight characters, it will be truncated.
X
X"Invalid lrecl"@\ Kermit-CMS will abort on any file-system error it
Xencounters when reading from the file it is to send. It can only send
Xfiles with variable or fixed length record formats, therefore, Wylbur
XEdit or Packed format files will cause an error.
X
X"Permanent I/O error"@\ This signifies a permanent I/O error that
Xoccured when reading from an existing file. Execution is aborted
Ximmediately.
X
X"Disk is read-only"@\ This error arises when there is an attempt to
Xwrite on a read-@|only disk.
X
X"Recfm conflict"@\ If a filename conflict arises, Kermit-CMS will
Xappend the received file to the existing one, provided the record
Xformats of the two are the same. Otherwise, this error will cause a
Xhalt of the execution.
X
X"Disk is full"@\ Refers to any error regarding limitations on a user's
Xstorage space. Most likely, it signifies that the receiving disk is
Xfull, but the error can also mean that the maximum number of files
Xallowed has been reached, or virtual storage capacity has been
Xexceeded, and so on.
X
X"Err allocating space"@\ Kermit-CMS keeps a table of all files it has sent
Xto the micro, allocating extra space if more than ten files are sent at one
Xtime. If there is an error obtaining more space, Kermit-CMS will abort with
Xthis message.
X at End<Description>
X at End<Enumerate>
X
X at references
XFor a more detailed explanation of Kermit or information regarding the
XSuperbrain, consult the Kermit manual, @u<Kermit Users Guide and
XSpecification>. The manual is available in the Reference Library,
XRoom 109 Computer Center for $3.50.
X
X
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 14026 Oct 23 16:35 cmskermit.mss (as sent)'
chmod u=rw,g=rw,o=rw cmskermit.mss
ls -l cmskermit.mss
echo x - cmsnxtfst.asm
sed 's/^X//' > cmsnxtfst.asm <<'+FUNKY+STUFF+'
X* NEXTFST ROUTINE
X* GIVEN A PLIST OF THE FORM
X* A(FILENAME)
X* A(FST)
X* A(ADT)
X* WHERE FILENAME IS A CMS FILENAME (FN,FT,FM), POSSIBLY CONTAINING
X* WILDCARD CHARACTERS, AND FST AND ADT POINT TO VALID ADTS AND FSTS
X* OR ARE NULL (DESIGNATED BY X'FF000000'), RETURN THE NEXT FST
X* MATCHING THE GIVEN FILENAME IN FST AND THE ADDRESS OF THE
X* CORRESPONDING ADT IN ADT.
X*
X* CARL KASS AND JEFF DAMENS, CUCCA USER SERVICES, 12/80
X* COPYRIGHT (C) 1980 COLUMBIA UNIVERSITY
X* PERMISSION IS GRANTED TO ANY INDIVIDUAL OR INSTITUTION TO COPY
X* OR USE THIS PROGRAM, EXCEPT FOR EXPLICITLY COMMERCIAL PURPOSES.
X*
XNEXTFST CSECT
X USING NEXTFST,15 ADDRESSABILITY
X STM 14,12,12(13) SAVE REGS
X LR 14,13 SAVE REG 14
X L 13,=V(NEXTFSTA) DATA AREA
X USING NEXTFSTA,13 POINT TO DATA AREA
X ST 14,4(13) BACKCHAIN
X ST 13,8(14) FORECHAIN
X DROP 15
X BALR 12,0 ESTABLISH FINAL...
X USING *,12 ...ADDRESSABILITY
X*
X USING NUCON,0 NUCON IS AT BOTTOM
X LR 11,1 POINT AT PAB
X USING PAB,11 TELL ASSEMBLER
X L 9,PABFN GET ADDRESS OF COPYED FN
X USING PASSFI,9
X MVC COPYFI,PASSFI COPY IT TO MY STORAGE
X LA 1,COPYFN+8 ADDR OF COPYED FN
X TRT COPYFN(8),NSPC LOOK FOR SPACE
X LA 2,COPYFN
X SR 1,2 COMPUTE LENGTH
X STH 1,PFNL
X LA 1,COPYFT+8 INITIALIZE TO END
X TRT COPYFT(8),NSPC LOOK FOR SPACE
X LA 2,COPYFT
X SR 1,2 FIGURE LENGTH
X STH 1,PFTL
X* NOW CHECK THE FILEMODE, IF LETTER IS BLANK SET TO "A",
X* IF NUMBER IS BLANK SET TO "%"
X CLI COPYFM,C' ' IS LETTER BLANK?
X BNE FMLNBLK IF NOT THEN BRANCH
X MVI COPYFM,C'A' SET TO A IF WAS BLANK
XFMLNBLK EQU *
X CLI COPYFM+1,C' ' IS NUMBER BLANK?
X BNE FMNNBLK IF NOT THEN BRANCH
X MVI COPYFM+1,C'%' SET TO % IF WAS BLANK
XFMNNBLK EQU *
X L 2,PABADT ADDR OF THE ADT THEY COPYED
X L 3,PABFST ADDR OF COPYED FST
X CLC 0(4,2),=X'FF000000' WAS IT NULL?
X BE ADTNULL
X CLC 0(4,3),=X'FF000000'
X BNE NNULL2 BOTH ARE NON-NULL
X LA 15,8 ONE IS NULL, ONE ISN'T
X B DONE GO HOME
XADTNULL EQU *
X CLC 0(4,3),=X'FF00000000' IS THE FST NULL?
X BE BOTHNULL BOTH ARE NULL
X LA 15,8 ONE NULL, ONE ISN'T
X B DONE GO HOME
X* IF WE GET HERE, NO ADT OR FST WAS COPYED, SO WE JUST USE THE
X* FIRST ONE THAT MATCHES THE FILEMODE
XBOTHNULL EQU *
X L 10,IADT GET FIRST ADT
X USING ADTSECT,10 TELL THE ASSEMBLER
XFINDHIS EQU * LOOK FOR THE FIRST ADT THAT MATCHES
X* WHAT HE COPYED
X TM ADTFLG1,ADTFRO+ADTFRW IS IT A CMS DISK?
X BZ GETNDSK NO, KEEP GOING
X LA 1,1 LENGTH IS ONE
X STH 1,STRINGL1 FIRST STRING
X STH 1,STRINGL2 SECOND STRING
X MVC STRINGT1(1),COPYFM HIS FM
X MVC STRINGT2(1),ADTM THE ONE ON DISK
X L 15,=V(WILD) THE COMPARE ROUTINE
X LA 1,WILDPAB THE PARAMETERS FOR IT
X BALR 14,15 CALL IT
X LTR 15,15 TEST RETURN CODE
X BZ HAVEDISK MATCHES, GOT IT
XGETNDSK EQU * NOPE, TRY NEXT ONE
X L 10,ADTPTR GRAB NEXT ADT
X LTR 10,10 CHECK IT
X BNZ FINDHIS KEEP GOING IF NOT END
X LA 15,4 CAN'T FIND IT
X B DONE GO HOME
XHAVEDISK EQU * R10 HAS THE ADT
X L 1,ADTFDA GRAB HYPERBLOCK PTR
X ST 1,HYPE SAVE FOR LATER
X USING DCHSECT,1
X LA 8,DCHDATA POINT TO FIRST FST
X L 3,DCHDWSIZ GET SIZE OF HYPERBLOCK
X SLL 3,3 CONVERT TO BYTES
X LA 2,DCHSECT(3) ADD TO GET END OF HYPERBLK
X ST 2,HYPEND SAVE IT
X DROP 1
X B MTCHFILE GO LOOK FOR HIS FILE
XNNULL2 EQU * BRANCH HERE WHEN WE HAVE COPYED ADT & FST
X L 10,PABADT GRAB ADDR OF COPYED ADT
X L 10,0(10) GET THE COPYED ADT
X TM ADTFLG1,ADTFRO+ADTFRW IS IT ACCESSED?
X BNZ HISADTOK YES, KEEP GOING
X LA 15,20 USE RIGHT COND CODE
X B DONE AND GO HOME.
XHISADTOK EQU * HIS ADT IS ACCESSED.
X* LOOK FOR HIS FST & HYPERBLOCK
X L 1,ADTFDA GET FIRST HYPERBLOCK ADDR
X USING DCHSECT,1
X L 3,PABFST POINT TO HIS FST
XFSTLOOK EQU *
X LA 2,DCHDATA THIS IS WHERE FST'S START
X C 2,0(3) COMPARE WITH HIS FST
X BH LOOKNXT GET NEXT HYPERBHOCK
X L 4,DCHDWSIZ GET SIZE IN DWORDS
X SLL 4,3 MULTIPLY BY 8 TO GET BYTE #
X LA 2,DCHSECT(4) ADD TO GET BOTTOM OF HYPERBLK
X C 2,0(3) COMPARE WITH BOTTOM
X BH GOTHBLK LESS, WE FOUND IT
XLOOKNXT EQU *
X LR 4,1 SAVE THIS
X LR 1,4
X L 1,DCHFWPTR GRAB NEXT HYPERBLK
X LTR 1,1 TEST IT TO SEE IF AT END
X BNZ FSTLOOK IF NOT END, KEEP TRYING
X LA 15,16 BAD FST, NAUGHTY, NAUGHTY
X B DONE GO HOME.
XGOTHBLK EQU * WE HAVE THE HYPERBLOCK
X ST 1,HYPE SAVE THE HYPERBLOCK
X ST 2,HYPEND STORE END OF HYPERBLOCK
X DROP 1 LOOK OUT FOR THAT CLIFF!!!
X L 8,0(3) THIS BECOMES CURRENT FST
X LR 3,1
X B NEXTFILE SKIP HIS FILE
X* ALL INITIALIZED, NOW WE'RE READY TO STEP THROUGH FILES, UNTIL
X* WE FIND A MATCH OR RUN OUT.
XMTCHFILE EQU * COME HERE TO MATCH HIS FILE
X* R8 CONTAINS CURRENT FST, R10 CONTAINS CURRENT ADT, HYPE
X* CONTAINS CURRENT HYPERBLOCK, HYPEND HAS END OF HYPERBLOCK
X* (TO SEE IF WE'RE DONE)
X*
X USING FSTSECT,8 TELL ASSEMBLER
X CLC FSTN(8),=8X'00' IS IT A 0?
X BE NEXTHYP END OF THIS, TRY NEXT HYPERBLK
X CLC FSTN(8),=A(1,0) THIS IS A KLUDGE
X BE NEXTFILE TO CHECK
X CLC FSTN(8),=A(2,0) IF IT IS THE DIRECTOR OR
X BE NEXTFILE ALLOCMAP AND SKIP IT.
X* WHEN WE FIGURE OUT HOW TO DETERMINE IF IT'S A REAL FILE OR
X* A CMS INTERNAL FILE, WE WON'T HAVE TO DO IT THIS WAY.
X LA 1,FSTN+8 ASSUME END
X TRT FSTN(8),NSPC LOOK FOR FIRST NON-SPACE
X LA 2,FSTN
X SR 1,2 COMPUTE LENGTH
X STH 1,STRINGL2 SAVE LENGTH
X MVC STRINGT2(8),FSTN COPY NAME IN
X MVC STRINGL1(2),PFNL LENGTH IS ALSO 8
X MVC STRINGT1(8),COPYFN COPY COPYED NAME
X LA 1,WILDPAB ADDRESS OF PAB
X L 15,=V(WILD) POINT TO WILD ROUTINE
X BALR 14,15 CALL IT
X LTR 15,15 CHECK CONDITION CODE
X BNE NEXTFILE NOT SAME, CONTINUE
X LA 1,FSTT+8
X TRT FSTT(8),NSPC LOOK FOR NON SPACE
X LA 2,FSTT
X SR 1,2 COMPUTE LENGTH
X STH 1,STRINGL2 SAVE IT
X MVC STRINGL1(2),PFTL GET LENGTH OF COPYED FT
X MVC STRINGT1(8),COPYFT COPY COPYED TYPE
X MVC STRINGT2(8),FSTT THE TYPE FROM THE FST
X LA 1,WILDPAB ADDRESS OF PAB
X L 15,=V(WILD)
X BALR 14,15 CALL FOR TYPE
X LTR 15,15 CHECK CONDITION CODE
X BNE NEXTFILE NOPE, TRY NEXT FILE
X MVC STRINGL1(2),=H'2' LENGTH OF MODE IS 2
X MVC STRINGL2(2),=H'2' DITTO
X MVC STRINGT1(2),COPYFM HIS COPYED FILEMODE
X MVC STRINGT2(1),ADTM GET REAL MODE LETTER FROM ADT
X MVC STRINGT2+1(1),FSTM+1 USE MODE NUMBER FROM FST
X LA 1,WILDPAB ADDRESS OF PAB
X L 15,=V(WILD)
X BALR 14,15 CALL WILD (AGAIN)
X LTR 15,15 LOOK AT CONDITION CODE
X BNZ NEXTFILE NOPE, CONTINUE
X L 1,PABADT
X ST 10,0(1) SAVE ADT FOR HIM
X L 1,PABFST
X ST 8,0(1) DITTO FOR FST
X SR 15,15 INDICATE SUCCESS
X B DONE GO HOME
X* COME HERE TO STEP TO NEXT FILE
XNEXTFILE EQU * STEP TO NEXT FILE
X* CAN ALSO GO TO NEXTHYP IF APPROPRIATE.
X*
X* THERE ARE TWO DIFFERENT KINDS OF FSTS (WE THINK FOR 3370'S
X* OR 3350'S)... ONE IS CALLED AN EXTENDED DISK FORMAT, AND
X* HAS A LONGER FST: ITS LENGTH IS FSTL2. IF IT ISN'T AN EDF
X* DISK, THE LENGTH IS JUST FSTL. THE NEXT FEW INSTRUCTIONS
X* DECIDE WHICH LENGTH TO USE AND ADD THE APPROPRIATE ONE.
X*
X TM ADTFLG4,ADTEDF IS THIS AN EXTENDED ONE?
X BZ NOTEDF NOT EXTENDED DISK FORMAT
X LA 8,FSTL2(8) POINT TO NEXT FILE
X B NEXTF2 'CAUSE WE CAN'T SKIP AN INSTR
XNOTEDF EQU * USING THE SHORT FORM OF FST
X LA 8,FSTL(8) POINT TO NEXT FILE
XNEXTF2 EQU *
X C 8,HYPEND SEE IF AT END
X BL MTCHFILE NOT AT END, KEEP TRYING
X*
XNEXTHYP EQU * GO TO THE NEXT HYPERBLOCK
X* OR TO THE NEXT DISK IF NO MORE.
X L 1,HYPE POINT TO OUR HYPERBLOCK
X USING DCHSECT,1 TELL ASSEMBLER
X L 1,DCHFWPTR GRAB NEXT ONE
X LTR 1,1 SEE IF AT END OF CHAIN
X BZ NEXTDISK NEED TO USE NEXT DISK
X ST 1,HYPE SAVE HYPERBLOCK ADDR
X LA 8,DCHDATA R8 GETS FIRST FST OF BLOCK
X L 2,DCHDWSIZ GET SIZE OF BLOCK
X SLL 2,3 CONVERT TO BYTES
X LA 2,DCHSECT(2) COMPUTE END OF HYPERBLK
X ST 2,HYPEND SAVE END
X B MTCHFILE KEEP TRYING TO MATCH
X DROP 1 DON'T BREAK IT
X*
XNEXTDISK EQU * COME HERE TO JUMP TO OUR
X* NEXT ACCESSED DISK. THIS ROUTINE RETURNS A 'FILE NOT FOUND'
X* CONDITION CODE WHEN IT RUNS OUT OF DISKS TO CHECK.
X*
X L 10,ADTPTR GRAB NEXT BLOCK IN CHAIN
X LTR 10,10 MAKE SURE THIS ISN'T THE END
X BNZ CHECKDSK IT'S THERE, GO LOOK AT IT.
X LA 15,4 SORRY, NO MORE
X L 1,PABFST GET ADDRESS OF COPYED FST
X MVC 0(4,1),=X'FF000000' RETURN A NULL AS FST
X L 1,PABADT ADDRESS FOR ADT
X MVC 0(4,1),=X'FF000000' DITTO FOR ADT
X B DONE BYE.
XCHECKDSK EQU * MAKE SURE DISK IS ACCESSED
X* AND MATCHES COPYED FM BEFORE GIVING IT TO ANYONE
X TM ADTFLG1,ADTFRO+ADTFRW IS IT A CMS DISK?
X BZ NEXTDISK NO, TRY NEXT ONE
X MVC STRINGL1(2),=H'1' LENGTH FOR MODE IS 1
X MVC STRINGL2(2),=H'1' DITTO
X MVC STRINGT1(1),COPYFM COPY HIS FM
X MVC STRINGT2(1),ADTM COPY DISK'S MODE
X LA 1,WILDPAB POINT TO PARMS
X L 15,=V(WILD) I HATE TYPING THIS
X BALR 14,15 CALL HIM
X LTR 15,15 CHECK CC
X BNZ NEXTDISK DIDN'T WORK, TRY ANOTHER
X L 1,ADTFDA GRAB HYPERBLOCK ADDRESS
X USING DCHSECT,1 TELL ASSEMBLER
X ST 1,HYPE SAVE HYPERBLOCK START
X LA 8,DCHDATA FIRST FST
X L 2,DCHDWSIZ GET SIZE IN DWORDS
X SLL 2,3 CONVERT TO BYTES
X LA 2,DCHSECT(2) COMPUTE LENGTH OF HYPERBLK
X ST 2,HYPEND SAVE END
X B MTCHFILE AND KEEP TRYING.
X DROP 1 KLUNK
XDONE EQU * RESTORE EVERYTHING BUT 15, RET
X L 13,4(13) OLD SAVE AREA
X L 14,12(13) RESTORE R14
X LM 0,12,20(13) NOW THE REST
X BR 14 HOME, JAMES!
X* DATA AREA
XNEXTFSTA CSECT
XSAVEAREA DS 18F SAVE AREA FOR GUY DOWN THERE
XWILDPAB DC A(STRINGL1,STRINGL2,WILDCHAR)
XSTRINGL1 DS H
XSTRINGT1 DS CL8
XSTRINGL2 DS H
XSTRINGT2 DS CL8
XWILDCHAR DC C'*%' STANDARD WILDCARD CHARS
XHYPE DS A ADDRESS OF CURRENT HYPERBLK
XHYPEND DS A END OF CURRENT HYPERBLK
XPFNL DS H LENGTH OF COPYED FILENAME
XPFTL DS H " " " FILEMODE
XCOPYFI DS CL18 FOR FILENAME,FILETYPE,FM
X ORG COPYFI FOR OVERLAY
XCOPYFN DS CL8
XCOPYFT DS CL8
XCOPYFM DS CL2
X ORG
XNSPC DC 256X'00' ALLOW EVERYTHING
X ORG NSPC+C' ' EXCEPT
X DC X'01' SPACES
X ORG
XPAB DSECT
XPABFN DS A POINTER TO FN,FT,FM
XPABADT DS A ADDRESS OF ADT TO START WITH
XPABFST DS A POINTER TO ADDR OF FST TO START
XPASSFI DSECT
XPASSFN DS CL8 THE NAME
XPASSFT DS CL8 THE TYPE
XPASSFM DS CL2 AND THE MODE
X NUCON , NUCLEUS CONSTANTS
X FSTB , THE OLD EXTENDED FILE STATUS TABLE
X ADT , THE PROVERBIAL ACTIVE DISK TABLE
X DCH , DATA CONTROL HYBERBLOCK (DON'T LOOK AT US)
X END
X
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 15505 Oct 23 16:35 cmsnxtfst.asm (as sent)'
chmod u=rw,g=rw,o=rw cmsnxtfst.asm
ls -l cmsnxtfst.asm
echo x - cmsnxtfst.doc
sed 's/^X//' > cmsnxtfst.doc <<'+FUNKY+STUFF+'
XRevised: 2/8/83 NEXTFST SUBROUTINE
X
X
X1. Introduction
X
X NEXTFST is an assembler language subroutine which permits an assembler or
Xhigh level language program to go through the list of files on the currently
Xaccessed disks. It permits wild card matching in fileid's and returns pointers
Xto the FST (File Status Table) and ADT (Active Disk Table) for each file
Xmatching the passed fileid. Return codes are passed back indicating success of
Xfile id match.
X
X2. CMS Command Syntax and Options
X
X The subroutine is called with three arguements: an 18 byte character string,
Xthe file pattern, containing the filename, filetype, and filemode to be
Xsearched for; a pointer which will be filled with the address of the ADT of the
Xmatched file, and a pointer which will be filled with the address of the FST of
Xthe matched file. If there are no files left which match the passed file
Xpattern then a NULL (X'FF000000') is placed in the two pointers. The ADT and
XFST pointers should not be changed between calls since they are used as
Xlocators indicating where to start looking for the next FST on subsequent
Xcalls.
X
X The file matching pattern consists of three seperate fields: the filename
Xpattern, the filetype pattern, and the filemode pattern. Each of the first two
Xfields are 8 characters long, the third is 2 characters. In the pattern, the
X"*" matches any number of characters, and the "%" matches any single character.
XIn the filemode field, a blank in the filemode letter position (first position)
Xmatches filemode A, a blank in the filemode number matches any filemode number.
XOnly characters up to the first blank in the filename and filetype fields are
Xrecognized, those following it are ignored. See the examples section for
Xexamples of this matching.
X
X When NEXTFST is invoked from PL/I, a declaration such as the following one
Xshould be used:
X
X DECLARE NEXTFST ENTRY(CHAR(18),POINTER,POINTER) EXTERNAL
X OPTIONS(ASSEMBLER,INTER,RETCODE);
X
XThe return code passed back from NEXTFST may be inspected by the PL/I builtin
Xfunction, PLIRETV.
X
X From assembler, use the standard OS calling conventions.
X
X3. Examples under CMS
X
X The file pattern
X
X
X Filename Filetype FM
X +--------+--------+--+
X |ABC% |* |Z |
X +--------+--------+--+
X
X CUCCA User Services Technical Note [1]
X Revised: 2/8/83 NEXTFST SUBROUTINE
X
X
Xwill match any file having a four letter filename starting with ABC on the
Xcurrently accessed Z-disk.
X
X
X
X The following PL/I program may be used to print a list of all the files on
Xthe A-disk:
X
X
X LISTF:PROC OPTIONS(MAIN);
X DECLARE NEXTFST ENTRY(CHAR(18),POINTER,POINTER) EXTERNAL
X OPTIONS(ASSEMBLER,INTER,RETCODE);
X DCL FID CHAR(18) INIT('* * A%'),
X (ADTPTR,FSTPTR) POINTER INIT(NULL);
X DCL (NULL,PLIRETV) BUILTIN;
X DCL 1 FST BASED(FSTPTR),
X 2 FN CHAR(8),
X 2 FT CHAR(8);
X
X CALL NEXTFST(FID,ADTPTR,FSTPTR);
X DO WHILE(PLIRETV=0);
X PUT FILE(SYSPRINT) SKIP LIST(FN,FT);
X CALL NEXTFST(FID,ADTPTR,FSTPTR);
X END;
X RETURN;
X END LISTF;
X
X Note that the FST has the filename and filetype as its first two doublewords.
XFor a complete description of the FST see the Data Areas and Control Block
XLogic manual, SY20-0884.
X
X
X
XThis example shows how a paramteter address block (PAB) would be set up in an
Xassembler program to call NEXTFST
X
X NEXTPAB DC A(FILPAT) ADDRESS OF FILE PATTERN
X DC A(ADTADDR) ADDRESS OF POINTER TO ADT
X DC X'80',AL3(FSTADDR) ADDRESS OF PTR TO FST
X
X4. VS1 JCL
X
X NOT APPLICABLE
X
X5. Examples under VS1
X
X NOT APPLICABLE
X
X
X
X
X
X CUCCA User Services Technical Note [2]
X Revised: 2/8/83 NEXTFST SUBROUTINE
X
X
X6. Additional Information
X
X The return codes and their meanings are as follows:
X
X 0 - normal return, file found.
X 4 - file not found or disk not accessed.
X 8 - one, but not both of ADTPTR and FSTPTR was null (X'FF000000') when
X NEXTFST was called.
X12 - the passed ADTPTR is bad.
X16 - the passed FSTPTR is bad; it is not pointing at one of the FST's in
X the passed ADTPTR's FST hyperblocks.
X20 - the ADTPTR is not pointing at a currently accessed disk.
X
X No files should be added or erased from the disk which the ADTPTR is pointing
Xat between calls to NEXTFST. If either of these actions are taken, then the FST
Xreturned by NEXTFST might not be the next one in the list of FST's which match
Xthe passed pattern.
X
X NEXTFST requires the WILD subroutine for execution. It must be available when
XNEXTFST is loaded.
X
X The FST may not contain the correct filemode letter, check the returned ADT
Xfor that information. It does, however, contain the correct file mode number.
X
X7. Reference
X
X The following manual contains a description of the FST and ADT: IBM Virtual
XMachine Facility/370: Data Areas and Control Block Logic, Order number
XSY20-0884.
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X CUCCA User Services Technical Note [3]
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 5379 Oct 23 16:35 cmsnxtfst.doc (as sent)'
chmod u=rw,g=rw,o=rw cmsnxtfst.doc
ls -l cmsnxtfst.doc
echo x - cmsnxtfst.mss
sed 's/^X//' > cmsnxtfst.mss <<'+FUNKY+STUFF+'
X at make(vmappendix)
X at comment(this is the NEXTFST appendix, by Carl Kass, Dec. 22, 1980)
X at comment<Copyright (C) 1980 Columbia University>
X at case(device,diablo="@Typewheel(pica)")
X at appendixname(name="NEXTFST SUBROUTINE")
X at introduction
X@;NEXTFST is an assembler language subroutine which permits an assembler
Xor high level language program to go through the list of files on the
Xcurrently accessed disks. It permits wild card matching in fileid's
Xand returns pointers to the FST (File Status Table) and ADT (Active
XDisk Table) for each file matching the passed fileid. Return codes
Xare passed back indicating success of file id match.
X@;@cmssyntax
XThe subroutine is called with three arguements: an 18 byte character
Xstring, the file pattern, containing the filename, filetype, and
Xfilemode to be searched for; a pointer which will be filled with the
Xaddress of the ADT of the matched file, and a pointer which will be
Xfilled with the address of the FST of the matched file. If there are
Xno files left which match the passed file pattern then a NULL
X(X'FF000000') is placed in the two pointers. The ADT and FST pointers
Xshould not be changed between calls since they are used as locators
Xindicating where to start looking for the next FST on subsequent
Xcalls.
X
XThe file matching pattern consists of three seperate fields: the
Xfilename pattern, the filetype pattern, and the filemode pattern. Each
Xof the first two fields are 8 characters long, the third is 2
Xcharacters. In the pattern, the "*" matches any number of characters,
Xand the "%" matches any single character. In the filemode field, a
Xblank in the filemode letter position (first position) matches
Xfilemode A, a blank in the filemode number matches any filemode
Xnumber. Only characters up to the first blank in the filename and
Xfiletype fields are recognized, those following it are ignored. See
Xthe examples section for examples of this matching.
X
XWhen NEXTFST is invoked from PL/I, a declaration such as the following
Xone should be used:
X at begin(example,group)
XDECLARE NEXTFST ENTRY(CHAR(18),POINTER,POINTER) EXTERNAL
X OPTIONS(ASSEMBLER,INTER,RETCODE);
X at END(EXAMPLE)
XThe return code passed back from NEXTFST may be inspected by the
XPL/I builtin function, PLIRETV.
X
XFrom assembler, use the standard OS calling conventions.
X@;@cmsexamples
XThe file pattern
X@;@begin(verbatim)
X Filename Filetype FM
X +--------+--------+--+
X |ABC% |* |Z |
X +--------+--------+--+
X@;@end(varbatim)
Xwill match any file having a four letter filename starting with ABC on
Xthe currently accessed Z-disk.
X@;@drawline
XThe following PL/I program may be used to print a list of all the
Xfiles on the A-disk:
X@;@begin(example,group)
XLISTF:PROC OPTIONS(MAIN);
XDECLARE NEXTFST ENTRY(CHAR(18),POINTER,POINTER) EXTERNAL
X OPTIONS(ASSEMBLER,INTER,RETCODE);
XDCL FID CHAR(18) INIT('* * A%'),
X (ADTPTR,FSTPTR) POINTER INIT(NULL);
XDCL (NULL,PLIRETV) BUILTIN;
XDCL 1 FST BASED(FSTPTR),
X 2 FN CHAR(8),
X 2 FT CHAR(8);
X
XCALL NEXTFST(FID,ADTPTR,FSTPTR);
XDO WHILE(PLIRETV=0);
X PUT FILE(SYSPRINT) SKIP LIST(FN,FT);
X CALL NEXTFST(FID,ADTPTR,FSTPTR);
XEND;
XRETURN;
XEND LISTF;
X at END(EXAMPLE)
X
XNote that the FST has the filename and filetype as its first two
Xdoublewords. For a complete description of the FST see the Data Areas
Xand Control Block Logic manual, SY20-0884. @drawline This example
Xshows how a paramteter address block (PAB) would be set up in an
Xassembler program to call NEXTFST
X at begin(example,group)
XNEXTPAB DC A(FILPAT) ADDRESS OF FILE PATTERN
X DC A(ADTADDR) ADDRESS OF POINTER TO ADT
X DC X'80',AL3(FSTADDR) ADDRESS OF PTR TO FST
X at END(EXAMPLE)
X@;@vs1syntax
X@;@na
X@;@vs1examples
X@;@na
X@;@additionalinfo
XThe return codes and their meanings are as follows:
X at begin(description,indentation -4,leftmargin +4,rightmargin +4,spacing
X1,spread 0)
X@ 0 - normal return, file found.
X
X@ 4 - file not found or disk not accessed.
X
X@ 8 - one, but not both of ADTPTR and FSTPTR was null (X'FF000000') when
XNEXTFST was called.
X
X12 - the passed ADTPTR is bad.
X
X16 - the passed FSTPTR is bad; it is not pointing at one of the FST's
Xin the passed ADTPTR's FST hyperblocks.
X
X20 - the ADTPTR is not pointing at a currently accessed disk.
X at end(description)
X
XNo files should be added or erased from the disk which the ADTPTR is
Xpointing at between calls to NEXTFST. If either of these actions are
Xtaken, then the FST returned by NEXTFST might not be the next one in
Xthe list of FST's which match the passed pattern.
X
XNEXTFST requires the WILD subroutine for execution. It must be
Xavailable when NEXTFST is loaded.
X
XThe FST may not contain the correct filemode letter, check the
Xreturned ADT for that information. It does, however, contain the
Xcorrect file mode number.
X
X@;@references
XThe following manual contains a description of the FST and ADT:
X at i(IBM Virtual Machine Facility/370: Data Areas and Control Block
XLogic,) Order number SY20-0884.
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 4984 Oct 23 16:35 cmsnxtfst.mss (as sent)'
chmod u=rw,g=rw,o=rw cmsnxtfst.mss
ls -l cmsnxtfst.mss
echo x - cmswild.asm
sed 's/^X//' > cmswild.asm <<'+FUNKY+STUFF+'
X* WILD ASSEMBLE
X*
X* CARL KASS AND JEFF DAMENS, CUCCA USER SERVICES, 12/80
X* COPYRIGHT (C) 1980 COLUMBIA UNIVERSITY
X* PERMISSION IS GRANTED TO ANY INDIVIDUAL OR INSTITUTION TO COPY
X* OR USE THIS PROGRAM, EXCEPT FOR EXPLICITLY COMMERCIAL PURPOSES.
X*
XWILD CSECT
X USING WILD,15 ADDRESSABILITY
X STM 14,12,12(13) SAVE REGS
X LR 14,13 SAVE REG 14
X L 13,=V(WILDA) DATA AREA
X USING WILDA,13 POINT TO DATA AREA
X ST 14,4(13) BACKCHAIN
X ST 13,8(14) FORECHAIN
X DROP 15
X BALR 10,0 ESTABLISH FINAL...
X USING *,10 ...ADDRESSABILITY
X************
X* WILDCARD STRING MATCH. CALL WITH R1 POINTING TO PAB OF FORM:
X* A(PAT.STRING)
X* A(SOURCE.STRING)
X* A(C'*%') WHERE * IS SNOBOL'S ARB, % IS LEN(1).
X* RETURNS CC=0 IF STRINGS MATCH, CC=8 IF NOT
X*
X* IF ONLY 2 PARMS ARE PASSED, THEN THE THIRD IS ASSUMED TO BE
X* "*" FOR THE ARB AND "%" FOR THE LEN(1)
X*
X**********
X* FIRST SOME INITIALIZATION
X SR 5,5
X SR 7,7
X USING PAB,1
X L 2,APAT GET PATTER ADDRESS
X USING STRING,2
X LH 5,STRLEN GET LENGTH
X LA 4,STRTXT POINT AT START OF PATTERN
X DROP 2 DON'T NEED PTR NOW
X L 2,ASRC POINT AT PARAMETER SOURCE
X USING STRING,2 NOW WE NEED IT
X LH 7,STRLEN GET LENGTH OF SOURCE
X LA 6,STRTXT POINT AT SOURCE
X* NOW CHECK TO SEE IF THERE IS A THIRD PARAMETER
X CLI ASRC,X'80' IS FIRST BIT ON?
X BE NOTHIRD IF SO THEN THIS IS LAST PARM
X DROP 2 THUD
X L 2,ASPEC ADDRESS OF SPECIAL CHARS
X MVC ARB(2),0(2) COPY BOTH
X B COMSTART GO AND USE THIRD PARM
XNOTHIRD EQU * NO THIRD PARMS, USE DEFAULTS
X MVC ARB(2),=CL2'*%' MOVE IN DEFAULTS
XCOMSTART EQU * COMMON THIRD PARM START ADDR
X MVI STARFLG,X'00' HAVEN'T SEEN ANY OF THESE
X ICM 7,B'1000',ARB USE THIS AS THE FILL CHAR
X*
XCOMPRE EQU *
X CLCL 4,6 COMPARE THEM
X BE SUCCESS THEY'RE EQUAL, TELL SOMEONE
X*****
X* STRINGS DON'T MATCH, SO EXAMINE OFFENDING PATTERN CHARACTER
X* IF NOT A SPECIAL CHARACTER AND WE HAVEN'T SEEN ANY ARBS YET,
X* ALL WE CAN DO IS FAIL. IF IT'S THE LEN1 CHARACTER, WE JUST
X* SKIP IT; IF IT'S THE ARB CHARACTER, WE SKIP IT AND REMEMBER
X* WE'VE SEEN IT. OTHERWISE, BACK UP TO ONE PAST THE LAST ARB
X* CHARACTER AND TRY AGAIN.
X*******
X CLC 0(1,4),LEN1 WAS IT THE LEN1 CHARACTER?
X BE GOTLEN1 TAKE CARE OF IT.
X CLC 0(1,4),ARB WAS IT THE ARB CHAR
X BE GOTARB HANDLE IT
X CLI STARFLG,X'00' HAVE WE SEEN A STAR?
X BE BOMB NO, FAIL
X CLM 7,B'0111',=XL3'000000' IS THIS ONE EXHAUSTED
X BE BOMB SAME DEAL HERE
X LM 4,7,PATADDR RESTORE ADDR OF OLD ARB CHAR
X LA 6,1(6) PUSH ONE PAST
X BCTR 7,0 DECREMENT LENGTH
X STM 6,7,SRCADDR STORE CHANGED ADDR
X B COMPRE AND GO COMPARE AGAIN.
XGOTLEN1 EQU *
X LA 4,1(4) INCREMENT PATTERN ADDR
X BCTR 5,0 DECREMENT PATTERN LEN
X LA 6,1(6) INCREMENT SOURCE ADDR
X BCTR 7,0 DECREMENT SOURCE LEN
X LA 0,0(,7) GET LENGTH W/O PAD CHAR
X LTR 0,0 ANY MORE SOURCE LEFT?
X BNZ COMPRE AND KEEP TRYINGKING
X LTR 5,5 NO DATA LEFT HERE EITHER?
X BZ SUCCESS SAME LENGTH - A MATCH
X CLC 0(1,4),ARB IS IT THE WILD CHAR?
X BE COMPRE IT'S OK
X B BOMB ELSE, WE FAIL
XGOTARB EQU *
X* IF PATTERN ENDS IN ARB, THEN IT WILL MATCH ANYTHING, SO
X* GOTARB SHOULD NOT RETURN TO COMPRE IF THE PATTERN IS EXHAUSTED.
X MVI STARFLG,X'FF' REMEMBER WE SAW ONE
X LA 4,1(4) PASS THE STAR
X BCTR 5,0 DECREMENT ITS LENGTH
X LTR 5,5
X BZ SUCCESS WE HAVE A MATCH
X STM 4,7,PATADDR SAVE WHERE THEY WERE
X B COMPRE
XSUCCESS EQU *
X L 13,4(13) RESTORE OLD SAVE AREA
X LM 14,12,12(13) BLAH
X SR 15,15 IT WORKED
X BR 14 HOME, JAMES
XBOMB EQU * IS IT EQUAL TO A START?
X L 13,4(13) PUT THE CONTENTS OF 13 IN 4
X LM 14,12,12(13) PUT LOTS OF NUMBERS BACK
X LA 15,8(0) TAKE SOME NUMBERS
X BR 14 CALL IEFBR14
X* DATA AREA
XWILDA CSECT
XSAVEAREA DS 18F
X* NEXT TWO THINGS MUST BE ADJACENT
XARB DS CL1'*' THIS MATCHES ANY STRING.
XLEN1 DS CL1'%' THIS MATCHES ANY CHARACTER.
XSTARFLG DS X'00' IF ON, WE'VE SEEN A STAR
XPATADDR DS A PLACE IN PATTERN OF LAST STAR
XPATOLDLN DS F LENGTH OF PATTERN PAST STAR
XSRCADDR DS A PLACE IN SOURCE WHEN STAR SEEN
XSRCOLDLN DS F LENGTH OF SOURCE PAST SRCADDR
XPAB DSECT
XAPAT DS A ADDRESS OF THE PATTERN STRING
XASRC DS A ADDRESS OF THE SOURCE STRING
XASPEC DS A ADDRESS OF SPECIAL CHARS STRING
XSTRING DSECT
XSTRLEN DS H LENGTH OF THE STRING
XSTRTXT DS C THE ACTUAL STRING
X END , THIS IS A COMMENT
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 6253 Oct 23 16:35 cmswild.asm (as sent)'
chmod u=rw,g=rw,o=rw cmswild.asm
ls -l cmswild.asm
echo x - cmswild.dif
sed 's/^X//' > cmswild.dif <<'+FUNKY+STUFF+'
XThe version of CMSWILD that was sent out on the Feb 11-17, 1983, DEC-20
XKermit distribution tapes was wrong. The current version of CMSWILD is
Xcorrect. Here are the differences:
X
XDirectly after the "WILD CSECT" statement, the -20 version is missing the
Xfollowing 6 lines between lines 8 and 9 (all instructions must be in
Xupper case):
X
XWILD CSECT
X USING WILD,15 ADDRESSABILITY
X STM 14,12,12(13) SAVE REGS
X LR 14,13 SAVE REG 14
X L 13,=V(WILDA) DATA AREA
X USING WILDA,13 POINT TO DATA AREA
X ST 14,4(13) BACKCHAIN
X
XAfter the comment "* FIRST SOME INITIALIZATION", the -20 version is missing
Xthe following 2 lines (between lines 24 and 25):
X
X* FIRST SOME INITIALIZATION
X SR 5,5
X SR 7,7
X
XThe whole section between the labels "GOTLEN1" and "GOTARB" should be
Xchanged. Delete lines 72/78 and insert instead to read:
X
XGOTLEN1 EQU *
X LA 4,1(4) INCREMENT PATTEN ADDR
X BCTR 5,0 DECREMENT PATTERN LEN
X LA 6,1(6) INCREMENT SOURCE ADDR
X BCTR 7,0 DECREMENT SOURCE LEN
X LA 0,0(,7) GET LENGTH W/O PAD CHAR
X LTR 0,0 ANY MORE SOURCE LEFT?
X BNZ COMPRE AND KEEP TRYING
X LTR 5,5 NO DATA LEFT HERE EITHER?
X BZ SUCCESS SAME LENGTH - A MATCH
X CLC 0(1,4),ARB IS IT THE WILD CHAR?
X BE COMPRE IT'S OK
X B BOMB ELSE, WE FAIL
XGOTARB EQU *
X
XAfter "GOTARB" follows two comments. There should be 7 lines of
Xcode after that before the label "SUCCESS". Replace lines 81
X(starting with the "MVI" instruction) through 86 with the following:
X
X* IF PATTERN.......
X* GOTARB SHOULD........
X MVI STARFLAG,X'FF' REMEMBER WE SAW ONE
X LA 4,1(4) PASS THE START
X BCTR 5,0 DECREMENT ITS LENGTH
X LTR 5,5
X BZ SUCCESS WE HAVE A MATCH
X STM 4,7,PATADDR SAVE WHERE THEY WERE
X B COMPRE
XSUCCESS EQU *
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 1693 Oct 23 16:36 cmswild.dif (as sent)'
chmod u=rw,g=rw,o=rw cmswild.dif
ls -l cmswild.dif
echo x - cmswild.doc
sed 's/^X//' > cmswild.doc <<'+FUNKY+STUFF+'
XRevised: 2/8/83 WILD SUBROUTINE
X
X
X1. Introduction
X
X The WILD subroutine is an assembler language subroutine which is PL/I
Xcallable as well as assembler callable. It compares two varying length strings
Xwith wild card matching.
X
X2. CMS Command Syntax and Options
X
X The subroutine may be declared either with two or three parameters from PL/I
Xas follows:
X
X DECLARE WILD ENTRY(CHAR(*) VAR,CHAR(*) VAR[,CHAR(2)])
X EXTERNAL OPTIONS(ASSEMBLER,INTER,RETCODE);
X
X and called as follows:
X
X CALL WILD(pattern,source[,wildcards]);
X
Xwhere "pattern" and "source" are character(*) varying and "wildcards" is
Xcharacter(2). "pattern" and "source" need not be the same length. "pattern"
Xrepresents the pattern string, whereas "source" is the string to be tested for
Xmatching the patten. "wildcard", if specified, represents the two wildcard
Xcharacters. The first of the two characters is a symbol which may appear in the
Xpattern string but not the source string which will match any number of any
Xcharacters (SNOBOL's ARB pattern). It is the calling program's responsibility
Xto ensure that the first wildcard character does not appear in the source
Xstring. The second wildcard character which may appear in the pattern and/or
Xthe source string will match any single character in the source string
X(SNOBOL's LEN(1)). If only two strings are passed, then the wildcard characters
Xdefault to "*" for ARB and "%" for LEN(1).
X
X To call WILD from assembler, use the standard OS calling conventions. The
Xformat of the source and pattern strings is as follows:
X
X +----------+--------------------+
X | | |
X +----------+--------------------+
X length text
X
X where the length field is a binary halfword containing the length of the text
Xfield. The wildcard string is simply a two byte string (CL2). If no wildcard
Xstring is to be passed to WILD, then the first byte of the second word of the
Xparameter address block (PAB) must be X'80'.
X
X If the strings match, then WILD will set a return code of 0 whereas if they
Xdon't match the return code will be set to 8. From PL/I this value may be
Xexamined through the PLIRETV builtin function, from assembler register 15 will
Xcontain the return code.
X
X Note: PLIRETV should be declared as follows:
X
X DECLARE PLIRETV BUILTIN;
X CUCCA User Services Technical Note [1]
X Revised: 2/8/83 WILD SUBROUTINE
X
X
Xand then used as any normal builtin function having no arguements (see example
Xbelow).
X
X3. Examples under CMS
X
X This is an example of calling WILD from a PL/I program passing it three
Xparameters:
X
X /* S1 IS THE PATTERN AND S2 IS THE SOURCE */
X DECLARE (S1,S2) CHAR(72) VARYING;
X /* $ IS ARB AND & IS LEN(1) */
X DECLARE WILDCHARS CHAR(2) STATIC INITIAL('$&');
X DECLARE WILD ENTRY(CHAR(*) VAR,CHAR(*) VAR,CHAR(2))
X EXTERNAL OPTIONS(ASSEMBLER,RETCODE,INTER);
X DECLARE PLIRETV BUILTIN;
X .
X .
X .
X CALL WILD(S1,S2,WILDCHARS);
X IF PLIRETV=8 THEN GOTO NOMATCH;
X ELSE GOTO MATCH;
X
X
X
X This example illustrates calling WILD from assembler using the default
Xwildcard characters:
X
X L 15,=V(WILD) POINT AT SUBROUTINE
X LA 1,PAB POINT AT PAB TO PASS
X BALR 14,15 DO CALL
X * THE RETURN IS TO HERE
X LTR 15,15 IS THE RETURN CODE 0?
X BZ MATCH IF SO THEN GOTO MATCH
X B NOMATCH OTHERWISE GOTO NOMTACH
X .
X .
X .
X PAB DS 0F FULLWORD ALIGN THE PAB
X DC A(PATTERN) ADDRESS OF PATTERN STRING
X DC X'80' FLAG INDICATING ONLY 2 PARMS
X DC AL3(SOURCE) ADDRESS OF SOURCE STRING
X .
X .
X .
X PATTERN DS H FILL IN LENGTH OF PATTERN
X DS CL80 ANY LENGTH FOR PATTERN STRING
X SOURCE DS H FILL IN LENGTH OF SOURCE
X DS CL90 ANY LENGTH FOR SOURCE STRING
X
X
X
X
X CUCCA User Services Technical Note [2]
X Revised: 2/8/83 WILD SUBROUTINE
X
X
X4. VS1 JCL
X
X NOT APPLICABLE
X
X5. Examples under VS1
X
X NOT APPLICABLE
X
X6. Additional Information
X
X WILD runs extremely quickly and may be freely used to compare two strings.
X
X7. Reference
X
X NOT APPLICABLE
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X
X CUCCA User Services Technical Note [3]
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 4906 Oct 23 16:36 cmswild.doc (as sent)'
chmod u=rw,g=rw,o=rw cmswild.doc
ls -l cmswild.doc
echo x - cmswild.mod
sed 's/^X//' > cmswild.mod <<'+FUNKY+STUFF+'
XDirectly after the "WILD CSECT" statement, the -20 version is missing the
Xfollowing 6 lines between lines 8 and 9 (all instructions must be in
Xupper case):
X
XWILD CSECT
X USING WILD,15 ADDRESSABILITY
X STM 14,12,12(13) SAVE REGS
X LR 14,13 SAVE REG 14
X L 13,=V(WILDA) DATA AREA
X USING WILDA,13 POINT TO DATA AREA
X ST 14,4(13) BACKCHAIN
X
XAfter the comment "* FIRST SOME INITIALIZATION", the -20 version is missing
Xthe following 2 lines (between lines 24 and 25):
X
X* FIRST SOME INITIALIZATION
X SR 5,5
X SR 7,7
X
XThe whole section between the labels "GOTLEN1" and "GOTARB" should be
Xchanged. Delete lines 72/78 and insert instead to read:
X
XGOTLEN1 EQU *
X LA 4,1(4) INCREMENT PATTEN ADDR
X BCTR 5,0 DECREMENT PATTERN LEN
X LA 6,1(6) INCREMENT SOURCE ADDR
X BCTR 7,0 DECREMENT SOURCE LEN
X LA 0,0(,7) GET LENGTH W/O PAD CHAR
X LTR 0,0 ANY MORE SOURCE LEFT?
X BNZ COMPRE AND KEEP TRYING
X LTR 5,5 NO DATA LEFT HERE EITHER?
X BZ SUCCESS SAME LENGTH - A MATCH
X CLC 0(1,4),ARB IS IT THE WILD CHAR?
X BE COMPRE IT'S OK
X B BOMB ELSE, WE FAIL
XGOTARB EQU *
X
XAfter "GOTARB" follows two comments. There should be 7 lines of
Xcode after that before the label "SUCCESS". Replace lines 81
X(starting with the "MVI" instruction) through 86 with the following:
X
X* IF PATTERN.......
X* GOTARB SHOULD........
X MVI STARFLAG,X'FF' REMEMBER WE SAW ONE
X LA 4,1(4) PASS THE START
X BCTR 5,0 DECREMENT ITS LENGTH
X LTR 5,5
X BZ SUCCESS WE HAVE A MATCH
X STM 4,7,PATADDR SAVE WHERE THEY WERE
X B COMPRE
XSUCCESS EQU *
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 1512 Oct 23 16:36 cmswild.mod (as sent)'
chmod u=rw,g=rw,o=rw cmswild.mod
ls -l cmswild.mod
echo x - cmswild.mss
sed 's/^X//' > cmswild.mss <<'+FUNKY+STUFF+'
X at make(vmappendix)
X at comment(this is the WILD appendix, by Carl Kass, Dec 13, 1980)
X at comment<Copyright (C) 1980 Columbia University>
X at case<device,diablo="@Typewheel(pica)">
X at appendixname(name="WILD subroutine")
X at introduction
XThe WILD subroutine is an assembler language subroutine which is PL/I
Xcallable as well as assembler callable. It compares two varying
Xlength strings with wild card matching.
X at cmssyntax
XThe subroutine may be declared either with two or three parameters
Xfrom PL/I as follows:
X
X at begin(example,group)
XDECLARE WILD ENTRY(CHAR(*) VAR,CHAR(*) VAR[,CHAR(2)])
X EXTERNAL OPTIONS(ASSEMBLER,INTER,RETCODE);
X at end(example)
X
Xand called as follows:
X at begin(example,group)
XCALL WILD(pattern,source[,wildcards]);
X at end(example)
Xwhere "pattern" and "source" are character(*) varying and "wildcards"
Xis character(2). "pattern" and "source" need not be the same length.
X"pattern" represents the pattern string, whereas "source" is the
Xstring to be tested for matching the patten. "wildcard", if specified,
Xrepresents the two wildcard characters. The first of the two
Xcharacters is a symbol which may appear in the pattern string but not
Xthe source string which will match any number of any characters
X(SNOBOL's ARB pattern). It is the calling program's responsibility to
Xensure that the first wildcard character does not appear in the source
Xstring. The second wildcard character which may appear in the pattern
Xand/or the source string will match any single character in the source
Xstring (SNOBOL's LEN(1)). If only two strings are passed, then the
Xwildcard characters default to "*" for ARB and "%" for LEN(1).
X
XTo call WILD from assembler, use the standard OS calling conventions.
XThe format of the source and pattern strings is as follows:
X
X at begin(verbatim)
X +----------+--------------------+
X | | |
X +----------+--------------------+
X length text
X at end(verbatim)
X
Xwhere the length field is a binary halfword containing the length of
Xthe text field. The wildcard string is simply a two byte string (CL2).
XIf no wildcard string is to be passed to WILD, then the first byte of
Xthe second word of the parameter address block (PAB) must be X'80'.
X
XIf the strings match, then WILD will set a return code of 0 whereas if
Xthey don't match the return code will be set to 8. From PL/I this
Xvalue may be examined through the PLIRETV builtin function, from
Xassembler register 15 will contain the return code.
X
XNote:
XPLIRETV should be declared as follows:
X at begin(example)
XDECLARE PLIRETV BUILTIN;
X at end(example)
Xand then used as any normal builtin function having no arguements (see
Xexample below).
X at cmsexamples
XThis is an example of calling WILD from a PL/I program passing it
Xthree parameters:
X at begin(example,group)
X/* S1 IS THE PATTERN AND S2 IS THE SOURCE */
XDECLARE (S1,S2) CHAR(72) VARYING;
X/* $ IS ARB AND & IS LEN(1) */
XDECLARE WILDCHARS CHAR(2) STATIC INITIAL('$&');
XDECLARE WILD ENTRY(CHAR(*) VAR,CHAR(*) VAR,CHAR(2))
X EXTERNAL OPTIONS(ASSEMBLER,RETCODE,INTER);
XDECLARE PLIRETV BUILTIN;
X .
X .
X .
XCALL WILD(S1,S2,WILDCHARS);
XIF PLIRETV=8 THEN GOTO NOMATCH;
X ELSE GOTO MATCH;
X at end(example)
X at drawline
XThis example illustrates calling WILD from assembler using the default
Xwildcard characters:
X at begin(example,group)
X L 15,=V(WILD) POINT AT SUBROUTINE
X LA 1,PAB POINT AT PAB TO PASS
X BALR 14,15 DO CALL
X* THE RETURN IS TO HERE
X LTR 15,15 IS THE RETURN CODE 0?
X BZ MATCH IF SO THEN GOTO MATCH
X B NOMATCH OTHERWISE GOTO NOMTACH
X .
X .
X .
XPAB DS 0F FULLWORD ALIGN THE PAB
X DC A(PATTERN) ADDRESS OF PATTERN STRING
X DC X'80' FLAG INDICATING ONLY 2 PARMS
X DC AL3(SOURCE) ADDRESS OF SOURCE STRING
X .
X .
X .
XPATTERN DS H FILL IN LENGTH OF PATTERN
X DS CL80 ANY LENGTH FOR PATTERN STRING
XSOURCE DS H FILL IN LENGTH OF SOURCE
X DS CL90 ANY LENGTH FOR SOURCE STRING
X at end(example)
X at vs1syntax
X at na
X at vs1examples
X at na
X at additionalinfo
XWILD runs extremely quickly and may be freely used to compare two
Xstrings.
X at references
X at na
+FUNKY+STUFF+
echo '-rw-rw-rw- 1 barry 4349 Oct 23 16:36 cmswild.mss (as sent)'
chmod u=rw,g=rw,o=rw cmswild.mss
ls -l cmswild.mss
exit 0
--
Barry Lustig
Harvey Mudd College
UUCP: {ihnp4,allegra,seismo}!scgvaxd!muddcs!barry
ARPA: muddcs!barry at ucla-cs
PHONE: At the moment --- (714) 621-8000 x8225
More information about the Comp.sources.unix
mailing list