home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
ibm370.zip
/
ik0com.asm
< prev
next >
Wrap
Assembly Source File
|
1993-10-21
|
95KB
|
1,161 lines
*COPY IK0COM 01800000
CHECKVER IK0COM,4.3 @SC90072 01800500
TITLE 'COMMON - Kermit-370 common routines/data areas' 01801000
COMMON CSECT 01802000
* Translat - translates data. On entry R2->buffer, R3=length @SC86202 01803000
* R14 = return address, R15->translate table @SC86202 01804000
* R1-R3 are destroyed, R15 is set to 0 @SC86202 01805000
TRANSLAT LTR 3,3 Anything to do? @SC86202 01806000
BNP TRANSRET No, quit @SC86202 01807000
ALR 2,3 End of source @SC86202 01808000
TRLOOP LR 1,2 @SC86202 01809000
SR 1,3 Ptr to remaining bytes @SC86202 01810000
BCTR 3,0 Count for EX @SC86202 01811000
EX 3,TREX Translate the input segment @SC86202 01812000
N 3,=F'-256' Remove count done @SC86202 01813000
BNZ TRLOOP Loop thru source @SC86202 01814000
TRANSRET SR 15,15 Done, set RC=0 @SC86202 01815000
BR 14 @SC86202 01816000
TREX TR 0(,1),0(15) @SC86202 01817000
* 01817060
* Get TOD in R0; clobber R1,R15,TMPDW; return via R14 @SC91172 01817120
ACCTTOD STCK TMPDW Get time in timer units @SC91172 01817180
LM 0,1,TMPDW @SC91172 01817240
SRDL 0,12 Convert to microsec @SC91172 01817300
D 0,=F'4000000' 4-sec chunks + remainder @SC91172 01817360
LR 15,0 Save remainder @SC91172 01817420
SR 0,0 @SC91172 01817480
SLDL 0,2 Convert back to seconds @SC91172 01817540
SRL 15,20 Convert remainder also @SC91172 01817600
ALR 1,15 Add back in @SC91172 01817660
BC 12,*+8 @SC91172 01817720
AL 0,F1 @SC91172 01817780
D 0,=F'86400' Get time of day in seconds @SC91172 01817840
BR 14 @SC91172 01817900
* 01818000
* Subroutine to test for undelimited v-binary format @SC86151 01819000
RDWSET XC RDWLEN,RDWLEN Usual format @SC86151 01820000
LA 0,5 Header length of 5 for D-binary @SC86262 01821000
CLI TYPFIL,C'D' Is it? @SC86262 01822000
BE RDWSOK Yes, use it @SC86262 01823000
LA 0,2 Header length of 2 for V-binary @SC86262 01824000
CLI TYPFIL,C'V' Test for special type @SC86151 01825000
BNER 14 Not V-binary @SC86151 01826000
RDWSOK DS 0H @SC86262 01827000
ST 0,MAXOUT Init for decoding @SC86151 01828000
ST 0,RDWLEN @SC86151 01829000
BR 14 @SC86151 01830000
* @SC92030 01830100
* Test if line mode terminal type: return with skip if not @SC92030 01830200
TTYCHK CLI TRMTP,C'T' @SC92030 01830300
BER 14 No skip if TTY @SC92030 01830400
CLI TRMTP,C'F' @SC92030 01830500
BER 14 Go if full-screen non-transparent @SC92030 01830600
CLI TRMTP,C'V' @SC92030 01830700
BER 14 Go if VTAM TTY @SC92030 01830800
B 4(,14) @SC92030 01830900
* 01831000
* Subroutine to increment pkt sequence number 01832000
INCRSEQ IC 3,SEQ @SC86135 01833000
LA 3,1(3) 01834000
N 3,MOD64 01835000
STC 3,SEQ @SC86135 01836000
LA 3,1 @SC86295 01837000
AL 3,PAKCNT @SC86295 01838000
ST 3,PAKCNT Update packet count @SC86295 01839000
BR 14 01840000
* 01841000
* Subroutines to interpret RPACK data 01842000
INPUTSPK SR 3,3 Clear counter @SC86276 01843000
KCALL SPACK,E=INPUTRTY @SC86276 01844000
INPUT SR 3,3 Clear loop counter 01845000
INPUTLUP KCALL RPACK Read data 01846000
INPUTINR DS 0H @SC88074 01847000
IC 4,RTYPE Test byte @SC86158 01848000
TM FL3,ZPRO @SC88074 01848200
BO INPUTQRT Must stop pronto @SC88074 01848400
MVI ERRNUM,ERRIPT Assume bad packet type @SC88074 01848600
BAL 2,CLKP Look up in list @SC86158 01849000
* Standard packet types for special treatment @SC86158 01850000
INPUTST DC AL1(AE),AL3(INPUTERR) Error packet @SC86158 01851000
DC AL1(AN),AL3(INPUTNAK) NAK packet @SC86158 01852000
DC AL1(AQ),AL3(INPUTQAB) RPACK error @SC86158 01853000
DC AL1(AT),AL3(INPUTTIM) Time out @SC86355 01854000
DC AL1(00),AL3(INPUTCNT) OK so far @SC86158 01855000
* 01856000
INPUTCNT DS 0H @SC86158 01857000
CLC SEQ,RSN 01858000
BNE INPUTMIS Go if pkt num mismatch 01859000
INPUTQRT LR 2,8 Get next-state table address 01860000
LR 14,9 For in-line return @SC86295 01861000
B CLKP Look up in expected list @SC86158 01862000
* 01863000
INPUTMIS MVI ERRNUM,ERRMIS Missing pkt @SC86156 01864000
B INPUTRTY Retry 01865000
* 01866000
INPUTQAB MVC ERRNUM,RPKERN RPACK error: get code @SC89219 01867000
CLI STYPE,AB @SC88168 01867500
BNE INPUTRTY Retry if not a BRK pkt 01868000
INPUTACK MVI RTYPE,AY Fake an ACK @SC88092 01869000
IC 4,RTYPE @SC86158 01870000
B INPUTQRT And go handle the ACK 01871000
* 01872000
INPUTTIM MVI ERRNUM,ERRTIM Timed out @SC86355 01873000
B INPUTRTY @SC86355 01874000
INPUTNAK MVI ERRNUM,ERRNAK Micro NAK'ed @SC86156 01875000
IC 2,SEQ Expected packet number @SC88092 01875100
LA 2,1(2) @SC88092 01875200
N 2,MOD64 Get next number @SC88092 01875300
CLM 2,1,RSN Is that what we got? @SC88092 01875400
BE INPUTACK Yes, treat as an ACK @SC88092 01875500
INPUTRTY BAL 2,SENDRTY Resend to the limit @SC86276 01876000
B INPUTLUP And interpret response 01877000
* 01878000
INPUTERR CLI STYPE,AI Trying to send I packet? @SC89263 01879000
BE IPKSKP Ok, other Kermit too stupid @SC89263 01879300
MVI ERRNUM,ERRABO Micro aborted @SC89263 01879600
LR 2,9 Save return @SC86295 01880000
BAL 9,DECODEN Decode error message @SC86295 01881000
LR 9,2 @SC86295 01882000
L 0,WBUF Ptr to decoded message @BS86090 01883000
L 1,WBUFL @BS86090 01884000
L 14,EMSGP Ptr to msg buffer @BS86090 01885000
LA 15,LEMSG @BS86090 01886000
CR 1,15 @BS86090 01887000
BNH *+6 @BS86090 01888000
LR 1,15 Truncate msg @BS86090 01889000
ST 1,EMSGL Save effective length @BS86090 01890000
MVCL 14,0 Save in buffer @BS86090 01891000
L 1,EMSGP @BS86090 01892000
TR 0(LEMSG,1),ATOED Convert to EBCDIC @SC89301 01893000
INPUTABR SR 4,4 Look for end of table @SC86158 01894000
B INPUTQRT @SC86158 01895000
* 01896000
* CLKP - Subroutine to dispatch to routine from table lookup @SC86158 01897000
* R2->table, R4=char, R14->return if null entry in table @SC86158 01898000
* Each entry has AL1(char),AL3(adr), last char=00 @SC86158 01899000
CLKNXT LA 2,4(2) Next state @SC86158 01900000
CLKP CLM 4,1,0(2) Match? @SC86158 01901000
BE CLKF Yes, go do it @SC86158 01902000
CLI 0(2),0 01903000
BNE CLKNXT Not at the end yet @SC86158 01904000
CLKF ICM 2,7,1(2) Pick routine address @SC86158 01905000
BNZR 2 Go to that routine if any @SC86295 01906000
BR 14 Or fall down to caller @SC86158 01907000
* 01908000
* Retry sending same packet until success or abort @SC86276 01909000
SENDRTY LA 3,1(3) Increment retry counter @SC86276 01910000
CL 3,LIMTRY Did we retry enough? @SC86276 01911000
BNL INPUTABR Yes, abort if limit reached @SC86276 01912000
LA 15,1 @SC86276 01913000
AL 15,RTRCNT @SC86276 01914000
ST 15,RTRCNT Update retry count @SC86276 01915000
TM FL5,NAK0 @SC90037 01916000
BO SENDNAK Haven't sent anything yet @SC86276 01917000
KCALL SIO,E=SENDRTY Resend the same packet @SC86276 01918000
BR 2 Success, return @SC86276 01919000
* 01920000
* Subroutine to send a NAK 01921000
SENDNAK MVI STYPE,AN A NAK pkt 01922000
XC DATL,DATL no data 01923000
B SENDPK Send the packet @SC86276 01924000
* 01925000
* Subroutine to send an ACK 01926000
SENDACK XC DATL,DATL no data length 01927000
SENDACKL MVI STYPE,AY an ACK pkt 01928000
SR 3,3 Clear counter @SC86276 01929000
SENDPK KCALL SPACK,E=SENDRTY Send the packet @SC86276 01930000
BR 2 return 01931000
* 01932000
* Set up command to foreign server. Trade parms if necessary 01933000
IPKSET KCALL INTINI,4,E=INPUTABR Initialize for sending @SC87300 01934000
TM FL3,PXCH @SC86155 01935000
BO IPKFIN @SC86155 01936000
MVI SEQ,0 @SC86155 01937000
MVC LIMTRY,MAXTNT Limit for INIT retries @SC86345 01938000
KCALL RPARSET @SC86155 01939000
KCALL RPAR Our I packet to send @SC86155 01940000
ICM 8,8,STYPE Save packet type @SC86295 01941000
MVI STYPE,AI Packet type = initialize @SC86155 01942000
BAL 9,INPUTSPK Send RPAR and interpret response @SC86295 01943000
STCM 8,8,STYPE Restore packet type @SC86295 01944000
KCALL SPAR Interpret reply to our I packet @SC86155 01945000
IPKFIN MVI SEQ,0 Reset packet number @SC86155 01946000
MVC LIMTRY,MAXTRY Nominal retry limit @SC86295 01947000
B 12(8) Skip over 3-entry table @SC88074 01948000
IPKSKP XC DATL,DATL Pretend we got an empty ACK @SC89263 01948300
BR 9 ... and resume above @SC89263 01948600
* 01949000
* Subroutine to skip over white-space 01950000
WSP LM 6,7,LEN Length and address of input 01951000
LTR 6,6 Any more data left to scan? 01952000
BNPR 9 Nope, fail @SC86135 01953000
WSPLUP CLI 0(7),C' ' @SC86115 01954000
BE WSPNXT Skip a blank 01955000
CLI 0(7),NL 01956000
BNE WSPEND Skip a new-line char 01957000
WSPNXT LA 7,1(7) next char 01958000
BCT 6,WSPLUP decrement length 01959000
BR 9 01960000
* 01961000
WSPEND STM 6,7,LEN Save new non-white spot 01962000
B 4(9) Skip return 01963000
* 01964000
* Subroutine to get next token from commands 01965000
TOK LM 6,7,LEN Length and address of input 01966000
LTR 6,6 Any more data to tokenize? 01967000
BNPR 9 No, error return @SC86135 01968000
MVI BRK,C' ' Init break char @SC88306 01968500
* 01969000
TOKLUP CLI 0(7),C' ' @SC86115 01970000
BE TOKSKP Found a blank terminator 01971000
CLI 0(7),NL 01972000
BE TOKSKP Found a new-line terminator 01973000
CLI 0(7),C',' @SC86115 01974000
BNE TOKNXT Not a comma 01975000
C 7,ADR Is comma the first char? 01976000
BNE TOKSKP No, must be a token itself 01977000
TOKNXT LA 7,1(7) Next char 01978000
BCT 6,TOKLUP decrement remaining length 01979000
TOKSKP BCTR 6,0 remaining length of input 01980000
ST 6,LEN Save it for next time 01981000
LTR 6,6 Did we run off the end? @SC88306 01981200
BM *+10 Yes, nothing left @SC88306 01981400
MVC BRK,0(7) No, keep the break char for ref. @SC88306 01981600
LA 6,1(7) Next spot to scan @SC86224 01982000
S 7,ADR Length of token 01983000
ST 6,ADR Next spot to scan @SC86224 01984000
SR 6,7 @SC86224 01985000
BCTR 6,0 Address of token @SC86224 01986000
BCTR 7,0 Token length - 1 01987000
B 4(9) Skip return 01988000
* 01989000
* Subroutine to skip white-space and pick next token 01990000
WSPTOK BAL 9,WSP 01991000
B 0(14) Ran off the end @SC86135 01992000
BAL 9,TOK 01993000
B 0(14) No more tokens @SC86135 01994000
B 4(14) Skip return 01995000
* 01996000
* Interpret decimal number from string at (R6) of length=(R7) 01997000
* Clobber R4,R7,R15. Return value in R0 and skips if ok. 01998000
* If R15 changed, it points to first non-numeric character 01999000
GETNUM LTR 4,7 Copy length @SC86316 01999200
BNPR 14 Nothing, skip it @SC89218 01999400
C 4,F Length must be <16 @SC87012 02000000
BHR 14 @SC87012 02001000
BCTR 7,0 Change for EX @SC86316 02002000
LR 15,6 Don't lose pointer to input @SC86316 02003000
GETNUML CLI 0(15),C'0' @SC86316 02004000
BLR 14 Go if not numeric @SC86316 02005000
CLI 0(15),C'9' @SC86316 02006000
BHR 14 Go if not numeric @SC86316 02007000
LA 15,1(15) Bump input pointer @SC86316 02008000
BCT 4,GETNUML Go if more @SC86316 02009000
EX 7,GETNUMPK Pack the input @SC86316 02010000
CVB 0,TMPDW Convert to binary @SC86316 02011000
B 4(14) Return and skip @SC86316 02012000
GETNUMPK PACK TMPDW,0(,6) @SC86316 02013000
* 02014000
* Test for Ascii char range of 33-62 and 96-126, skip on return if ok 02015000
* Character must be in low byte of R4 02016000
CHKQR CLM 4,1,SPACE+3 @SC86120 02017000
BNHR 14 Cannot use control char or blank @SC86120 02018000
CLM 4,1,MOD64+3 @SC86120 02019000
BL 4(14) OK, 33-62 @SC86120 02020000
CLM 4,1,LOCASE+96 @SC86295 02021000
BLR 14 @SC86120 02022000
CLM 4,1,LOCASE+127 @SC86295 02023000
BNLR 14 @SC86120 02024000
B 4(14) OK, 96-126 @SC86120 02025000
* 02026000
* Subroutine to scan a parse table built by KW macro 02027000
* R6->word, R7=length-1, R1->table. Clobbers R14,R15 @SC90239 02027500
* hi byte of R7 is a flag for just lookup and return @SC91320 02027600
* 2nd byte of R7 is a code to look up (not word vs name) @SC91320 02027700
SCAN CLI 0(6),C'?' @SC86115 02028000
BE HELPKW 02029000
MVC OPRND,0(6) Copy token for lookup @SC87034 02030000
TR OPRND,UPCASE And convert to upper case @SC87034 02031000
SR 15,15 02032000
SCANLUP CLI KWLEN(1),254 @SC90239 02033000
BH 4(14) Return to caller if end @SC88168 02034000
BL *+12 Not a branch to new list @SC88168 02035000
ICM 1,7,KWADR(1) Yes, get ptr to new list @SC90239 02036000
B SCANLUP And resume search @SC87117 02037000
CLM 7,4,F0 @SC91320 02037600
BNE SCANCODE Signal for checking the codes @SC91320 02038200
CLM 7,1,KWMIN(1) Compare token length vs min abbr @SC90239 02039000
BL SCANNO Go if < min 02040000
CLM 7,1,KWLEN(1) Compare token and kw lengths @SC90239 02041000
BH SCANNO Go if length of token > kw's 02042000
EX 7,SCANCLC 02043000
BE SCANYES 02044000
SCANNO IC 15,KWLEN(,1) KW length - 1 @SC90239 02045000
LA 1,KWNAME+1(15,1) Space over name to next item @SC90239 02046000
B SCANLUP Continue checking 02047000
* 02048000
SCANCODE CLM 7,4,KWCODE(1) The right code? @SC91320 02048300
BNE SCANNO @SC91320 02048600
SCANYES CLM 7,8,F0 Flagged just to find entry? @SC86355 02049000
BNER 14 Yes, got it @SC86355 02050000
ICM 14,7,KWADR(1) No, get handler address @SC90239 02052000
BR 14 02053000
* 02054000
SCANCLC CLC KWNAME(,1),OPRND Compare token to KW @SC90239 02055000
* 02056000
* Utility routine to set up linkage 02057000
SUBENT LR KSUBBASE,15 CSECT addressibility @SC89268 02058000
KTRACE SUBENT @LM91008 02058200
L 15,STKPTR Current end of stack @SC86295 02059000
AR 0,15 Our needs @SC86295 02060000
C 0,STKLIM Does it fit? @SC86295 02061000
BH SUBDIE No, (that's incredible) @SC86295 02062000
ST 0,STKPTR New end @SC86295 02063000
CL 0,STKHI @SC89089 02063200
BNH *+8 @SC89089 02063400
ST 0,STKHI New high limit of stack usage @SC89089 02063600
ST 13,4(15) Link subroutines @SC86295 02064000
ST 15,8(13) @SC86295 02065000
LR 13,15 @SC86295 02066000
LR 1,0 End of local variables @SC87012 02067000
LA 0,72(15) Start=end of save area @SC87012 02068000
SR 1,0 @SC87012 02069000
BNP *+8 No locals @SC87012 02070000
SR 15,15 @SC87012 02071000
MVCL 0,14 Zero-fill all locals @SC87012 02072000
L 15,4(13) @SC87012 02073000
LM 0,1,20(15) Restore R0,R1 @SC87012 02074000
BR 14 Go @SC86295 02075000
SUBDIE LM 14,12,12(13) @SC86295 02076000
LA 15,1 @SC87012 02077000
LCR 15,15 Set return code = -1 @SC87012 02078000
BR 14 Go @SC86295 02079000
* 02080000
* Common exit code 02081000
RETSNRC MVI BCTU,1 Reset chksum at end of transfer @SC86295 02082000
MVC BCTOFF,F0 (and flag) @SC92085 02082200
ST 0,KAFUNC Save for KACCT call @AB89191 02082500
KCALL INTINI,0 Close line for transfer @SC86295 02083000
KCALL SUPFNC,10 Get time @SC86295 02084000
S 15,SECTOT Take elapsed time @SC86295 02085000
BNM *+8 Ok, no wrap @SC86345 02086000
A 15,=F'1759218604' Wraps by 2**44/10000 @SC86345 02087000
ST 15,CSECTOT Save elapsed time in csec @SC86345 02088000
SR 14,14 @SC86295 02089000
LA 0,100 @SC86295 02090000
DR 14,0 Convert to sec @SC86295 02091000
AR 14,14 Check remainder @SC86295 02092000
CR 14,0 @SC86295 02093000
BL *+8 @SC86295 02094000
A 15,F1 Round up @SC86295 02095000
ST 15,SECTOT @SC86295 02096000
ICM 15,15,KAEXIT R15 -> stats exit routine @AB89191 02096100
BZ RTRN0 0 ==> no exit supplied @AB89191 02096200
L 0,KAFUNC R0 = SEND/RECEIVE indicator @AB89191 02096300
LA 1,NSENTAC R1 -> file transfer statistics @AB89191 02096400
LA 2,TRMLIN R2 -> current LINE definition @AB89191 02096500
BALR 14,15 Call accounting exit @AB89191 02096600
B RTRN0 @SC86295 02097000
WXTRN KACCT @AB89191 02097200
KAEXIT DC AL4(KACCT) Accounting exit (if supplied) @AB89191 02097400
RTRNUM BAL 14,LDERR Fetch error code @SC87117 02098000
B RTRN @SC87117 02099000
RTRN2 LA 15,2 Indicate error @SC86295 02100000
B RTRN @SC86295 02101000
RTRNM1 SR 15,15 Error = -1 @SC86295 02102000
BCTR 15,0 @SC86295 02103000
B RTRN @SC86295 02104000
RTRN0 SR 15,15 No errors @SC86295 02105000
B RTRN @SC86295 02106000
SUBERR WTEXT (3),(4) Print prepared message @SC86295 02107000
RTRN1 LA 15,1 Indicate error @SC86295 02108000
RTRN ST 13,STKPTR Free the storage @SC86295 02109000
L 13,4(13) Unlink @SC86295 02110000
KTRACE EXIT @LM91008 02110200
L 14,12(13) Restore registers @SC86295 02111000
LM 0,12,20(13) @SC86295 02112000
LTR 15,15 Test return code @SC86295 02113000
BR 14 @SC86295 02114000
* 02115000
* Subroutine to fetch error code (but 0 if no transfers yet) 02116000
LDERR SR 15,15 02117000
CLI ERRNUM,ERRNFT No file transfer isn't an error @HF86157 02118000
BER 14 @HF86157 02119000
IC 15,ERRNUM Return status code @HF86157 02120000
BR 14 @HF86157 02121000
* 02122000
* Subroutine to decode without disk-write 02123000
DECODEN NI FL1,255-EOF No EOF yet 02124000
XC WBUFL,WBUFL No data in WBUF yet 02125000
MVI LCKOLD,0 Start at normal state @SC91275 02125300
MVI DECESCP,0 @SC91275 02125600
OI FL1,NAME No disk-writes 02126000
KCALL DECODE Decode data into WBUF @SC86135 02127000
NI FL1,255-NAME Turn this off 02128000
BR 9 @SC86295 02129000
* 02130000
* Subroutine to encode without disk-read 02131000
ENCODEN XC RBUFP,RBUFP Start encoding at beg of RBUF 02132000
MVI LCKOLD,0 Start at normal state @SC91275 02132500
OI FL1,NAME Indicate not to do disk reads 02133000
KCALL ENCODE Encode it into DATA @SC86135 02134000
NI FL1,255-NAME Turn this off 02135000
LTR 15,15 Did it work? @SC89072 02135300
BP INPUTABR No, something awful happened @SC89072 02135600
BR 9 @SC86295 02136000
* 02137000
* Subroutine to display the contents of the KW tables 02138000
* R1->table. Clobbers 1,2,3,4,7,15. Return via R14 @SC90239 02138500
HELPKW SR 7,7 token length holder 02139000
LA 2,16 Tab width for display @SC86295 02140000
LA 3,CMD+79 Display buffer limit offset @SC86295 02141000
LR 4,1 KW table address 02142000
WTEXT '&ONEFOLL' @SC92300 02143000
HELPNL LA 1,CMD+1 Display buffer offset @SC86295 02144000
MVI CMD,C' ' Start blanking it @SC86115 02145000
MVC CMD+1(79),CMD blank 80 chars 02146000
HELPNT CLI KWLEN(4),254 @SC90239 02147000
BH HELPEND Return if end of tokens @SC88168 02148000
BL *+12 Not branch to other list @SC88168 02149000
ICM 4,7,KWADR(4) Yes, get ptr to new list @SC90239 02150000
B HELPNT And resume scan @SC87117 02151000
IC 7,KWLEN(4) Length-1 of current token @SC90239 02152000
IC 15,KWMIN(,4) Min abbreviation length - 1 @SC90239 02154000
EX 7,HELPMVC move it to display buffer 02155000
LA 4,KWNAME+1(7,4) Skip to next token in KW table @SC90239 02156000
MVI 15(1),C' ' Move a blank separator @SC86115 02157000
TR 0(15,1),LOCASE Make everthing lower case @SC86295 02158000
EX 15,TRUPCAS Upper case the minimum @SC86295 02159000
BXLE 1,2,HELPNT Loop if more room on line @SC86295 02160000
WTEXT CMD,80 display one line of tokens 02161000
B HELPNL and continue with next line 02162000
* 02163000
HELPEND LA 0,CMD+1 @SC86295 02164000
CR 6,0 Is there anything accumulated? @SC86295 02165000
BER 14 No, display buffer empty @SC86135 02166000
WTEXT CMD,80 02167000
BR14 BR 14 02168000
* 02169000
HELPMVC MVC 0(,1),KWNAME(4) Copy KW @SC90239 02170000
* 02171000
* Subroutine to compress a file specification @HF86223 02172000
PAKFIL LA 1,PREFIX Start with prefix @HF86223 02173000
L 7,RBUF Put FN here for encode @SC86155 02174000
BAL 14,PAKFOR @SC86295 02175000
LA 0,FFENC @SC86295 02176000
KCALL FSPEC,FILNAM Copy name with possible override @SC86295 02177000
LR 7,15 New output ptr @SC86295 02178000
LA 1,SUFFIX Finish with suffix @SC86224 02179000
BAL 14,PAKFOR @SC86295 02180000
S 7,RBUF Length of buffer @SC86155 02181000
ST 7,RBUFL @SC86155 02182000
BR 9 @HF86223 02183000
* 02184000
* Subroutine to append characters to the filespec @HF86223 02185000
PAKFOR SR 2,2 Number of characters to append @HF86223 02186000
ICM 2,1,0(1) Probably none @HF86223 02187000
BZR 14 @SC86295 02188000
BCTR 2,0 Copy into buffer @HF86223 02189000
EX 2,PAKRMV @HF86223 02190000
EX 2,PAKRTR And ASCII it @HF86223 02191000
LA 7,1(2,7) New end of string @HF86223 02192000
BR 14 @SC86295 02193000
* 02194000
PAKRMV MVC 0(0,7),1(1) @HF86223 02195000
PAKRTR TR 0(0,7),ETOAD @SC89301 02196000
* 02197000
* Routines to add decimal and string arguments to a buffer @SC86209 02198000
* Input: R15->insert point, R4=dec. value, R2->return @SC86209 02199000
EDDEC CVD 4,TMPDW Get packed decimal @SC86209 02200000
MVC 0(10,15),=X'40202020202020202120' @SC86209 02201000
LA 9,10(15) End of possible string @SC86209 02202000
LA 1,9(15) Last possible start of signif. @SC86209 02203000
EDMK 0(10,15),TMPDW+3 @SC86209 02204000
LTR 4,4 Check sign @SC86209 02205000
BNM EDDPOS @SC86209 02206000
BCTR 1,0 Back up and insert minus @SC86209 02207000
MVI 0(1),C'-' @SC86209 02208000
EDDPOS LR 8,1 Start @SC86209 02209000
SR 9,8 Length @SC86209 02210000
* R8->argument string, R9=length @SC86209 02211000
EDCHAR EX 9,EDCHRMV Copy string to buffer (1 extra) @HF86223 02212000
AR 15,9 Update output ptr @SC86209 02213000
BR 2 @SC86295 02214000
EDCHRMV MVC 0(0,15),0(8) Copy string to buffer @HF86223 02215000
* 02216000
* Enter here with R7->position in CMD, R1->filespec. Return to (R2). 02217000
STAFSP LA 0,FFDSP @SC86295 02218000
KCALL FSPEC Copy name for display @SC86295 02219000
STAPM15 LR 0,15 Output ptr @BS86090 02220000
STAPMSG LA 1,CMD Start of string @SC86295 02221000
SR 0,1 Get length @SC86295 02222000
WTEXT (1),(0) @SC86295 02223000
BR 2 @SC86295 02224000
* 02225000
TRUPCAS TR 0(,1),UPCASE Upcase @SC86158 02227000
* 02228000
* Main command loop implementation of TAKE files 02271000
USING SERVERSV,13 Uses locals of caller, e.g. SERVER@SC86295 02272000
LOOPS STM 0,1,RETADR Initialize for main loop @SC86295 02273000
BR 14 @SC86295 02274000
* 02275000
LUPERK BCT 15,LUPBAD Go if bad operand: try on system @SC86171 02276000
MVI ERRNUM,ERRKCE Kermit command error 02277000
OI FL5,CMERR Note error @SC86295 02278000
B LOOP @SC86295 02279000
LOOP0 CLI ERRNUM,ERRKCE Stale error? @SC86295 02280000
BNE LOOP No, keep old error code @SC86295 02281000
MVI ERRNUM,ERRNOE Clear old error condition @SC86295 02282000
B LOOP @SC86295 02283000
LUPFNF MVI ERRNUM,ERRFNF File not found @SC86295 02284000
B LUPWRTE @SC86239 02285000
LUPINV MVI ERRNUM,ERRKCE Invalid command @SC86239 02286000
LUPWRTE OI FL5,CMERR Note error @SC86171 02287000
LUPWRT WTEXT (3),(4) @SC86355 02288000
* 02289000
LOOP MVC OLDERR,ERRNUM @SC86171 02290000
ICM 2,15,TAKLEV Get current TAKE level @SC86295 02291000
BZ LUPEX @SC86295 02292000
BCTR 2,0 @SC86295 02293000
SLA 2,2 Get offset into table @SC86295 02294000
LA 2,TAKTAB(2) Point into TAKE file table @SC86295 02295000
TM FL5,CMERR+TKHLT @SC86239 02296000
BO LUPREX Quit reading on error @SC86239 02297000
NI FL5,255-CMERR-TKMSG Clear error flag @SC86239 02298000
READF 0(2),NONUM,E=LUPRER @SC88101 02299000
LA 1,CMD Ptr to buffer, R0 = length @SC86171 02300000
LR 3,1 @SC88006 02300100
AR 3,0 Get end of buffer @SC88006 02300200
BCTR 3,0 @SC88006 02300300
CLI 0(3),C' ' Find last non-blank @SC88006 02300400
BE *-6 @SC88006 02300500
LA 0,1(3) One past end of buffer @SC88006 02300600
SR 0,1 Get trimmed length @SC88006 02300700
BNP LOOP Nothing there, ignore it @SC88006 02300800
B LUPPRS Go parse 02301000
* 02302000
LUPRER C 15,F12 EOF code? 02303000
BE LUPCLO Yes, close the file 02304000
ERRF , Analyze the error @SC87338 02305000
LUPREX OI FL5,CMERR Note error @SC86171 02306000
TM FL5,TKMSG Already issued message? @SC86239 02307000
BO LUPCLO Don't overdo it @SC86239 02308000
WTEXT '&ERRTAKE' @SC86239 02309000
OI FL5,TKMSG @SC86239 02310000
LUPCLO CLOSF (2) Close the file @SC86135 02311000
L 2,TAKLEV Get TAKE level 02312000
BCTR 2,0 And decrement it 02313000
ST 2,TAKLEV 02314000
B LOOP 02315000
* 02316000
LUPEX NI FL5,255-CMERR-TKMSG Clear error flag @SC86239 02317000
L 14,RETADR @SC86295 02318000
BR 14 02319000
* 02320000
LUPKRM TM FL5,KRMONLY Already seen KERMIT prefix? @SC90059 02320200
BO LUPBAD Yes, let's not clown around @SC90059 02320400
OI FL5,KRMONLY Override SYSCMD option for now @SC90059 02320600
B LUPTOK @SC90059 02320800
LUPPRS DS 0H @SC87034 02321000
STM 0,1,SCANPTR Save for parser @SC86171 02322000
NI FL5,255-KRMONLY Allow possibility of host cmd @SC90059 02322500
LTR 2,2 @SC86171 02323000
BZ LUPTOK Not from TAKE @SC86171 02324000
TM FL2,ECHO @SC86171 02325000
BNO LUPTOK Not echoing @SC86171 02326000
WTEXT (1),(0) Echo to terminal @SC86171 02327000
LUPTOK MVC SCANSV,SCANPTR Save for system @SC86295 02328000
NTOKN N=LOOP 02329000
CLI 0(6),C'*' @SC86115 02330000
BE LOOP Go if comment 02331000
L 1,CMDPTR @SC86295 02332000
SCAN (1),LOOP @SC86295 02333000
LUPBAD PTEXT '&KCMDERR' @SC92300 02334000
TM FL2,PASS @SC86295 02335000
BZ LUPINV Don't try as system cmd @SC86295 02336000
TM FL5,KRMONLY KERMIT prefix? @SC90059 02336300
BO LUPINV Yes, don't try as system cmd @SC90059 02336600
MVC SCANPTR,SCANSV Restore string ptrs @SC86295 02337000
OI FL4,UCMD @SC86295 02338000
KCALL SUPFNC,3,E=(LOOP,NM) And execute it @SC86295 02339000
B LUPINV @SC86295 02340000
* 02341000
LUPSET KCALL SET,E=LUPERK Call SET routine @SC86295 02342000
B LOOP0 @SC86295 02343000
* 02344000
LUPSHO KCALL SHOW,E=LUPERK Call SHOW routine @SC86295 02345000
B LOOP0 @SC86295 02346000
* 02346200
LUPVERS PTEXT 'Kermit-&KSYS Version &KVRSN..&KEDIT &KTAG (&KDATE.)' 02346400
B LUPWRT @SC90339 02346600
* 02347000
LUPCWD KCALL CWDSET,E=LUPERK @SC86295 02348000
B LOOP0 @SC86295 02349000
* 02350000
LUPHNTS KCALL HINTS @SC91295 02350200
B LOOP0 @SC91295 02350400
* 02350600
LUPGIV KCALL GIVTAB,E=LUPERK @SC87117 02351000
B LOOP0 @SC87117 02352000
* 02353000
LUPTAK BAL 9,LUPTINS Look for file @SC86295 02354000
B LUPFNF Not found @SC86295 02355000
MVI ERRNUM,ERRNOE No error @SC86295 02356000
B LOOP OK @SC86295 02357000
* 02358000
LUPTIN STM 1,2,SCANPTR Set up scan @SC86295 02359000
LUPTINS SR 0,0 Flags for TAKE parsing @SC86295 02360000
KCALL FSPEC,FILNAM Get filespec @SC86295 02361000
BAL 14,LUPCKFN @SC86295 02362000
LR 3,9 Save return @SC86295 02363000
BAL 14,LUPCNF Check for illegal extras @SC86295 02364000
LR 9,3 @SC86295 02365000
PTEXT '&MAXNEST' @SC92300 02366000
L 5,TAKLEV Current TAKE level @SC86295 02367000
LA 14,TAKMAX @SC86295 02368000
CR 5,14 @SC86295 02369000
BNL LUPINV @SC86239 02370000
SLA 5,2 Offset into table @SC86295 02371000
LA 5,TAKTAB(5) Point into table of TAKE files @SC86295 02372000
PTEXT '&NOTFOUN' In case of error @SC92300 02373000
MVI ERRNUM,ERRFNF In case of error @SC86171 02374000
OPENF I,FILNAM,TAKFDB,0(5),E=0(9) @SC86295 02375000
PTEXT '&TAKLOOP' @SC86239 02376000
USING FDBD,1 @SC86295 02377000
TM FDBFLGS,FDBACTV Check for file active already @SC86295 02378000
DROP 1 @HF86232 02379000
BZ LUPTIOK @SC86295 02380000
CLOSF (5) @SC86295 02381000
BR 9 @SC86295 02382000
LUPTIOK L 3,TAKLEV Get current take level 02383000
LA 3,1(3) And increment 02384000
ST 3,TAKLEV 02385000
B 4(9) @SC86295 02386000
* 02387000
LUPCKFN LTR 15,15 @SC86295 02388000
BZR 14 No problem, R15=0 @SC86295 02389000
BCT 15,LUPINV Error, R15>1 @SC86295 02390000
B LUPWRTE Help requested, R15=1 @SC86295 02391000
* 02392000
LUPSTA BAL 14,LUPCNF Check for illegal extras @SC86295 02393000
MVC ERRNUM(2),OLDERR Restore from last command @SC92210 02394000
KCALL STATUS Write error message @SC86156 02395000
B LOOP0 @SC86295 02396000
* 02397000
LUPSPA KCALL DSPACE @SC86164 02398000
B LOOP0 @SC86295 02399000
* 02400000
LUPDMP KCALL DUMP,E=LUPERK Dump translation table @SC86156 02401000
B LOOP0 @SC86295 02402000
* 02402200
LUPSIM KCALL SIMLAT,E=LUPERK Replay file as packet input @SC91312 02402400
B LOOP0 @SC91312 02402600
* 02403000
LUPHSTI DS 0H @SC86295 02404000
AIF ('&TYPCMD' EQ 'TYPE').TYPOK @SC86295 02405000
MVC 0(,6),=CL16'&TYPCMD' Use right name @SC86295 02406000
EX 7,*-6 @SC86295 02407000
.TYPOK A 7,LEN Add remaining to token length 02408000
LA 5,2(7) Plus one for separator @SC86171 02409000
STM 5,6,SCANPTR Reset for tokenizer @SC86171 02410000
LUPHST PTEXT '&SYSCMND' @SC86295 02411000
FTOKN H=LUPWRTE,N=LUPINV Point to command @SC86239 02412000
LA 1,3 Execute host command @SC86316 02413000
LUPSYS OI FL4,UCMD User command, check for EXEC's @SC86316 02414000
PTEXT '&BADSCMD' @SC86295 02415000
KCALL SUPFNC,E=(LUPWRTE,M) Execute it @SC86295 02416000
B LOOP 02417000
AIF ('&KSYS' NE 'CMS').CM1Z @SC86355 02418000
* 02419000
LUPCP PTEXT '&CPCMND' @SC92300 02420000
FTOKN N=LUPINV,H=LUPWRTE @SC86295 02421000
LR 0,7 @SC86295 02422000
LA 1,4 @SC86295 02423000
B LUPSYS @SC86295 02424000
.CM1Z ANOP 02425000
* 02426000
LUPCNF FTOKN N=0(14),H=LUPCRH @SC86295 02427000
PTEXT '&EXTRAOP' @SC86295 02428000
B LUPINV @SC86295 02429000
LUPCRH PTEXT '&NOOPERS' @SC90179 02430000
B LUPWRTE @SC86295 02431000
DROP 13 02432000
GRDATA DC &S1CMD,X'70' @SC90264 02434000
GRDL EQU *-GRDATA @SC87215 02435000
XLFCT DC A(KMAXF) Extended packet size base @SC86202 02436000
AKMIN DC A(KMIN) Packet min size @SC86295 02437000
AMAXRT DC A(MAXRT) Longest terminal read @SC86295 02439000
AMAXRS DC A(MAXRS) Longest fullscreen read @SC90277 02439500
F64KP DC A(((&MAXLR+7+5+4)/8)*8) Size of disk buffers @SC87351 02440000
F0 DC F'0' 02441000
F1 DC F'1' 02442000
F2 DC F'2' 02443000
F3 DC F'3' @SC86295 02444000
F4 DC F'4' @SC86295 02445000
F5 DC F'5' 02446000
F8 DC F'8' 02447000
F12 DC F'12' 02448000
F64 DC F'64' 02449000
BLANK EQU F64+3 EBCDIC blank @SC86295 02450000
F DC F'15' 02451000
MOD64 DC F'63' 02452000
F256 DC F'256' 02453000
FLFID1 DC A(ACTLEN) Length of items in filespec table @SC91172 02453500
SPACE DC A(ABL) ASCII SPACE 02454000
LOBIT DC X'0000007F' 02462000
* Parameter defaults. Must map directly into DEFPARM etc. 02463000
KSYSTF , @SC86295 02464000
DS 0F --------Init for LOG file @SC86295 02465000
DC A(0) Buffer ptr @SC86295 02466000
DC A(LPKT) Buffer length @SC86295 02467000
FDBPAT ,V,LPKT Default disk RECFM, etc. @SC88120 02468000
DS 0F --------Init for SEND/RECEIVE file @SC86295 02471000
DC A(0) Addr of FSWRITE buffer @SC86295 02472000
DC F'&MAXLR' Buffer length @SC89215 02473000
FDBPAT ,V,80 Default disk RECFM, etc. @SC88120 02474000
DS 0F --------Init for TAKE file (read-only) @SC86295 02477000
DC A(0) Buffer ptr (CMD) @SC86295 02478000
DC F'256' Max buffer size @SC86295 02479000
FDBPAT ,V Default disk RECFM (no LRECL) @SC88120 02480000
* 02481000
IMAXTNT DC F'16' Retry limit during setup @SC86345 02482000
IMAXTRY DC F'5' Retry limit during transfer @SC86164 02483000
ILCLDLY DC F'10' Time to wait before sending @SC86164 02484000
IBAUD DC F'1200' Assumed baud rate @SC88325 02484500
IRPSIZ DC A(KMAX) Max receive size @SC86295 02485000
ISPSIZ DC A(KDEF) Max send size @SC86295 02487000
IMAXOUT DC F'&MAXLR' Max output buffer @SC86268 02488000
* Send mode Rpack interpret input table @SC89263 02488100
ISNDST DC AL1(AY),AL3(0) Micro ACK'd @SC89263 02488200
DC XL1'FF',AL3(SNDABR) Stop @SC89263 02488300
DC AL1(AN),AL3(INPUTMIS) Repeated trigger packet @SC89263 02488400
DC AL1(00),AL3(SNDABR) Error routine @SC89263 02488500
ITRMLIN DC CL8' ' Current data line @SC87166 02489000
IATFLG DC 9X'FF' Attribute-honoring flags @SC91109 02489500
ITYPFIL DC C'T' Type of file (T,B,V,D),see BINF @SC86151 02490000
ICLSNFL DC C'O' Collision default is OVERWRITE @SC90033 02490200
ITRNCFL DC C'T' Truncate by default (vs. F or H) @SC88120 02490500
IDEFPRM DC AL1(KDEF+ABL,ABL,ABL,64,CR+ABL,A#,AN,A1,ABL,ABL) SC86149 02491000
DC AL1(ABL,ABL,ABL,ABL) Extended size defaults @TB86196 02492000
DC X'0' Capabilities of micro RCAPA @SC86295 02493000
DC X'28' Capabilities I have SCAPA @SC91275 02494000
LONGP EQU X'02' LONGP bit in CAPAS flags @TB86196 02495000
MORCAPAS EQU X'01' More CAPAS bytes exist @TB86196 02496000
DC AL1(CR) EOL char I need (cr) REOL @SC86295 02497000
DC AL1(CR) EOL I'll send SEOL @SC86295 02498000
DC AL1(SOH) Incoming pkt start char RMARK @SC86295 02499000
DC AL1(SOH) Outbound pkt start char SMARK @SC86295 02500000
DC AL1(A#) Micro's ctl-quote char RCTLQ @SC86295 02501000
DC AL1(A#) Ctl-quote char we'll use SCTLQ @SC86295 02502000
DC AL1(AAMP) Orig 8-bit quote char EBQC @SC86295 02503000
DC AL1(5) Time limit - micro to wait RTIMO @SC86295 02504000
DC AL1(0) Timeout, if we can do it TIMOUT @SC86295 02505000
DC AL1(120) Timeout, if we can do it TIMOSRV@SC90045 02505100
DC AL1(0) Recieve parity is MARK RPRTY @SC88288 02505300
DC AL1(DAT8) Send parity is NONE SPRTY @SC88288 02505600
DC C'1' User requested chk type BCTC @SC92085 02506000
DC AL1(ATIL) Original repeat prefix RPTQC @SC86295 02507000
DC &AEACMD,AL2(8),X'0F02' D/O strct fld AEADAT @SC90173 02508000
DC X'0',X'00',AL2(1) D/O id is 1 AEAFLG @SC90173 02508300
DC AL2(7+2),X'0F1F',X'00C000' Not spanned AEABUFL@SC90173 02508600
DC &S1CMD,AL1(SBA),X'5D7F',AL1(SBA),X'0005' S1DATA @SC90264 02509000
COMMON CSECT Resume addressible constants @SC89215 02511200
MAXLRC DC F'&MAXLR' Max lrecl @SC89215 02511400
AKMAX DC A(KMAX) Normal packet maximum @SC89215 02511600
MAXBSZ DC F'&MAXBS' Max blksiz @SC86268 02512000
BUFSIZ DC Y(LPKT) Length of packet buffers @SC86190 02513000
* 02514000
IS1EOL DC AL1(CR) In case micro lost one S1EOL @SC90173 02514300
DC AL1(XON) Handshake for micro S1HND @SC90173 02514600
* Constants for COMMON 02515000
LTORG 02516000
* Translation for conversion to hex notation @SC86156 02517000
TRHEX EQU *-240 @SC86156 02518000
DC C'0123456789ABCDEF' @SC86156 02519000
* ASCII to EBCDIC translate table 02520000
ATOED HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C89268 02521000
HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C89268 02522000
HTBL 40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C89268 02523000
HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C89268 02524000
HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C89268 02525000
HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D 5 C89268 02526000
HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C89268 02527000
HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C89268 02528000
HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 8 C89268 02529000
HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 9 C89268 02530000
HTBL 40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 A C89268 02531000
HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F B C89268 02532000
HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 C C89268 02533000
HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D D C89268 02534000
HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 E C89268 02535000
HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 F C89268 02536000
* EBCDIC to ASCII translate table 02537000
ETOAD HTBL 00,01,02,03,00,09,00,7F,00,00,00,0B,0C,0D,0E,0F 0 C89268 02538000
HTBL 10,11,12,13,00,00,08,00,18,19,00,00,1C,1D,1E,1F 1 C89268 02539000
HTBL 00,00,00,00,00,0A,17,1B,00,00,00,00,00,05,06,07 2 C89268 02540000
HTBL 00,00,16,00,00,00,00,04,00,00,00,00,14,15,00,1A 3 C89268 02541000
HTBL 20,00,00,00,00,00,00,00,00,00,5C,2E,3C,28,2B,7C 4 C89268 02542000
HTBL 26,00,00,00,00,00,00,00,00,00,21,24,2A,29,3B,5E 5 C89268 02543000
HTBL 2D,2F,00,00,00,00,00,00,00,00,7C,2C,25,5F,3E,3F 6 C89268 02544000
HTBL 00,00,00,00,00,00,00,00,00,60,3A,23,40,27,3D,22 7 C89268 02545000
HTBL 00,61,62,63,64,65,66,67,68,69,00,7B,00,00,00,00 8 C89268 02546000
HTBL 00,6A,6B,6C,6D,6E,6F,70,71,72,00,7D,00,00,00,00 9 C89268 02547000
HTBL 00,7E,73,74,75,76,77,78,79,7A,00,00,00,5B,00,00 A C89268 02548000
HTBL 00,00,00,00,00,00,00,00,00,00,00,00,00,5D,00,00 B C89268 02549000
HTBL 7B,41,42,43,44,45,46,47,48,49,00,00,00,00,00,00 C C89268 02550000
HTBL 7D,4A,4B,4C,4D,4E,4F,50,51,52,00,00,00,00,00,00 D C89268 02551000
HTBL 5C,00,53,54,55,56,57,58,59,5A,00,00,00,00,00,00 E C89268 02552000
HTBL 30,31,32,33,34,35,36,37,38,39,7C,00,00,00,00,00 F C89268 02553000
* Table to remove 8th bit (overlaps LOCASE following) @SC87253 02554000
OFF80 DC 128AL1(*-OFF80) @SC87253 02555000
* Table to convert EBCDIC text to lower case 02556000
LOCASE DC 256AL1(*-LOCASE) @SC91316 02557000
LOCASE TBLFIX ABCDEFGHIJKLMNOPQRSTUVWXYZ, @SC91316.02558000
abcdefghijklmnopqrstuvwxyz @SC91316 02559000
* Table to convert EBCDIC text to upper case @SC89215 02561100
UPCASE DC 256AL1(*-UPCASE) @SC91316 02561200
UPCASE TBLFIX abcdefghijklmnopqrstuvwxyz, @SC91316.02561300
ABCDEFGHIJKLMNOPQRSTUVWXYZ @SC91316 02561400
ETCETERA CSECT @SC90278 02561620
* A-to-E table based on Hollerith cards @SC90278 02561640
ATOEKP HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90278 02561660
HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90278 02561680
HTBL 40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90278 02561700
HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90278 02561720
HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90278 02561740
HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90278 02561760
HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90278 02561780
HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90278 02561800
HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90278 02561820
HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,E1 9 C90278 02561840
HTBL 41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 A C90278 02561860
HTBL 58,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75 B C90278 02561880
HTBL 76,77,78,80,8A,8B,8C,8D,8E,8F,90,9A,9B,9C,9D,9E C C90278 02561900
HTBL 9F,A0,AA,AB,AC,AD,AE,AF,B0,B1,B2,B3,B4,B5,B6,B7 D C90278 02561920
HTBL B8,B9,BA,BB,BC,BD,BE,BF,CA,CB,CC,CD,CE,CF,DA,DB E C90278 02561940
HTBL DC,DD,DE,DF,EA,EB,EC,ED,EE,EF,FA,FB,FC,FD,FE,FF F C90278 02561960
TITLE 'Variable storage for Kermit-370' 02562000
&STORDS DSECT , @SC89268 02563000
STORAG EQU * @SC89268 02563500
KTRACE STORAG @LM91008 02563600
* - - - Translate tables (user-settable or program-modified) 02564000
TRTBL DS CL256 For finding blanks @SC86295 02565000
ATOE DS CL256 For converting to EBCDIC @SC86295 02566000
ETOA DS CL256 For converting to ASCII @SC86295 02567000
TATOE DS CL256 For converting packets to EBCDIC @SC87117 02568000
TETOA DS CL256 For retrieving input ASCII @SC87117 02569000
* - - - Variables initialized to zeroes 02572000
SCANPTR DS 0D Len and address of parse buffer 02573000
LEN DS F 02574000
ADR DS F 02575000
SCANSV DS D Saved len and adr @SC86295 02576000
CMD DS CL256 Buffer @SC86121 02577000
CBUF DS A Address of CP response buffer @SC86121 02578000
MSNDBUF DS A Adr of filespec buffer @SC88306 02578300
MSNDPTR DS A Scan ptr for readout @SC88306 02578600
AEPTRS DS 2A Tables to use (normal or "T") @SC92352 02578800
DATL DS F Send packet size @SC86121 02579000
KBYTES DS F Size of current file @SC86158 02581000
FDATE DS XL7 Date/time of current file @SC88235 02581500
* Program flags @SC86316 02582000
FL1 DS X @SC86316 02583000
TSTF EQU X'80' Special option for debugging @SC86295 02584000
ROVR EQU X'40' Overwrite sent filename 02585000
REN EQU X'20' Rename incoming file 02586000
KEEP EQU X'10' Keep incomplete files @SC90037 02587000
NAME EQU X'08' Encoding/decoding a name 02588000
BINF EQU X'04' Binary data 02589000
EOF EQU X'02' End-of-file 02590000
DEBUG EQU X'01' Debug mode ON 02591000
FL2 DS X @SC86316 02592000
FOPTS EQU X'80' Found file options @SC89218 02592500
TABS EQU X'40' Expand tabs 02593000
EOFZ EQU X'20' Truncate at ^Z for EOF 02594000
SRV EQU X'10' In SERVER mode 02595000
PASS EQU X'08' Try 'illegal' cmds on system @SC86295 02596000
ECHO EQU X'04' Echo TAKE files @SC86171 02597000
PROTO EQU X'02' Line ready for transfers @SC86295 02598000
DAT8 EQU X'01' 8-bit data line @SC86316 02599000
*--- DAT8 is now used only in RPRTY/SPRTY @SC88288 02599500
FL3 DS X @SC86316 02600000
ZPRO EQU X'80' Stop protocol mode pronto @SC88074 02600500
SVATT EQU X'40' Preserve attributes of old files @SC90033 02600700
PXCH EQU X'20' Parameters exchanged @SC86152 02601000
APPN EQU X'10' Append to existing files @SC86203 02602000
FCLRF EQU X'08' Skipping two lines on screen @SC92030 02602500
FL4 DS X @SC86316 02603000
TTAB EQU X'80' Use separate tables for terminal @SC87117 02604000
SFM EQU X'20' Sending from memory @SC86158 02605000
TXT EQU X'10' Xmitting text to micro @SC86158 02606000
NPS EQU X'08' Xmitting without protocol @SC86165 02607000
NMCHNG EQU X'04' Filename collsion occurring @SC90033 02607500
UCMD EQU X'02' User command entered @SC86158 02608000
NMOK EQU X'01' Filename collsion already checked @SC87012 02609000
FL5 DS X @SC86316 02610000
CMERR EQU X'80' Syntax error on last command @SC86171 02611000
TKHLT EQU X'40' Quit TAKE file on error @SC86171 02612000
NAK0 EQU X'10' Send NAK during Resend @SC90037 02614000
SALL EQU X'08' Search all disks for SEND @SC86209 02615000
TKMSG EQU X'04' Already issued TAKE error msg @SC86239 02616000
KRMONLY EQU X'02' Saw KERMIT prefix on subcmd @SC90059 02616500
* 02617000
RPKERN DS X Tentative error code from RPACK @SC89219 02617500
SEQ DS X Current pkt number @SC86135 02618000
RSN DS X Received pkt number @SC86135 02619000
CARCTL DS X Code for converting carriage ctl @SC91116 02619200
BRK DS C Break char for last parsed word @SC88306 02619500
TRMFLG DS X Flag(s) for terminal I/O @SC87275 02620000
TRMTP DS C Type of terminal line @SC87166 02621000
DBGFLG DS X Type of debug log @SC88168 02621100
DBGON EQU X'80' Logging on @SC88168 02621200
DBGIO EQU X'40' Logging of I/O info (SERIES1) @SC88168 02621300
DBGRW EQU X'20' Logging raw packets, not EBCDIC @SC88168 02621400
DBGSV EQU X'10' Log file closed after each entry @SC88168 02621500
DBGLO EQU X'08' Logging of I/O info w/ long buffer@SC90222 02621600
DBGTI EQU X'04' Logging of TOD before and after @SC91172 02621800
RBUF DS A Addr of FSREAD buffer @SC86121 02622000
CLEN DS A Length of non-tokenized parm @SC86121 02623000
NSENT DS F Number of files sent @SC86121 02624000
TSENT DS F Pointer to sent files table @SC86121 02625000
TXTPTR DS 3F Ptrs to start and end of text @SC89268 02627000
RBUFL DS F Record len (if recfm = V) @SC86121 02628000
RDWLEN DS F Record descriptor length @SC86151 02629000
SNDPKL DS F SNDPKT length for I/O @SC86295 02630000
RCVPKL DS F RCVPKT length after I/O @SC86295 02631000
WRCMD DS A Ptr to output packet I/O command @SC90173 02631300
WRCMDL DS 2F Length of commands, input to skip @SC90173 02631600
APKT DS A Ptr to packet buffer @SC86190 02632000
ASPKT DS A Ptr to effective send packet @SC86190 02633000
AASPKT DS A Ptr to send packet @SC86190 02634000
ASDATA DS A Ptr to data to send @SC86190 02635000
ARPKT DS A Ptr to receive packet buffer @SC86190 02636000
ARDATA DS A Ptr to received data @SC86190 02637000
FILPTR DS A Ticket for FILNAM file I/O @SC86295 02638000
LOGPTR DS A Ticket for LOG file I/O @SC86295 02639000
SIMPTR DS A Ticket for replay file I/O @SC91312 02639100
KHDSAV DS 5F Save area for hex dumps @SC91008 02639200
KAFUNC DS F SEND/RECEIVE indicator @AB89191 02639500
*--------- Start of data area known to accounting routine @SC90179 02639700
NSENTAC DS F Number of files sent @AB89191 02640000
TOUTOT DS 2F I*8 count of bytes sent @SC86295 02641000
TINTOT DS 2F I*8 count of bytes received @SC86295 02642000
DSKTOT DS 2F I*8 count of disk I/O bytes @SC86295 02643000
SSVDSK DS 2F Saved disk byte count @SC88092 02643500
PAKCNT DS F Number of packets sent/received @SC86295 02644000
RTRCNT DS F Number of retries @SC86295 02645000
SECTOT DS F Duration of transfer (sec) @SC86295 02646000
CSECTOT DS F Duration of transfer (csec) @SC86345 02647000
RECTRC DS F Count of record truncations @SC87268 02648000
RECFLD DS F Count of record foldings @SC88120 02648200
EMSGL DS F Length of msg @BS86090 02648500
TINSV DS 12F 3 snapshots of progress @SC88325 02648700
ERRNUM DS X Error number @SC92210 02648730
REASON DS X Reason for rejecting A-pkt @SC92210 02648760
*--------- NSENTAC to here is known to accounting routine @SC90179 02648800
LSTATS EQU *-NSENTAC Size of area to initialize @SC90179 02649000
TRANEND DS XL4 Ending time of last transfer @SC91172 02649500
PREFIX DS X,CL(FORMAXL) Prefix count and buffer @HF86223 02650000
SUFFIX DS X,CL(FORMAXL) Suffix count and buffer @HF86223 02651000
FILNAM DS CL(LFID) SEND/REC filename @SC86295 02654000
FLNOPTS DS 2AL4 File options @SC89218 02654300
FLNFLGS DS X @SC91116 02654400
FLNCC EQU X'80' File with carriage control @SC91116 02654500
LFOPTS EQU *-FLNOPTS Length of options @SC89218 02654600
DS 0F @SC86295 02655000
IFILE DS CL(LFID) Name of file(s) to send @SC86295 02656000
IFOPTS DS XL(LFOPTS) File options @SC91116 02656200
JFSPEC DS X Length of foreign filespec @SC86224 02656400
JFNAM DS CL95 Filespec @SC86224 02656600
DS 0F So LFSTF is 4*N @SC90264 02656700
LFSTF EQU *-IFILE Length of file info @SC89218 02656800
XFILE DS CL(LFID) Intended name of received file @SC90033 02656900
LIMTRY DS F Max packet retries 02657000
FREEDW DS F Size of aux. storage @SC86295 02658000
FREEPTR DS A Ptr to aux. storage @SC87286 02659000
FREED1 DS A Ptr to 1st disk buffer area @SC90264 02659100
FREED2 DS A Ptr to 2nd disk buffer area @SC90264 02659200
STKLO DS A Start of stack space @SC89089 02659300
STKHI DS A High extent of stack usage @SC89089 02659600
STKPTR DS F Current stack end @SC86295 02660000
STKLIM DS F End of stack storage @SC86295 02661000
EVCTR DS F Count of files opened @SC86295 02662000
EMSGP DS A Ptr to micro message @BS86090 02663000
LEMSG EQU 80 Max msg length kept 8*N @SC90264 02665000
LMARG DS F Left margin for SEND (0=>none) @SC87253 02666000
RMARG DS F Right margin (0=>none) @SC87253 02667000
RBUFP DS F RBUF pointer 02668000
WBUFL DS F Data length in WBUF 02669000
MAXSIZ DS 2A(KDEF-16) Max pkt size sent 02670000
ORGR0 DS F Saved R0 at main entry @SC87253 02671000
ORGR1 DS F Saved R1 at main entry @SC86295 02672000
* Plists for reading and writing in protocol mode 02673000
SIOPTRS DS 2F Address, length of data to send @SC90173 02674000
RIOPTRS DS 2F For reading data (max length) @SC90173 02675000
* 02679000
CDESPTR DS A(0) @SC90040 02679300
LALF EQU 14 Length of fields (must be even): @SC91325 02679600
TRNALF DS CL(LALF)'ASCII' @SC91325 02679700
FILALF DS CL(LALF)'EBCDIC' Logical char-set @SC91325 02679800
FILALF2 DS CL(LALF)'EBCDIC' Actual char-set (if complex) @SC91325 02679900
RIOC DS F Saved data length from prev read @SC86295 02680000
PREV DS C Previous char decoded 02681000
DECESCP DS C Saved DLE prefix, if any @SC91275 02681200
LCKCAPA DS X Flag x'20' if using locking shift @SC91275 02681400
LCKFRC DS X Flag x'21' if FORCE mode @SC91275 02681600
LCKOLD DS X Current locking shift state @SC91275 02681800
* - - - Variables initialized via block MVC's 02682000
KSYSTF , @SC86295 02683000
* Specifications for LOG file @SC86295 02684000
LOGFDB DS 0F @SC86295 02685000
LOGBUF DS A Buffer ptr @SC86295 02686000
DS A(LPKT) Buffer size @SC86295 02687000
FDBPAT LOG,V,LPKT Default disk RECFM, etc. @SC88120 02689000
* Specifications for SEND/RECEIVE file @SC86295 02692000
FILFDB DS 0F @SC86295 02693000
WBUF DS A,F Adr,length of FSWRITE buffer @SC86121 02694000
FDBPAT FIL,V,80 Default disk RECFM, etc. @SC88120 02696000
* Specifications for TAKE file (read-only) @SC86295 02699000
TAKFDB DS 0F @SC86295 02700000
TAKBUF DS A Buffer ptr (CMD) @SC86295 02701000
DS F'256' Max buffer size @SC86295 02702000
FDBPAT TAK,V Default disk RECFM (no LRECL) @SC88120 02703000
* 02705000
MAXTNT DS F'16' Retry limit during setup @SC86345 02706000
MAXTRY DS F'5' Retry limit during transfer @SC86164 02707000
LCLDLY DS F'10' Time to wait before sending @SC86164 02708000
BAUD DS F'1200' Assumed baud rate @SC88325 02708500
RPSIZ DS A(KMAX) Max receive size @SC86295 02709000
SPSIZ DS A(KDEF) Max send size @SC86295 02710000
MAXOUT DS F'&MAXLR' Max output buffer @SC86268 02711000
* Send mode Rpack interpret input table @SC89263 02711100
SNDST DS AL1(AY),AL3(0) Micro ACK'd @SC89263 02711200
DS XL1'FF',AL3(SNDABR) Stop @SC89263 02711300
RTYPPRV DS AL1(AN),AL3(INPUTMIS) Repeated trigger packet @SC89263 02711400
DS AL1(00),AL3(SNDABR) Error routine @SC89263 02711500
TRMLIN DS CL8' ' Current data line @SC87166 02712000
ATFLG DS X Attribute-honoring flags @SC90037 02712040
ATFLNG EQU X'80' Length of file @SC90037 02712080
ATFTYP EQU X'40' Type of file @SC90037 02712120
ATFDAT EQU X'20' Date of file creation @SC90037 02712160
ATFCRE EQU X'10' Creator of file @SC90037 02712200
ATFACT EQU X'08' Account @SC90037 02712240
ATFARE EQU X'04' Area @SC90037 02712280
ATFPWD EQU X'02' Password @SC90037 02712320
ATFBLK EQU X'01' Blocksize @SC90037 02712360
ATFL2 DS X @SC90037 02712400
ATFACC EQU X'80' Access @SC90037 02712440
ATFENC EQU X'40' Encoding @SC90037 02712480
ATFDSP EQU X'20' Disposition @SC90037 02712520
ATFPRO EQU X'18' Protection @SC90037 02712560
ATFORG EQU X'04' Origin @SC90037 02712600
ATFFMT EQU X'02' Format @SC90037 02712640
ATFSFO EQU X'01' System info @SC90037 02712680
ATFL3 DS X @SC90037 02712720
ATFXLN EQU X'80' Byte count @SC90037 02712760
ATFL4 DS X @SC91109 02712770
ATFEND EQU X'01' End of attributes @SC91109 02712780
ATFL5 DS 5X @SC91109 02712790
* 02712800
TYPFIL DS C'T' Type of file (T,B,V,D),see BINF @SC86151 02713000
CLSNFL DS C'O' Collision default is OVERWRITE @SC90033 02713200
TRNCFL DC C'T' Truncate or Fold or Halt @SC88120 02713500
* 02714000
DEFPARM DS AL1(KDEF+ABL,ABL,ABL,64,CR+ABL,A#,AN,A1,ABL,ABL) SC86149 02715000
DS AL1(ABL,ABL,ABL,ABL) Extended size defaults @TB86196 02716000
RCAPA DS X'0' Capabilities of micro @SC86149 02717000
SCAPA DS X'8' Capabilities I have (A-packets) @SC86149 02718000
REOL DS AL1(CR) EOL char I need (cr) 02719000
SEOL DS AL1(CR) EOL I'll send 02720000
RMARK DS AL1(SOH) Incoming pkt start char 02721000
SMARK DS AL1(SOH) Outbound pkt start char 02722000
RCTLQ DS AL1(A#) Micro's ctl-quote char 02723000
SCTLQ DS AL1(A#) Ctl-quote char we'll use 02724000
EBQC DS AL1(AAMP) Orig 8-bit quote char 02725000
RTIMO DS AL1(5) Time limit - micro to wait for us @SC86164 02726000
TIMOUT DS AL1(0) Timeout, if we can implement it @SC86164 02727000
TIMOSRV DS AL1(120) Timeout, if we can implement it @SC90045 02727100
RPRTY DS AL1(0) Recieve parity is MARK @SC88288 02727300
SPRTY DS AL1(DAT8) Send parity is NONE @SC88288 02727600
BCTC DS C'1' User requested chksum length @SC92085 02728000
RPTQC DS AL1(ATIL) Original repeat prefix 02729000
AEADAT DS &AEACMD,AL2(8),X'0F02' D/O strct fld @SC90173 02730000
AEAFLG DS X,X'00',AL2(1) D/O id is 1 @SC90173 02730600
AEADOL EQU *-AEADAT Length of just D/O field @SC91352 02730900
AEABUFL DS AL2,X'0F1F',X'00C000' Not spanned @SC90173 02731200
AEAL EQU *-AEADAT @SC90173 02731800
S1DATA DS &S1CMD,AL1(SBA),X'5D7F',AL1(SBA),X'0005' @SC90264 02732400
S1ORDL EQU *-S1DATA @SC90173 02733000
WRRD EQU *-1 Zap this to 0 for just write @SC90173 02733600
* ... but ONLY if we really won't read again @SC90173 02734200
LDEFS EQU *-DEFS @SC86295 02735000
* 02736000
S1XOPL DS 2A For sending prompt @SC90173 02737000
SCRPRBUF DS XL(S1ORDL) Command stream @SC90173 02737300
ORG SCRPRBUF @SC90173 02737600
DS XL(GRDL) @SC90173 02737900
ORG SCRPRBUF @SC90173 02738200
DS XL(AEAL) @SC90173 02738500
ORG , @SC90173 02738800
TRNSPL EQU *-SCRPRBUF Length of longest command string @SC90173 02739100
S1EOL DS AL1(CR) In case micro lost one @SC90173 02739400
S1HND DS AL1(XON) Handshake for micro @SC90173 02739700
SVHND DS X Saved value of HANDSHAKE char @SC87343 02740000
* - - - Initialized to zeroes 02741000
RPTQ DS X Repeat prefix 02742000
EBQ DS X 8-bit quoting char (off) 02743000
BCTOFF DS F Offset in checksum encoding (0/1) @SC92085 02743500
BCTU DS X Checksum length in use 02744000
BCTR DS X Other Kermit's chksum length 02745000
RPADN DS X Receive padding count 02746000
SPADN DS X Send pad count @SC86164 02747000
RPADC DS X Receive pad char 02748000
SPADC DS X Send pad char @SC86164 02749000
CTLTAB DS 160X Table of sendable ctl chars @SC93173 02749500
TMP DS X 02750000
TMPDW DS D Work double word 02751000
FSIZE DS F Record length @SC86203 02752000
FRECF DS C Record format flag @SC86151 02753000
STYPE DS C Type of packet sent @SC86295 02754000
RTYPE DS C Type of packet received @SC86295 02755000
ACCTFLG DS X Flag for transaction log @SC89218 02755200
ERRLAST DS X Error code on last file xferred @SC89218 02755400
REALAST DS X Reason code on last file @SC89218 02755600
OLDERR DS XL2 Saved ERRNUM+REASON in loop @SC90033 02757000
OPRND DS CL32 Upcased operand for table lookup @SC87034 02759000
TCTLQ DS X XECHO control character escape @SC86165 02760000
TABTBL DS XL20 Tab stops @SC86355 02761000
TABCNT DS H Current number of tabs @SC86355 02762000
STOPBUF DS CL8 Work area @SC91032 02762500
KSYSVAR , Specific variables @SC87012 02763000
DS 0D @SC86295 02764000
STODWDS EQU (*-STORAG)/8 @SC86295 02765000
TITLE 'ERRMSG - List of error messages' @SC86135 02766000
* Table of error messages @SC86156 02767000
MSGDF NOE,'&NOERROR' Err #0 @SC86156 02768000
MSGDF NFT,'&NOTRANS' Err #1 @SC86156 02768500
MSGDF TRC,'&TCANCEL' Err #2 @SC86156 02769000
MSGDF USC,'&BADSERV' Err #3 @SC86156 02769500
MSGDF TIE,'&TERMIOE' Err #4 @SC86156 02770000
MSGDF BPC,'&BADCHEK' Err #5 @SC86156 02770500
MSGDF IPS,'&BADPSYN' Err #6 @SC86158 02771000
MSGDF IPT,'&BADPTYP' Err #7 @SC86156 02771500
MSGDF MIS,'&LOSTPAK' Err #8 @SC86156 02772000
MSGDF NAK,'&GOTNAK' Err #9 @SC86156 02772500
MSGDF ABO,'&MICROAB' Err #10 @SC86156 02773000
MSGDF FNE,'&BADNAME' Err #11 @SC86156 02773500
MSGDF FNF,'&NOTFOUN' Err #12 @SC86156 02774000
MSGDF FUL,'&DSKFULL' Err #13 @SC86345 02774500
MSGDF DIE,'&DSKIOER' Err #14 @SC86345 02775000
MSGDF MOP,'&MISSOPR' Err #15 @SC86158 02775500
MSGDF SYS,'&BADSCMD' Err #16 @SC86268 02776000
MSGDF KCE,'&KCMDERR' Err #17 @SC86171 02776500
MSGDF TIM,'&NOPACKS' Err #18 @SC86355 02777000
MSGDF RTR,'&RECTRNC' Err #19 @SC87268 02777500
MSGDF COM,'&BADCOMM' Err #20 @SC87300 02778000
MSGDF PTY,'&NO8THBQ' Err #21 @SC89072 02778500
MSGDF FTS,'&TOOSHRT' Err #22 @SC89218 02779000
MSGDF SOH,'&NOSTART' Err #23 @SC89219 02779500
MSGDF OPT,'&BADOPTN' Err #24 @SC89249 02780000
MSGDF DSP,'&BADDISP' Err #25 @SC90037 02780500