Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / ibm370 / ikmker.upd < prev next >

Wrap

Text File | 2020-01-01 | 82KB | 1,162 lines

./ * ... Permanent change ... ./ * PG89001 - Make changes from base code for MUSIC/SP System ./ R 07574000 $ 07574000 500 ->4.3<- DC AL1(15,0+2) No wild matches @PG89001 ./ * ... Other ... ./ * S u m m a r y o f u p d a t e s ./ * SC93236 - Support long userid's and file names (MUSIC) ./ * SC93342 - Use date transmitted with file (CMS only) ./ * SC94074 - NAK bad data packet instead of re-ACKing previous ./ * SC94174 - WHATAMI option for file type ./ * SC94181 - Implement level-1 restart/recovery mode (MUSIC) ./ * SC94245 - More accurate statistics after server transfers ./ * SC94262 - Leave room for table expansion (MUSIC) ./ * SC94264 - Avoid spurious error message for host commands (MUSIC) ./ * SC94287 - Prevent or recover from lost screen (MUSIC) ./ * SC94299 - Make GIVE CONTROL subcommand work (MUSIC) ./ * SC95023 - Fix RESEND for already-sent file, implement APC subcmd. ./ * SC95032 - Allow Recovery into almost-full file system ./ * SC95033 - Update to level 4.3.1 ./ * SC95059 - Preserve transmitted time tag for RESENT file ./ * SC95108 - Prevent error-free transfers from halting TAKE files ./ * SC95174 - Implement REGET subcommand ./ * SC96122 - Avoid endless double transmission from windowed Kermit ./ * SC96151 - Add system ID to INIT packets ./ * SC96158 - Never skip sending an I-packet while in remote mode ./ * SC97028 - Clear 'Kermit command error' condition correctly ./ * SC97164 - Update to level 4.3.2 ./ * U p d a t e s ... ./ * SC93236 - Support long userid's and file names (MUSIC) ./ R 00917000 $ 917000 500 08/26/93 13:03:01 LH 9,DESTL Length of string @SC93236 ./ R 00997000 $ 997000 300 08/24/93 16:50:09 LFCODE EQU 16 @SC93236 LFID EQU 64 Max length of filespec @SC93236 FABFN DS CL(LFID) MUSIC filename & code @SC93236 ./ R 01025000 01027000 $ 1025000 1000 08/24/93 16:50:09 UCODE DS CL(LFID) User code @SC93236 SCODE DS CL20 SEARCH CODE @SC93236 FCODE DS CL16 CODE LOCATED BY MFINDX @SC93236 ./ R 01033000 $ 1033000 500 08/26/93 13:03:01 MFARG XNAME=0,HINFO=0,INFIN=0,INFOUT=0,ARG=0 @SC93236 ./ R 01038000 $ 1038000 500 08/26/93 13:03:01 MFNAME MFVAR XNAME,PRE=MF,PICT=Y @SC93236 ZHINFO MFVAR HINFO,PRE=MF,PICT=Y @SC93236 ./ R 01057000 $ 1057000 500 08/27/93 12:44:16 DESTL DS H Non-zero if CWD set. @SC93236 ./ R 01059000 01060000 $ 1059000 1000 08/24/93 16:50:09 NXFN DS CL(LFID) Pattern filespec @SC93236 LCFN DS CL(LFID) Located filename @SC93236 ./ I 01066000 $ 1066500 500 10/07/94 23:49:07 NXFNWL DS H Length of string to last wildcard @SC93236 ./ D 01100000 01101000 09/01/93 16:15:53 ./ D 01111000 08/24/93 16:50:09 ./ R 01148090 $ 1148090 10 10/12/94 13:31:34 &CWDERRM SETC 'Must be a valid MUSIC path name' @SC93236 ./ D 01157000 08/24/93 16:50:09 ./ R 05007000 05008000 $ 5007000 200 08/26/93 13:03:01 MVI TRTBL+C':',1 Set to scan for separator @SC93236 EX 7,CWDSCN Look for separator @SC93236 MVI TRTBL+C':',0 Clean up table before leaving @SC93236 BZ CWDTRY Not found. Just setting directory@SC93236 ./ R 05012000 05013000 $ 5011000 50 08/26/93 13:03:01 CWDTRY LA 0,MFNAME @SC93236 LA 1,LFID @SC93236 LA 7,1(,7) Set up MVCL @SC93236 ICM 7,8,=C' ' @SC93236 MVCL 0,6 @SC93236 TR MFNAME,UPCASE Up-case it @SC93236 MFARG 0,RLAB=CWDRC,XNAME=MFNAME,RNAME=CWDNAM @SC94272 MFGEN AREA=CWDBLK @SC94272 MFSET CWDBLK,DIRSRV,R=(DIRCD) @SC94272 MFREQ CWDBLK @SC94272 CLI CWDRC,0 Is it valid? @SC94272 BNE CWDERR Something went wrong @SC94272 CLC =C'\ ',CWDNAM Just my root directory? @SC94272 BE CWDRSET Yes, reset @SC94272 SR 1,1 Clear high bits @SC94272 TRT CWDNAM,TRTBL Find end of pathname @SC94272 BZ CWDERR Impossible! No trailing blank @SC94272 LA 0,CWDNAM+1 After the leading "\" @SC94272 LA 2,UCODE Start of destination string @SC94272 LA 15,LFCODE Max length of other userid @SC94272 LA 14,CWDNAM+2 Start scan for code separator @SC94272 CWDCLP CLI 0(14),C':' @SC94272 BE CWDOTH Found it, that's the dest. @SC94272 LA 14,1(,14) @SC94272 BCT 15,CWDCLP Keep looking @SC94272 BCTR 0,0 Not found, must copy whole string @SC94272 CWDME MVC 0(LFCODE,2),$USERID ... as subdirectory @SC94272 SR 15,15 @SC94272 IC 15,$OWNL Length of userid @SC94272 AR 2,15 @SC94272 MVI 0(2),C':' End of userid @SC94272 LA 2,1(,2) Set ptr for copying @SC94272 CWDOTH SR 1,0 Length of stuff to copy @SC94272 LA 15,0(1,2) End of expected value @SC94272 LA 3,UCODE+LFID End of destination field @SC94272 SR 3,2 Length to fill @SC94272 ICM 1,8,=C' ' Fill with blanks @SC94272 MVCL 2,0 Copy to dest field @SC94272 LR 1,15 Ptr to end @SC94272 BCTR 1,0 Back up to last character @SC94272 CLI 0(1),C':' Ends with a separator? @SC93236 BE CWDOK Yes, leave it at that @SC93236 CLI 0(1),C'\' Ends with a separator? @SC93236 BE CWDOK Ok @SC93236 MVI 1(1),C'\' No, tack on a slash @SC93236 LA 15,1(,15) Add to length of string @SC93236 CWDOK LA 1,UCODE @SC94272 SR 15,1 Length of string @SC94272 STH 15,DESTL Save length @SC94272 WTEXT (1),(15) Display now-current directory @SC94272 ./ I 05014000 $ 5014500 500 08/26/93 13:03:01 CWDSCN TRT 0(,6),TRTBL @SC93236 ./ R 05017000 05019000 $ 5017000 500 08/26/93 13:03:01 CWDRSET LA 2,UCODE Refill default code field @SC94272 LR 1,0 Null path name @SC94272 B CWDME Copy and blank-fill @SC94272 ./ I 05043000 $ 5043100 100 09/30/94 18:10:31 CWDBLK MFARG 0,RLAB=CWDRC,XNAME=0,RNAME=0,PICT=Y @SC94272 MFGEN , @SC94272 CWDNAM MFVAR RNAME,PRE=MF,PICT=Y @SC94272 ./ R 05077000 $ 5077000 500 08/26/93 13:03:01 MVI 0(1),C' ' Clear the filename to blanks @SC93236 MVC 1(LFID-1,1),0(1) @SC93236 ./ R 05091000 05092000 $ 5091000 500 08/26/93 13:03:01 MVC 0(LFID,1),UCODE Default prefix @SC93236 LH 15,DESTL @SC93236 AR 15,1 @SC93236 MVI 0(15),C'*' Yes @SC93236 ./ D 05101000 10/26/94 13:03:01 ./ R 05105000 05113000 $ 5105000 1000 08/26/93 13:03:01 * Fall through to treatment of received file header @SC93236 FSPHD MVC 0(LFID,1),UCODE Default code @SC93236 LH 15,DESTL @SC93236 AR 15,1 @SC93236 MVI 0(15),C'$' Default fn @SC93236 ./ I 05129000 $ 5129200 200 10/26/94 13:03:01 FSPCKNSP TRT 0(,1),TRTBL @SC93236 FSPVALC TR 0(,8),FSPTAB Make valid fn chars @SC93236 ./ R 05133600 05140000 $ 5134000 200 08/24/93 16:50:09 MVC 0(LFID,8),UCODE Add the user code in case needed@SC93236 LR 9,8 Yes, keep current user code @SC93236 FSPCPCLP LA 9,1(,9) @SC93236 CLI 0(9),C':' (UCODE always has a ":") @SC93236 BNE FSPCPCLP Find end of user code in output @SC93236 CLI 0(6),C'\' "Absolute" path for current user? @SC93236 BNE FSPCPOTH No, but maybe another user @SC93236 LA 0,1(,9) Yes, keep just user code+colon @SC93236 B FSPCPSEP Go tack on the path @SC93236 FSPCPOTH MVI TRTBL+C':',9 Set to find end of code @SC93236 LA 15,LFCODE Nominal length of code (not ":") @SC93236 CR 15,7 See if string is long enough @SC93236 BNH *+6 @SC93236 LR 15,7 Separator must be in name @SC93236 LR 1,6 Start of possible code in input @SC93236 XR 2,2 Clear result value @SC93236 EX 15,FSPCKNSP Find end of code, if any @SC93236 CLM 2,1,TRTBL+C':' Found a colon? @SC93236 MVI TRTBL+C':',0 Reset table @SC93236 BE FSPCPICD Found separator. Absolute path @SC93236 AH 0,DESTL Use whole destination string @SC93236 B FSPCPSEP All set @SC93236 FSPCPICD SR 1,6 Get offset to colon @SC93236 LA 9,0(1,8) Where it will be in output field @SC93236 * Now R0->where to copy input string, R8->output field @SC93236 FSPCPSEP LA 1,LFID(,8) End of name field @SC93236 SR 1,0 Length remaining to fill @SC93236 TM FSPFLG,FFRCF @SC93236 ./ R 05143000 $ 5143000 200 10/27/94 20:25:18 FSPCPN LR 2,0 @SC93236 SR 2,8 Length being preserved in output @SC93236 AR 2,7 Length to be copied - 1 @SC93236 LA 7,1(7) @SC93236 ./ I 05145000 $ 5145500 500 10/27/94 20:25:18 SR 2,7 Deduct anything uncopied @SC93236 ./ R 05147000 $ 5147000 100 10/26/94 16:50:09 BAL 14,FSPTVAL Error if name was too long @SC93236 ./ I 05148000 $ 5148020 20 10/26/94 16:50:09 MVC FSPFN,0(8) Copy tentative version of name @SC93236 CLI FSPFLG,FFRCF @SC93236 BE FSPMVAL Make sure it's valid for receive @SC93236 CLI FSPFLG,FFGET+FFRCF @SC93236 BE FSPMVAL Get 2nd name is like RECEIVE @SC93236 CLI FSPFLG,FFHDR @SC93236 BNE FSPCKNOK Ok, don't bother @SC93236 FSPMVAL CLI 0(8),C'*' Allow asterisk to start a code @SC93236 EX 2,FSPVALC Make valid fn chars @SC93236 BNE *+8 @SC93236 MVI 0(8),C'*' Restore asterisk @SC93236 MVI 0(9),C':' Restore code separator as "valid" @SC93236 MVI TRTBL+C':',9 Set to find separators @SC93236 MVI TRTBL+C'\',9 @SC93236 LA 5,LFID-1(,8) End of field @SC93236 LR 1,8 @SC93236 BCTR 1,0 Back up for starting @SC93236 FSPCKNLP LR 2,1 Save ptr to latest separator @SC93236 LA 1,1(,1) Advance to 1st byte of token @SC93236 LA 6,17(,1) Max for end of name @SC93236 TRT 0(,1),FSPTAB1 Valid to start token? @SC93236 BNZ FSPCKNLZ Ok @SC93236 CLC =C':\',0(2) No, is it end of user code? @SC93236 BE FSPCKNLZ Ok @SC93236 FSPCKNL1 MVI 0(1),C'$' Insist on valid 1st char @SC93236 FSPCKNLZ LR 2,5 Ptr to last char of field @SC93236 SR 2,1 Length-1 remaining @SC93236 EX 2,FSPCKNSP Find next separator, if any @SC93236 BZ FSPCKNF1 No more tokens @SC93236 CLM 2,1,TRTBL+C' ' Reached end of name? @SC93236 BNE FSPCKNLP No, keep scanning @SC93236 LR 5,1 Yes, note the end @SC93236 BCTR 5,0 Point to last char @SC93236 FSPCKNF1 MVI TRTBL+C':',0 Reset search table @SC93236 MVI TRTBL+C'\',0 @SC93236 CR 5,6 Is the name short enough? @SC93236 BL FSPCKNOK Ok @SC93236 LA 7,LFID(,8) End of field @SC93236 SR 7,6 Length to blank @SC93236 SR 15,15 @SC93236 ICM 15,8,UPCASE+C' ' @SC93236 MVCL 6,14 Fill with blanks @SC93236 FSPCKNOK CLC FSPFN,0(8) Was the name valid? @SC93236 BAL 14,FSPTVAL Complain if not @SC93236 ./ I 05149000 $ 5149100 100 10/26/94 16:50:09 * FSPTVAL BZR 14 No error, keep going @SC93236 CLI FSPFLG,FFHDR Was this passed by other Kermit? @SC93236 BER 14 Yes, use modified name @SC93236 B FSPINV No, user should know better @SC93236 ./ I 05179000 $ 5179090 90 10/27/94 21:45:49 LR 5,6 Now look back for start of name @SC93236 FSPWRN1 BCTR 5,0 @SC93236 CLI 0(5),C'\' @SC93236 BE FSPWRN2 Last separator is here @SC93236 CLI 0(5),C':' Always a code, if nothing else @SC93236 BNE FSPWRN1 @SC93236 FSPWRN2 LA 5,15(,5) Allow no more than 15 @SC93236 CR 5,6 Is this more restrictive? @SC93236 BNL *+6 No, keep whole name @SC93236 LR 6,5 Yes, chop off what's necessary @SC93236 ./ R 05198000 05205000 $ 5199000 500 08/24/93 16:50:09 LA 1,LFID-1(,4) Scan back for start of name part @SC93236 LR 15,1 Save ptr to last char @SC93236 FSPENCLP CLI 0(1),C':' Look for code or last subdirect. @SC93236 BE FSPENC1 Found separator @SC93236 CLI 0(1),C'\' @SC93236 BE FSPENC1 Found last delimiter @SC93236 BCT 1,FSPENCLP @SC93236 FSPENC1 MVC 0(LFID,7),1(1) @SC93236 SR 15,1 @SC93236 LA 1,1(15,7) End of token if no blanks @SC93236 EX 15,FSPETRT Find 1st blank, if any @SC93236 EX 15,FSPETR Convert to ASCII @SC93236 ./ I 05208000 $ 5208300 300 08/31/93 00:41:25 FSPETRT TRT 0(,7),TRTBL Find 1st blank @SC93236 FSPETR TR 0(,7),ETOAD ASCII it @SC93236 ./ R 05213000 05218000 $ 5213000 200 08/26/93 13:03:01 LA 14,UCODE @SC93236 LA 15,LFID @SC93236 LR 5,15 Save length if using all @SC93236 LR 2,7 @SC93236 LR 3,15 @SC93236 ICM 15,8,UPCASE+C' ' @SC93236 FSPDSPL CLCL 2,14 @SC93236 BNE FSPDSPN @SC93236 MVI 0(7),C'.' Exact match = current directory @SC93236 LA 15,1(,7) Just call it "." @SC93236 B FSPRET @SC93236 FSPDSPN CLI 0(14),C' ' Whole UCODE included? @SC93236 BE FSPDSP1 Yes, abbreviate (omit prefix) @SC93236 CLI 0(14),C'\' No, but maybe equivalent anyway? @SC93236 BNE FSPDSP2 No, use all of token @SC93236 BCTR 14,0 Maybe, look at previous char @SC93236 CLI 0(14),C':' End of userid? @SC93236 BNE FSPDSP2 No, use all of token @SC93236 LA 14,2(,14) Yes, next backslash optional @SC93236 BCTR 15,0 @SC93236 B FSPDSPL See if the rest matches @SC93236 FSPDSP1 MVC 0(LFID,7),0(2) Yes, use just the remainder @SC93236 LR 5,15 and use the abbreviated length @SC93236 FSPDSP2 BCTR 5,0 Correct for EX @SC93236 LA 1,1(5,7) End of token if no blanks @SC93236 EX 5,FSPDSPTR @SC93236 ./ I 05220000 $ 5220500 500 08/26/93 13:03:01 FSPDSPTR TRT 0(,7),TRTBL Find 1st blank @SC93236 ./ R 05223000 05225000 $ 5223000 500 09/01/93 11:44:20 FSPTAB DC 75C'$',C'.',2C'$',C'+$&&' dot, plus, ampersand @SC93236 DC 09C'$',C'!$' exclamation, dollar sign @SC93236 DC 04C'$',C'-' minus @SC93236 DC 11C'$',C'%_' percent, underscore @SC93236 DC 13C'$',C'#@' pound sign, at sign @SC93236 ./ R 05228000 $ 5228000 500 09/01/93 11:44:20 DC 07C'$',C'~STUVWXYZ' tilde, s-z @SC93236 ./ R 05231000 $ 5231000 500 09/01/93 11:44:20 DC 06C'$',C'\$STUVWXYZ' backslash, S-Z @SC93236 ./ I 05233000 $ 5233100 100 09/01/93 11:44:20 * * Valid characters to start directory or file name @SC93236 FSPTAB1 DC 91X'00',C'$' dollar @SC93236 DC 17X'00',C'_' underscore @SC93236 DC 13X'00',C'#@' pound sign, at sign @SC93236 DC 68X'00',C'ABCDEFGHI' A-I @SC93236 DC 07X'00',C'JKLMNOPQR' J-R @SC93236 DC 08X'00',C'STUVWXYZ' S-Z @SC93236 DC 22X'00' @SC93236 ./ I 05235000 $ 5235500 500 10/26/94 16:50:09 FSPFN DS CL(LFID) Copy of tentative version of name @SC93236 ./ R 05422000 $ 5422000 500 08/27/93 12:44:16 MFARG XNAME=MFNAME,HINFO=ZHINFO,INFIN=ZINFIN @SC93236 MFARG INFOUT=ZINFOUT,ARG=ZARG @SC93236 ./ R 05426000 05428000 $ 5426000 100 08/24/93 16:50:09 LM 5,6,SCANPTR Save string values @SC94272 MVC SCANPTR,=A(1,UPCASE+C'.') @SC94272 KCALL CWDSET,E=(STM1A,Z) Use current directory @SC94272 XC LEN,LEN Ensure no input string @SC93236 KCALL CWDSET Get default user code @SC93236 STM1A STM 5,6,SCANPTR Restore string values @SC94272 ./ D 06112000 08/27/93 12:44:16 ./ R 06114000 06118000 $ 6114000 200 08/27/93 12:44:16 MVI TRTBL+C':',9 Set to catch the separator @SC93236 TRT NXFN(LFID),TRTBL (known to be there) @SC93236 MVI TRTBL+C':',0 Restore the table @SC93236 LR 5,1 @SC93236 LA 4,NXFN Start of pattern @SC93236 SR 5,4 Get length of code @SC93236 ICM 5,8,=C' ' Use blank filling @SC93236 LA 0,SCODE Fill whole SCODE field @SC93236 LA 1,L'SCODE @SC93236 MVCL 0,4 @SC93236 LA 4,1(,4) Skip over the separator @SC93236 CLI 0(4),C'\' Starts with a backslash? @SC93236 BNE *+8 No, fine @SC93236 LA 4,1(,4) Skip over the backslash, too @SC93236 LA 5,NXFN+LFID @SC93236 SR 5,4 Get remaining length of name @SC93236 ICM 5,8,=C' ' @SC93236 LA 0,NXFN Recopy NXFN with just name part @SC93236 LA 1,LFID @SC93236 MVCL 0,4 @SC93236 ./ R 06121000 $ 6121000 100 08/27/93 12:44:16 LA 0,SCODE Yes, so use the real thing @SC93236 LA 1,L'SCODE @SC93236 LA 4,$USERID @SC93236 XR 5,5 @SC93236 IC 5,$OWNL Length of userid for code @SC93236 ICM 5,8,=C' ' @SC93236 MVCL 0,4 Copy with blank-fill @SC93236 ./ R 06133000 $ 6133000 100 08/27/93 12:44:16 DSKNS10 STH 2,NXFNWL Length to last wildcard @SC93236 LA 14,$USERID Are we searching our library? @SC93236 XR 15,15 @SC93236 IC 15,$OWNL Length of user code @SC93236 ICM 15,8,=C' ' Compare with blank padding @SC93236 LA 0,SCODE @SC93236 LA 1,L'SCODE @SC93236 CLCL 0,14 @SC93236 ./ R 06144000 $ 6144000 500 08/27/93 12:44:16 CALL MFIND1,((2),F10,SCODE,F10,ZRC),VL,MF=(E,PARMAREA) C93236 ./ R 06228000 06229000 $ 6228000 200 08/27/93 12:44:16 DSKFND MVC MFNAME(LFCODE+1),SCODE Rebuild the filename @SC93236 LR 14,1 Save ptr to name portion @SC93236 TRT MFNAME(LFCODE+1),TRTBL Find end of code @SC93236 MVI 0(1),C':' Insert a separator @SC93236 LA 2,MFNAME+LFID-2 @SC93236 SR 2,1 Get length - 1 of remainder @SC93236 MVC 1(,1),0(14) @SC93236 EX 2,*-6 Copy rest into field @SC93236 ./ I 06244000 $ 6244050 50 08/24/93 16:50:09 MVI TRTBL+C'\',9 Catch any subdirectory names @SC93236 LH 1,NXFNWL Length to last wildcard @SC93236 LA 15,LFID @SC93236 SR 15,1 Length to scan @SC93236 BCTR 15,0 Set up for EX @SC93236 LA 1,LCFN(1) Place to start scan for backslash @SC93236 TRT 0(,1),TRTBL @SC93236 EX 15,*-6 @SC93236 MVI TRTBL+C'\',0 @SC93236 CLI 0(1),C'\' Got a subdirectory file? @SC93236 BNE NXT31 No, carry on @SC93236 CLI 1(1),C' ' Just a subdirectory? @SC93236 BNE DSKSRCH No, a subdir file. Skip it @SC93236 L 15,4(,13) Look at caller @SC93236 C KSUBBASE,20+4*KSUBBASE(,15) Was it DIR? @SC93236 BNE DSKSRCH No, return only files @SC93236 NXT31 DS 0H @SC93236 ./ R 06247000 $ 6247000 500 08/24/93 16:50:09 CLC FCODE(LFCODE),SCODE Is this the right code? @SC93236 ./ R 06249000 $ 6249000 500 09/01/93 16:15:58 CALL MATCH,(LCFN,FM64,NXFN,NXFNL,ASTER,QUEST),VL, @SC93236+ ./ I 06260500 $ 6260600 100 08/27/93 12:44:16 LA 1,MFNAME+LFID @SC93236 TRT MFNAME(LFID),TRTBL @SC93236 LR 5,1 @SC93236 ./ R 06261000 06269500 $ 6261000 500 10/07/94 20:10:57 LA 7,CMD Yes, build the filename with @SC93236 LR 2,7 the attributes we want @SC93236 LA 0,FFDSP @SC93236 KCALL FSPEC,MFNAME Get display form @SC93236 LR 1,7 Save ptr to start of buffer @SC93236 LR 5,15 End of output name @SC93236 LA 3,22 Length of name buffer @SC93236 LR 4,2 Copy self unless too long @SC93236 SR 5,4 Length of name @SC93236 CR 5,3 Room for everything on line? @SC93236 BNH DSKDIRL2 Ok @SC93236 SR 5,3 No, skip over beginning of name @SC93236 AR 4,5 @SC93236 LR 5,3 Use as much as possible @SC93236 DSKDIRL2 LA 7,CMD-1(5) Ptr to last character @SC93236 ICM 5,8,F64+3 Get blank for padding @SC93236 ./ I 06270000 $ 6270500 500 08/27/93 12:44:16 XR 0,0 @SC93236 ./ R 06273000 $ 6273000 200 08/27/93 12:44:16 MVC 0(2,2),=C' ' Leave some blanks @SC88308 ./ I 06279000 $ 6279100 100 10/08/94 00:09:12 CLC =C'. ',CMD Is it the current directory? @SC93236 BE DSKDRL2 Yes, mark it @SC93236 CLI 0(7),C'\' Is it a directory? @SC93236 BNE DSKDRL3 @SC93236 DSKDRL2 SH 2,=H'5' Yes, mark it such @SC93236 MVC 0(5,2),=C'<DIR>' @SC93236 AH 2,=H'5' Restore output ptr @SC93236 DSKDRL3 DS 0H @SC93236 ./ R 06317000 $ 6317000 100 09/22/94 09:44:47 LA 14,$USERID Our own code? @SC93236 SR 15,15 @SC93236 IC 15,$OWNL Length of user code @SC93236 ICM 15,8,UPCASE+C' ' Pad if necessary @SC93236 LA 0,MFHIFC Code for file (blank padded) @SC93236 LA 1,16 Length of field @SC93236 CLCL 0,14 See if we match @SC93236 ./ I 06327000 $ 6327500 500 08/27/93 12:44:16 FM64 DC F'-64' @SC93236 ./ * SC93342 - Use date transmitted with file (CMS only) ./ I 01416400 $ 1416500 100 09/01/94 21:20:42 SSYMS , @SC93342 ./ D 01416800 09/01/94 21:20:42 ./ * SC94074 - NAK bad data packet instead of re-ACKing previous ./ I 01917000 $ 1917200 200 03/15/94 16:25:11 CLI STYPE,AY See if sent a plain ACK @SC94074 BNE *+12 No, resend whatever it was @SC94074 CLI DATLSN,0 "plain" only if no data @SC94074 BE SENDNAK Yes, send a NAK @SC94074 ./ R 02579000 $ 2579000 1000 03/15/94 16:25:11 DATL DS F Size of data in packet (S or R) @SC94074 ./ I 02617000 $ 2617200 200 03/15/94 16:25:11 DATLSN DS X Data length in last packet sent @SC94074 ./ I 08466500 $ 8466600 100 03/15/94 16:25:11 STC 9,DATLSN Copy length of data sent, if any @SC94074 ./ * SC94174 - WHATAMI option for file type ./ I 01424200 $ 1424300 100 06/23/94 22:46:07 AUND EQU 95 ASCII underscore @SC94174 ./ I 02082200 $ 2082300 100 06/23/94 22:46:07 MVI WHATRU,0 No valid value anymore @SC94174 ./ R 02492000 $ 2492000 500 06/24/94 00:00:08 DC AL1(ABL,ABL,ABL,A0),3AL1(AUND),AL1(ABL) @SC94174 ./ I 02680000 $ 2680500 500 06/23/94 18:34:18 WHATRU DS X Mode info from other Kermit @SC94174 ./ R 02716000 $ 2716000 500 06/24/94 00:00:08 DS AL1(ABL,ABL,ABL,A0),3AL1(AUND),AL1(ABL) @SC94174 ./ D 08159500 08160000 06/24/94 01:36:05 ./ I 08167500 $ 8167600 100 06/24/94 01:36:05 TM RCAPA,LONGP Test for long packet bit @SC94174 BZ SPARNX No extended packets @SC94174 ./ I 08168500 $ 8168510 10 06/23/94 18:26:14 BAL 14,SPARFTCH Get checkpoint flag @SC94174 * UNCHR 4,,SCKPNT Save for later @SC94174 XR 1,1 Clear checkpoint length @SC94174 LA 15,3 @SC94174 SPARCKPL MH 1,XLFCT+2 Shift left @SC94174 BAL 14,SPARFTCH Get next checkpoint length byte @SC94174 UNCHR 4 @SC94174 AR 1,4 @SC94174 BCT 15,SPARCKPL @SC94174 * ST 1,SCKINT @SC94174 BAL 14,SPARFTCH Get WHATAMI @SC94174 UNCHR 4,,WHATRU @SC94174 TM WHATRU,X'20' Valid? @SC94174 BZ SPARWHT No, skip it @SC94174 TM FL2,SRV Acting as server? @SC94174 BZ SPARWHT No, skip it @SC94174 IC 0,FL1 Get my file-type flag @SC94174 SRL 0,1 Shift BINF (4) to 2-bit @SC94174 XR 0,4 Compare (client 2-bit is binary) @SC94174 N 0,F2 Do they match? @SC94174 BZ SPARWHT Yes, all set @SC94174 XI FL1,BINF No, switch my setting @SC94174 MVI TYPFIL,C'T' Also set the subflag @SC94174 TM FL1,BINF @SC94174 BZ SPARWHT @SC94174 MVI TYPFIL,C'B' @SC94174 SPARWHT DS 0H @SC94174 ./ R 08219000 $ 8219000 100 06/23/94 18:26:14 MVI 10(9),ABL Window size is blank @SC86295 ./ R 08229500 $ 8229500 200 06/23/94 18:26:14 BNH RPARS1 KMAX >= RPSIZ @SC94174 ./ R 08230500 $ 8230500 200 06/23/94 18:26:14 SH 5,=H'7' Allow for long header @SC94174 ./ D 08231500 06/24/94 00:00:08 ./ R 08233500 08234000 $ 8233400 100 06/23/94 18:26:14 MVC 13(4,9),DEFPARM+13 No ckpt support @SC94174 LA 4,X'24' Bits always on in WHATAMI @SC94174 TM FL1,BINF Binary? @SC94174 BZ *+8 @SC94174 LA 4,2(,4) Yes @SC94174 TM FL2,SRV Server mode? @SC94174 BZ *+8 @SC94174 LA 4,1(,4) Yes @SC94174 TOCHR 4,,17(9) @SC94174 LA 0,18 Size of data including WHATAMI @SC94174 ./ * SC94181 - Implement level-1 restart/recovery mode (MUSIC) ./ I 00990000 $ 990300 300 06/29/94 18:55:26 FDBSIZEB DS F File size in bytes @SC94181 ./ I 01413600 $ 1413700 100 09/14/94 15:49:04 GBLC &AAARSND,&AUPDATE @SC94181 ./ R 01415400 01415600 $ 1415400 200 09/30/93 14:45:03 &KDATE SETC '94/06/30' @SC94181 &KEDIT SETC '1 TEST' @SC94181 ./ I 01460400 $ 1460500 100 06/28/94 18:25:34 &AAARSND SETC 'RESEND' cmd, m=3 @SC94181 ./ I 01475800 $ 1475900 100 09/20/94 21:29:31 &AUPDATE SETC 'UPDATE' kwd->COLLISN @SC94181 ./ I 02119000 $ 2119100 100 09/21/94 15:17:19 CLI ERRNUM,ERRTRC Canceled? @SC94181 BNE LDERR2 @SC94181 CLI REASON,STACNDAT Date too early? @SC94181 BER 14 Not an error @SC94181 CLI REASON,STACNDSC Simply a duplicate? @SC94181 BER 14 Not an error @SC94181 LDERR2 DS 0H @SC94181 ./ R 02494000 $ 2494000 500 06/28/94 18:25:34 DC X'38' Capabilities I have SCAPA @SC94181 ./ R 03033000 $ 3033000 80 06/28/94 18:25:34 KW '&AAARSND',KRMSND,R,MIN=3 @SC94181 SNDKCMD KW '&AAASEND',KRMSND,MIN=3 @SC94181 ORG SNDKCMD+KWCODE @SC94181 DC X'0' Normal send has no disp code @SC94181 ORG , @SC94181 ./ R 03034500 $ 3034500 100 10/15/94 18:25:34 XTYKCMD KW '&AAXTYPE',KRMNPS,MIN=2 @SC94181 ORG XTYKCMD+KWCODE @SC94181 DC X'0' Normal send has no disp code @SC94181 ORG , @SC94181 ./ R 03081000 $ 3081000 200 06/28/94 18:25:34 KRMSND MVC USNCOD,KWCODE(1) Save send command abbrev @SC94181 PTEXT '&SYSFSPC - ',AREG=1,LREG=0 @SC94181 ./ R 03094000 03095000 $ 3094000 90 09/21/94 16:45:10 KRMSNDBG SR 1,1 @SC94181 ICM 1,1,USNCOD Get send command code @SC94181 BZ USNSND3 Fine, no special disposition @SC94181 TM SCAPA,8 Can we do attributes? @SC94181 BZ USNSNDX No, give up right away @SC94181 TM ATFL2,ATFDSP Disposition attribute enabled? @SC94181 BZ USNSNDX No, can't do it @SC94181 TM ATFLG,ATFTYP Type attribute enabled? @SC94181 BZ USNSNDX Can't do it @SC94181 TM ATFL4,ATFEND End-of-atts attribute enabled? @SC94181 BZ USNSNDX Can't do it @SC94181 TM FL1,BINF Are we binary? @SC94181 BZ USNSNDX1 No, can't do it @SC94181 USNSND3 IC 1,ETOAD(1) Use ASCII version of Disp code @SC94181 XC LEN,LEN Clear length of Disp options @SC94181 KCALL SEND @SC94181 KRMXFZ BAL 14,LDERR Get massaged error code @SC94181 ./ I 03096000 $ 3096080 80 06/28/94 18:25:34 B USNSNDZ @SC94181 USNSNDX WTEXT '&ATTRIBU &AZDISAB' @SC94181 B USNSNDZ @SC94181 USNSNDX1 WTEXT '&CANNOT.&AAARSND ->&AAAABIN' @SC94181 USNSNDZ DS 0H @SC94181 ./ I 03105000 $ 3105200 200 06/28/94 18:25:34 MVI USNCOD,0 No special disposition @SC94181 ./ I 03130500 $ 3130700 200 06/28/94 18:25:34 USNCOD DS X Temporary flags for SEND/RESEND @SC94181 ./ I 03192000 $ 3192200 200 09/20/94 21:29:31 KW '&AUPDATE',SETCLSN,U @SC94181 ./ R 03754000 $ 3754000 100 09/20/94 21:29:31 STACNTB DC C'-&ATTUNK.-&ATTLEN.-&ATTTYP' @SC94181 STACNDAT EQU (*-STACNTB)/8 Date reason code @SC94181 DC C'-&ATTDAT.' @SC94181 ./ R 03756500 $ 3756500 100 09/20/94 16:08:33 DC (31-(*-STACNTB)/8)CL8'-??' @SC94181 STACNDSC EQU (*-STACNTB)/8 One extra reason (not in A-packet)@SC94181 DC C'-&COLLIS.' @SC94181 ./ I 05843000 $ 5843500 500 09/20/94 21:29:31 XC FDBD(FDBINFO),FDBD Clear it out @SC94181 ./ I 06205000 $ 6205100 100 06/29/94 18:55:26 ICM 0,15,MFNLRC Number of records @SC94181 MH 0,MFORSIZ Record length @SC94181 ST 0,FDBSIZEB Save @SC94181 ./ I 07683000 $ 7683100 100 06/28/94 18:25:34 CLI SNDDSP,AR Trying to recover? @SC94181 BNE SNDFIL No, fine @SC94181 TM RCAPA,X'10' Yes, can the other Kermit do it? @SC94181 BZ SNDCMDER No. Give up @SC94181 ./ I 07685000 $ 7685200 200 06/28/94 18:25:34 XC SNDBLEN,SNDBLEN Clear "recovery" length @SC94181 ./ I 07757500 $ 7757530 30 06/28/94 18:25:34 CLI SNDDSP,AR Trying to recover? @SC94181 BNE SNDPKLX No @SC94181 CLC DATL,F3 Any byte length? @SC94181 BL SNDPKLX No @SC94181 CLI 0(1),A1 Is this it? @SC94181 BNE SNDPKLX No @SC94181 UNCHR 7,1(1) Yes, get length of number string @SC94181 LA 6,2(,1) Ptr to numeric string @SC94181 LR 14,7 @SC94181 BCTR 14,0 @SC94181 EX 14,SNDTRAT @SC94181 BAL 14,GETNUM Get file length @SC94181 LA 0,0 Default is to send all @SC94181 ST 0,SNDBLEN Save expected size @SC94181 ./ I 07760500 $ 7760700 200 06/28/94 18:25:34 SNDTRAT TR 0(,6),ATOED Convert to EBCDIC for decoding @SC94181 ./ I 07765000 $ 7765050 50 06/28/94 18:25:34 L 5,SNDBLEN Length to skip @SC94181 SNDRECL LTR 5,5 Any more? @SC94181 BNP SNDENC No, start sending @SC94181 KCALL INBUF,E=SNDEND @SC94181 S 5,RBUFL Data length in RBUF @SC94181 BNM SNDRECL Keep skipping @SC94181 A 5,RBUFL Must use part of this buffer @SC94181 ST 5,RBUFP Index of next char in RBUF @SC94181 ./ I 07797000 $ 7797200 200 12/19/94 15:58:18 SNDEND MVC DATL,F0 End while restarting: do nothing @SC94181 ./ I 07809000 $ 7809060 60 09/21/94 15:58:18 CLI ERRNUM,ERRTRC Cancelled? @SC94181 BNE SNDBRKA No, it's a solid error @SC94181 CLI REASON,STACNDAT Refused as duplicate (date)? @SC94181 BE SNDBRKP Yes, not really an error @SC94181 CLI REASON,STACNDSC Refused as duplicate? @SC94181 BE SNDBRKP Yes, not really an error @SC94181 SNDBRKA DS 0H @SC94181 ./ I 07833000 $ 7833200 200 06/28/94 18:25:34 SNDBLEN DS F Length to skip in resending file @SC94181 ./ R 07864500 07875500 $ 7865500 500 06/29/94 20:43:04 RECOVR XC FILFLGS,FL3 Set flag for DISP @SC94181 NI FILFLGS,255-APPN-SVATT @SC90033 XC FILFLGS,FL3 @SC86295 TM RCAPA,X'18' Attributes, including End? @SC94181 BNO RECCOL No, do collision test now @SC94181 TM SCAPA,X'08' Am I expecting A-packets? @SC94181 BNO RECCOL No, do collision test now @SC94181 TM ATFL4,ATFEND Will I honor the End attribute? @SC94181 BO RECOPN Yes, defer collision test @SC94181 RECCOL KCALL TCOLL,E=(RECOPN,Z) @SC94181 ./ R 07879000 07883500 $ 7879000 1000 06/29/94 20:43:04 RECOPN DS 0H @SC94181 ./ I 07892500 $ 7892560 60 06/30/94 14:49:18 MVI RECDISP,0 No disposition specified @SC94181 TM RCAPA,X'18' Does he promise End attribute? @SC94181 BNO RECDAT No, let it ride @SC94181 TM SCAPA,X'08' Am I expecting A-packets @SC94181 BNO RECDAT No, but I'll accept them @SC94181 TM ATFL4,ATFEND Will I honor the End attribute? @SC94181 BNO RECDAT No, let it ride @SC94181 LA 8,RECAST Ok, accept only A-packets for now @SC94181 ./ I 07896500 $ 7896600 100 06/29/94 21:14:51 L 2,FSIZE Default lrecl @SC94181 ICM 0,15,FILPTR Already opened? @SC94181 BNZ RECDATO Yes, fine @SC94181 ./ I 07899500 $ 7899700 200 06/29/94 21:14:51 RECDATO DS 0H @SC94181 ./ R 07908000 $ 7908000 100 06/30/94 14:49:18 RECDAK XC DATL,DATL Set length to zero @SC94181 RECDAKL BAL 2,SENDACKL Send an ack @SC94181 ./ R 07927000 $ 7927000 200 09/20/94 16:42:43 BNZ RECADTX Invalid, stop now @SC94181 ./ R 07930500 $ 7930500 200 09/20/94 16:42:43 BH RECADTX Too big, stop now @SC94181 ./ R 07932000 $ 7932000 200 09/20/94 16:42:43 BNE RECADTX No, illegal @SC94181 ./ R 07940500 $ 7940500 200 09/20/94 16:42:43 BNE RECADTX No, error @SC94181 ./ I 07942500 $ 7942600 100 09/20/94 16:42:43 RECADTX MVI ERRNUM,ERRIPS Bad syntax @SC94181 B RECABR Quit @SC94181 ./ I 07945000 $ 7945200 200 06/30/94 16:32:21 XC DATL,DATL Normally no data on ACK @SC94181 ./ R 07946000 $ 7946000 200 06/30/94 16:32:21 BNL RECDAKL No, done @SC94181 ./ R 07947000 $ 7947000 200 06/30/94 16:32:21 BO RECDAKL Yes, ignore further attributes @SC94181 ./ I 07951000 $ 7951100 100 06/30/94 14:49:18 CLC FILPTR,F0 End attribute already seen? @SC94181 BNE RECRJC Yes, this is forbidden @SC94181 ./ R 07959000 $ 7959000 200 06/28/94 18:25:34 RECDSPCD DC AL1(11),AL3(RECADI) + - Disposition @SC94181 ./ R 07994500 $ 7994500 200 06/28/94 18:25:34 RECADI MVC RECDISP,0(6) Save disp code @SC94181 BAL 2,RECALKP @SC94181 ./ I 07996000 $ 7996300 300 06/28/94 18:25:34 DC AL1(AR),AL3(RECCKL) Recover @SC94181 ./ R 08026000 08026500 $ 8025800 20 06/30/94 14:49:18 RECAZZ DS 0H End of attributes, must be last @SC94181 CLI RECDISP,AR Recover? @SC94181 BNE RECAZ2 No, fine @SC94181 TM FL1,BINF Yes, make sure binary @SC94181 BZ RECRJD Oops, can't do it @SC94181 BAL 14,RDWSET Decide which kind of binary @SC94181 OI FILFLGS,APPN Yes, must append @SC94181 RECAZ2 TM RCAPA,X'18' Did other Kermit promise End att? @SC94181 BNO RECAZ3 No, already tested collision @SC94181 KCALL TCOLL,E=RECRJC Do it now @SC94181 RECAZ3 XC DATL,DATL @SC94181 CLI RECDISP,AR Recover? @SC94181 BNE RECAZ4 No, fine @SC94181 SR 4,4 Ok, get exact length of file @SC94181 OPENF T,FILNAM,E=RECBLCZ Does it exist? @SC94181 CLI TYPFIL,C'B' Ordinary binary? @SC94181 BE RECBLCA Yes, try shortcut @SC94181 MVC FDBSIZEB-FDBD(4,1),F0 No, can't trust n*lrecl @SC94181 RECBLCA ICM 4,15,FDBSIZEB-FDBD(1) Yes, get length, if poss. @SC94181 BNZ RECBLCZ Ok, got it @SC94181 OPENF I,FILNAM,FILFDB,FILPTR,E=RECBLCZ @SC94181 RECBLCL KCALL INBUF,E=RECBLCZ @SC94181 A 4,RBUFL (Doing it the hard way) @SC94181 B RECBLCL @SC94181 RECBLCZ CLOSF FILPTR Done, close file for input @SC94181 NI FL1,255-EOF Clear eof condition @SC94181 ST 4,RECBLEN Got total length @SC94181 LTR 4,4 Any? @SC94181 BZ RECAZ4 No, just process normally @SC94181 LA 0,512 @SC94181 ALR 0,4 Round to nearest K @SC94181 SRL 0,10 @SC94181 L 6,FILFSIZ Size of promised file @SC94181 SLR 6,0 Amount to be sent and appended @SC94181 BC 3,*+6 Ok @SC94181 SLR 6,6 All received already! @SC94181 ST 6,FILFSIZ Corrected size for space check @SC94181 L 6,ASDATA Output buffer @SC94181 MVI 0(6),A1 Byte-length attribute code @SC94181 LA 15,2(,6) @SC94181 BAL 2,EDDEC Format it (clobbers R8!) @SC94181 TR 2(9,6),ETOAD Convert plenty to ASCII @SC94181 SR 15,6 @SC94181 ST 15,DATL Length of data field @SC94181 LA 4,ABL-2(,15) Number of digits (printably) @SC94181 STC 4,1(,6) @SC94181 RECAZ4 DS 0H @SC94181 KCALL ACCTNM,FILNAM Insert revised name, if necessary @SC94181 OPENF O,FILNAM,FILFDB,FILPTR,E=RECRJA @SC94181 USING FDBD,1 @SC94181 MVC FSIZE,FABLRTR Copy LRECL from effective length @SC94181 MVC FRECF,FDBRCF Save info @SC94181 DROP 1 @SC94181 ICM 0,15,FILFSIZ Expected size, if known @SC94181 BZ RECAZ5 Not known, proceed @SC94181 OPENF S,FILNAM,FILFDB,FILPTR,E=RECRJLL Check disk spac@SC94181 XC FILFSIZ,FILFSIZ No need to repeat this test @SC94181 RECAZ5 DS 0H @SC94181 LA 8,RECANST Now accept D-packets @SC94181 ./ I 08027500 $ 8027550 50 06/28/94 18:25:34 RECRJD MVC REASON,RECDSPCD Because of disposition @SC94181 B RECRJC @SC94181 RECRJLL MVC REASON,RECLNCOD Because of length @SC94181 B RECRJC @SC94181 RECRJA MVI REASON,6 Because of "area" (couldn't open) @SC94181 B RECRJC @SC94181 ./ I 08034500 $ 8034700 200 06/30/94 17:17:14 LA 8,RECANST Accept A, D, or Z now @SC94181 ./ R 08036000 08036500 $ 8036000 200 06/30/94 16:32:21 B RECDAKL Acknowledge @SC94181 ./ I 08041500 $ 8041700 200 10/28/94 22:42:46 L 5,FILPTR @SC94181 ./ I 08042000 $ 8042100 100 10/28/94 22:42:46 LTR 5,5 Was the file actually open? @SC94181 BZ RECKEP No, don't worry about it @SC94181 ./ R 08058500 $ 8058500 70 09/21/94 15:17:19 BZ RECBRKA No, that's fine @SC94181 CLI REASON,STACNDAT Refused as duplicate (date)? @SC94181 BE RECBRKA Yes, not really an error @SC94181 CLI REASON,STACNDSC Refused as duplicate? @SC94181 BNE RECERP No, send an error packet @SC94181 RECBRKA DS 0H @SC94181 ./ R 08079000 $ 8079000 200 09/21/94 01:21:04 * DC XL1'FF',AL3(RECABR) Stop (same as unknown) @SC94181 ./ D 08081500 09/21/94 01:21:04 ./ R 08084000 $ 8084000 200 06/30/94 14:49:18 DC AL1(00),AL3(RECABR) Error return @SC94181 RECAST DC AL1(AA),AL3(RECCKA) Micro sent A-packet @SC94181 ./ I 08089500 $ 8089600 100 06/28/94 18:25:34 RECBLEN DS F Length of recovery file @SC94181 RECDISP DS X Requested disposition @SC94181 ./ I 08113500 $ 8113540 40 10/28/94 22:42:46 * * Copy file name from (R1) to current file table entry, if any @SC94181 ACCTNM ENTER ALT @SC94181 L 3,NSENT Number of current file @SC94181 C 3,NSENTAC Off the end? @SC94181 BNE RTRN0 Yes, quit now @SC94181 BCTR 3,0 Ok, get offset @SC94181 MH 3,FLFID1+2 Times length of items @SC94181 A 3,TSENT Loc in sent-table @SC94181 MVC ACTFID,0(1) Save filespec @SC94181 B RTRN0 @SC94181 ./ R 08985500 $ 8986000 500 06/29/94 20:43:04 TITLE 'TCOLL Routine - test for collision (RECEIV)' @SC94181 * Exit: R15=0 if ok (use name in FILNAM), else reject @SC94181 TCOLL ENTER , @SC94181 TM FILFLGS,APPN Appending to old file? @SC94181 BO RTRN0 Yes, just do it @SC94181 CLI CLSNFL,C'U' @SC94181 BE *+12 Update option overrides "warn" @SC94181 TM FL1,REN @SC94181 BZ RTRN0 No, just do it @SC94181 LA 0,FFNEW @SC86295 KCALL FSPEC,FILNAM,E=RTRN1 Check collisions @SC94181 TM FL4,NMCHNG @SC90033 BZ RTRN0 @SC90033 CLI CLSNFL,C'B' @SC90033 BNE TCLTSTD @SC90033 LA 2,FILNAM Must back up original file @SC90033 LA 0,15 Rename it to unique new name @SC90033 KCALL DISKIO,XFILE,E=RTRN1 Give up if rename fails @SC90264 CLI TRMLIN,C' ' Alt. line? @SC90033 BE TCLBZ No, be quiet @SC90033 INITSTR '&BACKDUP',CMD,REG=7 @SC92300 LA 1,FILNAM @SC90033 BAL 2,STAFSP Format backup name and show it @SC90033 TCLBZ MVC FILNAM,XFILE Now, just use intended name @SC90033 TCLMSG DS 0H @SC90033 CLI TRMLIN,C' ' Alt. line? @SC87300 BE RTRN0 No, be quiet @SC94181 INITSTR '&RECVDAS',CMD,REG=7 Yes, display message @SC92300 LA 1,FILNAM @SC87300 BAL 2,STAFSP Format name and show it @SC87300 B RTRN0 @SC94181 TCLTSTD CLI CLSNFL,C'D' @SC90033 BNE TCLTSTU See if UPDATE @SC94181 MVI REASON,STACNDSC Reason is collision (DISCARD) @SC94181 B RTRN1 @SC94181 TCLTSTU CLI CLSNFL,C'U' @SC94181 BNE TCLMSG Other case is just "rename" @SC94181 CLI FDATE,0 @SC94181 BE TCLOKU @SC94181 OPENF T,XFILE,E=TCLOKU Look at existing file @SC94181 USING FDBD,1 @SC94181 CLI FDBDATE,0 Is there a time tag? @SC94181 BE TCLOKU No, skip this test @SC94181 CLC FDATE,FDBDATE Is the incoming file newer? @SC94181 BH TCLOKU Yes, overwrite the file @SC94181 DROP 1 @SC94181 MVI REASON,STACNDAT No, reason is date @SC94181 B RTRN1 @SC94181 TCLOKU MVC FILNAM,XFILE Restore original name @SC94181 B RTRN0 @SC94181 LOCALS , @SC94181 EXIT , @SC94181 END KERMIT ./ * SC94245 - More accurate statistics after server transfers ./ R 02084000 $ 2084000 500 05/29/92 ->4.3<- LR 15,7 Get time supplied as "end" @SC94245 ./ I 07824500 $ 7824600 100 05/29/92 ->4.3<- KCALL SUPFNC,10 Get time of completion @SC94245 LR 7,15 Save for statistics @SC94245 ./ I 08060500 $ 8060700 200 05/29/92 ->4.3<- KCALL SUPFNC,10 Say completion time is now @SC94245 ST 15,RECTIMZ Save @SC94245 ./ R 08070000 $ 8070000 200 05/29/92 ->4.3<- RECERP KCALL SUPFNC,10 Say completion time is now @SC94245 ST 15,RECTIMZ Save @SC94245 KCALL ERPACK Send error packet @SC94245 ./ I 08070500 $ 8070700 200 05/29/92 ->4.3<- L 7,RECTIMZ @SC94245 ./ I 08089500 $ 8089550 50 05/29/92 ->4.3<- RECTIMZ DS F Ending time of transfer @SC94245 ./ * SC94262 - Leave room for table expansion (MUSIC) ./ R 01415400 $ 1415400 200 09/30/93 14:45:03 &KDATE SETC '94/09/20' @SC94262 ./ R 01513000 $ 1513000 100 09/20/94 17:56:54 L 3,PTATOED @SC94262 MVC ATOE,0(3) @SC94262 ./ R 01515000 $ 1515000 1000 09/20/94 17:56:54 MVC TATOE,0(3) @SC94262 ./ R 01893000 $ 1893000 300 09/20/94 17:56:54 L 4,PTATOED @SC94262 TR 0(LEMSG,1),0(4) Convert to EBCDIC @SC94262 ./ I 02453000 $ 2453200 200 09/20/94 17:56:54 PTATOED DC A(ATOED) Address of ASCII-to-EBCDIC def. @SC94262 ./ I 02519000 $ 2519500 500 09/20/94 17:56:54 DEFTBLS CSECT @SC94262 ./ I 02536000 $ 2536500 500 09/20/94 17:56:54 COMMON CSECT @SC94262 ./ R 03354000 $ 3354000 200 09/20/94 17:56:54 SETTAT2 L 2,PTATOED Address of original @SC94262 ./ R 03635000 $ 3635000 100 09/20/94 17:56:54 L 8,PTATOED @SC94262 TR TMP,0(8) Convert to EBCDIC @SC94262 ./ R 03840000 $ 3840000 200 09/20/94 17:56:54 GIVA1 L 0,PTATOED @SC94262 ./ I 05099000 $ 5099500 500 09/20/94 17:56:54 L 14,PTATOED @SC94262 ./ R 05102300 $ 5102300 100 09/20/94 17:56:54 FSPTRAE TR 0(,5),0(14) @SC94262 ./ R 07610500 $ 7610500 200 09/20/94 17:56:54 L 14,PTATOED Use default if "transparent" @SC94262 ./ R 07690000 $ 7690000 100 09/20/94 17:56:54 L 2,PTATOED @SC94262 TR 0(250,15),0(2) Back to EBCDIC @SC94262 ./ I 07757800 $ 7757810 10 09/20/94 17:56:54 L 4,PTATOED @SC94262 ./ R 07760700 $ 7760700 100 09/20/94 17:56:54 SNDTRAT TR 0(,6),0(4) Convert to EBCDIC for decoding @SC94262 ./ R 07859000 $ 7859000 100 09/20/94 17:56:54 L 14,PTATOED @SC94262 TR 0(256,1),0(14) Convert to std EBCDIC @SC94262 ./ I 07925500 $ 7925700 200 09/20/94 17:56:54 L 4,PTATOED @SC94262 ./ R 07973000 $ 7973000 100 09/20/94 17:56:54 L 14,PTATOED @SC94262 IC 4,0(4,14) Ok, set file type as well @SC94262 ./ I 07978500 $ 7978700 200 09/20/94 17:56:54 L 4,PTATOED @SC94262 ./ I 07984000 $ 7984200 200 09/20/94 17:56:54 L 4,PTATOED @SC94262 ./ R 07987500 $ 7987500 200 09/20/94 17:56:54 RECTRAT TR 0(,6),0(4) Convert to EBCDIC for decoding @SC94262 ./ R 08013000 $ 8013000 100 09/20/94 17:56:54 L 1,PTATOED @SC94262 TR 0(94,4),0(1) Convert to EBCDIC @SC94262 ./ R 08397000 $ 8397000 100 09/20/94 17:56:54 L 4,PTATOED @SC94262 TR 0(5,6),0(4) No, must be 5-byte ASCII prefix @SC94262 ./ R 08584000 $ 8584000 100 09/20/94 17:56:54 L 4,PTATOED @SC94262 TR STOPBUF,0(4) @SC94262 ./ * SC94264 - Avoid spurious error message for host commands (MUSIC) ./ R 01415400 $ 1415400 200 09/30/93 14:45:03 &KDATE SETC '94/09/30' @SC94264 ./ I 05293000 $ 5293200 200 10/12/94 14:05:00 FTOKN N=SFCHBAD Skip over leading blanks @SC94264 L 4,ADR Save adr of string @SC94264 L 5,LEN Save length of string @SC94264 ./ I 05295000 $ 5295050 50 10/12/94 14:05:00 LA 6,128+64+32 Flags for subshell @SC94264 TM SVCFLG,INTERCPT Intercepting messages? @SC94264 BZ *+8 Ok @SC94264 LA 6,128+64+32 No display (can't intercept) @SC94264 STM 5,6,SFCPRMS Save length and option codes @SC94264 CALL NXTCMD,((4),SFCPRMS,SFCPRMS+4),VL,MF=(E,PARMAREA) C94264 CALL GETRET,SFCPRMS,VL,MF=(E,PARMAREA) @SC94264 L 15,SFCPRMS @SC94264 CH 15,=H'1000' Code for non-existant cmd? @SC94264 BE RTRNM1 Yes @SC94264 B SFCRC @SC94264 SFCPRMS EQU PARMAREA+12 @SC94264 ./ I 05302000 $ 5302500 500 10/06/94 15:10:26 KW 'CD',SFCCWD @SC94264 ./ I 05304000 $ 5304100 100 10/06/94 15:10:26 SFCCWD FTOKN N=SFCPWD If no argument, just do current @SC94264 KCALL CWDSET Yes, try to set directory @SC94264 B SFCRC Report if failure @SC94264 SFCPWD LH 0,DESTL Length of string @SC94264 WTEXT UCODE,(0) Display it @SC94264 B RTRN0 @SC94264 ./ R 05306000 $ 5306000 300 09/23/94 20:08:36 LA 0,FFUTL+FFWLD Default to dir * @SC94264 B SFCUT0 @SC94264 ./ I 05315000 $ 5315500 500 09/23/94 20:08:36 SFCUT0 DS 0H @SC94264 ./ R 05328840 $ 5328840 20 09/22/94 15:23:46 SFCZRC LR 15,4 @SC94264 TM FL1,TSTF @SC94264 BO RTRN Retain any error code if testing @SC94264 ./ * SC94287 - Prevent or recover from lost screen (MUSIC) ./ I 01024000 $ 1024500 500 10/17/94 19:59:06 STMSAV DS F Saved message bit for user @SC94287 ./ R 01415400 $ 1415400 200 09/30/93 14:45:03 &KDATE SETC '94/10/17' @SC94287 ./ I 05458000 $ 5459000 300 10/17/94 19:47:07 CALL MSGBIT,(F0,F0,STMSAV),VL,MF=(E,PARMAREA) Msg flg@SC94287 CALL MSGBIT,(F1,F0,F1),VL,MF=(E,PARMAREA) Msg off @SC94287 ./ I 05466000 $ 5466500 500 10/17/94 19:47:07 CALL MSGBIT,(F1,F0,STMSAV),VL,MF=(E,PARMAREA) Restore@SC94287 ./ R 05687000 05688000 $ 5687000 1000 10/15/94 01:26:33 SCRCLRA MVC FSFSFG(2),=X'8460' Set up FSIO @SC94287 ./ I 05714500 $ 5714600 100 10/15/94 01:26:33 MVC SCRARGSV,ZFSARG @SC94287 LA 4,5 Max tries to recover screen @SC94287 SCRNEXLP DS 0H @SC94287 ./ R 05716200 $ 5716200 10 10/15/94 01:26:33 CLI SCRRC,11 Lost screen? @SC94287 BNE SCRRD2 No, rejoin @SC94287 TM SCRRC+1,X'40' Lost screen? @SC94287 BZ SCRRD2 No, rejoin @SC94287 BCT 4,SCRBRK Go recover unless retries exhaust @SC94287 B RTRN0 Error, say no data received @SC94287 SCRBRK XC ZFSARG(20),ZFSARG Clear FSIO Control Block @SC94287 MVC FSFSFG(2),=X'8460' Set up FSIO @SC94287 MVC CONSSAV,CONSOPR @SC94287 MVI CONSOPR,RTRYCOD-CONSOPRS @SC94287 BAL 9,SCRNEX Clear screan @SC94287 MVC FSFSFG(2),SCRFGS+4 Erase/write flags @SC94287 LA 0,LRTRYCM @SC94287 ST 0,FSFSWL Copy buffer length @SC94287 LA 0,RTRYCM Dummy write @SC94287 ST 0,FSFSWB Copy buffer address @SC94287 BAL 9,SCRNEX Erase/write to reset @SC94287 LA 1,RTRYCM @SC94287 LA 2,LRTRYCM @SC94287 BAL 7,SCRLOGD Log the dummy data @SC94287 MVC CONSOPR,CONSSAV Restore @SC94287 MVC ZFSARG(20),SCRARGSV @SC94287 B SCRNEXLP Try again @SC94287 ./ R 05730200 $ 5730200 100 10/15/94 01:26:33 LA 2,4 @SC94287 ./ I 05743600 $ 5743700 100 10/15/94 01:26:33 RTRYCOD DC C'b' For recovery @SC94287 RTRYCM DC &S1CMD @SC94287 LRTRYCM EQU *-RTRYCM @SC94287 ./ I 05744600 $ 5744700 100 10/15/94 01:26:33 SCRARGSV DS XL20 Saved I/O block @SC94287 CONSSAV DS XL1 Saved I/O operation @SC94287 ./ * SC94299 - Make GIVE CONTROL subcommand work (MUSIC) ./ R 00853000 00861000 $ 853000 1000 10/27/94 00:09:00 &LABEL READF &TICK,BUFFER=&BUFFER,BSIZE=&BSIZE,E=&E,CODE=10 @SC94299 ./ R 00865000 00866000 $ 865000 1000 10/27/94 00:09:00 &LABEL READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E=,&CODE=9 @SC94299 .* Read from disk file (or write) (see WRITF, but also...) @SC94299 ./ I 00867000 $ 867100 100 10/27/94 00:09:00 LCLC &R @SC86299 LCLA &C @SC88101 &C SETA &CODE @SC88101 AIF (T'&NONUM EQ 'O').RDC @SC88101 AIF ('&NONUM' NE 'NONUM').ER1 @SC88101 &C SETA 0 Code 0 means exclude sequence nos.@SC88101 .RDC ANOP @SC88101 ./ R 00870000 00871000 $ 870000 200 10/27/94 00:09:00 AIF ('&BUFFER'(1,1) NE '(').BLA @SC86299 &R SETC '&BUFFER(1)' @SC86299 AGO .BST @SC86299 .BLA LA 15,&BUFFER @SC86299 &R SETC '15' @SC86299 .BST ST &R,FDBBUFF-FABD(1) @SC86299 ./ R 00873000 00879000 $ 873000 1000 10/27/94 00:09:00 AIF ('&BSIZE'(1,1) NE '(').SLA @SC86299 &R SETC '&BSIZE(1)' @SC86299 AGO .SST @SC86299 .SLA LA 15,&BSIZE @SC86299 &R SETC '15' @SC86299 .SST ST &R,FDBBSIZ-FABD(1) @SC86299 .RGO LA 0,&C @SC88101 ./ R 01415400 $ 1415400 200 10/26/94 14:45:03 &KDATE SETC '94/10/30' @SC94299 ./ * SC95023 - Fix RESEND for already-sent file, implement APC subcmd. ./ R 01415400 $ 1415400 200 01/23/95 11:12:19 &KDATE SETC '95/01/23' @SC95023 ./ I 01422200 $ 1422300 100 01/23/95 11:12:19 AESC EQU 27 ASCII ESC @SC95023 ./ I 01424000 $ 1424100 100 01/23/95 11:12:19 ABSL EQU 92 ASCII backslash @SC95023 ./ I 03028500 $ 3028700 200 01/23/95 11:12:19 KW 'APC',USNAPC,MIN=3 @SC95023 ./ I 03103000 $ 3103030 30 01/23/95 11:12:19 * USNAPC L 5,ADR Pointer to rest of line @SC95023 ICM 4,15,LEN Remaining data length @SC95023 BNP KRMXPEH Go if nothing specified @SC95023 L 3,RBUF @SC95023 ICM 0,2,ATOE+AESC Get special wrapper for APC @SC95023 ICM 0,1,ATOE+AUND Must use current EBCDIC codes @SC95023 STCM 0,3,0(3) @SC95023 MVC 2(256,3),0(5) Copy to disk read buffer @SC95023 AR 4,3 Get end @SC95023 ICM 0,1,ATOE+ABSL Closing wrapper @SC95023 STCM 0,3,2(4) @SC95023 LA 4,4(4) Account for wrapper @SC95023 B USNAPC1 @SC95023 ./ D 03105200 01/23/95 11:12:19 ./ I 03106500 $ 3106700 200 01/23/95 11:12:19 USNAPC1 MVI USNCOD,0 No special disposition @SC95023 ./ R 07765100 $ 7765100 50 01/23/95 19:14:24 LTR 5,5 Any? @SC95023 ./ R 07765200 $ 7765200 50 01/23/95 19:14:24 SNDRECL KCALL INBUF,E=SNDEND @SC95023 ./ R 07765300 $ 7765300 50 01/23/95 19:14:24 BH SNDRECL Keep skipping @SC95023 ./ * SC95032 - Allow Recovery into almost-full file system ./ R 01415400 $ 1415400 200 02/01/95 12:29:03 &KDATE SETC '95/02/01' @SC95032 ./ I 07986000 $ 7986080 80 02/01/95 16:54:31 TM RCAPA,X'18' Attributes, including End? @SC95032 BNO RECAL3 No, do space test now @SC95032 TM ATFL4,ATFEND Will I honor the End attribute? @SC95032 BO RECCKL Yes, defer space test @SC95032 RECAL3 DS 0H @SC95032 ./ * SC95033 - Update to level 4.3.1 ./ R 01415400 01415600 $ 1415400 200 02/02/95 12:29:03 &KDATE SETC '95/02/02' @SC95033 &KEDIT SETC '1' @SC95033 ./ * SC95059 - Preserve transmitted time tag for RESENT file ./ I 08026040 $ 8026050 10 02/28/95 19:49:43 MVC RECBDAT,FDATE Save date for output file @SC95059 ./ I 08026280 $ 8026290 10 02/28/95 19:49:43 MVC FDATE,RECBDAT Restore date for output file @SC95059 ./ I 08089600 $ 8089650 50 02/28/95 19:49:43 RECBDAT DS XL7 Saved date for output file @SC95059 ./ * SC95108 - Prevent error-free transfers from halting TAKE files ./ I 02116000 $ 2116500 500 04/18/95 18:47:43 * Set CC according to R15. @SC95108 ./ R 02120000 $ 2120490 490 04/18/95 18:47:43 ICM 15,1,ERRNUM Return status code @SC95108 ./ * SC95174 - Implement REGET subcommand ./ R 01413700 $ 1413700 40 06/23/95 21:21:34 GBLC &AAARSND,&AUPDATE,&AAARGET @SC95174 ./ I 01460400 $ 1460450 50 06/23/95 21:21:34 &AAARGET SETC 'REGET' cmd, m=3 @SC95174 ./ R 03030500 $ 3030500 200 06/23/95 21:13:35 KW '&AAAAGET',KRMGET,R @SC95174 ./ I 03032000 $ 3032200 200 06/23/95 21:13:35 KW '&AAARGET',KRMGET,J,MIN=3 @SC95174 ./ R 03034700 $ 3034700 40 06/23/95 21:13:35 DC X'0' Normal type has no disp code @SC95174 ./ R 03052500 $ 3052500 100 06/23/95 21:13:35 KRMGET MVC USNCOD,KWCODE(1) Save send command abbrev @SC95174 PTEXT '&FORFSPC - ',AREG=1,LREG=0 @SC95174 ./ R 03065000 $ 3065000 100 06/23/95 21:13:35 MVC STYPE,USNCOD Type = receive initiate (R/J) @SC95174 TR STYPE,ETOAD @SC95174 ./ I 07508500 $ 7508700 200 06/23/95 21:13:35 DC AL1(AJ),AL3(SRVSND) Micro wants to get a file @SC95174 ./ R 07530500 $ 7530500 100 06/23/95 21:13:35 SR 1,1 Normal send is code 0 @SC95174 CLI RTYPE,AJ Is it a REGET? @SC95174 BNE *+8 @SC95174 LA 1,AR Yes, use the RESEND code @SC95174 KCALL SEND @SC95174 ./ * SC96122 - Avoid endless double transmission from windowed Kermit ./ R 01917400 01917800 $ 1917400 100 05/02/96 20:09:53 BNE SENDRTA No, resend whatever it was @SC96122 CLI DATLSN,0 "plain" only if no data @SC96122 BNE SENDRTA No, resend whatever it was @SC96122 CLC RSN,SSN Yes, did we rereceive the prev? @SC96122 BNE SENDNAK No, must be bad packet, send NAK @SC96122 SENDRTA DS 0H @SC96122 ./ I 02619000 $ 2619100 100 05/02/96 20:09:53 SSN DS X Last sent pkt number @SC96122 ./ I 08473000 $ 8473200 200 05/02/96 20:09:53 MVC SSN,SEQ Save an extra copy @SC96122 ./ * SC96151 - Add system ID to INIT packets ./ R 08234300 $ 8234250 50 05/31/96 22:26:14 MVC 18(LSYSATR-1,9),SYSATR+1 Copy system ID @SC96151 LA 0,18+LSYSATR-1 Size of data including ID @SC96151 ./ * SC96158 - Never skip sending an I-packet while in remote mode ./ I 01934000 $ 1934300 300 06/06/96 23:14:40 CLI TRMLIN,C' ' Alt. line? @SC96158 BE IPKGO No, send I-packet regardless @SC96158 ./ I 01936000 $ 1936500 500 06/06/96 23:14:40 IPKGO DS 0H @SC96158 ./ * SC97028 - Clear 'Kermit command error' condition correctly ./ I 02279000 $ 2279500 500 01/28/97 20:49:24 LUPWRT WTEXT (3),(4) @SC97028 ./ R 02288000 $ 2288000 500 01/28/97 20:49:24 WTEXT (3),(4) @SC97028 ./ * SC97164 - Update to level 4.3.2 ./ R 01415400 01415600 $ 1415400 200 06/13/97 12:29:03 &KDATE SETC '97/06/13' @SC97164 &KEDIT SETC '2' @SC97164 ./ * End of updates