$SET INSTALLATION 1-500 00100000037 $VERSION 1.040 % [DS] 02-89 00101000040 $SET ASCII % BURROUGHS USES 8 BITS FOR ASCII 00102000 BEGIN 00103000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01000000 % 01001000 % K E R M I T File Transfer Utility 01002000 % 01003000 % Burroughs 7800, University of California at Davis, 1986 01004000 % Larry Johnson, Dave Squire, Katie Stevens 01005000 % 01006000 % 01007000 %%%%% REVISIONS 01008000 % 1.017 [KS] 1-86 01170000 % ENABLED REPEAT PROCESSING 01171000 % ELIMINATE BLANK RECORD ADDED TO END OF RCV FILES 01172000 % 1.018 [KS] 3-86 01180000 % FIXED PACKET # BUG CAUSED BY DUP VARIABLE NAMES 01181000 % 1.019 [KS] 4-86 01190000 % FIXED RE-TRY BUG IN SENDSW/SBREAK 01191000 % OVERHAULED HELP PROCEDURES 01192000 % ENABLED 8-TH BIT QUOTING 01193000 % ENABLED VARIABLE START-OF-PACKET CHAR 01194000 % FIXED SERVER-SPAR RETRY BUG IN RECSW/RFILE 01195000 % 1.020 [KS] 7-86 01200000 % FIXED EXTRA CHARS WITH RETRY IN RECSW/RDATA 01201000 % 1.021 [KS] 5-87 01210000 % FIXED BUG WHEN LAST CHAR IN PKT IS A REPT CHAR 01211000 % FIXED BUG WHEN CONSECUTIVE BLANK LINES SET OFF REPT 01212000 % COUNT PROCESSING 01213000 % 1.022 [KS] 5-87 01220000 % FIXED GETFILETITLE TO STRIP (USERCODE) PREFIXES 01221000 % 1.023 [DS] 11-87 01230000 % CHANGED PROMPTS,GET MACHINE FROM TIME(24) 01231000 % 1.024 [DS] 09-88 0124000001.040.024 % FIRST STEP OF A GENERAL UPGRADE OF KERMIT 0124100001.040.024 % RPACK AND SPACK REWRITTEN TO IMPROVE 0124200001.040.024 % EFFICIENCY AND REDUCE INIT-PBIT'S. 0124300001.040.024 % FIX BUG IN RINIT THAT PREVENTED MULTIPLE 0124400001.040.024 % RECEIVES. 0124500001.040.024 % 1.025 [DS] 10-88 0125000001.040.025 % MAKE SPAR AND RPAR EASIER TO UNDERSTAND AND 0125100001.040.025 % EASIER TO MODIFY 0125200001.040.025 % 1.026 [DS] 11-88 0126000001.040.026 % MINOR CHANGE TO REDUCE INIT-PBITS. 0126100001.040.026 % ALSO FIX SEG ARRAY ERROR IN SCANIT 0126200001.040.026 % 1.027 [DS] 11-88 0127000001.040.027 % ADD BLOCK CHECK TYPES 2 AND 3. 0127100001.040.027 % 1.028 [DS] 11-88 0128000001.040.028 % FIX MESSAGE AND BUG OUTPUT ROUTINES. 0128100001.040.028 % 1.029 [DS] 11-88 0129000001.040.029 % IMPLEMENT OPTIONAL LONG PACKETS. 0129100001.040.029 % 1.030 [DS] 11-88 0130000001.040.030 % IMPLEMENTING THE TAKE COMMAND, AND KERMIT 0130100001.040.030 % INIT FILE 0130200001.040.030 % 1.031 [DS] 11-88 0131000001.040.031 % CHANGE THE PARAMETER TO HELPER TO AN ARRAY. 0131100001.040.031 % THIS IS REALLY A MATTER OF AESTHETICS. 0131200001.040.031 % 1.032 [DS] 11-88 0132000001.040.032 % CHANGE SEND AND PROCESSIT SO THAT WE CAN SEND 0132100001.040.032 % SEVERAL FILES WITH 1 SEND COMMAND. GETFILETITLE 0132200001.040.032 % SAVES THE EXTRA TITLES AND ANOTHERFILETITLE 0132300001.040.032 % RETRIEVES THEM. 0132400001.040.032 % 1.033 [DS] 11-88 0133000001.040.033 % CHANGE TO SEND. PACKETS THAT NEED TO BE RESENT 0133100001.040.033 % WILL BE RESENT RATHER THAT RECONSTRUCTED. SEND'S 0133200001.040.033 % MAINLINE WILL BE USED ONLY TO CHANGE STATES. 0133300001.040.033 % 1.034 [DS] 11-88 0134000001.040.034 % REWRITING GETC AND BUFILL TO IMPROVE EFFICIENCY. 0134100001.040.034 % GETC IS NOW CALLED GETCHARS. 0134200001.040.034 % 1.035 [DS] 11-88 0135000001.040.035 % REWRITING BUFEMP AND PUTC TO BE MORE EFFICIENT. 0135100001.040.035 % ADDING PUTCHARS. 0135200001.040.035 % 1.036 [DS] 12-88 0136000001.040.036 % CONVERT ALL DATA TO/FROM KERMIT PACKET FORM, NOT 0136100001.040.036 % JUST DATA FOR 'D' PACKETS. 0136200001.040.036 % 1.037 [DS] 12-88 0137000001.040.037 % FIX TO RFILE TO ALLOW USERS TO SPECIFY UNISYS 0137100001.040.037 % STYLE FILENAME FOR FILE RECEIVED. 0137200001.040.037 % 1.038 [DS] 12-88 0138000001.040.038 % ALLOW USE OF ACTUAL FILE TITLE IN SENDS RATHER 0138100001.040.038 % THAN TRYING TO MAKE AN MS-DOS TITLE. ALLOWS 0138200001.040.038 % ATTEMPTED USE OF ACTUAL TITLE IN RECEIVES RATHER 0138300001.040.038 % THAN TRYING TO MAKE A UNISYS TITLE. 01384000 % 1.039 [DS] 02-89 0139000001.040.039 % IT SEEMS THAT UNPACKDATA/BUFEMP DIDN'T HANDLE 0139100001.040.039 % NULLS CORRECTLY. IN FACT IT WAS RATHER UGLY. 0139200001.040.039 % THIS PATCH FIXES THE PROBLEM. 0139300001.040.039 % 1.040 [DS] 02-89 0140000001.040.040 % SENDING RAW REQUIRED SET FILE FIXED. THIS SEEMS 0140100001.040.040 % A LITTLE UNWEILDY, SO IT HAS BEEN CHANGED. 0140200001.040.040 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01990000 01991000 % SYMBOL DEFINITIONS 02000000 02001000 DEFINE ABSOLUTEMAXPACKSIZE=3018#,%SYSTEM LIMITATION 0200200001.040.029 MAXPACKSIZ = 2000#, % SITE DEPENDENT 0200210001.040.029 SHORTPACKSIZ = 94#, % IF THE OTHER SIDE CANT DO LONG PACKETS0200220001.040.029 DEFLONGPACKSIZ = 500#, % IF LONG PACKETS OK BUT NO LENGTH 0200230001.040.029 MAXPACKWDS = (ABSOLUTEMAXPACKSIZE DIV 6)#, 0200300001.040.029 MAXSENDFILESIZ = 11#, % LARGEST FILE NAME I SHOULD SEND 02004000 MAXREPT = 94#, % LARGEST REPEAT COUNT (126-32) 02005000 EOF = 4"201"#,% EOF FOR BUFILL 02006000 NULC = 48"00"#,% ASCII NULL CHARACTER 02007000 DEFSOH = 1#, % [1.019] START OF HEADER 02008000 % SOHC = 48"01"#,% SOH CHARACTER 02009000 ETXC = 48"03"#,% ETX CHARACTER 02010000 BEL = 7#, % ASCII BELL 02011000 HT = 9#, % ASCII HORIZONTAL TAB 02012000 LF = 10#, % ASCII LINE FEED 02013000 NL = LF#, % NEWLINE CHARACTER 02014000 CR = 13#, % ASCII CARRIAGE RETURN 02015000 SP = 32#, % ASCII SPACE 02016000 DEL = 127#, % ASCII DELETE (RUBOUT) 02017000 02018000 REPTTHRESH = 3#, % CHARACTER REPEAT THRESHOLD 0201900001.040.034 DEFINITRETRY = 20#, % TIMES TO RETRY INITIALIZATION 02020000 DEFPACKETRETRY = 10#, % TIMES TO RETRY A PACKET 02021000 TABLEN = 8#, % LENGTH OF A TAB IF EXPANDED 02022000 DEFRECSIZE = 15#, % MAXRECSIZE IN WORDS OF RECEIVED FILE 02023000 DEFBLOCKSIZE = 420#, % BLOCKSIZE IN WORDS OF RECEIVED FILE 02024000 DEFUNITS = VALUE(WORDS)#, % UNITS OF RECEIVED FILE 02025000 DEFPAD = 0#, % DEFAULT # OF PADDING CHARACTERS 02026000 DEFPCHAR = 0#, % DEFAULT PADDING CHARACTER 02027000 DEFEOL = CR#, % DEFAULT END OF LINE CHAR FOR BURROUGHS02028000 DEFQUOTE = "#"#, % DEFAULT QUOTE CHARACTER 02029000 DEFQBIN = "&"#, % DEFAULT BINARY QUOTE CHARACTER 02030000 DEFREPT = "~"#, % DEFAULT REPEAT CHARACTER 02032000 DEFPAUSE = 0#, % DEFAULT PAUSE BEFORE ACK 02033000 DEFDELAY = 5#, % DEFAULT DELAY FOR FIRST SEND 02034000 DEFESCCHR = "^"#, % DEFAULT ESCAPE CHARACTER FOR CONNECT 02035000 DEFTIME = 5#, % DEFAULT TIMEOUT INTERVAL 02036000 MAXTIM = 60#, % MAXIMUM TIMEOUT INTERVAL 02037000 MINTIM = 2# % MINUMUM TIMEOUT INTERVAL 0203800001.040.027 ,CSTYPE1 = 1# 0203900001.040.027 ,CSTYPE2 = 2# 0204000001.040.027 ,CSTYPE3 = 3# 0204100001.040.027 ,DEFCHKTYPE = CSTYPE1#% DEFAULT CHECKSUM TYPE 0204200001.040.027 ,DEFWINDOWS = 0# % DEFAULT WINDOW SIZE (FOR NOW) 0204300001.040.029 ; 0207900001.040.027 02080000 % MACRO DEFINITIONS 02081000 02082000 % 02083000 % TOCHAR: CONVERTS A CONTROL CHARACTER TO A PRINTABLE ONE BY ADDING A S02084000 % 02085000 % UNCHAR: UNDOES TOCHAR. 02086000 % 02087000 % CTL: CONVERTS BETWEEN CONTROL CHARACTERS AND PRINTABLE CHARACTERS 02088000 % TOGGLING THE CONTROL BIT (IE. ^A BECOMES A AND A BECOMES ^A). 02089000 02090000 DEFINE TOCHAR(CH) = ((CH) + 32) #; 02091000 DEFINE UNCHAR(CH) = ((CH) - 32) #; 02092000 DEFINE CTL(CH) = ((CH) & (1-(CH).[6:1])[6:1]) #; 02093000 DEFINE TONUM (CH) = ((CH) + "0") #; 0209400001.040.027 DEFINE UNNUM (CH) = ((CH) - "0") #; 0209500001.040.027 0209600001.040.027 % GLOBAL VARIABLES 02100000 02101000 REAL 02102000 BSIZE, % SIZE OF PRESENT DATA 02103000 RPSIZ, % MAXIMUM RECEIVE PACKET SIZE 02104000 SPSIZ, % MAXIMUM SEND PACKET SIZE 02105000 TIMINT, % TIMEOUT FOR FOREIGN HOST ON SENDS 02106000 PAD, % HOW MUCH PADDING TO SEND 02107000 PCHAR, % PADDING CHARACTER TO SEND 02108000 EOL, % END-OF-LINE CHARACTER TO SEND 02109000 SOHCHAR, % [1.019] START-OF-PACKET CHAR TO SEND 02110000 QUOTE, % QUOTE CHARACTER IN INCOMING DATA 02111000 QBIN, % BINARY QUOTE CHARACTER IN INCOMING DATA 02112000 CHKTYPE, % ERROR DETECTION TYPE IN INCOMING DATA 02113000 REPT, % REPEAT CHARACTER IN INCOMING DATA 02114000 N, % PACKET NUMBER 02115000 NUMTRY, % TIMES THIS PACKET RETRIED 02116000 OLDTRY % TIMES PREVIOUS PACKET RETRIED 0211700001.040.027 ,THECHKTYPE % THE CHECKSUM AGREED UPON FOR FILE TRASFER 0211800001.040.027 ,MSGLEN % NUMBER OF BYTES IN LAST PACKET SENT 0211900001.040.033 ; 0214900001.040.033 BOOLEAN 02200000 SERVER, % MEANS WE'RE A KERMIT SERVER 02201000 BINARYON, % [1.019] MEANS 8-BIT QUOTING MODE ENABLED 02202000 HIBITOK, % MEANS 8-BIT MODE IN ACTION 02203000 REPTOK, % [1.017] TRUE MEANS REPEAT ENCRIPTION OK 02205000 DEBUG, % INDICATES LEVEL OF DEBUGGING OUTPUT (0=NONE) 02206000 EXPTABS, % EXPAND TABS ON INPUT 02207000 FIXEDRECS, % SEND FIXEDRECS LENGTH RECORDS 02208000 RAW, % DONT USE NL AS RECORD SEPARATOR 02209000 KEEPFILE % KEEP THE OUTPUT FILE 0221000001.040.029 ,LONGPACKETSOK % TRANSMIT LONG PACKETS 0221100001.040.029 ,WINDOWING % DO WINDOWING 0221200001.040.029 ,TAKING % CURRENT COMMAND IS FROM A DISK FILE 0221300001.040.030 ,SENDACTUALTITLE % DON'T CONVERT TITLE SENT TO MS-DOS FORM 0221400001.040.038 ,RECACTUALTITLE % DON'T CONVERT TITLE REC'D TO UNISYS FORM 0221500001.040.038 ; 0224900001.040.029 REAL 02300000 INITRETRY, % NUMBER OF RETRIES ON INITIALIZATION 02301000 PACKETRETRY, % NUMBER OF RETRIES FOR A DATA PACKET 02302000 FILERECSIZE, % MAXRECSIZE OF RECEIVED FILE 02303000 FILEBLOCKSIZE, % BLOCKSIZE OF RECEIVED FILE 02304000 FILEUNITS, % UNITS OF RECEIVED FILE 02305000 FILECOUNT, % NUMBER OF FILES LEFT TO SEND 02306000 STATE, % PRESENT STATE OF THE AUTOMATON 02307000 MYPACKSIZ, % MY MAXIMUM PACKET SIZE 02308000 MYTIME, % MY TIMEOUT INTERVAL 02309000 MYPAD, % MY NUMBER OF PADDING CHARACTERS 02310000 MYPCHAR, % MY PADDING CHARACTER 02311000 MYEOL, % MY END OF LINE CHARACTER 02312000 MYSOH, % [1.019] MY START-OF-PACKET CHAR 02313000 MYQUOTE, % MY QUOTE CHARACTER 02314000 MYQBIN, % MY BINARY QUOTE CHARACTER 02315000 MYCHKTYPE, % MY CHECKSUM TYPE 02316000 MYREPT, % MY REPEAT CHARACTER 02317000 MYPAUSE, % MY PAUSE AFTER ACK TIME 02318000 MYDELAY, % MY DELAY FOR FIRST SEND TIME 02319000 MYESCCHR % MY ESCAPE CHARACTER FROM CONNECT 0232000001.040.029 ,MYWINDOWSIZE % THE WINDOW SIZE I WANT TO USE 0232100001.040.029 ,WINDOWSIZE % THE WINDOW SIZE WE AGREE TO USE 0232200001.040.029 ; 0234900001.040.029 ARRAY 02400000 FILNAM[0:MAXPACKWDS] % TITLE OF CURRENT DISK FILE 0240100001.040.026 ,AC[0:3] % SCRATCH BUFFER FOR SCANNERS 0240200001.040.026 ,FILNAM1[0:MAXPACKWDS] % EBCDIC FILE TITLE 0240300001.040.030 ; 0240900001.040.026 POINTER 02500000 PFILNAM; % POINTER TO FILNAM 02501000 02502000 ARRAY 02600000 RECPKT[0:MAXPACKWDS],% RECEIVE PACKET BUFFER 02601000 PACKET[0:MAXPACKWDS];% PACKET BUFFER 02602000 02603000 FILE 02700000 REM % FILE FOR REMOTE INPUT / OUTPUT 02701000 (KIND=REMOTE,MYUSE=IO,UNITS=CHARACTERS,BUFFERS=1, 02702000 MAXRECSIZE=ABSOLUTEMAXPACKSIZE,FILETYPE=3), 0270300001.040.029 LOG % FILE POINTER FOR LOGFILE 02704000 (KIND=DISK,UNITS=CHARACTERS,MAXRECSIZE=96,BLOCKSIZE=2880, 02705000 PROTECTION=SAVE,NEWFILE,SAVEFACTOR=1,BUFFERS=1, 02706000 TITLE=8"KERMIT/LOG."); 02707000 FILE KERMITINI; % FOR FILE-EQUATING FILENAME, IF DESIRED 0270800001.040.030 TRANSLATETABLE TOUPPER( ASCII TO ASCII, 02800000 "abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 02801000 TOLOWER( ASCII TO ASCII, 02802000 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO "abcdefghijklmnopqrstuvwxyz"), 02803000 TOBURROUGHS( ASCII TO ".", 02804000 "abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 02805000 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 02806000 "0123456789" TO "0123456789" ); 02807000 TRANSLATETABLE ASCTOEBC( 02808000 47"000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F" 02809000 TO 48"00010203372D2E2F1605250B0C0D0E0F101112133C3D322618193F271C1D1E1F" 02810000 ,47"202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F" 02811000 TO 48"404F7F7B5B6C507D4D5D5C4E6B604B61F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F" 02812000 ,47"404142434445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F" 02813000 TO 48"7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8D9E2E3E4E5E6E7E8E94AE05A5F6D" 02814000 ,47"606162636465666768696A6B6C6D6E6F707172737475767778797A7B7C7D7E7F" 02815000 TO 48"79818283848586878889919293949596979899A2A3A4A5A6A7A8A9C06AD0A107" 02816000 ); 02817000 TRANSLATETABLE FIXSLASHES( ASCII TO ASCII , "/" TO "_" ); 02818000 TRUTHSET NUMBERS( "0" OR "1" OR "2" OR "3" OR "4" OR 03000000 "5" OR "6" OR "7" OR "8" OR "9"); 03001000 TRUTHSET QUOTECHARS( "!" OR 48"7F" OR "#" OR "$" OR "%" OR "&" 03002000 OR "'" OR "(" OR ")" OR "*" OR "+" OR "," OR "-" OR "." 03003000 OR "/" OR "0" OR NUMBERS OR ":" OR ";" OR "<" OR "=" OR ">" 03004000 OR "`" OR "{" OR "|" OR "}" OR "~" ); 03005000 ARRAY ACNTRL[0:15], % TRUTHSET FOR ALL CONTROL CHARS 03100000 BCNTRL[0:15]; % TRUTHSET FOR JUST QUOTE,QBIN,REPT 03101000 % 4"0000FFFFFFFF", % ADD IN FROM 0 THRU 31 03102000 % 0,0, % LEAVE OUT 32 THRU 95 03103000 % 4"000000000001", % ADD IN BIT FOR 127 03104000 % 0,0,0,0 % ZERO OUT END (MAY NEED FOR EBCDIC) 03105000 % TABLE ALGORITHM: 03106000 % BOOLEAN(TABLE[CHAR.[7:3]].[(31-CHAR.[4:5]):1]) => IN TABLE 03107000 % 03108000 DEFINE TABLEIT(TAB,C) = TAB[C.[7:3]].[(31-C.[4:5]):1] := 1#, 03109000 UNTABLE(TAB,C) = TAB[C.[7:3]].[(31-C.[4:5]):1] := 0#; 03110000 03111000 ARRAY FBUF_[0:29], % USED BY FPRINT 03200000 EBUF_[0:15], % USED BY ERROR 03201000 TBUF_[0:15], % TEMPORARY BUFFER FOR DIGITS CONVERSION 03202000 GBUF_[0:99], % USED BY GETC 03203000 PBUF_[0:99]; % USED BY PUTC 03204000 POINTER PG_, % POINTS TO GBUF_ 03300000 PP_ % POINTS TO PBUF_ 0330100001.040.028 ,PF_ % POINTS TO FBUF_ 0330200001.040.028 ,PT_ % POINTS TO TBUF_ 0330300001.040.028 ; 0330900001.040.028 REAL RD, % RESULT DESCRIPTOR FOR EVERYBODY 03400000 GCNT_, % NUMBER OF CHARACTERS IN GBUF_ 03401000 PCNT_, % NUMBER OF CHARACTERS IN PBUF_ 03402000 RECSIZ_, % MAXRECSIZE OF FP 03403000 UNITS_, % CHARACTERS PER "UNIT" OF FP 03404000 HUH_ % SILLY LITTLE FILLER 0340500001.040.030 ,PROMPTLENGTH % LENGTH OF INTERACTIVE PROMPT 0340600001.040.030 ,PROMPTOFFSET % USED FOR ERROR MESSAGE ALIGNMENT 0340700001.040.030 ,NEXTSENDL % KEEPS TRACK OF LENGTH OF NEXTSEND 0340800001.040.032 ; 0344900001.040.030 BOOLEAN BRD = RD; % BOOLEAN RD 03500000 DEFINE % SOME BURROUGHS FIELD DEFINES 03501000 LENGTHF = [47:20]#, % CHAR. COUNT RETURNED FROM RESLT. DESCR. 03502000 EOFBIT = [ 9: 1]#, % EOF ON I/O FROM RESLT. DESCR. 03503000 BRKBIT = [13: 1]#, % BREAK ON I/O FROM RESLT. DESCR. 03504000 TIMEOUTBIT = [15: 1]#, % TIMEOUT ON I/O FROM RESLT. DESCR. 03505000 ERRORF = [16:17]#, % THE WHOLE ERROR FIELD 03506000 MOD64 = .[5:6]#; % N MOD 64 == N.[5:6] 03507000 03508000 DEFINE 03600000 INDENT = TRUE#, % BOOLEAN CONSTANTS 03601000 NOINDENT = FALSE#; 03602000 03603000 ARRAY NULLDATA[0:0]; 03700000 03701000 DEFINE SENDIT = 0380000001.040.028 BEGIN 0380100001.040.028 IF SERVER THEN 0380200001.040.028 ERROR(FBUF_) 0380300001.040.028 ELSE 0380400001.040.028 BRD := WRITE(REM,OFFSET(PF_),FBUF_[*]); 0380500001.040.028 REPLACE FBUF_ BY " " FOR 16 WORDS; 0380600001.040.028 END# 0380700001.040.028 ,FORM (STR) = 0381000001.040.028 BEGIN 0381100001.040.028 REPLACE PF_:POINTER(FBUF_) BY STR; 0381200001.040.028 END# 0381300001.040.028 ,FORM1 (STR,NUMBER) = 0382000001.040.028 BEGIN 0382100001.040.028 REPLACE PT_:TBUF_ BY 8"-" FOR REAL(NUMBER LSS 0), 0382200001.040.028 NUMBER FOR * DIGITS; 0382300001.040.028 REPLACE PF_:POINTER(FBUF_) BY STR,TBUF_ FOR OFFSET(PT_) 0382400001.040.028 WITH EBCDICTOASCII; 0382500001.040.028 END# 0382600001.040.028 ,APPEND (STR) = 0383000001.040.028 BEGIN 0383100001.040.028 REPLACE PF_:PF_ BY STR; 0383200001.040.028 END# 0383300001.040.028 ,APPEND1(STR,NUMBER) = 0384000001.040.028 BEGIN 0384100001.040.028 REPLACE PT_:TBUF_ BY 8"-" FOR REAL(NUMBER LSS 0), 0384200001.040.028 NUMBER FOR * DIGITS; 0384300001.040.028 REPLACE PF_:PF_ BY STR,TBUF_ FOR OFFSET(PT_) 0384400001.040.028 WITH EBCDICTOASCII; 0384500001.040.028 END# 0384600001.040.028 ; 0385000001.040.028 DEFINE CH(NUMBER,N) = (NUMBER).[ 7:48] FOR N#,% TO USE NUMBER AS A CHAR04000000 SAY(STR) = 04100000 BEGIN 04101000 FORM(STR); 0410200001.040.028 SENDIT; 0410300001.040.028 END#, 04108000 SAY1(STR,NUMBER)= 04200000 BEGIN 04201000 FORM1(STR,NUMBER); 0420200001.040.028 SENDIT; 0420300001.040.028 END#, 04211000 SAYC(STR,NUMBER)= 04300000 BEGIN 04301000 IF TBUF_[0] := NUMBER LSS SP THEN 04302000 REPLACE PF_:POINTER(FBUF_) BY STR, 0430300001.040.028 "CTRL-",CH(NUMBER+64,1), 0430310001.040.028 " (HEX ",POINTER(TBUF_,4)+10 FOR 2 WITH HEXTOASCII,")" 0430400001.040.028 ELSE 04305000 REPLACE PF_:POINTER(FBUF_) BY STR, CH(NUMBER,1), " (HEX ", 0430600001.040.028 POINTER(TBUF_,4)+10 FOR 2 WITH HEXTOASCII,")"; 0430700001.040.028 SENDIT; 0430800001.040.028 END#, 04313000 SAYN(STR,PTR) = 04400000 BEGIN 04401000 FORM(STR); 0440200001.040.028 APPEND(PTR FOR (96 - OFFSET(PF_)) UNTIL = NULC); 0440300001.040.028 SENDIT; 0440400001.040.028 END#, 04409000 SAYP(PTR,WHITESPACE) = 04500000 BEGIN 04501000 IF WHITESPACE THEN 04502000 REPLACE PF_:POINTER(FBUF_) BY " ", 0450300001.040.028 PTR FOR (96-3) WHILE GEQ " " 0450400001.040.028 ELSE 04505000 REPLACE PF_:POINTER(FBUF_) BY PTR FOR 96 WHILE GEQ " "; 0450600001.040.028 SENDIT; 0450700001.040.028 END#, 04512000 04513000 SAYQ(STR) = 04600000 BEGIN 04601000 REPLACE PF_:POINTER(FBUF_) BY 0460200001.040.028 " " FOR COL_BASE + PROMPTOFFSET - COL_OK_TIL, 0460210001.040.030 "?"; 04603000 BRD := WRITE(REM,OFFSET(PF_),FBUF_[*]); 0460400001.040.028 REPLACE FBUF_ BY " " FOR 16 WORDS; 04605000 REPLACE PF_:POINTER(FBUF_) BY " missing or invalid ", 0460600001.040.028 STR, 04607000 " parameter"; 04608000 BRD := WRITE(REM,OFFSET(PF_),FBUF_[*]); 0460900001.040.028 REPLACE FBUF_ BY " " FOR 16 WORDS; 04610000 END#, 04611000 04612000 SAYQOPT(STR) = 04700000 BEGIN 04701000 COL_OK_TIL := COL_BASE + PROMPTOFFSET - COL_OK_TIL; 0470200001.040.030 REPLACE PF_:POINTER(FBUF_) BY " " FOR COL_OK_TIL, 0470300001.040.028 "?"; 04704000 BRD := WRITE(REM,OFFSET(PF_),FBUF_[*]); 0470500001.040.028 REPLACE FBUF_ BY " " FOR 16 WORDS; 04706000 REPLACE PF_:POINTER(FBUF_) BY " missing or invalid ", 0470700001.040.028 STR, 04708000 " parameter - options are:"; 04709000 BRD := WRITE(REM,OFFSET(PF_),FBUF_[*]); 0471000001.040.028 REPLACE FBUF_ BY " " FOR 16 WORDS; 04711000 END#, 04712000 04713000 04800000 BUG(STR) = 04801000 BEGIN 04802000 FORM(STR); 0480300001.040.028 BRD := WRITE(LOG,96,FBUF_[*]); 04804000 REPLACE FBUF_ BY " " FOR 16 WORDS; 04805000 END#, 04806000 BUG1(STR,NUMBER)= 04900000 BEGIN 04901000 FORM1(STR,NUMBER); 0490200001.040.028 BRD := WRITE(LOG,96,FBUF_[*]); 04906000 REPLACE FBUF_ BY " " FOR 16 WORDS; 04907000 END#, 04908000 BUGH(STR,NUMBER)= 05000000 BEGIN 05001000 TBUF_[0] := NUMBER; 05002000 REPLACE PF_:POINTER(FBUF_) BY STR, 0500300001.040.028 POINTER(TBUF_,4) FOR 12 WITH HEXTOASCII; 05004000 BRD := WRITE(LOG,96,FBUF_[*]); 05005000 REPLACE FBUF_ BY " " FOR 16 WORDS; 05006000 END#, 05007000 BUGC(STR,NUMBER)= 05100000 BEGIN 05101000 IF TBUF_[0] := NUMBER LSS SP THEN 05102000 REPLACE PF_:POINTER(FBUF_) BY STR, 0510300001.040.028 "CTRL-",CH(NUMBER+64,1), 0510310001.040.028 " (HEX ",POINTER(TBUF_,4)+10 FOR 2 WITH HEXTOASCII,")" 0510320001.040.028 ELSE 05104000 REPLACE PF_:POINTER(FBUF_) BY STR, " ",CH(NUMBER,1), 0510500001.040.028 " (HEX ",POINTER(TBUF_,4)+10 FOR 2 WITH HEXTOASCII,")"; 0510510001.040.028 BRD := WRITE(LOG,96,FBUF_[*]); 05106000 REPLACE FBUF_ BY " " FOR 16 WORDS; 05107000 END#, 05108000 BUGN(STR,PTR) = 05200000 BEGIN 05201000 FORM(STR); 0520200001.040.028 APPEND(PTR FOR (96 - OFFSET(PF_)) UNTIL = NULC); 0520300001.040.028 BRD := WRITE(LOG,96,FBUF_[*]); 05204000 REPLACE FBUF_ BY " " FOR 16 WORDS; 05205000 END#, 05206000 BUGP(PTR) = 05300000 BEGIN 05301000 FORM(PTR FOR 96 UNTIL = NULC); 0530200001.040.028 BRD := WRITE(LOG,96,FBUF_[*]); 05303000 REPLACE FBUF_ BY " " FOR 16 WORDS; 05304000 END#; 05305000 05306000 % 05400000 % E R R O R 05401000 % 05402000 % PRINT ERROR MESSAGE. 05403000 % 05404000 % IF LOCAL, PRINT ERROR MESSAGE WITH PRINTMSG. 05405000 % IF REMOTE, SEND AN ERROR PACKET WITH THE MESSAGE. 05406000 % 05407000 DEFINE ERROR(ARA) = 05408000 BEGIN 05409000 REPLACE EBUF_ BY ARA FOR HUH_:(96 - 5) WHILE GEQ " "; 0541000001.040.028 HUH_ := (96 - 5) - HUH_; 0541100001.040.028 REPLACE FBUF_ BY " " FOR 16 WORDS; %SO DEBUGGING IN SPACK IS OK05412000 SPACK("E",N:=(N+1) MOD64,HUH_,EBUF_); 05413000 REPLACE EBUF_ BY " " FOR 16 WORDS; 05414000 END#; 05415000 TRANSLATETABLE STRIP_PARITY ( 0550000001.040.024 ASCII TO ASCII 0550100001.040.024 ,47"808182838485868788898A8B8C8D8E8F" TO 0550200001.040.024 47"000102030405060708090A0B0C0D0E0F" 0550300001.040.024 ,47"909192939495969798999A9B9C9D9E9F" TO 0550400001.040.024 47"101112131415161718191A1B1C1D1E1F" 0550500001.040.024 ,47"A0A1A2A3A4A5A6A7A8A9AAABACADAEAF" TO 0550600001.040.024 47"202122232425262728292A2B2C2D2E2F" 0550700001.040.024 ,47"B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF" TO 0550800001.040.024 47"303132333435363738393A3B3C3D3E3F" 0550900001.040.024 ,47"C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF" TO 0551000001.040.024 47"404142434445464748494A4B4C4D4E4F" 0551100001.040.024 ,47"D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF" TO 0551200001.040.024 47"505152535455565758595A5B5C5D5E5F" 0551300001.040.024 ,47"E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF" TO 0551400001.040.024 47"606162636465666768696A6B6C6D6E6F" 0551500001.040.024 ,47"F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF" TO 0551600001.040.024 47"707172737475767778797A7B7C7D7E7F" 0551700001.040.024 ); 0551800001.040.024 ARRAY SBUFFER,RBUFFER[0:(MAXPACKWDS - 1)]; 0551900001.040.029 POINTER SPB,SPC,RPB,RPC,RPD; 0552000001.040.024 REAL CHKSUM; 0552100001.040.024 DEFINE PACKETMOD = 95#; 0552500001.040.024 DEFINE RESERVEDBIT5 = 5# 0552700001.040.029 ,RESERVEDBIT4 = 4# 0552800001.040.029 ,APACKETBIT = 3# 0552900001.040.029 ,WINDOWSBIT = 2# 0553000001.040.029 ,LONGPACKETBIT= 1# 0553100001.040.029 ,MORECAPASBIT = 0# 0553200001.040.029 ; 0553300001.040.029 POINTER CP; % CHAR POINTER 06000000 REAL COL; % COLUMN COUNTER FOR SCANNER 06001000 REAL COL_BASE; % BEGINNING COLUMN COUNT FOR SCANNER 06002000 REAL COL_OK_TIL; % COLUMN COUNTER FOR PREVIOUS SCAN 06003000 ARRAY NEXTSEND[0:MAXPACKWDS]; % NEXT FILE(S) TO SEND 06004000 BOOLEAN MORETOSEND; % SOMETHING IN NEXTSEND 06005000 EBCDIC ARRAY MACHINE[0:5]; % WHAT MACHINE (B7800, A10) [1.023] 06006000 ARRAY KPROMPT[0:15]; % THE KERMIT PROMPT 06007000 ARRAY REFERENCE SPECARA[0]; % CURRENT COMMAND ARRAY 06008000 INTEGER MACHINENAMEL; % LENGTH OF MACHINE NAME [1.023] 06009000 06010000 VALUE ARRAY SPECIAL( % ALL THE COMMANDS 07000000 48"01" "? " , % ? FOR HELP 07001000 48"04" "EXIT " , 07002000 48"04" "HELP " , 07003000 48"04" "QUIT " , 07004000 48"07" "RECEIVE " , 07005000 48"04" "SEND " , 07006000 48"06" "SERVER " , 07007000 48"03" "SET " , 07008000 48"04" "SHOW " , 07009000 48"06" "STATUS " , 07010000 48"04" "TAKE ", 0701100001.040.030 0); 0702900001.040.030 0703000001.040.030 % DEFINES FOR COMMANDS 07050000 07051000 DEFINE 07052000 QMARKV = 0#, 07053000 EXITV = 1#, 07054000 HELPV = 2#, 07055000 QUITV = 3#, 07056000 RECEIVEV = 4#, 07057000 SENDV = 6#, 07058000 SERVERV = 7#, 07059000 SETV = 9#, 07060000 SHOWV = 10#, 07061000 STATUSV = 11#, 07062000 TAKEV = 13#, 0706300001.040.030 QUESTIONV = -98#, 0709000001.040.030 INVALIDV = -99#, 0709100001.040.030 NOERRORV = 101#; 0709200001.040.030 0709300001.040.030 VALUE ARRAY SPECSET( % ALL THE SPECIAL 'SET' COMMANDS 07100000 48"01" "? " , 07101000 48"09" "DEBUGGING " , 07102000 48"05" "DELAY" , 07103000 48"04" "FILE " , 07104000 48"0A" "INCOMPLETE " , 07105000 48"05" "RETRY" , 07106000 48"07" "RECEIVE " , 07107000 48"04" "SEND " , 07108000 48"06" "BINARY " , 07109000 48"0B" "BLOCK-CHECK", 0711000001.040.027 07111000 0); 0712900001.040.027 0713000001.040.027 % DEFINES FOR SET COMMAND 07150000 07151000 DEFINE 07152000 % QMARKV = 0#, 07153000 DEBUGV = 1#, 07154000 DELAYV = 3#, 07155000 FILEV = 4#, 07156000 INCOMPLETEV = 5#, 07157000 RETRYV = 7#, 07158000 SETRECEIVEV = 8#, 07159000 SETSENDV = 10#, 07160000 BINARYV = 11# 0716100001.040.027 ,CHECKSUMTYPEV = 13# 0716200001.040.027 ; 0718900001.040.027 VALUE ARRAY SPECFILE( % FOR SET FILE COMMANDS 07200000 48"01" "? " , 07201000 48"0A" "BLOCK-SIZE " , 07202000 48"0B" "EXPAND-TABS" , 07203000 48"05" "FIXED" , 07204000 48"03" "RAW " , 07205000 48"0B" "RECORD-SIZE" , 07206000 48"05" "UNITS" , 07207000 0); 07208000 07209000 % DEFINES FOR SET FILE COMMANDS 07250000 DEFINE 07251000 % QMARK = 0#, 07252000 BLOCKSIZEV = 1#, 07253000 EXPTABSV = 3#, 07254000 FIXEDV = 5#, 07255000 RAWV = 6#, 07256000 RECORDSIZEV = 7#, 07257000 UNITSV = 9#; 07258000 07259000 VALUE ARRAY SPECABORT( % FOR SET ABORTED-FILE 07300000 48"01" "? " , 07301000 48"07" "DISCARD " , 07302000 48"04" "KEEP " , 07303000 0); 07304000 07305000 % DEFINES FOR SPECABORT 07350000 07351000 DEFINE 07352000 % QMARKV = 0#, 07353000 DISCARDV = 1#, 07354000 KEEPV = 3#; 07355000 07356000 VALUE ARRAY SPECDEBUG( % FOR SET DEBUGGING 07400000 48"01" "? " , 07401000 48"06" "STATES " , 07402000 48"07" "PACKETS " , 07403000 48"08" "LOG-FILE " , 07404000 48"03" "OFF ", 07405000 0); 07406000 07407000 % DEFINES FOR SPECDEBUG 07450000 07451000 DEFINE 07452000 % QMARKV = 0#, 07453000 STATESV = 1#, 07454000 PACKETSV = 3#, 07455000 LOGFILEV = 5#, 07456000 DOFFV = 7#; 07457000 07458000 VALUE ARRAY SPECRETRY( % FOR SET RETRY 07500000 48"01" "? " , 07501000 48"12" "INITIAL-CONNECTION " , 07502000 48"07" "PACKETS " , 07503000 0); 07504000 07505000 % DEFINES FOR SPECRETRY 07550000 07551000 DEFINE 07552000 % QMARKV = 0#, 07553000 INITCONNV = 1#, 07554000 RETRYPACKETSV = 5#; 07555000 07556000 VALUE ARRAY SPECONOFF( % FOR ON/OFF 07600000 48"01" "? " , 07601000 48"02" "ON " , 07602000 48"03" "OFF " , 07603000 0); 07604000 07605000 % DEFINES FOR SPECONOFF 07650000 07651000 DEFINE 07652000 % QMARKV = 0#, 07653000 ONV = 1#, 07654000 OFFV = 2#; 07655000 07656000 VALUE ARRAY SPECRECEIVE( % FOR SET RECEIVE, SET SEND 07700000 48"01" "? " , 07701000 48"0B" "END-OF-LINE" , 07702000 48"0D" "PACKET-LENGTH " , 07703000 48"07" "PADDING " , 07704000 48"07" "PADCHAR " , 07705000 48"05" "PAUSE" , 07706000 48"05" "QUOTE" , 07707000 48"0F" "START-OF-PACKET " , 07708000 48"07" "TIMEOUT " , 07709000 48"0C" "ACTUAL-TITLE ", 0771000001.040.038 07711000 0); 0774800001.040.038 0774900001.040.038 % DEFINES FOR SPECRECEIVE 07750000 07751000 DEFINE 07752000 % QMARKV = 0#, 07753000 EOLV = 1#, 07754000 LENV = 3#, 07755000 PADV = 6#, 07756000 PCHARV = 8#, 07757000 PAUSEV = 10#, 07758000 QUOTEV = 11#, 07759000 STARTOFPACKV = 12#, 07760000 TIMEOUTV = 15# 0776100001.040.038 ,ACTUALTITLEV = 17# 0776200001.040.038 ; 0779800001.040.038 0779900001.040.038 VALUE ARRAY SPECUNITS( % FOR SET RECEIVE UNITS 07800000 48"01" "? ", 07801000 48"05" "WORDS", 07802000 48"0A" "CHARACTERS ", 07803000 0); 07804000 07805000 % DEFINES FOR SPECUNITS 07850000 07851000 DEFINE 07852000 % QMARKV = 0#, 07853000 UWORDSV = 1#, 07854000 UCHARACTERSV = 2#; 07855000 07856000 VALUE ARRAY SPECSHOW( % FOR SHOW SEND/RECEIVE 07900000 48"04" "SEND " , 07901000 0); 07902000 07903000 DEFINE 07950000 SHOSENDV = 0#; 07951000 07952000 07953000 09000000 VALUE ARRAY PLAINHELP( % GLOBAL HELP STUFF 09001000 48"0D" "EXIT to CANDE ", 09002000 48"1B" "HELP by giving this message ", 09003000 48"10" "QUIT (like EXIT) ", 09004000 48"16" "RECEIVE file from host ", 09005000 48"11" "SEND file to host", 09006000 48"20" "SERVER make me a Kermit Server ", 09007000 48"0F" "SET a parameter ", 09008000 48"0D" "SHOW settings ", 09009000 48"12" "STATUS (like SHOW) ", 09010000 48"1E" "TAKE commands from a disk file ", 0901100001.040.030 0), 0904900001.040.030 SETHELP( % SET HELP STUFF 09050000 48"20" " BINARY (do 8th bit transfers) " , 09051000 48"13" " BLOCK-CHECK type " , 0905150001.040.027 48"19" " DEBUGGING level option ", 09052000 48"1F" " DELAY seconds for first SEND ", 09053000 48"11" " FILE parameter" , 09054000 48"19" " INCOMPLETE disposition " , 09055000 48"0E" " RETRY count ", 09056000 48"14" " RECEIVE parameter ", 09057000 48"11" " SEND parameter", 09058000 0), 09059000 SETFILEHELP( % SET FILE HELP STUFF 09100000 48"14" " BLOCK-SIZE length ", 09101000 48"17" " EXPAND-TABS on input", 09102000 48"32" " FIXED (send blanks found at the end of records)" , 09103000 48"2A" " RAW (without any line delimiting chars) ", 09104000 48"15" " RECORD-SIZE length ", 09105000 48"1E" " UNITS (words or characters) ", 09106000 0), 09107000 SENDHELP( % SET RECEIVE/SEND HELP 09150000 48"1C" " END-OF-LINE (number 0-31) ", 09151000 48"17" " PACKET-LENGTH length", 09152000 48"20" " PADDING (number of PADCHARS) ", 09153000 48"19" " PADCHAR (number 0-31) ", 09154000 48"1B" " PAUSE seconds before ACK ", 09155000 48"12" " QUOTE character ", 09156000 48"20" " START-OF-PACKET (number 0-31) " , 09157000 48"15" " TIMEOUT in seconds ", 09158000 0), 09159000 UNITSHELP( % SET RECEIVE UNITS HELP 09200000 48"08" " WORDS ", 09201000 48"0D" " CHARACTERS ", 09202000 0), 09203000 ABORTHELP( % SET ABORTED-FILE HELP 09250000 48"1C" " DISCARD the file on abort ", 09251000 48"19" " KEEP the file on abort ", 09252000 0), 09253000 DEBUGHELP( % SET DEBUGGING HELP 09300000 48"1E" " STATES - flag state changes ", 09301000 48"19" " PACKETS- flag all data ", 09302000 48"20" " LOG-FILE changes log filename ", 09303000 48"1E" " OFF - turn off all flags ", 09304000 0), 09305000 RETRYHELP( % SET RETRY HELP 09350000 48"1C" " INITIAL-CONNECTION count ", 09351000 48"11" " PACKETS count", 09352000 0), 09353000 ONOFFHELP( % ONLY ON OR OFF 09400000 48"05" " ON", 09401000 48"06" " OFF ", 09402000 0), 09403000 LONUMBERHELP( % ONLY NUMBERS ALLOWED 09450000 48"24" " must be an integer from 0 thru 31 ", 09451000 0), 09452000 QUOTEHELP( % ONLY 32 < N < 127 09500000 48"2B" " must be an ASCII character from ! thru ~ ", 09501000 48"2E" " (HEX 21 thru 7E) ", 09502000 0), 09503000 NUMBERHELP( % ANY NUMBERS ALLOWED 09550000 48"21" " can be any decimal digit > 0 ", 09551000 0) 0955200001.040.027 ,CHKTYPEHELP( % NUMBERS 1 THRU 3 ONLY 0960000001.040.027 48"23" " must be an integer from 1 thru 3", 0960100001.040.027 0) 0960200001.040.027 ,TAKEHELP( % A FILENAME 0965000001.040.030 48"1C" " must be a valid file name ", 0965100001.040.030 0) 0965200001.040.030 ; 0989900001.040.030 BOOLEAN PROCEDURE SENDSW; FORWARD; 10000000 BOOLEAN PROCEDURE RECSW(ISTATE); % [1.017] 10001000 REAL ISTATE; FORWARD; % [1.017] 10002000 PROCEDURE SPACK(TYPE,NUM,LEN,DATA); 10003000 VALUE TYPE,NUM,LEN; 10004000 REAL TYPE; 10005000 REAL NUM,LEN; 10006000 ARRAY DATA[0]; FORWARD; 10007000 REAL PROCEDURE RPACK(LEN,NUM,DATA); 10008000 REAL LEN,NUM; 10009000 ARRAY DATA[0]; FORWARD; 10010000 REAL PROCEDURE BUFILL(FID,BUFFER); 10011000 FILE FID; 10012000 ARRAY BUFFER[0]; FORWARD; 10013000 PROCEDURE BUFEMP(FID,BUFFER,LEN); 10014000 VALUE LEN; 10015000 REAL LEN; 10016000 FILE FID; 10017000 ARRAY BUFFER[0]; FORWARD; 10018000 PROCEDURE SPAR(LEN,DATA,FIRSTCALL); 1001900001.040.025 VALUE FIRSTCALL; 1001910001.040.025 BOOLEAN FIRSTCALL; 1001920001.040.025 REAL LEN; 1002000001.040.025 ARRAY DATA[0]; FORWARD; 1002100001.040.025 PROCEDURE RPAR(LEN,DATA,FIRSTCALL); 1002200001.040.025 VALUE FIRSTCALL; 1002210001.040.025 BOOLEAN FIRSTCALL; 1002220001.040.025 REAL LEN; 1002300001.040.025 ARRAY DATA[0]; FORWARD; 1002400001.040.025 PROCEDURE FLUSHINPUT; FORWARD; 10025000 PROCEDURE PRERRPKT(MSG); 10026000 ARRAY MSG[0]; FORWARD; 10027000 REAL PROCEDURE CHECKSUM(PB,LEN,TYPE); 1002800001.040.024 VALUE PB,LEN,TYPE; 1002900001.040.024 POINTER PB; 1003000001.040.024 INTEGER LEN,TYPE; 1003100001.040.024 FORWARD; 1003200001.040.024 PROCEDURE TAKER(INITIALIZED); 1003300001.040.030 VALUE INITIALIZED; 1003400001.040.030 BOOLEAN INITIALIZED; 1003500001.040.030 FORWARD; 1003600001.040.030 BOOLEAN PROCEDURE PROCESSIT; FORWARD; 1003700001.040.030 INTEGER PROCEDURE MAKEPACKETDATA(SPTR,SCOUNT,DPTR,SPACEAVAILABLE); 1003800001.040.036 VALUE SPTR,SCOUNT,DPTR,SPACEAVAILABLE; 1003900001.040.036 POINTER SPTR,DPTR; 1004000001.040.036 INTEGER SCOUNT,SPACEAVAILABLE; 1004100001.040.036 FORWARD; 1004200001.040.036 INTEGER PROCEDURE GETPACKETDATA(SPTR,SCOUNT,DPTR,DCOUNT); 1004300001.040.036 VALUE SPTR,SCOUNT,DPTR,DCOUNT; 1004400001.040.036 POINTER SPTR,DPTR; 1004500001.040.036 INTEGER SCOUNT,DCOUNT; 1004600001.040.036 FORWARD; 1004700001.040.036 BOOLEAN PROCEDURE COBBLE(FILENAME,LEN); 1005300001.040.037 VALUE LEN; 1005400001.040.037 ARRAY FILENAME[0]; 1005500001.040.037 INTEGER LEN; 1005600001.040.037 FORWARD; 1005700001.040.037 11000000 % 11001000 % A B O R T R U N 11002000 % 11003000 % SENDS AN ERROR PACKET AND ABORTS 11004000 % 11005000 PROCEDURE ABORTRUN; 11006000 BEGIN 11007000 REPLACE TBUF_[0] BY COL FOR * DIGITS," "; 11008000 REPLACE EBUF_ BY "KERMIT ABORTING DUE TO FAULT # ", 11009000 TBUF_ FOR 2 WITH EBCDICTOASCII," @ ", 11010000 KPROMPT FOR 50 WITH EBCDICTOASCII; 11011000 SPACK("E",( N := *+1 ) MOD64, MAXPACKSIZ-5,EBUF_); 11012000 IF NOT SERVER THEN 11013000 SAYP(EBUF_,NOINDENT); 11014000 IF (MYSELF.OPTION).[VALUE(FAULT) : 1]=1 THEN 11015000 PROGRAMDUMP(ARRAYS,FILES); 11016000 WHEN(10); 11017000 MYSELF.STATUS := VALUE(TERMINATED); 11018000 END ABORTRUN; 11019000 12000000 % 12001000 % I N I T I A L I Z E 12002000 % 12003000 % INITIALIZE SETS UP INITIAL VALUES 12004000 % 12005000 PROCEDURE INITIALIZE; 12006000 BEGIN 12007000 ARRAY GREETING[0:13]; 12008000 EBCDIC ARRAY VERSION[0:7]; 12009000 12010000 REPLACE MACHINE BY TIME(24); % [1.023] 12011000 SCAN MACHINE FOR MACHINENAMEL:6 UNTIL = 8" "; % [1.023] 12012000 MACHINENAMEL := 6 - MACHINENAMEL; % [1.023] 12013000 REPLACE VERSION BY COMPILETIME(20) FOR 1 DIGITS,8".", 12014000 COMPILETIME(21) FOR 3 DIGITS; 12015000 REPLACE GREETING BY "UCD A-SERIES KERMIT-", % [1.023] 12016000 MACHINE FOR MACHINENAMEL WITH EBCDICTOASCII, % [1.023] 12017000 " - VERSION ",VERSION FOR 5 WITH EBCDICTOASCII,NULC; 12018000 REPLACE FBUF_ BY " " FOR 30 WORDS; 12019000 REPLACE EBUF_ BY " " FOR 16 WORDS; 12020000 SAYP(GREETING,NOINDENT); 12021000 PROMPTOFFSET := PROMPTLENGTH := 8 + MACHINENAMEL; 1202110001.040.030 REPLACE KPROMPT BY "KERMIT-",MACHINE FOR MACHINENAMEL % [1.023] 12022000 WITH EBCDICTOASCII," "; % [1.023] 12023000 12024000 % INITIALIZE THESE VALUES AND HOPE THE FIRST PACKET WILL GET ACROSS OK 12025000 12026000 EOL := CR; % EOL FOR OUTGOING PACKETS 12027000 SOHCHAR := DEFSOH; % SOH FOR OUTGOING PACKETS 12028000 QUOTE := "#"; % STANDARD CONTROL-QUOTE CHAR "#" 12029000 PAD := 0; % NO PADDING 12030000 PCHAR := NULC; % USE NULC IF ANY PADDING WANTED 12031000 QBIN := "N"; % DEFAULT TO NO BINARY QUOTING 12032000 REPT := DEFREPT; % [1.021] DEFAULT TO TILDE 12033000 CHKTYPE := DEFCHKTYPE; % DEFAULT 1203400001.040.027 MYPACKSIZ := SHORTPACKSIZ; % SET MINE TO DEFAULTS 1203500001.040.029 INITRETRY := DEFINITRETRY; % INITIALIZE RETRIES 12036000 PACKETRETRY:= DEFPACKETRETRY; 12037000 FILERECSIZE:= DEFRECSIZE; 12038000 FILEBLOCKSIZE:= DEFBLOCKSIZE; 12039000 FILEUNITS := DEFUNITS; 12040000 MYTIME := DEFTIME; 12041000 MYPAD := DEFPAD; 12042000 MYPCHAR := DEFPCHAR; 12043000 MYEOL := DEFEOL; 12044000 MYSOH := DEFSOH; % [1.019] 12045000 MYQUOTE := DEFQUOTE; 12046000 MYQBIN := DEFQBIN; % [1.019] 12047000 MYCHKTYPE := DEFCHKTYPE; 12048000 MYREPT := DEFREPT; 12049000 MYPAUSE := DEFPAUSE; % SECONDS ( INPUT IS IN 10THS ) 12050000 MYDELAY := DEFDELAY; 12051000 MYESCCHR := DEFESCCHR; 12052000 MYCHKTYPE := DEFCHKTYPE; 1205300001.040.027 FIXEDRECS := FALSE; % DEFAULT 12054000 EXPTABS := TRUE; % DEFAULT -> EXPAND THEM 12055000 HIBITOK := FALSE; % [1.017] 8-BIT ONLY WHEN REQUESTED 12056000 BINARYON := FALSE; % [1.019] CHANGED BY SET BINARY CMD 12057000 REPTOK := TRUE; % [1.021] ENABLE REPEAT PROCESSING 12058000 KEEPFILE := TRUE; % DEFAULT TO KEEP ALL FILES MADE 12059000 RAW := FALSE; % USE CR FOR END-OF-LINE 12060000 % INITIALIZE ACNTRL TABLE 12061000 REPLACE ACNTRL BY 48"0000FFFFFFFF",0,0,48"000000000001",0,0,0,0; 12062000 REPLACE BCNTRL BY 0 FOR 8 WORDS; 12063000 12064000 THECHKTYPE := DEFCHKTYPE; 1206500001.040.027 MYWINDOWSIZE := DEFWINDOWS; 1206600001.040.029 WINDOWSIZE := DEFWINDOWS; 1206700001.040.029 PFILNAM := POINTER(FILNAM); 1206900001.040.030 REPLACE CP:POINTER(PACKET) BY KERMITINI.FILENAME; 1207000001.040.030 COL := OFFSET(CP) - 1; 1207100001.040.030 REPLACE PACKET BY CP:=POINTER(PACKET) FOR COL WITH EBCDICTOASCII; 1207200001.040.030 TAKER(FALSE); 1207300001.040.030 END INITIALIZE; 12099000 13000000 % 13001000 % S C A N I T 13002000 % 13003000 % SCANS INPUT AND PUTS ITEMS INTO ARRAY AC IN KUNKER-FORM. PLACES 13004000 % ITEM LENGTH INTO LEN AND RETURNS THE ITEM'S INDEX IN THE SPECIAL 13005000 % ARRAY. 13006000 % 13007000 13008000 REAL PROCEDURE SCANIT; 13009000 BEGIN 13010000 REAL I,J,SAVEJ,CNT; 13012000 13013000 SCANIT := -1; 13014000 COL_OK_TIL := COL - 1; 1301500001.040.030 SCAN CP:CP FOR COL:COL UNTIL GTR " "; 13016000 IF COL GTR 0 THEN 13017000 BEGIN 13018000 COL_OK_TIL := COL; 1301810001.040.030 SCAN CP FOR I:COL WHILE GTR " "; 1301900001.040.026 IF (I := COL - I) LEQ 23 THEN 1301910001.040.026 BEGIN 1301920001.040.026 IF CP + (I - 1) = "?" THEN 1302000001.040.026 IF I GTR 1 THEN 13021000 I := *-1; 13022000 REPLACE POINTER(AC) BY I.[7:48] FOR 1, 1302300001.040.026 CP FOR I, 0 FOR (23-I); 1302400001.040.026 J := SIZE(SPECARA); 13025000 SAVEJ := CNT := -1; 13026000 WHILE J:=*-1 GEQ 0 DO 13027000 IF J := MASKSEARCH(AC[0], 13028000 40"E0" & REAL(NOT FALSE)[39:MIN(40,I*8)],SPECARA[J])13029000 GEQ 0 THEN 13030000 IF CP = POINTER(SPECARA[J])+1 FOR I THEN 13031000 TBUF_[CNT:=*+1] := SAVEJ := J; 13032000 IF (CNT:=*+1 GTR 1) OR (CP+I = "?") THEN 13034000 BEGIN 13035000 IF CP+I NEQ "?" THEN 13036000 SAY(" ambiguous command, please supply more characters"); 13037000 SAY(" possible commands:"); 13038000 WHILE CNT GTR 0 DO 13039000 IF SAVEJ := TBUF_[CNT := *-1] GTR 0 THEN 13040000 SAYP(POINTER(SPECARA[SAVEJ])+1,INDENT); 13041000 SCANIT := NOERRORV; 13042000 END 13043000 ELSE 13044000 SCANIT := SAVEJ; 13045000 CP := *+I; 13046000 COL := *-I; 13047000 END; 1304790001.040.026 END; 13048000 END SCANIT; 13049000 14000000 % 14001000 % S C A N U M 14002000 % 14003000 REAL PROCEDURE SCANUM; 14004000 BEGIN 14005000 REAL I,J,SAVEJ,CNT; 14007000 14008000 SCANUM := INVALIDV; 14009000 COL_OK_TIL := COL - 1; 1401000001.040.030 SCAN CP:CP FOR COL:COL UNTIL GTR " "; 14011000 IF COL GTR 0 THEN 14012000 BEGIN 1401210001.040.030 COL_OK_TIL := COL; 1401220001.040.030 IF CP IN NUMBERS THEN 14013000 BEGIN 14014000 SCAN CP FOR I:COL WHILE IN NUMBERS; 14015000 IF I := COL-I LSS 12 THEN 14016000 BEGIN 14017000 REPLACE AC BY CP FOR I WITH ASCIITOEBCDIC; 14018000 SCANUM := INTEGER(AC,I); 14019000 END 14020000 ELSE 14021000 SCANUM := INVALIDV; 14022000 END 14023000 ELSE 14024000 IF CP = "?" THEN 14025000 SCANUM := QUESTIONV; 14026000 END; 1402610001.040.030 END OF PROCEDURE SCANUM; 14027000 % 15000000 % H E L P E R 15001000 % 15002000 % DOES ALL THE HELP STUFF FROM ? OR HELP INPUT 15003000 % 15004000 15005000 $BEGINSEGMENT 15006000 15007000 PROCEDURE HELPER(HELPARA); 1500800001.040.031 ARRAY HELPARA[0]; 1500900001.040.031 BEGIN 15011000 POINTER P; 15013000 REAL LENGTH; 15014000 P := POINTER(HELPARA); 15083000 WHILE LENGTH := REAL(P,1) GTR 0 DO 15084000 BEGIN 15085000 BRD := WRITE(REM,LENGTH,P+1); 15086000 P := *+(((LENGTH + 6) DIV 6) *6); 15087000 END; 15088000 END HELPER; 15090000 15091000 % 1600000001.040.030 % O P E N I N P U T 1600100001.040.030 % 1600200001.040.030 % OPEN A DISK FILE FOR INPUT 1600300001.040.030 % 1600400001.040.030 BOOLEAN PROCEDURE OPENINPUT(FP,LEN); 1600500001.040.030 FILE FP; 1600600001.040.030 INTEGER LEN; 1600700001.040.030 BEGIN 1600800001.040.030 IF FP.OPEN THEN 1600900001.040.030 CLOSE (FP); 1601000001.040.030 FP(KIND=DISK,FILETYPE=8, % CURRENT DISK FILE 1601100001.040.030 INTMODE=ASCII, % SO CHECKSUM, ETC, WILL WORK 1601200001.040.030 TRANSLATE=FORCESOFT,INPUTTABLE=EBCDICTOASCII, 1601300001.040.030 MYUSE=IN); 1601400001.040.030 SCAN PFILNAM FOR LEN:MAXPACKSIZ UNTIL = NULC; 1601500001.040.030 LEN := MAXPACKSIZ - LEN; % LENGTH OF A-SERIES TITLE 1601600001.040.030 REPLACE FILNAM1 BY PFILNAM FOR LEN WITH ASCIITOEBCDIC; 1601700001.040.030 REPLACE FP.TITLE BY FILNAM1; % GIVE IT THE NEW NAME 1601800001.040.030 IF 1601900001.040.030 (IF FP.ATTERR THEN 1602000001.040.030 TRUE 1602100001.040.030 ELSE 1602200001.040.030 (NOT FP.PRESENT)) THEN % FILE ISN'T THERE 1602300001.040.030 BEGIN 1602400001.040.030 OPENINPUT := TRUE; 1602500001.040.030 END 1602600001.040.030 ELSE 1602700001.040.030 BEGIN 1602800001.040.030 IF FP.EXTMODE = VALUE(EBCDIC) THEN % DEFAULT IS TO TRANSLATE IT... 1602900001.040.030 BEGIN 1603000001.040.030 CLOSE(FP); 1603100001.040.030 FP.EXTMODE := VALUE(EBCDIC); 1603200001.040.030 FP.OPEN := TRUE; 1603300001.040.030 END 1603400001.040.030 ELSE 1603500001.040.030 IF FP.EXTMODE = VALUE(ASCII) THEN % DONT TRANSLATE IT... 1603600001.040.030 BEGIN 1603700001.040.030 CLOSE(FP); 1603800001.040.030 FP.EXTMODE := VALUE(ASCII); 1603900001.040.030 FP.TRANSLATE := VALUE(FULLTRANS); 1604000001.040.030 FP.OPEN := TRUE; 1604100001.040.030 END 1604200001.040.030 ELSE 1604300001.040.030 ; % GIVE UP...? 1604400001.040.030 RECSIZ_ := FP.MAXRECSIZE; 1604500001.040.030 UNITS_ := IF FP.UNITS=VALUE(CHARACTERS) THEN 1 ELSE 6; 1604600001.040.030 END; 1604700001.040.030 END OPENINPUT; 1604800001.040.030 % 1610000001.040.030 % D I S K R E A D E R 1610100001.040.030 % 1610200001.040.030 % READ A COMMAND FROM A DISK FILE FOR PROCESSING 1610300001.040.030 % 1610400001.040.030 BOOLEAN PROCEDURE DISKREADER(FP,MAXREC,UNITZ); 1610500001.040.030 VALUE MAXREC,UNITZ; 1610600001.040.030 INTEGER MAXREC,UNITZ; 1610700001.040.030 FILE FP; 1610800001.040.030 BEGIN 1610900001.040.030 CP := POINTER(PACKET); 1611000001.040.030 IF NOT DISKREADER := READ(FP,MAXREC,PACKET) THEN 1611100001.040.030 BEGIN 1611200001.040.030 REPLACE CP BY CP FOR (COL := MAXREC*UNITZ) WITH TOUPPER; 1611300001.040.030 END; 1611400001.040.030 END; 1611500001.040.030 % 1620000001.040.030 % R E M O T E R E A D E R 1620100001.040.030 % 1620200001.040.030 % READ A COMMAND FROM THE TERMINAL FOR PROCESSING 1620300001.040.030 % 1620400001.040.030 BOOLEAN PROCEDURE REMOTEREADER; 1620500001.040.030 BEGIN 1620600001.040.030 REPLACE CP := PACKET BY NULC FOR MAXPACKWDS WORDS; 1620700001.040.030 IF NOT REMOTEREADER := BRD := 1620800001.040.030 WRITE(REM[STOP],PROMPTLENGTH,KPROMPT) THEN 1620900001.040.030 BEGIN 1621000001.040.030 IF NOT REMOTEREADER := BRD := READ(REM,80,PACKET) THEN 1621100001.040.030 BEGIN 1621200001.040.030 REPLACE CP BY CP FOR (COL := RD.LENGTHF) WITH TOUPPER; 1621300001.040.030 END; 1621400001.040.030 END; 1621500001.040.030 END; 1621600001.040.030 20000000 % 20001000 % S E T S T U F F 20002000 % 20003000 % SETS THE VARIOUS THINGS 20004000 % 20005000 PROCEDURE SETSTUFF; 20006000 BEGIN 20007000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20100000 PROCEDURE ABORTER; 20101000 BEGIN 20102000 SPECARA := SPECABORT; 20103000 CASE SCANIT OF 20104000 BEGIN 20105000 QMARKV: 20106000 SAY("determines what to do if RECEIVE transfer fails - " 20107000 "options are:"); 20107100 HELPER(ABORTHELP); 2010800001.040.031 DISCARDV: 20109000 KEEPFILE := FALSE; 20110000 KEEPV: 20111000 KEEPFILE := TRUE; 20112000 ELSE: 20113000 SAYQOPT("INCOMPLETE"); 20114000 HELPER(ABORTHELP); 2011500001.040.031 END CASE; 20116000 END ABORTER; 20117000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20200000 PROCEDURE DEBUGGER; 20201000 BEGIN 20202000 POINTER P; 20203000 SPECARA := SPECDEBUG; 20204000 CASE SCANIT OF 20205000 BEGIN 20206000 QMARKV: 20207000 SAY(" sets level of DEBUGGING output -- options are:"); 20208000 HELPER(DEBUGHELP); 2020900001.040.031 STATESV: 20210000 DEBUG := TRUE; 20211000 PACKETSV: 20212000 DEBUG := BOOLEAN(3); 20213000 LOGFILEV: 20214000 IF NOT DEBUG THEN DEBUG := TRUE; 20215000 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 20216000 IF COL GTR 0 THEN 20217000 BEGIN 20218000 SCAN P:CP FOR COL WHILE GEQ "A"; 20219000 REPLACE P BY "."48"00"; 20220000 IF LOG.OPEN THEN LOCK(LOG,CRUNCH); 20221000 REPLACE CP BY CP FOR COL+1 WITH ASCIITOEBCDIC; 20222000 REPLACE LOG.TITLE BY CP; 20223000 END; 20224000 DOFFV: 20225000 DEBUG := FALSE; 20226000 ELSE: 20227000 SAYQOPT("DEBUGGING"); 20228000 HELPER(DEBUGHELP); 2022900001.040.031 END CASE; 20230000 IF DEBUG THEN 20231000 IF NOT LOG.OPEN THEN LOG.OPEN := TRUE 20232000 ELSE 20233000 ELSE 20234000 IF LOG.OPEN THEN LOCK(LOG,CRUNCH); 20235000 END DEBUGGER; 20236000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20300000 PROCEDURE DELAYER; 20301000 BEGIN 20302000 REAL N; 20303000 N := SCANUM; 20304000 IF (N LSS 0)OR(N GTR 31) THEN 20305000 IF (N = QUESTIONV) THEN 20306000 BEGIN 20307000 SAY(" sets time to delay (in secs) before"); 20308000 SAY(" sending first packet during file SEND"); 20309000 HELPER(LONUMBERHELP); 2031000001.040.031 END 20311000 ELSE 20312000 BEGIN 20313000 SAYQ("DELAY"); 20314000 HELPER(LONUMBERHELP); 2031500001.040.031 END 20316000 ELSE 20317000 MYDELAY := N 20318000 END DELAYER; 20319000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20400000 PROCEDURE RETRYER; 20401000 BEGIN 20402000 REAL N; 20403000 SPECARA := SPECRETRY; 20404000 CASE SCANIT OF 20405000 BEGIN 20406000 QMARKV: 20407000 SAY(" sets number of times to retry an operation"); 20408000 SAY(" before giving up - options are:"); 20409000 HELPER(RETRYHELP); 2041000001.040.031 INITCONNV: 20411000 N := SCANUM; 20412000 IF (N LSS 0) THEN 20413000 IF (N = QUESTIONV) THEN 20414000 BEGIN 20415000 SAY(" sets number of times to retry initial connection"); 20416000 HELPER(NUMBERHELP) 2041700001.040.031 END 20418000 ELSE 20419000 BEGIN 20420000 SAYQ("INITIAL-CONNECTION"); 20421000 HELPER(NUMBERHELP); 2042200001.040.031 END 20423000 ELSE 20424000 INITRETRY := N; 20425000 RETRYPACKETSV: 20426000 N := SCANUM; 20427000 IF (N LSS 0) THEN 20428000 IF (N = QUESTIONV) THEN 20429000 BEGIN 20430000 SAY(" sets number of times to retry regular connection"); 20431000 HELPER(NUMBERHELP) 2043200001.040.031 END 20433000 ELSE 20434000 BEGIN 20435000 SAYQ("PACKETS"); 20436000 HELPER(NUMBERHELP); 2043700001.040.031 END 20438000 ELSE 20439000 PACKETRETRY := N; 20440000 ELSE: 20441000 SAYQOPT("RETRY"); 20442000 HELPER(RETRYHELP); 2044300001.040.031 END CASE 20444000 END RETRYER; 20445000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20500000 PROCEDURE BLOCKER; 20501000 BEGIN 20502000 REAL N; 20503000 N := SCANUM; 20504000 IF (N LSS 1) THEN 20505000 IF (N = QUESTIONV) THEN 20506000 BEGIN 20507000 SAY(" sets BLOCKSIZE attribute of RECEIVED files"); 20508000 HELPER(NUMBERHELP); 2050900001.040.031 END 20510000 ELSE 20511000 BEGIN 20512000 SAYQ("BLOCK-SIZE"); 20513000 HELPER(NUMBERHELP); 2051400001.040.031 END 20515000 ELSE 20516000 BEGIN 20517000 FILEBLOCKSIZE := N; 20518000 IF (FILEBLOCKSIZE MOD FILERECSIZE) NEQ 0 THEN 20519000 BEGIN 20520000 SAY("Warning: BLOCK-SIZE must be a multiple of RECORD-SIZE"); 20521000 SAY1(" current settings: RECORD-SIZE = ",FILERECSIZE); 20522000 SAY1(" BLOCK-SIZE = ",FILEBLOCKSIZE); 20523000 END 20524000 END 20525000 END BLOCKER; 20526000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20600000 PROCEDURE RECSIZER; 20601000 BEGIN 20602000 REAL N; 20603000 N := SCANUM; 20604000 IF (N LSS 1) THEN 20605000 IF (N = QUESTIONV) THEN 20606000 BEGIN 20607000 SAY(" sets MAXRECSIZE attribute of RECEIVED files"); 20608000 HELPER(NUMBERHELP); 2060900001.040.031 END 20610000 ELSE 20611000 BEGIN 20612000 SAYQ("RECORD-SIZE"); 20613000 HELPER(NUMBERHELP); 2061400001.040.031 END 20615000 ELSE 20616000 BEGIN 20617000 FILERECSIZE := N; 20618000 IF (FILEBLOCKSIZE MOD FILERECSIZE) NEQ 0 THEN 20619000 BEGIN 20620000 SAY("Warning: BLOCK-SIZE must be a multiple of RECORD-SIZE"); 20621000 SAY1(" current settings: RECORD-SIZE = ",FILERECSIZE); 20622000 SAY1(" BLOCK-SIZE = ",FILEBLOCKSIZE); 20623000 END 20624000 END 20625000 END RECSIZER; 20626000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 20700000 PROCEDURE UNITER; 20701000 BEGIN 20702000 SPECARA := SPECUNITS; 20703000 CASE SCANIT OF 20704000 BEGIN 20705000 QMARKV: 20706000 SAY(" set UNITS file attribute for received files " 20707000 "-- options are:"); 20707100 HELPER(UNITSHELP); 2070800001.040.031 UWORDSV: 20709000 FILEUNITS := VALUE(WORDS); 20710000 UCHARACTERSV: 20711000 FILEUNITS := VALUE(CHARACTERS); 20712000 ELSE: 20713000 SAYQOPT("UNITS"); 20714000 HELPER(UNITSHELP); 2071500001.040.031 END CASE; 20716000 END OF PROCEDURE UNITER; 20717000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 21000000 PROCEDURE SENDRECEIVER(WHICH); 21001000 VALUE WHICH; 21002000 REAL WHICH; 21003000 BEGIN 21004000 REAL N; % [1.018] NEED TO DECLARE LOCALLY 21005000 INTEGER NDX; 21006000 SPECARA := SPECRECEIVE; 21007000 CASE NDX := SCANIT OF 21008000 BEGIN 21009000 QMARKV: 21010000 SAY(" sets various packet parameters - options are:"); 21011000 HELPER(SENDHELP); 2101200001.040.031 EOLV: 21013000 N := SCANUM; 21014000 IF (N LSS 1)OR(N GTR 31) THEN 21015000 IF (N = QUESTIONV) THEN 21016000 BEGIN 21017000 IF WHICH=SETRECEIVEV THEN 21018000 SAY(" sets the packet terminator character expect") 21019000 ELSE 21020000 SAY(" sets the packet terminator character to send"); 21021000 HELPER(LONUMBERHELP) 2102200001.040.031 END 21023000 ELSE 21024000 BEGIN 21025000 SAYQ("END-OF-LINE"); 21026000 HELPER(LONUMBERHELP); 2102700001.040.031 END 21028000 ELSE 21029000 IF WHICH=SETRECEIVEV THEN 21030000 MYEOL := N 21031000 ELSE 21032000 EOL := N; 21033000 QUOTEV: 21034000 IF WHICH=SETRECEIVEV THEN 21035000 SAY(" not implemented, no need to set QUOTE to expect") 21036000 ELSE 21037000 BEGIN 21038000 COL_OK_TIL := COL; 21039000 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 21040000 IF COL GTR 0 THEN 21041000 BEGIN 21042000 IF CP = "?" THEN 21043000 BEGIN 21044000 SAY(" sets QUOTE character to send"); 21045000 HELPER(QUOTEHELP) 2104600001.040.031 END 21047000 ELSE 21048000 IF N := REAL(CP,1) LSS 33 OR N GTR 126 THEN % ! < N < 21049000 BEGIN 21050000 SAY(" invalid QUOTE character - must be an"); 21051000 HELPER(QUOTEHELP); 2105200001.040.031 END 21053000 ELSE 21054000 IF N=MYQBIN THEN % NO WAY! 21055000 SAY(" QUOTE not set, that character is " 21056000 "your binary quote") 21056100 ELSE 21057000 IF N=MYREPT THEN % NO WAY! 21058000 SAY(" QUOTE not set, that character is " 21059000 "your repeat quote") 21059100 ELSE 21060000 MYQUOTE := N 21061000 END 21062000 ELSE 21063000 BEGIN 21064000 SAYQ("QUOTE"); 21065000 HELPER(QUOTEHELP); 2106600001.040.031 END; 21067000 END; 21068000 LENV: 21069000 N := SCANUM; 21070000 IF (N LSS 10) OR (N GTR MAXPACKSIZ) THEN 2107100001.040.029 IF (N = QUESTIONV) THEN 21072000 BEGIN 21073000 IF WHICH=SETRECEIVEV THEN 21074000 SAY(" set PACKET-LENGTH for incoming packets") 21075000 ELSE 21076000 SAY(" sets PACKET-LENGTH for outgoing packets"); 21077000 SAY1(" must be an integer from 10 to ",MAXPACKSIZ); 2107800001.040.029 END 21079000 ELSE 21080000 BEGIN 21081000 SAYQ("PACKET-LENGTH"); 21082000 SAY1(" must be an integer from 10 to ",MAXPACKSIZ); 2108300001.040.029 END 21084000 ELSE 21085000 IF WHICH=SETRECEIVEV THEN 21086000 MYPACKSIZ := N 21087000 ELSE 21088000 SPSIZ := N; 21089000 PADV: 21090000 PCHARV: 21091000 PAUSEV: 21092000 STARTOFPACKV: 21093000 TIMEOUTV: 21094000 N := SCANUM; 21095000 IF (N LSS 0)OR(N GTR 31) THEN 21096000 IF (N = QUESTIONV) THEN 21097000 BEGIN 21098000 IF WHICH=SETRECEIVEV THEN 21099000 SAY(" sets a packet parameter for incoming packets") 21100000 ELSE 21101000 SAY(" sets a packet parameter for outgoing packets"); 21102000 HELPER(LONUMBERHELP); 2110300001.040.031 END 21104000 ELSE 21105000 BEGIN 21106000 SAYQ("packet"); 21107000 HELPER(LONUMBERHELP); 2110800001.040.031 END 21109000 ELSE 21110000 CASE NDX OF 21111000 BEGIN 21112000 PADV: 21113000 IF WHICH=SETRECEIVEV THEN 21114000 MYPAD := N 21115000 ELSE 21116000 PAD := N; 21117000 PCHARV: 21118000 IF WHICH=SETRECEIVEV THEN 21119000 MYPCHAR := N 21120000 ELSE 21121000 PCHAR := N; 21122000 PAUSEV: 21123000 MYPAUSE := N/10; 21124000 STARTOFPACKV: 21125000 IF WHICH=SETRECEIVEV THEN 21126000 MYSOH := N 21127000 ELSE 21128000 SOHCHAR := N; 21129000 TIMEOUTV: 21130000 IF N = 0 THEN 21131000 SAY(" TIMEOUT must be greater than zero") 21132000 ELSE 21133000 IF WHICH=SETRECEIVEV THEN 21134000 MYTIME := N 21135000 ELSE 21136000 TIMINT := N; 21137000 END CASE; 21138000 ACTUALTITLEV: 2113900001.040.038 SPECARA := SPECONOFF; 2114000001.040.038 CASE SCANIT OF 2114100001.040.038 BEGIN 2114200001.040.038 QMARKV: 2114300001.040.038 IF WHICH = SETRECEIVEV THEN 2114400001.040.038 SAY(" inhibits conversion of received file titles to " 2114500001.040.038 "UNISYS form") 2114600001.040.038 ELSE 2114700001.040.038 SAY(" inhibits conversion of sent file titles to MS-DOS" 2114800001.040.038 " form"); 2114900001.040.038 HELPER(ONOFFHELP); 2115000001.040.038 ONV: 2115100001.040.038 IF WHICH = SETRECEIVEV THEN 2115200001.040.038 RECACTUALTITLE := TRUE 2115300001.040.038 ELSE 2115400001.040.038 SENDACTUALTITLE := TRUE; 2115500001.040.038 OFFV: 2115600001.040.038 IF WHICH = SETRECEIVEV THEN 2115700001.040.038 RECACTUALTITLE := FALSE 2115800001.040.038 ELSE 2115900001.040.038 SENDACTUALTITLE := FALSE; 2116000001.040.038 ELSE: 2116100001.040.038 SAYQOPT("ACTUAL-TITLE"); 2116200001.040.038 HELPER(ONOFFHELP); 2116300001.040.038 END CASE; 2116400001.040.038 NOERRORV: 21900000 ; 21901000 ELSE: 21902000 IF WHICH=SETRECEIVEV THEN 21903000 SAYQOPT("RECEIVE") 21904000 ELSE 21905000 SAYQOPT("SEND"); 21906000 HELPER(SENDHELP); 2190700001.040.031 END CASE; 21908000 END SENDRECEIVER; 21909000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 22000000 PROCEDURE BINARER; 22001000 BEGIN 22002000 SPECARA := SPECONOFF; 22003000 CASE SCANIT OF 22004000 BEGIN 22005000 QMARKV: 22006000 SAY(" transfer all 8 bits of each character - options are:"); 22007000 HELPER(ONOFFHELP); 2200800001.040.031 ONV: 22009000 BINARYON := TRUE; 22010000 OFFV: 22011000 BINARYON := FALSE; 22012000 ELSE: 22013000 SAYQOPT("BINARY"); 22014000 HELPER(ONOFFHELP); 2201500001.040.031 END CASE; 22016000 END BINARER; 22017000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 22100000 PROCEDURE FIXER; 22101000 BEGIN 22102000 SPECARA := SPECONOFF; 22103000 CASE SCANIT OF 22104000 BEGIN 22105000 QMARKV: 22106000 SAY(" send trailing blanks found at the end of"); 22107000 SAY(" fixed-length records -- options are:"); 22108000 HELPER(ONOFFHELP); 2210900001.040.031 ONV: 22110000 FIXEDRECS := TRUE; 22111000 OFFV: 22112000 FIXEDRECS := FALSE; 22113000 ELSE: 22114000 SAYQOPT("FIXED"); 22115000 HELPER(ONOFFHELP); 2211600001.040.031 END CASE; 22117000 END FIXER; 22118000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 22200000 PROCEDURE EXPANDTABBER; 22201000 BEGIN 22202000 SPECARA := SPECONOFF; 22203000 CASE SCANIT OF 22204000 BEGIN 22205000 QMARKV: 22206000 SAY("expand TABs to spaces when RECEIVING files - " 22207000 "options are:"); 22207100 HELPER(ONOFFHELP); 2220800001.040.031 ONV: 22209000 EXPTABS := TRUE; 22210000 OFFV: 22211000 EXPTABS := FALSE; 22212000 ELSE: 22213000 SAYQOPT("EXPAND-TABS"); 22214000 HELPER(ONOFFHELP); 2221500001.040.031 END CASE; 22216000 END EXPANDTABBER; 22217000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 22300000 PROCEDURE RAWER; 22301000 BEGIN 22302000 SPECARA := SPECONOFF; 22303000 CASE SCANIT OF 22304000 BEGIN 22305000 QMARKV: 22306000 SAY("fill each record to MAXRECSIZE when RECEIVING files -"); 22307000 SAY(" options are:"); 22308000 HELPER(ONOFFHELP); 2230900001.040.031 ONV: 22310000 RAW := TRUE; 22311000 EXPTABS := FALSE; 22312000 SAY("EXPAND-TABS now set to OFF"); 22313000 OFFV: 22314000 RAW := FALSE; 22315000 IF EXPTABS THEN 22315900 SAY("EXPAND-TABS is ON") 22316000 ELSE 22316100 SAY("EXPAND-TABS is OFF"); 22317000 ELSE: 22318000 SAYQ("RAW"); 22319000 HELPER(ONOFFHELP); 2232000001.040.031 END CASE; 22321000 END RAWER; 22322000 22323000 %%%%%%%%%%%%%%%%%%%%%% 22400000 PROCEDURE SETFILER; 22401000 BEGIN 22402000 22403000 INTEGER NDX; 22404000 SPECARA := SPECFILE; 22405000 CASE (NDX := SCANIT) OF 22406000 BEGIN 22407000 QMARKV: 22408000 HELPER(SETFILEHELP); 2240900001.040.031 BLOCKSIZEV: 22410000 BLOCKER; 22411000 EXPTABSV: 22412000 EXPANDTABBER; 22413000 FIXEDV: 22414000 FIXER; 22415000 RAWV: 22416000 RAWER; 22417000 RECORDSIZEV: 22418000 RECSIZER; 22419000 UNITSV: 22420000 UNITER; 22421000 NOERRORV: 22422000 ; 22423000 ELSE: 22424000 SAYQOPT("FILE"); 22425000 HELPER(SETFILEHELP); 2242600001.040.031 END OF CASE; 22427000 END OF PROCEDURE SETFILER; 22428000 %%%%%%%%%%%%%%%%%%%%%%%% 2250000001.040.027 PROCEDURE CHECKSUMTYPER; 2250100001.040.027 BEGIN 2250200001.040.027 REAL N; 2250300001.040.027 N := SCANUM; 2250400001.040.027 IF (N < CSTYPE1) OR (N > CSTYPE3) THEN 2250500001.040.027 BEGIN 2250600001.040.027 IF (N = QUESTIONV) THEN 2250700001.040.027 BEGIN 2250800001.040.027 SAY (" selects prefered checksum type for file transfer"); 2250900001.040.027 END 2251000001.040.027 ELSE 2251100001.040.027 BEGIN 2251200001.040.027 SAYQ("BLOCK-CHECK"); 2251300001.040.027 END; 2251400001.040.027 HELPER(CHKTYPEHELP); 2251500001.040.031 END 2251600001.040.027 ELSE 2251700001.040.027 BEGIN 2251800001.040.027 MYCHKTYPE := N; 2251900001.040.027 END; 2252000001.040.027 END CHECKSUMTYPER; 2252100001.040.027 25000000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% mainline for procedure SETSTUFF 25001000 SPECARA := SPECSET; 25002000 CASE SCANIT OF 25003000 BEGIN 25004000 QMARKV: 25005000 SAY(" sets various KERMIT environment variables -- " 25006000 "options are:"); 25006100 HELPER(SETHELP); 2500700001.040.031 INCOMPLETEV: 25008000 ABORTER; 25009000 BINARYV: 25010000 BINARER; 25011000 DEBUGV: 25012000 DEBUGGER; 25013000 DELAYV: 25014000 DELAYER; 25015000 FILEV: 25016000 SETFILER; 25017000 RETRYV: 25018000 RETRYER; 25019000 SETRECEIVEV: 25020000 SENDRECEIVER(SETRECEIVEV); 25021000 SETSENDV: 25022000 SENDRECEIVER(SETSENDV); 25023000 NOERRORV: 25024000 ; 25025000 CHECKSUMTYPEV: 2502600001.040.027 CHECKSUMTYPER; 2502700001.040.027 ELSE: 25076000 SAYQOPT("SET"); 25077000 HELPER(SETHELP); 2507800001.040.031 END CASE; 25079000 END SETSTUFF; 25089000 25097000 $ENDSEGMENT 25098000 25099000 % 2600000001.040.030 %T A K E R 2600100001.040.030 % 2600200001.040.030 %READ KERMIT COMMANDS FROM A DISK FILE 2600300001.040.030 % 2600400001.040.030 PROCEDURE TAKER(INITIALIZED); 2600500001.040.030 VALUE INITIALIZED; 2600600001.040.030 BOOLEAN INITIALIZED; 2600700001.040.030 BEGIN 2600800001.040.030 FILE TAKEF; 2600900001.040.030 2601000001.040.030 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 2601100001.040.030 IF COL > 0 THEN 2601200001.040.030 BEGIN 2601300001.040.030 IF CP = "?" THEN 2601400001.040.030 BEGIN 2601500001.040.030 SAY(" takes KERMIT input commands from a disk file"); 2601600001.040.030 HELPER(TAKEHELP); 2601700001.040.031 END 2601800001.040.030 ELSE 2601900001.040.030 BEGIN 2602000001.040.030 IF TAKING THEN 2602100001.040.030 BEGIN 2602200001.040.030 SAY(" Nested TAKE's not allowed. Command ignored."); 2602300001.040.030 END 2602400001.040.030 ELSE 2602500001.040.030 BEGIN 2602600001.040.030 REPLACE PFILNAM BY CP FOR COL WHILE GTR " ",".",NULC; 2602700001.040.030 IF OPENINPUT(TAKEF,COL) THEN 2602800001.040.030 BEGIN 2602900001.040.030 IF INITIALIZED THEN 2603000001.040.030 BEGIN 2603100001.040.030 SAYN("CANNOT TAKE FILE:",PFILNAM); 2603200001.040.030 END; 2603300001.040.030 END 2603400001.040.030 ELSE 2603500001.040.030 BEGIN 2603600001.040.030 TAKING := TRUE; 2603700001.040.030 PROMPTOFFSET := 7; 2603800001.040.030 WHILE NOT DISKREADER(TAKEF,RECSIZ_,UNITS_) DO 2603900001.040.030 BEGIN 2604000001.040.030 SAYN("TAKEN: ",CP); 2604100001.040.030 PROCESSIT; 2604200001.040.030 END; 2604300001.040.030 PROMPTOFFSET := PROMPTLENGTH; 2604400001.040.030 TAKING := FALSE; 2604500001.040.030 END; 2604600001.040.030 END; 2604700001.040.030 END; 2604800001.040.030 END 2604900001.040.030 ELSE 2605000001.040.030 BEGIN 2605100001.040.030 SAYQOPT("TAKE"); 2605200001.040.030 HELPER(TAKEHELP); 2605300001.040.031 END; 2605400001.040.030 END TAKER; 2605500001.040.030 % 2700000001.040.032 % G E T F I L E T I T L E 2700100001.040.032 % 2700200001.040.032 % GETS THE DISK FILE TITLE FOR SENDING 2700300001.040.032 % AND RETURNS TRUE IF THERE ARE MORE FILES IN THE LIST 2700400001.040.032 % 2700500001.040.032 BOOLEAN PROCEDURE GETFILETITLE; 2700600001.040.032 BEGIN 2700700001.040.032 POINTER P,Q; 2700800001.040.032 REAL I,J; 2700900001.040.032 2701000001.040.032 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 2701100001.040.032 IF COL GTR 0 THEN 2701200001.040.032 BEGIN 2701300001.040.032 SCAN P:CP FOR I:COL WHILE GTR " "; 2701400001.040.032 REPLACE PFILNAM:=POINTER(FILNAM) BY CP:CP FOR (COL - I),".",NULC; 2701600001.040.032 IF (COL := I) - 1 GTR 0 THEN 2701700001.040.032 BEGIN 2701800001.040.032 SCAN Q:P+1 FOR J:I-1 UNTIL GTR " "; 2701900001.040.032 END; 2702000001.040.032 IF GETFILETITLE := (NEXTSENDL := J) GTR 0 THEN 2702100001.040.032 BEGIN 2702200001.040.032 REPLACE NEXTSEND BY Q FOR J,NULC; 2702300001.040.032 END; 2702400001.040.032 REPLACE PACKET BY NULC FOR MAXPACKWDS WORDS; 2702500001.040.032 END; 2702600001.040.032 END GETFILETITLE; 2702700001.040.032 % 2710000001.040.032 % A N O T H E R F I L E T I T L E 2710100001.040.032 % 2710200001.040.032 % TELLS SEND IF THERE ARE MORE FILES IN THE SEND LIST 2710300001.040.032 % AND USES GETFILE TITLE TO MOVE THE NEXT NAME INTO FILNAM 2710400001.040.032 % 2710500001.040.032 BOOLEAN PROCEDURE ANOTHERFILETITLE; 2710600001.040.032 BEGIN 2710700001.040.032 IF ANOTHERFILETITLE := MORETOSEND THEN 2710800001.040.032 BEGIN 2710900001.040.032 REPLACE CP := POINTER(PACKET) BY NEXTSEND FOR 2711000001.040.032 COL:NEXTSENDL UNTIL = NULC,NULC; 2711100001.040.032 COL := NEXTSENDL - COL; 2711200001.040.032 MORETOSEND := GETFILETITLE; 2711300001.040.032 END; 2711400001.040.032 END OF ANOTHERFILETITLE; 2711500001.040.032 29000000 % 29001000 % S T A T U S 29002000 % 29003000 % DISPLAY THE STATUS OF ALL THE VARIOUS THINGS 29004000 % 29005000 PROCEDURE STATUS; 29006000 BEGIN 29007000 SAY("parameters which can be changed by the SET command"); 29008000 IF (BINARYON) THEN 29009000 SAY(" BINARY ON (8th bit quoting will be requested)") 29010000 ELSE 29011000 SAY(" BINARY OFF (No 8th bit quoting will be done)"); 29012000 SAY1(" BLOCK-CHECK = ",MYCHKTYPE); 2901250001.040.027 IF DEBUG THEN 29013000 BEGIN 29014000 REPLACE PFILNAM:=POINTER(FILNAM) BY LOG.TITLE,NULC; 29015000 REPLACE PFILNAM BY PFILNAM FOR 80 WITH EBCDICTOASCII; 29016000 IF REAL(DEBUG) GTR 1 THEN 29017000 SAYN(" DEBUG STATES and PACKETS to file ",PFILNAM) 29018000 ELSE 29019000 SAYN(" DEBUG STATES to file ",PFILNAM); 29020000 END 29021000 ELSE 29022000 SAY(" DEBUG OFF"); 29023000 SAY1(" DELAY before first send (in seconds) = ",MYDELAY); 29024000 IF KEEPFILE THEN 29025000 SAY(" if INCOMPLETE, KEEP partial file") 29026000 ELSE 29027000 SAY(" if INCOMPLETE, DISCARD partial file"); 29028000 SAY1(" RETRY INITIAL-CONNECTION = ",INITRETRY); 29029000 SAY1(" RETRY PACKETS = ",PACKETRETRY); 29030000 SAY("parameters which can be changed by the SET FILE command"); 29031000 FORM1 (" RECORD-SIZE = ",FILERECSIZE); 2903200001.040.028 APPEND1(", BLOCK-SIZE = ",FILEBLOCKSIZE); 2903300001.040.028 IF FILEUNITS = VALUE(WORDS) THEN 29034000 APPEND(", UNITS = WORDS") 2903500001.040.028 ELSE 29036000 APPEND(", UNITS = CHARACTERS"); 2903700001.040.028 SENDIT; 2903710001.040.028 IF EXPTABS THEN 29038000 SAY(" EXPAND-TABS ON") 29039000 ELSE 29040000 SAY(" EXPAND-TABS OFF"); 29041000 IF FIXEDRECS THEN 29042000 SAY(" FIXED ON (send blanks found at the end of records)") 29043000 ELSE 29044000 SAY(" FIXED OFF (strip blanks from the end of records)"); 29045000 IF RAW THEN 29046000 SAY(" RAW ON ( Burroughs records delimited by size only )") 29047000 ELSE 29048000 SAY(" RAW OFF ( Burroughs records delimited by CR )"); 29049000 SPECARA := SPECSHOW; 29050000 CASE SCANIT OF 29051000 BEGIN 29052000 SHOSENDV: 29053000 SAY("parameters which can be changed by the SET SEND command"); 29054000 SAYC(" END-OF-LINE character = ",EOL); 29055000 SAY1(" maximum PACKET-LENGTH = ",SPSIZ); 29056000 SAY1(" number of PADDING characters = ",PAD); 29057000 IF PAD GTR 0 THEN 29058000 SAYC(" PADDING CHARACTER = ",PCHAR); 29059000 SAY1(" PAUSE before packet send (in tenths of second) = ", 29060000 MYPAUSE*10); 29060100 SAYC(" START-OF-PACKET charcter = ",SOHCHAR); 29061000 SAY1(" packet TIMEOUT (in seconds) = ",TIMINT); 29062000 IF SENDACTUALTITLE THEN 2906210001.040.038 SAY(" ACTUAL-TITLE ON (send title in UNISYS form)") 2906220001.040.038 ELSE 2906230001.040.038 SAY(" ACTUAL-TITLE OFF (send title in MS-DOS form)"); 2906240001.040.038 ELSE: 29063000 SAY("parameters which can be changed by the SET RECEIVE command");29064000 SAYC(" END-OF-LINE character = ",MYEOL); 29065000 SAY1(" maximum PACKET-LENGTH = ",MYPACKSIZ); 29066000 SAY1(" number of PADDING characters = ",MYPAD); 29067000 IF MYPAD GTR 0 THEN 29068000 SAYC(" PADDING CHARACTER = ",MYPCHAR); 29069000 SAY1(" PAUSE before packet send (in tenths of second) = ", 29070000 MYPAUSE*10); 29070100 SAYC(" QUOTE character = ",MYQUOTE); 29071000 SAYC(" START-OF-PACKET character = ",MYSOH); 29072000 SAY1(" packet TIMEOUT (in seconds) = ",MYTIME); 29073000 IF RECACTUALTITLE THEN 2907310001.040.038 SAY(" ACTUAL-TITLE ON (leave title in received form)") 2907320001.040.038 ELSE 2907330001.040.038 SAY(" ACTUAL-TITLE OFF (change received title to UNISYS " 2907340001.040.038 "form)"); 2907350001.040.038 END CASE; 29074000 END STATUS; 29075000 29076000 30000000 BOOLEAN PROCEDURE PROCESSIT; 30001000 BEGIN 30002000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 31000000 PROCEDURE SERVANT; 31001000 BEGIN 31002000 BOOLEAN DONTQUIT; % LOOP CONTROL 31003000 ARRAY BUFFER[0:MAXPACKWDS]; % TEMPORARY FILE TITLE BUFFER 31004000 FILE DUMMY(KIND=PACK,FILETYPE=7);%TEMPORARY DUMMY FILE 31005000 REAL NUM,LEN,TIMER; % PACKET NUMBER, LENGTH, TIMEOUT 31006000 31007000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 31100000 PROCEDURE GENERICTHINGS; % HANDLE "G" REQUESTS 31101000 BEGIN 31102000 POINTER PR; % POINTER TO PACKET 31103000 PR := POINTER(PACKET); % INITIALIZE IT 31105000 CASE REAL(PR,1) OF 31106000 BEGIN 31107000 "F": % FINISH, BUT DON'T LOGOUT 31108000 SPACK("Y",N,0,NULLDATA);% ACK TO PC AND THEN... 31109000 DONTQUIT := FALSE; % EXIT FROM WHILE LOOP 31110000 BRD := TRUE; % AND EXIT FROM MAIN LOOP 31111000 "L": % FINISH AND LOG OUT, TOO 31112000 % SPACK("Y",N,0,NULLDATA);% ACK TO PC AND THEN... 31113000 SAYN("BYE IS NOT IMPLEMENTED: ",PACKET); 31114000 DONTQUIT := FALSE; % EXIT FROM WHILE LOOP 31115000 BRD := TRUE; % AND EXIT FROM MAIN LOOP 31116000 % % THIS PART ISN'T IMPLEMENTED 31117000 ELSE: % SOME OTHER NON-IMPLEMENTED THING 31118000 SAYN("THIS IS NOT IMPLEMENTED: ",PACKET); 31119000 END CASE; 31120000 END GENERICTHINGS; 31121000 31122000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% mainline statements for SERVANT 31900000 STATE := "T"; % JUST TO INITIALIZE FOR DEBUG 31901000 DONTQUIT := SERVER := TRUE; % INITIALIZE BOOLEANS 31902000 REPLACE PFILNAM:=POINTER(FILNAM) BY NULC FOR MAXPACKWDS WORDS; 31903000 TIMER := IF TIMINT LSS MINTIM OR TIMINT GTR MAXTIM THEN 31904000 MYTIME ELSE TIMINT; 31905000 31906000 WHILE DONTQUIT DO 31907000 BEGIN 31908000 REM.TIMELIMIT := TIMER; % SET UP FOR IO TIMEOUT 31909000 IF DEBUG THEN BUGC("SERVANT STATE: ",STATE); 31910000 CASE RPACK(LEN,NUM,PACKET) OF% DO WHICHEVER ONE WE NEED 31911000 BEGIN 31912000 "R": % GET OR RECEIVE A FILE(US TO PC) 31913000 N := NUM; % RESTART PACKET NUMBERS 31914000 LEN := GETPACKETDATA(POINTER(PACKET),LEN,PFILNAM,(12*18)-1); 3191500001.040.036 REPLACE PFILNAM BY PFILNAM FOR LEN WITH TOUPPER,".",NULC; 3191600001.040.036 REPLACE BUFFER BY PFILNAM FOR LEN+1 WITH ASCIITOEBCDIC; 31917000 IF DUMMY.OPEN THEN CLOSE(DUMMY); 31918000 REPLACE DUMMY.TITLE BY BUFFER; 31919000 IF NOT DUMMY.RESIDENT THEN 31920000 SAYN("NO FILE: ",FILNAM) 31921000 ELSE 31922000 SENDSW; 31923000 STATE := "R"; % FOR DEBUG 31927000 "S": % SEND A FILE (FROM PC TO US) 31928000 RPAR(LEN,PACKET,TRUE); % EXCHANGE 3193000001.040.025 SPAR(LEN,PACKET,FALSE); % PARAMETERS 3193100001.040.025 SPACK("Y",NUM,LEN,PACKET);%[1.017] 31932000 OLDTRY := NUMTRY; % [1.017] RESET COUNTERS 31933000 NUMTRY := 0; % [1.017] 31934000 N := (NUM+1) MOD64; % [1.017] 31935000 IF (NOT RECSW("F")) THEN% [1.017] ATTEMPT TO RECEIVE 31936000 BEGIN % [1.017] 31937000 REPLACE FBUF_ BY "RECEIVE FAILED."; 31938000 ERROR(FBUF_); % [1.017] 31939000 END; % [1.017] 31940000 STATE := "S"; % FOR DEBUG 31947000 "T": % TIMED OUT 31948000 SPACK("N",N,0,NULLDATA);% NAK ON TIMEOUT 31949000 STATE := "T"; % FOR DEBUG 31950000 "G": % GENERIC COMMAND 31951000 GENERICTHINGS; % TAKE CARE OF THEM ELSEWHERE 31952000 "I": % INITIALIZE PACKETS 31953000 RPAR(LEN,PACKET,TRUE); % GET HIS INIT DATA 3195500001.040.025 SPAR(LEN,PACKET,FALSE); % FILL UP PACKET WITH MY INIT DATA 3195600001.040.025 SPACK("Y",NUM,LEN,PACKET);%ACK WITH MY PARAMETERS 3195700001.040.024 OLDTRY := NUMTRY; % SAVE OLD TRY COUNT 31958000 NUMTRY := 0; % INITIALIZE NUMTRY 31959000 ELSE: % WHO KNOWS 31960000 SPACK("N",N,6,PACKET); % NAK IT 31961000 0: % UNKNOWN DATACOM ERROR 3196110001.040.024 BRD := TRUE; % PROBABLY EOF SO GIVE UP 3196120001.040.024 DONTQUIT := FALSE; 3196130001.040.024 END CASE; 31962000 END WHILE; 31963000 WHEN(5); % MAKE SURE ACK GETS OUT 31964000 BRD := TRUE; % EXIT THRU TO EOT 31965000 END SERVANT; 31966000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% mainline statements for PROCESSIT 39000000 SPECARA := SPECIAL; 39003000 COL_BASE := COL; 39008000 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 39009000 IF COL GTR 0 THEN 39010000 CASE SCANIT OF 39011000 BEGIN 39012000 QMARKV: 39013000 HELPV: 39014000 HELPER(PLAINHELP); % ?, HELP 3901500001.040.031 SERVERV: 39016000 SERVANT; % SERVER 39017000 SENDV: 39018000 MORETOSEND:=GETFILETITLE; % SEND 3901900001.040.032 SENDSW; 39020000 RECEIVEV: 39024000 REPLACE PFILNAM := POINTER(FILNAM) BY NULC FOR MAXPACKWDS WORDS;39025000 RECSW("R"); % [1.017] 39026000 SETV: 39033000 SETSTUFF; % SET 39034000 SHOWV: 39035000 STATUSV: 39036000 STATUS; % STATUS 39037000 QUITV: 39038000 EXITV: 39039000 BRD := TRUE; 39040000 NOERRORV: % WE ALREADY GAVE THE ERROR 39041000 ; 39042000 TAKEV: % TAKE 3904300001.040.030 TAKER(TRUE); 3904400001.040.030 ELSE: % GARBAGE? 39900000 SAYQOPT(" "); 39901000 HELPER(PLAINHELP); 3990200001.040.031 END CASE; 39903000 END PROCESSIT; 39911000 39912000 40000000 % 40001000 % S E N D S W 40002000 % 40003000 % SENDSW IS THE STATE TABLE SWITCHER FOR SENDING FILES. IT LOOPS UNTI 40004000 % EITHER IT FINISHES, OR AN ERROR IS ENCOUNTERED. THE ROUTINES CALLED 40005000 % BY SENDSW ARE RESPONSIBLE FOR CHANGING THE STATE. 40006000 % 40007000 40008000 40009000 $BEGINSEGMENT 40010000 40011000 BOOLEAN PROCEDURE SENDSW; 40012000 BEGIN 40013000 BOOLEAN DONTQUIT; % LOOP CONTROL 40014000 FILE FP(KIND=DISK,FILETYPE=8, % CURRENT DISK FILE 40015000 INTMODE=ASCII, % SO CHECKSUM, ETC, WILL WORK 40016000 TRANSLATE=FORCESOFT,INPUTTABLE=EBCDICTOASCII, 40017000 MYUSE=IN); 40018000 40019000 40020000 40021000 % 4010000001.040.033 % R E S E N D 4010100001.040.033 % 4010200001.040.033 % RESEND A PACKET THAT WAS NACKED OR GOT NO REPLY 4010300001.040.033 % 4010400001.040.033 REAL PROCEDURE RESEND(TRIES); 4010500001.040.033 VALUE TRIES; 4010600001.040.033 INTEGER TRIES; 4010700001.040.033 BEGIN 4010800001.040.033 IF NUMTRY := * + 1 < TRIES THEN 4010900001.040.033 BEGIN 4011000001.040.033 IF WRITE(REM[STOP],MSGLEN,SBUFFER) THEN; 4011100001.040.033 IF REAL(DEBUG) > 1 THEN 4011200001.040.033 BUG1("RESENDING ",MSGLEN); 4011300001.040.033 END 4011400001.040.033 ELSE 4011500001.040.033 BEGIN 4011600001.040.033 RESEND := "A"; 4011700001.040.033 IF REAL(DEBUG) > 1 THEN 4011800001.040.033 BUG("RESEND ABORTING"); 4011900001.040.033 END; 4012000001.040.033 END; 4012100001.040.033 % 41000000 % S I N I T 41001000 % 41002000 % SEND INITIATE: SEND THIS HOST'S PARAMETERS AND GET OTHER SIDE'S BACK41003000 41004000 41005000 REAL PROCEDURE SINIT; 41006000 BEGIN 41007000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 41008000 REAL NEXTSTATE; % STATE TO ADVANCE TO 4100900001.040.033 4101000001.040.033 SPAR(LEN,PACKET,TRUE); % FILL UP INIT INFO PACKET 4101300001.040.025 41014000 IF NOT SERVER THEN % WAIT A BIT BEFORE SENDING THE 4101500001.040.033 WHEN(MYDELAY); % INIT PACKET... 41016000 FLUSHINPUT; % FLUSH PENDING INPUT 41017000 41018000 SPACK("S",N,LEN,PACKET); % SEND AN S PACKET 41019000 DO % UNTIL WE GET A GOOD REPLY OR ABORT 4101910001.040.033 BEGIN 4101920001.040.033 CASE RPACK(LEN,NUM,RECPKT) OF% WHAT WAS THE REPLY? 41020000 BEGIN 41021000 "N": % NAK, TRY IT AGAIN 41022000 NEXTSTATE := RESEND(INITRETRY);% NAK, TRY IT AGAIN 4102300001.040.033 "Y": % ACK 41024000 IF (N = NUM) THEN 41025000 BEGIN 41026000 RPAR(LEN,RECPKT,FALSE);% GET OTHER SIDE'S INIT INFO 4102700001.040.025 IF EOL = 0 THEN % CHECK AND SET DEFAULTS 41028000 EOL := MYEOL; 41029000 IF QUOTE = 0 THEN 41030000 QUOTE := MYQUOTE; 41031000 NUMTRY := 0; % RESET TRY COUNTER 41032000 N := (N+1) MOD64; % BUMP PACKET COUNT 41033000 NEXTSTATE := "F"; % OK, CASE STATE TO F 4103400001.040.033 END 41035000 ELSE 41035100 NEXTSTATE := RESEND(INITRETRY);% WRONG ACK, STAY IN S 4103600001.040.033 41037000 "E": % ERROR PACKET RECEIVED 41038000 PRERRPKT(RECPKT); % PRINT IT OUT AND 41039000 NEXTSTATE := "A"; % ABORT 4104000001.040.033 41041000 "Q": % CHECKSUM FAILURE 4104110001.040.024 "T": % RECEIVE FAILURE, TRY AGAIN 41042000 NEXTSTATE := RESEND(INITRETRY); 4104300001.040.033 41044000 ELSE: % ANYTHING ELSE, JUST ABORT 41045000 NEXTSTATE := "A"; 4104600001.040.033 END CASE; 41047000 END OF LOOP 4104800001.040.033 UNTIL NEXTSTATE NEQ 0; % ONLY RESEND CAN MAKE NEXTSTATE = 0 4104900001.040.033 SINIT := NEXTSTATE; 4105000001.040.033 END SINIT; 4105100001.040.033 41052000 % 42000000 % S F I L E 42001000 % 42002000 % SEND FILE HEADER. 42003000 42004000 42005000 REAL PROCEDURE SFILE; 42006000 BEGIN 42007000 LABEL ACKHERE,QUIT; 42008000 REAL NUM, LEN, R; % PACKET NUMBER, LENGTH 42009000 POINTER NEWFILNAM, % POINTER TO FILE NAME TO SEND 42011000 CP; % CHAR POINTER 42012000 REAL NEXTSTATE; % STATE TO ADVANCE TO 4201210001.040.033 CHKTYPE := THECHKTYPE; % THE ONE AGREED TO BY BOTH SIDES 4201300001.040.027 IF OPENINPUT(FP,LEN) THEN % FILE ISN'T THERE 4202200001.040.030 BEGIN 42023000 REPLACE FBUF_ BY "CANNOT FIND FILE: ",PFILNAM FOR MAXSENDFILESIZ 42024000 WHILE GEQ " ",NULC; 42025000 ERROR(FBUF_); 42026000 SFILE := "A"; 42027000 GO QUIT; 42028000 END; 42029000 IF DEBUG THEN BUGN("OPENING FOR SENDING: ",PFILNAM); 42046000 RESIZE(GBUF_,(RECSIZ_ * UNITS_ + 5 + 2) DIV 6);% ROOM FOR CR, LF 4204900001.040.034 LEN := *-1; % GET RID OF THE EXTRA PERIOD... 42050000 CP := PFILNAM; 4205100001.040.030 R := REAL(CP,1).[6:7]; % [1.022] STRIP (USERCODE) 42052000 IF (R = "(") THEN % [1.022] 42053000 BEGIN % [1.022] 42054000 SCAN CP:CP FOR LEN:LEN WHILE NEQ ")";%[1.022] 42055000 IF (LEN GTR 0) THEN % [1.022] 42056000 SCAN CP:CP FOR LEN:LEN WHILE = ")"; 42057000 END; % [1.022] 42058000 IF SENDACTUALTITLE THEN % DON'T MUCK WITH IT 4205810001.040.038 BEGIN 4205820001.040.038 REPLACE FILNAM1 BY CP FOR LEN; 4205830001.040.038 END 4205840001.040.038 ELSE 4205850001.040.038 BEGIN 4205860001.040.038 NUM := LEN; 42059000 WHILE NUM GTR 0 AND LEN GTR MAXSENDFILESIZ DO % PARE DOWN TITLE 42060000 BEGIN 42061000 SCAN NEWFILNAM:CP FOR NUM:LEN UNTIL ="/"; 42062000 IF NUM GTR 0 THEN 42063000 SCAN CP:NEWFILNAM FOR LEN:NUM WHILE = "/"; 42064000 END; 42065000 NUM := LEN; 42066000 NEWFILNAM := FILNAM1; 42067000 WHILE NUM GTR 0 DO 42068000 BEGIN 42069000 REPLACE NEWFILNAM:NEWFILNAM BY CP:CP FOR NUM:NUM WHILE NEQ """; 42070000 IF NUM GTR 0 THEN 42071000 BEGIN 42072000 SCAN CP:CP FOR NUM:NUM WHILE = """; 42073000 LEN := *-1; 42074000 END; 42075000 END; 42076000 IF LEN GTR 8 THEN % WE'LL HAVE TO INSERT A DOT 42077000 BEGIN 42078000 LEN := *+1; 42079000 REPLACE PFILNAM BY CP:FILNAM1 FOR 8 WITH FIXSLASHES, 42080000 "." , CP FOR LEN-8 WITH FIXSLASHES 42081000 END 42082000 ELSE 42083000 REPLACE PFILNAM BY FILNAM1 FOR LEN WITH FIXSLASHES; 42084000 REPLACE FILNAM1 BY PFILNAM FOR LEN, NULC; 42085000 END; 4208510001.040.038 42086000 42087000 IF DEBUG THEN 42088000 BUGN("SENDING: ",FILNAM1); 42089000 LEN := MAKEPACKETDATA(POINTER(FILNAM1),LEN,POINTER(PACKET), 4209000001.040.036 (SPSIZ - 2 - CHKTYPE)); 4209010001.040.036 SPACK("F",N,LEN,PACKET); % SEND AN F PACKET 4209100001.040.036 DO % UNTIL WE GET A GOOD REPLY OR ABORT 4209110001.040.033 BEGIN 4209120001.040.033 CASE RPACK(LEN,NUM,RECPKT) OF %WHAT WAS THE REPLY? 42092000 BEGIN 42093000 "N": % NAK, JUST STAY IN THIS STATE, 42094000 NUM := (NUM+63) MOD64; % UNLESS IT'S NAK FOR NEXT PACKET 42095000 IF N NEQ NUM THEN % WHICH IS JUST LIKE AN ACK FOR 42096000 NEXTSTATE := RESEND(PACKETRETRY) % THIS PACKET 4209700001.040.033 ELSE GO TO ACKHERE; 42098000 42099000 "Y": % ACK 42100000 ACKHERE: 42100100 IF N = NUM THEN % PACKET NUMBER MATCHES 42101000 BEGIN 42102000 NUMTRY := 0; % RESET TRY COUNTER 42103000 N := (N+1) MOD64; % BUMP PACKET COUNT 42104000 IF BSIZE := BUFILL(FP,PACKET) = 0 THEN 42105000 % GET FIRST DATA FROM FILE, ERROR? 42106000 NEXTSTATE := "Z" % YES, QUIT NOW 4210700001.040.033 ELSE % A GOOD READ 42108000 NEXTSTATE := "D"; % CASE STATE TO D 4210900001.040.033 END 42110000 ELSE 42111000 NEXTSTATE := RESEND(PACKETRETRY); % WRONG ACK, STAY IN F 4211200001.040.033 42113000 "E": % ERROR PACKET RECEIVED 42114000 PRERRPKT(RECPKT); % PRINT IT OUT AND 42115000 NEXTSTATE := "A"; % ABORT 4211600001.040.033 42117000 "Q": % CHECKSUM FAILURE 4211710001.040.024 "T": % RECEIVE FAILURE, STAY IN F STATE 42118000 NEXTSTATE := RESEND(PACKETRETRY); 4211900001.040.033 ELSE: 42120000 NEXTSTATE := "A"; % SOMETHING ELSE, JUST "ABORT" 4212100001.040.033 END CASE; 42122000 END 4212300001.040.033 UNTIL NEXTSTATE NEQ 0; % ONLY RESEND CAN MAKE NEXTSTATE = 0 4212400001.040.033 SFILE := NEXTSTATE; 4212500001.040.033 QUIT: 4212600001.040.033 END SFILE; 4212700001.040.033 42128000 % 44000000 % S D A T A 44001000 % 44002000 % SEND FILE DATA 44003000 44004000 44005000 REAL PROCEDURE SDATA; 44006000 BEGIN 44007000 LABEL ACKHERE; 44008000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 44009000 REAL NEXTSTATE; % STATE TO ADVANCE TO 4401000001.040.033 4401100001.040.033 DO % UNTIL NO LONGER IN D STATE 4401200001.040.033 BEGIN 4401300001.040.033 SPACK("D",N,BSIZE,PACKET); % SEND A D PACKET 44014000 DO % UNTIL WE GET A GOOD REPLY OR ABORT 4401410001.040.033 BEGIN 4401420001.040.033 CASE RPACK(LEN,NUM,RECPKT) OF % WHAT WAS THE REPLY? 44015000 BEGIN 44016000 "N": % NAK, JUST STAY IN THIS STATE, 44017000 % UNLESS IT'S NAK FOR NEXT PACKET 44018000 NUM := (NUM+63) MOD64;% UNLESS IT'S NAK FOR NEXT PACKET 44019000 IF N NEQ NUM THEN % WHICH IS JUST LIKE AN ACK FOR 44020000 NEXTSTATE := RESEND(PACKETRETRY) % THIS PACKET 4402100001.040.033 ELSE 44022000 GO TO ACKHERE; 44023000 "Y": % ACK 44024000 ACKHERE: 44024100 IF N = NUM THEN % IF WRONG ACK, FAIL 44025000 BEGIN 44026000 NUMTRY := 0; % RESET TRY COUNTER 44027000 N := (N+1)MOD64; % BUMP PACKET COUNT 44028000 IF ((BSIZE := BUFILL(FP,PACKET)) = 0) THEN 44029000 % GOT DATA FROM FILE 44030000 NEXTSTATE := "Z" % IF EOF SET STATE TO THAT 4403100001.040.033 ELSE 44031100 NEXTSTATE := "D"; % GOT DATA, STAY IN STATE D 4403200001.040.033 END 44033000 ELSE 44034000 NEXTSTATE := RESEND(PACKETRETRY); 4403500001.040.033 44036000 "E": % ERROR PACKET RECEIVED 44037000 PRERRPKT(RECPKT); % PRINT IT OUT AND 44038000 NEXTSTATE := "A"; % ABORT 4403900001.040.033 44040000 "Q": % CHECKSUM FAILURE 4404010001.040.024 "T": 44040900 NEXTSTATE := RESEND(PACKETRETRY);% RECEIVE FAILED, STAY IN D4404100001.040.033 44042000 ELSE: 44042900 NEXTSTATE := "A"; % ANYTHING ELSE, "ABORT" 4404300001.040.033 END CASE; 44044000 END 4404500001.040.033 UNTIL NEXTSTATE NEQ 0; % ONLY RESEND CAN MAKE NEXTSTATE = 0 4404600001.040.033 END 4404700001.040.033 UNTIL NEXTSTATE NEQ "D"; 4404800001.040.033 SDATA := NEXTSTATE; 4404900001.040.033 END SDATA; 4405000001.040.033 4405100001.040.033 % 45000000 % S E O F 45001000 % 45002000 % SEND END-OF-FILE. 45003000 45004000 45005000 REAL PROCEDURE SEOF; 45006000 BEGIN 45007000 LABEL ACKHERE; 45008000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 45009000 REAL NEXTSTATE; % STATE TO ADVANCE TO 4501000001.040.033 45012000 SPACK("Z",N,0,PACKET); % SEND A "Z" PACKET 45013000 DO % UNTIL WE GET A GOOD REPLY OR ABORT 4501310001.040.033 BEGIN 4501320001.040.033 CASE RPACK(LEN,NUM,RECPKT) OF %WHAT WAS THE REPLY? 45014000 BEGIN 45015000 "N": % NAK, JUST STAY IN THIS STATE, 45016000 % UNLESS IT'S NAK FOR NEXT PACKET, 45017000 NUM := (NUM+63) MOD64; % UNLESS IT'S NAK FOR NEXT PACKET 45018000 IF N NEQ NUM THEN % WHICH IS JUST LIKE AN ACK FOR 45019000 NEXTSTATE := RESEND(PACKETRETRY) % THIS PACKET 4502000001.040.033 ELSE 45021000 GO TO ACKHERE; 45022000 "Y": % ACK 45023000 ACKHERE: 45024000 IF N = NUM THEN 45025000 BEGIN 45026000 NUMTRY := 0; % RESET TRY COUNTER 45027000 N := (N+1) MOD64; % AND BUMP PACKET COUNT 45028000 IF DEBUG THEN BUGN("CLOSING INPUT FILE: ",PFILNAM); 45029000 CLOSE(FP); % CLOSE THE INPUT FILE 45030000 IF ANOTHERFILETITLE THEN 4503100001.040.032 NEXTSTATE := "F" % MORE FILES TO SEND 4503110001.040.033 ELSE 4503120001.040.032 NEXTSTATE := "B" % BREAK, EOT, ALL DONE 4503130001.040.033 END % IF WRONG ACK, HOLD OUT 45032000 ELSE 45032100 NEXTSTATE := RESEND(PACKETRETRY); 4503300001.040.033 45034000 "E": % ERROR PACKET RECEIVED 45035000 PRERRPKT(RECPKT); % PRINT IT OUT AND 45036000 NEXTSTATE := "A"; % ABORT 4503700001.040.033 45038000 "Q": % CHECKSUM FAILURE 4503810001.040.024 "T": 45038900 NEXTSTATE := RESEND(PACKETRETRY); %RECEIVE FAILURE, STAY IN Z 4503900001.040.033 45040000 ELSE: 45040900 NEXTSTATE := "A"; % SOMETHING ELSE, "ABORT" 4504100001.040.033 END CASE; 45042000 END 4504300001.040.033 UNTIL NEXTSTATE NEQ 0; % ONLY RESEND CAN MAKE NEXTSTATE = 0 4504400001.040.033 SEOF := NEXTSTATE; 4504500001.040.033 END SEOF; 4504600001.040.033 45047000 % 46000000 % S B R E A K 46001000 % 46002000 % SEND BREAK (EOT) 46003000 46004000 46005000 REAL PROCEDURE SBREAK; 46006000 BEGIN 46007000 LABEL ACKHERE; 46008000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 46009000 REAL NEXTSTATE; % STATE TO ADVANCE TO 4601000001.040.033 46012000 SPACK("B",N,0,PACKET); % SEND A B PACKET 46013000 DO % UNTIL WE GET A GOOD REPLY OR ABORT 4601310001.040.033 BEGIN 4601320001.040.033 CASE RPACK(LEN,NUM,RECPKT) OF %WHAT WAS THE REPLY? 46014000 BEGIN 46015000 "N": % NAK, JUST STAY IN THIS STATE, 46016000 % UNLESS NAK FOR PREVIOUS PACKET, 46017000 NUM := (NUM+63) MOD64; % UNLESS IT'S NAK FOR NEXT PACKET 46018000 IF N NEQ NUM THEN % WHICH IS JUST LIKE AN ACK FOR 46019000 NEXTSTATE := RESEND(PACKETRETRY) % THIS PACKET 4602000001.040.033 ELSE 46021000 GO TO ACKHERE; 46022000 46023000 "Y": % ACK 46024000 ACKHERE: 46025000 IF N = NUM THEN % IF WRONG ACK, FAIL 46026000 BEGIN 46027000 NUMTRY := 0; % RESET TRY COUNTER 46028000 N := (N+1) MOD64; % AND BUMP PACKET COUNT 46029000 NEXTSTATE := "C"; % CASE STATE TO COMPLETE 4603000001.040.033 END 46031000 ELSE 46031100 NEXTSTATE := RESEND(PACKETRETRY); 4603200001.040.033 46033000 "E": % ERROR PACKET RECEIVED 46034000 PRERRPKT(RECPKT); % PRINT IT OUT AND 46035000 NEXTSTATE := "A"; % ABORT 4603600001.040.033 46037000 "Q": % CHECKSUM FAILURE 4603710001.040.024 "T": 46037900 NEXTSTATE := RESEND(PACKETRETRY); % RECEIVE FAILURE, STAY IN B4603800001.040.033 46041000 ELSE: 46041900 NEXTSTATE := "A" % OTHER, "ABORT" 4604200001.040.033 END CASE; 46043000 END 4604400001.040.033 UNTIL NEXTSTATE NEQ 0; % ONLY RESEND CAN MAKE NEXTSTATE = 0 4604500001.040.033 SBREAK := NEXTSTATE; 4604600001.040.033 END SBREAK; 4604700001.040.033 % MAIN LINE TO SENDSW 49000000 49001000 49002000 49003000 STATE := "S"; % SEND INITIATE IS THE START STATE 49004000 N := 0; % INITIALIZE MESSAGE NUMBER 49005000 GCNT_ := -1; % INITIALIZE GETCHAR POINTER, ETC 49006000 NUMTRY := 0; % BUG NO TRIES YET 49007000 DONTQUIT := TRUE; % INITIALIZE FOR LOOP 49008000 REM.TIMELIMIT := IF TIMINT LSS MINTIM OR TIMINT GTR MAXTIM THEN 49009000 MYTIME ELSE TIMINT; 49010000 CHKTYPE := CSTYPE1; % FOR STARTUP 4901100001.040.027 WHILE DONTQUIT DO % DO THIS AS LONG AS NECESSARY 49012000 BEGIN 49013000 IF DEBUG THEN BUGC("SENDSW STATE: ",STATE); 49014000 CASE STATE OF 49015000 BEGIN 49016000 "S": STATE := SINIT; % SEND-INIT 49017000 "F": STATE := SFILE; % SEND-FILE 49018000 "D": STATE := SDATA; % SEND-DATA 49019000 "Z": STATE := SEOF; % SEND-END-OF-FILE 49020000 "B": STATE := SBREAK; % SEND-BREAK 49021000 "C": SENDSW := TRUE; % COMPLETE 49022000 DONTQUIT:=FALSE; % LET'S QUIT 49023000 "A": SENDSW := FALSE; % "ABORT" 49024000 DONTQUIT:=FALSE; % LET'S QUIT 49025000 ELSE:SENDSW := FALSE; % UNKNOWN, FAIL 49026000 DONTQUIT:=FALSE; % LET'S QUIT 49027000 END CASE; 49028000 END WHILE; 49029000 REM.TIMELIMIT := 0; % DISABLE REMOTE INPUT TIMELIMIT 49030000 CHKTYPE := CSTYPE1; % BACK TO DEFAULT 4903100001.040.027 END SENDSW; 49099000 49100000 $ENDSEGMENT 49101000 49102000 50000000 % 50001000 % R E C S W 50002000 % 50003000 % THIS IS THE STATE TABLE SWITCHER FOR RECEIVING FILES. 50004000 50005000 50006000 $BEGINSEGMENT 50007000 50008000 BOOLEAN PROCEDURE RECSW(ISTATE); % [1.017] 50009000 REAL ISTATE; % [1.017] 50010000 BEGIN 50011000 BOOLEAN DONTQUIT; 50012000 FILE FP(KIND=DISK,MYUSE=OUT, % FILE POINTER FOR CURRENT DISK FILE 50013000 INTMODE=ASCII,EXTMODE=EBCDIC,UNITS=FILEUNITS, 50014000 TRANSLATE=FULLTRANS,OUTPUTTABLE=ASCIITOEBCDIC, 50015000 MAXRECSIZE=FILERECSIZE,BLOCKSIZE=FILEBLOCKSIZE, 50016000 AREASIZE=FILEBLOCKSIZE DIV FILERECSIZE * 10); 50017000 50018000 50019000 50020000 % 51000000 % R I N I T 51001000 % 51002000 % RECEIVE INITIALIZATION 51003000 51004000 51005000 REAL PROCEDURE RINIT; 51006000 BEGIN 51007000 REAL LEN, NUM; % PACKET LENGTH, NUMBER 51008000 51009000 IF (NUMTRY:=*+1 LEQ INITRETRY) THEN 51010000 BEGIN 51011000 51012000 CASE IF SERVER AND NUMTRY=1 THEN 51013000 "S" 51013100 ELSE 51014000 RPACK(LEN,NUM,PACKET) OF %GET A PACKET 51015000 BEGIN 51016000 "S": % SEND-INIT 51017000 RPAR(LEN,PACKET,TRUE); % GET THE OTHER SIDE'S INIT DATA 5101900001.040.025 SPAR(LEN,PACKET,FALSE); % FILL UP PACKET WITH MY INIT 5102000001.040.025 SPACK("Y",NUM,LEN,PACKET);%ACK WITH MY PARAMETERS 5102100001.040.024 OLDTRY := NUMTRY; % SAVE OLD TRY COUNT 51022000 NUMTRY := 0; % START A NEW COUNTER 51023000 N := (NUM+1) MOD64; % BUMP PACKET NUMBER, MOD 64 5102400001.040.024 RINIT := "F"; % ENTER FILE-RECEIVE STATE 51025000 51026000 "E": % ERROR PACKET RECEIVED 51027000 PRERRPKT(PACKET); % PRINT IT OUT AND 51028000 RINIT := "A"; % ABORT 51029000 51030000 "Q" : % CHECKSUM FAILURE 5103010001.040.024 "T": % DIDN'T GET PACKET 51031000 SPACK("N",N,0,NULLDATA);% RETURN A NAK 51032000 RINIT := STATE; % KEEP TRYING 51033000 51034000 ELSE: 51034900 RINIT := "A"; % SOME OTHER PACKET TYPE, "ABORT" 51035000 END CASE; 51036000 END 51037000 ELSE 51037100 RINIT := "A"; % ABORT IF TOO MANY TRIES 51038000 END RINIT; 51039000 51040000 51041000 % 52000000 % R F I L E 52001000 % 52002000 % RECEIVE FILE HEADER 52003000 52004000 52005000 REAL PROCEDURE RFILE; 52006000 BEGIN 52007000 LABEL QUIT; 52008000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 52009000 POINTER NEWFILNAM; 52011000 CHKTYPE := THECHKTYPE; % THE ONE AGREED TO BY BOTH SIDES 5201200001.040.027 IF (NUMTRY:=*+1 LEQ PACKETRETRY+1) THEN 52013000 BEGIN 52014000 52015000 CASE RPACK(LEN,NUM,PACKET) OF %GET A PACKET 52016000 BEGIN 52017000 "S": % SEND-INIT, MAYBE OUR ACK LOST 52018000 IF OLDTRY := *+1 LEQ PACKETRETRY+1 THEN 52019000 BEGIN 52020000 IF NUM = (N+63) MOD64 THEN 52021000 % PREVIOUS PACKET, MOD 64 ? 52022000 BEGIN % YES, ACK IT AGAIN WITH 52023000 SPAR(LEN,PACKET,FALSE);%OUR SEND-INIT PARAMETERS 5202500001.040.025 SPACK("Y",NUM,LEN,PACKET);% [1.019] FIX LENGTH PARAMETER 52026000 NUMTRY := 0; % RESET TRY COUNTER 52027000 RFILE := STATE; % STAY IN THIS STATE 52028000 END 52029000 ELSE 52029900 RFILE := "A"; % NOT PREVIOUS PACKET, "ABORT" 52030000 END 52031000 ELSE 52031100 RFILE := "A"; 52032000 52033000 "Z": % END-OF-FILE 52034000 IF (OLDTRY := *+1 LEQ PACKETRETRY+1) THEN 52035000 BEGIN 52036000 IF NUM = (N+63) MOD64 THEN 52037000 % PREVIOUS PACKET, MOD 64 ? 52038000 BEGIN % YES, ACK IT AGAIN. 52039000 SPACK("Y",NUM,0,NULLDATA); 52040000 NUMTRY := 0; 52041000 RFILE := STATE; % STAY IN THIS STATE 52042000 END 52043000 ELSE 52043100 RFILE := "A"; % NOT PREVIOUS PACKET, "ABORT" 52044000 END 52045000 ELSE 52045100 RFILE := "A"; % ABORT IT 52046000 52047000 "F": % FILE HEADER (JUST WHAT WE WANT) 52048000 IF NUM = N THEN % THE PACKET NUMBER MUST BE RIGHT 52049000 BEGIN 52050000 LEN := GETPACKETDATA(POINTER(PACKET),LEN,PFILNAM,12*18-1); 5205100001.040.036 REPLACE PFILNAM BY PFILNAM FOR LEN WITH TOUPPER,".",NULC; 5205200001.040.036 REPLACE FILNAM1 BY PFILNAM FOR (LEN+2) WITH ASCIITOEBCDIC; 5205300001.040.037 IF NOT RECACTUALTITLE THEN % MUCK WITH IT 5205310001.040.038 IF COBBLE(FILNAM1,LEN) THEN % NOTHING USABLE 5205400001.040.037 BEGIN 5205500001.040.037 REPLACE PF_:FBUF_ BY "CANNOT USE TITLE: ", 5205510001.040.037 PFILNAM FOR LEN,NULC; 5205520001.040.037 ERROR(FBUF_); 5205530001.040.037 RFILE := "A"; 5205540001.040.037 GO QUIT; 5205550001.040.037 END; 5205600001.040.037 IF FP.OPEN THEN 52057000 CLOSE(FP); 52057100 IF KEEPFILE THEN 52057900 FP.PROTECTION := VALUE(SAVE) 52058000 ELSE 52058100 FP.PROTECTION := VALUE(TEMPORARY); 52059000 REPLACE FP.TITLE BY FILNAM1; 52061000 IF 5206200001.040.037 IF FP.ATTERR THEN 5206210001.040.037 TRUE 5206220001.040.037 ELSE 5206230001.040.037 NOT FP.PRESENT THEN % DIDN'T OPEN THE FILE 5206240001.040.037 BEGIN 52063000 REPLACE FBUF_ BY "CANNOT CREATE: ",PFILNAM FOR LEN,NULC; 52064000 ERROR(FBUF_); 52065000 RFILE := "A"; 52066000 GO QUIT; 52067000 END 52068000 ELSE % OK, GIVE MESSAGE 52069000 IF DEBUG THEN 52070000 BUGN("RECEIVING: ",PFILNAM); 52071000 RECSIZ_ := FP.MAXRECSIZE; 52072000 UNITS_ := IF FP.UNITS=VALUE(CHARACTERS) THEN 1 ELSE 6; 52073000 RESIZE(PBUF_,(RECSIZ_ * UNITS_ +6) DIV 6);% SET UP BUFFER 52074000 REPLACE PP_ := POINTER(PBUF_) BY " " FOR 52075000 PCNT_ := (RECSIZ_ * UNITS_); 5207600001.040.035 SPACK("Y",N,0,NULLDATA);% ACKNOWLEDGE THE FILE HEADER 52077000 OLDTRY := NUMTRY; % RESET TRY COUNTERS 52078000 NUMTRY := 0; % ... 52079000 N := (N+1) MOD64; % BUMP PACKET NUMBER, MOD 64 52080000 RFILE := "D"; % CASE TO DATA STATE 52081000 END 52082000 ELSE 52082100 RFILE := "A"; 52083000 52084000 "B": % BREAK TRANSMISSION (EOT) 52085000 IF NUM = N THEN % NEED RIGHT PACKET NUMBER HERE 52086000 BEGIN 52087000 SPACK("Y",N,0,NULLDATA);% BUG OK 52088000 RFILE := "C"; % GO TO COMPLETE STATE 52089000 END 52090000 ELSE 52090100 RFILE := "A"; 52091000 52092000 "E": % ERROR PACKET RECEIVED 52093000 PRERRPKT(PACKET); % PRINT IT OUT AND 52094000 RFILE := "A"; % ABORT 52095000 52096000 "Q" : % CHECKSUM FAILURE 5209610001.040.024 "T": % DIDN'T GET PACKET 52097000 SPACK("N",N,0,NULLDATA);% RETURN A NAK 52098000 RFILE := STATE; % KEEP TRYING 52099000 52100000 ELSE: 52100900 RFILE := "A"; % SOME OTHER PACKET, "ABORT" 52101000 END CASE; 52102000 END 52103000 ELSE 52103100 RFILE := "A"; % ABORT IF TOO MANY TRIES 52104000 QUIT: 52105000 END RFILE; 52106000 52107000 52108000 % 54000000 % R D A T A 54001000 % 54002000 % RECEIVE DATA 54003000 54004000 54005000 REAL PROCEDURE RDATA; 54006000 BEGIN 54007000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 54008000 IF NUMTRY:=*+1 LEQ PACKETRETRY+1 THEN 54009000 BEGIN 54010000 CASE RPACK(LEN,NUM,PACKET) OF% GET PACKET 54012000 BEGIN 54013000 "D": % GOT DATA PACKET 54014000 IF NUM NEQ N THEN % RIGHT PACKET? 54015000 BEGIN % NO 54016000 IF OLDTRY := *+1 LEQ PACKETRETRY+1 THEN 54017000 BEGIN 54018000 IF NUM = (N+63) MOD64 THEN 54019000 % ELSE CHECK PACKET NUMBER 54020000 BEGIN % PREVIOUS PACKET AGAIN? 54021000 SPACK("Y",NUM,0,NULLDATA); % [1.020] YES, RE-ACK IT 54022000 NUMTRY := 0; % RESET TRY COUNTER 54023000 RDATA := STATE; % DON'T WRITE OUT DATA! 54024000 END 54025000 ELSE 54025100 RDATA := "A"; % SORRY, WRONG NUMBER 54026000 END 54027000 ELSE 54027100 RDATA := "A"; 54028000 END 54029000 ELSE 54029100 BEGIN 54030000 % GOT DATA WITH RIGHT PACKET NUMBER 54031000 BUFEMP(FP,PACKET,LEN);% WRITE THE DATA TO THE FILE 54032000 SPACK("Y",N,0,NULLDATA);%ACKNOWLEDGE THE PACKET 54033000 OLDTRY := NUMTRY; % RESET THE TRY COUNTERS 54034000 NUMTRY := 0; % ... 54035000 N := (N+1) MOD64; % BUMP PACKET NUMBER, MOD 64 54036000 RDATA := "D"; % REMAIN IN DATA STATE 54037000 END; 54038000 54039000 "F": % GOT A FILE HEADER 54040000 IF OLDTRY := *+1 LEQ PACKETRETRY+1 THEN 54041000 BEGIN 54042000 IF NUM = (N+63) MOD64 THEN 54043000 % ELSE CHECK PACKET NUMBER 54044000 BEGIN % IT WAS THE PREVIOUS ONE 54045000 SPACK("Y",NUM,0,NULLDATA);% ACK IT AGAIN 54046000 NUMTRY := 0; % RESET TRY COUNTER 54047000 RDATA := STATE; % STAY IN DATA STATE 54048000 END 54049000 ELSE 54049100 RDATA := "A"; % NOT PREVIOUS PACKET, "ABORT" 54050000 END 54051000 ELSE 54051100 RDATA := "A"; % ABORT IT 54052000 54053000 "Z": % END-OF-FILE 54054000 IF NUM = N THEN % MUST HAVE RIGHT PACKET NUMBER 54055000 BEGIN 54056000 SPACK("Y",N,0,NULLDATA);% OK, ACK IT. 54057000 IF PCNT_ LSS RECSIZ_*UNITS_ THEN 5405800001.040.035 BEGIN 5405810001.040.035 REPLACE PP_ BY " " FOR PCNT_; 5405820001.040.035 BRD:=WRITE(FP,RECSIZ_,PBUF_);% FLUSH THE BUFFER 54059000 END; 5405910001.040.035 LOCK(FP,CRUNCH); % LOCK THE FILE 54060000 N := (N+1) MOD64; % BUMP PACKET NUMBER 54061000 RDATA := "F"; % GO BACK TO RECEIVE FILE STATE 54062000 END 54063000 ELSE 54063100 RDATA := "A"; 54064000 54065000 "E": % ERROR PACKET RECEIVED 54066000 PRERRPKT(PACKET); % PRINT IT OUT AND 54067000 RDATA := "A"; % ABORT 54068000 54069000 "Q" : % CHECKSUM FAILURE 5406910001.040.024 "T": % DIDN'T GET PACKET 54070000 SPACK("N",N,0,NULLDATA);% RETURN A NAK 54071000 RDATA := STATE; % KEEP TRYING 54072000 54073000 ELSE: 54073900 RDATA := "A"; % SOME OTHER PACKET, "ABORT" 54074000 END CASE; 54075000 END 54076000 ELSE 54076100 RDATA := "A"; % ABORT IF TOO MANY TRIES 54077000 END RDATA; 54078000 54079000 % MAIN LINE TO RECSW 59000000 59001000 59002000 59003000 STATE := ISTATE; % [1.017] START STATE IS PASSED IN 59004000 % [1.017] N := 0; % INITIALIZE MESSAGE NUMBER 59005000 NUMTRY := 0; % BUG NO TRIES YET 59006000 DONTQUIT := TRUE; % LOOP INITIALIZATION 59007000 REM.TIMELIMIT := IF TIMINT LSS MINTIM OR TIMINT GTR MAXTIM THEN 59008000 MYTIME ELSE TIMINT; 59009000 CHKTYPE := CSTYPE1; % FOR STARTUP 5901000001.040.027 WHILE DONTQUIT DO 59011000 BEGIN 59012000 IF DEBUG THEN BUGC("RECSW STATE: ",STATE); 59013000 CASE STATE OF 59014000 BEGIN 59015000 "R": STATE := RINIT; % RECEIVE-INIT 59016000 "F": STATE := RFILE; % RECEIVE-FILE 59017000 "D": STATE := RDATA; % RECEIVE-DATA 59018000 "C": RECSW := TRUE; % COMPLETE STATE 59019000 DONTQUIT := FALSE; % LET'S QUIT 59020000 "A": RECSW := FALSE; % "ABORT" STATE 59021000 DONTQUIT := FALSE; % LET'S QUIT 59022000 ELSE:RECSW := FALSE; % UNKNOWN STATE 59023000 DONTQUIT := FALSE; % LET'S QUIT 59024000 END CASE; 59025000 END WHILE; 59026000 REM.TIMELIMIT := 0; % DISABLE REMOTE INPUT TIMELIMIT 59027000 CHKTYPE := CSTYPE1; % BACK TO DEFAULT 5902800001.040.027 END RECSW; 59099000 $ENDSEGMENT 59101000 59102000 60000000 % 60001000 % KERMIT UTILITIES. 60002000 % 60003000 60004000 60005000 % 60006000 % S P A C K 60007000 % 60008000 % SEND A PACKET 60009000 60010000 60011000 $BEGINSEGMENT 6001200001.040.024 60013000 PROCEDURE SPACK(TYPE,NUM,LEN,DATA); 6001400001.040.024 VALUE TYPE,NUM,LEN; 6001500001.040.024 REAL TYPE,NUM,LEN; 6001600001.040.024 ARRAY DATA[0]; 6001700001.040.024 BEGIN 6001800001.040.024 INTEGER HEADERTYPE,I; 6001900001.040.033 HEADERTYPE := 3; 6002000001.040.024 IF LONGPACKETSOK THEN 6002100001.040.024 BEGIN 6002200001.040.024 IF (LEN + CHKTYPE + 2) > SHORTPACKSIZ THEN 6002300001.040.029 BEGIN 6002400001.040.024 HEADERTYPE := 0; 6002500001.040.024 END; 6002600001.040.024 END; 6002700001.040.024 % 6002800001.040.024 IF REAL(DEBUG) GTR 1 THEN % DISPLAY OUTGOING PACKET 6002900001.040.024 BEGIN 6003000001.040.024 BUGC("SPACK TYPE: ",TYPE); 6003100001.040.024 BUG1("NUM: ",NUM); 6003200001.040.024 BUG1("LEN: ",LEN); 6003300001.040.024 BUG1("HTYPE:",HEADERTYPE); 6003400001.040.024 IF LEN GTR 0 THEN 6003500001.040.024 BUGN("DATA: ",DATA); 6003600001.040.024 END; 6003700001.040.024 SPB := POINTER(SBUFFER); 6003800001.040.024 MSGLEN := LEN + 3; % # OF BYTES TO CHECKSUM 6003900001.040.024 % 6004000001.040.024 IF PAD > 0 THEN 6004100001.040.024 BEGIN 6004200001.040.024 REPLACE SPB:SPB BY CH(PCHAR,PAD); 6004300001.040.024 END; 6004400001.040.024 REPLACE SPB:SPB BY CH(SOHCHAR,1);% PACKET MARKER 6004500001.040.024 SPC := SPB; % FOR CHECKSUMS 6004600001.040.024 IF HEADERTYPE NEQ 3 THEN % PUT IN HEADERTYPE 6004700001.040.024 REPLACE SPB:SPB BY CH(TOCHAR(HEADERTYPE),1) 6004800001.040.024 ELSE % PUT IN LENGTH 6004900001.040.024 REPLACE SPB:SPB BY CH(TOCHAR(LEN + 2 + CHKTYPE),1); 6005000001.040.024 REPLACE SPB:SPB BY CH(TOCHAR(NUM),1),CH(TYPE,1); 6005100001.040.024 IF HEADERTYPE = 0 THEN % TYPE 0 HEADER INCLUDES 6005200001.040.024 BEGIN % LENGTH AND A CHECKSUM 6005300001.040.024 REPLACE SPB:SPB BY 6005400001.040.024 CH(TOCHAR((LEN + CHKTYPE) DIV PACKETMOD),1), 6005500001.040.024 CH(TOCHAR((LEN + CHKTYPE) MOD PACKETMOD),1); 6005600001.040.024 REPLACE SPB:SPB BY CHKSUM := CHECKSUM(SPC,5,CSTYPE1) FOR CSTYPE1; 6005700001.040.024 MSGLEN := * + 2 + CSTYPE1; 6005800001.040.024 IF REAL(DEBUG) GTR 1 THEN % DISPLAY TYPE 0 HEADER 6005900001.040.024 BEGIN 6006000001.040.024 BUGH("SCHK: ",CHKSUM); 6006100001.040.024 END; 6006200001.040.024 END; 6006300001.040.024 REPLACE SPB:SPB BY POINTER(DATA) FOR LEN; 6006400001.040.024 REPLACE SPB:SPB BY (CHKSUM := CHECKSUM(SPC,MSGLEN,CHKTYPE)) 6006500001.040.024 FOR CHKTYPE; 6006600001.040.024 MSGLEN := * + 2 + CHKTYPE + PAD;% NOW IT'S THE # OF BYTES TO WRITE 6006700001.040.024 IF REAL(DEBUG) GTR 1 THEN % DISPLAY DATA AND CHECKSUM 6006800001.040.024 BEGIN 6006900001.040.024 BUGH("SCHK: ",CHKSUM); 6007200001.040.024 END; 6007300001.040.024 IF SPB - 1 = " " THEN % TRAILING BLANK MAY BE STRIPPED 6007400001.040.024 BEGIN 6007500001.040.024 REPLACE SPB:SPB BY "?",CH(EOL,1); 6007600001.040.024 MSGLEN := * + 2; 6007700001.040.024 END; 6007800001.040.024 REPLACE SPB:SPB BY CH(EOL,1); % ADD THE END OF LINE CHARACTER 6007900001.040.024 IF BRD := WRITE(REM[STOP],MSGLEN,SBUFFER) THEN 6008000001.040.024 BEGIN 6008100001.040.024 I := 3+1; % TRY 3 MORE TIMES 6008200001.040.024 WHILE BRD AND I := *-1 GTR 0 DO 6008300001.040.024 BEGIN 6008400001.040.024 IF DEBUG THEN 6008500001.040.024 BUGH("SPACK WRITE ERROR (HEX) = ",RD); 6008600001.040.024 WHEN(.5); % WAIT A HALF SECOND 6008700001.040.024 BRD := WRITE(REM[STOP],MSGLEN,SBUFFER); 6008800001.040.024 END; % TRY THE IO AGAIN 6008900001.040.024 END; 6009000001.040.024 END OF SPACK; 6009100001.040.024 61000000 % 61001000 % R P A C K 61002000 % 61003000 % READ A PACKET 61004000 61005000 61006000 REAL PROCEDURE RPACK(LEN,NUM,DATA); 6100700001.040.024 REAL LEN, NUM; % PACKET LENGTH, NUMBER 6100800001.040.024 ARRAY DATA[0]; % PACKET DATA 6100900001.040.024 BEGIN 6101000001.040.024 INTEGER COL,X; % BYTES TO PROCESS,SCRATCH 6101100001.040.024 REAL TYPE; % PACKET TYPE 6101200001.040.024 LABEL QUIT,RETRYSOH; 6101300001.040.024 PROCEDURE ABORT(TYPE); % TIMED OUT OR DEFICIENT PACKET 6101400001.040.024 VALUE TYPE; % OF FAILURE 6101500001.040.024 REAL TYPE; 6101600001.040.024 BEGIN 6101700001.040.024 RPACK := TYPE; 6101800001.040.024 IF BRD.TIMEOUTBIT THEN % TIMED OUT 6101900001.040.024 IF REAL(DEBUG) GTR 1 THEN 6102000001.040.024 BUG("TIMED OUT") 6102100001.040.024 ELSE 6102200001.040.024 ELSE 6102300001.040.024 IF BRD THEN % SOME OTHER ERROR 6102400001.040.024 BEGIN 6102500001.040.024 IF DEBUG THEN 6102600001.040.024 BUGH("ERROR ON READ (HEX) = ",RD); 6102700001.040.024 RPACK := 0; % I GIVE UP 6102800001.040.024 END 6102900001.040.024 ELSE % NO ERROR - MUST BE A BAD PACKET 6103000001.040.024 IF DEBUG THEN 6103100001.040.024 BEGIN 6103200001.040.024 BUG("BAD PACKET"); 6103300001.040.024 BUG1("CHARACTERS LEFT=",COL); 6103400001.040.024 IF COL GTR 0 THEN 6103500001.040.024 BUGN("WHICH ARE :",RPD); 6103600001.040.024 BUGN("BUFFER IS :",RBUFFER); 6103700001.040.024 END; 6103800001.040.024 RD := 0; % RESET RESULT DESCRIPTOR 6103900001.040.024 GO QUIT; 6104000001.040.024 END OF ABORT; 6104100001.040.024 % 6104200001.040.024 RPB := POINTER(RBUFFER); 6104500001.040.024 IF BRD := READ(REM,ABSOLUTEMAXPACKSIZE,RBUFFER) THEN 6104600001.040.029 ABORT("T"); 6104700001.040.024 REPLACE RPB BY RPB FOR X := RD.LENGTHF WITH STRIP_PARITY,NULC; 6104800001.040.024 SCAN RPB:RPB FOR X:X UNTIL = MYSOH; 6104900001.040.024 RETRYSOH: 6105000001.040.024 IF X < 5 THEN % MINIMUM PACKET LENGTH 6105100001.040.024 ABORT("T"); 6105200001.040.024 SCAN RPD:RPB FOR COL:X WHILE = MYSOH; 6105300001.040.024 SCAN RPB:RPD FOR X:COL UNTIL = MYSOH; 6105400001.040.024 IF REAL(DEBUG) > 1 THEN % RPD POINTS 1 PAST SOH 6105500001.040.024 BUG1("COL: ",(COL - X)); % (COL - X) IS NUMBER OF CHARS 6105600001.040.024 IF (COL := * - X) < 4 THEN % TOO SHORT 6105700001.040.024 GO RETRYSOH; 6105800001.040.024 % 6105900001.040.024 RPC := RPD; % FOR CHECKSUMS 6106000001.040.024 IF (LEN := UNCHAR(REAL(RPD,1))) < 0 THEN 6106100001.040.024 ABORT(0) 6106200001.040.024 ELSE 6106300001.040.024 BEGIN 6106400001.040.024 CASE LEN OF 6106500001.040.024 BEGIN 6106600001.040.024 0: % CHECKSUM TYPE 0 HEADER 6106700001.040.024 IF COL < (5 + CSTYPE1) THEN 6106800001.040.024 GO RETRYSOH; % TOO SHORT FOR HEADER 6106900001.040.024 CHKSUM := CHECKSUM(RPC,5,CSTYPE1); 6107000001.040.024 1: 6107100001.040.024 2: % NOT IMPLEMENTED 6107200001.040.024 ABORT(0); 6107300001.040.024 ELSE: % CHECKSUM THE WHOLE MESSAGE 6107400001.040.024 IF COL < (LEN + 1) THEN 6107500001.040.024 GO RETRYSOH; % TOO SHORT FOR MESSAGE 6107600001.040.024 CHKSUM := CHECKSUM(RPC,(LEN + 1 - CHKTYPE),CHKTYPE); 6107700001.040.024 END; 6107800001.040.024 END; 6107900001.040.024 NUM := UNCHAR(REAL(RPD:=*+1,1));% PACKET NUMBER 6108000001.040.024 TYPE := REAL(RPD:=*+1,1); % PACKET TYPE 6108100001.040.024 RPD := * + 1; % POINT TO 1 PAST TYPE 6108200001.040.024 IF REAL(DEBUG) GTR 1 THEN % DISPLAY INCOMING PACKET 6108300001.040.024 BEGIN 6108400001.040.024 BUGC("RPACK TYPE: ",TYPE); 6108500001.040.024 BUG1("NUM: ",NUM); 6108600001.040.024 BUG1("LEN: ",LEN); 6108700001.040.024 END; 6108800001.040.024 CASE LEN OF 6108900001.040.024 BEGIN 6109000001.040.024 0:BEGIN % GET THE LENGTH 6109100001.040.024 LEN := PACKETMOD * UNCHAR(REAL(RPD,1)) + 6109200001.040.024 UNCHAR(REAL(RPD+1,1)); 6109300001.040.024 RPD := * + 2; 6109400001.040.024 IF REAL(DEBUG) GTR 1 THEN 6109500001.040.024 BEGIN 6109600001.040.024 BUG1("LEN: ",LEN); 6109700001.040.024 BUG1("CKSUM:",CHKSUM.[47:8]); 6109800001.040.024 BUG1("RCHK: ",REAL(RPD,1)); 6109900001.040.024 END; 6110000001.040.024 IF REAL(RPD,1) NEQ CHKSUM.[47:8] THEN 6110100001.040.024 ABORT("Q"); % BAD HEADER CHECKSUM 6110200001.040.024 IF COL < (LEN + 5) THEN 6110300001.040.024 GO RETRYSOH; % NOT ENOUGH BYTES 6110400001.040.024 CHKSUM := CHECKSUM(RPC,(LEN + 5 + CSTYPE1 - CHKTYPE),CHKTYPE); 6110500001.040.024 RPD := * + CSTYPE1; % MOVE PAST HEADER CHECKSUM 6110600001.040.024 LEN := * - CHKTYPE; % NUMBER OF DATA BYTES 6110700001.040.024 END OF CASE 0; 6110800001.040.024 1: % NOT IMPLIMENTED 6110900001.040.024 2: 6111000001.040.024 ABORT(0); 6111100001.040.024 ELSE: % TYPE 3 HEADERS 6111200001.040.024 BEGIN 6111300001.040.024 LEN := * - 2 - CHKTYPE; % NUMBER OF DATA BYTES 6111400001.040.024 END; % OF ELSE CASE 6111500001.040.024 END OF CASES; 6111600001.040.024 REPLACE POINTER(DATA) BY RPD:RPD FOR LEN,NULC; 6111700001.040.024 IF REAL(DEBUG) GTR 1 THEN % DISPLAY THE DATA 6111800001.040.024 BEGIN 6111900001.040.024 BUGH("CKSUM:",CHKSUM); 6112000001.040.024 BUGH("RCHK: ",REAL(RPD,CHKTYPE)); 6112100001.040.024 IF LEN > 0 THEN 6112200001.040.024 BUGN("DATA: ",DATA); 6112300001.040.024 END; 6112400001.040.024 IF CHKSUM.[47:8*CHKTYPE] NEQ REAL(RPD,CHKTYPE) THEN 6112500001.040.027 BEGIN % SOMETIMES REDUCES RECOVERY TIME 6112600001.040.027 IF CHKTYPE = CSTYPE1 THEN % WITH A BLOCK CHECK MIS-MATCH 6112700001.040.027 ABORT("Q") % BETWEEN KERMITS. 'S' PACKETS 6112800001.040.027 ELSE % MUST HAVE TYPE 1. SERVER IDLE 6112900001.040.027 BEGIN % 'N' PACKETS WILL BE TYPE 1. 6113000001.040.027 IF NOT (TYPE = "S" OR TYPE ="N") THEN 6113100001.040.027 ABORT("Q") 6113200001.040.027 ELSE 6113300001.040.027 BEGIN 6113400001.040.027 INTEGER CSTYPE; 6113410001.040.027 IF TYPE = "S" THEN 6113500001.040.027 RPD := * + (CHKTYPE - (CSTYPE := CSTYPE1)) 6113510001.040.027 ELSE 6113520001.040.027 CSTYPE := LEN - 2; % ALWAYS TRUE FOR NAK'S 6113530001.040.027 CHKSUM := CHECKSUM(RPC,OFFSET(RPD)-OFFSET(RPC),CSTYPE); 6113600001.040.027 IF REAL(DEBUG) > 1 THEN 6113700001.040.027 BEGIN 6113800001.040.027 BUGH("2CHK: ",CHKSUM); 6113900001.040.027 BUGH("2RCK: ",REAL(RPD,CSTYPE)); 6114000001.040.027 END; 6114100001.040.027 IF CHKSUM.[47:8*CSTYPE] NEQ REAL(RPD,CSTYPE) THEN 6114200001.040.027 ABORT("Q") 6114300001.040.027 ELSE 6114400001.040.027 BEGIN 6114500001.040.027 THECHKTYPE := CHKTYPE := CSTYPE; 6114600001.040.027 IF TYPE = "S" THEN % NOT ALL THE DATA GOT MOVED 6114700001.040.027 ABORT("Q"); 6114800001.040.027 END; 6114900001.040.027 END; 6115000001.040.027 END; 6115100001.040.027 END; % SECOND CHANCE TRASH 6115200001.040.027 RPACK := TYPE; 6115300001.040.024 QUIT: 6115400001.040.024 WHEN(MYPAUSE); % WAIT BEFORE SENDING ACK 6115500001.040.024 END OF RPACK; 6115600001.040.024 % 6200000001.040.034 % G E T C H A R S 6200100001.040.034 % 6200200001.040.034 % GET CHARACTERS FROM A DISK FILE AND HAND THEM TO BUFILL. CONVERT 6200300001.040.034 % FIXED LENGTH RECORDS TO VARIABLE LENGTH, AND ADD CR, LF IF NEEDED. 6200400001.040.034 % 6200500001.040.034 REAL PROCEDURE GETCHARS(FID); 6200600001.040.034 FILE FID; 6200700001.040.034 BEGIN 6200800001.040.034 POINTER P,Q; 6200900001.040.034 REAL R; 6201000001.040.034 6201100001.040.034 IF NOT READ(FID,RECSIZ_,GBUF_) THEN 6201200001.040.034 BEGIN 6201300001.040.034 PG_ := POINTER(GBUF_); 6201400001.040.034 GCNT_ := RECSIZ_*UNITS_; 6201500001.040.034 IF NOT RAW THEN % ADD THE RECORD SEPARATER 6201600001.040.040 BEGIN 6201700001.040.034 IF FIXEDRECS THEN 6201800001.040.040 BEGIN 6201900001.040.034 REPLACE PG_ + GCNT_ BY CH(CR,1),CH(NL,1); 6202000001.040.034 GCNT_ := * + 2; 6202100001.040.034 END 6202200001.040.034 ELSE % STRIP TRAILING BLANKS 6202300001.040.040 BEGIN % (OR LSS BLANK) 6202400001.040.040 Q := PG_; 6202500001.040.040 DO % FIND LAST NON-BLANK 6202600001.040.040 BEGIN 6202700001.040.040 SCAN P:Q FOR R:GCNT_ UNTIL LEQ " "; 6202800001.040.040 SCAN Q:P FOR GCNT_:R WHILE LEQ " "; 6202900001.040.040 END 6203000001.040.040 UNTIL GCNT_ LEQ 0; 6203100001.040.040 REPLACE P BY CH(CR,1),CH(NL,1); 6203200001.040.040 GCNT_ := RECSIZ_*UNITS_ - R + 2; 6203300001.040.040 END; 6203400001.040.040 END; 6203500001.040.034 GETCHARS := GCNT_; 6203600001.040.034 END 6203700001.040.034 ELSE % IO ERROR 6203800001.040.034 BEGIN 6203900001.040.034 GETCHARS := 0; 6204000001.040.034 END; 6204100001.040.034 END OF GETCHARS; 6204200001.040.034 % 6250000001.040.034 % P A C K D A T A 6250100001.040.034 % 6250200001.040.034 % COPIES DATA FROM SOURCE TO DESTINATION DOING COMPRESSION AND 6250300001.040.034 % NECESSARY CHARACTER QUOTING FOR KERMIT PACKETS 6250400001.040.034 % 6250500001.040.034 INTEGER PROCEDURE PACKDATA(SPTR,SCOUNT,DPTR,SPACEAVAILABLE); 6250600001.040.034 VALUE SPACEAVAILABLE; 6250700001.040.034 INTEGER SCOUNT,SPACEAVAILABLE; 6250800001.040.034 POINTER SPTR,DPTR; 6250900001.040.034 BEGIN 6251000001.040.034 INTEGER COUNT 6251100001.040.034 ,CHAR 6251200001.040.034 ; 6251300001.040.034 BOOLEAN REPEATING; 6251400001.040.034 DEFINE EMIT (X) = 6251500001.040.034 BEGIN 6251600001.040.034 REPLACE DPTR:DPTR BY X; 6251700001.040.034 SPACEAVAILABLE := * - 1; 6251800001.040.034 PACKDATA := * + 1; 6251900001.040.034 END# 6252000001.040.034 ,EMIT2(X,Y) = 6252100001.040.034 BEGIN 6252200001.040.034 REPLACE DPTR:DPTR BY X,Y; 6252300001.040.034 SPACEAVAILABLE := * - 2; 6252400001.040.034 PACKDATA := * + 2; 6252500001.040.034 END# 6252600001.040.034 ,EMITN(X,N) = 6252700001.040.034 BEGIN 6252800001.040.034 REPLACE DPTR:DPTR BY X FOR N; 6252900001.040.034 SPACEAVAILABLE := * - N; 6253000001.040.034 PACKDATA := * + N; 6253100001.040.034 END# 6253200001.040.034 ; 6253300001.040.034 WHILE SPACEAVAILABLE GEQ 5 DO % THERE'S ROOM FOR WORST CASE 6253400001.040.034 BEGIN 6253500001.040.034 CHAR := REAL(SPTR,1); 6253600001.040.034 IF REPTOK THEN % FIND IF CHAR IS REPEATED 6253700001.040.034 BEGIN 6253800001.040.034 SCAN SPTR FOR COUNT:SCOUNT WHILE = CHAR; 6253900001.040.034 COUNT := MIN(SCOUNT - COUNT,MAXREPT); 6254000001.040.034 REPEATING := COUNT > 1; 6254100001.040.034 END 6254200001.040.034 ELSE % PROCESS ONLY ONE CHAR 6254300001.040.034 BEGIN 6254400001.040.034 COUNT := 1; 6254500001.040.034 END; 6254600001.040.034 6254700001.040.034 IF BOOLEAN(CHAR).[7:1] THEN 6254800001.040.034 BEGIN 6254900001.040.034 IF QBIN NEQ "N" THEN % WE'LL NEED AN 8-BIT QUOTE 6255000001.040.034 BEGIN 6255100001.040.034 IF REPEATING THEN 6255200001.040.034 EMIT2(CH(REPT,1),CH(TOCHAR(COUNT),1)); 6255300001.040.034 EMIT(CH(QBIN,1)); 6255400001.040.034 REPEATING := FALSE; % WE'VE ALREADY EMITTED THE COUNT 6255500001.040.034 % REPLACE SPTR BY SPTR FOR COUNT WITH STRIP_PARITY; 6255600001.040.034 CHAR := * & 0[7:1]; % NOW IT'S < 128 6255700001.040.034 END; 6255800001.040.034 END; 6255900001.040.034 IF CHAR IN ACNTRL[0] THEN % CONTROL OR KERMIT 'QUOTE' 6256000001.040.034 BEGIN 6256100001.040.034 IF REPEATING THEN 6256200001.040.034 EMIT2(CH(REPT,1),CH(TOCHAR(COUNT),1)); 6256300001.040.034 EMIT(CH(QUOTE,1)); % THE KERMIT 'QUOTE' 6256400001.040.034 IF CHAR IN BCNTRL[0] THEN % IF IT'S A KERMIT 'QUOTE' 6256500001.040.034 EMIT(CH(CHAR,1)) % JUST SEND IT 6256600001.040.034 ELSE 6256700001.040.034 EMIT(CH(CTL(CHAR),1)); % OTHERWISE 'CTL' IT 6256800001.040.034 END 6256900001.040.034 ELSE % PLAIN OLD TEXT 6257000001.040.034 BEGIN 6257100001.040.034 IF REPEATING THEN 6257200001.040.034 BEGIN 6257300001.040.034 IF COUNT > REPTTHRESH THEN % FOR PLAIN TEXT 6257400001.040.034 BEGIN 6257500001.040.034 EMIT2(CH(REPT,1),CH(TOCHAR(COUNT),1)); 6257600001.040.034 EMIT(CH(CHAR,1)); 6257700001.040.034 END 6257800001.040.034 ELSE 6257900001.040.034 EMITN(SPTR,COUNT) 6258000001.040.034 END 6258100001.040.034 ELSE 6258200001.040.034 EMIT(CH(CHAR,1)); 6258300001.040.034 END; 6258400001.040.034 SPTR := * + COUNT; 6258500001.040.034 IF SCOUNT := * - COUNT LEQ 0 THEN 6258600001.040.034 BEGIN 6258700001.040.034 SPACEAVAILABLE := 0; % DROP OUT OF THE LOOP 6258800001.040.034 END; 6258900001.040.034 END; 6259000001.040.034 END PACKDATA; 6259100001.040.034 % 6300000001.040.034 % 6300100001.040.034 % B U F I L L 6300200001.040.034 % 6300300001.040.034 % GET A BUFFERFUL OF DATA FROM THE FILE THAT'S BEING SENT. 6300400001.040.034 % CONTROL-QUOTING, 8-BIT & REPEAT COUNT PREFIXES ARE ALL 6300500001.040.034 % HANDLED. 6300600001.040.034 6300700001.040.034 6300800001.040.034 REAL PROCEDURE BUFILL(FID,BUFFER); 6300900001.040.034 FILE FID; 6301000001.040.034 ARRAY BUFFER[0]; 6301100001.040.034 BEGIN 6301200001.040.034 POINTER PB; 6301300001.040.034 INTEGER SPACEAVAILABLE; 6301400001.040.034 PB := POINTER(BUFFER); 6301500001.040.034 SPACEAVAILABLE := SPSIZ - CHKTYPE - 2; 6301600001.040.034 IF GCNT_ LEQ 0 THEN % NOTHING IN THE INPUT BUFFER 6301700001.040.034 BEGIN 6301800001.040.034 IF (GCNT_ := GETCHARS(FID)) LEQ 0 THEN 6301900001.040.034 BEGIN % NOTHING TO PROCESS 6302000001.040.034 SPACEAVAILABLE := 0; % STAY OUT OF THE LOOP 6302100001.040.034 END; 6302200001.040.034 END; 6302300001.040.034 WHILE SPACEAVAILABLE GEQ 5 DO % ROOM FOR WORST CASE 6302400001.040.034 BEGIN 6302500001.040.034 SPACEAVAILABLE := * - PACKDATA(PG_,GCNT_,PB,SPACEAVAILABLE); 6302600001.040.034 IF GCNT_ LEQ 0 THEN 6302700001.040.034 BEGIN 6302800001.040.034 IF (GCNT_ := GETCHARS(FID)) LEQ 0 THEN 6302900001.040.034 BEGIN % NOTHING TO PROCESS 6303000001.040.034 SPACEAVAILABLE := 0; % DROP OUT OF THE LOOP 6303100001.040.034 END; 6303200001.040.034 END; 6303300001.040.034 END LOOP; 6303400001.040.034 BUFILL := OFFSET(PB); 6303500001.040.034 REPLACE PB BY NULC; % NEEDED BY BUGN 6303600001.040.034 END BUFILL; 6303700001.040.034 6303800001.040.034 % 6310000001.040.036 % M A K E P A C K E T D A T A 6310100001.040.036 % 6310200001.040.036 % TAKES AN ARRAY OF DATA AND CONVERTS IT TO PACKET FORM. ALL THE 6310300001.040.036 % PARAMETERS ARE CALL BY VALUE, WHICH DIFFERS FROM PACKDATA. 6310400001.040.036 % 6310500001.040.036 INTEGER PROCEDURE MAKEPACKETDATA(SPTR,SCOUNT,DPTR,SPACEAVAILABLE); 6310600001.040.036 VALUE SPTR,SCOUNT,DPTR,SPACEAVAILABLE; 6310700001.040.036 POINTER SPTR,DPTR; 6310800001.040.036 INTEGER SCOUNT,SPACEAVAILABLE; 6310900001.040.036 BEGIN 6311000001.040.036 MAKEPACKETDATA := PACKDATA(SPTR,SCOUNT,DPTR,SPACEAVAILABLE); 6311100001.040.036 IF SPACEAVAILABLE > 0 THEN 6311200001.040.036 REPLACE DPTR BY NULC; % NEEDED BY BUGN 6311300001.040.036 END MAKEPACKETDATA; 6311400001.040.036 % 6400000001.040.035 % W R I T E O U T P U T 6400200001.040.035 % 6400300001.040.035 % WRITE OUT OUTPUT BUFFER AND RESET POINTERS; 6400400001.040.035 % 6400500001.040.035 PROCEDURE WRITEOUTPUT(FID); 6400600001.040.035 FILE FID; 6400700001.040.035 BEGIN 6400800001.040.035 IF PCNT_ > 0 THEN % PRESUME PCNT_ = 0 IF RAW 6400900001.040.035 REPLACE PP_ BY " " FOR PCNT_; 6401000001.040.035 BRD := WRITE(FID,RECSIZ_,PBUF_); 6401100001.040.035 PP_ := POINTER(PBUF_); 6401200001.040.035 PCNT_ := RECSIZ_*UNITS_; 6401300001.040.035 END OF WRITEOUTPUT; 6401400001.040.035 % 6410000001.040.035 % P U T C 6410100001.040.035 % 6410200001.040.035 % PUT OUT A STRING (1 OR MORE) OF CHARACTERS ALL THE SAME 6410300001.040.035 % 6410400001.040.035 PROCEDURE PUTC(C,COUNT,FID); 6410500001.040.035 VALUE C,COUNT; 6410600001.040.035 REAL C; 6410700001.040.035 INTEGER COUNT; 6410800001.040.035 FILE FID; 6410900001.040.035 BEGIN 6411000001.040.035 INTEGER LCOUNT; 6411100001.040.035 6411200001.040.035 LCOUNT := (47 + 8); 6411300001.040.035 THRU MIN (COUNT,5) DO % REPLICATE C FOR REPLACE 6411400001.040.035 BEGIN % ALREADY 1 IN C.[7:8] 6411500001.040.035 C := * & C [(LCOUNT := * - 8):8]; 6411600001.040.035 END; 6411700001.040.035 WHILE COUNT > 0 DO 6411800001.040.035 BEGIN 6411900001.040.035 IF PCNT_ LEQ 0 THEN % NO ROOM IN OUTPUT BUFFER 6412000001.040.035 BEGIN 6412100001.040.035 WRITEOUTPUT(FID); 6412200001.040.035 END; 6412300001.040.035 REPLACE PP_:PP_ BY C FOR LCOUNT := MIN(COUNT,PCNT_); 6412400001.040.035 COUNT := * - LCOUNT; 6412500001.040.035 PCNT_ := * - LCOUNT; 6412600001.040.035 END; 6412700001.040.035 END OF PUTC; 6412800001.040.035 % 6420000001.040.035 % P U T C H A R S 6420100001.040.035 % 6420200001.040.035 % PUT A STRING OF CHARACTERS IN THE OUTPUT BUFFER. IF THERE ARE 6420300001.040.035 % MORE THAN FIT THEN WRITE OUT THE BUFFER; 6420400001.040.035 % 6420500001.040.035 PROCEDURE PUTCHARS(PB,COUNT,FID); 6420600001.040.035 VALUE COUNT; 6420700001.040.035 POINTER PB; 6420800001.040.035 INTEGER COUNT; 6420900001.040.035 FILE FID; 6421000001.040.035 BEGIN 6421100001.040.035 INTEGER LCOUNT; 6421200001.040.035 6421300001.040.035 WHILE COUNT > 0 DO 6421400001.040.035 BEGIN 6421500001.040.035 IF PCNT_ LEQ 0 THEN % NO ROOM IN OUTPUT BUFFER 6421600001.040.035 BEGIN 6421700001.040.035 WRITEOUTPUT(FID); 6421800001.040.035 END; 6421900001.040.035 REPLACE PP_:PP_ BY PB:PB FOR LCOUNT := MIN(COUNT,PCNT_); 6422000001.040.035 COUNT := * - LCOUNT; 6422100001.040.035 PCNT_ := * - LCOUNT; 6422200001.040.035 END; 6422300001.040.035 END OF PUTCHARS; 6422400001.040.035 % 6430000001.040.035 % U N P A C K D A T A 6430100001.040.035 % 6430200001.040.035 % PROCESSES PACKET DATA UN-DOING COMPRESSION AND QUOTING SEQUENCES. 6430300001.040.035 % RATHER THAN PUTTING THE DATA IN THE OUTPUT BUFFER WE LOCATE IT, 6430400001.040.035 % AND CONVERT IT, AND THEN LET THE CALLER DECIDE WHAT TO DO WITH IT 6430500001.040.035 % BECAUSE THE CALLERS HANDLE SOME SPECIAL CHARACTERS DIFFERENTLY. 6430600001.040.035 % 6430700001.040.035 REAL PROCEDURE UNPACKDATA(PB,LEN,CNT); 6430800001.040.035 POINTER PB; 6430900001.040.035 INTEGER LEN,CNT; 6431000001.040.035 BEGIN 6431100001.040.035 BOOLEAN HIBIT; 6431200001.040.035 REAL T; 6431300001.040.035 6431400001.040.035 SCAN PB FOR CNT:LEN UNTIL IN BCNTRL[0]; 6431500001.040.035 IF CNT := LEN - CNT > 0 THEN % A STRING OF NON-CONTROL CHARACTERS 6431600001.040.035 BEGIN 6431700001.040.035 LEN := * - CNT; 6431800001.040.035 END 6431900001.040.035 ELSE 6432000001.040.035 BEGIN 6432100001.040.035 HIBIT := FALSE; % INITIALIZE IT 6432200001.040.035 CNT := 1; % WE HAVE 1 CHARACTER AT LEAST 6432300001.040.035 T := REAL(PB,1); % GET CHARACTER 6432400001.040.035 PB := *+1; LEN := *-1; % BUMP THE POINTER 6432500001.040.035 IF REPTOK THEN % WE CAN USE REPEAT COUNTS 6432600001.040.035 IF T = MYREPT THEN % WE ARE REPEATING 6432700001.040.035 BEGIN 6432800001.040.035 CNT := UNCHAR(REAL(PB,1));% GET THE COUNT 6432900001.040.035 PB := *+1; LEN := *-1; % BUMP THE POINTER 6433000001.040.035 T := REAL(PB,1); % GET THE NEXT CHARACTER 6433100001.040.035 PB := *+1; LEN := *-1; % BUMP THE POINTER 6433200001.040.035 END; 6433300001.040.035 IF HIBITOK THEN % WE CAN QUOTE 8-BIT STUFF 6433400001.040.035 IF T = MYQBIN THEN % WE HAVE AN 8-BIT THING 6433500001.040.035 BEGIN 6433600001.040.035 HIBIT := TRUE; % SET THE FLAG 6433700001.040.035 T := REAL(PB,1); % GET THE NEXT CHARACTER 6433800001.040.035 PB := *+1; LEN := *-1; % BUMP THE POINTER 6433900001.040.035 END; 6434000001.040.035 IF T = MYQUOTE THEN % WE HAVE A QUOTED THING 6434100001.040.035 BEGIN 6434200001.040.035 T := REAL(PB,1); % GET THE NEXT CHARACTER 6434300001.040.035 PB := *+1; LEN := *-1; % BUMP THE POINTER 6434400001.040.035 IF NOT T IN BCNTRL[0] THEN % IT'S NOT QUOTE, QBIN OR REPT 6434500001.040.035 T := CTL(T); % UNCONTROLIFY IT 6434600001.040.035 END; 6434700001.040.035 IF HIBIT THEN % SET THE 8-TH BIT 6434800001.040.035 T := * & 1 [7:1]; 6434900001.040.035 UNPACKDATA := T & 1 [47:01]; % RETURN THE CHARACTER 6435000001.040.039 END; % BIT 47 IS IN CASE CHAR = NUL 6435100001.040.039 END UNPACKDATA; 6435200001.040.035 6500000001.040.035 % 6500100001.040.035 % B U F E M P 6500200001.040.035 % 6500300001.040.035 % PUT DATA FROM AN INCOMING PACKET INTO A FILE. 6500400001.040.035 6500500001.040.035 6500600001.040.035 PROCEDURE BUFEMP(FID,BUFFER,LEN); 6500700001.040.035 VALUE LEN; 6500800001.040.035 REAL LEN; 6500900001.040.035 FILE FID; 6501000001.040.035 ARRAY BUFFER[0]; % BUFFER 6501100001.040.035 BEGIN 6501200001.040.035 INTEGER CNT; 6501300001.040.035 POINTER PB; 6501400001.040.035 REAL T; 6501500001.040.035 PB := POINTER(BUFFER); 6501600001.040.035 WHILE LEN > 0 DO % DECREMENTED BY UNPACKDATA 6501700001.040.035 BEGIN 6501800001.040.035 IF (T := UNPACKDATA(PB,LEN,CNT)) IS 0 THEN 6501900001.040.039 BEGIN 6502000001.040.035 PUTCHARS(PB,CNT,FID); 6502100001.040.035 END 6502200001.040.035 ELSE 6502300001.040.035 BEGIN 6502400001.040.035 IF T = HT THEN % IS IT A TAB? 6502500001.040.035 IF EXPTABS THEN % WE NEED TO EXPAND IT 6502600001.040.035 THRU CNT DO % PUT OUT SPACES 6502700001.040.035 PUTC(SP,(TABLEN-((RECSIZ_*UNITS_-PCNT_) MOD TABLEN)),FID) 6502800001.040.035 ELSE 6502900001.040.035 PUTC(HT,CNT,FID) % JUST PUT OUT THE TABS 6503000001.040.035 ELSE % IT'S NOT A TAB 6503100001.040.035 IF T = CR THEN % [1.017] IT'S A CR 6503200001.040.035 IF (RAW) THEN % DON'T FIDDLE WITH IT 6503300001.040.035 PUTC(CR,CNT,FID) % PUT OUT THE CR'S 6503400001.040.035 ELSE % IT'S PROBABLY EXTRA, SO 6503500001.040.035 % JUST EAT IT! 6503600001.040.035 ELSE % NOT A CR, EITHER 6503700001.040.035 IF T = NL THEN % IT'S A NEWLINE 6503800001.040.035 IF (RAW) THEN % DON'T FIDDLE 6503900001.040.035 PUTC(NL,CNT,FID) % PUT THEM IN THE BUFFER 6504000001.040.035 ELSE % WE ARE INTERPRETING NL'S 6504100001.040.035 THRU CNT DO 6504200001.040.035 WRITEOUTPUT(FID) % DUMP THE BUFFER 6504300001.040.035 ELSE % NOTHING SPECIAL 6504400001.040.035 PUTC(T,CNT,FID); % PUT THEM OUT 6504500001.040.035 END; 6504600001.040.035 END; 6504700001.040.035 END BUFEMP; 6504800001.040.035 % 6510000001.040.036 % G E T P A C K E T D A T A 6510100001.040.036 % 6510200001.040.036 % TAKES AN ARRAY OF PACKET FORM DATA, 'UNPACKS' IT AND COPIES THE 6510300001.040.036 % UNPACKED DATA TO THE OUTPUT ARRAY. OVERFLOW IS NOT SAVED, NOR IS 6510400001.040.036 % THE NUMBER OF INPUT CHARACTERS PROCESSED SAVED. THIS IS A ONE 6510500001.040.036 % SHOT PACKET-TO-ARRAY PROCEDURE. 6510600001.040.036 % 6510700001.040.036 INTEGER PROCEDURE GETPACKETDATA(SPTR,SCOUNT,DPTR,DCOUNT); 6510800001.040.036 VALUE SPTR,SCOUNT,DPTR,DCOUNT; 6510900001.040.036 POINTER SPTR,DPTR; 6511000001.040.036 INTEGER SCOUNT,DCOUNT; 6511100001.040.036 BEGIN 6511200001.040.036 REAL T; 6511300001.040.036 INTEGER CNT; 6511400001.040.036 6511500001.040.036 WHILE SCOUNT > 0 DO 6511600001.040.036 BEGIN 6511700001.040.036 IF (T := UNPACKDATA(SPTR,SCOUNT,CNT)) IS 0 THEN 6511800001.040.039 BEGIN 6511900001.040.036 REPLACE DPTR:DPTR BY SPTR:SPTR FOR CNT:=MIN(DCOUNT,CNT); 6512000001.040.036 END 6512100001.040.036 ELSE 6512200001.040.036 BEGIN 6512300001.040.036 T := * & T [47:8]; 6512400001.040.036 THRU CNT:=MIN(DCOUNT,CNT) DO 6512500001.040.036 BEGIN 6512600001.040.036 REPLACE DPTR:DPTR BY T FOR 1; 6512700001.040.036 END; 6512800001.040.036 END; 6512900001.040.036 GETPACKETDATA := * + CNT; 6513000001.040.036 IF DCOUNT := * - CNT LEQ 0 THEN 6513100001.040.036 BEGIN 6513200001.040.036 SCOUNT := 0; % DROP OUT OF LOOP 6513300001.040.036 END; 6513400001.040.036 END; 6513500001.040.036 END GETPACKETDATA; 6513600001.040.036 % 6600000001.040.024 % C H E C K S U M 6600100001.040.024 % 6600200001.040.024 % CHECKSUM A PACKET 6600300001.040.024 6600400001.040.024 6600500001.040.024 REAL PROCEDURE CHECKSUM(PB,LEN,TYPE); 6600900001.040.024 VALUE PB,LEN,TYPE; 6601000001.040.024 POINTER PB; % THE DATA TO BE CHECKSUMED 6601100001.040.024 INTEGER LEN,TYPE; % LENGTH OF DATA, CHECKSUM TYPE 6601200001.040.024 BEGIN 6601300001.040.024 INTEGER SUM; % HOLDS CHECKSUM 6601400001.040.024 INTEGER C,Q; % FOR CRC CHECKSUM 6601410001.040.027 DEFINE XOR(A,B) = (NOT(BOOLEAN(A) EQV BOOLEAN(B)))#; 6601420001.040.027 % 6601500001.040.024 CASE TYPE OF 6601600001.040.024 BEGIN 6601700001.040.024 CSTYPE1: 6601800001.040.027 CSTYPE2: 6601900001.040.027 BEGIN % TYPE 1 AND 2 CHECKSUMS 6602000001.040.027 SUM := REAL(PB,1); 6602100001.040.027 THRU LEN-1 DO % ADD UP THE BYTES 6602200001.040.027 BEGIN 6602300001.040.027 SUM := * + REAL(PB := * + 1,1); 6602400001.040.027 END; 6602500001.040.027 IF TYPE = CSTYPE1 THEN 6602600001.040.027 BEGIN 6602700001.040.027 SUM := *.[7:8]; % 'FOLD' THE SUM 6602800001.040.027 SUM := (SUM + SUM.[7:2]).[5:6]; 6602900001.040.027 CHECKSUM := 0 & (TOCHAR(SUM))[47:8]; % READY FOR PACKET 6603000001.040.027 END 6603100001.040.027 ELSE 6603200001.040.027 BEGIN 6603300001.040.027 CHECKSUM := 0 & (TOCHAR(SUM.[11:6]))[47:8] 6603400001.040.027 & (TOCHAR(SUM.[ 5:6]))[39:8]; 6603500001.040.027 END 6603600001.040.027 END; % CASE 1 AND 2 6603700001.040.027 CSTYPE3: % 16-BIT CRC CHECKSUM 6603800001.040.027 BEGIN 6603900001.040.027 THRU LEN DO 6604000001.040.027 BEGIN 6604100001.040.027 C := REAL(PB,1); 6604200001.040.027 PB := * + 1; 6604300001.040.027 Q := REAL(XOR((SUM),(C))).[3:4]; 6604400001.040.027 % Q = (CRC XOR C) AND 15; 6604500001.040.027 SUM := REAL(XOR((SUM.[15:12]),(Q*4225))); 6604600001.040.027 % CRC = (CRC / 16) XOR (Q * 4225); 6604700001.040.027 Q := REAL(XOR((SUM),(C.[7:4]))).[3:4]; 6604800001.040.027 % Q = (CRC XOR (C / 16)) AND 15; 6604900001.040.027 SUM := REAL(XOR((SUM.[15:12]),(Q*4225))); 6605000001.040.027 % CRC = (CRC / 16) XOR (Q * 4225); 6605100001.040.027 END; 6605200001.040.027 CHECKSUM := 0 & (TOCHAR(SUM.[15:4])) [47:8] 6605300001.040.027 & (TOCHAR(SUM.[11:6])) [39:8] 6605400001.040.027 & (TOCHAR(SUM.[ 5:6])) [31:8]; 6605500001.040.027 END; % CHECKSUM TYPE 3 6605600001.040.027 END OF CASES; 6605700001.040.024 END OF CHECKSUM; 6605800001.040.024 $ENDSEGMENT 6609900001.040.024 % 6700000001.040.037 % WARNING ! WARNING ! WARNING ! WARNING ! WARNING 6700100001.040.037 % THE FOLLOWING PROCEDURE ONLY HAS '$ RESET ASCII' SO IT CAN 6700200001.040.037 % EASILY MANIPULATE FILE TITLES. DON'T MESS IT UP. 6700300001.040.037 % 6700400001.040.037 $ RESET ASCII 6700500001.040.037 % 6700600001.040.037 % END OF WARNING 6700700001.040.037 % 6700800001.040.037 % C O B B L E 6700900001.040.037 % 6701000001.040.037 % TAKE AN ARBITRARY STRING OF CHARACTERS AND ATTEMP TO MAKE A 6701100001.040.037 % USABLE FILE NAME FROM THEM. 6701200001.040.037 % 6701300001.040.037 BOOLEAN PROCEDURE COBBLE(FILENAME,LEN); 6701400001.040.037 VALUE LEN; 6701500001.040.037 ARRAY FILENAME[0]; 6701600001.040.037 INTEGER LEN; 6701700001.040.037 BEGIN 6701800001.040.037 % RETURNS TRUE IF FILE TITLE CAN NOT BE MANIPULATED INTO A 6701900001.040.037 % USABLE TITLE. 6702000001.040.037 EBCDIC ARRAY COBBLEDNAME,STDCOBBLEDNAME[0:255]; 6702100001.040.037 POINTER PN,PM; 6702200001.040.037 INTEGER NAMECOUNT; 6702300001.040.037 DEFINE PERIOD = "."# 6702400001.040.037 ,QUOTE = """# 6702500001.040.037 ,SLASH = "/"# 6702600001.040.037 ; 6702700001.040.037 TRUTHSET NULLQUOTESLASH (NULC OR QUOTE OR SLASH) 6702800001.040.037 ,NULLQUOTE (NULC OR QUOTE) 6702900001.040.037 ; 6703000001.040.037 % 6703100001.040.037 PM := POINTER(FILENAME,8); 6703200001.040.037 PN := COBBLEDNAME[0]; 6703300001.040.037 SCAN PM:PM FOR LEN:LEN WHILE = SLASH; 6703400001.040.037 REPLACE PM + LEN BY NULC; 6703500001.040.037 DO 6703600001.040.037 BEGIN 6703700001.040.037 REPLACE PN:PN BY QUOTE; 6703800001.040.037 IF PM = QUOTE THEN 6703900001.040.037 BEGIN 6704000001.040.037 REPLACE PN:PN BY PM:PM+1 FOR 17 UNTIL IN NULLQUOTE; 6704100001.040.037 IF PM = QUOTE THEN 6704200001.040.037 BEGIN 6704300001.040.037 PM := * + 1; 6704400001.040.037 END; 6704500001.040.037 END 6704600001.040.037 ELSE 6704700001.040.037 BEGIN 6704800001.040.037 REPLACE PN:PN BY PM:PM FOR 17 UNTIL IN NULLQUOTESLASH; 6704900001.040.037 END; 6705000001.040.037 REPLACE PN:PN BY QUOTE; 6705100001.040.037 WHILE PM = SLASH DO % WE DONT HAVE A COUNT SO 6705200001.040.037 BEGIN % WE CAN'T DO A SCAN 6705300001.040.037 PM := * + 1; 6705400001.040.037 END; 6705500001.040.037 IF NAMECOUNT := * + 1 < 12 THEN 6705600001.040.037 BEGIN 6705700001.040.037 IF PM NEQ NULC THEN 6705800001.040.037 BEGIN 6705900001.040.037 REPLACE PN:PN BY SLASH; 6706000001.040.037 END; 6706100001.040.037 END; 6706200001.040.037 END 6706300001.040.037 UNTIL PM = NULC OR NAMECOUNT GEQ 12; 6706400001.040.037 REPLACE PN:PN BY PERIOD; 6706500001.040.037 PN := COBBLEDNAME[0]; 6706600001.040.037 IF NOT COBBLE := DISPLAYTOSTANDARD(PN,STDCOBBLEDNAME[0]) THEN 6706700001.040.037 BEGIN 6706800001.040.037 PM := POINTER(FILENAME); 6706900001.040.037 STANDARDTODISPLAY(STDCOBBLEDNAME[0],PM); 6707000001.040.037 END; 6707100001.040.037 END OF COBBLE; 6707200001.040.037 % 6707300001.040.037 % WARNING ! 6707400001.040.037 % THE PRECEEDING PROCEDURE HAS '$ RESET ASCII'. DON'T MESS IT UP. 6707500001.040.037 % 6707600001.040.037 $ SET ASCII 6707700001.040.037 % 6707800001.040.037 % END OF WARNING 6707900001.040.037 % 6708000001.040.037 70000000 % 70001000 % S P A R 70002000 % 70003000 % FILL THE DATA ARRAY WITH MY SEND-INIT PARAMETERS 70004000 % 70005000 70006000 70007000 $BEGINSEGMENT 70008000 70009000 PROCEDURE SPAR(LEN,DATA,FIRSTCALL); 7001000001.040.025 VALUE FIRSTCALL; 7001010001.040.025 BOOLEAN FIRSTCALL; % OF SPAR:RPAR PAIR 7001020001.040.025 REAL LEN; 7001100001.040.025 ARRAY DATA[0]; 7001200001.040.025 BEGIN 7001300001.040.025 DEFINE FORCESEGMENT=#; % SO BEGINSEGMENT WILL WORK 7001400001.040.025 POINTER PD; % TEMPORARY POINTER 7001500001.040.025 REPLACE PD:PD := POINTER(DATA) BY 7001600001.040.025 CH(TOCHAR(MIN(MYPACKSIZ,SHORTPACKSIZ)),1) , 7001700001.040.029 % BIGGEST PACKET I CAN RECEIVE 7001710001.040.029 CH(TOCHAR(MYTIME),1) , % WHEN I WANT TO BE TIMED OUT 7001800001.040.025 CH(TOCHAR(MYPAD),1) , % HOW MUCH PADDING I NEED 7001900001.040.025 CH(CTL(MYPCHAR),1) , % PADDING CHARACTER I WANT 7002000001.040.025 CH(TOCHAR(MYEOL),1) , % END-OF-LINE CHARACTER I WANT 7002100001.040.025 CH(MYQUOTE,1) ; % CONTROL-QUOTE CHARACTER I SEND 7002200001.040.025 IF FIRSTCALL THEN % 7002300001.040.025 % IF SPAR IS CALLED FIRST (BEFORE RPAR) WE CONTROL 7002400001.040.025 % WHETHER OR NOT 8TH BIT QUOTING CAN BE DONE 7002500001.040.025 IF (BINARYON) THEN % 7002600001.040.025 REPLACE PD:PD BY CH(MYQBIN,1)% REQUEST 8TH BIT QUOTING 7002700001.040.025 ELSE % 7002800001.040.025 REPLACE PD:PD BY "N" % PREVENT 8TH BIT QUOTING 7002900001.040.025 ELSE % 7003000001.040.025 % IF SPAR IS CALLED SECOND (AFTER RPAR) WE 7003100001.040.025 % RESPOND TO THE REQUEST FROM THE REMOTE KERMIT 7003200001.040.025 IF (BINARYON)AND(HIBITOK) THEN % 7003300001.040.025 % IF 8TH BIT QUOTING REQUESTED, ACCEPT IF WE ARE IN BINARY MODE 7003400001.040.025 IF (QBIN = "Y") THEN % USE WHAT WE WANT 7003500001.040.025 BEGIN 7003600001.040.025 REPLACE PD:PD BY CH(MYQBIN,1); 7003700001.040.025 QBIN := MYQBIN; % USE MYQBIN CHAR 7003800001.040.025 END 7003900001.040.025 ELSE 7004000001.040.025 BEGIN 7004100001.040.025 REPLACE PD:PD BY "Y"; % ACK 8BIT QUOTE REQUEST 7004200001.040.025 MYQBIN := QBIN; % USE INCOMING QBIN CHAR 7004300001.040.025 END 7004400001.040.025 ELSE 7004500001.040.025 BEGIN 7004600001.040.025 % 8TH BIT QUOTING WILL NOT BE DONE 7004700001.040.025 REPLACE PD:PD BY "N"; % NAK 8TH BIT QUOTING 7004800001.040.025 HIBITOK := FALSE; 7004900001.040.025 END; 7005000001.040.025 7005100001.040.025 REPLACE PD:PD BY 7005200001.040.025 CH(TONUM(MYCHKTYPE),1); % MY PREFERED CHECKSUM TYPE 7005300001.040.027 IF FIRSTCALL THEN 7005400001.040.025 BEGIN 7005500001.040.025 % REQUEST REPEAT CHAR PROCESSING 7005600001.040.025 REPLACE PD:PD BY CH(MYREPT,1); 7005700001.040.025 END 7005900001.040.025 ELSE 7006000001.040.025 BEGIN 7006100001.040.025 % ACKNOWLEDGE REPEAT PROCESSING IF IT WAS REQUESTED 7006200001.040.025 IF (REPTOK) THEN 7006300001.040.025 REPLACE PD:PD BY CH(REPT,1) 7006400001.040.025 ELSE 7006500001.040.025 REPLACE PD:PD BY CH(SP,1); 7006600001.040.025 END; 7006800001.040.025 REPLACE PD:PD BY CH(TOCHAR( % 7007000001.040.029 0 & 0 [RESERVEDBIT5 :1] 7007100001.040.029 & 0 [RESERVEDBIT4 :1] 7007200001.040.029 & 0 [APACKETBIT :1] 7007300001.040.029 & 1 [WINDOWSBIT :1] 7007400001.040.029 & 1 [LONGPACKETBIT:1] 7007500001.040.029 & 0 [MORECAPASBIT :1] ),1); 7007600001.040.029 REPLACE PD:PD BY CH(TOCHAR(MYWINDOWSIZE),1); 7010000001.040.029 REPLACE PD:PD BY 7010100001.040.029 CH(TOCHAR(MYPACKSIZ DIV PACKETMOD),1), 7010200001.040.029 CH(TOCHAR(MYPACKSIZ MOD PACKETMOD),1); 7010300001.040.029 LEN := OFFSET(PD); 7090000001.040.025 IF REAL(DEBUG) GTR 1 THEN % EXPAND IT ALL 7090100001.040.025 BEGIN 7090200001.040.025 BUG1("My packet size = ",MYPACKSIZ); 7090300001.040.025 BUG1("My timeout = ",MYTIME); 7090400001.040.025 BUG1("My padding = ",MYPAD); 7090500001.040.025 BUGH("My padding character = ",MYPCHAR); 7090600001.040.025 BUGH("My end of line character = ",MYEOL); 7090700001.040.025 BUGC("My quote character = ",MYQUOTE); 7090800001.040.025 BUGC("My binary quote character = ",MYQBIN); 7090900001.040.025 BUGC("My checksum type = ",MYCHKTYPE); 7091000001.040.025 BUGC("My repeat character = ",MYREPT); 7091100001.040.025 BUG1("My checksum type = ",MYCHKTYPE); 7091200001.040.027 BUG1("My window size = ",MYWINDOWSIZE); 7091300001.040.029 IF REPTOK THEN 7095000001.040.025 BUG("WE ARE REPEATING") 7095100001.040.025 ELSE 7095200001.040.025 BUG("NO REPEAT CHARACTER"); 7095300001.040.025 IF HIBITOK THEN 7095400001.040.025 BUG("WE ARE BINARY QUOTING") 7095500001.040.025 ELSE 7095600001.040.025 BUG("NOT BINARY QUOTING"); 7095700001.040.025 IF WINDOWING THEN 7095800001.040.029 BUG("WE ARE WINDOWING") 7095900001.040.029 ELSE 7096000001.040.029 BUG("NOT WINDOWING"); 7096100001.040.029 IF LONGPACKETSOK THEN 7096200001.040.029 BUG("WE ARE USING LONG PACKETS") 7096300001.040.029 ELSE 7096400001.040.029 BUG("NO LONG PACKETS"); 7096500001.040.029 END; 7099000001.040.025 END SPAR; 7099100001.040.025 7099200001.040.025 75000000 % R P A R 75001000 % 75002000 % GET THE OTHER HOST'S SEND-INIT PARAMETERS 75003000 % 75004000 75005000 75006000 PROCEDURE RPAR(LEN,DATA,FIRSTCALL); 7500700001.040.025 VALUE FIRSTCALL; 7500710001.040.025 BOOLEAN FIRSTCALL; % OF RPAR:SPAR PAIR 7500720001.040.025 REAL LEN; 7500800001.040.025 ARRAY DATA[0]; 7500900001.040.025 BEGIN 7501000001.040.025 POINTER PD; 7501100001.040.025 INTEGER YOURCHKTYPE; % FOR DIAGNOSTICS ONLY 7501110001.040.027 BOOLEAN CAPAS; 7501120001.040.029 PD := POINTER(DATA); 7501200001.040.025 7501300001.040.025 LEN := * - 6; % FIRST 6 CHARACTERS PROCESSED 7501400001.040.025 SPSIZ := UNCHAR(REAL(PD,1)); % MAXIMUM SEND PACKET SIZE 7501500001.040.025 PD := *+1; 7501600001.040.025 TIMINT := UNCHAR(REAL(PD,1)); % WHEN I SHOULD TIME OUT 7501700001.040.025 PD := *+1; 7501800001.040.025 PAD := UNCHAR(REAL(PD,1)); % NUMBER OF PADS TO SEND 7501900001.040.025 PD := *+1; 7502000001.040.025 PCHAR := CTL(REAL(PD,1)); % PADDING CHARACTER TO SEND 7502100001.040.025 PD := *+1; 7502200001.040.025 EOL := UNCHAR(REAL(PD,1)); % EOL CHARACTER I MUST SEND 7502300001.040.025 PD := *+1; 7502400001.040.025 UNTABLE(ACNTRL,QUOTE); % TAKE IT OUT OF THE ATABLE 7502500001.040.025 UNTABLE(BCNTRL,QUOTE); % TAKE IT OUT OF THE BTABLE 7502600001.040.025 QUOTE := REAL(PD,1); % INCOMING DATA QUOTE CHARACTER 7502700001.040.025 TABLEIT(ACNTRL,QUOTE); % PUT NEW ONE IN THE ATABLE 7502800001.040.025 TABLEIT(BCNTRL,QUOTE); % PUT NEW ONE IN THE BTABLE 7502900001.040.025 % CHECK FOR REQUEST/ACKNOWLEDGE FOR 8TH BIT QUOTING 7503000001.040.025 HIBITOK := FALSE; % THE DEFAULT 7503100001.040.025 IF LEN := * - 1 GEQ 0 THEN % THERE IS SOMETHING TO LOOK AT 7503200001.040.025 BEGIN 7503300001.040.025 PD := * + 1; % MOVE TO QBIN 7503400001.040.025 UNTABLE(ACNTRL,QBIN); % TAKE OUT OF ATABLE 7503500001.040.025 UNTABLE(BCNTRL,QBIN); % TAKE OUT OF BTABLE 7503600001.040.025 QBIN := REAL(PD,1); % INCOMING 8BIT QUOTE 7503700001.040.025 IF FIRSTCALL THEN 7503800001.040.025 BEGIN 7503900001.040.025 % IF 8TH BIT MODE IS ENABLED, SEE IF INCOMING QBIN 7504000001.040.025 % CHAR REQUESTS 8TH BIT QUOTING 7504100001.040.025 IF (BINARYON) AND ((PD IN QUOTECHARS) OR (PD = "Y")) THEN 7504200001.040.025 BEGIN 7504300001.040.025 HIBITOK := TRUE; % YES, SET OK FLAG 7504400001.040.025 IF (PD = "Y") THEN 7504500001.040.025 BEGIN 7504600001.040.025 TABLEIT(ACNTRL,MYQBIN); % TABLE MY QBIN CHAR 7504700001.040.025 TABLEIT(BCNTRL,MYQBIN); % 7504800001.040.025 END 7504900001.040.025 ELSE 7505000001.040.025 BEGIN 7505100001.040.025 TABLEIT(ACNTRL,QBIN); % TABLE INCOMING QBIN 7505200001.040.025 TABLEIT(BCNTRL,QBIN); 7505300001.040.025 END; 7505400001.040.025 END 7505500001.040.025 END 7505600001.040.025 ELSE % SPAR WAS CALLED FIRST 7505700001.040.025 BEGIN % CHECK THE REPLY 7505800001.040.025 % IF 8TH BIT MODE IS ENABLED, SEE IF WE 7505900001.040.025 % GOT AN ACK TO OUR 8TH BIT QUOTE REQUEST 7506000001.040.025 IF (BINARYON) AND ((QBIN = "Y") OR (QBIN = MYQBIN)) THEN 7506100001.040.025 BEGIN 7506200001.040.025 HIBITOK := TRUE; % WILL DO 8TH BIT QUOTING 7506300001.040.025 TABLEIT(ACNTRL,MYQBIN); % TABLE MY QBIN CHAR 7506400001.040.025 TABLEIT(BCNTRL,MYQBIN); 7506500001.040.025 END 7506600001.040.025 END; 7506700001.040.025 END; 7506800001.040.025 THECHKTYPE := DEFCHKTYPE; % THE DEFAULT 7510000001.040.027 IF LEN := * - 1 GEQ 0 THEN 7510100001.040.027 BEGIN 7510200001.040.027 PD := * + 1; % MOVE TO CHECKSUMTYPE 7510300001.040.027 IF (YOURCHKTYPE := UNNUM(REAL(PD,1))) = MYCHKTYPE THEN 7510400001.040.027 THECHKTYPE := YOURCHKTYPE; 7510500001.040.027 END; 7510600001.040.027 REPTOK := FALSE; % THE DEFAULT 7520000001.040.025 IF LEN := * - 1 GEQ 0 THEN 7520100001.040.025 BEGIN 7520200001.040.025 PD := * + 1; % MOVE TO REPT CHAR 7520300001.040.025 UNTABLE(ACNTRL,REPT); % TAKE IT OUT OF ATABLE 7520400001.040.025 UNTABLE(BCNTRL,REPT); % TAKE IT OUT OF BTABLE 7520500001.040.025 REPT := REAL(PD,1); % INCOMING REPEAT CHAR 7520600001.040.025 IF FIRSTCALL THEN 7520700001.040.025 BEGIN 7520800001.040.025 % IF CHAR SENT IS A VALID QUOTE CHAR, WE ARE REPEATING 7520900001.040.025 IF (PD IN QUOTECHARS) THEN % VALID CHAR ? 7521000001.040.025 BEGIN 7521100001.040.025 REPTOK := TRUE; 7521200001.040.025 MYREPT := REPT; % USE THE ONE RECEIVED 7521300001.040.025 TABLEIT(ACNTRL,REPT); 7521400001.040.025 TABLEIT(BCNTRL,REPT); 7521500001.040.025 END; 7521600001.040.025 END 7521700001.040.025 ELSE 7521800001.040.025 BEGIN 7521900001.040.025 % IF CHAR MATCHES CHAR WE SENT, WE ARE REPEATING 7522000001.040.025 IF (REPT = MYREPT) THEN 7522100001.040.025 BEGIN 7522200001.040.025 REPTOK := TRUE; 7522300001.040.025 TABLEIT(ACNTRL,REPT); 7522400001.040.025 TABLEIT(BCNTRL,REPT); 7522500001.040.025 END; 7522600001.040.025 END; 7522700001.040.025 END; 7522800001.040.025 % RESERVEDBIT5 7523000001.040.029 % RESERVEDBIT4 7523100001.040.029 % A PACKETS 7523200001.040.029 WINDOWING := FALSE; 7523300001.040.029 LONGPACKETSOK := FALSE; 7523400001.040.029 7523500001.040.029 IF LEN := * - 1 GEQ 0 THEN % SOME CAPABILITIES 7525000001.040.029 BEGIN 7525100001.040.029 PD := * + 1; % MOVE TO FIRST BYTE 7525200001.040.029 CAPAS := BOOLEAN(UNCHAR(REAL(PD,1))); 7525300001.040.029 % RESERVEDBIT5 7525400001.040.029 % RESERVEDBIT4 7525500001.040.029 % A PACKETS 7525600001.040.029 WINDOWING := CAPAS.[WINDOWSBIT :1]; 7525700001.040.029 LONGPACKETSOK := CAPAS.[LONGPACKETBIT:1]; 7525800001.040.029 7525900001.040.029 WHILE CAPAS.[MORECAPASBIT:1] DO% SKIP PASSED CAPAS 7526000001.040.029 IF LEN := * - 1 GEQ 0 THEN 7526100001.040.029 PD := * + 1 7526200001.040.029 ELSE 7526300001.040.029 CAPAS := FALSE; 7526400001.040.029 END; 7529900001.040.029 WINDOWSIZE := 0; % THE DEFAULT 7530000001.040.029 IF LEN := * - 1 GEQ 0 THEN 7530100001.040.029 BEGIN 7530200001.040.029 PD := * + 1; % MOVE TO THE WINDOW BYTE 7530300001.040.029 WINDOWSIZE := MIN(UNCHAR(REAL(PD,1)), 7530400001.040.029 MYWINDOWSIZE); 7530500001.040.029 END; 7530600001.040.029 WINDOWING := WINDOWSIZE > 1; % WHAT'S THE POINT OF 1? 7530700001.040.029 IF LONGPACKETSOK THEN 7531000001.040.029 SPSIZ := DEFLONGPACKSIZ; % IF NO LENGTH FIELD IN PACKET 7531100001.040.029 IF LEN := * - 2 GEQ 0 THEN % LENGTH PROVIDED 7531200001.040.029 BEGIN 7531300001.040.029 PD := * + 1; % MOVE TO FIRST BYTE 7531400001.040.029 SPSIZ := MIN((UNCHAR(REAL(PD ,1))*PACKETMOD + 7531500001.040.029 UNCHAR(REAL(PD+1,1))), 7531600001.040.029 MAXPACKSIZ); 7531700001.040.029 PD := * + 1; % SKIP SECOND BYTE 7531800001.040.029 END; 7531900001.040.029 LONGPACKETSOK := SPSIZ > SHORTPACKSIZ; 7532000001.040.029 IF REAL(DEBUG) GTR 1 THEN % EXPAND IT ALL 7700000001.040.025 BEGIN 7700100001.040.025 BUG1("Your packet size = ",SPSIZ); 7700200001.040.025 BUG1("Your timeout = ",TIMINT); 7700300001.040.025 BUG1("Your padding = ",PAD); 7700400001.040.025 BUGH("Your padding character = ",PCHAR); 7700500001.040.025 BUGH("Your end of line character = ",EOL); 7700600001.040.025 BUGC("Your quote character = ",QUOTE); 7700700001.040.025 BUGC("Your binary quote character = ",QBIN); 7700800001.040.025 BUGC("Your checksum type = ",CHKTYPE); 7700900001.040.025 BUGC("Your repeat character = ",REPT); 7701000001.040.025 BUG1("Your checksum type = ",YOURCHKTYPE); 7701100001.040.027 BUG1("Your window size = ",WINDOWSIZE); 7701300001.040.029 IF REPTOK THEN 7705000001.040.025 BUG("WE ARE REPEATING") 7705100001.040.025 ELSE 7705200001.040.025 BUG("NO REPEAT CHARACTER"); 7705300001.040.025 IF HIBITOK THEN 7705400001.040.025 BUG("WE ARE BINARY QUOTING") 7705500001.040.025 ELSE 7705600001.040.025 BUG("NOT BINARY QUOTING"); 7705700001.040.025 IF WINDOWING THEN 7705800001.040.029 BUG("WE ARE WINDOWING") 7705900001.040.029 ELSE 7706000001.040.029 BUG("NOT WINDOWING"); 7706100001.040.029 IF LONGPACKETSOK THEN 7706200001.040.029 BUG("WE ARE USING LONG PACKETS") 7706300001.040.029 ELSE 7706400001.040.029 BUG("NO LONG PACKETS"); 7706500001.040.029 END; 7709000001.040.025 END RPAR; 7709100001.040.025 7709200001.040.025 80000000 % 80001000 % F L U S H I N P U T 80002000 % 80003000 % DUMP ALL PENDING INPUT TO CLEAR STACKED UP NAKS. 80004000 % 80005000 80006000 80007000 PROCEDURE FLUSHINPUT; 80008000 BEGIN 80009000 80010000 WHILE REM.CENSUS GTR 0 DO 80011000 BRD := READ(REM); 80012000 END FLUSHINPUT; 80013000 80014000 $ENDSEGMENT 80015000 80016000 80017000 % 81000000 % P R E R R P K T 81001000 % 81002000 % PRINT CONTENTS OF ERROR PACKET RECEIVED FROM REMOTE HOST. 81003000 81004000 PROCEDURE PRERRPKT(MSG); 81005000 ARRAY MSG[0]; 81006000 BEGIN 81007000 BUG("KERMIT ABORTING WITH FOLLOWING ERROR FROM REMOTE HOST:"); 81008000 BUGP(MSG); 81009000 END PRERRPKT; 81010000 90000000 INITIALIZE; 90001000 ON ANYFAULT [ KPROMPT[*] : COL] , ABORTRUN; 90002000 WHILE NOT BRD DO 9000300001.040.030 IF NOT REMOTEREADER THEN 9000400001.040.030 PROCESSIT; 9000500001.040.030 END. 90006000