$SET NOBINDINFO 00100000 $VERSION 1.019 % [KS] 5-86 00101000 $SET ASCII % BURROUGHS USES 8 BITS FOR ASCII 00102000 BEGIN 00103000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00104000 % 00105000 % K E R M I T File Transfer Utility 00106000 % 00107000 % Burroughs 7800, University of California at Davis, 1986 00108000 % Larry Johnson, Dave Squire, Katie Stevens 00109000 % 00110000 % 00111000 %%%%% REVISIONS 00112000 % 1.019 [KS] 4-86 00113000 % FIXED RE-TRY BUG IN SENDSW/SBREAK 00114000 % OVERHAULED HELP PROCEDURES 00115000 % ENABLED 8-TH BIT QUOTING 00116000 % ENABLED VARIABLE START-OF-PACKET CHAR 00117000 % FIXED SERVER-SPAR RETRY BUG IN RECSW/RFILE 00117100 % 1.018 [KS] 3-86 00118000 % FIXED PACKET # BUG CAUSED BY DUP VARIABLE NAMES 00119000 % 1.017 [KS] 1-86 00120000 % ENABLED REPEAT PROCESSING 00121000 % ELIMINATE BLANK RECORD ADDED TO END OF RCV FILES 00122000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00123000 00124000 % SYMBOL DEFINITIONS 00125000 00126000 DEFINE MAXPACKSIZ = 94#, % MAXIMUM PACKET SIZE 00127000 MAXPACKWDS = 15#, % (MAXPACKSIZ+5)DIV 6-1 00128000 MAXSENDFILESIZ = 11#, % LARGEST FILE NAME I SHOULD SEND 00129000 MAXREPT = 94#, % LARGEST REPEAT COUNT (126-32) 00130000 EOF = 4"201"#,% EOF FOR BUFILL 00131000 NULC = 48"00"#,% ASCII NULL CHARACTER 00132000 DEFSOH = 1#, % [1.019] START OF HEADER 00133000 % SOHC = 48"01"#,% SOH CHARACTER 00134000 ETXC = 48"03"#,% ETX CHARACTER 00135000 BEL = 7#, % ASCII BELL 00136000 HT = 9#, % ASCII HORIZONTAL TAB 00137000 LF = 10#, % ASCII LINE FEED 00138000 NL = LF#, % NEWLINE CHARACTER 00139000 CR = 13#, % ASCII CARRIAGE RETURN 00140000 SP = 32#, % ASCII SPACE 00141000 DEL = 127#, % ASCII DELETE (RUBOUT) 00142000 00143000 REPTTHRESH = 5#, % CHARACTER REPEAT THRESHOLD 00144000 DEFINITRETRY = 20#, % TIMES TO RETRY INITIALIZATION 00145000 DEFPACKETRETRY = 10#, % TIMES TO RETRY A PACKET 00146000 TABLEN = 8#, % LENGTH OF A TAB IF EXPANDED 00147000 DEFRECSIZE = 15#, % MAXRECSIZE IN WORDS OF RECEIVED FILE 00148000 DEFBLOCKSIZE = 420#, % BLOCKSIZE IN WORDS OF RECEIVED FILE 00149000 DEFUNITS = VALUE(WORDS)#, % UNITS OF RECEIVED FILE 00150000 DEFPAD = 0#, % DEFAULT # OF PADDING CHARACTERS 00151000 DEFPCHAR = 0#, % DEFAULT PADDING CHARACTER 00152000 DEFEOL = CR#, % DEFAULT END OF LINE CHAR FOR BURROUGHS00153000 DEFQUOTE = "#"#, % DEFAULT QUOTE CHARACTER 00154000 DEFQBIN = "&"#, % DEFAULT BINARY QUOTE CHARACTER 00155000 DEFCHKTYPE = "1"#, % DEFAULT CHECKSUM TYPE 00156000 DEFREPT = "~"#, % DEFAULT REPEAT CHARACTER 00157000 DEFPAUSE = 0#, % DEFAULT PAUSE BEFORE ACK 00158000 DEFDELAY = 5#, % DEFAULT DELAY FOR FIRST SEND 00159000 DEFESCCHR = "^"#, % DEFAULT ESCAPE CHARACTER FOR CONNECT 00160000 DEFTIME = 5#, % DEFAULT TIMEOUT INTERVAL 00161000 MAXTIM = 60#, % MAXIMUM TIMEOUT INTERVAL 00162000 MINTIM = 2#; % MINUMUM TIMEOUT INTERVAL 00163000 00164000 00165000 % MACRO DEFINITIONS 00166000 00167000 % 00168000 % TOCHAR: CONVERTS A CONTROL CHARACTER TO A PRINTABLE ONE BY ADDING A S00169000 % 00170000 % UNCHAR: UNDOES TOCHAR. 00171000 % 00172000 % CTL: CONVERTS BETWEEN CONTROL CHARACTERS AND PRINTABLE CHARACTERS 00173000 % TOGGLING THE CONTROL BIT (IE. ^A BECOMES A AND A BECOMES ^A). 00174000 00175000 DEFINE TOCHAR(CH) = ((CH) + 32) #; 00176000 DEFINE UNCHAR(CH) = ((CH) - 32) #; 00177000 DEFINE CTL(CH) = ((CH) & (1-(CH).[6:1])[6:1]) #; 00178000 00179000 00180000 % GLOBAL VARIABLES 00181000 00182000 REAL 00183000 BSIZE, % SIZE OF PRESENT DATA 00184000 RPSIZ, % MAXIMUM RECEIVE PACKET SIZE 00185000 SPSIZ, % MAXIMUM SEND PACKET SIZE 00186000 TIMINT, % TIMEOUT FOR FOREIGN HOST ON SENDS 00187000 PAD, % HOW MUCH PADDING TO SEND 00188000 PCHAR, % PADDING CHARACTER TO SEND 00189000 EOL, % END-OF-LINE CHARACTER TO SEND 00190000 SOHCHAR, % [1.019] START-OF-PACKET CHAR TO SEND 00191000 QUOTE, % QUOTE CHARACTER IN INCOMING DATA 00192000 QBIN, % BINARY QUOTE CHARACTER IN INCOMING DATA 00193000 CHKTYPE, % ERROR DETECTION TYPE IN INCOMING DATA 00194000 REPT, % REPEAT CHARACTER IN INCOMING DATA 00195000 N, % PACKET NUMBER 00196000 NUMTRY, % TIMES THIS PACKET RETRIED 00197000 OLDTRY; % TIMES PREVIOUS PACKET RETRIED 00198000 00199000 BOOLEAN 00200000 SERVER, % MEANS WE'RE A KERMIT SERVER 00201000 BINARYON, % [1.019] MEANS 8-BIT QUOTING MODE ENABLED 00202000 HIBITOK, % MEANS 8-BIT MODE IN ACTION 00203000 CALL1, % [1.017] KEEPS TRACK OF RPAR/SPAR SEQUENCE 00204000 REPTOK, % [1.017] TRUE MEANS REPEAT ENCRIPTION OK 00205000 DEBUG, % INDICATES LEVEL OF DEBUGGING OUTPUT (0=NONE) 00206000 EXPTABS, % EXPAND TABS ON INPUT 00207000 FIXEDRECS, % SEND FIXEDRECS LENGTH RECORDS 00208000 RAW, % DONT USE NL AS RECORD SEPARATOR 00209000 KEEPFILE; % KEEP THE OUTPUT FILE 00210000 00211000 REAL 00212000 INITRETRY, % NUMBER OF RETRIES ON INITIALIZATION 00213000 PACKETRETRY, % NUMBER OF RETRIES FOR A DATA PACKET 00214000 FILERECSIZE, % MAXRECSIZE OF RECEIVED FILE 00215000 FILEBLOCKSIZE, % BLOCKSIZE OF RECEIVED FILE 00216000 FILEUNITS, % UNITS OF RECEIVED FILE 00217000 FILECOUNT, % NUMBER OF FILES LEFT TO SEND 00218000 STATE, % PRESENT STATE OF THE AUTOMATON 00219000 MYPACKSIZ, % MY MAXIMUM PACKET SIZE 00220000 MYTIME, % MY TIMEOUT INTERVAL 00221000 MYPAD, % MY NUMBER OF PADDING CHARACTERS 00222000 MYPCHAR, % MY PADDING CHARACTER 00223000 MYEOL, % MY END OF LINE CHARACTER 00224000 MYSOH, % [1.019] MY START-OF-PACKET CHAR 00225000 MYQUOTE, % MY QUOTE CHARACTER 00226000 MYQBIN, % MY BINARY QUOTE CHARACTER 00227000 MYCHKTYPE, % MY CHECKSUM TYPE 00228000 MYREPT, % MY REPEAT CHARACTER 00229000 MYPAUSE, % MY PAUSE AFTER ACK TIME 00230000 MYDELAY, % MY DELAY FOR FIRST SEND TIME 00231000 MYESCCHR; % MY ESCAPE CHARACTER FROM CONNECT 00232000 00233000 00234000 ARRAY 00235000 FILNAM[0:MAXPACKWDS]; % TITLE OF CURRENT DISK FILE 00236000 00237000 POINTER 00238000 PFILNAM; % POINTER TO FILNAM 00239000 00240000 ARRAY 00241000 RECPKT[0:MAXPACKWDS],% RECEIVE PACKET BUFFER 00242000 PACKET[0:MAXPACKWDS];% PACKET BUFFER 00243000 00244000 FILE 00245000 REM % FILE FOR REMOTE INPUT / OUTPUT 00246000 (KIND=REMOTE,MYUSE=IO,UNITS=CHARACTERS,BUFFERS=1, 00247000 MAXRECSIZE=300,FILETYPE=3), 00248000 LOG % FILE POINTER FOR LOGFILE 00249000 (KIND=DISK,UNITS=CHARACTERS,MAXRECSIZE=96,BLOCKSIZE=2880, 00250000 PROTECTION=SAVE,NEWFILE,SAVEFACTOR=1,BUFFERS=1, 00251000 TITLE=8"KERMIT/LOG."); 00252000 00253000 TRANSLATETABLE TOUPPER( ASCII TO ASCII, 00254000 "abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), 00255000 TOLOWER( ASCII TO ASCII, 00256000 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO "abcdefghijklmnopqrstuvwxyz"), 00257000 TOBURROUGHS( ASCII TO ".", 00258000 "abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 00259000 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ", 00260000 "0123456789" TO "0123456789" ); 00261000 TRANSLATETABLE ASCTOEBC( 00262000 47"000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F" 00263000 TO 48"00010203372D2E2F1605250B0C0D0E0F101112133C3D322618193F271C1D1E1F" 00264000 ,47"202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F" 00265000 TO 48"404F7F7B5B6C507D4D5D5C4E6B604B61F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F" 00266000 ,47"404142434445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F" 00267000 TO 48"7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8D9E2E3E4E5E6E7E8E94AE05A5F6D" 00268000 ,47"606162636465666768696A6B6C6D6E6F707172737475767778797A7B7C7D7E7F" 00269000 TO 48"79818283848586878889919293949596979899A2A3A4A5A6A7A8A9C06AD0A107" 00270000 ); 00271000 TRANSLATETABLE FIXSLASHES( ASCII TO ASCII , "/" TO "_" ); 00272000 TRUTHSET NUMBERS( "0" OR "1" OR "2" OR "3" OR "4" OR 00273000 "5" OR "6" OR "7" OR "8" OR "9"); 00274000 TRUTHSET QUOTECHARS( "!" OR 48"7F" OR "#" OR "$" OR "%" OR "&" 00275000 OR "'" OR "(" OR ")" OR "*" OR "+" OR "," OR "-" OR "." 00276000 OR "/" OR "0" OR NUMBERS OR ":" OR ";" OR "<" OR "=" OR ">" 00277000 OR "`" OR "{" OR "|" OR "}" OR "~" ); 00278000 ARRAY ACNTRL[0:15], % TRUTHSET FOR ALL CONTROL CHARS 00279000 BCNTRL[0:15]; % TRUTHSET FOR JUST QUOTE,QBIN,REPT 00280000 % 4"0000FFFFFFFF", % ADD IN FROM 0 THRU 31 00281000 % 0,0, % LEAVE OUT 32 THRU 95 00282000 % 4"000000000001", % ADD IN BIT FOR 127 00283000 % 0,0,0,0 % ZERO OUT END (MAY NEED FOR EBCDIC) 00284000 % TABLE ALGORITHM: 00285000 % BOOLEAN(TABLE[CHAR.[7:3]].[(31-CHAR.[4:5]):1]) => IN TABLE 00286000 % 00287000 DEFINE TABLEIT(TAB,C) = TAB[C.[7:3]].[(31-C.[4:5]):1] := 1#, 00288000 UNTABLE(TAB,C) = TAB[C.[7:3]].[(31-C.[4:5]):1] := 0#; 00289000 00290000 ARRAY FBUF_[0:29], % USED BY FPRINT 00291000 EBUF_[0:15], % USED BY ERROR 00292000 TBUF_[0:15], % TEMPORARY BUFFER FOR DIGITS CONVERSION 00293000 GBUF_[0:99], % USED BY GETC 00294000 PBUF_[0:99]; % USED BY PUTC 00295000 POINTER PG_, % POINTS TO GBUF_ 00296000 PP_; % POINTS TO PBUF_ 00297000 REAL RD, % RESULT DESCRIPTOR FOR EVERYBODY 00298000 GCNT_, % NUMBER OF CHARACTERS IN GBUF_ 00299000 PCNT_, % NUMBER OF CHARACTERS IN PBUF_ 00300000 RECSIZ_, % MAXRECSIZE OF FP 00301000 UNITS_, % CHARACTERS PER "UNIT" OF FP 00302000 HUH_; % SILLY LITTLE FILLER 00303000 BOOLEAN BRD = RD; % BOOLEAN RD 00304000 DEFINE % SOME BURROUGHS FIELD DEFINES 00305000 LENGTHF = [47:20]#, % CHAR. COUNT RETURNED FROM RESLT. DESCR. 00306000 EOFBIT = [ 9: 1]#, % EOF ON I/O FROM RESLT. DESCR. 00307000 BRKBIT = [13: 1]#, % BREAK ON I/O FROM RESLT. DESCR. 00308000 TIMEOUTBIT = [15: 1]#, % TIMEOUT ON I/O FROM RESLT. DESCR. 00309000 ERRORF = [16:17]#, % THE WHOLE ERROR FIELD 00310000 MOD64 = .[5:6]#; % N MOD 64 == N.[5:6] 00311000 00312000 DEFINE 00313000 INDENT = TRUE#, % BOOLEAN CONSTANTS 00314000 NOINDENT = FALSE#; 00315000 00316000 ARRAY NULLDATA[0:0]; 00317000 00318000 DEFINE CH(NUMBER,N) = (NUMBER).[ 7:48] FOR N#,% TO USE NUMBER AS A CHAR00319000 SAY(STR) = 00320000 BEGIN 00321000 REPLACE POINTER(FBUF_) BY STR; 00322000 IF SERVER THEN 00323000 ERROR(FBUF_) 00324000 ELSE 00325000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00326000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00327000 END#, 00328000 SAY1(STR,NUMBER)= 00329000 BEGIN 00330000 REPLACE TBUF_ BY 8"-" FOR REAL(NUMBER LSS 0), 00331000 NUMBER FOR * DIGITS,8" " FOR 12; 00332000 REPLACE POINTER(FBUF_) BY STR,TBUF_ FOR 12 00333000 WITH EBCDICTOASCII; 00334000 IF SERVER THEN 00335000 ERROR(FBUF_) 00336000 ELSE 00337000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00338000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00339000 END#, 00340000 SAYC(STR,NUMBER)= 00341000 BEGIN 00342000 IF TBUF_[0] := NUMBER LSS SP THEN 00343000 REPLACE POINTER(FBUF_) BY STR,"CTRL-",CH(NUMBER+64,1), 00344000 " (HEX ",POINTER(TBUF_,4)+10 FOR 2 WITH HEXTOASCII,")" 00345000 ELSE 00346000 REPLACE POINTER(FBUF_) BY STR, CH(NUMBER,1), " (HEX ", 00347000 POINTER(TBUF_,4)+10 FOR 2 WITH HEXTOASCII,")"; 00348000 IF SERVER THEN 00349000 ERROR(FBUF_) 00350000 ELSE 00351000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00352000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00353000 END#, 00354000 SAYN(STR,PTR) = 00355000 BEGIN 00356000 REPLACE POINTER(FBUF_) BY STR, 00357000 PTR FOR MAXPACKSIZ UNTIL = NULC; 00358000 IF SERVER THEN 00359000 ERROR(FBUF_) 00360000 ELSE 00361000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00362000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00363000 END#, 00364000 SAYP(PTR,WHITESPACE) = 00365000 BEGIN 00366000 IF WHITESPACE THEN 00367000 REPLACE POINTER(FBUF_) BY " ", 00368000 PTR FOR MAXPACKSIZ-3 WHILE GEQ " "00369000 ELSE 00370000 REPLACE POINTER(FBUF_) BY PTR FOR MAXPACKSIZ WHILE GEQ " "; 00371000 IF SERVER THEN 00372000 ERROR(FBUF_) 00373000 ELSE 00374000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00375000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00376000 END#, 00377000 00378000 SAYQ(STR) = 00379000 BEGIN 00380000 REPLACE POINTER(FBUF_) BY " " FOR COL_BASE+12-COL_OK_TIL, 00381000 "?"; 00382000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00383000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00384000 REPLACE POINTER(FBUF_) BY " missing or invalid ", 00385000 STR, 00386000 " parameter"; 00387000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00388000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00389000 END#, 00390000 00391000 SAYQOPT(STR) = 00392000 BEGIN 00393000 COL_OK_TIL := COL_BASE + 12 - COL_OK_TIL; 00394000 REPLACE POINTER(FBUF_) BY " " FOR COL_OK_TIL, 00395000 "?"; 00396000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00397000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00398000 REPLACE POINTER(FBUF_) BY " missing or invalid ", 00399000 STR, 00400000 " parameter - options are:"; 00401000 BRD := WRITE(REM,MAXPACKSIZ,FBUF_[*]); 00402000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00403000 END#, 00404000 00405000 00406000 BUG(STR) = 00407000 BEGIN 00408000 REPLACE POINTER(FBUF_) BY STR; 00409000 BRD := WRITE(LOG,96,FBUF_[*]); 00410000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00411000 END#, 00412000 BUG1(STR,NUMBER)= 00413000 BEGIN 00414000 REPLACE TBUF_ BY 8"-" FOR REAL(NUMBER LSS 0), 00415000 NUMBER FOR * DIGITS,8" " FOR 12; 00416000 REPLACE POINTER(FBUF_) BY STR,TBUF_ FOR 12 00417000 WITH EBCDICTOASCII; 00418000 BRD := WRITE(LOG,96,FBUF_[*]); 00419000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00420000 END#, 00421000 BUGH(STR,NUMBER)= 00422000 BEGIN 00423000 TBUF_[0] := NUMBER; 00424000 REPLACE POINTER(FBUF_) BY STR, 00425000 POINTER(TBUF_,4) FOR 12 WITH HEXTOASCII; 00426000 BRD := WRITE(LOG,96,FBUF_[*]); 00427000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00428000 END#, 00429000 BUGC(STR,NUMBER)= 00430000 BEGIN 00431000 IF TBUF_[0] := NUMBER LSS SP THEN 00432000 REPLACE POINTER(FBUF_) BY STR,"CTRL-",CH(CTL(NUMBER),1) 00433000 ELSE 00434000 REPLACE POINTER(FBUF_) BY STR, CH(NUMBER,1); 00435000 BRD := WRITE(LOG,96,FBUF_[*]); 00436000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00437000 END#, 00438000 BUGN(STR,PTR) = 00439000 BEGIN 00440000 REPLACE POINTER(FBUF_) BY STR, 00441000 PTR FOR MAXPACKSIZ UNTIL = NULC; 00442000 BRD := WRITE(LOG,96,FBUF_[*]); 00443000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00444000 END#, 00445000 BUGP(PTR) = 00446000 BEGIN 00447000 REPLACE POINTER(FBUF_) BY PTR FOR MAXPACKSIZ UNTIL = NULC; 00448000 BRD := WRITE(LOG,96,FBUF_[*]); 00449000 REPLACE FBUF_ BY " " FOR 16 WORDS; 00450000 END#; 00451000 00452000 DEFINE ERROR(ARA) = 00453000 BEGIN 00454000 REPLACE EBUF_ BY ARA FOR HUH_:MAXPACKSIZ-5 WHILE GEQ " "; 00455000 HUH_ := MAXPACKSIZ - HUH_ - 5; 00456000 REPLACE FBUF_ BY " " FOR 16 WORDS; % SO DEBUGGING IN SPACK IS OK00457000 SPACK("E",N:=(N+1) MOD64,HUH_,EBUF_); 00458000 REPLACE EBUF_ BY " " FOR 16 WORDS; 00459000 END#; 00460000 REAL PROCEDURE GETC(FID); 00461000 FILE FID; 00462000 BEGIN 00463000 POINTER P,Q; 00464000 REAL R; 00465000 00466000 IF GCNT_ LEQ 0 THEN 00467000 IF BRD := READ(FID,RECSIZ_,GBUF_) THEN 00468000 GETC := EOF 00469000 ELSE 00470000 BEGIN 00471000 PG_ := POINTER(GBUF_); % INITIALIZE POINTER 00472000 GCNT_ := RECSIZ_ * UNITS_; % AND COUNT 00473000 IF FIXEDRECS THEN 00474000 IF NOT RAW THEN % [1.019] 00475000 REPLACE PG_+GCNT_ BY CH(NL,1)% ADD IN A NL AT END 00476000 ELSE 00477000 GCNT_ := *-1 % [1.019] NO RECORD TERMINATOR 00478000 ELSE 00479000 BEGIN 00480000 Q := PG_; 00481000 DO BEGIN 00482000 SCAN P:Q FOR R:GCNT_ UNTIL LEQ " "; 00483000 SCAN Q:P FOR GCNT_:R WHILE LEQ " "; 00484000 END UNTIL GCNT_ LEQ 0; 00485000 REPLACE P BY CH(NL,1); 00486000 GCNT_ := RECSIZ_ * UNITS_ - R; 00487000 END; 00488000 GETC := REAL(PG_,1); % GET FIRST CHAR 00489000 PG_ := *+1; % BUMP PTR BUT COUNT IS STILL OK 00490000 END % SINCE WE ADDED THE NL EARLIER 00491000 ELSE 00492000 BEGIN 00493000 GCNT_ := *-1; 00494000 GETC := REAL(PG_,1); 00495000 PG_ := *+1; 00496000 END; 00497000 END GETC; 00498000 00499000 REAL PROCEDURE PUTC(C,FID); 00500000 VALUE C; 00501000 REAL C; 00502000 FILE FID; 00503000 BEGIN 00504000 00505000 IF C = NL AND NOT RAW THEN 00506000 PCNT_ := -1 00507000 ELSE 00508000 REPLACE PP_:PP_ BY CH(C,1); 00509000 IF PCNT_ := *-1 LEQ 0 THEN 00510000 BEGIN 00511000 BRD := WRITE(FID,RECSIZ_,PBUF_); 00512000 REPLACE PP_:=POINTER(PBUF_) BY " " FOR PCNT_:=RECSIZ_*UNITS_+1; 00513000 IF C NEQ NL OR RAW THEN % WE JUST LOST A CHARACTER 00514000 BEGIN % LET'S GET IT BACK 00515000 REPLACE PP_:PP_ BY CH(C,1); 00516000 PCNT_ := *-1; % AND DECREMENT COUNTER 00517000 END; 00518000 END; 00519000 PUTC := C; 00520000 END PUTC; 00521000 00522000 00523000 % 00524000 % M A I N 00525000 % 00526000 % MAIN ROUTINE - PARSE COMMAND AND OPTIONS, SET UP THE 00527000 % TTY LINES, AND DISPATCH TO THE APPROPRIATE ROUTINE. 00528000 00529000 00530000 PROCEDURE MAIN; 00531000 BEGIN 00532000 POINTER CP; % CHAR POINTER 00533000 REAL COL; % COLUMN COUNTER FOR SCANNER 00534000 REAL COL_BASE; % BEGINNING COLUMN COUNT FOR SCANNER 00535000 REAL COL_OK_TIL; % COLUMN COUNTER FOR PREVIOUS SCAN 00536000 ARRAY NEXTSEND[0:MAXPACKWDS]; % NEXT FILE(S) TO SEND 00537000 BOOLEAN MORETOSEND; % SOMETHING IN NEXTSEND 00538000 EBCDIC ARRAY MACHINE[0:3]; % WHAT MACHINE (7800, 6700, ETC) 00539000 ARRAY KPROMPT[0:15]; % THE KERMIT PROMPT 00540000 ARRAY REFERENCE SPECARA[0]; % CURRENT COMMAND ARRAY 00541000 00542000 00543000 VALUE ARRAY SPECIAL( % ALL THE COMMANDS 00544000 48"01" "? " , % ? FOR HELP 00545000 48"04" "EXIT " , 00546000 48"04" "HELP " , 00547000 48"04" "QUIT " , 00548000 48"07" "RECEIVE " , 00549000 48"04" "SEND " , 00550000 48"06" "SERVER " , 00551000 48"03" "SET " , 00552000 48"04" "SHOW " , 00553000 48"06" "STATUS " , 00554000 0); 00555000 00556000 % DEFINES FOR COMMANDS 00557000 00558000 DEFINE 00559000 QMARKV = 0#, 00560000 EXITV = 1#, 00561000 HELPV = 2#, 00562000 QUITV = 3#, 00563000 RECEIVEV = 4#, 00564000 SENDV = 6#, 00565000 SERVERV = 7#, 00566000 SETV = 9#, 00567000 SHOWV = 10#, 00568000 STATUSV = 11#, 00569000 QUESTIONV = -98#, 00570000 INVALIDV = -99#, 00571000 NOERRORV = 101#; 00572000 00573000 VALUE ARRAY SPECSET( % ALL THE SPECIAL 'SET' COMMANDS 00574000 48"01" "? " , 00575000 48"09" "DEBUGGING " , 00576000 48"05" "DELAY" , 00577000 48"04" "FILE " , 00578000 48"0A" "INCOMPLETE " , 00579000 48"05" "RETRY" , 00580000 48"07" "RECEIVE " , 00581000 48"04" "SEND " , 00582000 48"06" "BINARY " , 00583000 0); 00584000 00585000 % DEFINES FOR SET COMMAND 00586000 00587000 DEFINE 00588000 % QMARKV = 0#, 00589000 DEBUGV = 1#, 00590000 DELAYV = 3#, 00591000 FILEV = 4#, 00592000 INCOMPLETEV = 5#, 00593000 RETRYV = 7#, 00594000 SETRECEIVEV = 8#, 00595000 SETSENDV = 10#, 00596000 BINARYV = 11#; 00597000 00598000 VALUE ARRAY SPECFILE( % FOR SET FILE COMMANDS 00599000 48"01" "? " , 00600000 48"0A" "BLOCK-SIZE " , 00601000 48"0B" "EXPAND-TABS" , 00602000 48"05" "FIXED" , 00603000 48"03" "RAW " , 00604000 48"0B" "RECORD-SIZE" , 00605000 48"05" "UNITS" , 00606000 0); 00607000 00608000 % DEFINES FOR SET FILE COMMANDS 00609000 DEFINE 00610000 % QMARK = 0#, 00611000 BLOCKSIZEV = 1#, 00612000 EXPTABSV = 3#, 00613000 FIXEDV = 5#, 00614000 RAWV = 6#, 00615000 RECORDSIZEV = 7#, 00616000 UNITSV = 9#; 00617000 00618000 VALUE ARRAY SPECABORT( % FOR SET ABORTED-FILE 00619000 48"01" "? " , 00620000 48"07" "DISCARD " , 00621000 48"04" "KEEP " , 00622000 0); 00623000 00624000 % DEFINES FOR SPECABORT 00625000 00626000 DEFINE 00627000 % QMARKV = 0#, 00628000 DISCARDV = 1#, 00629000 KEEPV = 3#; 00630000 00631000 VALUE ARRAY SPECDEBUG( % FOR SET DEBUGGING 00632000 48"01" "? " , 00633000 48"06" "STATES " , 00634000 48"07" "PACKETS " , 00635000 48"08" "LOG-FILE " , 00636000 48"03" "OFF ", 00637000 0); 00638000 00639000 % DEFINES FOR SPECDEBUG 00640000 00641000 DEFINE 00642000 % QMARKV = 0#, 00643000 STATESV = 1#, 00644000 PACKETSV = 3#, 00645000 LOGFILEV = 5#, 00646000 DOFFV = 7#; 00647000 00648000 VALUE ARRAY SPECRETRY( % FOR SET RETRY 00649000 48"01" "? " , 00650000 48"12" "INITIAL-CONNECTION " , 00651000 48"07" "PACKETS " , 00652000 0); 00653000 00654000 % DEFINES FOR SPECRETRY 00655000 00656000 DEFINE 00657000 % QMARKV = 0#, 00658000 INITCONNV = 1#, 00659000 RETRYPACKETSV = 5#; 00660000 00661000 VALUE ARRAY SPECONOFF( % FOR ON/OFF 00662000 48"01" "? " , 00663000 48"02" "ON " , 00664000 48"03" "OFF " , 00665000 0); 00666000 00667000 % DEFINES FOR SPECONOFF 00668000 00669000 DEFINE 00670000 % QMARKV = 0#, 00671000 ONV = 1#, 00672000 OFFV = 2#; 00673000 00674000 VALUE ARRAY SPECRECEIVE( % FOR SET RECEIVE, SET SEND 00675000 48"01" "? " , 00676000 48"0B" "END-OF-LINE" , 00677000 48"0D" "PACKET-LENGTH " , 00678000 48"07" "PADDING " , 00679000 48"07" "PADCHAR " , 00680000 48"05" "PAUSE" , 00681000 48"05" "QUOTE" , 00682000 48"0F" "START-OF-PACKET " , 00683000 48"07" "TIMEOUT " , 00684000 0); 00685000 00686000 % DEFINES FOR SPECRECEIVE 00687000 00688000 DEFINE 00689000 % QMARKV = 0#, 00690000 EOLV = 1#, 00691000 LENV = 3#, 00692000 PADV = 6#, 00693000 PCHARV = 8#, 00694000 PAUSEV = 10#, 00695000 QUOTEV = 11#, 00696000 STARTOFPACKV = 12#, 00697000 TIMEOUTV = 15#; 00698000 00699000 VALUE ARRAY SPECUNITS( % FOR SET RECEIVE UNITS 00700000 48"01" "? ", 00701000 48"05" "WORDS", 00702000 48"0A" "CHARACTERS ", 00703000 0); 00704000 00705000 % DEFINES FOR SPECUNITS 00706000 00707000 DEFINE 00708000 % QMARKV = 0#, 00709000 UWORDSV = 1#, 00710000 UCHARACTERSV = 2#; 00711000 00712000 VALUE ARRAY SPECSHOW( % FOR SHOW SEND/RECEIVE 00713000 48"04" "SEND " , 00714000 0); 00715000 00716000 DEFINE 00717000 SHOSENDV = 0#; 00718000 00719000 00720000 00721000 VALUE ARRAY PLAINHELP( % GLOBAL HELP STUFF 00722000 48"0D" "EXIT to CANDE ", 00723000 48"1B" "HELP by giving this message ", 00724000 48"10" "QUIT (like EXIT) ", 00725000 48"16" "RECEIVE file from host ", 00726000 48"11" "SEND file to host", 00727000 48"20" "SERVER make me a Kermit Server ", 00728000 48"0F" "SET a parameter ", 00729000 48"0D" "SHOW settings ", 00730000 48"12" "STATUS (like SHOW) ", 00731000 0), 00732000 SETHELP( % SET HELP STUFF 00733000 48"20" " BINARY (do 8th bit transfers) " , 00734000 48"19" " DEBUGGING level option ", 00735000 48"1F" " DELAY seconds for first SEND ", 00736000 48"11" " FILE parameter" , 00737000 48"19" " INCOMPLETE disposition " , 00738000 48"0E" " RETRY count ", 00739000 48"14" " RECEIVE parameter ", 00740000 48"11" " SEND parameter", 00741000 0), 00742000 SETFILEHELP( % SET FILE HELP STUFF 00743000 48"14" " BLOCK-SIZE length ", 00744000 48"17" " EXPAND-TABS on input", 00745000 48"32" " FIXED (send blanks found at the end of records)" , 00746000 48"2A" " RAW (without any line delimiting chars) ", 00747000 48"15" " RECORD-SIZE length ", 00748000 48"1E" " UNITS (words or characters) ", 00749000 0), 00750000 SENDHELP( % SET RECEIVE/SEND HELP 00751000 48"1C" " END-OF-LINE (number 0-31) ", 00752000 48"17" " PACKET-LENGTH length", 00753000 48"20" " PADDING (number of PADCHARS) ", 00754000 48"19" " PADCHAR (number 0-31) ", 00755000 48"1B" " PAUSE seconds before ACK ", 00756000 48"12" " QUOTE character ", 00757000 48"20" " START-OF-PACKET (number 0-31) " , 00758000 48"15" " TIMEOUT in seconds ", 00759000 0), 00760000 UNITSHELP( % SET RECEIVE UNITS HELP 00761000 48"08" " WORDS ", 00762000 48"0D" " CHARACTERS ", 00763000 0), 00764000 ABORTHELP( % SET ABORTED-FILE HELP 00765000 48"1C" " DISCARD the file on abort ", 00766000 48"19" " KEEP the file on abort ", 00767000 0), 00768000 DEBUGHELP( % SET DEBUGGING HELP 00769000 48"1E" " STATES - flag state changes ", 00770000 48"19" " PACKETS- flag all data ", 00771000 48"20" " LOG-FILE changes log filename ", 00772000 48"1E" " OFF - turn off all flags ", 00773000 0), 00774000 RETRYHELP( % SET RETRY HELP 00775000 48"1C" " INITIAL-CONNECTION count ", 00776000 48"11" " PACKETS count", 00777000 0), 00778000 ONOFFHELP( % ONLY ON OR OFF 00779000 48"05" " ON", 00780000 48"06" " OFF ", 00781000 0), 00782000 LONUMBERHELP( % ONLY NUMBERS ALLOWED 00783000 48"24" " must be an integer from 0 thru 31 ", 00784000 0), 00785000 QUOTEHELP( % ONLY 32 < N < 127 00786000 48"2B" " must be an ASCII character from ! thru ~ ", 00787000 48"2E" " (HEX 21 thru 7E) ", 00788000 0), 00789000 NUMBERHELP( % ANY NUMBERS ALLOWED 00790000 48"21" " can be any decimal digit > 0 ", 00791000 0); 00792000 00793000 DEFINE 00794000 PLAINH = 0#, 00795000 SETH = 1#, 00796000 ABORTH = 2#, 00797000 DEBUGH = 3#, 00798000 RETRYH = 4#, 00799000 RECEIVEH = 5#, 00800000 SENDH = 5#, 00801000 NUMBERH = 6#, 00802000 ONOFFH = 7#, 00803000 QUOTEH = 8#, 00804000 UNITSH = 9#, 00805000 LONUMH = 10#, 00806000 SETFILEH = 11#; 00807000 00808000 00809000 BOOLEAN PROCEDURE SENDSW; FORWARD; 00810000 BOOLEAN PROCEDURE RECSW(ISTATE); % [1.017] 00811000 REAL ISTATE; FORWARD; % [1.017] 00812000 PROCEDURE SPACK(TYPE,NUM,LEN,DATA); 00813000 VALUE TYPE,NUM,LEN; 00814000 REAL TYPE; 00815000 REAL NUM,LEN; 00816000 ARRAY DATA[0]; FORWARD; 00817000 REAL PROCEDURE RPACK(LEN,NUM,DATA); 00818000 REAL LEN,NUM; 00819000 ARRAY DATA[0]; FORWARD; 00820000 REAL PROCEDURE BUFILL(FID,BUFFER); 00821000 FILE FID; 00822000 ARRAY BUFFER[0]; FORWARD; 00823000 PROCEDURE BUFEMP(FID,BUFFER,LEN); 00824000 VALUE LEN; 00825000 REAL LEN; 00826000 FILE FID; 00827000 ARRAY BUFFER[0]; FORWARD; 00828000 PROCEDURE SPAR(LEN,DATA); 00829000 REAL LEN; 00830000 ARRAY DATA[0]; FORWARD; 00831000 PROCEDURE RPAR(LEN,DATA); 00832000 REAL LEN; 00833000 ARRAY DATA[0]; FORWARD; 00834000 PROCEDURE FLUSHINPUT; FORWARD; 00835000 PROCEDURE PRERRPKT(MSG); 00836000 ARRAY MSG[0]; FORWARD; 00837000 00838000 % 00839000 % A B O R T R U N 00840000 % 00841000 % SENDS AN ERROR PACKET AND ABORTS 00842000 % 00843000 PROCEDURE ABORTRUN; 00844000 BEGIN 00845000 REPLACE TBUF_[0] BY COL FOR * DIGITS," "; 00846000 REPLACE EBUF_ BY "KERMIT ABORTING DUE TO FAULT # ", 00847000 TBUF_ FOR 2 WITH EBCDICTOASCII," @ ", 00848000 KPROMPT FOR 50 WITH EBCDICTOASCII; 00849000 SPACK("E",( N := *+1 ) MOD64, MAXPACKSIZ-5,EBUF_); 00850000 IF NOT SERVER THEN 00851000 SAYP(EBUF_,NOINDENT); 00852000 IF (MYSELF.OPTION).[VALUE(FAULT) : 1]=1 THEN 00853000 PROGRAMDUMP(ARRAYS,FILES); 00854000 WHEN(10); 00855000 MYSELF.STATUS := VALUE(TERMINATED); 00856000 END ABORTRUN; 00857000 00858000 % 00859000 % I N I T I A L I Z E 00860000 % 00861000 % INITIALIZE SETS UP INITIAL VALUES 00862000 % 00863000 PROCEDURE INITIALIZE; 00864000 BEGIN 00865000 ARRAY GREETING[0:13]; 00866000 EBCDIC ARRAY VERSION[0:7]; 00867000 00868000 REPLACE MACHINE BY TIME(23).[7:8]*100 FOR 4 DIGITS; 00869000 REPLACE VERSION BY COMPILETIME(20) FOR 1 DIGITS,8".", 00870000 COMPILETIME(21) FOR 3 DIGITS; 00871000 REPLACE GREETING BY "UCD BURROUGHS KERMIT-", 00872000 MACHINE FOR 4 WITH EBCDICTOASCII, 00873000 " - VERSION ",VERSION FOR 5 WITH EBCDICTOASCII,NULC; 00874000 REPLACE FBUF_ BY " " FOR 30 WORDS; 00875000 REPLACE EBUF_ BY " " FOR 16 WORDS; 00876000 SAYP(GREETING,NOINDENT); 00877000 REPLACE KPROMPT BY "KERMIT-",MACHINE FOR 2 00878000 WITH EBCDICTOASCII," ",ETXC; % PUT ETXC AT END TO KEEP BLANK 00879000 00880000 % INITIALIZE THESE VALUES AND HOPE THE FIRST PACKET WILL GET ACROSS OK00881000 00882000 EOL := CR; % EOL FOR OUTGOING PACKETS 00883000 SOHCHAR := DEFSOH; % SOH FOR OUTGOING PACKETS 00884000 QUOTE := "#"; % STANDARD CONTROL-QUOTE CHAR "#" 00885000 PAD := 0; % NO PADDING 00886000 PCHAR := NULC; % USE NULC IF ANY PADDING WANTED 00887000 QBIN := "N"; % DEFAULT TO NO BINARY QUOTING 00888000 REPT := SP; % DEFAULT TO SPACE 00889000 CHKTYPE := "1"; % DEFAULT CHKTYPE 00890000 MYPACKSIZ := MAXPACKSIZ; % SET MINE TO DEFAULTS 00891000 INITRETRY := DEFINITRETRY; % INITIALIZE RETRIES 00892000 PACKETRETRY:= DEFPACKETRETRY; 00893000 FILERECSIZE:= DEFRECSIZE; 00894000 FILEBLOCKSIZE:= DEFBLOCKSIZE; 00895000 FILEUNITS := DEFUNITS; 00896000 MYTIME := DEFTIME; 00897000 MYPAD := DEFPAD; 00898000 MYPCHAR := DEFPCHAR; 00899000 MYEOL := DEFEOL; 00900000 MYSOH := DEFSOH; % [1.019] 00901000 MYQUOTE := DEFQUOTE; 00902000 MYQBIN := DEFQBIN; % [1.019] 00903000 MYCHKTYPE := DEFCHKTYPE; 00904000 MYREPT := DEFREPT; 00905000 MYPAUSE := DEFPAUSE; % SECONDS ( INPUT IS IN 10THS ) 00906000 MYDELAY := DEFDELAY; 00907000 MYESCCHR := DEFESCCHR; 00908000 00909000 FIXEDRECS := FALSE; % DEFAULT 00910000 EXPTABS := TRUE; % DEFAULT -> EXPAND THEM 00911000 HIBITOK := FALSE; % [1.017] 8-BIT ONLY WHEN REQUESTED 00912000 BINARYON := FALSE; % [1.019] CHANGED BY SET BINARY COMMA00913000 REPTOK := FALSE; % [1.017] NO REPEAT PROCESSING 00914000 KEEPFILE := TRUE; % DEFAULT TO KEEP ALL FILES MADE 00915000 RAW := FALSE; % USE CR FOR END-OF-LINE 00916000 % INITIALIZE ACNTRL TABLE 00917000 REPLACE ACNTRL BY 48"0000FFFFFFFF",0,0,48"000000000001",0,0,0,0; 00918000 REPLACE BCNTRL BY 0 FOR 8 WORDS; 00919000 00920000 END INITIALIZE; 00921000 00922000 % 00923000 % S C A N I T 00924000 % 00925000 % SCANS INPUT AND PUTS ITEMS INTO ARRAY AC IN KUNKER-FORM. PLACES 00926000 % ITEM LENGTH INTO LEN AND RETURNS THE ITEM'S INDEX IN THE SPECIAL 00927000 % ARRAY. 00928000 % 00929000 00930000 REAL PROCEDURE SCANIT; 00931000 BEGIN 00932000 ARRAY AC[0:3]; 00933000 REAL I,J,SAVEJ,CNT; 00934000 00935000 SCANIT := -1; 00936000 COL_OK_TIL := COL; 00937000 SCAN CP:CP FOR COL:COL UNTIL GTR " "; 00938000 IF COL GTR 0 THEN 00939000 BEGIN 00940000 SCAN CP FOR I:COL WHILE GTR " "; 00941000 IF CP+((I := COL-I)-1) = "?" THEN 00942000 IF I GTR 1 THEN 00943000 I := *-1; 00944000 REPLACE POINTER(AC) BY I.[7:48] FOR 1, 00945000 CP FOR I; 00946000 J := SIZE(SPECARA); 00947000 SAVEJ := CNT := -1; 00948000 WHILE J:=*-1 GEQ 0 DO 00949000 IF J := MASKSEARCH(AC[0], 00950000 40"E0" & REAL(NOT FALSE)[39:MIN(40,I*8)],SPECARA[J]) 00951000 GEQ 0 THEN 00952000 IF CP = POINTER(SPECARA[J])+1 FOR I THEN 00953000 TBUF_[CNT:=*+1] := SAVEJ := J 00954000 ; 00955000 IF (CNT:=*+1 GTR 1)OR(CP+I = "?") THEN 00956000 BEGIN 00957000 IF CP+I NEQ "?" THEN 00958000 SAY(" ambiguous command, please supply more characters");00959000 SAY(" possible commands:"); 00960000 WHILE CNT GTR 0 DO 00961000 IF SAVEJ := TBUF_[CNT := *-1] GTR 0 THEN 00962000 SAYP(POINTER(SPECARA[SAVEJ])+1,INDENT); 00963000 SCANIT := NOERRORV; 00964000 END 00965000 ELSE 00966000 SCANIT := SAVEJ; 00967000 CP := *+I; 00968000 COL := *-I; 00969000 END; 00970000 END SCANIT; 00971000 00972000 % 00973000 % S C A N U M 00974000 % 00975000 REAL PROCEDURE SCANUM; 00976000 BEGIN 00977000 ARRAY AC[0:3]; 00978000 REAL I,J,SAVEJ,CNT; 00979000 00980000 SCANUM := INVALIDV; 00981000 COL_OK_TIL := COL; 00982000 SCAN CP:CP FOR COL:COL UNTIL GTR " "; 00983000 IF COL GTR 0 THEN 00984000 IF CP IN NUMBERS THEN 00985000 BEGIN 00986000 SCAN CP FOR I:COL WHILE IN NUMBERS; 00987000 IF I := COL-I LSS 12 THEN 00988000 BEGIN 00989000 REPLACE AC BY CP FOR I WITH ASCIITOEBCDIC; 00990000 SCANUM := INTEGER(AC,I); 00991000 END 00992000 ELSE 00993000 SCANUM := INVALIDV; 00994000 END 00995000 ELSE 00996000 IF CP = "?" THEN 00997000 SCANUM := QUESTIONV; 00998000 END OF PROCEDURE SCANUM; 00999000 % 01000000 % H E L P E R 01001000 % 01002000 % DOES ALL THE HELP STUFF FROM ? OR HELP INPUT 01003000 % 01004000 01005000 $BEGINSEGMENT 01006000 01007000 PROCEDURE HELPER(TYPE); 01008000 VALUE TYPE; 01009000 REAL TYPE; 01010000 BEGIN 01011000 ARRAY REFERENCE HELPARA[0]; 01012000 POINTER P; 01013000 REAL LENGTH; 01014000 CASE TYPE OF 01015000 BEGIN 01016000 PLAINH: % PLAN OLD HELP 01017000 HELPARA := PLAINHELP; 01018000 SETH: % SET HELP 01019000 HELPARA := SETHELP; 01020000 ABORTH: % ABORT HELP 01021000 HELPARA := ABORTHELP; 01022000 DEBUGH: % DEBUG HELP 01023000 HELPARA := DEBUGHELP; 01024000 RETRYH: % RETRY HELP 01025000 HELPARA := RETRYHELP; 01026000 SENDH: % SEND HELP 01027000 HELPARA := SENDHELP; 01028000 NUMBERH: % NUMBER HELP 01029000 HELPARA := NUMBERHELP; 01030000 ONOFFH: % ON/OFF HELP 01031000 HELPARA := ONOFFHELP; 01032000 QUOTEH: % QUOTE HELP 01033000 HELPARA := QUOTEHELP; 01034000 UNITSH: % RECEIVE UNITS HELP 01035000 HELPARA := UNITSHELP; 01036000 LONUMH: % LOW NUMBER HELP (0-31) 01037000 HELPARA := LONUMBERHELP; 01038000 SETFILEH: 01039000 HELPARA := SETFILEHELP; % SET FILE HELP 01040000 ELSE: 01041000 LENGTH := -1; 01042000 END CASE; 01043000 IF LENGTH GEQ 0 THEN 01044000 BEGIN 01045000 P := POINTER(HELPARA); 01046000 WHILE LENGTH := REAL(P,1) GTR 0 DO 01047000 BEGIN 01048000 BRD := WRITE(REM,LENGTH,P+1); 01049000 P := *+(((LENGTH + 6) DIV 6) *6); 01050000 END; 01051000 END; 01052000 END HELPER; 01053000 01054000 01055000 % 01056000 % S E T S T U F F 01057000 % 01058000 % SETS THE VARIOUS THINGS 01059000 % 01060000 PROCEDURE SETSTUFF; 01061000 BEGIN 01062000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01063000 PROCEDURE ABORTER; 01064000 BEGIN 01065000 SPECARA := SPECABORT; 01066000 CASE SCANIT OF 01067000 BEGIN 01068000 QMARKV: 01069000 SAY(" determines what to do if RECEIVE transfer fails - options are:");01070000 HELPER(ABORTH); 01071000 DISCARDV: 01072000 KEEPFILE := FALSE; 01073000 KEEPV: 01074000 KEEPFILE := TRUE; 01075000 ELSE: 01076000 SAYQOPT("INCOMPLETE"); 01077000 HELPER(ABORTH); 01078000 END CASE; 01079000 END ABORTER; 01080000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01081000 PROCEDURE DEBUGGER; 01082000 BEGIN 01083000 POINTER P; 01084000 SPECARA := SPECDEBUG; 01085000 CASE SCANIT OF 01086000 BEGIN 01087000 QMARKV: 01088000 SAY(" sets level of DEBUGGING output -- options are:"); 01089000 HELPER(DEBUGH); 01090000 STATESV: 01091000 DEBUG := TRUE; 01092000 PACKETSV: 01093000 DEBUG := BOOLEAN(3); 01094000 LOGFILEV: 01095000 IF NOT DEBUG THEN DEBUG := TRUE; 01096000 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 01097000 IF COL GTR 0 THEN 01098000 BEGIN 01099000 SCAN P:CP FOR COL WHILE GEQ "A"; 01100000 REPLACE P BY "."48"00"; 01101000 IF LOG.OPEN THEN LOCK(LOG,CRUNCH); 01102000 REPLACE CP BY CP FOR COL+1 WITH ASCIITOEBCDIC; 01103000 REPLACE LOG.TITLE BY CP; 01104000 END; 01105000 DOFFV: 01106000 DEBUG := FALSE; 01107000 ELSE: 01108000 SAYQOPT("DEBUGGING"); 01109000 HELPER(DEBUGH); 01110000 END CASE; 01111000 IF DEBUG THEN 01112000 IF NOT LOG.OPEN THEN LOG.OPEN := TRUE 01113000 ELSE 01114000 ELSE 01115000 IF LOG.OPEN THEN LOCK(LOG,CRUNCH); 01116000 END DEBUGGER; 01117000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01118000 PROCEDURE DELAYER; 01119000 BEGIN 01120000 REAL N; 01121000 N := SCANUM; 01122000 IF (N LSS 0)OR(N GTR 31) THEN 01123000 IF (N = QUESTIONV) THEN 01124000 BEGIN 01125000 SAY(" sets time to delay (in secs) before"); 01126000 SAY(" sending first packet during file SEND"); 01127000 HELPER(LONUMH); 01128000 END 01129000 ELSE 01130000 BEGIN 01131000 SAYQ("DELAY"); 01132000 HELPER(LONUMH); 01133000 END 01134000 ELSE 01135000 MYDELAY := N 01136000 END DELAYER; 01137000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01138000 PROCEDURE RETRYER; 01139000 BEGIN 01140000 REAL N; 01141000 SPECARA := SPECRETRY; 01142000 CASE SCANIT OF 01143000 BEGIN 01144000 QMARKV: 01145000 SAY(" sets number of times to retry an operation"); 01146000 SAY(" before giving up - options are:"); 01147000 HELPER(RETRYH); 01148000 INITCONNV: 01149000 N := SCANUM; 01150000 IF (N LSS 0) THEN 01151000 IF (N = QUESTIONV) THEN 01152000 BEGIN 01153000 SAY(" sets number of times to retry initial connection");01154000 HELPER(NUMBERH) 01155000 END 01156000 ELSE 01157000 BEGIN 01158000 SAYQ("INITIAL-CONNECTION"); 01159000 HELPER(NUMBERH); 01160000 END 01161000 ELSE 01162000 INITRETRY := N; 01163000 RETRYPACKETSV: 01164000 N := SCANUM; 01165000 IF (N LSS 0) THEN 01166000 IF (N = QUESTIONV) THEN 01167000 BEGIN 01168000 SAY(" sets number of times to retry regular connection");01169000 HELPER(NUMBERH) 01170000 END 01171000 ELSE 01172000 BEGIN 01173000 SAYQ("PACKETS"); 01174000 HELPER(NUMBERH); 01175000 END 01176000 ELSE 01177000 PACKETRETRY := N; 01178000 ELSE: 01179000 SAYQOPT("RETRY"); 01180000 HELPER(RETRYH); 01181000 END CASE 01182000 END RETRYER; 01183000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01184000 PROCEDURE BLOCKER; 01185000 BEGIN 01186000 REAL N; 01187000 N := SCANUM; 01188000 IF (N LSS 1) THEN 01189000 IF (N = QUESTIONV) THEN 01190000 BEGIN 01191000 SAY(" sets BLOCKSIZE attribute of RECEIVED files"); 01192000 HELPER(NUMBERH); 01193000 END 01194000 ELSE 01195000 BEGIN 01196000 SAYQ("BLOCK-SIZE"); 01197000 HELPER(NUMBERH); 01198000 END 01199000 ELSE 01200000 BEGIN 01201000 FILEBLOCKSIZE := N; 01202000 IF (FILEBLOCKSIZE MOD FILERECSIZE) NEQ 0 THEN 01203000 BEGIN 01204000 SAY("Warning: BLOCK-SIZE must be a multiple of RECORD-SIZE");01205000 SAY1(" current settings: RECORD-SIZE = ",FILERECSIZE); 01206000 SAY1(" BLOCK-SIZE = ",FILEBLOCKSIZE); 01207000 END 01208000 END 01209000 END BLOCKER; 01210000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01211000 PROCEDURE RECSIZER; 01212000 BEGIN 01213000 REAL N; 01214000 N := SCANUM; 01215000 IF (N LSS 1) THEN 01216000 IF (N = QUESTIONV) THEN 01217000 BEGIN 01218000 SAY(" sets MAXRECSIZE attribute of RECEIVED files"); 01219000 HELPER(NUMBERH); 01220000 END 01221000 ELSE 01222000 BEGIN 01223000 SAYQ("RECORD-SIZE"); 01224000 HELPER(NUMBERH); 01225000 END 01226000 ELSE 01227000 BEGIN 01228000 FILERECSIZE := N; 01229000 IF (FILEBLOCKSIZE MOD FILERECSIZE) NEQ 0 THEN 01230000 BEGIN 01231000 SAY("Warning: BLOCK-SIZE must be a multiple of RECORD-SIZE");01232000 SAY1(" current settings: RECORD-SIZE = ",FILERECSIZE); 01233000 SAY1(" BLOCK-SIZE = ",FILEBLOCKSIZE); 01234000 END 01235000 END 01236000 END RECSIZER; 01237000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01238000 PROCEDURE UNITER; 01239000 BEGIN 01240000 SPECARA := SPECUNITS; 01241000 CASE SCANIT OF 01242000 BEGIN 01243000 QMARKV: 01244000 SAY(" set UNITS file attribute for received files -- options are:"); 01245000 HELPER(UNITSH); 01246000 UWORDSV: 01247000 FILEUNITS := VALUE(WORDS); 01248000 UCHARACTERSV: 01249000 FILEUNITS := VALUE(CHARACTERS); 01250000 ELSE: 01251000 SAYQOPT("UNITS"); 01252000 HELPER(UNITSH); 01253000 END CASE; 01254000 END OF PROCEDURE UNITER; 01255000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01256000 PROCEDURE SENDRECEIVER(WHICH); 01257000 VALUE WHICH; 01258000 REAL WHICH; 01259000 BEGIN 01260000 REAL N; % [1.018] NEED TO DECLARE LOCALLY 01261000 INTEGER NDX; 01262000 SPECARA := SPECRECEIVE; 01263000 CASE NDX := SCANIT OF 01264000 BEGIN 01265000 QMARKV: 01266000 SAY(" sets various packet parameters - options are:"); 01267000 HELPER(SENDH); 01268000 EOLV: 01269000 N := SCANUM; 01270000 IF (N LSS 1)OR(N GTR 31) THEN 01271000 IF (N = QUESTIONV) THEN 01272000 BEGIN 01273000 IF WHICH=SETRECEIVEV THEN 01274000 SAY(" sets the packet terminator character to expect") 01275000 ELSE 01276000 SAY(" sets the packet terminator character to send"); 01277000 HELPER(LONUMH) 01278000 END 01279000 ELSE 01280000 BEGIN 01281000 SAYQ("END-OF-LINE"); 01282000 HELPER(LONUMH); 01283000 END 01284000 ELSE 01285000 IF WHICH=SETRECEIVEV THEN 01286000 MYEOL := N 01287000 ELSE 01288000 EOL := N; 01289000 QUOTEV: 01290000 IF WHICH=SETRECEIVEV THEN 01291000 SAY(" not implemented, no need to set QUOTE to expect") 01292000 ELSE 01293000 BEGIN 01294000 COL_OK_TIL := COL; 01295000 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 01296000 IF COL GTR 0 THEN 01297000 BEGIN 01298000 IF CP = "?" THEN 01299000 BEGIN 01300000 SAY(" sets QUOTE character to send"); 01301000 HELPER(QUOTEH) 01302000 END 01303000 ELSE 01304000 IF N := REAL(CP,1) LSS 33 OR N GTR 126 THEN % ! < N < ~ 01305000 BEGIN 01306000 SAY(" invalid QUOTE character - must be an"); 01307000 HELPER(QUOTEH) 01308000 END 01309000 ELSE 01310000 IF N=MYQBIN THEN % NO WAY! 01311000 SAY(" QUOTE not set, that character is your binary quote") 01312000 ELSE 01313000 IF N=MYREPT THEN % NO WAY! 01314000 SAY(" QUOTE not set, that character is your repeat quote") 01315000 ELSE 01316000 MYQUOTE := N 01317000 END 01318000 ELSE 01319000 BEGIN 01320000 SAYQ("QUOTE"); 01321000 HELPER(QUOTEH); 01322000 END; 01323000 END; 01324000 LENV: 01325000 N := SCANUM; 01326000 IF (N LSS 10)OR(N GTR 94) THEN 01327000 IF (N = QUESTIONV) THEN 01328000 BEGIN 01329000 IF WHICH=SETRECEIVEV THEN 01330000 SAY(" set PACKET-LENGTH for incoming packets") 01331000 ELSE 01332000 SAY(" sets PACKET-LENGTH for outgoing packets"); 01333000 SAY(" must be an integer from 10 to 94"); 01334000 END 01335000 ELSE 01336000 BEGIN 01337000 SAYQ("PACKET-LENGTH"); 01338000 SAY(" must be an integer from 10 to 94"); 01339000 END 01340000 ELSE 01341000 IF WHICH=SETRECEIVEV THEN 01342000 MYPACKSIZ := N 01343000 ELSE 01344000 SPSIZ := N; 01345000 PADV: 01346000 PCHARV: 01347000 PAUSEV: 01348000 STARTOFPACKV: 01349000 TIMEOUTV: 01350000 N := SCANUM; 01351000 IF (N LSS 0)OR(N GTR 31) THEN 01352000 IF (N = QUESTIONV) THEN 01353000 BEGIN 01354000 IF WHICH=SETRECEIVEV THEN 01355000 SAY(" sets a packet parameter for incoming packets") 01356000 ELSE 01357000 SAY(" sets a packet parameter for outgoing packets"); 01358000 HELPER(LONUMH); 01359000 END 01360000 ELSE 01361000 BEGIN 01362000 SAYQ("packet"); 01363000 HELPER(LONUMH); 01364000 END 01365000 ELSE 01366000 CASE NDX OF 01367000 BEGIN 01368000 PADV: 01369000 IF WHICH=SETRECEIVEV THEN 01370000 MYPAD := N 01371000 ELSE 01372000 PAD := N; 01373000 PCHARV: 01374000 IF WHICH=SETRECEIVEV THEN 01375000 MYPCHAR := N 01376000 ELSE 01377000 PCHAR := N; 01378000 PAUSEV: 01379000 MYPAUSE := N/10; 01380000 STARTOFPACKV: 01381000 IF WHICH=SETRECEIVEV THEN 01382000 MYSOH := N 01383000 ELSE 01384000 SOHCHAR := N; 01385000 TIMEOUTV: 01386000 IF N = 0 THEN 01387000 SAY(" TIMEOUT must be greater than zero") 01388000 ELSE 01389000 IF WHICH=SETRECEIVEV THEN 01390000 MYTIME := N 01391000 ELSE 01392000 TIMINT := N; 01393000 END CASE; 01394000 NOERRORV: 01395000 ; 01396000 ELSE: 01397000 IF WHICH=SETRECEIVEV THEN 01398000 SAYQOPT("RECEIVE") 01399000 ELSE 01400000 SAYQOPT("SEND"); 01401000 HELPER(SENDH); 01402000 END CASE; 01403000 END SENDRECEIVER; 01404000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01405000 PROCEDURE BINARER; 01406000 BEGIN 01407000 SPECARA := SPECONOFF; 01408000 CASE SCANIT OF 01409000 BEGIN 01410000 QMARKV: 01411000 SAY(" transfer all 8 bits of each character - options are:"); 01412000 HELPER(ONOFFH); 01413000 ONV: 01414000 BINARYON := TRUE; 01415000 OFFV: 01416000 BINARYON := FALSE; 01417000 ELSE: 01418000 SAYQOPT("BINARY"); 01419000 HELPER(ONOFFH); 01420000 END CASE; 01421000 END BINARER; 01422000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01423000 PROCEDURE FIXER; 01424000 BEGIN 01425000 SPECARA := SPECONOFF; 01426000 CASE SCANIT OF 01427000 BEGIN 01428000 QMARKV: 01429000 SAY(" send trailing blanks found at the end of"); 01430000 SAY(" fixed-length records -- options are:"); 01431000 HELPER(ONOFFH); 01432000 ONV: 01433000 FIXEDRECS := TRUE; 01434000 OFFV: 01435000 FIXEDRECS := FALSE; 01436000 ELSE: 01437000 SAYQOPT("FIXED"); 01438000 HELPER(ONOFFH); 01439000 END CASE; 01440000 END FIXER; 01441000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01442000 PROCEDURE EXPANDTABBER; 01443000 BEGIN 01444000 SPECARA := SPECONOFF; 01445000 CASE SCANIT OF 01446000 BEGIN 01447000 QMARKV: 01448000 SAY(" expand TABs to spaces when RECEIVING files - options are:"); 01449000 HELPER(ONOFFH); 01450000 ONV: 01451000 EXPTABS := TRUE; 01452000 OFFV: 01453000 EXPTABS := FALSE; 01454000 ELSE: 01455000 SAYQOPT("EXPAND-TABS"); 01456000 HELPER(ONOFFH); 01457000 END CASE; 01458000 END EXPANDTABBER; 01459000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01460000 PROCEDURE RAWER; 01461000 BEGIN 01462000 SPECARA := SPECONOFF; 01463000 CASE SCANIT OF 01464000 BEGIN 01465000 QMARKV: 01466000 SAY(" fill each record to MAXRECSIZE when RECEIVING files -"); 01467000 SAY(" options are:"); 01468000 HELPER(ONOFFH); 01469000 ONV: 01470000 RAW := TRUE; 01471000 EXPTABS := FALSE; 01472000 SAY("EXPAND-TABS now set to OFF"); 01473000 OFFV: 01474000 RAW := FALSE; 01475000 IF EXPTABS THEN SAY("EXPAND-TABS is ON") 01476000 ELSE SAY("EXPAND-TABS is OFF"); 01477000 ELSE: 01478000 SAYQ("RAW"); 01479000 HELPER(ONOFFH); 01480000 END CASE; 01481000 END RAWER; 01482000 01483000 %%%%%%%%%%%%%%%%%%%%%% 01484000 PROCEDURE SETFILER; 01485000 BEGIN 01486000 01487000 INTEGER NDX; 01488000 SPECARA := SPECFILE; 01489000 CASE (NDX := SCANIT) OF 01490000 BEGIN 01491000 QMARKV: 01492000 HELPER(SETFILEH); 01493000 BLOCKSIZEV: 01494000 BLOCKER; 01495000 EXPTABSV: 01496000 EXPANDTABBER; 01497000 FIXEDV: 01498000 FIXER; 01499000 RAWV: 01500000 RAWER; 01501000 RECORDSIZEV: 01502000 RECSIZER; 01503000 UNITSV: 01504000 UNITER; 01505000 NOERRORV: 01506000 ; 01507000 ELSE: 01508000 SAYQOPT("FILE"); 01509000 HELPER(SETFILEH); 01510000 END OF CASE; 01511000 END OF PROCEDURE SETFILER; 01512000 %%%%%%%%%%%%%%%%%%%%%% 01513000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% mainline for procedure SETSTUFF 01514000 SPECARA := SPECSET; 01515000 CASE SCANIT OF 01516000 BEGIN 01517000 QMARKV: 01518000 SAY(" sets various KERMIT environment variables -- options are:"); 01519000 HELPER(SETH); 01520000 INCOMPLETEV: 01521000 ABORTER; 01522000 BINARYV: 01523000 BINARER; 01524000 DEBUGV: 01525000 DEBUGGER; 01526000 DELAYV: 01527000 DELAYER; 01528000 FILEV: 01529000 SETFILER; 01530000 RETRYV: 01531000 RETRYER; 01532000 SETRECEIVEV: 01533000 SENDRECEIVER(SETRECEIVEV); 01534000 SETSENDV: 01535000 SENDRECEIVER(SETSENDV); 01536000 NOERRORV: 01537000 ; 01538000 ELSE: 01539000 SAYQOPT("SET"); 01540000 HELPER(SETH); 01541000 END CASE; 01542000 END SETSTUFF; 01543000 01544000 $ENDSEGMENT 01545000 01546000 01547000 % 01548000 % S T A T U S 01549000 % 01550000 % DISPLAY THE STATUS OF ALL THE VARIOUS THINGS 01551000 % 01552000 PROCEDURE STATUS; 01553000 BEGIN 01554000 SAY("parameters which can be changed by the SET command"); 01555000 IF (BINARYON) THEN 01556000 SAY(" BINARY ON (8th bit quoting will be requested)") 01557000 ELSE 01558000 SAY(" BINARY OFF (No 8th bit quoting will be done)"); 01559000 IF DEBUG THEN 01560000 BEGIN 01561000 REPLACE PFILNAM:=POINTER(FILNAM) BY LOG.TITLE,NULC; 01562000 REPLACE PFILNAM BY PFILNAM FOR 80 WITH EBCDICTOASCII; 01563000 IF REAL(DEBUG) GTR 1 THEN 01564000 SAYN(" DEBUG STATES and PACKETS to file ",PFILNAM) 01565000 ELSE 01566000 SAYN(" DEBUG STATES to file ",PFILNAM); 01567000 END 01568000 ELSE 01569000 SAY(" DEBUG OFF"); 01570000 SAY1(" DELAY before first send (in seconds) = ",MYDELAY); 01571000 IF KEEPFILE THEN 01572000 SAY(" if INCOMPLETE, KEEP partial file") 01573000 ELSE 01574000 SAY(" if INCOMPLETE, DISCARD partial file"); 01575000 SAY1(" RETRY INITIAL-CONNECTION = ",INITRETRY); 01576000 SAY1(" RETRY PACKETS = ",PACKETRETRY); 01577000 SAY("parameters which can be changed by the SET FILE command"); 01578000 SAY1(" RECORD-SIZE = ",FILERECSIZE); 01579000 SAY1(" BLOCK-SIZE = ",FILEBLOCKSIZE); 01580000 IF FILEUNITS = VALUE(WORDS) THEN 01581000 SAY(" UNITS = WORDS") 01582000 ELSE 01583000 SAY(" UNITS = CHARACTERS"); 01584000 IF EXPTABS THEN 01585000 SAY(" EXPAND-TABS ON") 01586000 ELSE 01587000 SAY(" EXPAND-TABS OFF"); 01588000 IF FIXEDRECS THEN 01589000 SAY(" FIXED ON (send blanks found at the end of records)") 01590000 ELSE 01591000 SAY(" FIXED OFF (strip blanks from the end of records)"); 01592000 IF RAW THEN 01593000 SAY(" RAW ON ( Burroughs records delimited by size only )") 01594000 ELSE 01595000 SAY(" RAW OFF ( Burroughs records delimited by CR )"); 01596000 SPECARA := SPECSHOW; 01597000 CASE SCANIT OF 01598000 BEGIN 01599000 SHOSENDV: 01600000 SAY("parameters which can be changed by the SET SEND command"); 01601000 SAYC(" END-OF-LINE character = ",EOL); 01602000 SAY1(" maximum PACKET-LENGTH = ",SPSIZ); 01603000 SAY1(" number of PADDING characters = ",PAD); 01604000 IF PAD GTR 0 THEN 01605000 SAYC(" PADDING CHARACTER = ",PCHAR); 01606000 SAY1(" PAUSE before packet send (in tenths of second) = ",MYPAUSE*10);01607000 SAYC(" START-OF-PACKET charcter = ",SOHCHAR); 01608000 SAY1(" packet TIMEOUT (in seconds) = ",TIMINT); 01609000 ELSE: 01610000 SAY("parameters which can be changed by the SET RECEIVE command"); 01611000 SAYC(" END-OF-LINE character = ",MYEOL); 01612000 SAY1(" maximum PACKET-LENGTH = ",MYPACKSIZ); 01613000 SAY1(" number of PADDING characters = ",MYPAD); 01614000 IF MYPAD GTR 0 THEN 01615000 SAYC(" PADDING CHARACTER = ",MYPCHAR); 01616000 SAY1(" PAUSE before packet send (in tenths of second) = ",MYPAUSE*10);01617000 SAYC(" QUOTE character = ",MYQUOTE); 01618000 SAYC(" START-OF-PACKET character = ",MYSOH); 01619000 SAY1(" packet TIMEOUT (in seconds) = ",MYTIME); 01620000 END CASE; 01621000 END STATUS; 01622000 01623000 01624000 BOOLEAN PROCEDURE PROCESSIT; 01625000 BEGIN 01626000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01627000 PROCEDURE SERVANT; 01628000 BEGIN 01629000 BOOLEAN DONTQUIT; % LOOP CONTROL 01630000 ARRAY BUFFER[0:MAXPACKWDS]; % TEMPORARY FILE TITLE BUFFER 01631000 FILE DUMMY(KIND=PACK,FILETYPE=7);% TEMPORARY DUMMY FILE 01632000 REAL NUM,LEN,TIMER; % PACKET NUMBER, LENGTH, TIMEOUT 01633000 01634000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01635000 PROCEDURE GENERICTHINGS; % HANDLE "G" REQUESTS 01636000 BEGIN 01637000 POINTER PR; % POINTER TO PACKET 01638000 01639000 PR := POINTER(PACKET); % INITIALIZE IT 01640000 CASE REAL(PR,1) OF 01641000 BEGIN 01642000 "F": % FINISH, BUT DON'T LOGOUT 01643000 SPACK("Y",N,0,NULLDATA);% ACK TO PC AND THEN... 01644000 DONTQUIT := FALSE; % EXIT FROM WHILE LOOP 01645000 BRD := TRUE; % AND EXIT FROM MAIN LOOP 01646000 "L": % FINISH AND LOG OUT, TOO 01647000 % SPACK("Y",N,0,NULLDATA);% ACK TO PC AND THEN... 01648000 SAYN("BYE IS NOT IMPLEMENTED: ",PACKET); 01649000 DONTQUIT := FALSE; % EXIT FROM WHILE LOOP 01650000 BRD := TRUE; % AND EXIT FROM MAIN LOOP 01651000 % % THIS PART ISN'T IMPLEMENTED 01652000 ELSE: % SOME OTHER NON-IMPLEMENTED THING 01653000 SAYN("THIS IS NOT IMPLEMENTED: ",PACKET); 01654000 END CASE; 01655000 END GENERICTHINGS; 01656000 01657000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%% mainline statements for SERVANT 01658000 STATE := "T"; % JUST TO INITIALIZE FOR DEBUG 01659000 DONTQUIT := SERVER := TRUE; % INITIALIZE BOOLEANS 01660000 REPLACE PFILNAM:=POINTER(FILNAM) BY NULC FOR MAXPACKWDS WORDS; 01661000 TIMER := IF TIMINT LSS MINTIM OR TIMINT GTR MAXTIM THEN 01662000 MYTIME ELSE TIMINT; 01663000 01664000 WHILE DONTQUIT DO 01665000 BEGIN 01666000 REM.TIMELIMIT := TIMER; % SET UP FOR IO TIMEOUT 01667000 IF DEBUG THEN BUGC("SERVANT STATE: ",STATE); 01668000 CASE RPACK(LEN,NUM,PACKET) OF% DO WHICHEVER ONE WE NEED 01669000 BEGIN 01670000 "R": % GET OR RECEIVE A FILE(US TO PC) 01671000 N := NUM; % RESTART PACKET NUMBERS 01672000 REPLACE PFILNAM BY PACKET FOR LEN WITH TOUPPER, 01673000 ".",NULC; 01674000 REPLACE BUFFER BY PFILNAM FOR LEN+1 WITH ASCIITOEBCDIC; 01675000 IF DUMMY.OPEN THEN CLOSE(DUMMY); 01676000 REPLACE DUMMY.TITLE BY BUFFER; 01677000 IF NOT DUMMY.RESIDENT THEN 01678000 SAYN("NO FILE: ",FILNAM) 01679000 ELSE 01680000 IF SENDSW THEN 01681000 % SAYN("SEND DONE FOR: ",PFILNAM) 01682000 % ELSE 01683000 % SAYN("SEND FAILED FOR: ",PFILNAM); 01684000 STATE := "R"; % FOR DEBUG 01685000 "S": % SEND A FILE (FROM PC TO US) 01686000 CALL1 := TRUE; % [1.017] 01687000 RPAR(LEN,PACKET); % [1.017] EXCHANGE 01688000 SPAR(LEN,PACKET); % [1.017] PARAMETERS 01689000 SPACK("Y",NUM,LEN,PACKET); % [1.017] 01690000 OLDTRY := NUMTRY; % [1.017] RESET COUNTERS 01691000 NUMTRY := 0; % [1.017] 01692000 N := (NUM+1) MOD64; % [1.017] 01693000 IF (NOT RECSW("F")) THEN % [1.017] ATTEMPT TO RECEIVE01694000 BEGIN % [1.017] 01695000 REPLACE FBUF_ BY "RECEIVE FAILED."; 01696000 ERROR(FBUF_); % [1.017] 01697000 END; % [1.017] 01698000 % SAYN("RECEIVE DONE FOR: ",PFILNAM) 01699000 % ELSE % NO SUCH LUCK 01700000 % IF KEEPFILE THEN % WE GOT PART OF IT... 01701000 % SAYN("RECEIVE FAILED, BUT SAVED PART OF: ",PFILNAM) 01702000 % ELSE 01703000 % SAYN("RECEIVE FAILED FOR: ",PFILNAM); 01704000 STATE := "S"; % FOR DEBUG 01705000 "T": % TIMED OUT 01706000 SPACK("N",N,0,NULLDATA);% NAK ON TIMEOUT 01707000 STATE := "T"; % FOR DEBUG 01708000 "G": % GENERIC COMMAND 01709000 GENERICTHINGS; % TAKE CARE OF THEM ELSEWHERE 01710000 "I": % INITIALIZE PACKETS 01711000 CALL1 := TRUE; % [1.017] RPAR CALLED FIRST 01712000 RPAR(LEN,PACKET); % GET HIS INIT DATA 01713000 SPAR(LEN,PACKET); % FILL UP PACKET WITH MY INIT DATA 01714000 SPACK("Y",N,LEN,PACKET);% ACK WITH MY PARAMETERS 01715000 OLDTRY := NUMTRY; % SAVE OLD TRY COUNT 01716000 NUMTRY := 0; % INITIALIZE NUMTRY 01717000 ELSE: % WHO KNOWS 01718000 SPACK("N",N,6,PACKET); % NAK IT 01719000 END CASE; 01720000 END WHILE; 01721000 WHEN(5); % MAKE SURE ACK GETS OUT 01722000 BRD := TRUE; % EXIT THRU TO EOT 01723000 END SERVANT; 01724000 % 01725000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 01726000 % G E T F I L E T I T L E 01727000 % 01728000 % GETS THE DISK FILE TITLE FOR SENDING 01729000 % AND MAKES SURE THE FILE TITLE WILL FIT INSIDE A PACKET 01730000 % 01731000 PROCEDURE GETFILETITLE; 01732000 BEGIN 01733000 POINTER P,Q; 01734000 REAL I,J; 01735000 01736000 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 01737000 IF COL GTR 0 THEN 01738000 BEGIN 01739000 SCAN P:CP FOR I:COL WHILE GTR " "; 01740000 COL := *-I; 01741000 REPLACE PFILNAM:=POINTER(FILNAM) BY CP FOR COL,".",NULC; 01742000 CP := POINTER(PACKET)+COL; 01743000 IF (COL:=I)-1 GTR 0 THEN 01744000 SCAN Q:P+1 FOR J:I-1 UNTIL GTR " "; 01745000 IF MORETOSEND := J GTR 0 THEN 01746000 REPLACE NEXTSEND BY Q FOR J,NULC; 01747000 REPLACE PACKET BY NULC FOR MAXPACKWDS WORDS; 01748000 END; 01749000 END GETFILETITLE; 01750000 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% mainline statements for PROCESSIT 01751000 REPLACE CP:=PACKET BY NULC FOR MAXPACKWDS WORDS; 01752000 COL:=80; 01753000 SPECARA := SPECIAL; 01754000 BRD := WRITE(REM[STOP],11,KPROMPT); 01755000 IF NOT BRD := READ(REM,COL,PACKET) THEN 01756000 BEGIN 01757000 REPLACE CP BY CP FOR COL := RD.LENGTHF WITH TOUPPER; 01758000 COL_BASE := COL; 01759000 SCAN CP:CP FOR COL:COL WHILE LEQ " "; 01760000 IF COL GTR 0 THEN 01761000 CASE SCANIT OF 01762000 BEGIN 01763000 QMARKV: 01764000 HELPV: 01765000 HELPER(PLAINH); % ?, HELP 01766000 SERVERV: 01767000 SERVANT; % SERVER 01768000 SENDV: 01769000 GETFILETITLE; % SEND 01770000 IF SENDSW THEN 01771000 % SAY("SEND DONE") 01772000 ;% ELSE 01773000 % SAY("SEND FAILED"); 01774000 RECEIVEV: 01775000 REPLACE PFILNAM := POINTER(FILNAM) BY NULC FOR MAXPACKWDS WORDS;01776000 IF RECSW("R") THEN % [1.017] 01777000 % SAY("RECEIVE DONE") 01778000 ;% ELSE 01779000 % IF KEEPFILE THEN 01780000 % SAY("RECEIVE FAILED - PARTIAL FILE SAVED") 01781000 % ELSE 01782000 % SAY("RECEIVE FAILED"); 01783000 SETV: 01784000 SETSTUFF; % SET 01785000 SHOWV: 01786000 STATUSV: 01787000 STATUS; % STATUS 01788000 QUITV: 01789000 EXITV: 01790000 BRD := TRUE; 01791000 NOERRORV: % WE ALREADY GAVE THE ERROR 01792000 ; 01793000 ELSE: % GARBAGE? 01794000 SAYQOPT(" "); 01795000 HELPER(PLAINH); 01796000 END CASE; 01797000 IF MORETOSEND THEN 01798000 BEGIN 01799000 MORETOSEND := FALSE; 01800000 REPLACE CP := PACKET BY "SEND ",NEXTSEND FOR 01801000 COL:MAXPACKSIZ-5 UNTIL=NULC, NULC FOR COL; 01802000 END; 01803000 END IF; 01804000 END PROCESSIT; 01805000 01806000 01807000 % 01808000 % S E N D S W 01809000 % 01810000 % SENDSW IS THE STATE TABLE SWITCHER FOR SENDING FILES. IT LOOPS UNTI01811000 % EITHER IT FINISHES, OR AN ERROR IS ENCOUNTERED. THE ROUTINES CALLED01812000 % BY SENDSW ARE RESPONSIBLE FOR CHANGING THE STATE. 01813000 % 01814000 01815000 01816000 $BEGINSEGMENT 01817000 01818000 BOOLEAN PROCEDURE SENDSW; 01819000 BEGIN 01820000 BOOLEAN DONTQUIT; % LOOP CONTROL 01821000 FILE FP(KIND=DISK,FILETYPE=8, % CURRENT DISK FILE 01822000 INTMODE=ASCII, % SO CHECKSUM, ETC, WILL WORK 01823000 TRANSLATE=FORCESOFT,INPUTTABLE=EBCDICTOASCII, 01824000 MYUSE=IN); 01825000 01826000 01827000 01828000 % 01829000 % S I N I T 01830000 % 01831000 % SEND INITIATE: SEND THIS HOST'S PARAMETERS AND GET OTHER SIDE'S BACK01832000 01833000 01834000 REAL PROCEDURE SINIT; 01835000 BEGIN 01836000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 01837000 01838000 IF (NUMTRY:=*+1 LEQ INITRETRY) THEN 01839000 BEGIN 01840000 CALL1 := TRUE; % [1.017] SPAR CALLED FIRST 01841000 SPAR(LEN,PACKET); % FILL UP INIT INFO PACKET 01842000 01843000 IF NOT SERVER AND NUMTRY = 1 THEN % WAIT A BIT BEFORE SENDING THE 01844000 WHEN(MYDELAY); % INIT PACKET... 01845000 FLUSHINPUT; % FLUSH PENDING INPUT 01846000 01847000 SPACK("S",N,LEN,PACKET); % SEND AN S PACKET 01848000 CASE RPACK(LEN,NUM,RECPKT) OF % WHAT WAS THE REPLY? 01849000 BEGIN 01850000 "N": SINIT := STATE; % NAK, TRY IT AGAIN 01851000 01852000 "Y": % ACK 01853000 IF (N = NUM) THEN 01854000 BEGIN 01855000 RPAR(LEN,RECPKT); % GET OTHER SIDE'S INIT INFO 01856000 IF EOL = 0 THEN % CHECK AND SET DEFAULTS 01857000 EOL := MYEOL; 01858000 IF QUOTE = 0 THEN 01859000 QUOTE := MYQUOTE; 01860000 NUMTRY := 0; % RESET TRY COUNTER 01861000 N := (N+1) MOD64; % BUMP PACKET COUNT 01862000 SINIT := "F"; % OK, CASE STATE TO F 01863000 END ELSE 01864000 SINIT := STATE; % IF WRONG ACK, STAY IN S STATE 01865000 01866000 "E": % ERROR PACKET RECEIVED 01867000 PRERRPKT(RECPKT); % PRINT IT OUT AND 01868000 SINIT := "A"; % ABORT 01869000 01870000 "T": % RECEIVE FAILURE, TRY AGAIN 01871000 SINIT := STATE; 01872000 01873000 ELSE: % ANYTHING ELSE, JUST ABORT 01874000 SINIT := "A"; 01875000 END CASE; 01876000 END ELSE 01877000 SINIT := "A"; % IF TOO MANY TRIES, GIVE UP 01878000 END SINIT; 01879000 01880000 01881000 % 01882000 % S F I L E 01883000 % 01884000 % SEND FILE HEADER. 01885000 01886000 01887000 REAL PROCEDURE SFILE; 01888000 BEGIN 01889000 LABEL ACKHERE,QUIT; 01890000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 01891000 ARRAY FILNAM1[0:MAXPACKWDS]; % CONVERTED FILE NAME 01892000 POINTER NEWFILNAM, % POINTER TO FILE NAME TO SEND 01893000 CP; % CHAR POINTER 01894000 01895000 IF (NUMTRY:=*+1 LEQ PACKETRETRY+1) THEN 01896000 BEGIN 01897000 01898000 IF FP.OPEN THEN CLOSE(FP); % MAKE SURE IT'S CLOSED 01899000 SCAN CP := PFILNAM FOR LEN:MAXPACKSIZ UNTIL = NULC; 01900000 LEN := MAXPACKSIZ - LEN; % LENGTH OF BURROUGHS TITLE 01901000 REPLACE FILNAM1 BY PFILNAM FOR LEN WITH ASCIITOEBCDIC; 01902000 REPLACE FP.TITLE BY FILNAM1; % GIVE IT THE NEW NAME 01903000 IF NOT FP.PRESENT THEN % FILE ISN'T THERE 01904000 BEGIN 01905000 REPLACE FBUF_ BY "CANNOT FIND FILE: ",PFILNAM FOR MAXSENDFILESIZ01906000 WHILE GEQ " ",NULC; 01907000 ERROR(FBUF_); 01908000 SFILE := "A"; 01909000 GO QUIT; 01910000 END; 01911000 IF FP.EXTMODE = VALUE(EBCDIC) THEN % DEFAULT IS TO TRANSLATE IT... 01912000 BEGIN 01913000 CLOSE(FP); 01914000 FP.EXTMODE := VALUE(EBCDIC); 01915000 FP.OPEN := TRUE; 01916000 END 01917000 ELSE 01918000 IF FP.EXTMODE = VALUE(ASCII) THEN % DONT TRANSLATE IT... 01919000 BEGIN 01920000 CLOSE(FP); 01921000 FP.EXTMODE := VALUE(ASCII); 01922000 FP.TRANSLATE := VALUE(FULLTRANS); 01923000 FP.OPEN := TRUE; 01924000 END 01925000 ELSE 01926000 ; % GIVE UP...? 01927000 IF DEBUG THEN BUGN("OPENING FOR SENDING: ",PFILNAM); 01928000 RECSIZ_ := FP.MAXRECSIZE; 01929000 UNITS_ := IF FP.UNITS=VALUE(CHARACTERS) THEN 1 ELSE 6; 01930000 RESIZE(GBUF_,(RECSIZ_ * UNITS_ + 6) DIV 6);% MAKE BUFFER CORRECT SIZ01931000 LEN := *-1; % GET RID OF THE EXTRA PERIOD... 01932000 01933000 NUM := LEN; 01934000 WHILE NUM GTR 0 AND LEN GTR MAXSENDFILESIZ DO % PARE DOWN TITLE 01935000 BEGIN 01936000 SCAN NEWFILNAM:CP FOR NUM:LEN UNTIL ="/"; 01937000 IF NUM GTR 0 THEN 01938000 SCAN CP:NEWFILNAM FOR LEN:NUM WHILE = "/"; 01939000 END; 01940000 NUM := LEN; 01941000 NEWFILNAM := FILNAM1; 01942000 WHILE NUM GTR 0 DO 01943000 BEGIN 01944000 REPLACE NEWFILNAM:NEWFILNAM BY CP:CP FOR NUM:NUM WHILE NEQ """; 01945000 IF NUM GTR 0 THEN 01946000 BEGIN 01947000 SCAN CP:CP FOR NUM:NUM WHILE = """; 01948000 LEN := *-1; 01949000 END; 01950000 END; 01951000 IF LEN GTR 8 THEN % WE'LL HAVE TO INSERT A DOT 01952000 BEGIN 01953000 LEN := *+1; 01954000 REPLACE PFILNAM BY CP:FILNAM1 FOR 8 WITH FIXSLASHES, 01955000 "." , CP FOR LEN-8 WITH FIXSLASHES 01956000 END 01957000 ELSE 01958000 REPLACE PFILNAM BY FILNAM1 FOR LEN WITH FIXSLASHES; 01959000 REPLACE FILNAM1 BY PFILNAM FOR LEN, NULC; 01960000 01961000 01962000 IF DEBUG THEN 01963000 BUGN("SENDING: ",FILNAM1); 01964000 01965000 SPACK("F",N,LEN,FILNAM1); % SEND AN F PACKET 01966000 CASE RPACK(LEN,NUM,RECPKT) OF % WHAT WAS THE REPLY? 01967000 BEGIN 01968000 "N": % NAK, JUST STAY IN THIS STATE, 01969000 NUM := (NUM+63) MOD64; % UNLESS IT'S NAK FOR NEXT PACKET 01970000 IF N NEQ NUM THEN % WHICH IS JUST LIKE AN ACK FOR 01971000 SFILE := STATE % THIS PACKET SO FALL THRU TO... 01972000 ELSE GO TO ACKHERE; 01973000 01974000 "Y": % ACK 01975000 ACKHERE: IF N = NUM THEN % PACKET NUMBER MATCHES 01976000 BEGIN 01977000 NUMTRY := 0; % RESET TRY COUNTER 01978000 N := (N+1) MOD64; % BUMP PACKET COUNT 01979000 IF BSIZE := BUFILL(FP,PACKET)=0 01980000 THEN % GET FIRST DATA FROM FILE, ERROR? 01981000 SFILE := "Z" % YES, QUIT NOW 01982000 ELSE % A GOOD READ 01983000 SFILE := "D"; % CASE STATE TO D 01984000 END 01985000 ELSE 01986000 SFILE := STATE; % WRONG ACK, STAY IN F STATE 01987000 01988000 "E": % ERROR PACKET RECEIVED 01989000 PRERRPKT(RECPKT); % PRINT IT OUT AND 01990000 SFILE := "A"; % ABORT 01991000 01992000 "T": % RECEIVE FAILURE, STAY IN F STATE 01993000 SFILE := STATE; 01994000 01995000 ELSE: SFILE := "A"; % SOMETHING ELSE, JUST "ABORT" 01996000 END CASE; 01997000 END ELSE 01998000 SFILE := "A"; % IF TOO MANY TRIES, GIVE UP 01999000 QUIT: 02000000 END SFILE; 02001000 02002000 02003000 % 02004000 % S D A T A 02005000 % 02006000 % SEND FILE DATA 02007000 02008000 02009000 REAL PROCEDURE SDATA; 02010000 BEGIN 02011000 LABEL ACKHERE; 02012000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 02013000 02014000 IF (NUMTRY:=*+1 LEQ PACKETRETRY+1) THEN 02015000 BEGIN 02016000 02017000 SPACK("D",N,BSIZE,PACKET); % SEND A D PACKET 02018000 CASE RPACK(LEN,NUM,RECPKT) OF % WHAT WAS THE REPLY? 02019000 BEGIN 02020000 "N": % NAK, JUST STAY IN THIS STATE, 02021000 % UNLESS IT'S NAK FOR NEXT PACKET 02022000 NUM := (NUM+63) MOD64; % UNLESS IT'S NAK FOR NEXT PACKET 02023000 IF N NEQ NUM THEN % WHICH IS JUST LIKE AN ACK FOR 02024000 SDATA := STATE % THIS PACKET SO FALL THRU TO... 02025000 ELSE GO TO ACKHERE; 02026000 02027000 "Y": % ACK 02028000 ACKHERE: IF N = NUM THEN % IF WRONG ACK, FAIL 02029000 BEGIN 02030000 NUMTRY := 0; % RESET TRY COUNTER 02031000 N := (N+1)MOD64; % BUMP PACKET COUNT 02032000 IF ((BSIZE := BUFILL(FP,PACKET)) = 0) 02033000 THEN % GET DATA FROM FILE 02034000 SDATA := "Z" % IF EOF SET STATE TO THAT 02035000 ELSE SDATA := "D"; % GOT DATA, STAY IN STATE D 02036000 END 02037000 ELSE 02038000 SDATA := STATE; 02039000 02040000 "E": % ERROR PACKET RECEIVED 02041000 PRERRPKT(RECPKT); % PRINT IT OUT AND 02042000 SDATA := "A"; % ABORT 02043000 02044000 "T": SDATA := STATE; % RECEIVE FAILURE, STAY IN D 02045000 02046000 ELSE: SDATA := "A"; % ANYTHING ELSE, "ABORT" 02047000 END CASE; 02048000 END ELSE 02049000 SDATA := "A"; % IF TOO MANY TRIES, GIVE UP 02050000 END SDATA; 02051000 02052000 02053000 % 02054000 % S E O F 02055000 % 02056000 % SEND END-OF-FILE. 02057000 02058000 02059000 REAL PROCEDURE SEOF; 02060000 BEGIN 02061000 LABEL ACKHERE; 02062000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 02063000 IF (NUMTRY:=*+1 LEQ PACKETRETRY+1) THEN 02064000 BEGIN 02065000 02066000 SPACK("Z",N,0,PACKET); % SEND A "Z" PACKET 02067000 CASE RPACK(LEN,NUM,RECPKT) OF % WHAT WAS THE REPLY? 02068000 BEGIN 02069000 "N": % NAK, JUST STAY IN THIS STATE, 02070000 % UNLESS IT'S NAK FOR NEXT PACKET, 02071000 NUM := (NUM+63) MOD64; % UNLESS IT'S NAK FOR NEXT PACKET 02072000 IF N NEQ NUM THEN % WHICH IS JUST LIKE AN ACK FOR 02073000 SEOF := STATE % THIS PACKET SO FALL THRU TO... 02074000 ELSE GO TO ACKHERE; 02075000 02076000 "Y": % ACK 02077000 ACKHERE: 02078000 IF N = NUM THEN 02079000 BEGIN 02080000 NUMTRY := 0; % RESET TRY COUNTER 02081000 N := (N+1) MOD64; % AND BUMP PACKET COUNT 02082000 IF DEBUG THEN BUGN("CLOSING INPUT FILE: ",PFILNAM); 02083000 CLOSE(FP); % CLOSE THE INPUT FILE 02084000 SEOF := "B"; % BREAK, EOT, ALL DONE 02085000 END ELSE % IF WRONG ACK, HOLD OUT 02086000 SEOF := STATE; 02087000 02088000 "E": % ERROR PACKET RECEIVED 02089000 PRERRPKT(RECPKT); % PRINT IT OUT AND 02090000 SEOF := "A"; % ABORT 02091000 02092000 "T": SEOF := STATE; % RECEIVE FAILURE, STAY IN Z 02093000 02094000 ELSE: SEOF := "A"; % SOMETHING ELSE, "ABORT" 02095000 END CASE; 02096000 END ELSE 02097000 SEOF := "A"; % IF TOO MANY TRIES, ABORT 02098000 END SEOF; 02099000 02100000 02101000 % 02102000 % S B R E A K 02103000 % 02104000 % SEND BREAK (EOT) 02105000 02106000 02107000 REAL PROCEDURE SBREAK; 02108000 BEGIN 02109000 LABEL ACKHERE; 02110000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 02111000 IF (NUMTRY:=*+1 LEQ PACKETRETRY+1) THEN 02112000 BEGIN 02113000 02114000 SPACK("B",N,0,PACKET); % SEND A B PACKET 02115000 CASE RPACK(LEN,NUM,RECPKT) OF % WHAT WAS THE REPLY? 02116000 BEGIN 02117000 "N": % NAK, JUST STAY IN THIS STATE, 02118000 % UNLESS NAK FOR PREVIOUS PACKET, 02119000 NUM := (NUM+63) MOD64; % UNLESS IT'S NAK FOR NEXT PACKET 02120000 IF N NEQ NUM THEN % WHICH IS JUST LIKE AN ACK FOR 02121000 SBREAK := STATE % THIS PACKET SO FALL THRU TO... 02122000 ELSE 02123000 GO TO ACKHERE; 02124000 02125000 "Y": % ACK 02126000 ACKHERE: 02127000 IF N = NUM THEN % IF WRONG ACK, FAIL 02128000 BEGIN 02129000 NUMTRY := 0; % RESET TRY COUNTER 02130000 N := (N+1) MOD64; % AND BUMP PACKET COUNT 02131000 SBREAK := "C"; % CASE STATE TO COMPLETE 02132000 END ELSE 02133000 SBREAK := STATE; 02134000 02135000 "E": % ERROR PACKET RECEIVED 02136000 PRERRPKT(RECPKT); % PRINT IT OUT AND 02137000 SBREAK := "A"; % ABORT 02138000 02139000 "T": SBREAK := STATE; % RECEIVE FAILURE, STAY IN B 02140000 % [KS019] NEED TO RETRY ON TIME OUT 02141000 % "T": SBREAK := "C"; % TIMED OUT WAITING FOR LAST ACK 02142000 02143000 ELSE: SBREAK := "A"; % OTHER, "ABORT" 02144000 END CASE; 02145000 END ELSE 02146000 SBREAK := "A"; % IF TOO MANY TRIES, ABORT 02147000 END SBREAK; 02148000 02149000 % MAIN LINE TO SENDSW 02150000 02151000 02152000 02153000 STATE := "S"; % SEND INITIATE IS THE START STATE 02154000 N := 0; % INITIALIZE MESSAGE NUMBER 02155000 GCNT_ := -1; % INITIALIZE GETCHAR POINTER, ETC 02156000 NUMTRY := 0; % BUG NO TRIES YET 02157000 DONTQUIT := TRUE; % INITIALIZE FOR LOOP 02158000 REM.TIMELIMIT := IF TIMINT LSS MINTIM OR TIMINT GTR MAXTIM THEN 02159000 MYTIME ELSE TIMINT; 02160000 02161000 WHILE DONTQUIT DO % DO THIS AS LONG AS NECESSARY 02162000 BEGIN 02163000 IF DEBUG THEN BUGC("SENDSW STATE: ",STATE); 02164000 CASE STATE OF 02165000 BEGIN 02166000 "S": STATE := SINIT; % SEND-INIT 02167000 "F": STATE := SFILE; % SEND-FILE 02168000 "D": STATE := SDATA; % SEND-DATA 02169000 "Z": STATE := SEOF; % SEND-END-OF-FILE 02170000 "B": STATE := SBREAK; % SEND-BREAK 02171000 "C": SENDSW := TRUE; % COMPLETE 02172000 DONTQUIT:=FALSE; % LET'S QUIT 02173000 "A": SENDSW := FALSE; % "ABORT" 02174000 DONTQUIT:=FALSE; % LET'S QUIT 02175000 ELSE: SENDSW := FALSE; % UNKNOWN, FAIL 02176000 DONTQUIT:=FALSE; % LET'S QUIT 02177000 END CASE; 02178000 END WHILE; 02179000 REM.TIMELIMIT := 0; % DISABLE REMOTE INPUT TIMELIMIT 02180000 END SENDSW; 02181000 02182000 $ENDSEGMENT 02183000 02184000 02185000 % 02186000 % R E C S W 02187000 % 02188000 % THIS IS THE STATE TABLE SWITCHER FOR RECEIVING FILES. 02189000 02190000 02191000 $BEGINSEGMENT 02192000 02193000 BOOLEAN PROCEDURE RECSW(ISTATE); % [1.017] 02194000 REAL ISTATE; % [1.017] 02195000 BEGIN 02196000 BOOLEAN DONTQUIT; 02197000 FILE FP(KIND=DISK,MYUSE=OUT, % FILE POINTER FOR CURRENT DISK FILE02198000 INTMODE=ASCII,EXTMODE=EBCDIC,UNITS=FILEUNITS, 02199000 TRANSLATE=FULLTRANS,OUTPUTTABLE=ASCIITOEBCDIC, 02200000 MAXRECSIZE=FILERECSIZE,BLOCKSIZE=FILEBLOCKSIZE, 02201000 AREASIZE=FILEBLOCKSIZE DIV FILERECSIZE * 10); 02202000 02203000 02204000 02205000 % 02206000 % R I N I T 02207000 % 02208000 % RECEIVE INITIALIZATION 02209000 02210000 02211000 REAL PROCEDURE RINIT; 02212000 BEGIN 02213000 REAL LEN, NUM; % PACKET LENGTH, NUMBER 02214000 02215000 IF (NUMTRY:=*+1 LEQ INITRETRY) THEN 02216000 BEGIN 02217000 02218000 CASE IF SERVER AND NUMTRY=1 THEN "S" 02219000 ELSE 02220000 RPACK(LEN,NUM,PACKET) OF% GET A PACKET 02221000 BEGIN 02222000 "S": % SEND-INIT 02223000 CALL1 := TRUE; % [1.017] RPAR CALLED FIRST 02224000 RPAR(LEN,PACKET); % GET THE OTHER SIDE'S INIT DATA 02225000 SPAR(LEN,PACKET); % FILL UP PACKET WITH MY INIT 02226000 SPACK("Y",N,LEN,PACKET);% ACK WITH MY PARAMETERS 02227000 OLDTRY := NUMTRY; % SAVE OLD TRY COUNT 02228000 NUMTRY := 0; % START A NEW COUNTER 02229000 N := (N+1) MOD64; % BUMP PACKET NUMBER, MOD 64 02230000 RINIT := "F"; % ENTER FILE-RECEIVE STATE 02231000 02232000 "E": % ERROR PACKET RECEIVED 02233000 PRERRPKT(PACKET); % PRINT IT OUT AND 02234000 RINIT := "A"; % ABORT 02235000 02236000 "T": % DIDN'T GET PACKET 02237000 SPACK("N",N,0,NULLDATA);% RETURN A NAK 02238000 RINIT := STATE; % KEEP TRYING 02239000 02240000 ELSE: RINIT := "A"; % SOME OTHER PACKET TYPE, "ABORT" 02241000 END CASE; 02242000 END ELSE 02243000 RINIT := "A"; % SOME OTHER PACKET TYPE, ABORT 02244000 END RINIT; 02245000 02246000 02247000 % 02248000 % R F I L E 02249000 % 02250000 % RECEIVE FILE HEADER 02251000 02252000 02253000 REAL PROCEDURE RFILE; 02254000 BEGIN 02255000 LABEL QUIT; 02256000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 02257000 ARRAY FILNAM1[0:MAXPACKWDS]; % HOLDS THE CONVERTED FILE NAME 02258000 POINTER NEWFILNAM; 02259000 02260000 IF (NUMTRY:=*+1 LEQ PACKETRETRY+1) THEN 02261000 BEGIN 02262000 02263000 CASE RPACK(LEN,NUM,PACKET) OF% GET A PACKET 02264000 BEGIN 02265000 "S": % SEND-INIT, MAYBE OUR ACK LOST 02266000 IF OLDTRY := *+1 LEQ PACKETRETRY+1 THEN 02267000 BEGIN 02268000 IF NUM = (N+63) MOD64 02269000 THEN % PREVIOUS PACKET, MOD 64 ? 02270000 BEGIN % YES, ACK IT AGAIN WITH 02271000 CALL1 := FALSE; % [1.017] RPAR WAS ALREADY CALLED 02272000 SPAR(LEN,PACKET); % OUR SEND-INIT PARAMETERS 02273000 SPACK("Y",NUM,LEN,PACKET); % [1.019] FIX LENGTH PARAMETER02274000 NUMTRY := 0; % RESET TRY COUNTER 02275000 RFILE := STATE; % STAY IN THIS STATE 02276000 END 02277000 ELSE RFILE := "A"; % NOT PREVIOUS PACKET, "ABORT" 02278000 END ELSE 02279000 RFILE := "A"; 02280000 02281000 "Z": % END-OF-FILE 02282000 IF (OLDTRY := *+1 LEQ PACKETRETRY+1) THEN 02283000 BEGIN 02284000 IF NUM = (N+63) MOD64 02285000 THEN % PREVIOUS PACKET, MOD 64 ? 02286000 BEGIN % YES, ACK IT AGAIN. 02287000 SPACK("Y",NUM,0,NULLDATA); 02288000 NUMTRY := 0; 02289000 RFILE := STATE; % STAY IN THIS STATE 02290000 END 02291000 ELSE RFILE := "A"; % NOT PREVIOUS PACKET, "ABORT" 02292000 END ELSE 02293000 RFILE := "A"; % ABORT IT 02294000 02295000 "F": % FILE HEADER (JUST WHAT WE WANT) 02296000 IF NUM = N THEN % THE PACKET NUMBER MUST BE RIGHT 02297000 BEGIN 02298000 IF LEN LEQ 17 THEN 02299000 REPLACE PFILNAM BY """,PACKET FOR LEN WITH TOBURROUGHS, 02300000 "".",NULC 02301000 ELSE 02302000 REPLACE PFILNAM BY """,POINTER(PACKET)+(LEN-17) FOR 17 WITH02303000 TOBURROUGHS, "".",NULC; 02304000 IF FP.OPEN THEN CLOSE(FP); 02305000 IF KEEPFILE THEN FP.PROTECTION := VALUE(SAVE) 02306000 ELSE FP.PROTECTION := VALUE(TEMPORARY); 02307000 REPLACE FILNAM1 BY PFILNAM FOR LEN+4 WITH ASCIITOEBCDIC; 02308000 REPLACE FP.TITLE BY FILNAM1; 02309000 IF NOT FP.PRESENT THEN% DIDN'T OPEN THE FILE 02310000 BEGIN 02311000 REPLACE FBUF_ BY "CANNOT CREATE: ",PFILNAM FOR LEN,NULC;02312000 ERROR(FBUF_); 02313000 RFILE := "A"; 02314000 GO QUIT; 02315000 END 02316000 ELSE % OK, GIVE MESSAGE 02317000 IF DEBUG THEN 02318000 BUGN("RECEIVING: ",PFILNAM); 02319000 RECSIZ_ := FP.MAXRECSIZE; 02320000 UNITS_ := IF FP.UNITS=VALUE(CHARACTERS) THEN 1 ELSE 6; 02321000 RESIZE(PBUF_,(RECSIZ_ * UNITS_ +6) DIV 6);% SET UP BUFFER SIZE02322000 REPLACE PP_ := POINTER(PBUF_) BY " " FOR 02323000 PCNT_ := (RECSIZ_ * UNITS_) + 1; 02324000 SPACK("Y",N,0,NULLDATA); % ACKNOWLEDGE THE FILE HEADER 02325000 OLDTRY := NUMTRY; % RESET TRY COUNTERS 02326000 NUMTRY := 0; % ... 02327000 N := (N+1) MOD64; % BUMP PACKET NUMBER, MOD 64 02328000 RFILE := "D"; % CASE TO DATA STATE 02329000 END ELSE 02330000 RFILE := "A"; 02331000 02332000 "B": % BREAK TRANSMISSION (EOT) 02333000 IF NUM = N THEN % NEED RIGHT PACKET NUMBER HERE 02334000 BEGIN 02335000 SPACK("Y",N,0,NULLDATA);% BUG OK 02336000 RFILE := "C"; % GO TO COMPLETE STATE 02337000 END ELSE 02338000 RFILE := "A"; 02339000 02340000 "E": % ERROR PACKET RECEIVED 02341000 PRERRPKT(PACKET); % PRINT IT OUT AND 02342000 RFILE := "A"; % ABORT 02343000 02344000 "T": % DIDN'T GET PACKET 02345000 SPACK("N",N,0,NULLDATA); % RETURN A NAK 02346000 RFILE := STATE; % KEEP TRYING 02347000 02348000 ELSE: RFILE := "A"; % SOME OTHER PACKET, "ABORT" 02349000 END CASE; 02350000 END ELSE 02351000 RFILE := "A"; % ABORT IF TOO MANY TRIES 02352000 QUIT: 02353000 END RFILE; 02354000 02355000 02356000 % 02357000 % R D A T A 02358000 % 02359000 % RECEIVE DATA 02360000 02361000 02362000 REAL PROCEDURE RDATA; 02363000 BEGIN 02364000 REAL NUM, LEN; % PACKET NUMBER, LENGTH 02365000 IF NUMTRY:=*+1 LEQ PACKETRETRY+1 THEN 02366000 BEGIN 02367000 02368000 CASE RPACK(LEN,NUM,PACKET) OF% GET PACKET 02369000 BEGIN 02370000 "D": % GOT DATA PACKET 02371000 IF NUM NEQ N THEN % RIGHT PACKET? 02372000 BEGIN % NO 02373000 IF OLDTRY := *+1 LEQ PACKETRETRY+1 THEN 02374000 BEGIN 02375000 IF NUM = (N+63) MOD64 02376000 THEN % ELSE CHECK PACKET NUMBER 02377000 BEGIN % PREVIOUS PACKET AGAIN? 02378000 SPACK("Y",NUM,6,PACKET); % YES, RE-ACK IT 02379000 NUMTRY := 0; % RESET TRY COUNTER 02380000 RDATA := STATE; % DON'T WRITE OUT DATA! 02381000 END 02382000 ELSE RDATA := "A"; % SORRY, WRONG NUMBER 02383000 END 02384000 ELSE RDATA := "A"; 02385000 END ELSE 02386000 BEGIN 02387000 % GOT DATA WITH RIGHT PACKET NUMBER 02388000 BUFEMP(FP,PACKET,LEN);% WRITE THE DATA TO THE FILE 02389000 SPACK("Y",N,0,NULLDATA);% ACKNOWLEDGE THE PACKET 02390000 OLDTRY := NUMTRY; % RESET THE TRY COUNTERS 02391000 NUMTRY := 0; % ... 02392000 N := (N+1) MOD64; % BUMP PACKET NUMBER, MOD 64 02393000 RDATA := "D"; % REMAIN IN DATA STATE 02394000 END; 02395000 02396000 "F": % GOT A FILE HEADER 02397000 IF OLDTRY := *+1 LEQ PACKETRETRY+1 THEN 02398000 BEGIN 02399000 IF NUM = (N+63) MOD64 02400000 THEN % ELSE CHECK PACKET NUMBER 02401000 BEGIN % IT WAS THE PREVIOUS ONE 02402000 SPACK("Y",NUM,0,NULLDATA); % ACK IT AGAIN 02403000 NUMTRY := 0; % RESET TRY COUNTER 02404000 RDATA := STATE; % STAY IN DATA STATE 02405000 END 02406000 ELSE RDATA := "A"; % NOT PREVIOUS PACKET, "ABORT" 02407000 END ELSE 02408000 RDATA := "A"; % ABORT IT 02409000 02410000 "Z": % END-OF-FILE 02411000 IF NUM = N THEN % MUST HAVE RIGHT PACKET NUMBER 02412000 BEGIN 02413000 SPACK("Y",N,0,NULLDATA);% OK, ACK IT. 02414000 IF PCNT_ LSS RECSIZ_*UNITS_+1 THEN 02415000 BRD:=WRITE(FP,RECSIZ_,PBUF_);% FLUSH THE BUFFER 02416000 LOCK(FP,CRUNCH); % LOCK THE FILE 02417000 N := (N+1) MOD64; % BUMP PACKET NUMBER 02418000 RDATA := "F"; % GO BACK TO RECEIVE FILE STATE 02419000 END ELSE 02420000 RDATA := "A"; 02421000 02422000 "E": % ERROR PACKET RECEIVED 02423000 PRERRPKT(PACKET); % PRINT IT OUT AND 02424000 RDATA := "A"; % ABORT 02425000 02426000 "T": % DIDN'T GET PACKET 02427000 SPACK("N",N,0,NULLDATA);% RETURN A NAK 02428000 RDATA := STATE; % KEEP TRYING 02429000 02430000 ELSE: RDATA := "A"; % SOME OTHER PACKET, "ABORT" 02431000 END CASE; 02432000 END ELSE 02433000 RDATA := "A"; % ABORT IF TOO MANY TRIES 02434000 END RDATA; 02435000 02436000 % MAIN LINE TO RECSW 02437000 02438000 02439000 02440000 STATE := ISTATE; % [1.017] START STATE IS PASSED IN 02441000 % [1.017] N := 0; % INITIALIZE MESSAGE NUMBER 02442000 NUMTRY := 0; % BUG NO TRIES YET 02443000 DONTQUIT := TRUE; % LOOP INITIALIZATION 02444000 REM.TIMELIMIT := IF TIMINT LSS MINTIM OR TIMINT GTR MAXTIM THEN 02445000 MYTIME ELSE TIMINT; 02446000 02447000 WHILE DONTQUIT DO 02448000 BEGIN 02449000 IF DEBUG THEN BUGC("RECSW STATE: ",STATE); 02450000 CASE STATE OF 02451000 BEGIN 02452000 "R": STATE := RINIT; % RECEIVE-INIT 02453000 "F": STATE := RFILE; % RECEIVE-FILE 02454000 "D": STATE := RDATA; % RECEIVE-DATA 02455000 "C": RECSW := TRUE; % COMPLETE STATE 02456000 DONTQUIT := FALSE; % LET'S QUIT 02457000 "A": RECSW := FALSE; % "ABORT" STATE 02458000 DONTQUIT := FALSE; % LET'S QUIT 02459000 ELSE: RECSW := FALSE; % UNKNOWN STATE 02460000 DONTQUIT := FALSE; % LET'S QUIT 02461000 END CASE; 02462000 END WHILE; 02463000 REM.TIMELIMIT := 0; % DISABLE REMOTE INPUT TIMELIMIT 02464000 END RECSW; 02465000 02466000 $ENDSEGMENT 02467000 02468000 02469000 % 02470000 % KERMIT UTILITIES. 02471000 % 02472000 02473000 02474000 % 02475000 % S P A C K 02476000 % 02477000 % SEND A PACKET 02478000 02479000 02480000 $BEGINSEGMENT 02481000 02482000 PROCEDURE SPACK(TYPE,NUM,LEN,DATA); 02483000 VALUE TYPE,NUM,LEN; 02484000 REAL TYPE; 02485000 REAL NUM, LEN; 02486000 ARRAY DATA[0]; 02487000 BEGIN 02488000 REAL I; % CHARACTER LOOP COUNTER 02489000 REAL CHKSUM; % CHECKSUM 02490000 ARRAY BUFFER[0:MAXPACKWDS+1+(PAD+5)DIV 6]; % PACKET BUFFER 02491000 POINTER PB,PD; % BUFFER POINTERS 02492000 02493000 PD := POINTER(DATA); 02494000 REPLACE PD + LEN BY NULC; 02495000 IF REAL(DEBUG) GTR 1 THEN % DISPLAY OUTGOING PACKET 02496000 BEGIN 02497000 BUGC("SPACK TYPE: ",TYPE); 02498000 BUG1("NUM: ",NUM); 02499000 BUG1("LEN: ",LEN); 02500000 IF LEN GTR 0 THEN 02501000 BUGN("DATA: ",DATA); 02502000 END; 02503000 02504000 IF PAD GTR 0 THEN 02505000 REPLACE PB:PB:=POINTER(BUFFER) BY CH(PCHAR,PAD) 02506000 ELSE 02507000 PB := POINTER(BUFFER); 02508000 02509000 REPLACE PB:PB BY CH(SOHCHAR,1), % PACKET MARKER, ASCII 1 (SOH) 02510000 CH(TOCHAR(LEN+3),1), % SEND THE CHARACTER COUNT 02511000 CH(TOCHAR(NUM),1), % PACKET NUMBER 02512000 CH(TYPE,1); % PACKET TYPE 02513000 CHKSUM := TOCHAR(LEN+3) % CHECKSUM CHARACTER COUNT 02514000 + TOCHAR(NUM) % CHECKSUM PACKET NUMBER 02515000 + TYPE; % CHECKSUM PACKET TYPE 02516000 02517000 FOR I:=0 STEP 1 UNTIL LEN-1 DO % LOOP FOR ALL DATA CHARACTERS 02518000 BEGIN 02519000 CHKSUM := *+REAL(PD,1); % UPDATE CHECKSUM 02520000 REPLACE PB:PB BY PD:PD FOR 1;% GET A CHARACTER 02521000 END; 02522000 CHKSUM := *.[7:8]; % SIMULATE CHAR ARITHMETIC 02523000 CHKSUM := * + CHKSUM.[7:2]; 02524000 CHKSUM := *.[5:6]; % COMPUTE FINAL CHECKSUM 02525000 IF CHKSUM=0 THEN % WE MAY STRIP TRAILING BLANKS... 02526000 BEGIN 02527000 REPLACE PB:PB BY CH(TOCHAR(CHKSUM),1),% SO LET'S PUT IN A DUMMY 02528000 "?",CH(EOL,1); % ? BEFORE ANOTHER EOL... 02529000 LEN := *+2; % WE HAVE TO WRITE OUT 2 MORE, NOW 02530000 END 02531000 ELSE % NO NEED TO WORRY ABOUT IT 02532000 REPLACE PB:PB BY CH(TOCHAR(CHKSUM),1);% PUT IT IN THE PACKET 02533000 REPLACE PB:PB BY CH(EOL,1); % PUT IN LINE TERMINATOR 02534000 IF BRD := WRITE(REM[STOP],LEN+6+PAD,BUFFER) THEN 02535000 BEGIN 02536000 I := 3+1; % TRY 3 TIMES 02537000 WHILE BRD AND I := *-1 GTR 0 DO 02538000 BEGIN 02539000 IF DEBUG THEN BUGH("SPACK WRITE ERROR (HEX) = ",RD); 02540000 WHEN(.5); % WAIT A HALF SECOND 02541000 BRD := WRITE(REM,LEN+6+PAD,BUFFER); 02542000 END; % TRY THE IO AGAIN 02543000 END; 02544000 IF REAL(DEBUG) GTR 1 THEN 02545000 BUG1("CSUM: ",CHKSUM); 02546000 WHEN(.1); % ALLOW FOR TURN AROUND DELAY 02547000 END SPACK; 02548000 02549000 % 02550000 % R P A C K 02551000 % 02552000 % READ A PACKET 02553000 02554000 02555000 REAL PROCEDURE RPACK(LEN,NUM,DATA); 02556000 REAL LEN, NUM; % PACKET LENGTH, NUMBER 02557000 ARRAY DATA[0]; % PACKET DATA 02558000 BEGIN 02559000 LABEL GOTSOH,QUIT; 02560000 REAL I; % DATA CHARACTER NUMBER, LOOP EXIT 02561000 REAL R, % CURRENT INPUT CHARACTER 02562000 TYPE, % PACKET TYPE 02563000 CCHKSUM, % OUR (COMPUTED) CHECKSUM 02564000 RCHKSUM, % CHECKSUM RECEIVED FROM OTHER HOST 02565000 COL; % COLUMN COUNTER FOR PB 02566000 BOOLEAN DONE; % ARE WE THRU? 02567000 ARRAY BUFFER[0:49]; 02568000 POINTER PB,PD; 02569000 DEFINE ABORT = % TIMED OUT OR DEFICIENT PACKET 02570000 BEGIN 02571000 RPACK := "T"; % DEFAULT TO TIMED OUT OR SHORT PACK02572000 IF BRD.TIMEOUTBIT THEN 02573000 IF REAL(DEBUG) GTR 1 THEN 02574000 BUG("TIMED OUT") 02575000 ELSE 02576000 ELSE 02577000 IF BRD THEN % SOME OTHER ERROR 02578000 BEGIN 02579000 IF DEBUG THEN 02580000 BUGH("ERROR ON READ (HEX) = ",RD); 02581000 RPACK := 0; % ABORT ... NOW 02582000 END 02583000 ELSE % NO ERROR - MUST BE A SHORT PACKET 02584000 IF DEBUG THEN 02585000 BEGIN 02586000 BUG("SHORT PACKET"); 02587000 BUG1("CHARACTERS LEFT=",COL); 02588000 IF COL GTR 0 THEN 02589000 BUGN("WHICH ARE :",PB); 02590000 BUGN("BUFFER IS :",BUFFER); 02591000 END; 02592000 RD := 0; % RESET RESULT DESCRIPTOR 02593000 GO QUIT; 02594000 END#; 02595000 02596000 02597000 DO 02598000 BEGIN 02599000 IF BRD := READ(REM,300,BUFFER) THEN ABORT; 02600000 SCAN PB:PB:=POINTER(BUFFER) % FIND A SOH HEADER 02601000 FOR COL:RD.LENGTHF UNTIL = MYSOH; 02602000 IF COL := *-1 GTR 0 THEN % ADJUST POINTER AFTER SOH 02603000 PB := *+1; 02604000 END UNTIL COL GTR 0; 02605000 02606000 DONE := FALSE; % GOT SOH, INIT LOOP 02607000 GOTSOH: 02608000 02609000 IF COL LSS 4 THEN ABORT; % NOT A WHOLE PACKET LEFT 02610000 WHILE NOT DONE DO % LOOP TO GET A PACKET 02611000 BEGIN 02612000 % [1.017] IF HIBITOK THEN 02613000 % [1.017] R := REAL(PB,1) % TAKE 8 BITS 02614000 % [1.017] ELSE 02615000 R := REAL(PB,1).[6:7]; % HANDLE PARITY 02616000 PB := *+1; COL := *-1; % BUMP THE POINTER 02617000 IF R = MYSOH THEN GO TO GOTSOH;% RESYNCHRONIZE IF SOH 02618000 CCHKSUM := R; % START THE CHECKSUM 02619000 LEN := UNCHAR(R)-3; % CHARACTER COUNT 02620000 02621000 % [1.017] IF HIBITOK THEN 02622000 % [1.017] R := REAL(PB,1) % TAKE 8 BITS 02623000 % [1.017] ELSE 02624000 R := REAL(PB,1).[6:7]; % HANDLE PARITY 02625000 PB := *+1; COL := *-1; % BUMP THE POINTER 02626000 IF R = MYSOH THEN GO TO GOTSOH;% RESYNCHRONIZE IF SOH 02627000 CCHKSUM := * + R; % UPDATE CHECKSUM 02628000 NUM := UNCHAR(R); % PACKET NUMBER 02629000 02630000 % [1.017] IF HIBITOK THEN 02631000 % [1.017] R := REAL(PB,1) % TAKE 8 BITS 02632000 % [1.017] ELSE 02633000 R := REAL(PB,1).[6:7]; % HANDLE PARITY 02634000 PB := *+1; COL := *-1; % BUMP THE POINTER 02635000 IF R = MYSOH THEN GO TO GOTSOH;% SYNCHRONIZE IF SOH 02636000 CCHKSUM := * + R; % UPDATE CHECKSUM 02637000 TYPE := R; % PACKET TYPE 02638000 02639000 IF COL LSS LEN+1 THEN ABORT; % NOT A WHOLE PACKET LEFT 02640000 REPLACE PD := POINTER(DATA) BY NULC FOR MAXPACKSIZ; 02641000 FOR I := 0 STEP 1 UNTIL LEN-1 DO 02642000 BEGIN % LOOP FOR CHARACTER COUNT 02643000 % [1.017] IF HIBITOK THEN 02644000 % [1.017] R := REAL(PB,1) % TAKE 8 BITS 02645000 % [1.017] ELSE 02646000 R := REAL(PB,1).[6:7]; % HANDLE PARITY 02647000 IF R = MYSOH THEN GO GOTSOH;% RESYNCH IF SOH 02648000 CCHKSUM := * + R; % UPDATE CHECKSUM 02649000 REPLACE PD:PD BY PB:PB FOR 1;%PUT IT IN THE DATA BUFFER 02650000 COL := *-1; % BUMP THE POINTER 02651000 END; 02652000 02653000 R := REAL(PB,1); % TAKE 8 BITS 02654000 PB := *+1; COL := *-1; % BUMP THE POINTER 02655000 RCHKSUM := UNCHAR(R); % CONVERT TO NUMERIC 02656000 % [1.017] IF HIBITOK THEN % GET EOL CHARACTER AND TOSS IT 02657000 % [1.017] R := REAL(PB,1) % TAKE 8 BITS 02658000 % [1.017] ELSE 02659000 R := REAL(PB,1).[6:7]; % HANDLE PARITY 02660000 PB := *+1; COL := *-1; % BUMP THE POINTER 02661000 IF R = MYSOH THEN GO TO GOTSOH;% RESYNCHRONIZE IF SOH 02662000 DONE := TRUE; % GOT CHECKSUM, DONE 02663000 END; 02664000 02665000 IF REAL(DEBUG) GTR 1 THEN % DISPLAY INCOMING PACKET 02666000 BEGIN 02667000 BUGC("RPACK TYPE: ",TYPE); 02668000 BUG1("NUM: ",NUM); 02669000 BUG1("LEN: ",LEN); 02670000 IF LEN GTR 0 THEN 02671000 BUGN("DATA: ",DATA); 02672000 END; 02673000 % FOLD IN BITS 7:8 TO COMPUTE 02674000 CCHKSUM := * + CCHKSUM.[7:2]; % FINAL CHECKSUM 02675000 CCHKSUM := *.[5:6]; 02676000 02677000 IF CCHKSUM NEQ RCHKSUM THEN 02678000 RPACK := 0 02679000 ELSE 02680000 RPACK := TYPE; % ALL OK, RETURN PACKET TYPE 02681000 IF REAL(DEBUG) GTR 1 THEN 02682000 BEGIN 02683000 BUG1("CCSUM: ",CCHKSUM); 02684000 BUG1("RCSUM: ",RCHKSUM); 02685000 END; 02686000 QUIT: 02687000 WHEN(MYPAUSE); % WAIT BEFORE SENDING ACK 02688000 END RPACK; 02689000 02690000 $ENDSEGMENT 02691000 02692000 02693000 % 02694000 % B U F I L L 02695000 % 02696000 % GET A BUFFERFUL OF DATA FROM THE FILE THAT'S BEING SENT. 02697000 % CONTROL-QUOTING, 8-BIT & REPEAT COUNT PREFIXES ARE ALL 02698000 % HANDLED. 02699000 02700000 02701000 REAL PROCEDURE BUFILL(FID,BUFFER); 02702000 FILE FID; % DISK FILE TO FILL FROM 02703000 ARRAY BUFFER[0]; % BUFFER 02704000 BEGIN 02705000 LABEL QUIT; 02706000 REAL I, % LOOP INDEX 02707000 LASTT, % PREVIOUS CHARACTER READ FROM FILE 02708000 CNT, % COUNT OF IDENTICAL PREVIOUS CHARS 02709000 T; % CHAR READ FROM FILE 02710000 REAL T7; % 7-BIT VERSION OF ABOVE 02711000 BOOLEAN BT = T, % A BOOLEAN VERSION OF T 02712000 REPTON; % [1.017] TRUE WHEN REPEAT IN ACTION 02713000 POINTER PB, % POINTER TO BUFFER 02714000 PBSAVE; % [1.017] PTS TO SLOT FOR REPEAT COUNT02715000 02716000 REAL PROCEDURE FIXIT; % FIXES UP BINARY QUOTING, ETC 02717000 BEGIN 02718000 IF QBIN NEQ "N" THEN % [1.019] WE MAY USE 8-BIT STUFF 02719000 IF BT.[7:1] THEN % [1.019] HIGH BIT IS ON 02720000 BEGIN % [1.019] 02721000 REPLACE PB:PB BY CH(QBIN,1); 02722000 FIXIT := *+1; % [1.019] 02723000 END; % [1.019] 02724000 IF T7 IN ACNTRL[0] THEN % CONTROL, QUOTE, QBIN, REPT 02725000 BEGIN 02726000 REPLACE PB:PB BY CH(QUOTE,1); 02727000 IF T7 IN BCNTRL[0] THEN % DON'T CTL IT 02728000 REPLACE PB:PB BY CH(T7,1)% PUT IT OUT STRAIGHT 02729000 ELSE % IT'S 0 <= N <= 31 OR 127 02730000 IF T7 = NL THEN % TREAT NL SPECIALLY 02731000 IF NOT HIBITOK THEN % [1.019] 02732000 BEGIN 02733000 REPLACE PB:PB BY CH(CTL(CR),1), 02734000 CH(QUOTE,1), 02735000 CH(CTL(T7),1); 02736000 FIXIT := *+2; % WE'LL COUNT THE CHARACTER LATER 02737000 END 02738000 ELSE % CAN'T ADD CR IF USING 8 BITS 02739000 REPLACE PB:PB BY CH(CTL(T7),1) 02740000 ELSE % IT WASN'T A CR, ANYWAY 02741000 REPLACE PB:PB BY CH(CTL(T7),1); 02742000 FIXIT := *+1; % ADD 1 FOR THE QUOTE 02743000 END 02744000 ELSE % NOT A CONTROL CHARACTER 02745000 REPLACE PB:PB BY CH(T7,1); % PUT IT OUT NORMALLY 02746000 FIXIT := *+1; % FINALLY ADD IN THE LAST ONE 02747000 END FIXIT; 02748000 02749000 02750000 PB := POINTER(BUFFER); 02751000 I := 0; % INIT DATA BUFFER POINTER 02752000 WHILE (T:=GETC(FID)) NEQ EOF DO % GET THE NEXT CHARACTER 02753000 BEGIN 02754000 T7 := T.[6:7]; % GET LOW ORDER 7 BITS 02755000 02756000 IF (T = LASTT)AND(REPTOK) THEN % [1.017] CHECK FOR REPEAT 02757000 BEGIN % [1.017] 02758000 IF (I >0) THEN % [1.017] COUNT UNLESS FIRST CHAR02759000 BEGIN % [1.017] IN PACKET 02760000 CNT := *+1; % [1.017] 02761000 END; % [1.017] 02762000 % PROCESS CHAR NORMALLY UNTIL REPEAT THRESHOLD EXCEEDED 02763000 IF (NOT REPTON) THEN % [1.017] 02764000 BEGIN % [1.017] 02765000 % WHEN THRESHOLD EXCEEDED, BACKUP AND INSERT REPEAT PREFIX 02766000 IF (CNT > REPTTHRESH) THEN % [1.017] 02767000 BEGIN % [1.017] 02768000 IF (T7 IN ACNTRL[0]) THEN % [1.017] 02769000 BEGIN % [1.017] 02770000 PB := *-5; % [1.017] BACKUP FOR CTL QUOTE 02771000 I := *-5; % [1.017] 02772000 END; % [1.017] 02773000 PB := *-5; % [1.017] BACKUP FOR CHAR ITSELF 02774000 I := *-5; % [1.017] 02775000 REPLACE PB:PB BY CH(REPT,1);% [1.017] INSERT REPT QUOTE 02776000 I := *+1; % [1.017] 02777000 PBSAVE := PB; % [1.017] LEAVE SLOT FOR COUNT 02778000 PB := *+1; % [1.017] 02779000 I := *+1; % [1.017] 02780000 REPTON := TRUE; % [1.017] SET REPEAT FLAG 02781000 END; % [1.017] 02782000 I := *+FIXIT; % [1.017] INSERT CHAR WITH QUOTES02783000 END; % [1.017] 02784000 IF (CNT > MAXREPT) THEN % [1.017] CHECK FOR REPEAT LIMIT 02785000 BEGIN % [1.017] 02786000 REPLACE PBSAVE BY CH(TOCHAR(CNT),1); % FILL COUNT SLOT 02787000 REPTON := FALSE; % [1.017] RESET REPEAT FLAG 02788000 CNT := 0; % [1.017] 02789000 END; % [1.017] 02790000 END % [1.017] 02791000 ELSE % [1.017] 02792000 BEGIN % [1.017] 02793000 IF (REPTON) THEN % [1.017] CHECK FOR END OF REPEAT02794000 BEGIN % [1.017] 02795000 REPLACE PBSAVE BY CH(TOCHAR(CNT),1); % FILL COUNT SLOT 02796000 REPTON := FALSE; % [1.017] 02797000 END; % [1.017] 02798000 CNT := 1; % [1.017] 02799000 I := *+FIXIT; % [1.017] INSERT CHAR WITH QUOTING 02800000 LASTT := T; % [1.017] 02801000 END; % [1.017] 02802000 02803000 IF I GEQ SPSIZ-11 THEN % ALLOW FOR SOH,LEN,#,TYP,CHK,?,EOL,EOL,UP02804000 BEGIN 02805000 BUFILL := I; % CHECK LENGTH 02806000 GO TO QUIT; 02807000 END; 02808000 END WHILE; 02809000 BUFILL := I; % HANDLE PARTIAL BUFFER 02810000 QUIT: 02811000 END BUFILL; 02812000 02813000 02814000 % 02815000 % B U F E M P 02816000 % 02817000 % PUT DATA FROM AN INCOMING PACKET INTO A FILE. 02818000 02819000 02820000 PROCEDURE BUFEMP(FID,BUFFER,LEN); 02821000 VALUE LEN; 02822000 REAL LEN; 02823000 FILE FID; 02824000 ARRAY BUFFER[0]; % BUFFER 02825000 BEGIN 02826000 REAL I; % COUNTER 02827000 REAL T; % CHARACTER HOLDER 02828000 BOOLEAN HIBIT; % 8 BIT STUFF 02829000 REAL CNT; % REPEAT COUNT 02830000 POINTER PB; % BUFFER POINTER 02831000 02832000 PB := POINTER(BUFFER); 02833000 FOR I:=0 STEP 1 UNTIL LEN-1 DO % LOOP THRU THE DATA FIELD 02834000 BEGIN 02835000 HIBIT := FALSE; % INITIALIZE IT 02836000 CNT := 1; % WE HAVE 1 CHARACTER AT LEAST 02837000 T := REAL(PB,1); % GET CHARACTER 02838000 PB := *+1; 02839000 IF REPTOK THEN % WE CAN USE REPEAT COUNTS 02840000 IF T = MYREPT THEN % WE ARE REPEATING 02841000 BEGIN 02842000 CNT := UNCHAR(REAL(PB,1));% GET THE COUNT 02843000 PB := *+1; I := *+1; % BUMP THE POINTER 02844000 T := REAL(PB,1); % GET THE NEXT CHARACTER 02845000 PB := *+1; I := *+1; % BUMP THE POINTER 02846000 END; 02847000 IF HIBITOK THEN % WE CAN QUOTE 8-BIT STUFF 02848000 IF T = MYQBIN THEN % WE HAVE AN 8-BIT THING 02849000 BEGIN 02850000 HIBIT := TRUE; % SET THE FLAG 02851000 T := REAL(PB,1); % GET THE NEXT CHARACTER 02852000 PB := *+1; I := *+1; % BUMP THE POINTER 02853000 END; 02854000 IF T = MYQUOTE THEN % WE HAVE A QUOTED THING 02855000 BEGIN 02856000 T := REAL(PB,1); % GET THE NEXT CHARACTER 02857000 PB := *+1; I := *+1; % BUMP THE POINTER 02858000 IF NOT T IN BCNTRL[0] THEN% IT'S NOT QUOTE, QBIN OR REPT 02859000 T := CTL(T); % UNCONTROLIFY IT 02860000 END; 02861000 IF HIBIT THEN T := * & 1[7:1];% SET THE 8-TH BIT 02862000 THRU CNT DO 02863000 IF T = HT THEN % IS IT A TAB? 02864000 IF EXPTABS THEN % WE NEED TO EXPAND IT 02865000 THRU (TABLEN-((RECSIZ_*UNITS_-PCNT_) MOD TABLEN)) DO 02866000 PUTC(SP,FID) % FILL IN WITH SPACES 02867000 ELSE 02868000 PUTC(T,FID) % JUST PUT OUT THE TAB 02869000 ELSE % IT'S NOT A TAB 02870000 IF T = CR THEN % [1.017] IT'S A CR 02871000 IF (HIBITOK)OR(RAW) THEN % DON'T FIDDLE WITH IT 02872000 PUTC(T,FID) % PUT OUT A CR 02873000 ELSE % IT'S PROBABLY EXTRA, SO 02874000 % JUST EAT IT! 02875000 ELSE % NOT A CR, EITHER 02876000 PUTC(T,FID); % PUT IT OUT 02877000 END FOR LOOP; 02878000 02879000 END BUFEMP; 02880000 02881000 02882000 % 02883000 % S P A R 02884000 % 02885000 % FILL THE DATA ARRAY WITH MY SEND-INIT PARAMETERS 02886000 % 02887000 02888000 02889000 $BEGINSEGMENT 02890000 02891000 PROCEDURE SPAR(LEN,DATA); 02892000 REAL LEN; 02893000 ARRAY DATA[0]; 02894000 BEGIN 02895000 DEFINE FORCESEGMENT=#; % SO BEGINSEGMENT WILL WORK 02896000 POINTER PD; % [1.017] TEMPORARY POINTER 02897000 REPLACE PD:PD := POINTER(DATA) BY 02898000 CH(TOCHAR(MYPACKSIZ),1) , % BIGGEST PACKET I CAN RECEIVE 02899000 CH(TOCHAR(MYTIME),1) , % WHEN I WANT TO BE TIMED OUT 02900000 CH(TOCHAR(MYPAD),1) , % HOW MUCH PADDING I NEED 02901000 CH(CTL(MYPCHAR),1) , % PADDING CHARACTER I WANT 02902000 CH(TOCHAR(MYEOL),1) , % END-OF-LINE CHARACTER I WANT 02903000 CH(MYQUOTE,1) ; % CONTROL-QUOTE CHARACTER I SEND 02904000 IF CALL1 THEN % [1.019] 02905000 % IF SPAR IS CALLED FIRST (BEFORE RPAR) WE CONTROL 02906000 % WHETHER OR NOT 8TH BIT QUOTING CAN BE DONE 02907000 IF (BINARYON) THEN % [1.019] 02908000 REPLACE PD:PD BY CH(MYQBIN,1) % [1.019] REQUEST 8TH BIT QUOTING 02909000 ELSE % [1.019] 02910000 REPLACE PD:PD BY "N" % [1.019] PREVENT 8TH BIT QUOTING 02911000 ELSE % [1.019] 02912000 % IF SPAR IS CALLED SECOND (AFTER RPAR) WE 02913000 % RESPOND TO THE REQUEST FROM THE REMOTE KERMIT 02914000 IF (BINARYON)AND(HIBITOK) THEN % [1.019] 02915000 % IF 8TH BIT QUOTING REQUESTED, ACCEPT IF WE ARE IN BINARY MODE 02916000 IF (QBIN = "Y") THEN % [1.019] USE OUR QBIN CHAR 02917000 BEGIN % [1.019] 02918000 REPLACE PD:PD BY CH(MYQBIN,1); % [1.019] 02919000 QBIN := MYQBIN; % [1.019] 02920000 END % [1.019] 02921000 ELSE % [1.019] 02922000 BEGIN % [1.019] 02923000 REPLACE PD:PD BY "Y"; % [1.019] ACK 8BIT QUOTE REQUEST 02924000 MYQBIN := QBIN; % [1.019] USE INCOMING QBIN CHAR 02925000 END % [1.019] 02926000 ELSE % [1.019] 02927000 BEGIN % [1.019] 02928000 % 8TH BIT QUOTING WILL NOT BE DONE 02929000 REPLACE PD:PD BY "N"; % [1.019] NAK 8TH BIT QUOTING 02930000 HIBITOK := FALSE; % [1.019] 02931000 END; % [1.019] 02932000 % [1.019] 02933000 REPLACE PD:PD BY 02934000 CH(MYCHKTYPE,1) ; % [1.017] STANDARD CHECKTYPE 02935000 IF CALL1 THEN % [1.017] 02936000 BEGIN % [1.017] 02937000 % REQUEST REPEAT CHAR PROCESSING 02938000 REPLACE PD BY CH(MYREPT,1); % [1.017] 02939000 CALL1 := FALSE; % [1.017] 02940000 END % [1.017] 02941000 ELSE % [1.017] 02942000 BEGIN % [1.017] 02943000 % ACKNOWLEDGE REPEAT PROCESSING IF IT WAS REQUESTED 02944000 IF (REPTOK) THEN % [1.017] 02945000 REPLACE PD BY CH(REPT,1) % [1.017] 02946000 ELSE % [1.017] 02947000 REPLACE PD BY CH(SP,1); % [1.017] 02948000 CALL1 := TRUE; % [1.017] 02949000 END; % [1.017] 02950000 LEN := 9; % [1.017] 02951000 IF REAL(DEBUG) GTR 1 THEN % EXPAND IT ALL 02952000 BEGIN 02953000 BUG1("My packet size = ",MYPACKSIZ); 02954000 BUG1("My timeout = ",MYTIME); 02955000 BUG1("My padding = ",MYPAD); 02956000 BUGH("My padding character = ",MYPCHAR); 02957000 BUGH("My end of line character = ",MYEOL); 02958000 BUGC("My quote character = ",MYQUOTE); 02959000 BUGC("My binary quote character = ",MYQBIN); 02960000 BUGC("My checksum type = ",MYCHKTYPE); 02961000 BUGC("My repeat character = ",MYREPT); 02962000 IF REPTOK THEN 02963000 BUG("WE ARE REPEATING") 02964000 ELSE 02965000 BUG("NO REPEAT CHARACTER"); 02966000 IF HIBITOK THEN 02967000 BUG("WE ARE BINARY QUOTING") 02968000 ELSE 02969000 BUG("NOT BINARY QUOTING"); 02970000 END; 02971000 END SPAR; 02972000 02973000 02974000 % R P A R 02975000 % 02976000 % GET THE OTHER HOST'S SEND-INIT PARAMETERS 02977000 % 02978000 02979000 02980000 PROCEDURE RPAR(LEN,DATA); 02981000 REAL LEN; 02982000 ARRAY DATA[0]; 02983000 BEGIN 02984000 POINTER PD; 02985000 PD := POINTER(DATA); 02986000 02987000 02988000 SPSIZ := UNCHAR(REAL(PD,1)); % MAXIMUM SEND PACKET SIZE 02989000 PD := *+1; 02990000 TIMINT := UNCHAR(REAL(PD,1)); % WHEN I SHOULD TIME OUT 02991000 PD := *+1; 02992000 PAD := UNCHAR(REAL(PD,1)); % NUMBER OF PADS TO SEND 02993000 PD := *+1; 02994000 PCHAR:= CTL(REAL(PD,1)); % PADDING CHARACTER TO SEND 02995000 PD := *+1; 02996000 EOL := UNCHAR(REAL(PD,1)); % EOL CHARACTER I MUST SEND 02997000 PD := *+1; 02998000 UNTABLE(ACNTRL,QUOTE); % TAKE IT OUT OF THE ATABLE 02999000 UNTABLE(BCNTRL,QUOTE); % TAKE IT OUT OF THE BTABLE 03000000 QUOTE := REAL(PD,1); % INCOMING DATA QUOTE CHARACTER 03001000 TABLEIT(ACNTRL,QUOTE); % PUT NEW ONE IN THE ATABLE 03002000 TABLEIT(BCNTRL,QUOTE); % PUT NEW ONE IN THE BTABLE 03003000 % CHECK FOR REQUEST/ACKNOWLEDGE FOR 8TH BIT QUOTING 03004000 IF LEN := *-6 GTR 0 THEN % [1.019] 03005000 BEGIN % [1.019] 03006000 PD := *+1; % [1.019] SKIP PAST QUOTE 03007000 UNTABLE(ACNTRL,QBIN); % [1.019] TAKE OUT OF ATABLE 03008000 UNTABLE(BCNTRL,QBIN); % [1.019] TAKE OUT OF BTABLE 03009000 QBIN := REAL(PD,1); % [1.019] INCOMING 8BIT QUOTE 03010000 IF (CALL1) THEN % [1.019] 03011000 BEGIN % [1.019] 03012000 % [1.019] IF 8TH BIT MODE IS ENABLED, SEE IF INCOMING QBIN 03013000 % [1.019] CHAR REQUESTS 8TH BIT QUOTING 03014000 IF (BINARYON)AND((PD IN QUOTECHARS)OR(PD = "Y")) THEN 03015000 BEGIN % [1.019] 03016000 HIBITOK := TRUE; % [1.019] YES, SET OK FLAG 03017000 IF (PD = "Y") THEN % [1.019] 03018000 BEGIN % [1.019] 03019000 TABLEIT(ACNTRL,MYQBIN); % [1.019] TABLE MY QBIN CHAR 03020000 TABLEIT(BCNTRL,MYQBIN); % [1.019] 03021000 END % [1.019] 03022000 ELSE % [1.019] 03023000 BEGIN % [1.019] 03024000 TABLEIT(ACNTRL,QBIN); % [1.019] TABLE INCOMING QBIN 03025000 TABLEIT(BCNTRL,QBIN); % [1.019] 03026000 END; % [1.019] 03027000 END % [1.019] 03028000 ELSE % [1.019] 8TH BIT QUOTING WILL 03029000 HIBITOK := FALSE; % [1.019] NOT BE DONE 03030000 END 03031000 ELSE % [1.019] CALL 2, SPAR WAS CALLED FIRST 03032000 BEGIN % [1.019] 03033000 % [1.019] IF 8TH BIT MODE IS ENABLED, SEE IF WE 03034000 % [1.019] GOT AN ACK TO OUR 8TH BIT QUOTE REQUEST 03035000 IF (BINARYON)AND((QBIN = "Y")OR(QBIN = MYQBIN)) THEN 03036000 BEGIN % [1.019] 03037000 HIBITOK := TRUE; % [1.019] WILL DO 8TH BIT QUOTING 03038000 TABLEIT(ACNTRL,MYQBIN); % [1.019] TABLE MY QBIN CHAR 03039000 TABLEIT(BCNTRL,MYQBIN); % [1.019] 03040000 END % [1.019] 03041000 ELSE % [1.019] 03042000 HIBITOK := FALSE; % [1.019] 8TH BIT QUOTING WILL 03043000 END; % [1.019] NOT BE DONE 03044000 END; % [1.019] 03045000 IF LEN := *-2 GTR 0 THEN 03046000 BEGIN 03047000 PD := *+2; % [1.017] SKIP PAST QBIN,CHKTYPE 03048000 UNTABLE(ACNTRL,REPT); % [1.017] TAKE IT OUT OF ATABLE 03049000 UNTABLE(BCNTRL,REPT); % [1.017] TAKE IT OUT OF BTABLE 03050000 REPT := REAL(PD,1); % [1.017] INCOMING REPEAT CHAR 03051000 IF CALL1 THEN % [1.017] 03052000 BEGIN % [1.017] 03053000 % IF CHAR SENT IS A VALID QUOTE CHAR, WE ARE REPEATING 03054000 IF (PD IN QUOTECHARS) THEN % [1.017] VALID CHAR ? 03055000 BEGIN % [1.017] 03056000 REPTOK := TRUE; % [1.017] 03057000 MYREPT := REPT; % [1.017] 03058000 TABLEIT(ACNTRL,REPT); % [1.017] 03059000 TABLEIT(BCNTRL,REPT); % [1.017] 03060000 END % [1.017] 03061000 ELSE % [1.017] 03062000 REPTOK := FALSE; % [1.017] 03063000 CALL1 := FALSE; % [1.017] 03064000 END % [1.017] 03065000 ELSE % [1.017] 03066000 BEGIN % [1.017] 03067000 % IF CHAR MATCHES CHAR WE SENT, WE ARE REPEATING 03068000 IF (REPT = MYREPT) THEN % [1.017] 03069000 BEGIN % [1.017] 03070000 REPTOK := TRUE; % [1.017] 03071000 TABLEIT(ACNTRL,REPT); % [1.017] 03072000 TABLEIT(BCNTRL,REPT); % [1.017] 03073000 END % [1.017] 03074000 ELSE % [1.017] 03075000 REPTOK := FALSE; % [1.017] 03076000 CALL1 := TRUE; % [1.017] 03077000 END % [1.017] 03078000 END % [1.017] 03079000 ELSE % [1.017] 03080000 % DEFAULT TO NO REPEAT PROCESSING 03081000 BEGIN % [1.017] 03082000 REPTOK := FALSE; % [1.017] 03083000 END; % [1.017] 03084000 IF REAL(DEBUG) GTR 1 THEN % EXPAND IT ALL 03085000 BEGIN 03086000 BUG1("Your packet size = ",SPSIZ); 03087000 BUG1("Your timeout = ",TIMINT); 03088000 BUG1("Your padding = ",PAD); 03089000 BUGH("Your padding character = ",PCHAR); 03090000 BUGH("Your end of line character = ",EOL); 03091000 BUGC("Your quote character = ",QUOTE); 03092000 BUGC("Your binary quote character = ",QBIN); 03093000 BUGC("Your checksum type = ",CHKTYPE); 03094000 BUGC("Your repeat character = ",REPT); 03095000 IF REPTOK THEN 03096000 BUG("WE ARE REPEATING") 03097000 ELSE 03098000 BUG("NO REPEAT CHARACTER"); 03099000 IF HIBITOK THEN 03100000 BUG("WE ARE BINARY QUOTING") 03101000 ELSE 03102000 BUG("NOT BINARY QUOTING"); 03103000 END; 03104000 END RPAR; 03105000 03106000 03107000 % 03108000 % F L U S H I N P U T 03109000 % 03110000 % DUMP ALL PENDING INPUT TO CLEAR STACKED UP NAKS. 03111000 % 03112000 03113000 03114000 PROCEDURE FLUSHINPUT; 03115000 BEGIN 03116000 03117000 WHILE REM.CENSUS GTR 0 DO 03118000 BRD := READ(REM); 03119000 END FLUSHINPUT; 03120000 03121000 $ENDSEGMENT 03122000 03123000 03124000 % 03125000 % KERMIT PRINTING ROUTINES: 03126000 % 03127000 % PRERRPKT - PRINT CONTENTS OF ERROR PACKET RECEIVED FROM REMOTE HOST 03128000 03129000 03130000 % 03131000 % E R R O R 03132000 % 03133000 % PRINT ERROR MESSAGE. 03134000 % 03135000 % IF LOCAL, PRINT ERROR MESSAGE WITH PRINTMSG. 03136000 % IF REMOTE, SEND AN ERROR PACKET WITH THE MESSAGE. 03137000 03138000 03139000 % 03140000 % P R E R R P K T 03141000 % 03142000 % PRINT CONTENTS OF ERROR PACKET RECEIVED FROM REMOTE HOST. 03143000 03144000 PROCEDURE PRERRPKT(MSG); 03145000 ARRAY MSG[0]; 03146000 BEGIN 03147000 BUG("KERMIT ABORTING WITH FOLLOWING ERROR FROM REMOTE HOST:"); 03148000 BUGP(MSG); 03149000 END PRERRPKT; 03150000 03151000 INITIALIZE; 03152000 ON ANYFAULT [ KPROMPT[*] : COL] , ABORTRUN; 03153000 03154000 WHILE NOT BRD DO PROCESSIT; 03155000 03156000 END MAIN; 03157000 03158000 % 03159000 % O U T E R B L O C K 03160000 % 03161000 % OUTER BLOCK OF KERMIT 03162000 03163000 MAIN; 03164000 END. 03165000