home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
sperryunivac9060.tar.gz
/
sperryunivac9060.tar
/
sp9ker.src
next >
Wrap
Text File
|
1988-08-16
|
42KB
|
930 lines
**************************************************************
** MAIN ENTRY POINT - KERMIT ONLY RUNS AS A SERVER SINCE **
** THE SPERRY 90/60 CAN NOT INITIATE **
** USE OF AN RTIO LINE OTHER THAN THE **
** TERMINAL LINE ITSELF **
** MCC TABLES AND TRANSLATION MODULES MODIFIED IN SYSTEM **
** THIS IS NECESSARY TO INSURE THAT ALL THE CHARACTERS **
** IN THE PRINTABLE ASCII RANGE AND THE ^A HAVE VALUES **
** WITHIN THE EBCDIC REPRESENTATION (SEE ATOE TABLE) **
**************************************************************
SERVER CSECT
STM 14,12,12(13) SAVE CALLER REGISTERS
BALR 12,0 SET UP A BASE REGISTER
USING *,12
ST 13,SAVE+4 SAVE MY CALLERS SAVE AREA ADR
LA 13,SAVE SET UP MY SAVE AREA TO CALL
SETBF 200,N
WAIT LA 1,=A(PKNAK,REC) SET UP PARAMATER LIST
ERRSEN L 15,=V(PACKETIO) GET READY TO GO
BALR 14,15 GO DO A TRANSFER
LA 1,=A(REC) ADDRESS OF PACKET RECIEVED
LA 14,CHCK RETURN ADDRESS FOR FOLLOWING
CHCK CLI RECTYP,C'S' IS IT A SEND INIT PACKET
BNE SKIPSEND CHECK NEXT PACKET TYPE
L 15,=V(RECFILE) REMOTE IS SENDING US A FILE
BR 15 GO TAKE FILE FROM REMOTE TO DISK
SKIPSEND CLI RECTYP,C'R' IS IT A RECIEVE INIT PACKET
BNE SKIPREC NO GO TO CHECK OTHER TYPES
L 15,=V(SENFILE) ROUTINE TO SEND FILE TO REMOTE
BR 15 AND OFF WE GO
SKIPREC CLI RECTYP,C'I' CHECK FOR AN INIT PACKET
BNE SKIPINIT
L 15,=V(KRMTINI) ADDRESS OF INIT HANDLER
BR 15
SKIPINIT CLI RECTYP,C'G'
BNE SKIPGEN
CLI RECDAT,C'L' IS THIS A LOGOUT
BNE SKIPGEN
LA 1,=A(PKYAK,0)
L 15,=V(PACKETIO)
BALR 14,15 ACK THE LOGOFF COMMAND
CMAND '/LOGOFF'
SKIPGEN CLI RECTYP,C'Y' IS THIS AN EXTRA ACK
BE WAIT YES SEND A NAK AND WAIT
CLI RECTYP,C'E'
BE WAIT
LA 1,=A(PKERR,REC)
B ERRSEN
PKERR DS 0F
PKELEN DC X'1B'
PKESEQ DC X'00'
PKETYP DC C'E'
PKEDAT DC C'FUNCTION NOT IMPLEMENTED'
PKNAK DS 0F
DC X'03' LENGTH OF NAK PACKET TO SEND
DC X'00' SEQUENCE NUMBER
DC C'N'
PKYAK DC X'03' PACKET LENGTH
DC X'00' PACKET NUMBER
DC C'Y' PACKET DATA
REC DS 0F
RECLEN DS XL1
RECSEQ DS XL1
RECTYP DS XL1
RECDAT DS CL150
SAVE DS 18F
END
KRMTINI CSECT
STM 14,12,12(13) SAVE CALLER REGISTERS
BALR 12,0 SET UP MY BASE REGISTER
USING *,12
ST 13,SAVE+4 SAVE CALLERS SAVE ADDRESS LOCAL
LA 13,SAVE SET UP A SAVE AREA FOR OTHER CALLS
***************************************************************
**KERMIT INIT PACKER HANDLER **
** ARGUMENTS (1) - 1 ADDRESS OF PACKET **
** RECIEVED INIT PACKET ON INPUT **
** NEXT PACKET ON RETURN **
** EXTERNAL REFF POINT - (KRMTPARM) START OF KERMIT
** PARAM LIST **
***************************************************************
L 2,0(1) ADDRESS OF PACKET
IC 3,0(2) LENGTH OF PACKET
MVI PARMPKT,C' ' BLANK OUT THE LOCAL PACKET
MVC PARMPKT+1(152),PARMPKT
BCTR 3,0 DECREMENT FOR AN EX MOVE
EX 3,MOVEPKT MOVE IT TO PARMPKT
MVI CALLTYP,C' ' NORMAL CALL
CLI PARMTYP,C'R' IS THIS AN INIT REMOTE RECIEVE
BE WESTART IF SO WE START THE INIT
SETMAXL SR 11,11 CLEAR A REGISTER
IC 11,PARMDAT GET MAX LENGTH
L 3,=V(ETOA) NEED PACKETIO TRANS TABLE
IC 11,0(11,3) CHANGE CHARACTER TO ASCII
SH 11,=H'32' LOWER FROM PRINTABLE RANGE
STC 11,PARMMAXL STORE AMOUNT IN PARM TABLE
SETTIME SR 11,11
IC 11,=X'10' SET TIME TO WAIT TO 16 SECONDS
AH 11,=H'32' SET UP IN PRINTABLE RANGE
L 4,=V(ATOE) TRANS FROM PACKETIO TO EBCDIC
IC 11,0(11,4) CHANGE TIME TO EBCDIC
STC 11,PARMDAT+1 PUT IN PACKET TO SEND
SETPAD SR 11,11
IC 11,PARMDAT+2 GET NUMBER OF PADDING CHARS
IC 11,0(11,3) CONVERT IT TO ASCII BITS
SH 11,=H'32' ADJUST DOWN FROM PRINTABLE
STC 11,PARMNPAD STORE IN MY PARM LIST
LH 11,=H'0' PUT SOME FILL CHARS IN
AH 11,=H'32' GET UP TO PRINTABLE RANGE
IC 11,0(11,4) TRANSLATE TO EBCDIC
STC 11,PARMDAT+2 PUT IN PACKET TO SEND
SETPADC SR 11,11
IC 11,PARMDAT+3 GET CHARACTER THEY ASKED FOR
IC 11,0(11,3) TRANSLATE TO ASCII
X 11,XORWRD USE CTL FUNCTION TO MOVE DOWN
IC 11,0(11,4) TRANSLATE BACK TO EBCDIC
STC 11,PARMPADC PUT IN PARM LIST
SR 11,11
X 11,XORWRD USE CTL FUNCTION TO MOVE UP
IC 11,0(11,4) SET TO EBCDIC CHAR
STC 11,PARMDAT+3 TELL HIM I WANT NULLS(WHO CARES)
SETEOL SR 11,11
IC 11,PARMDAT+4 GET EOL CHAR THEY WANT TO SEND
IC 11,0(11,3) TRANSLATE TO ASCII
SH 11,=H'32'
IC 11,0(11,4) TRANSLATE BACK TO EBCDIC
STC 11,PARMEOL PUT IN PARM LIST
IC 11,=X'15' PUT IN MY <NL> CHARACTER
IC 11,0(11,3) TRANSLATE TO ASCII
AH 11,=H'32' SET UP TO PRINTABLE
IC 11,0(11,4) TRANSLATE BACK TO EBCDIC
STC 11,PARMDAT+4
SETQCTL IC 11,PARMDAT+5 GET QUOTE CHARACTER FOR CTL
STC 11,PARMQCTL GOOD FOR ME TOO
SETQBIN MVI PARMDAT+6,C'N' WE DONT DO 8 BIT QUOTING
MVI PARMDAT+7,C'1' WE ONLY DO 1 BYTE CHECKSUMS
SEQREPT IC 11,PARMDAT+8 GET A REPT QUOTE CHARACTER
STC 11,PARMREPT GOOD ENOUGH FOR M
MVI PARMDAT+9,X'00' WE HAVE NO EXTENSIONS
MVI PARMTYP,C'Y' CHANGE PACKET TO AN ACK
CLI CALLTYP,C'R' IS THIS INIT CAUSED BY A R PACKET
BE ENDCALL WE ALREADY SENT OUT INIT PARAMS
LA 1,ARGLIST
L 15,=V(PACKETIO) CALL PACKET I/O FOR MESS SWAP
BALR 14,15
ENDCALL L 11,=V(PIOINIT) GET PARAM LOCATION IN PACKETIO
MVC 0(3,11),PARMNPAD MOVE NPAD, PADC, AND EOL CHARS
GOBACK SR 11,11 CLEAR IT
IC 11,PARMLEN GET THE LENGTH
BCTR 11,0 DECREMENT BY 1 FOR EX MOVE
EX 11,MOVEBK MOVE IT BACK TO CALLER
RETURN L 13,SAVE+4
LM 14,12,12(13)
SR 15,15
BR 14
WESTART LA 1,=A(PKINIT,PARMPKT)
L 15,=V(PACKETIO) SEND BASIC INIT START
BALR 14,15
CLI PARMTYP,C'E'
BE GOBACK
CLI PARMTYP,C'I'
BE ISOK
CLI PARMTYP,C'Y'
BE ISOK
B GOBACK
ISOK MVI CALLTYP,C'R' THIS IS AN R PACKET INIT
B SETMAXL GO UP AND GET PARAM
ARGLIST DC A(PARMPKT)
DC A(PARMPKT)
XORWRD DC F'64'
MOVEPKT MVC PARMPKT(1),0(2)
MOVEBK MVC 0(1,2),PARMPKT
CALLTYP DS CL1
SAVE DS 18F
PARMPKT DS 0F
PARMLEN DS XL1
PARMSEQ DS XL1
PARMTYP DS XL1
PARMDAT DS CL150
ENTRY KRMTPARM
KRMTPARM EQU *
PARMMAXL DS XL1
PARMTIME DS XL1
PARMNPAD DS XL1
PARMPADC DS CL1
PARMEOL DS CL1
PARMQCTL DS CL1
PARMQBIN DS CL1
PARMCHKT DS CL1
PARMREPT DS CL1
PARMCAPS DS X'00'
PKINIT DS 0F
PKILEN DC X'0C'
PKISEQ DC X'00'
PKITYP DC C'S'
PKIMAXL DC X'FF'
PKITIM DC C'-'
PKINPAD DC C' '
PKIPADC DC C'@'
PKIEOL DC C'-'
PKIQCTL DC C'#'
PKIQBIN DC C'N'
PKICKTYP DC C'1'
PKIQREPT DC C'_'
END
KRMTUC CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
****************************************************
* ROUTINE TO CONVERT A 54 CHAR FIELD TO UPPER CS *
****************************************************
L 2,0(1) GET ADDRESS OF THE FIELD
LA 3,54 GET A COUNT IN REG 3
LOOPUC CLI 0(2),X'81' CHECK LOWER RANGE TO CHANGE
BL NOCHNG IF LOW NO CHANGE
CLI 0(2),X'A9' CHECK THE UPPER RANGE
BH NOCHNG IF HIGH NO CHANGE
OI 0(2),X'40' SET THE BIT FOR UPPER CASE
NOCHNG LA 2,1(2) INCREMENT 2 BY 1
CLI 0(2),X'40' IS IS A BLANK
BE RETURN IF SO NO MORE TO CHECK
BCT 3,LOOPUC GO CHECK NEXT CHAR
RETURN L 13,SAVE+4 GET THE SAVE AREA
LM 14,12,12(13) SET REGISTERS BACK
SR 15,15 ALL OK
BR 14 AND BACK WE GO
SAVE DS 18F
END
PACKETIO CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
**************************************************************
** KERMIT I/O HANDELER **
** USE: **
** CONVERTS A PACKET FROM SIMPLE INTERNAL FORMAT **
** TO KERMIT FORMAT AND SENDS IT **
** RECIEVES THE ANS PACKET AND CONVERTS IT TO SIMPLE **
** INTERNAL FORMAT **
** RETRANSMITS FOR I/O ERRORS UNTIL TRANSACTION FINISH **
** CALL FORMAT: **
** STANDARD LINKAGE USAGE **
** ARG #1 - ADDRESS OF PACKET TO SEND **
** ARG #2 - ADDRESS OF PACKET TO RECIEVE **
** INTERNAL PACKET FORMAT: **
** <LENGTH> BINARY LENGTH INCLUSIVE **
** <SEQ> PACKET SEQUENCE NUMBER IN BINARY **
** <TYPE> CHARACTER REPRESENTING PACKET TYPE **
** <DATA> VARIABLE LENGTH DATA FIELD **
** LENGTH OF FIELD = <LENGTH>-3 **
** PROCEDURE: **
** A) PREFIX PACKET WITH A ^A FOR START OF PACKET **
** B) PREFIX PACKET WITH LENGTH AND STUFF FOR A **
** UNIVAC V TYPE RECORD **
** C) CONVERT <LENGTH>&<SIZE> TO CHAR ADJUSTED FORM **
** D) CALCULATE A CHECK SUM BASED ON ASCII REP **
** F) SUFFIX PACKET WITH A CARRAGE RETURN **
** EBCDIC <NL> X'15' = ASCII <CR> X'0D' **
** G) SEND THE PACKET AND GET THE RETURN PACKET **
** H) CONVERT THE RETURN PACKET TO SIMPLE FORM **
** I) RETURN THE PACKET TO THE CALLER **
** ERRORS: **
** ALL ERRORS CAUSE THE ORIGINAL PACKET TO BE SENT **
** AGAIN. (THIS SHOULD BE OK; DUPE PACKETS ARE DROP)**
** ERRORS WHICH ARE INTERCEPTED ARE: **
** RTIO ERROR - UNIVAC BUFFER OVERRUN **
** CHECKSUM - ERROR ON CHECKSUM ON RETURNING PACK **
** NAK - PACKET SENT WAS NAK'ED BY REMOTE **
**************************************************************
SPACE
SPACE
**************************************************************
** BUILD THE PACKET TO GO OUT **
**************************************************************
L 3,0(1) GET ADDRESS PACKET TO SEND
L 4,4(1) GET ADDRESS OF PACKET
SR 5,5 CLEAR A REG FOR ERROR COUNT
SENDAGN SR 11,11 CLEAR OUT A TEMP REG
C 5,=F'50' CHECK FOR ERROR ABORT
BH TERMD LETS GET THAT DUMP
IC 11,0(3) GET THE LENGTH OF PACKET
EX 11,MOVEPK MOVE TO LOCAL(YES 1 EXTRA CHAR)
MVI SENDMRK,X'27' MOVE IN ^A FOR START OF PACKET
LA 11,8(11) GET LENGTH FOR V RECORD
STH 11,SENDVREC STORE IT IN BEGINNING OF BUFFER
MVC SENDFIL,=X'4040' BLANKS TO KEEP UNIVAC HAPPY
MVI SENDNUL,X'00' MOVE IN A NUL AT START OF LINE
SR 11,11 CLEAR IT AGAIN
IC 11,SENDLEN GET THE LENGTH AGAIN
STC 11,SAVELEN SAVE LENGTH FOR LATER USE
AH 11,=H'32' MOVE UP TO PRINTABLE
STC 11,SENDLEN PUT BACK IN PACKET
TR SENDLEN,ATOE TRANS TO EBCDIC FOR LATER ASCII
SR 11,11 CLEAR 11 FOR SAME TO SEQUENCE
IC 11,SENDSEQ GET THE SEQUENCE NUMBER
AH 11,=H'32' ADJUST UP TO PRINTABLE
STC 11,SENDSEQ PUT BACK IN PACKET RECORD
TR SENDSEQ,ATOE TRANS TO EBCDIC FOR LATER ASCII CVT
SR 11,11 CLEAR TEMP REGISTER AGAIN
IC 11,SAVELEN GET ORIGINAL BINARY LENGTH
EX 11,MOVETS MOVE PACKET TO TEMP STORAGE
EX 11,TRANTS TRANSLATE TEMPORARY TO ASCII
SR 10,10 CLEAR ANOTHER REGISTER FOR TEMP
SR 9,9 CLEAR A REGISTER FOR SUM
LR 8,11 POINT TO LAST CHAR (CHECKSUM)
LOOPCKSM IC 10,TEMPS-1(8) GET NEXT CHAR IN STRING
AR 9,10 ADD TO SUM
BCT 8,LOOPCKSM GO BACK FOR MORE CHARS
N 9,ZAPHIGH GET RID OF HIGH 3 BYTES
LR 8,9 COPY TO 8
SRL 8,6 SHIFT RIGHT 6 BITS TO LEAVE HIGH 2
AR 9,8 ADD IT TO THE SUM
N 9,ZAPBUT6 ZAP ALL BUT LAST 6 BITS
AH 9,=H'32' MOVE UP TO PRINTABLE RANGE
IC 9,ATOE(9) CONVERT TO EBCDIC
STC 9,SENDLEN(11) PUT AT END OF PACKET
IC 8,CARRET GET A CARRAGE RETURN/NEW LINE
STC 8,SENDLEN+1(11) PUT AFTER THE CHECK SUM
**************************************************************
** NOW THAT A PACKET IS READY TO GO WE WILL SEND IT TO **
** THE REMOTE DEVICE VIA TERMINAL LINE AND WAIT FOR THE **
** RETURN PACKET FROM THE REMOTE **
SR 11,11 CLEAR REG
IC 11,NPAD GET NUMBER OF PAD CHARS
LTR 11,11 SEE IF ZERO
BZ WTRD DO THE WRITE NOW
MVC TEMPS(1),PADC MOVE IN PAD CHARACTER
MVC TEMPS+1(150),TEMPS
AH 11,=H'5' ADD FOR RECLEN
STH 11,TEMPS PUT IN THE RECORD
MVC TEMPS+2(2),=C' ' PUT IN BLANKS KEEP UNI HAPPY
WROUT TEMPS,X'16' WRITE OUT THE NULLS (NO CR)
WTRD LTR 4,4 CHECK RETURN PACKET ADDR
BZ SENDONLY IF ZERO WE SEND AND RETURN
WRTRD SENDPK,X'16',TEMPS,X'16',150,RTIOERR
**************************************************************
** INPUT BUFFER (TEMPS) SHOULD HAVE A PACKET. FIRST WE MUST **
** FIND THE ^A TO START THE PACKET AND DROP TRASH **
**************************************************************
TRT TEMPS+4(L'TEMPS-4),TABCTLA
BZ RTIOERR ^A NOT FOUND
LA 11,TEMPS-1 ADDRESS OF START OF PACKET
LH 10,TEMPS LENGTH OF STRING (V REC)
LR 9,1 ADDRESS OF ^A
N 9,ZAPADDR
N 11,ZAPADDR GET RID OF FIRST BY ADDRESS CONST
SR 9,11 AMOUNT OF TRASH BEFORE ^A
AR 11,9 ADD LENGHT OF TRASH TO START
SR 10,9 GET LENGHTOF GOOD DATA
LR 8,10 SAVE LENGHT OF GOOD DATA(TEMP)
BCTR 10,0 DECREMENT BY 1 FOR EX TYPE MOVE
EX 10,MOVEGT MOVE IT TO THE "GET" PACKET
***************************************************************
** THE GOOD PART OF THE PACKET IS IN THE "GET" AREA **
** MUST BE CHECKED FOR CHECKSUM OR NAK **
***************************************************************
SR 11,11 CLEAR OUT A TEMP REG
IC 11,GETLEN GET THE EBCDIC LENGTH(NOT READY)
IC 11,ETOA(11) TRANSLATE CHAR TO ASCII
SH 11,=H'32' DOWN FROM PRINTABLE TO BINARY
BM RTIOERR THIS PACKET LENGTH IS BAD
SR 8,11 GET DIFF BETWEEN V LEN AND PACKET
C 8,=F'5' IS THE DIFF MORE THAN 5
BH RTIOERR
C 8,=F'-5' IS DIFF LESS THAN 5
BL RTIOERR
EX 11,MOVEGTP MOVE IT TO TEMP STORAGE
EX 11,TRANTS TRANSLATE IT TO ASCII
LR 10,11 POINT TO LAST CHAR
SR 9,9 CLEAR FOR SUM
SR 8,8 CLEAR FOR TEMP USE
LOOPCK IC 8,TEMPS-1(10) GET A CHARACTER
AR 9,8 ADD IT TO THE SUM
BCT 10,LOOPCK GO BACK FOR MORE CHARS?
N 9,ZAPHIGH CLEAR ALL BUT LAST BYTE
LR 10,9 COPY TO REG 10
SRL 10,6 MOVE HIGH 2 BITS OF BYTE TO LOW BITS
AR 9,10 ADD THOSE BITS TO THE SUM
N 9,ZAPBUT6 CLEAR ALL BUT LAST 6 BITS
AH 9,=H'32' ADD TO COMPAIR IN PRINTABLE RANGE
IC 10,TEMPS(11) GET THE CHECKSUM RECIEVED
CR 9,10 ARE THEY THE SAME
BNE RTIOERR IF NOT LETS TRY AGAIN
**************************************************************
** THIS LOOKS LIKE A GOOD PACKET. NEXT TO CHANGE THE BINARY **
** FIELDS FROM THEIR EBCDIC CHAR TRANSLATION **
**************************************************************
CLI GETTYP,C'N' IS THE PACKET A NAK
BE RTIOERR IF SO LETS TRY AGAIN
SR 11,11 CLEAR IT
IC 11,TEMPS+1 GET ASCII REP FOR SEQUENCE
SH 11,=H'32' MOVE IT DOWN
STC 11,GETSEQ PUT IT IN THE PACKET TO RETURN
IC 11,TEMPS GET THE ASCII REP FOR LENGTH
SH 11,=H'32' MOVE IT DOWN FROM PRINTABLE
STC 11,GETLEN PUT IN PACKET TO RETURN
BCTR 11,0 DECREMENT IT FOR THE MOVE
EX 11,MOVEBK MOVE IT BACK TO CALLER
RETURN LM 14,12,12(13) RESTORE CALLERS REGISTERS
SR 15,15 ALL IS OK
BR 14 AND BACK TO THE CALLER
RTIOERR LA 5,1(5) INCREMENT I/O ERROR COUNT
B SENDAGN GO BACK AND SEND AGAIN
SENDONLY WROUT SENDPK,X'16'
B RETURN AND BACK WE GO
TERMD TERMD
ENTRY ATOE,ETOA
ATOE DC X'00270303030303030303030303150303'
DC X'03030303030303030303030303030303'
DC X'405A7F7B5B6C507D4D5D5C4E6B604B61'
DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
DC X'D7D8D9E2E3E4E5E6E7E8E9B4BCB56A6D'
DC X'4A818283848586878889919293949596'
DC X'979899A2A3A4A5A6A7A8A9C04FD0FF07'
DC X'03030303030303030303030303030303'
DC X'03030303030303030303030303030303'
DC X'03030303030303030303030303030303'
DC X'03030303030303030303030303030303'
DC X'03030303030303030303030303030303'
DC X'03030303030303030303030303030303'
DC X'03030303030303030303030303030303'
DC X'03030303030303030303030303030303'
ETOA DC X'000303030303037F0303030303030303'
DC X'03030303030D03030303030303030303'
DC X'03030303030303010303030303030303'
DC X'03030303030303030303030303030303'
DC X'20030303030303030303602E3C282B7C'
DC X'2603030303030303030321242A293B03'
DC X'2D2F03030303030303035E2C255F3E3F'
DC X'030303030303030303033A2340273D22'
DC X'03616263646566676869030303030303'
DC X'026A6B6C6D6E6F707172030303030303'
DC X'0303737475767778797A030303030303'
DC X'030303035B5D0303030303035C030303'
DC X'7B414243444546474849030303030303'
DC X'7D4A4B4C4D4E4F505152030303030303'
DC X'0303535455565758595A030303030303'
DC X'3031323334353637383903030303037E'
TABCTLA DC 256X'00'
ORG TABCTLA+X'27'
CTRLA DC X'27'
ORG
SAVELEN DS CL1
ENTRY PIOINIT
PIOINIT EQU *
NPAD DS XL1
PADC DS CL1
CARRET DC X'15'
MOVETS MVC TEMPS(1),SENDLEN
MOVEGTP MVC TEMPS(1),GETLEN
TRANTS TR TEMPS(1),ETOA
MOVEPK MVC SENDLEN(1),0(3)
MOVEGT MVC GETLEN(1),1(11)
MOVEBK MVC 0(1,4),GETLEN
DS 0F
ZAPHIGH DC X'000000FF'
ZAPBUT6 DC X'0000003F'
ZAPADDR DC X'00FFFFFF'
LTORG
SENDPK DS 0F
SENDVREC DS H
SENDFIL DS XL2
SENDNUL DS XL1
SENDMRK DS CL1
SENDLEN DS CL1
SENDSEQ DS CL1
SENDTYP DS CL1
SENDDATA DS CL150
SAFE1 DS CL256
DS 0F
TEMPS DS CL150
SAFE2 DS CL256
GETPK DS 0F
GETLEN DS CL1
GETSEQ DS CL1
GETTYP DS CL1
GETDATA DS CL150
SAFE3 DS CL256
END
SENFILE CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
***********************************************************
** ROUTINE TO SEND A FILE **
***********************************************************
L 3,0(1) GET THE ADDRESS OF PACKET
SR 11,11 CLEAR IT
IC 11,0(3) GET THE LENGTH
BCTR 11,0 DECREMENT BY 1 FOR MVC
EX 11,MOVELCL MOVE THE PACKET TO LOCAL
MVI INFCB+X'2E',C' '
MVC INFCB+X'2F'(53),INFCB+X'2E'
SH 11,=H'3' SUBTRACT FOR LEN,SEQ,TYP
EX 11,MOVEFIL MOVE THE FILE NAME TO FCB
LA 1,=A(INFCB+X'2E')
L 15,=V(KRMTUC)
BALR 14,15
MVC FILECMD+12(54),INFCB+X'2E'
LA 1,=A(PACKET) SET UP PARM FOR SUB CALL
L 15,=V(KRMTINI) GET READY TO DO AN INIT
BALR 14,15 AND OFF WE GO
CLI PKTYP,C'E'
BE RETURN
CLI PKTYP,C'Y' IS IT AN ACK FOR INIT
BE ISOKACK YES WE CAN GO ON
B RETURN
ABORT TERMD
ISOKACK MVI PKTYP,C'F' START BUILDING A FILE PACKET
MVC PKDAT(54),FILECMD+12
LA 11,PKDAT+53 POINT TO THE END OF PACKET
LOOKEND CLI 0(11),C' ' IS THIS A BLANK CHAR
BNE HAVEEND
BCT 11,LOOKEND LOOK FOR THE END OF FILENAME
HAVEEND LA 10,PACKET GET START OF PACKET
SR 11,10 GET LENGTH IN 11
LA 11,1(11) INCREMENT TO MAKE INCLUSIVE
STC 11,PKLEN PUT IT IN THE LENGTH
BAL 14,INCSEQ
SR 10,10 CLEAR A TEMP REGISTER
SR 11,11 CLEAR A SECOND TEMP REGISTER
LA 1,ARGLIST SEND ARG LIST OF PACKET,PACKET
L 15,=V(PACKETIO)
BALR 14,15 SEND THE F PACKET
CLI PKTYP,C'Y' DID WE GET FILE ACK
BNE RETURN
PRINT NOGEN
FILECMD FILE DUMMYFILE
PRINT GEN
OPEN INFCB,INPUT OPEN THE INPUT FILE
L 11,=V(KRMTPARM)
SR 7,7
IC 7,0(11) GET MAX PACKET LENGTH
SH 7,=H'3' SUBTRACT LEN,TYP,SEQ
***************************************************************
** WE HAVE SENT AN INIT PACKET (SEE KRMTINI) **
** ALSO HAVE SENT AN F PACKET WITH THE FILE NAME IN IT **
** AND THE FILE SHOULD BE OPEN FOR INPUT AT THIS POINT **
***************************************************************
SR 11,11
SR 4,4 CLEAR A POINTER TO RECORD
SR 5,5 CLEAR A POINTER TO DATA
SR 9,9
GETREC GET INFCB,RECLEN GET A RECORD FROM THE FILE
LH 6,RECLEN GET LENGTH OF RECORD
SH 6,=H'4' SUBTRACT LENGTH OF V REC FORMAT
MOVECHR IC 11,RECORD(4) GET NEXT CHARACTER FROM RECORD
L 8,=V(ETOA) NEED ADDRESS OF TRANSLATION TABLE
IC 10,0(11,8) GET ASCII VALUE OF CHARACTER
EX 10,TESTBAD CHECK FOR A NON PRINTABLE CHAR
BNE NOZAP NOT CHANGED TO TILD
ZAPIT IC 11,=X'6D' MAKE THIS A TILD CHARACTER
NOZAP STC 11,TESTCHR PUT IT IN MEMORY
CLI TESTCHR,X'00' GET RID OF NULLS
BE ZAPIT
CLI TESTCHR,X'0D' IS IT A DEL CHARACTER
BE ZAPIT GET RID OF THAT ALSO
CLI TESTCHR,X'01' IS IT A CONTROL A
BE ZAPIT
CLI TESTCHR,X'FF'
BE ZAPIT
CLI TESTCHR,C'#' IS THIS A #
BNE NORMCH NO PROCESS NORMAL
STC 11,PKDAT(5) PUT IN FIRST #
LA 5,1(5) INCREMENT IN BUFFER
CR 5,7 WILL THERE BE ROOM FOR NEXT #
BL STORECH YES GO PUT IT IN
BCTR 5,0 TAKE OFF THE ONE WE PUT IN
BAL 2,WRITEPK WRITE THE SHORT PACKET
IC 11,=C'#' GET BACK THE #
STC 11,PKDAT(5) PUT ONE IN
LA 5,1(5) INCREMENT POINTER
B STORECH PUT IN THE SECOND ONE
NORMCH CLC TESTCHR,LASTCHR IS THIS THE SAME AS LAST
BE INCCNT IF SO INC THE REPT COUNT
SR 9,9 SET CHAR COUNT TO ZERO
MVC LASTCHR,TESTCHR MOVE THIS TO LAST
INCCNT LA 9,1(9) INCREMENT BY 1
CH 9,=H'4' HOW MANY DO WE HAVE
BL STORECH NOT ENOUGH
STC 11,PKDAT-1(5) PUT THE CHAR IN
IC 11,=X'FF' GET A TILD
STC 11,PKDAT-3(5) PUT TILD IN FOR QUOTE
L 8,=V(ATOE) TRANS TO EBCDIC CHAR
IC 11,32(8,9) GET ASCII VALUE OF AMT
STC 11,PKDAT-2(5)
CH 9,=H'94'
BL INCDPTR
MVI LASTCHR,X'FE'
B INCDPTR
STORECH STC 11,PKDAT(5) PUT THE CHARACTER IN OUTPUT
LA 5,1(5) INCREMENT DATA POINTER
INCDPTR LA 4,1(4) INCREMENT RECORD POINTER
CR 5,7 IS MORE ROOM IN PACKET
BL CHECKREC IF YES IS MORE DATA IN REC
SKIPWRT BAL 2,WRITEPK WRITE A PACKET
CHECKREC CR 4,6 IS MORE DATA IN CURRENT RECORD
BL MOVECHR PROCESS REST OF RECORD
SR 9,9 SET REPT COUNT TO ZERO
LR 11,5 GET LENGTH USED IN PACKET
LA 11,4(11) WILL THERE BE ROOM FOR QUOTED CHAR
CR 11,7
BNL SKIPWRT WE HAVE ROOM NO NEED TO WRITE
IC 11,=C'#' GET A PREFIX CHAR
STC 11,PKDAT(5) PUT IT IN THE RECORD
IC 11,=C'M' GET A 'M' FOR ^M
LA 5,1(5) INCREMENT BY 1
STC 11,PKDAT(5) PUT IT IN THE RECORD
IC 11,=C'#' QUOTE AGAIN
LA 5,1(5) GO TO NEXT POSITION
STC 11,PKDAT(5)
LA 5,1(5)
IC 11,=C'J'
STC 11,PKDAT(5)
LA 5,1(5) RECORD IS FINISHED
SR 4,4 CLEAR RECORD POINTER FOR NEXT
CR 5,7 DID WE FILL THE BUFFER
BL GETREC
BAL 2,WRITEPK GO TO LOCAL RTN TO WRITE PACKET
B GETREC GO GET ANOTHER RECORD
INCSEQ IC 11,PKSEQ
LA 11,1(11)
STC 11,PKSEQ
NI PKSEQ,63
BR 14
WRITEPK MVI PKTYP,C'D' SET PACKET TYPE TO DATA
SR 11,11
BAL 14,INCSEQ
LA 5,3(5) ADD FOR LEN,TYPE,SEQ
STC 5,PKLEN STORE IT IN THE LENGTH
LA 1,ARGLIST GET ADDRESS LIST FOR SUB CALL
L 15,=V(PACKETIO) GET ROUTINE TO WRITE PACKET
BALR 14,15 AND WRITE IT OUT
CLI PKTYP,C'Y' DID WE GET AN ACK
BNE ERRCLS NO ABORT THIS RUN
SR 5,5 THE NEW PACKET IS EMPTY
SR 9,9 REPT COUNT IS ZERO
BR 2 GO BACK TO CALLER
EOF LTR 5,5 WAS THERE DATA IN A PACKET
BZ WRITEZ NO CLOSE THE TRANSMISSION
BAL 2,WRITEPK WRITE LAST PACKET
WRITEZ MVI PKTYP,C'Z' END OF FILE PACKET
CLOSE INFCB REMEMBER TO CLOSE THE INPUT
SR 11,11
BAL 14,INCSEQ
MVI PKLEN,X'03' SET LENGTH TO 3
LA 1,ARGLIST GET READY TO CALL PACKETIO
L 15,=V(PACKETIO)
BALR 14,15 SEND THAT PACKET GET AN ACK
CLI PKTYP,C'E'
BE RETURN
CLI PKTYP,C'Y' WAS IT AN ACK
BNE RETURN LETS GET A DUMP
MVI PKTYP,C'B' BUILD A BREAK PACKET
BAL 14,INCSEQ
MVI PKLEN,X'03' SET THE LENGTH TO 3
L 15,=V(PACKETIO)
BALR 14,15
CLI PKTYP,C'E'
BE RETURN
CLI PKTYP,C'Y' THE BREAK SHOULD BE ACKED
BNE RETURN IF NOT ABORT AGAIN
RETURN SR 11,11
IC 11,PKLEN GET THE LENGTH
BCTR 11,0 DECREMENT BY 1
EX 11,MOVEBK MOVE THE PACKET BACK TO CALLER
L 13,SAVE+4 GET WHERE I PUT CALLERS REGISTERS
LM 14,12,12(13) RESTORE THOSE REGISTERS
SR 15,15 ALL OK
BR 14
NOFILE LA 1,=A(D33ERR,PACKET)
L 15,=V(PACKETIO)
BALR 14,15
B RETURN
ERRCLS CLOSE INFCB
B RETURN
SAVE DS 18F
D33ERR DC YL1(ED33-*)
D33PKN DC X'00'
D33PKT DC C'E'
D33PKD DC C'OPEN ERROR OCCURED ON FILE OPEN'
ED33 EQU *
ARGLIST DC A(PACKET)
DC A(PACKET)
PACKET DS 0F
PKLEN DS XL1
PKSEQ DS XL1
PKTYP DS CL1
PKDAT DS CL150
MOVELCL MVC PACKET(1),0(3) TARGET MOVE TO GO TO LOCAL STORAGE
MOVEBK MVC 0(1,3),PACKET TARGET MOVE TO GOT BACK TO CALLER
MOVEFIL MVC INFCB+X'2E'(1),PKDAT
TESTBAD CLI BADCHR,X'00'
BADCHR DC X'03'
TESTCHR DS CL1
LASTCHR DS CL1
PRINT NOGEN
DS 0D
INFCB FCB LINK=KRMOUT,FCBTYPE=SAM,RECFORM=V,EXIT=EXLST
EXLST EXLST COMMON=NOFILE,EOFADDR=EOF
UNIREC DS 0F
RECLEN DS H
REDFIL DS CL2
RECORD DS CL1000
END
RECFILE CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE SET UP MY SAVE AREA
***********************************************************
** ROUTINE TO RECIEVE A FILE FROM REMOTE KERMIT **
** FIRST WE MUST CHECK FOR AN S TYPE PACKET WHICH WOULD **
** REQUIRE WE ACK WITH INIT PARAMS USING KRMTINI ROUTINE **
***********************************************************
L 2,0(1) GET ADDRESS OF PACKET
IC 11,0(2) GET THE LENGTH OF THE PACKET
BCTR 11,0 DECREMENT BY 1 FOR MVC
EX 11,MOVELCL MOVE TO LOCAL STORAGE
CLI PKTYP,C'S' IS IT THE INIT PACKET
BNE SKIPINI IF NOT WE DONT NEED INIT
LA 1,=A(PACKET) SET UP AN ARG LIST FOR CALL
L 15,=V(KRMTINI) GET ADDRESS OF INIT ROUTINE
BALR 14,15 OFF WE GO FOR THE INIT
CLI PKTYP,C'E'
BE RETURN
************************************************************
** HAVING INIT THE CONNECTION IT IS TIME TO SET UP THE **
** FILE TO BE TRANSFERED **
************************************************************
SKIPINI CLI PKTYP,C'F' SHOULD BE A FILE NAME
BNE RETURN WE REALLY NEED A FILE NAME
L 11,=V(KRMTPARM) GET ADDRESS OF INIT PARAM
MVC CTLCHR,5(11) GET THE CONTROL QUOTE CHAR
MVC REPTCHR,8(11) GET THE REPT QUOTE CHAR
MVI FILEFCB+X'2E',C' '
MVC FILEFCB+X'2F'(53),FILEFCB+X'2E'
IC 11,PKLEN GET LENGTH OF PACKET
SH 11,=H'4' SUBTRACT LEN,SEQ,TYP,+1
EX 11,MOVENAME MOVE NAME IN CLEAN FIELD
LA 1,=A(FILEFCB+X'2E')
L 15,=V(KRMTUC)
BALR 14,15 CONVERT FILENAME TO UPPER CASE
MVC FILECMD+12(54),FILEFCB+X'2E'
FILECMD FILE DUMMYFILE
OPENFL OPEN FILEFCB,OUTPUT OPEN THE FILE
*************************************************************
** FILE IS OPEN AND WE ARE READY TO START THE TRANSFER **
** WE SHOULD BE PROCESSING 'D' PACKETS AT THIS TIME **
** P.S. SORRY ABOUT THE SLOPPY WAY OF REFF FILE NAME IN **
** UNIVAC FCB = FCB+X'2E' IT WASN'T WORTH THE COMPILE**
** TIME TO INCLUDE THE IDFCB AND COVER IT WITH A REG **
*************************************************************
MVC PKASEQ,PKSEQ
LA 1,=A(PKACK,PACKET)
L 15,=V(PACKETIO) ACK FILE NAME GET FIRST D
BALR 14,15
CLI PKTYP,C'D'
BNE ERRCLS
SR 10,10 CLEAR RECORD POINTER
SR 8,8 CLEAR TEMP REG
SR 9,9 START AT BEG OF DATA FIELD
SR 11,11 CLEAR REG FOR COUNT
IC 11,PKLEN PUT IN THE LENGTH
SH 11,=H'3' REMOVE LEN TYP AND SEQ FIELDS
LOOPCHR BAL 4,GETNEXT GET THE NEXT CHARACTER IN 8
EX 8,TESTCTL TEST FOR A CONTROL PREFIX
BE PROCCTL PROCESS A CONTROL CHAR
EX 8,TESTREPT TEST FOR REPT
BE PROCREPT PROCESS THE REPT CHAR
EX 8,TESTEND
BE PROCEND PROCESS AN END OF FILE
TAKECHR STC 8,RECORD(10) PUT IT IN THE RECORD
LA 10,1(10) INCREMENT RECORD POINTER
C 10,=F'2000' HAVE WE REACHED THE END OF REC
BE ENDFILE PRETEND WE HAD A LINE FEED
B LOOPCHR GO FOR MORE
PROCCTL BAL 4,GETNEXT GET NEXT CHARACTER
STC 8,TEMPCHR PUT IN MEMORY FOR CLI
CLI TEMPCHR,C'M' IS IT A CARRAGE RETURN ^M
BE LOOPCHR WE DONT NEED IT
CLI TEMPCHR,C'J' IS IT A LINE RETURN
BE ENDREC YES WRITE THE RECORD
CLI TEMPCHR,C'#' IS THIS A # SIGN QUOTED WITH A #
BE TAKECHR WELL WE WILL KEEP IT
IC 8,=X'FF' GIVE THEM A FLAG OF BAD CHAR
B TAKECHR PUT IT IN THE OUTPUT REC
ENDREC LTR 10,10 IS THERE ANY LENGTH TO REC
BNZ WRITEOK YES NO BLANK NEEDED
LA 10,1(10) ADD 1 TO LENGTH
IC 1,=C' '
STC 1,RECORD(10) PUT A BLANK IN THE RECORD
WRITEOK AH 10,=H'4' ADD FOR UNIVAC V REC
STH 10,RECLEN PUT IT IN THE LENGTH
MVC RECFIL,=C' ' PUT IN V FILL CHARS
PUT FILEFCB,RECLEN WRITE THE RECORD (USING MOVE MODE)
SR 10,10 CLEAR THE RECORD POINTER
B LOOPCHR GO PROCESS MORE CHARACTERS
PROCREPT BAL 4,GETNEXT GET THE NEXT CHAR(REPT COUNT)
L 5,=V(ETOA) NEED IT IN ASCII
IC 8,0(5,8) CHANGE IT
SH 8,=H'32' MOVE IT DOWN FROM PRINTABLE
LR 7,8 HOLD THAT COUNT
BAL 4,GETNEXT AND WHAT CHAR DO WE NEE
EX 8,TESTCTL IS THE REPT CHAR A CTL
BNE LOOPINS GOOD NO INSERT IT
BAL 4,GETNEXT WHAT IS THE UNCTL CHAR
STC 8,TEMPCHR PUT IN MEMORY
CLI TEMPCHR,C'J' IS IT A LINEFEED
BE WRITEBLK WRITE THIS AND BLANK LINES
CLI TEMPCHR,C'#' IS THIS A LOUSY # SIGN
BE LOOPINS WELL WE WILL KEEP IT
IC 8,=X'FF' CHANGE IT TO FLAG CHAR
LOOPINS STC 8,RECORD(10) PUT IT IN THE RECORD
LA 10,1(10) GO UP BY 1
BCT 7,LOOPINS KEEP DOING IT FOR COUNT IN 7
B LOOPCHR GO FOR MORE
WRITEBLK AH 10,=H'4' MAKE THE UNIVAC V RECORD LENGHT
STH 10,RECLEN PUT IN RECORD
MVC RECFIL,=C' ' AND BLANKS
PUT FILEFCB,RECLEN WRITE IT
BCT 7,LOOPBLK GO FOR MORE(REPT OF 1 LOOSER)
B LOOPCHR
LOOPBLK PUT FILEFCB,BLKREC WRITE A PREFORMATTED BLANK REC
BCT 7,LOOPBLK GO BACK FOR MORE
B LOOPCHR GO FOR MORE CHARS.
***********************************************************
** ROUTINE (GETNEXT) TO GET THE NEXT CHARACTER FROM INPUT**
** IF NECESSARY IT WILL ACK THE LAST PACKET AND GET NEXT**
***********************************************************
GETNEXT CR 9,11 ARE THERE MORE IN BUFFER
BL TAKENEXT YES GO GET THE NEXT CHAR
ACKPACK MVC PKASEQ,PKSEQ MOVE THE SEQ NUMBER TO ACK
LA 1,=A(PKACK,PACKET)
L 15,=V(PACKETIO) GO FOR ANOTHER PACKER
BALR 14,15
CLI PKTYP,C'E'
BE ERRCLS
SR 9,9 SET POINTER TO BEG OF PACKET
IC 11,PKLEN PUT LENGTH IN 11
SH 11,=H'3' DECREMENT FOR LEN,TYP,SEQ
TAKENEXT CLI PKTYP,C'D' IS THIS A DATA PACKET
BNE ENDFILE YES SEND A ^B TO END FILE
IC 8,PKDAT(9) GIVE HIM THE CHARACTER
LA 9,1(9) INCREMENT DATA POINTER
BR 4 GO BACK TO CALLER
ENDFILE IC 8,=X'02' GIVE HIM A ^B
BR 4 AND GO BACK
***********************************************************
** ROUTINE ON END OF FILE **
***********************************************************
PROCEND LTR 10,10 IS ANYTHING IN BUFFER
BZ SKIPWRT NOTHING TO WRITE
AH 10,=H'4' ADD FOR V TYPE REC
STH 10,RECLEN PUT IN THE RECORD
MVC RECFIL,=C' ' PUT IN BLANK FOR FILL
PUT FILEFCB,RECLEN AND WRITE IT TO THE FILE
SKIPWRT CLOSE FILEFCB CLOSE THE FILE
CLI PKTYP,C'Z' IS THIS A REAL END OF FILE
BNE RETURN DONT KNOW WHAT ELSE IT IS
MVC PKASEQ,PKSEQ ACK THE END OF FILE
LA 1,=A(PKACK,PACKET)
L 15,=V(PACKETIO) GET THE NEXT PACKET
BALR 14,15
CLI PKTYP,C'E'
BE RETURN
DONEXT CLI PKTYP,C'F' IS THIS A NEW FILE HEADER
BE SKIPINI START ANOTHER FILE
CLI PKTYP,C'B' IS THIS A BREAK IN TRANS
BNE RETURN
MVC PKASEQ,PKSEQ GET READY TO ACK BREAK
LA 1,=A(PKACK,PACKET)
L 15,=V(PACKETIO)
BALR 14,15
RETURN IC 11,PKLEN GET THE LENGTH OF PACKET
BCTR 11,0 DECREMENT BY 1
EX 11,MOVEBK MOVE IT BACK (REM REG 2)
L 13,SAVE+4 GET ADDRESS OF OUT REGS
LM 14,12,12(13) RESTORE THE REGISTERS
SR 15,15 ALL IS OK
BR 14 BACK WE GO TO CALLER
BADOPN LA 1,=A(BADPK,PACKET)
L 15,=V(PACKETIO)
BALR 14,15
B RETURN
ERRCLS CLOSE FILEFCB
B RETURN
ABORT TERMD
LTORG
SAVE DS 18F
TEMPCHR DS CL1
MOVEBK MVC 0(1,2),PACKET
TESTCTL CLI CTLCHR,X'00'
TESTREPT CLI REPTCHR,X'00'
TESTEND CLI ENDCHR,X'00'
MOVELCL MVC PACKET(0),0(2)
MOVENAME MVC FILEFCB+X'2E'(1),PKDAT
CTLCHR DC C'#'
REPTCHR DC C'_'
ENDCHR DC X'02'
BADPK DC YL1(ENDBAD-*)
DC X'00'
DC C'E'
DC C'OPEN FAILED FOR OUTPUT FILE'
ENDBAD EQU *
PACKET DS 0F
PKLEN DS XL1
PKSEQ DS XL1
PKTYP DS XL1
PKDAT DS CL150
PKACK DS 0F
PKALEN DC X'03'
PKASEQ DS XL1
PKATYP DC C'Y'
BLKREC DC H'5'
DC C' '
EXPRM EXLST COMMON=BADOPN,OPENER=BADOPN
FILEFCB FCB FCBTYPE=SAM,LINK=KRMFL,RECFORM=V,EXIT=EXPRM
RECLEN DS H
RECFIL DS CL2
RECORD DS CL2000
END