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