home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
burroughs
/
b79ker.alg
< prev
next >
Wrap
Text File
|
2020-01-01
|
295KB
|
3,646 lines
$RESET LIST 00000100
%#PP %LOCAL PATCH IN DCALGOL-COMPILER. 00000200
%THIS PATCH MAKES THIS PROGRAM 00000300
%PRIVILEGED,NECESSARY TO CALL 00000400
%DIRREQUEST. 00000500
%IF YOU DON'T HAVE THIS PATCH, 00000600
%COMPILE THIS PROGRAM WITH ALGOL 00000700
%AND PP THE PROGRAM ON THE SPO. 00000800
00000900
00001000
00001100
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00001200
% THIS PROGRAM USES A LIBRARY CALLED DIRSEARCH. % 00001300
% DIRREQUEST : GETS THE REQUESTED DIRECTORY. % 00001400
% GETTITLE : GIVES THE NEXT TITLE IN THE DIRECTORY. % 00001500
% TITLESTART : WHERE TO FIND THE TITLE. % 00001600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00001700
00001800
00001900
00002000
$PAGE 00002100
BEGIN 00002200
LIBRARY DIRSEARCH (TITLE="*LIBRARY/DIRSEARCH ON APPL."); 00002300
BOOLEAN PROCEDURE DIRREQUEST (PDEST, SPEC); VALUE PDEST, SPEC; 00002400
% ---------- 00002500
POINTER PDEST; BOOLEAN SPEC; LIBRARY DIRSEARCH; 00002600
BOOLEAN PROCEDURE DIRSIZE (FILES, SEGS); INTEGER FILES, SEGS; 00002700
% ------- 00002800
LIBRARY DIRSEARCH; 00002900
INTEGER PROCEDURE DISPLAYFILEKIND (INFO, DEST); VALUE INFO, DEST; 00003000
% --------------- 00003100
REAL INFO; POINTER DEST; LIBRARY DIRSEARCH; 00003200
INTEGER PROCEDURE DISPLAYREQUEST (PT); VALUE PT; POINTER PT; 00003300
% -------------- 00003400
LIBRARY DIRSEARCH; 00003500
BOOLEAN PROCEDURE GETDIRECTORY (US); ARRAY US [0]; 00003600
% ------------- 00003700
LIBRARY DIRSEARCH; 00003800
BOOLEAN PROCEDURE GETTITLE (H); ARRAY H [0]; LIBRARY DIRSEARCH; 00003900
% -------- 00004000
BOOLEAN PROCEDURE INITDIR (MSK); VALUE MSK; REAL MSK; 00004100
% ------- 00004200
LIBRARY DIRSEARCH; 00004300
INTEGER PROCEDURE TITLESTART; LIBRARY DIRSEARCH; 00004400
% ---------- 00004500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00004600
% % 00004700
% K E R M I T - B U R . % 00004800
% ----------------------- % 00004900
% File Transfer Utility . % 00005000
% % 00005100
% Burroughs 7900 KERMIT, Eindhoven University of Technology, % 00005200
% Netherland, 1984 . % 00005300
% THS % 00005400
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00005500
% 00005600
% 00005700
% 00005800
FILE FILOUT ( KIND = REMOTE , 00005900
MAXRECSIZE = 1628 , 00006000
FILETYPE = 3 , 00006100
UNITS = CHARACTERS , 00006200
MYUSE = OUT ) , 00006300
00006400
FILIN ( KIND = REMOTE , 00006500
MAXRECSIZE = 96 , 00006600
FILETYPE = 3 , 00006700
UNITS = CHARACTERS , 00006800
MYUSE = IN ) , 00006900
00007000
FILSTORE ( KIND = DISK , 00007100
PROTECTION =SAVE) , 00007200
00007300
FILGET ( KIND = DISK ) , 00007400
00007500
JOURNAAL ( KIND = PRINTER , 00007600
MAXRECSIZE = 135 , 00007700
FILETYPE = 3 , 00007800
UNITS = CHARACTERS , 00007900
MYUSE = OUT , 00008000
TITLE = "KERMIT/LOG." , 00008100
PROTECTION = SAVE) , 00008200
00008300
WARNINGS ( KIND = DISK , 00008400
MAXRECSIZE = 80 , 00008500
BLOCKSIZE = 240 , 00008600
UNITS = 1 , 00008700
NEWFILE = FALSE , 00008800
PROTECTION = SAVE , 00008900
TITLE = "KERMIT/WARNINGS."), 00009000
00009100
KERMHELP ( KIND = DISK , 00009200
FILETYPE = 7 , 00009300
TITLE ="DATA/KERMITHELP ON APPL."); 00009400
00009500
$PAGE 00009600
EBCDIC ARRAY 00009700
COMMAND , % FOR THE PROCESINPUT 00009800
00009900
RECVPACKET [ 1:96 ] , % RECEIVE PACKET WITHOUT EOL 00010000
00010100
SENDPACKET , % SENDING PACKET WITH EOL 00010200
OLDPACKET [ 1:97 ] , % FOR RESENDING A PACKET 00010300
PADARR [1:20], % CONTAINS PADDING CHARACTERS 00010400
RECSTORE , % FOR WRITING TO DISKFILE 00010500
RECBUF [ 1:255 ], % FOR READING FROM DISKFILE 00010600
BINRECSTORE, 00010700
BINRECBUF [ 1:512 ], 00010800
% AND BUFFER DATAPART OF PACKET00010900
00011000
SCRATCH , 00011100
DIRIN [ 1:100 ] ; % CONTAINS FILEID OR DIRECTORY 00011200
% OF FILE(S) TO BE SEND 00011300
REAL ARRAY 00011400
DIRTITEL [ 0:99 ] ; % 00011500
% 00011600
POINTER PSEND , 00011700
PRECV , 00011800
POLD , 00011900
PCMD , 00012000
PCALC , 00012100
PSTORE , 00012200
PRCBUF , 00012300
PBINRECBUF , 00012400
PBINRECSTORE, 00012500
PDIRTITEL , 00012600
PSCRATCH , 00012700
PDIRIN , 00012800
HOLDPDIRIN ; 00012900
% 00013000
BOOLEAN BEXIT , % EXIT FROM KERMIT 00013100
QUOTESEEN , % TRUE IF QCTL SEEN 00013200
CRSEEN , % TRUE IF CR SEEN 00013300
REPTSEEN , % TRUE IF REPT SEEN 00013400
CHARBIT8 , % TRUE IF 8th BIT IS SET 00013500
RECV , % TRUE = GOOD PACKET ARRIVAL 00013600
EMPTYBUF , % TRUE = REC OR DATAPACK EMPTY 00013700
BEOF , % END OF FILE 00013800
DOEOL , % END OF RECORD ENCOUNTERED 00013900
WAITWITHEOL , % DO EOL AFTERWARDS 00014000
DEBUG , % TRUE = LOG WANTED 00014100
SERVERMODE , % TRUE = SEND ERRORPACKET 00014200
DIRREQUESTRESULT, 00014300
FIRSTFILETOSEND, % TRUE = SEND INIT 00014400
DIRECTORY, % TRUE = SEND DIRECTORY 00014500
BINARY, % TRUE = I WANT TO DO 00014600
% 8-BIT QUOTING 00014700
STOPBINARY, % TRUE = THE OTHER SIDE CAN'T 00014800
% DO 8-BIT QUOTING 00014900
REPEAT, % TRUE = DO DATA COMPRESSION 00015000
RECEIVEMODE, % TRUE = RECEIVING 00015100
EXTENSION, % TRUE = EXTEND WITH FILEKIND 00015200
RECDIR, % TRUE = RECeive DIRectory SET 00015300
SENDDIR, % TRUE = SEND DIRectory SET 00015400
SKIPFIRSTFILE ; % TRUE = FILEID. AND DIRECTORY 00015500
% ARE IDENTICAL 00015600
$PAGE 00015700
INTEGER DELAY , 00015800
% 00015900
SENDCOUNT , % (LENGTH - 2) OF SENDPACKET 00016000
RECVCOUNT , % (LENGTH - 2) OF RECVPACKET 00016100
OLDCOUNT , % LENGTH OF RESENDPACKET 00016200
LEN , % LENGTH OD DATA - PART 00016300
% 00016400
SEQNUM , 00016500
SENDSEQ , 00016600
RECVSEQ , 00016700
% 00016800
SENDPACKSIZE, 00016900
RECVPACKSIZE, 00017000
% 00017100
MYTIMEOUT , 00017200
THEIRTIMEOUT, 00017300
% 00017400
MYPAD , 00017500
SENDPAD , % NUMBER OF PADDING CHARACTERS 00017600
% 00017700
CHECK , 00017800
RECVCHECK , 00017900
CHECKTYPE , 00018000
RECVCHKTYPE , 00018100
% 00018200
RUNSTATE , 00018300
STATE , 00018400
% 00018500
NUMCHAR , 00018600
ROOM , 00018700
% 00018800
NUMTRY , 00018900
MAXTRY , 00019000
% 00019100
NUMSENDPACK , 00019200
NUMRECVPACK , 00019300
NUMACK , 00019400
NUMNAK , 00019500
NUMACKRECV , 00019600
NUMNAKRECV , 00019700
NUMBADRECV , 00019800
% 00019900
SENDFILEKINDV , % 00020000
RECFILEKINDV , % 00020100
SENDMAXRECSIZEV , % NECESSARY TO 00020200
RECMAXRECSIZEV , % HANDLE FILE 00020300
MAXRECCHAR , % TRANSPORT ON 00020400
RECTYPE , % THE B7700 00020500
TEXTWIDTH , % 00020600
SEQWIDTH , % 00020700
SSEQ , % 00020800
SEQCOUNT , % 00020900
% 00021000
CRLFSEEN , % TO AVOID SUPERFLUOUS NEWLINES00021100
K , 00021200
LOFSCRATCH , % LENGTH OF RECeive DIRectory 00021300
LOFSENDDIR , % LENGTH OF SEND DIRectory 00021350
COUNT ; % FOR REPEAT COUNT PROCESSING 00021400
$PAGE 00021500
REAL MYSOP , 00021600
SENDSOP , 00021700
% 00021800
PACKETTYPE , 00021900
RECVPTYPE , 00022000
SENDPTYPE , 00022100
% 00022200
MYPADCHAR , 00022300
SENDPADCHAR , 00022400
% 00022500
MYEOL , 00022600
SENDEOL , 00022700
% 00022800
MYQUOTE , 00022900
SENDQUOTE , 00023000
% 00023100
MY8BQ , 00023200
SEND8BQ , 00023300
% 00023400
MYREPT , 00023500
SENDREPT , 00023600
% 00023700
HELPPARM , % PARAMETER FOR THE HELPPROC. 00023800
LASTCHAR , 00023900
TSV ; % TITLE START VALUE 00024000
% START OF FILENAME IN DIRTITEL00024100
% (NORMAL = 30) 00024200
00024300
% 00024400
TRANSLATETABLE LTOU ( EBCDIC TO EBCDIC, 00024500
"abcdefghijklmnopqrstuvwxyz" TO 00024600
"ABCDEFGHIJKLMNOPQRSTUVWXYZ") ; 00024700
TRANSLATETABLE HPR (EBCDIC TO EBCDIC,48"00"TO 48"4B",48"0D"TO 48"40"); 00024800
% 00024900
TRUTHSET TIETEL (ALPHA OR " " OR "/" OR "(" OR ")" OR "*"), 00025000
TIETELNOSPACE (TIETEL AND NOT " "); 00025100
$PAGE 00025200
% DEFINES ON CHARACTERS IN ASCII - CODE ** 00025300
00025400
DEFINE LF = 48"0A" # , % LINEFEED 00025500
CR = 48"0D" # , % CARRIAGE RETURN 00025600
CRLF = 48"OD0A"# , % CRLF 00025700
SOH = 48"01" # , % START OF HEADER 00025800
DEL = 48"7F" # , % DELETE 00025900
BLANK = 48"20" # , % SPATIE 00026000
NULL = 48"00" # , % NULL 00026100
SLASH = 48"2F" # , % ASCII - "/" 00026200
ASCRP = 48"29" # , % ASCII - ")" 00026300
ASCDOT = 48"2E" # , % ASCII - "." 00026400
ASCJ = 48"4A" # , % ASCII - J 00026500
ASCM = 48"4D" # , % ASCII - M 00026600
00026700
% DEFINES OF THE DEFAULTVALUES OF KERMIT ** 00026800
00026900
MAXPACK = 94 # , % MAXIMUM PACKET-LENGTH 00027000
MINPACK = 10 # , % MINIMUM PACKET-LENGTH 00027100
DEFPAD = 0 # , % NUMBER OF PADDING = 0 00027200
DEFPADCHAR = 0 # , % PADCHAR = 0 00027300
DEFEOL = CR # , % EOL = CR 00027400
DEFSOP = SOH # , % SOP = SOH 00027500
DEFQUOTE = 48"23" # , % QUOTE = # 00027600
DEF8BQ = 48"4E" # , % NO 8-bit QUOTING 00027700
DEFREPT = 48"7E" # , % REPT = ~ 00027800
DEFCHKTYPE = 48"31" # , % SINGLE-ARITHMETIC CHECKSUM = 100027900
DEFTRY = 5 # , % NUMBER OF TRIES OF SAME PACKET00028000
DEFINITTRY = 10 # , % NUMBER OF TRIES OF INIT-PACKET00028100
DEFTIMEOUT = 15 # , % TIMEOUT = 15 SEC 00028200
DEFDELAY = 5 # , % DELAY = 5 SEC 00028300
NUMPARAM = 9 # , % NUMBER OF PARMS IN INITPACKET 00028400
00028500
% DEFINES FOR THE PACKET - TYPES IN ASCII-CODE ** 00028600
00028700
ACK = 48"59" # , % ACK = "Y" 00028800
NAK = 48"4E" # , % NAK = "N" 00028900
DATA = 48"44" # , % DATA = "D" 00029000
SINIT = 48"53" # , % INIT = "S" 00029100
FILEHEAD = 48"46" # , % FILEHEADER = "F" 00029200
ERROR = 48"45" # , % ERROR = "E" 00029300
EOF = 48"5A" # , % EOF = "Z" 00029400
BRK = 48"42" # , % BRK = "B" 00029500
RINIT = 48"52" # , % RINIT = "R" 00029600
IINIT = 48"49" # , % IINIT = "I" 00029700
GENERIC = 48"47" # , % GENERIC = "G" 00029800
TEXT = 48"58" # , % TEXT = "X" 00029900
00030000
% DEFINES FOR COMMANDS IN GENERIC - PACKETS IN ASCII-CODE ** 00030100
00030200
FINISH = 48"46" # , % FINISH = "F" 00030300
LOGOUT = 48"4C" # , % LOGOUT = "L" 00030400
00030500
% DEFINES FOR THE COMMAND - STATE ** 00030600
00030700
SET = 11 # , 00030800
SHOW = 12 # , 00030900
SEND = 13 # , 00031000
RECEIVE = 14 # , 00031100
SERVER = 15 # , 00031200
HELP = 16 # , 00031300
EXIT = 17 # , 00031400
SPATIE = 18 # , 00031500
00031600
% DEFINES FOR THE STATE-TABLE ** 00031700
00031800
NEXTFILE = 19 # , 00031900
INIT = 20 # , 00032000
FILEHEADER = 21 # , 00032100
FILEDATA = 22 # , 00032200
EOFFILE = 23 # , 00032300
BREAK = 24 # , 00032400
COMPLETE = 25 # , 00032500
ABORT = 26 # , 00032600
00032700
$PAGE 00032800
% DEFINES FOR ERRORMESSAGES ON COMMANDS ** 00032900
00033000
NOCOMMAND = 40 # , 00033100
TOOPARM = 41 # , 00033200
PARMEXPECT = 42 # , 00033300
INVPARM = 43 # , 00033400
TOOVALUE = 44 # , 00033500
VALUEXPECT = 45 # , 00033600
INVVALUE = 46 # , 00033700
FNOTEX = 47 # , 00033800
ERRDIRREQUEST = 48 # , 00033900
NOFILEKIND = 49 # , 00034000
NOFILE = 50 # , 00034100
NOFILENAME = 51 # , 00034200
00034300
% DEFINES FOR ERRORMESSAGES ON FILE-TRANSPORT ** 00034400
00034500
CANTRECVINIT= 52 # , 00034600
CANTRECVFH = 53 # , 00034700
CANTRECVDATA= 54 # , 00034800
CANTSENDINIT= 56 # , 00034900
CANTSENDFH = 57 # , 00035000
CANTSENDDATA= 58 # , 00035100
CANTSENDEOF = 59 # , 00035200
CANTSENDBRK = 60 # , 00035300
NOTIMPLEM = 62 # , 00035400
SOPWRONG = 65 # , 00035500
READTIMEOUT = 66 # , 00035600
READERROR = 67 # , 00035700
TRANSMITERR = 68 # , 00035800
NOQUOTE = 72 # , 00035900
CANTNAMEFILE= 75 # , 00036000
BINFAULT = 76 # , 00036100
$PAGE 00036200
% DEFINES FOR PROGRAMMER ** 00036300
00036400
P = POINTER # , 00036500
DEBLANK(P) = SCAN P:P WHILE= " " # , 00036600
CTL(X) = ((X + 64) MOD 128) # , 00036700
CHAR(X) = (X + 32) # , 00036800
BITSSHIFT(X) = X.[7:48] FOR 1 # , 00036900
CHARSHIFT(X) = (X + 32).[7:48] FOR 1 # , 00037000
UNCHAR(X) = (REAL( X,1 ) - 32) # , 00037100
CTLSHIFT(X) = ((X + 64) MOD 128).[7:48] FOR 1 # , 00037200
TRANSTOEBCDIC( X, Y, Z ) 00037300
= REPLACE X[Y] BY X[Y] 00037400
FOR Z WITH ASCIITOEBCDIC; # , 00037500
TRANSTOASCII( X, Y, Z ) 00037600
= REPLACE X[Y] BY X[Y] 00037700
FOR Z WITH EBCDICTOASCII; # , 00037800
CONTROL(X) = (X = DEL) OR (X < BLANK)# , 00037900
GETCHAR(X) = BEGIN 00038000
X := REAL( PRCBUF,1 ) ; 00038100
PRCBUF := * + 1 ; 00038200
NUMCHAR := * - 1 00038300
END # , 00038400
GETBINCHAR(X) = BEGIN 00038500
X := REAL(PBINRECBUF,1); 00038600
PBINRECBUF := * + 1; 00038700
NUMCHAR := * - 1 00038800
END # , 00038900
BIT8 = (IF CHARBIT8 THEN 1 ELSE 0) # , 00039000
CALCSUM( X, Y ) 00039100
= BEGIN 00039200
CHECK := 0 ; 00039300
PCALC := X[2] ; 00039400
FOR K := 0 STEP 1 UNTIL ( Y - 1 ) DO 00039500
CHECK := * + REAL( PCALC + K, 1 ) ; 00039600
CHECK := ( CHECK + CHECK.[7:2] ) MOD 64 ; 00039700
END # ; 00039800
00039900
$PAGE 00040000
%************** PROCEDURE - DECLARATIES **************************** 00040100
00040200
00040300
PROCEDURE ERRORHANDLER(ERRMSG); 00040400
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00040500
% % 00040600
% ERROR HANDLER % 00040700
% THS % 00040800
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00040900
00041000
INTEGER ERRMSG ; 00041100
00041200
BEGIN 00041300
EBCDIC ARRAY 00041400
MSG [ 1:36 ] ; 00041500
00041600
POINTER PMSG ; 00041700
00041800
DEFINE PUTMSG(X) = REPLACE PMSG:= MSG[1] BY X FOR 36 # ; 00041900
00042000
BEGIN 00042100
IF (ERRMSG < 52) 00042200
THEN BEGIN 00042300
CASE ERRMSG OF 00042400
BEGIN 00042500
NOCOMMAND : PUTMSG ( "ERROR ** NO COMMAND ");00042600
TOOPARM : PUTMSG ( "ERROR ** TOO MANY PARAMETERS ");00042700
PARMEXPECT : PUTMSG ( "ERROR ** PARAMETERS EXPECTED ");00042800
INVPARM : PUTMSG ( "ERROR ** INVALID PARAMETERS ");00042900
VALUEXPECT : PUTMSG ( "ERROR ** VALUE EXPECTED ");00043000
INVVALUE : PUTMSG ( "ERROR ** INVALID VALUE ");00043100
FNOTEX : PUTMSG ( "ERROR ** NOT EXISTING FILE(S) ");00043200
ERRDIRREQUEST: PUTMSG ( "ERROR ** DIRREQUEST FAILED ");00043300
TOOVALUE : PUTMSG ( "ERROR ** VALUE TOO LARGE ");00043400
NOFILENAME : PUTMSG ( "ERROR ** NO FILE - NAME ");00043500
NOFILE : PUTMSG ( "ERROR ** NO FILE ");00043600
NOFILEKIND : PUTMSG ( "ERROR ** NO FILE - KIND ");00043700
END CASE ; 00043800
IF NOT SERVERMODE 00043900
THEN BEGIN 00044000
WRITE( FILOUT, 36, MSG[*] ) ; 00044100
IF DEBUG THEN 00044200
WRITE( JOURNAAL[SPACE 2], < X3, A36>, MSG[*] ) ; 00044300
END 00044400
ELSE BEGIN 00044500
REPLACE RECBUF[1] BY MSG[1] FOR 36 00044600
WITH EBCDICTOASCII ; 00044700
IF DEBUG THEN 00044800
WRITE(JOURNAAL[SPACE 2],<"SERVER",X3,A36>,MSG[*]); 00044900
END; 00045000
END 00045100
ELSE BEGIN 00045200
CASE ERRMSG OF 00045300
BEGIN 00045400
CANTRECVINIT : PUTMSG ( "ERROR ** CAN'T RECEIVE INIT ");00045500
CANTRECVFH : PUTMSG ( "ERROR ** CAN'T RECEIVE F-HEAD ");00045600
CANTRECVDATA : PUTMSG ( "ERROR ** CAN'T RECEIVE F-DATA ");00045700
CANTSENDINIT : PUTMSG ( "ERROR ** CAN'T SEND INIT-PACK ");00045800
CANTSENDFH : PUTMSG ( "ERROR ** CAN'T SEND FILENAME ");00045900
CANTSENDDATA : PUTMSG ( "ERROR ** CAN'T SEND DATA ");00046000
CANTSENDEOF : PUTMSG ( "ERROR ** CAN'T SEND EOF ");00046100
CANTSENDBRK : PUTMSG ( "ERROR ** CAN'T SEND BREAK ");00046200
NOTIMPLEM : PUTMSG ( "ERROR ** NOT IMPLEMENTED ");00046300
SOPWRONG : PUTMSG ( "ERROR ** START OF PACKET WRONG ");00046400
READTIMEOUT : PUTMSG ( "ERROR ** READACTION TIMED OUT ");00046500
READERROR : PUTMSG ( "ERROR ** ERROR ON READACTION ");00046600
TRANSMITERR : PUTMSG ( "ERROR ** CHECKS DON'T MATCH ");00046700
NOQUOTE : PUTMSG ( "ERROR ** FORGOTTEN TO QUOTE ");00046800
CANTNAMEFILE : PUTMSG ( "ERROR ** CANT CHANGE FILENAME ");00046900
BINFAULT : PUTMSG ( "ERROR ** BINARY FILE ISN'T DATA ");00047000
END CASE; 00047100
IF NOT SERVERMODE THEN 00047200
IF DEBUG THEN 00047300
WRITE( JOURNAAL[SPACE 2],<"*******",X3,A36>,MSG[*]) 00047400
ELSE 00047500
ELSE 00047600
BEGIN 00047700
REPLACE RECBUF[1] BY MSG[1] FOR 36 00047800
WITH EBCDICTOASCII ; 00047900
IF DEBUG THEN 00048000
WRITE( JOURNAAL[SPACE 2],<"SERVER*",X3,A36>,MSG[*]); 00048100
END; 00048200
END ; 00048300
END; 00048400
END ERRORHANDLER ; 00048500
$PAGE 00048600
PROCEDURE PRINTLOGHEADING(B); VALUE B; BOOLEAN B; 00048700
BEGIN 00048800
VALUE ARRAY 00048900
MONTHS ("JANU ","FEBRU ","MARCH ","APRIL ","MAY ", 00049000
"JUNE ","JULY ","AUGUST","SEPTEM","OCTO ", 00049100
"NOVEM ","DECEM "), 00049200
DAYS ("SUN ","MON ","TUES ","WEDNES","THURS ", 00049300
"FRI ","SATUR "), 00049400
TAGS ("ARY "," ","BER "); 00049500
EBCDIC ARRAY SCRATCH [1:135]; 00049600
POINTER PSCRATCH; 00049700
INTEGER M; 00049800
REAL T; 00049900
00050000
REPLACE PSCRATCH := SCRATCH[1] BY " " FOR 135; 00050100
IF B THEN 00050200
WRITE (JOURNAAL ,<"LOGGING/STATISTICS OF Kermit-Bur AT:">) 00050300
ELSE 00050400
WRITE(WARNINGS ,<"WARNING OF Kermit-Bur AT:">); 00050500
T := TIME(7); 00050600
REPLACE PSCRATCH BY 00050700
POINTER(DAYS[T.[5:6]]) FOR 6 UNTIL = " ", % DAY OF WEEK 00050800
"DAY ", 00050900
POINTER(MONTHS[(M := T.[35:6]) - 1 ]) 00051000
FOR 6 UNTIL = " ", % MONTH 00051100
POINTER(TAGS[FIRSTONE(M - 1) DIV 2]) 00051200
FOR 3 UNTIL = " ", 00051300
" ", 00051400
T.[29:6] FOR * DIGITS, % DATE 00051500
", 19", 00051600
T.[47:12] FOR 2 DIGITS; 00051700
IF B THEN 00051800
WRITE(JOURNAAL,135,SCRATCH[*]) 00051900
ELSE 00052000
WRITE(WARNINGS,135,SCRATCH[*]); 00052100
REPLACE PSCRATCH := SCRATCH[1] BY " " FOR 135; 00052200
REPLACE PSCRATCH BY 00052300
"TIME: ", 00052400
T.[23:6] FOR 2 DIGITS,":", % HOUR 00052500
T.[17:6] FOR 2 DIGITS,":", % MINUTE 00052600
T.[11:6] FOR 2 DIGITS; % SECOND 00052700
IF B THEN 00052800
WRITE(JOURNAAL,135,SCRATCH[*]) 00052900
ELSE 00053000
WRITE(WARNINGS,135,SCRATCH[*]) 00053100
END PRINTLOGHEADING; 00053200
00053300
$PAGE 00053400
PROCEDURE GETCANDEPARAM (TYPE); 00053500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00053600
% % 00053700
% GETCANDEPARAM ASSIGNS THE PROPER FILE ATRIBUTES TO THE GLOBALS % 00053800
% ACCORDING TO THE CANDE SPECIFICATIONS. % 00053900
% THS % 00054000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00054100
VALUE 00054200
TYPE ; 00054300
00054400
INTEGER 00054500
TYPE ; 00054600
00054700
BEGIN 00054800
VALUE ARRAY % LAYOUT : 00054900
CANDEPARAM( 00055000
"101072","072008","015000" % TYPE , 00055100
,"103072","072008","015000" % TEXTWIDTH , 00055200
,"108066","000006","014000" % STARTSEQ-1 , 00055300
,"109072","072008","014000" % SEQWIDTH , 00055400
,"114068","000004","014000" % MAXRECSIZE . 00055500
,"115080","082008","015000" 00055600
,"116080","000000","080000" 00055700
,"117072","072008","014000" 00055800
,"118084","000000","084000" 00055900
,"119074","000005","080000" 00056000
,"120072","072008","015000"); 00056100
00056200
ARRAY 00056300
TEMP[0:0] ; 00056400
00056500
POINTER 00056600
TEMPP ; 00056700
00056800
INTEGER 00056900
PLACE ; 00057000
00057100
REPLACE TEMPP := POINTER (TEMP) BY TYPE FOR 3 DIGITS, 00057200
"000"; 00057300
IF PLACE := MASKSEARCH (TEMP[0] , 48"FFFFFF000000" , CANDEPARAM) 00057400
GEQ 0 AND (PLACE MOD 3) EQL 0 THEN 00057500
BEGIN 00057600
TEMPP := POINTER (CANDEPARAM [PLACE]) + 3; 00057700
TEXTWIDTH := INTEGER (TEMPP , 3); TEMPP := * + 3; 00057800
SSEQ := INTEGER (TEMPP , 3); TEMPP := * + 3; 00057900
SEQWIDTH := INTEGER (TEMPP , 3); TEMPP := * + 3; 00058000
RECMAXRECSIZEV := INTEGER (TEMPP , 3) 00058100
END; 00058200
END GETCANDEPARAM ; 00058300
00058400
$PAGE 00058500
BOOLEAN PROCEDURE GETFILEKIND (TAIP) ; 00058600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00058700
% % 00058800
% GETFILEKIND SEARCHES FOR THE PROPER VALUE OF THE FILEKIND % 00058900
% OF STORE. ALSO MYTYPE IS ASSIGNED. % 00059000
% % 00059100
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00059200
ARRAY 00059300
TAIP[*] ; 00059400
00059500
BEGIN 00059600
VALUE ARRAY % LAYOUT : 00059700
TYPES( 00059800
"ALGOL ","064101" % NAME , 00059900
,"PL/I ","068103" % FILEKIND , 00060000
,"COBOL ","065108" % MYTYPE . 00060100
,"FORTRA","066109" 00060200
,"BASIC ","073114" 00060300
,"JOB ","075115" 00060400
,"DATA ","192116" 00060500
,"SEQ ","193117" 00060600
,"CDATA ","197118" 00060700
,"CSEQ ","198119" 00060800
,"PASCAL","081120" 00060900
,"BINARY","192121") ; 00061000
00061100
INTEGER 00061200
TEMP ; 00061300
00061400
POINTER 00061500
PA ; 00061600
00061700
IF TEMP:=MASKSEARCH(TAIP[0],48"FFFFFF000000",TYPES) 00061800
GEQ 0 AND (TEMP MOD 2) EQL 0 THEN 00061900
BEGIN 00062000
PA := POINTER (TYPES[TEMP+1]); 00062100
RECFILEKINDV := INTEGER(PA,3); PA := PA + 3; 00062200
RECTYPE := INTEGER(PA,3); 00062300
GETFILEKIND := TRUE ; 00062400
END 00062500
ELSE GETFILEKIND := FALSE ; 00062600
END GETFILEKIND; 00062700
$PAGE 00062800
PROCEDURE SHOWPROC ; 00062900
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00063000
% % 00063100
% SHOWS THE VALUES OF THE SET - PARAMETERS % 00063200
% THS % 00063300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00063400
BEGIN 00063500
EBCDIC ARRAY 00063600
QUOTEHLP [1:1] ; 00063700
00063800
VALUE ARRAY 00063900
NAMES( 00064000
101,"ALGOL ", 00064100
103,"PL/I ", 00064200
108,"COBOL ", 00064300
109,"FORTRAN ", 00064400
114,"BASIC ", 00064500
115,"JOB ", 00064600
116,"DATA ", 00064700
117,"SEQ ", 00064800
118,"CDATA ", 00064900
119,"CSEQ ", 00065000
120,"PASCAL ", 00065100
121,"BINARY "); 00065200
INTEGER I; 00065300
POINTER PA; 00065400
00065500
BEGIN 00065600
WRITE( FILOUT, <" DELAY = ", J3>, DELAY ); 00065700
IF DEBUG THEN 00065800
WRITE( FILOUT, <" DEBUG IS ON ">) 00065900
ELSE 00066000
WRITE( FILOUT, <" DEBUG IS OFF ">); 00066100
IF EXTENSION THEN 00066102
WRITE( FILOUT, <" EXTENSION IS ON ">) 00066104
ELSE 00066106
WRITE( FILOUT, <" EXTENSION IS OFF ">); 00066108
IF RECDIR THEN 00066110
WRITE( FILOUT, <" RECeive DIRectory IS : ",A*>,LOFSCRATCH,SCRATCH[*]) 00066112
ELSE 00066114
WRITE( FILOUT, <" RECeive DIRectory IS <empty> ">); 00066116
IF SENDDIR THEN 00066118
WRITE( FILOUT, <" SEND DIRectory IS : ",A*>,LOFSENDDIR,DIRIN[*]) 00066120
ELSE 00066122
WRITE( FILOUT, <" SEND DIRectory IS <empty> ">); 00066124
IF BINARY THEN 00066200
BEGIN 00066300
IF STOPBINARY THEN 00066400
BEGIN 00066500
WRITE(FILOUT, <" NO BINARY TRANSPORT POSSIBLE !! ">); 00066600
WRITE(FILOUT, <" THE OTHER KERMIT CAN'T DO IT ">); 00066700
END ELSE 00066800
WRITE(FILOUT, <" BINARY TRANSPORT IS POSSIBLE ">) 00066900
END ELSE 00067000
WRITE(FILOUT, <" NO BINARY TRANSPORT ">); 00067100
I := MASKSEARCH(RECTYPE,REAL(NOT FALSE),NAMES[*]); 00067200
PA := POINTER(NAMES[I + 1]); 00067300
WRITE(FILOUT,<" TYPE OF FILE(S) TO BE RECEIVED IS : ",A16>,PA); 00067400
WRITE(FILOUT[STOP],<" RECORDLENGTH OF FILE(S) TO BE RECEIVED IS : ", 00067500
J3>,RECMAXRECSIZEV); 00067600
IF (RECFILEKINDV = VALUE(DATA)) OR (RECMAXRECSIZEV > 20) THEN 00067700
WRITE(FILOUT,<" CHARACTERS ">) ELSE 00067800
WRITE(FILOUT,<" WORDS ">); 00067900
WRITE( FILOUT, <" TIMEOUT Other Kermit = ",J3>,THEIRTIMEOUT); 00068000
WRITE( FILOUT, <" TIMEOUT Kermit-Bur = ",J3>,MYTIMEOUT); 00068100
WRITE( FILOUT, <" PAKLEN = ", J2>, SENDPACKSIZE ); 00068200
REPLACE QUOTEHLP[1] BY BITSSHIFT( SENDQUOTE ) ; 00068300
TRANSTOEBCDIC( QUOTEHLP, 1, 1 ) ; 00068400
WRITE( FILOUT, <" QUOTE = ", A1>, QUOTEHLP[*] ); 00068500
WRITE( FILOUT, <" PADDING = ", J3>, SENDPAD ); 00068600
WRITE( FILOUT, <" PADCHAR = ", J3>, SENDPADCHAR ); 00068700
WRITE( FILOUT, <" EOL = ", J3>, SENDEOL ); 00068800
WRITE( FILOUT, <" SOP = ", J3>, SENDSOP ); 00068900
END ; 00069000
END SHOWPROC ; 00069100
$PAGE 00069200
PROCEDURE WRITERECORDTOFILE; 00069300
BEGIN 00069400
SEQCOUNT := * + 100 ; 00069500
TRANSTOEBCDIC( RECSTORE, 1, 135 ); 00069600
REPLACE RECSTORE[ SSEQ + 1 ] BY SEQCOUNT 00069700
FOR SEQWIDTH DIGITS ; 00069800
WRITE( FILSTORE, RECMAXRECSIZEV, RECSTORE[*] ); 00069900
REPLACE PSTORE := RECSTORE[1] BY BLANK FOR 135 ; 00070000
IF ( SSEQ EQL 0 ) THEN PSTORE := * + SEQWIDTH ; 00070100
ROOM := MAXRECCHAR ; 00070200
END; 00070300
$PAGE 00070400
PROCEDURE WRITEBINRECORDTOFILE; 00070500
BEGIN 00070600
WRITE(FILSTORE,RECMAXRECSIZEV,BINRECSTORE[*]); 00070700
REPLACE PBINRECSTORE := BINRECSTORE[1] BY NULL FOR RECMAXRECSIZEV; 00070800
ROOM := RECMAXRECSIZEV 00070900
END; 00071000
$PAGE 00071100
PROCEDURE PUTCHARSINSTORE(C); VALUE C; REAL C; 00071200
BEGIN 00071300
INTEGER I; 00071400
IF ROOM = 0 THEN WRITERECORDTOFILE; 00071500
WHILE (ROOM LSS COUNT) DO 00071600
BEGIN 00071700
I := ROOM; 00071800
WHILE I NEQ 0 DO 00071900
BEGIN 00072000
REPLACE PSTORE:PSTORE BY C.[7:48] FOR 1; 00072100
I := * - 1 00072200
END; 00072300
COUNT := * - ROOM; 00072400
WRITERECORDTOFILE 00072500
END; 00072600
I := COUNT; 00072700
WHILE I NEQ 0 DO 00072800
BEGIN 00072900
REPLACE PSTORE:PSTORE BY C.[7:48] FOR 1; 00073000
I := * - 1 00073100
END; 00073200
ROOM := * - COUNT; 00073300
COUNT := 1; 00073400
CRLFSEEN := 0 00073500
END PUTCHARSINSTORE; 00073600
$PAGE 00073700
PROCEDURE PUTBINCHARSINSTORE(C); VALUE C; REAL C; 00073800
BEGIN 00073900
INTEGER I; 00074000
IF CHARBIT8 THEN C := C & 1[7:1]; 00074100
IF ROOM = 0 THEN WRITEBINRECORDTOFILE; 00074200
WHILE (ROOM LSS COUNT) DO 00074300
BEGIN 00074400
I := ROOM; 00074500
WHILE I NEQ 0 DO 00074600
BEGIN 00074700
REPLACE PBINRECSTORE:PBINRECSTORE BY C.[7:48] FOR 1; 00074800
I := * - 1 00074900
END; 00075000
COUNT := * - ROOM; 00075100
WRITEBINRECORDTOFILE 00075200
END; 00075300
I := COUNT; 00075400
WHILE I NEQ 0 DO 00075500
BEGIN 00075600
REPLACE PBINRECSTORE:PBINRECSTORE BY C.[7:48] FOR 1; 00075700
I := * - 1 00075800
END; 00075900
ROOM := * - COUNT; 00076000
COUNT := 1; CHARBIT8 := FALSE 00076100
END PUTBINCHARSINSTORE; 00076200
$PAGE 00076300
BOOLEAN PROCEDURE PUTCHARSINSENDPACKET; 00076400
BEGIN 00076500
BOOLEAN PACKFULL,SPECIALCHAR,CHARISCONTROL,CHARISQUOTE, 00076600
CHARISREPT; 00076700
BEGIN 00076800
CHARISCONTROL := CONTROL(LASTCHAR); 00076900
CHARISQUOTE := (LASTCHAR = SENDQUOTE); 00077000
CHARISREPT := (LASTCHAR = SENDREPT); 00077100
SPECIALCHAR := CHARISCONTROL OR CHARISQUOTE 00077200
OR CHARISREPT; 00077300
IF COUNT LSS 4 THEN 00077400
BEGIN 00077500
IF SPECIALCHAR THEN 00077600
BEGIN 00077700
IF (COUNT * 2 + SENDCOUNT + 1) > SENDPACKSIZE THEN 00077800
PACKFULL := TRUE ELSE 00077900
BEGIN 00078000
WHILE COUNT NEQ 0 DO 00078100
BEGIN 00078200
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE); 00078300
IF CHARISCONTROL THEN 00078400
REPLACE PSEND:PSEND BY CTLSHIFT(LASTCHAR) 00078500
ELSE 00078600
IF CHARISQUOTE THEN 00078700
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE) 00078800
ELSE 00078900
REPLACE PSEND:PSEND BY BITSSHIFT(SENDREPT); 00079000
SENDCOUNT := * + 2; 00079100
COUNT := * - 1 00079200
END; 00079300
END 00079400
END ELSE 00079500
BEGIN 00079600
IF (COUNT + SENDCOUNT +1) > SENDPACKSIZE THEN 00079700
PACKFULL := TRUE ELSE 00079800
BEGIN 00079900
WHILE COUNT NEQ 0 DO 00080000
BEGIN 00080100
REPLACE PSEND:PSEND BY BITSSHIFT(LASTCHAR); 00080200
SENDCOUNT := * + 1; 00080300
COUNT := * - 1 00080400
END; 00080500
END 00080600
END 00080700
END ELSE % COUNT GEQ 4 00080800
BEGIN 00080900
IF SPECIALCHAR THEN 00081000
BEGIN 00081100
IF (SENDCOUNT + 5) > SENDPACKSIZE THEN 00081200
PACKFULL := TRUE ELSE 00081300
BEGIN 00081400
REPLACE PSEND:PSEND BY BITSSHIFT(SENDREPT), 00081500
CHARSHIFT(COUNT),BITSSHIFT(SENDQUOTE); 00081600
IF CHARISCONTROL THEN 00081700
REPLACE PSEND:PSEND BY CTLSHIFT(LASTCHAR) 00081800
ELSE 00081900
IF CHARISQUOTE THEN 00082000
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE) 00082100
ELSE 00082200
REPLACE PSEND:PSEND BY BITSSHIFT(SENDREPT); 00082300
SENDCOUNT := * + 4; 00082400
END 00082500
END ELSE 00082600
BEGIN 00082700
IF (SENDCOUNT + 4) > SENDPACKSIZE THEN 00082800
PACKFULL := TRUE ELSE 00082900
BEGIN 00083000
REPLACE PSEND:PSEND BY BITSSHIFT(SENDREPT), 00083100
CHARSHIFT(COUNT),BITSSHIFT(LASTCHAR); 00083200
SENDCOUNT := * + 3; 00083300
END 00083400
END 00083500
END 00083600
END; 00083700
PUTCHARSINSENDPACKET := PACKFULL 00083800
END PUTCHARSINSENDPACKET; 00083900
$PAGE 00084000
BOOLEAN PROCEDURE PUTBINCHARSINSENDPACKET; 00084100
BEGIN 00084200
BOOLEAN PACKFULL,SPECIALCHAR,CHARISCONTROL,CHARISQUOTE, 00084300
CHARISREPT,CHARIS8BQ; 00084400
REAL CHAR; 00084500
00084600
BEGIN 00084700
CHAR := LASTCHAR; 00084800
IF (CHARBIT8 := CHAR.[7:1] = 1) THEN 00084900
CHAR := CHAR & 0 [7:1]; 00085000
CHARISCONTROL := CONTROL(CHAR); 00085100
CHARISQUOTE := (CHAR = SENDQUOTE); 00085200
CHARISREPT := (CHAR = SENDREPT); 00085300
CHARIS8BQ := (CHAR = SEND8BQ); 00085400
SPECIALCHAR := CHARISCONTROL OR CHARISQUOTE 00085500
OR CHARISREPT 00085600
OR CHARIS8BQ; 00085700
IF COUNT LSS 4 THEN 00085800
BEGIN 00085900
IF SPECIALCHAR THEN 00086000
BEGIN 00086100
IF(COUNT*(2 + BIT8) + SENDCOUNT + 1) > SENDPACKSIZE THEN00086200
PACKFULL := TRUE ELSE00086300
BEGIN 00086400
WHILE COUNT NEQ 0 DO 00086500
BEGIN 00086600
IF CHARBIT8 THEN 00086700
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00086800
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE); 00086900
IF CHARISCONTROL THEN 00087000
REPLACE PSEND:PSEND BY CTLSHIFT(CHAR) 00087100
ELSE 00087200
IF CHARISQUOTE THEN 00087300
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE) 00087400
ELSE 00087500
IF CHARISREPT THEN 00087600
REPLACE PSEND:PSEND BY BITSSHIFT(SENDREPT) 00087700
ELSE 00087800
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00087900
SENDCOUNT := * + 2 + BIT8; 00088000
COUNT := * - 1 00088100
END 00088200
END 00088300
END ELSE 00088400
BEGIN 00088500
IF (COUNT*(1+BIT8) + SENDCOUNT + 1) > SENDPACKSIZE THEN 00088600
PACKFULL := TRUE ELSE 00088700
BEGIN 00088800
WHILE COUNT NEQ 0 DO 00088900
BEGIN 00089000
IF CHARBIT8 THEN 00089100
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00089200
REPLACE PSEND:PSEND BY BITSSHIFT(CHAR); 00089300
SENDCOUNT := * + 1 + BIT8; 00089400
COUNT := * - 1 00089500
END 00089600
END 00089700
END 00089800
END ELSE % COUNT GEQ 4 00089900
BEGIN 00090000
IF SPECIALCHAR THEN 00090100
BEGIN 00090200
IF (SENDCOUNT + 5 + BIT8) > SENDPACKSIZE THEN 00090300
PACKFULL := TRUE ELSE 00090400
BEGIN 00090500
REPLACE PSEND:PSEND BY BITSSHIFT(SENDREPT), 00090600
CHARSHIFT(COUNT); 00090700
IF CHARBIT8 THEN 00090800
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00090900
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE); 00091000
IF CHARISCONTROL THEN 00091100
REPLACE PSEND:PSEND BY CTLSHIFT(CHAR) 00091200
ELSE 00091300
IF CHARISQUOTE THEN 00091400
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE) 00091500
ELSE 00091600
IF CHARISREPT THEN 00091700
REPLACE PSEND:PSEND BY BITSSHIFT(SENDREPT) 00091800
ELSE 00091900
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00092000
SENDCOUNT := * + 4 + BIT8; 00092100
END 00092200
END ELSE 00092300
BEGIN 00092400
IF (SENDCOUNT + 4 + BIT8) > SENDPACKSIZE THEN 00092500
PACKFULL := TRUE ELSE 00092600
BEGIN 00092700
REPLACE PSEND:PSEND BY BITSSHIFT(SENDREPT), 00092800
CHARSHIFT(COUNT); 00092900
IF CHARBIT8 THEN 00093000
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00093100
REPLACE PSEND:PSEND BY BITSSHIFT(CHAR); 00093200
SENDCOUNT := * + 3 + BIT8 00093300
END 00093400
END 00093500
END 00093600
END; 00093700
PUTBINCHARSINSENDPACKET := PACKFULL 00093800
END PUTBINCHARSINSENDPACKET; 00093900
$PAGE 00094000
PROCEDURE STOREBININRECORD; 00094100
BEGIN 00094200
REAL C; 00094300
PRCBUF := RECBUF[1]; NUMCHAR := RECVCOUNT - 3; 00094400
WHILE (NUMCHAR > 0 ) AND (STATE NEQ ABORT) DO 00094500
BEGIN 00094600
IF (ROOM = 0) THEN WRITEBINRECORDTOFILE; 00094700
GETCHAR(C); 00094800
IF QUOTESEEN THEN 00094900
BEGIN 00095000
IF (C EQL MYQUOTE) OR (C EQL MY8BQ) 00095100
THEN PUTBINCHARSINSTORE(C) 00095200
ELSE PUTBINCHARSINSTORE(CTL(C)); 00095300
QUOTESEEN := FALSE 00095400
END ELSE 00095500
IF (C EQL MY8BQ) THEN CHARBIT8 := TRUE 00095600
ELSE 00095700
IF (C EQL MYQUOTE) THEN QUOTESEEN := TRUE 00095800
ELSE 00095900
IF CONTROL(C) THEN 00096000
BEGIN 00096100
STATE := ABORT; 00096200
ERRORHANDLER(NOQUOTE); 00096300
CLOSE(FILSTORE,CRUNCH) 00096400
END ELSE 00096500
PUTBINCHARSINSTORE(C) 00096600
END 00096700
END STOREBININRECORD; 00096800
$PAGE 00096900
PROCEDURE REPSTOREBININRECORD; 00097000
BEGIN 00097100
REAL C; 00097200
PRCBUF := RECBUF[1]; NUMCHAR := RECVCOUNT - 3; 00097300
WHILE (NUMCHAR > 0) AND (STATE NEQ ABORT) DO 00097400
BEGIN 00097500
IF (ROOM = 0) THEN WRITEBINRECORDTOFILE; 00097600
GETCHAR(C); 00097700
IF QUOTESEEN THEN 00097800
BEGIN 00097900
IF (C EQL MYQUOTE) OR (C EQL MY8BQ) OR (C EQL MYREPT) 00098000
THEN PUTBINCHARSINSTORE(C) 00098100
ELSE PUTBINCHARSINSTORE(CTL(C)); 00098200
QUOTESEEN := FALSE 00098300
END ELSE 00098400
IF REPTSEEN THEN 00098500
BEGIN 00098600
COUNT := C - 32; % UNCHAR(C) 00098700
REPTSEEN := FALSE 00098800
END ELSE 00098900
IF (C EQL MYQUOTE) THEN QUOTESEEN := TRUE 00099000
ELSE 00099100
IF (C EQL MY8BQ) THEN CHARBIT8 := TRUE 00099200
ELSE 00099300
IF (C EQL MYREPT) THEN REPTSEEN := TRUE 00099400
ELSE 00099500
IF CONTROL(C) THEN 00099600
BEGIN 00099700
STATE := ABORT; 00099800
ERRORHANDLER(NOQUOTE); 00099900
CLOSE(FILSTORE,CRUNCH) 00100000
END ELSE 00100100
PUTBINCHARSINSTORE(C) 00100200
END 00100300
END REPSTOREBININRECORD; 00100400
$PAGE 00100500
PROCEDURE STOREINRECORD; 00100600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00100700
% PUTS THE DATA FROM RECBUF(DATAFIELD) IN RECSTORE % 00100800
% - RECORD TOO BIG :DIVIDE INCOMING RECORD OVER TWO OR % 00100900
% MORE RECORDS IN FILSTORE % 00101000
% - IF NO QUOTING IS DONE : CLOSE,CRUNCH AND ABORT % 00101100
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00101200
BEGIN 00101300
REAL C; 00101400
LABEL EXCHAR; 00101500
00101600
PRCBUF := RECBUF[1]; NUMCHAR := RECVCOUNT - 3; 00101700
WHILE (NUMCHAR > 0) AND (STATE NEQ ABORT) DO 00101800
BEGIN 00101900
GETCHAR(C); 00102000
00102100
EXCHAR: 00102200
00102300
IF (QUOTESEEN AND CRSEEN) THEN 00102400
BEGIN 00102500
IF (C NEQ ASCJ) THEN 00102600
BEGIN 00102700
PUTCHARSINSTORE(CR); 00102800
CRSEEN := FALSE; 00102900
GO TO EXCHAR 00103000
END 00103100
ELSE 00103200
BEGIN 00103300
CRLFSEEN := * + 1; 00103400
IF (CRLFSEEN = 1) AND (ROOM = MAXRECCHAR) THEN 00103500
ELSE 00103600
WRITERECORDTOFILE; 00103700
QUOTESEEN := CRSEEN := FALSE 00103800
END 00103900
END 00104000
ELSE 00104100
IF QUOTESEEN THEN 00104200
BEGIN 00104300
IF (C EQL ASCM) THEN CRSEEN := TRUE 00104400
ELSE 00104500
IF (C EQL MYQUOTE) THEN PUTCHARSINSTORE(C) 00104600
ELSE PUTCHARSINSTORE(CTL(C)); 00104700
QUOTESEEN := FALSE 00104800
END 00104900
ELSE 00105000
IF CRSEEN THEN 00105100
BEGIN 00105200
IF (C EQL MYQUOTE) THEN QUOTESEEN := TRUE 00105300
ELSE 00105400
BEGIN 00105500
PUTCHARSINSTORE(CR); 00105600
CRSEEN := FALSE; 00105700
GO TO EXCHAR 00105800
END 00105900
END 00106000
ELSE 00106100
IF (C EQL MYQUOTE) THEN 00106200
QUOTESEEN := TRUE ELSE 00106300
BEGIN 00106400
IF CONTROL(C) THEN 00106500
BEGIN 00106600
STATE := ABORT; 00106700
ERRORHANDLER(NOQUOTE); 00106800
CLOSE(FILSTORE,CRUNCH) 00106900
END 00107000
ELSE 00107100
PUTCHARSINSTORE(C) 00107200
END 00107300
END 00107400
END STOREINRECORD; 00107500
$PAGE 00107600
PROCEDURE REPSTOREINRECORD; 00107700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00107800
% PUTS THE DATA(TEXT) FROM RECBUF(DATAFIELD) IN RECSTORE % 00107900
% - RECORD TOO BIG : DIVIDE INCOMING RECORD OVER % 00108000
% MORE RECORDS IN FILSTORE. % 00108100
% - HANDLES REPEATCOUNT % 00108200
% - IF NO QUOTING IS DONE: CLOSE, CRUNCH AND ABORT % 00108300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00108400
BEGIN 00108500
LABEL EXCHAR; 00108600
REAL C; 00108700
00108800
PRCBUF := RECBUF[1]; NUMCHAR := RECVCOUNT - 3; 00108900
WHILE (NUMCHAR > 0) AND (STATE NEQ ABORT) DO 00109000
BEGIN 00109100
GETCHAR(C); 00109200
00109300
EXCHAR: 00109400
00109500
IF (QUOTESEEN AND CRSEEN) THEN 00109600
BEGIN 00109700
IF (C NEQ ASCJ) THEN 00109800
BEGIN 00109900
PUTCHARSINSTORE(CR); 00110000
CRSEEN := FALSE; 00110100
GO TO EXCHAR 00110200
END ELSE 00110300
BEGIN 00110400
CRLFSEEN := * + 1; 00110500
IF (CRLFSEEN = 1) AND (ROOM = MAXRECCHAR) THEN 00110600
ELSE 00110700
WRITERECORDTOFILE; 00110800
QUOTESEEN := CRSEEN := FALSE 00110900
END 00111000
END ELSE 00111100
IF QUOTESEEN THEN 00111200
BEGIN 00111300
IF (C EQL ASCM) THEN CRSEEN := TRUE 00111400
ELSE 00111500
IF ((C EQL MYREPT) OR 00111600
(C EQL MYQUOTE)) THEN PUTCHARSINSTORE(C) 00111700
ELSE PUTCHARSINSTORE(CTL(C)); 00111800
QUOTESEEN := FALSE 00111900
END ELSE 00112000
IF CRSEEN THEN 00112100
BEGIN 00112200
IF (C EQL MYQUOTE) THEN QUOTESEEN := TRUE 00112300
ELSE 00112400
BEGIN 00112500
PUTCHARSINSTORE(CR); 00112600
CRSEEN := FALSE; 00112700
GO TO EXCHAR 00112800
END 00112900
END ELSE 00113000
IF REPTSEEN THEN 00113100
BEGIN 00113200
COUNT := C - 32; % UNCHAR(C) 00113300
REPTSEEN := FALSE 00113400
END ELSE 00113500
IF (C EQL MYREPT) THEN REPTSEEN := TRUE 00113600
ELSE 00113700
IF (C EQL MYQUOTE) THEN QUOTESEEN := TRUE 00113800
ELSE 00113900
BEGIN 00114000
IF CONTROL(C) THEN 00114100
BEGIN 00114200
STATE := ABORT; 00114300
ERRORHANDLER(NOQUOTE); 00114400
CLOSE(FILSTORE,CRUNCH) 00114500
END ELSE 00114600
PUTCHARSINSTORE(C) 00114700
END 00114800
END 00114900
END REPSTOREINRECORD; 00115000
$PAGE 00115100
PROCEDURE READNEXTREC; 00115200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00115300
% % 00115400
% READ NEXT RECORD; IF EOF THEN BEOF := TRUE % 00115500
% THS % 00115600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00115700
00115800
BEGIN 00115900
REPLACE RECBUF[1] BY " " FOR 255 ; 00116000
IF BEOF := READ(FILGET, SENDMAXRECSIZEV, RECBUF[*]) THEN ELSE 00116100
BEGIN 00116200
NUMCHAR := MAXRECCHAR - 1 ; 00116300
PRCBUF := RECBUF[1] ; 00116400
WHILE ((PRCBUF + NUMCHAR) EQL " ") AND 00116500
( NUMCHAR GEQ 0 ) DO 00116600
NUMCHAR := NUMCHAR - 1 ; 00116700
TRANSTOASCII( RECBUF, 1, 255 ) ; 00116800
END; 00116900
EMPTYBUF := FALSE ; 00117000
END READNEXTREC ; 00117100
00117200
$PAGE 00117300
PROCEDURE READNEXTBINRECORD; 00117400
BEGIN 00117500
REPLACE BINRECBUF[1] BY NULL FOR SENDMAXRECSIZEV; 00117600
IF BEOF := READ(FILGET,SENDMAXRECSIZEV,BINRECBUF[*]) THEN ELSE 00117700
BEGIN 00117800
PBINRECBUF := BINRECBUF[1]; 00117900
NUMCHAR := (IF FILGET.UNITS = 0 THEN 6*SENDMAXRECSIZEV 00118000
ELSE SENDMAXRECSIZEV) 00118100
END; 00118200
EMPTYBUF := FALSE 00118300
END READNEXTBINRECORD; 00118400
$PAGE 00118500
BOOLEAN PROCEDURE NOTEOLDONE ; 00118600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00118700
% % 00118800
% TRY TO PUT AN EOL IN THE DATAFIELD OF THE SEND-PACKET % 00118900
% WHEN THIS ISN'T POSSIBLE ( THE PACKET IS FULL ) % 00119000
% THEN DOEOL AND NOTEOLDONE BECOMES TRUE % 00119100
% ELSE THEY BECOME FALSE % 00119200
% THS % 00119300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00119400
00119500
BEGIN 00119600
00119700
REAL FCR , 00119800
FLF ; 00119900
BEGIN 00120000
NOTEOLDONE := FALSE ; 00120100
FCR := CR ; 00120200
FLF := LF ; 00120300
IF ((SENDCOUNT + 5) > SENDPACKSIZE) 00120400
THEN NOTEOLDONE := TRUE 00120500
ELSE BEGIN 00120600
REPLACE PSEND:PSEND BY BITSSHIFT( SENDQUOTE ), 00120700
CTLSHIFT( FCR ), 00120800
BITSSHIFT( SENDQUOTE ), 00120900
CTLSHIFT( FLF ); 00121000
SENDCOUNT := * + 4 ; 00121100
DOEOL := FALSE ; 00121200
END ; 00121300
END; 00121400
END NOTEOLDONE ; 00121500
00121600
$PAGE 00121700
BOOLEAN PROCEDURE PUTINPACKET ; 00121800
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00121900
% % 00122000
% PUTS A RECORD IN THE % 00122100
% DATAFIELD OF THE SEND - PACKET . % 00122200
% % 00122300
% END OF RECORD : - EMPTYBUF AND DOEOL BECOME TRUE % 00122400
% - TRY TO DO AN EOL, WHEN NOT POSSIBLE % 00122500
% PACKFULL BECOMES TRUE AND DOEOL STAYES TRUE. % 00122600
% PUT CHARACTERS IN DATAFIELD UNTIL RECORD IS EMPTY % 00122700
% OR DATAFIELD OF THE PACKET IF FULL . % 00122800
% THS % 00122900
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00123000
00123100
BEGIN 00123200
00123300
REAL C ; 00123400
00123500
BOOLEAN PACKFULL ; 00123600
00123700
BEGIN 00123800
PACKFULL := FALSE ; 00123900
IF DOEOL 00124000
THEN PACKFULL := NOTEOLDONE ; 00124100
WHILE (NOT EMPTYBUF) AND ( NOT PACKFULL ) DO 00124200
BEGIN 00124300
IF NUMCHAR < 0 00124400
THEN DOEOL := EMPTYBUF := TRUE 00124500
ELSE GETCHAR( C ) ; 00124600
IF DOEOL 00124700
THEN PACKFULL := NOTEOLDONE 00124800
ELSE 00124900
IF CONTROL( C ) 00125000
THEN BEGIN 00125100
IF ((SENDCOUNT + 3) > SENDPACKSIZE) 00125200
THEN BEGIN 00125300
PACKFULL := TRUE; 00125400
PRCBUF := * - 1 ; 00125500
NUMCHAR := * + 1 ; 00125600
END 00125700
ELSE BEGIN 00125800
REPLACE PSEND:PSEND BY BITSSHIFT( SENDQUOTE ), 00125900
CTLSHIFT( C ); 00126000
SENDCOUNT := * + 2 00126100
END; 00126200
END 00126300
ELSE 00126400
IF (C = SENDQUOTE ) 00126500
THEN BEGIN 00126600
IF ((SENDCOUNT + 3) > SENDPACKSIZE) 00126700
THEN BEGIN 00126800
PACKFULL := TRUE ; 00126900
PRCBUF := * - 1 ; 00127000
NUMCHAR := * + 1 ; 00127100
END 00127200
ELSE BEGIN 00127300
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE), 00127400
BITSSHIFT(SENDQUOTE) ; 00127500
SENDCOUNT := * + 2 00127600
END ; 00127700
END 00127800
ELSE BEGIN 00127900
IF ((SENDCOUNT + 2) > SENDPACKSIZE) 00128000
THEN BEGIN 00128100
PACKFULL := TRUE ; 00128200
PRCBUF := * - 1 ; 00128300
NUMCHAR := * + 1 ; 00128400
END 00128500
ELSE BEGIN 00128600
REPLACE PSEND:PSEND BY BITSSHIFT( C ); 00128700
SENDCOUNT := * + 1 ; 00128800
END ; 00128900
END ; 00129000
END; 00129100
PUTINPACKET := PACKFULL ; 00129200
END; 00129300
END PUTINPACKET ; 00129400
00129500
$PAGE 00129600
BOOLEAN PROCEDURE REPPUTINPACKET ; 00129700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00129800
% PUTS A RECORD IN THE DATAFIELD OF THE SEND - PACKET. % 00129900
% % 00130000
% END OF RECORD: - EMPTYBUF AND DOEOL BECOME TRUE % 00130100
% - TRY TO DO AN EOL ,WHEN NOT POSSIBLE % 00130200
% PACKFULL BECOMES TRUE AND DOEOL % 00130300
% STAYES TRUE. % 00130400
% PUT CHARACTERS IN DATAFIELD UNTIL RECORD IS EMPTY % 00130500
% OR DATAFIELD OF THE PACKET IS FULL. % 00130600
% DOES FILE-COMPRESSION. % 00130700
% % 00130800
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00130900
00131000
BEGIN 00131100
REAL C; 00131200
BOOLEAN PACKFULL; 00131300
BEGIN 00131400
PACKFULL := FALSE; 00131500
IF WAITWITHEOL THEN IF (PACKFULL := PUTCHARSINSENDPACKET) THEN 00131600
ELSE 00131700
BEGIN 00131800
WAITWITHEOL := FALSE; 00131900
COUNT := 0; LASTCHAR := 0 00132000
END; 00132100
IF DOEOL THEN PACKFULL := NOTEOLDONE; 00132200
WHILE (NOT EMPTYBUF) AND (NOT PACKFULL) DO 00132300
BEGIN 00132400
IF NUMCHAR < 0 THEN 00132500
BEGIN 00132600
IF (PACKFULL := PUTCHARSINSENDPACKET) THEN 00132700
WAITWITHEOL := TRUE ELSE 00132800
BEGIN COUNT := 0; LASTCHAR := 0 END; 00132900
DOEOL := EMPTYBUF := TRUE 00133000
END ELSE GETCHAR(C); 00133100
IF DOEOL THEN IF PACKFULL THEN ELSE PACKFULL:=NOTEOLDONE 00133200
ELSE 00133300
BEGIN 00133400
IF COUNT = 0 THEN 00133500
BEGIN LASTCHAR := C; COUNT := 1 END 00133600
ELSE 00133700
BEGIN 00133800
IF C = LASTCHAR THEN 00133900
BEGIN 00134000
COUNT := * + 1; 00134100
IF COUNT = 94 THEN 00134200
IF (PACKFULL := PUTCHARSINSENDPACKET) THEN 00134300
BEGIN 00134400
PRCBUF := * - 1; 00134500
NUMCHAR := * + 1; 00134600
COUNT := * - 1 00134700
END ELSE 00134800
BEGIN COUNT := 0; LASTCHAR := 0 END 00134900
END ELSE 00135000
BEGIN 00135100
IF (PACKFULL := PUTCHARSINSENDPACKET) THEN 00135200
BEGIN PRCBUF := * - 1; NUMCHAR := * + 1 END 00135300
ELSE 00135400
BEGIN LASTCHAR := C; COUNT := 1 END 00135500
END 00135600
END 00135700
END 00135800
END; 00135900
REPPUTINPACKET := PACKFULL; 00136000
END 00136100
END REPPUTINPACKET; 00136200
$PAGE 00136300
BOOLEAN PROCEDURE PUTBININPACKET; 00136400
BEGIN 00136500
REAL C; 00136600
BOOLEAN PACKFULL; 00136700
BEGIN 00136800
PACKFULL := FALSE; 00136900
WHILE (NOT EMPTYBUF) AND (NOT PACKFULL) DO 00137000
BEGIN 00137100
IF NUMCHAR = 0 THEN EMPTYBUF := TRUE 00137200
ELSE GETBINCHAR(C); 00137300
IF EMPTYBUF THEN ELSE 00137400
BEGIN 00137500
IF (CHARBIT8 := C.[7:1] =1) THEN C := C & 0[7:1]; 00137600
IF CONTROL(C) THEN 00137700
BEGIN 00137800
IF (SENDCOUNT + 3 + BIT8) > SENDPACKSIZE THEN 00137900
BEGIN 00138000
PACKFULL := TRUE; 00138100
PBINRECBUF := * - 1; 00138200
NUMCHAR := * + 1 00138300
END ELSE 00138400
BEGIN 00138500
IF CHARBIT8 THEN 00138600
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00138700
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE), 00138800
CTLSHIFT(C); 00138900
SENDCOUNT := * + 2 + BIT8 00139000
END 00139100
END ELSE 00139200
IF (C= SENDQUOTE) OR (C = SEND8BQ) THEN 00139300
BEGIN 00139400
IF (SENDCOUNT + 3 + BIT8) > SENDPACKSIZE THEN 00139500
BEGIN 00139600
PACKFULL := TRUE; 00139700
PBINRECBUF := * - 1; 00139800
NUMCHAR := * + 1 00139900
END ELSE 00140000
BEGIN 00140100
IF CHARBIT8 THEN 00140200
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00140300
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE); 00140400
IF (C = SENDQUOTE) THEN 00140500
REPLACE PSEND:PSEND BY BITSSHIFT(SENDQUOTE) 00140600
ELSE 00140700
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00140800
SENDCOUNT := * + 2 + BIT8 00140900
END 00141000
END ELSE 00141100
BEGIN 00141200
IF (SENDCOUNT + 2 + BIT8) > SENDPACKSIZE THEN 00141300
BEGIN 00141400
PACKFULL := TRUE; 00141500
PBINRECBUF := * - 1; 00141600
NUMCHAR := * + 1 00141700
END ELSE 00141800
BEGIN 00141900
IF CHARBIT8 THEN 00142000
REPLACE PSEND:PSEND BY BITSSHIFT(SEND8BQ); 00142100
REPLACE PSEND:PSEND BY BITSSHIFT(C); 00142200
SENDCOUNT := * + 1 + BIT8 00142300
END 00142400
END 00142500
END 00142600
END; 00142700
PUTBININPACKET := PACKFULL; 00142800
END 00142900
END PUTBININPACKET; 00143000
$PAGE 00143100
BOOLEAN PROCEDURE REPPUTBININPACKET; 00143200
BEGIN 00143300
REAL C; 00143400
BOOLEAN PACKFULL; 00143500
BEGIN 00143600
PACKFULL := FALSE; 00143700
WHILE (NOT EMPTYBUF) AND (NOT PACKFULL) DO 00143800
BEGIN 00143900
IF NUMCHAR = 0 THEN EMPTYBUF := TRUE 00144000
ELSE GETBINCHAR(C); 00144100
IF EMPTYBUF THEN ELSE 00144200
BEGIN 00144300
IF COUNT = 0 THEN 00144400
BEGIN LASTCHAR := C;COUNT := 1 END 00144500
ELSE 00144600
BEGIN 00144700
IF C = LASTCHAR THEN 00144800
BEGIN 00144900
COUNT := * + 1; 00145000
IF COUNT = 94 THEN 00145100
IF (PACKFULL := PUTBINCHARSINSENDPACKET) THEN00145200
BEGIN 00145300
PBINRECBUF := * - 1; 00145400
NUMCHAR := * + 1; 00145500
COUNT := * - 1 00145600
END ELSE00145700
BEGIN LASTCHAR := 0;COUNT := 0 END 00145800
END ELSE 00145900
BEGIN 00146000
IF (PACKFULL := PUTBINCHARSINSENDPACKET) THEN 00146100
BEGIN 00146200
PBINRECBUF := * - 1; 00146300
NUMCHAR := * + 1 00146400
END ELSE 00146500
BEGIN LASTCHAR := C; COUNT := 1 END 00146600
END 00146700
END 00146800
END 00146900
END; 00147000
REPPUTBININPACKET := PACKFULL; 00147100
END 00147200
END REPPUTBININPACKET; 00147300
$PAGE 00147400
PROCEDURE BUILDPACKET; 00147500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00147600
% % 00147700
% BUILDS THE PACKETS AND CALCULATES THE CHECKSUM FOR % 00147800
% THE SEND - PROCEDURE . % 00147900
% THS % 00148000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00148100
BEGIN 00148200
00148300
VALUE ARRAY % LAYOUT 00148400
FILEKINDNAME( % FILEKIND, 00148500
% . FIRST 3 LETTERS OF 00148600
% FILEKIND IN ASCII-CODE 00148700
64,48"2E414C472020", % .ALG 00148800
68,48"2E504C492020", % .PLI 00148900
65,48"2E434F422020", % .COB 00149000
66,48"2E464F522020", % .FOR 00149100
73,48"2E4241532020", % .BAS 00149200
75,48"2E4A4F422020", % .JOB 00149300
81,48"2E5041532020", % .PAS 00149400
192,48"2E4441542020", % .DAT 00149500
193,48"2E5345512020", % .SEQ 00149600
197,48"2E4344412020", % .CDA 00149700
198,48"2E4353452020"); % .CSE 00149800
00149900
EBCDIC ARRAY 00150000
HULP [1:92]; 00150100
00150200
POINTER PHULP , 00150300
PLASTID , % POINTS TO LAST IDENTIFIER 00150400
PLASTIDBO ; % POINTS TO LAST IDENTIFIER BUT ONE 00150500
00150600
BOOLEAN FULLPACKET , 00150700
OK ; 00150800
00150900
INTEGER K, J ,I , 00151000
NOI , % NUMBER OF IDENTIFIERS IN FILEID. 00151100
LOLASTID , % LENGTH OF LAST IDENTIFIER 00151200
LOLASTIDBO ; % LENGTH OF LAST IDENTIFIER BUT ONE 00151300
00151400
TRUTHSET ASCSBD ( SLASH OR BLANK OR ASCDOT ) , 00151500
BLANKORDOT ( BLANK OR ASCDOT ) ; 00151600
BEGIN 00151700
IF DEBUG THEN 00151800
WRITE( JOURNAAL[SPACE 2], <"********* BUILDING"> ); 00151900
PSEND := SENDPACKET[1] ; 00152000
CASE STATE OF 00152100
BEGIN 00152200
INIT : 00152300
BEGIN 00152400
SEQNUM := SENDSEQ := 0 ; 00152500
SENDPTYPE := SINIT ; 00152600
SENDCOUNT := NUMPARAM + 3; 00152700
REPLACE PSEND:PSEND BY BITSSHIFT( SENDSOP ) , 00152800
CHARSHIFT( SENDCOUNT ) , 00152900
CHARSHIFT( SENDSEQ ) , 00153000
BITSSHIFT( SENDPTYPE ) , 00153100
CHARSHIFT( RECVPACKSIZE ) , 00153200
CHARSHIFT( THEIRTIMEOUT ) , 00153300
CHARSHIFT( MYPAD ) , 00153400
CTLSHIFT( MYPADCHAR ) , 00153500
CHARSHIFT( MYEOL ) , 00153600
BITSSHIFT( MYQUOTE ) , 00153700
BITSSHIFT( MY8BQ ) , 00153800
BITSSHIFT( CHECKTYPE ) , 00153900
BITSSHIFT( MYREPT ) ; 00154000
END ; 00154100
00154200
% GET THE NEXT FILENAME AND MAKE IT ACCEPTABLE 00154300
FILEHEADER : 00154400
BEGIN 00154500
SENDPTYPE := FILEHEAD; 00154600
SENDCOUNT := 2; 00154700
PSEND := * + 2; 00154800
REPLACE SENDPACKET[1] BY BITSSHIFT( SENDSOP ); 00154900
REPLACE PSEND:PSEND BY CHARSHIFT( SENDSEQ ), 00155000
BITSSHIFT( SENDPTYPE ); 00155100
00155200
REPLACE PHULP:=HULP[1] BY " " FOR 92 ; 00155300
REPLACE PHULP:=HULP[1] BY FILGET.TITLE ; 00155400
TRANSTOASCII( HULP, 1, 92 ); 00155500
SCAN PHULP:PHULP FOR K:92 UNTIL= ASCRP ; 00155600
IF ( K EQL 0 ) THEN BEGIN 00155700
K := 93 ; 00155800
PHULP := HULP[1] ; 00155900
END 00156000
ELSE PHULP := * + 1 ; 00156100
OK := FALSE ;NOI := 1 ;PLASTIDBO := PHULP; 00156200
WHILE ( NOT OK ) DO % SEARCH LAST IDENTIFIER 00156300
% OF FILEIDENTIFIER 00156400
BEGIN 00156500
J := K - 1; PLASTID := PHULP; 00156600
SCAN PHULP:PHULP FOR K:J UNTIL IN ASCSBD ; 00156700
IF NOI = 1 THEN LOLASTIDBO := J - K 00156800
ELSE LOLASTID := J - K; 00156900
IF (REAL( PHULP, 1 ) IN BLANKORDOT ) 00157000
THEN OK := TRUE 00157100
ELSE BEGIN 00157200
PHULP := * + 1; 00157300
NOI := * + 1; 00157400
IF NOI = 2 00157500
THEN ELSE 00157600
BEGIN PLASTIDBO := PLASTID ; 00157700
LOLASTIDBO:= LOLASTID 00157800
END 00157900
END 00158000
END ; 00158100
IF EXTENSION THEN 00158200
BEGIN 00158300
IF NOI = 1 THEN 00158400
BEGIN 00158500
REPLACE PSEND:PSEND BY 00158600
PLASTIDBO FOR LOLASTIDBO; 00158700
SENDCOUNT := * + LOLASTIDBO 00158800
END ELSE 00158900
BEGIN 00159000
REPLACE PSEND:PSEND BY 00159100
PLASTID FOR LOLASTID; 00159200
SENDCOUNT := * + LOLASTID 00159300
END ; 00159400
I := MASKSEARCH(SENDFILEKINDV,REAL(NOT FALSE), 00159500
FILEKINDNAME[*]); 00159600
PHULP := POINTER(FILEKINDNAME[I + 1]); 00159700
REPLACE PSEND:PSEND BY PHULP FOR 4; 00159800
SENDCOUNT := * + 4 00159900
END ELSE 00160000
BEGIN 00160100
REPLACE PSEND:PSEND BY PLASTIDBO FOR LOLASTIDBO; 00160200
SENDCOUNT := * + LOLASTIDBO; 00160300
IF NOI GEQ 2 THEN 00160400
BEGIN 00160500
REPLACE PSEND:PSEND BY 48"2E" FOR 1; % . 00160600
SENDCOUNT := * + 1; 00160700
IF LOLASTID GEQ 3 THEN 00160800
BEGIN 00160900
REPLACE PSEND:PSEND BY PLASTID FOR 3 ; 00161000
SENDCOUNT := * + 3 00161100
END ELSE 00161200
BEGIN 00161300
REPLACE PSEND:PSEND BY 00161400
PLASTID FOR LOLASTID; 00161500
SENDCOUNT := * + LOLASTID 00161600
END 00161700
END; 00161800
END; 00161900
SENDCOUNT := * + 1; 00162000
REPLACE SENDPACKET[2] BY CHARSHIFT( SENDCOUNT ); 00162100
EMPTYBUF := TRUE ; 00162200
BEOF := FALSE ; 00162300
END; 00162400
00162500
% BUILD THE DATA-PACKETS UNTIL EOF 00162600
FILEDATA : 00162700
BEGIN 00162800
FULLPACKET := FALSE ; 00162900
SENDPTYPE := DATA ; 00163000
SENDCOUNT := 2 ; 00163100
PSEND := * + 2 ; 00163200
REPLACE SENDPACKET[1] BY BITSSHIFT( SENDSOP ); 00163300
REPLACE PSEND:PSEND BY CHARSHIFT( SENDSEQ ), 00163400
BITSSHIFT( SENDPTYPE ); 00163500
IF BINARY THEN 00163600
BEGIN 00163700
IF EMPTYBUF THEN READNEXTBINRECORD; 00163800
WHILE ((NOT BEOF) AND (NOT FULLPACKET)) DO 00163900
BEGIN 00164000
FULLPACKET := IF REPEAT THEN REPPUTBININPACKET 00164100
ELSE PUTBININPACKET; 00164200
IF EMPTYBUF THEN READNEXTBINRECORD 00164300
END ; 00164400
IF BEOF THEN 00164500
BEGIN 00164600
IF FULLPACKET THEN ELSE 00164700
IF ( REPEAT AND (COUNT NEQ 0)) THEN 00164800
IF FULLPACKET :=PUTBINCHARSINSENDPACKET 00164900
THEN ELSE COUNT :=0 00165000
END 00165100
END ELSE 00165200
BEGIN 00165300
IF EMPTYBUF 00165400
THEN READNEXTREC ; 00165500
WHILE ((NOT BEOF) AND (NOT FULLPACKET)) DO 00165600
BEGIN 00165700
FULLPACKET := IF REPEAT THEN REPPUTINPACKET 00165800
ELSE PUTINPACKET; 00165900
IF EMPTYBUF 00166000
THEN READNEXTREC ; 00166100
END ; 00166200
IF BEOF THEN 00166300
BEGIN 00166400
IF FULLPACKET THEN ELSE 00166500
BEGIN 00166600
EMPTYBUF := TRUE; 00166700
IF REPEAT THEN REPPUTINPACKET 00166800
ELSE PUTINPACKET 00166900
END 00167000
END 00167100
END; 00167200
SENDCOUNT := * + 1 ; 00167300
REPLACE SENDPACKET[2] BY CHARSHIFT( SENDCOUNT ); 00167400
END ; 00167500
00167600
EOFFILE : 00167700
BEGIN 00167800
SENDPTYPE := EOF ; 00167900
SENDCOUNT := 3; 00168000
REPLACE PSEND:PSEND BY BITSSHIFT( SENDSOP ), 00168100
CHARSHIFT( SENDCOUNT ), 00168200
CHARSHIFT( SENDSEQ ), 00168300
BITSSHIFT( SENDPTYPE ); 00168400
END; 00168500
00168600
BREAK : 00168700
BEGIN 00168800
SENDPTYPE := BRK ; 00168900
SENDCOUNT := 3; 00169000
REPLACE PSEND:PSEND BY BITSSHIFT( SENDSOP ), 00169100
CHARSHIFT( SENDCOUNT ), 00169200
CHARSHIFT( SENDSEQ ), 00169300
BITSSHIFT( SENDPTYPE ); 00169400
END; 00169500
END CASE ; 00169600
CALCSUM ( SENDPACKET, SENDCOUNT ); 00169700
REPLACE PSEND:PSEND BY CHARSHIFT( CHECK ); 00169800
END; 00169900
END BUILDPACKET ; 00170000
00170100
$PAGE 00170200
PROCEDURE RESENDPACKET ; 00170300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00170400
% % 00170500
% RESENDS THE PACKET BECAUSE OF BAD TRANSMISSION % 00170600
% THS % 00170700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00170800
00170900
BEGIN 00171000
NUMSENDPACK := * + 1; 00171100
IF ( SENDPAD NEQ 0 ) THEN 00171200
WRITE ( FILOUT[ STOP ], SENDPAD , PADARR[*] ); 00171300
WRITE( FILOUT[STOP], OLDCOUNT, OLDPACKET[*] ) ; 00171400
IF DEBUG THEN 00171500
WRITE(JOURNAAL[SPACE 2 ], <"RESEND **"> ); 00171600
END RESENDPACKET ; 00171700
00171800
$PAGE 00171900
PROCEDURE TRANSMITPACKET ; 00172000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00172100
% % 00172200
% TRANSMISSION OF A PACKET % 00172300
% AND IF NECESSARY GIVES PADDING % 00172400
% THS % 00172500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00172600
BEGIN 00172700
REPLACE POLD:=OLDPACKET[1] BY NULL FOR 97 ; 00172800
REPLACE PSEND:PSEND BY BITSSHIFT( SENDEOL ); 00172900
TRANSTOEBCDIC( SENDPACKET, 1, SENDCOUNT + 3 ) ; 00173000
NUMSENDPACK := * + 1; 00173100
IF ( SENDPAD NEQ 0 ) THEN 00173200
WRITE ( FILOUT[ STOP ], SENDPAD, PADARR[*] ) ; 00173300
WRITE( FILOUT[STOP], SENDCOUNT + 3, SENDPACKET[*] ) ; 00173400
REPLACE POLD:=OLDPACKET[1] BY PSEND:=SENDPACKET[1] FOR 97 ; 00173500
OLDCOUNT := SENDCOUNT + 3 ; 00173600
IF DEBUG THEN 00173700
BEGIN 00173800
PACKETTYPE := REAL( SENDPACKET[ 4 ],1 ); 00173900
REPLACE SENDPACKET[1] BY SENDPACKET[1] FOR 97 WITH HPR ; 00174000
WRITE(JOURNAAL[SPACE 2], < X8, "*", X2, A1, X3, A97 >, 00174100
PACKETTYPE, SENDPACKET[*] ); 00174200
END; 00174300
REPLACE PSEND:= SENDPACKET[1] BY NULL FOR 97 ; 00174400
END TRANSMITPACKET; 00174500
$PAGE 00174600
PROCEDURE SENDANSWER ( SEQ, TYPE ); 00174700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00174800
% % 00174900
% SENDS AN ACK ON A GOOD ARRIVAL OF A PACKET % 00175000
% SENDS A NAK ON A BAD ARRIVAL OF A PACKET % 00175100
% THS % 00175200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00175300
00175400
INTEGER 00175500
SEQ ; 00175600
00175700
REAL 00175800
TYPE ; 00175900
00176000
BEGIN 00176100
IF ( TYPE EQL NAK ) THEN NUMNAK := * + 1 00176200
ELSE NUMACK := * + 1 ; 00176300
PSEND := SENDPACKET[1] ; 00176400
SENDCOUNT := 3 ; 00176500
REPLACE PSEND:PSEND BY BITSSHIFT( SENDSOP ), 00176600
CHARSHIFT( SENDCOUNT ), 00176700
CHARSHIFT( SEQ ), 00176800
BITSSHIFT( TYPE ); 00176900
CALCSUM ( SENDPACKET, SENDCOUNT ); 00177000
REPLACE PSEND:PSEND BY CHARSHIFT( CHECK ); 00177100
TRANSMITPACKET ; 00177200
00177300
END SENDANSWER ; 00177400
00177500
$PAGE 00177600
PROCEDURE SENDERROR( SEQ, ERRSERVER ) ; 00177700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00177800
% % 00177900
% SEND AN ERROR - PACKET BECAUSE AN ERROR % 00178000
% OCCURED WHILE IN SERVER MODE . % 00178100
% THS % 00178200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00178300
INTEGER 00178400
SEQ , 00178500
ERRSERVER ; 00178600
00178700
BEGIN 00178800
SENDPTYPE := ERROR ; 00178900
PSEND := SENDPACKET[ 3 ] ; 00179000
SENDCOUNT := 3 ; 00179100
REPLACE SENDPACKET[ 1 ] BY BITSSHIFT( SENDSOP ); 00179200
REPLACE PSEND:PSEND BY CHARSHIFT( SEQ ), 00179300
BITSSHIFT( SENDPTYPE ) ; 00179400
ERRORHANDLER( ERRSERVER ); 00179500
REPLACE PSEND:PSEND BY RECBUF[ 1 ] FOR 30 ; 00179600
SENDCOUNT := * + 30 ; 00179700
REPLACE SENDPACKET[ 2 ] BY CHARSHIFT( SENDCOUNT ) ; 00179800
CALCSUM( SENDPACKET, SENDCOUNT ) ; 00179900
REPLACE PSEND:PSEND BY CHARSHIFT( CHECK ) ; 00180000
TRANSMITPACKET ; 00180100
END SENDERROR ; 00180200
00180300
00180400
$PAGE 00180500
BOOLEAN PROCEDURE RECEIVEPACKET; 00180600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00180700
% % 00180800
% THIS PROCEDURE CHECKS IF A PACKET HAS A GOOD ARRIVAL % 00180900
% IT GIVES AN ERRORMESSAGE BY THE FOLOWING ERRORS : % 00181000
% - TIMEOUT , % 00181100
% - ERROR DURING THE READACTION , % 00181200
% - WRONG START OF PACKET , % 00181300
% - WRONG CHECKSUM . % 00181400
% WHEN IT HAS A GOOD ARRIVAL IT PUTS THE DATAFIELD IN % 00181500
% ARRAY RECBUF . % 00181600
% THS % 00181700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00181800
00181900
BEGIN 00182000
BOOLEAN 00182100
EC ; 00182200
% 00182300
BEGIN 00182400
RECEIVEPACKET := FALSE ; 00182500
REPLACE RECVPACKET[1] BY " " FOR 96; 00182600
PRECV := RECVPACKET[1] ; 00182700
IF SERVERMODE THEN 00182800
EC := READ(FILIN[TIMELIMIT 60],96,RECVPACKET[*]) 00182900
ELSE 00183000
EC := READ(FILIN[TIMELIMIT MYTIMEOUT],96,RECVPACKET[*]); 00183100
IF EC THEN 00183200
BEGIN 00183300
IF EC.[15:1] 00183400
THEN IF SERVERMODE THEN SENDANSWER(SEQNUM,NAK) 00183500
ELSE ERRORHANDLER (READTIMEOUT) 00183600
ELSE 00183700
ERRORHANDLER (READERROR) 00183800
END 00183900
ELSE 00184000
% THROW AWAY THE LEADING PACKETS AND TAKE ONLY 00184100
% THE LAST PACKET WHICH IS THE ONE YOU WANT . 00184200
BEGIN 00184300
IF FILIN.CENSUS = 0 THEN 00184400
ELSE 00184450
BEGIN 00184475
THRU (FILIN.CENSUS - 1) DO READ( FILIN ); %SKIP 00184500
EC := READ(FILIN,96,RECVPACKET[*]); 00184600
END; 00184650
IF EC THEN ERRORHANDLER(READERROR) 00184675
ELSE 00184700
BEGIN 00184900
PACKETTYPE := REAL( RECVPACKET[ 4 ], 1 ); 00185000
IF DEBUG THEN 00185100
WRITE(JOURNAAL[SPACE 2], <"RECEIVE *", X2, A1, X3, A96>, 00185200
PACKETTYPE, RECVPACKET[*] ); 00185300
TRANSTOASCII( RECVPACKET, 1, 96 ); 00185400
NUMRECVPACK := * + 1; 00185500
IF (MYSOP = REAL( RECVPACKET[1],1 )) 00185600
THEN BEGIN 00185700
RECVCOUNT := UNCHAR( RECVPACKET[2] ); 00185800
RECVPTYPE := REAL( RECVPACKET[4], 1 ); 00185900
RECVCHECK := UNCHAR(RECVPACKET[RECVCOUNT + 2]); 00186000
CALCSUM( RECVPACKET, RECVCOUNT ); 00186100
IF CHECK = RECVCHECK 00186200
THEN BEGIN 00186300
RECEIVEPACKET := TRUE; 00186400
RECVSEQ := UNCHAR( RECVPACKET[3] ) ; 00186500
LEN := RECVCOUNT -3 ; 00186600
REPLACE RECBUF[1] BY RECVPACKET[5] FOR LEN; 00186700
END 00186800
ELSE BEGIN 00186900
ERRORHANDLER (TRANSMITERR); 00187000
NUMBADRECV := * + 1; 00187100
END 00187200
END 00187300
ELSE BEGIN 00187400
ERRORHANDLER (SOPWRONG); 00187500
NUMBADRECV := * + 1 ; 00187600
END ; 00187700
END; 00187800
END; 00187900
END; 00188000
END RECEIVEPACKET; 00188100
00188200
$PAGE 00188300
PROCEDURE ENCODEPARM; 00188400
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00188500
% % 00188600
% BUILD A RECEIVE-INIT PACKET % 00188700
% THS % 00188800
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00188900
00189000
BEGIN REPLACE SENDPACKET[1] BY NULL FOR 96; 00189100
PSEND := SENDPACKET[1] ; 00189200
SENDCOUNT := NUMPARAM + 3 ; 00189300
REPLACE PSEND:PSEND BY BITSSHIFT( SENDSOP ) , 00189400
CHARSHIFT( SENDCOUNT ) , 00189500
CHARSHIFT( SENDSEQ ) , 00189600
BITSSHIFT( SENDPTYPE ) , 00189700
CHARSHIFT( RECVPACKSIZE ) , 00189800
CHARSHIFT( THEIRTIMEOUT ) , 00189900
CHARSHIFT( MYPAD ) , 00190000
CTLSHIFT( MYPADCHAR ) , 00190100
CHARSHIFT( MYEOL ) , 00190200
BITSSHIFT( MYQUOTE ) , 00190300
BITSSHIFT( MY8BQ ) , 00190400
BITSSHIFT( CHECKTYPE ) , 00190500
BITSSHIFT( MYREPT ) ; 00190600
CALCSUM( SENDPACKET, SENDCOUNT ) ; 00190700
REPLACE PSEND:PSEND BY CHARSHIFT( CHECK ); 00190800
END ENCODEPARM ; 00190900
00191000
$PAGE 00191100
PROCEDURE DECODEPARM; 00191200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00191300
% % 00191400
% DECODE THE PARAMETERS FROM THE RECEIVE-INIT PACKET % 00191500
% THS % 00191600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00191700
BEGIN 00191800
IF (RECVCOUNT < 3 ) 00191900
THEN BEGIN 00192000
ERRORHANDLER( CANTRECVINIT ); 00192100
STATE := ABORT ; 00192200
END 00192300
ELSE 00192400
BEGIN 00192500
IF ( RECVCOUNT > 3 ) 00192600
THEN IF (SENDPACKSIZE := UNCHAR( RECBUF[1]) EQL BLANK) 00192700
THEN SENDPACKSIZE := MAXPACK ; 00192800
IF ( RECVCOUNT > 4 ) 00192900
THEN IF (MYTIMEOUT := UNCHAR( RECBUF[2]) NEQ BLANK) 00193000
THEN MYTIMEOUT := * + 5 00193100
ELSE MYTIMEOUT := DEFTIMEOUT; 00193200
IF ( RECVCOUNT > 5 ) 00193300
THEN IF (SENDPAD := UNCHAR( RECBUF[3]) NEQ BLANK) 00193400
THEN SENDPADCHAR := CTL(REAL( RECBUF[4],1 )) 00193500
ELSE SENDPAD := DEFPAD; 00193600
IF ( RECVCOUNT > 7 ) 00193700
THEN IF (SENDEOL := UNCHAR( RECBUF[5]) EQL BLANK) 00193800
THEN SENDEOL := DEFEOL ; 00193900
IF ( RECVCOUNT > 8 ) 00194000
THEN IF (SENDQUOTE := REAL( RECBUF[6], 1 ) EQL BLANK) 00194100
THEN SENDQUOTE := DEFQUOTE ; 00194200
IF BINARY THEN 00194300
IF (RECVCOUNT > 9 ) THEN 00194400
BEGIN 00194500
SEND8BQ := REAL( RECBUF[7], 1 ); 00194600
IF RECEIVEMODE THEN 00194700
BEGIN 00194800
IF (SEND8BQ EQL NAK) OR (SEND8BQ EQL BLANK) THEN 00194900
BEGIN 00195000
STOPBINARY := TRUE; 00195100
MY8BQ := NAK 00195200
END ELSE 00195300
BEGIN 00195400
IF (SEND8BQ EQL ACK) THEN 00195500
SEND8BQ := MY8BQ 00195600
ELSE 00195700
BEGIN 00195800
IF (SEND8BQ EQL MYQUOTE) OR 00195900
(SEND8BQ EQL MYREPT) THEN 00196000
BEGIN 00196100
STOPBINARY := TRUE; 00196200
MY8BQ := NAK 00196300
END ELSE 00196400
MY8BQ := SEND8BQ 00196500
END 00196600
END 00196700
END ELSE 00196800
IF (SEND8BQ EQL ACK) OR (SEND8BQ EQL MY8BQ) THEN ELSE 00196900
STOPBINARY := TRUE 00197000
END ELSE 00197100
BEGIN 00197200
STOPBINARY := TRUE; 00197300
MY8BQ := NAK 00197400
END; 00197500
IF ( RECVCOUNT > 11 ) THEN 00197600
BEGIN 00197700
SENDREPT := REAL( RECBUF[9], 1 ); 00197800
IF RECEIVEMODE THEN 00197900
BEGIN 00198000
IF (SENDREPT EQL BLANK) THEN 00198100
BEGIN 00198200
REPEAT := FALSE; 00198300
MYREPT := BLANK 00198400
END ELSE 00198500
BEGIN 00198600
IF (SENDREPT EQL MYQUOTE) OR (SENDREPT EQL MY8BQ) THEN 00198700
BEGIN 00198800
REPEAT := FALSE; 00198900
MYREPT := BLANK 00199000
END ELSE 00199100
BEGIN 00199200
REPEAT := TRUE; 00199300
MYREPT := SENDREPT 00199400
END 00199500
END 00199600
END ELSE 00199700
BEGIN 00199800
IF (SENDREPT EQL MYREPT) THEN REPEAT := TRUE 00199900
ELSE REPEAT := FALSE 00200000
END 00200100
END ELSE 00200200
BEGIN 00200300
REPEAT := FALSE; 00200400
MYREPT := BLANK 00200500
END; 00200600
IF DEBUG THEN 00200700
BEGIN 00200800
WRITE( JOURNAAL[ SPACE 2 ], <"PACKSIZE= ", I2, X3, "TIMEOUT= ", 00200900
I2, X3, "PADDING= ", I2, X3, "PADCHAR= ", H2, X3, 00201000
"EOL= ", H2, X3, "QUOTE= ", H2 >, SENDPACKSIZE, 00201100
MYTIMEOUT, SENDPAD, SENDPADCHAR, SENDEOL, SENDQUOTE); 00201200
WRITE(JOURNAAL,<X43,"|_________in__ascii-code________|">); 00201300
END 00201400
END; 00201500
END DECODEPARM ; 00201600
00201700
$PAGE 00201800
PROCEDURE FILEHANDLER; 00201900
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00202000
% % 00202100
% TRIES TO GET THE NEXT FILE. % 00202200
% IF IT SUCCEEDS SEVERAL FILE-ATTRIBUTES AND GLOBAL VARIABLES % 00202300
% ARE SET. % 00202400
% IF THE FILE DOESN'T EXIST THEN STATE := ABORT. % 00202500
% IF END OF DIRECTORY IS ENCOUNTERED THEN STATE := BREAK. % 00202600
% % 00202700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00202800
BEGIN 00202900
ARRAY TEMP[0:15]; 00203000
POINTER PTEMP; 00203100
BOOLEAN B; 00203200
REAL X; 00203300
LABEL EXIT; 00203400
00203500
BEGIN 00203600
PTEMP := POINTER(TEMP); 00203700
IF NOT(B := GETTITLE(DIRTITEL))THEN 00203800
BEGIN 00203900
IF SKIPFIRSTFILE THEN 00204000
BEGIN 00204100
SKIPFIRSTFILE := FALSE; 00204200
GO TO EXIT 00204300
END; 00204400
PDIRTITEL := DIRTITEL[TSV]; 00204500
IF DIRREQUESTRESULT.[9:1] THEN %OTHER DIRECTORY 00204600
BEGIN 00204700
X := DIRTITEL[13]; %SECURITY 00204800
IF X.[19:20] = 0 AND %PUBLIC? 00204900
(X.[39:20] = 1 OR %IN? 00205000
X.[39:20] = 0)THEN %IO? 00205100
ELSE 00205200
BEGIN 00205300
NUMTRY := 0; 00205400
IF SERVERMODE THEN SENDERROR(RECVSEQ,NOFILE) 00205500
ELSE ERRORHANDLER(NOFILE); 00205600
GO TO EXIT 00205700
END 00205800
END; 00205900
IF NOT SERVERMODE THEN 00206000
IF FIRSTFILETOSEND THEN WRITE(FILOUT,<"Proceed ">); 00206100
REPLACE PTEMP BY PDIRTITEL WHILE IN TIETEL,"."; 00206200
REPLACE FILGET.TITLE BY PTEMP; 00206300
SCAN PDIRTITEL:PDIRTITEL WHILE IN TIETELNOSPACE; 00206400
DEBLANK(PDIRTITEL); 00206500
IF PDIRTITEL EQL "ON" THEN 00206600
BEGIN 00206700
FILGET.KIND := VALUE(PACK); 00206800
PDIRTITEL := * + 2; 00206900
DEBLANK(PDIRTITEL); 00207000
REPLACE PTEMP BY PDIRTITEL WHILE IN ALPHA,"."; 00207100
REPLACE FILGET.PACKNAME BY PTEMP; 00207200
END; 00207300
FILGET.FILETYPE := 7 ; 00207400
FILGET.MYUSE := VALUE( IN ) ; 00207500
FILGET.OPEN := TRUE ; 00207600
SENDMAXRECSIZEV := FILGET.MAXRECSIZE ; 00207700
SENDFILEKINDV := FILGET.FILEKIND ; 00207800
IF BINARY THEN 00207900
BEGIN 00208000
IF (SENDFILEKINDV NEQ VALUE(DATA)) THEN 00208100
BEGIN 00208200
STATE := ABORT; 00208300
IF SERVERMODE THEN SENDERROR(RECVSEQ,BINFAULT) 00208400
ELSE ERRORHANDLER(BINFAULT); 00208500
GO TO EXIT 00208600
END; 00208700
IF FILGET.UNITS = 0 THEN 00208800
IF (SENDMAXRECSIZEV * 6) > 512 THEN 00208900
RESIZE(BINRECBUF[*],SENDMAXRECSIZEV * 6) 00209000
ELSE 00209100
ELSE 00209200
IF SENDMAXRECSIZEV > 512 THEN 00209300
RESIZE(BINRECBUF[*],SENDMAXRECSIZEV); 00209400
END ELSE 00209500
CASE SENDFILEKINDV OF 00209600
BEGIN 00209700
VALUE(COBOLSYMBOL): MAXRECCHAR := 66 ; 00209800
VALUE(BASICSYMBOL): MAXRECCHAR := 68 ; 00209900
VALUE(JOBSYMBOL) : MAXRECCHAR := 80 ; 00210000
VALUE(CSEQDATA) : MAXRECCHAR := 74 ; 00210100
VALUE(DATA) : BEGIN 00210200
MAXRECCHAR := IF FILGET.UNITS = 0 00210300
THEN SENDMAXRECSIZEV * 6 00210400
ELSE SENDMAXRECSIZEV ; 00210500
MAXRECCHAR := IF MAXRECCHAR = 84 00210600
THEN 80 00210700
ELSE MAXRECCHAR ; 00210800
END ; 00210900
VALUE(CDATA) : MAXRECCHAR := IF FILGET.UNITS = 0 00211000
THEN SENDMAXRECSIZEV * 6 00211100
ELSE SENDMAXRECSIZEV ; 00211200
ELSE : MAXRECCHAR := 72 ; % SEQ, ALGOL, PL/I, 00211300
END CASE ; 00211400
IF SERVERMODE THEN SERVERMODE := FALSE; 00211500
END ELSE 00211600
IF REAL(B.[3:3])= 1 THEN % NOFILES 00211700
BEGIN 00211800
STATE := ABORT; 00211900
IF SERVERMODE THEN SENDERROR(RECVSEQ,FNOTEX) 00212000
ELSE ERRORHANDLER(FNOTEX); 00212100
GO TO EXIT 00212200
END 00212300
ELSE 00212400
IF REAL(B.[3:3])= 0 THEN % ENDOFDIRECTORY 00212500
IF FIRSTFILETOSEND THEN 00212600
BEGIN 00212700
STATE := ABORT; 00212800
IF SERVERMODE THEN SENDERROR(RECVSEQ,FNOTEX) 00212900
ELSE ERRORHANDLER(FNOTEX); 00213000
GO TO EXIT 00213100
END 00213200
ELSE 00213300
BEGIN 00213400
STATE := BREAK; NUMTRY := 0; 00213500
GO TO EXIT 00213600
END; 00213700
IF FIRSTFILETOSEND THEN STATE := INIT ELSE STATE := FILEHEADER; 00213800
00213900
00214000
EXIT: 00214100
00214200
00214300
END 00214400
END FILEHANDLER; 00214500
$PAGE 00214600
PROCEDURE STARTRUN; 00214700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00214800
% % 00214900
% INITIALIZE THE SEND- OR RECEIVE- PROCEDURE % 00215000
% THS % 00215100
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00215200
00215300
BEGIN NUMSENDPACK := 0; 00215400
NUMRECVPACK := 0; 00215500
NUMACK := 0; 00215600
NUMNAK := 0; 00215700
NUMACKRECV := 0; 00215800
NUMNAKRECV := 0; 00215900
NUMBADRECV := 0; 00216000
NUMTRY := 0; 00216100
IF (RUNSTATE NEQ SERVER) 00216200
THEN BEGIN 00216300
MAXTRY := DEFINITTRY ; 00216400
SEQNUM := 0 ; 00216500
SENDSEQ:= 0 ; 00216600
RECVSEQ:= 0 ; 00216700
END ; 00216800
00216900
00217000
END STARTRUN ; 00217100
00217200
$PAGE 00217300
PROCEDURE SENDINIT ; 00217400
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00217500
% % 00217600
% BUILD AND SEND THE SEND-INIT PACKET. % 00217700
% --------------------- % 00217800
% ARRIVAL OF ACK-PACKET % 00217900
% THEN DECODE PARAMETERS OF RECEIVE-INIT PACKET % 00218000
% STATE := FILEHEADER % 00218100
% ELSE TRY AGAIN UNTIL NUMTRY = 10 % 00218200
% THS % 00218300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00218400
00218500
BEGIN 00218600
IF NUMTRY > MAXTRY 00218700
THEN BEGIN 00218800
STATE := ABORT ; 00218900
ERRORHANDLER( CANTSENDINIT ); 00219000
END 00219100
ELSE BEGIN 00219200
NUMTRY := * + 1; 00219300
IF NUMTRY NEQ 1 00219400
THEN RESENDPACKET 00219500
ELSE BEGIN 00219600
IF DEBUG THEN 00219700
WRITE( JOURNAAL, <"********* SENDINIT"> ) ; 00219800
BUILDPACKET; 00219900
WAIT( (DELAY) ) ; 00220000
TRANSMITPACKET ; 00220100
END; 00220200
IF ( RECV := RECEIVEPACKET ) 00220300
THEN BEGIN 00220400
IF ( RECVPTYPE EQL ACK ) AND (RECVSEQ = SEQNUM ) 00220500
THEN BEGIN 00220600
NUMACKRECV := * + 1; 00220700
DECODEPARM; 00220800
IF STOPBINARY THEN STATE := ABORT 00220900
ELSE STATE := FILEHEADER; 00221000
NUMTRY := 0; 00221100
MAXTRY := DEFTRY; 00221200
SENDSEQ := (SENDSEQ + 1) MOD 64; 00221300
SEQNUM := SENDSEQ ; 00221400
END 00221500
ELSE 00221600
IF ( RECVPTYPE EQL NAK) AND (RECVSEQ = SEQNUM ) 00221700
THEN NUMNAKRECV := * + 1 00221800
ELSE NUMBADRECV := * + 1 ; 00221900
END ; 00222000
END ; 00222100
END SENDINIT ; 00222200
$PAGE 00222300
PROCEDURE SENDFILE ; 00222400
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00222500
% % 00222600
% BUILD AND SENDS THE FILEHEADER - PACKET. % 00222700
% ------------------------ % 00222800
% BY ARRIVAL OF ACK-PACKET % 00222900
% THEN STATE := FILEDATA % 00223000
% ELSE TRY AGAIN UNTIL NUMTRY = 5 . % 00223100
% THS % 00223200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00223300
00223400
BEGIN 00223500
IF ( NUMTRY > MAXTRY ) 00223600
THEN BEGIN 00223700
STATE := ABORT; 00223800
ERRORHANDLER( CANTSENDFH ); 00223900
END 00224000
ELSE 00224100
BEGIN 00224200
NUMTRY := * + 1; 00224300
IF ( NUMTRY NEQ 1 ) 00224400
THEN RESENDPACKET 00224500
ELSE BEGIN 00224600
IF DEBUG THEN 00224700
WRITE( JOURNAAL, <"********* SENDFILEHEAD"> ) ; 00224800
BUILDPACKET; 00224900
TRANSMITPACKET ; 00225000
END; 00225100
IF ( RECV := RECEIVEPACKET ) 00225200
THEN BEGIN 00225300
IF ((RECVPTYPE EQL ACK ) AND ( RECVSEQ = SEQNUM)) OR 00225400
((RECVPTYPE EQL NAK ) AND ( RECVSEQ = SEQNUM + 1)) 00225500
THEN BEGIN 00225600
NUMACKRECV := * + 1; 00225700
STATE := FILEDATA; 00225800
COUNT := 0; LASTCHAR := 0; 00225900
NUMTRY := 0; 00226000
SENDSEQ := (SENDSEQ + 1) MOD 64; 00226100
SEQNUM := SENDSEQ; 00226200
END 00226300
ELSE 00226400
IF (RECVPTYPE EQL ERROR) THEN STATE := ABORT 00226500
ELSE 00226600
IF ( RECVPTYPE EQL NAK) AND ( RECVSEQ = SEQNUM ) 00226700
THEN NUMNAKRECV := * + 1 00226800
ELSE NUMBADRECV := * + 1 ; 00226900
END ; 00227000
END; 00227100
00227200
END SENDFILE; 00227300
00227400
$PAGE 00227500
PROCEDURE SENDDATA ; 00227600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00227700
% % 00227800
% BUILD AND SENDS THE DATA - PACKET OF THE FILE. % 00227900
% ----------------- % 00228000
% BY ARRIVAL OF ACK-PACKET % 00228100
% THEN SEND NEXT DATA-PACKET % 00228200
% IF EOF-ENCOUNTERED STATE := EOFFILE % 00228300
% ELSE TRY AGAIN UNTIL NUMTRY = 5 . % 00228400
% THS % 00228500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00228600
00228700
BEGIN 00228800
IF ( NUMTRY > MAXTRY ) 00228900
THEN BEGIN 00229000
STATE := ABORT; 00229100
ERRORHANDLER( CANTSENDDATA ); 00229200
END 00229300
ELSE BEGIN 00229400
NUMTRY := * + 1; 00229500
IF ( NUMTRY NEQ 1 ) 00229600
THEN RESENDPACKET 00229700
ELSE BEGIN 00229800
IF DEBUG THEN 00229900
WRITE( JOURNAAL, <"********* SENDDATA"> ) ; 00230000
BUILDPACKET; 00230100
TRANSMITPACKET ; 00230200
END; 00230300
IF ( RECV := RECEIVEPACKET ) 00230400
THEN BEGIN 00230500
IF ((RECVPTYPE EQL ACK) AND ( RECVSEQ = SEQNUM)) OR 00230600
((RECVPTYPE EQL NAK) AND ( RECVSEQ = SEQNUM + 1)) 00230700
THEN BEGIN 00230800
NUMTRY := 0; 00230900
NUMACKRECV := * + 1 ; 00231000
SENDSEQ := (SENDSEQ + 1) MOD 64; 00231100
SEQNUM := SENDSEQ; 00231200
IF BEOF THEN 00231300
IF BINARY THEN 00231400
IF (REPEAT AND (COUNT NEQ 0)) 00231500
THEN EMPTYBUF := TRUE 00231600
ELSE STATE := EOFFILE 00231700
ELSE 00231800
IF DOEOL THEN ELSE STATE := EOFFILE 00231900
END 00232000
ELSE 00232100
IF ( RECVPTYPE EQL NAK ) AND ( RECVSEQ = SEQNUM ) 00232200
THEN NUMNAKRECV := * + 1 00232300
ELSE NUMBADRECV := * + 1 ; 00232400
END ; 00232500
END; 00232600
END SENDDATA; 00232700
00232800
$PAGE 00232900
PROCEDURE SENDEOF ; 00233000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00233100
% % 00233200
% BUILD AND SENDS THE EOF-PACKET. % 00233300
% --------------- % 00233400
% THEN CLOSE THE FILE % 00233500
% STATE := NEXTFILE. % 00233600
% ELSE TRY AGAIN UNTIL NUMTRY = 5 . % 00233700
% THS % 00233800
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00233900
00234000
BEGIN 00234100
IF ( NUMTRY > MAXTRY ) 00234200
THEN BEGIN 00234300
STATE := ABORT; 00234400
ERRORHANDLER( CANTSENDEOF ); 00234500
END 00234600
ELSE BEGIN 00234700
NUMTRY := * + 1; 00234800
IF ( NUMTRY NEQ 1 ) 00234900
THEN RESENDPACKET 00235000
ELSE BEGIN 00235100
IF DEBUG THEN 00235200
WRITE( JOURNAAL, <"********* SENDEOF"> ); 00235300
BUILDPACKET; 00235400
TRANSMITPACKET ; 00235500
END; 00235600
IF ( RECV := RECEIVEPACKET ) 00235700
THEN BEGIN 00235800
IF ((RECVPTYPE EQL ACK ) AND ( RECVSEQ = SEQNUM)) OR 00235900
((RECVPTYPE EQL NAK ) AND ( RECVSEQ = SEQNUM + 1)) 00236000
THEN BEGIN 00236100
IF DIRECTORY THEN STATE := NEXTFILE 00236200
ELSE STATE := BREAK; 00236300
NUMACKRECV := * + 1 ; 00236400
IF FILGET.OPEN 00236500
THEN CLOSE( FILGET ) ; 00236600
NUMTRY := 0; 00236700
SENDSEQ := (SENDSEQ + 1) MOD 64; 00236800
SEQNUM := SENDSEQ; 00236900
END 00237000
ELSE 00237100
IF ( RECVPTYPE EQL NAK ) AND ( RECVSEQ = SEQNUM ) 00237200
THEN NUMNAKRECV := * + 1 00237300
ELSE NUMBADRECV := * + 1 ; 00237400
END ; 00237500
END; 00237600
END SENDEOF; 00237700
00237800
$PAGE 00237900
PROCEDURE SENDBREAK ; 00238000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00238100
% % 00238200
% BUILD AND SENDS THE BREAK-PACKET. % 00238300
% ----------------- % 00238400
% THEN STATE := COMPLETE % 00238500
% ELSE TRY AGAIN UNTIL NUMTRY = 5 % 00238600
% THS % 00238700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00238800
% 00238900
BEGIN 00239000
IF ( NUMTRY > MAXTRY ) 00239100
THEN BEGIN 00239200
STATE := ABORT; 00239300
ERRORHANDLER( CANTSENDBRK ); 00239400
END 00239500
ELSE BEGIN 00239600
NUMTRY := * + 1; 00239700
IF ( NUMTRY NEQ 1 ) 00239800
THEN RESENDPACKET 00239900
ELSE BEGIN 00240000
IF DEBUG THEN 00240100
WRITE( JOURNAAL, <"********* SENDBREAK"> ) ; 00240200
BUILDPACKET; 00240300
TRANSMITPACKET; 00240400
END; 00240500
IF ( RECV := RECEIVEPACKET ) 00240600
THEN BEGIN 00240700
IF ((RECVPTYPE EQL ACK ) AND ( RECVSEQ = SEQNUM)) OR 00240800
((RECVPTYPE EQL NAK ) AND ( RECVSEQ = SEQNUM + 1)) 00240900
THEN BEGIN 00241000
NUMACKRECV := * + 1; 00241100
STATE := COMPLETE; 00241200
NUMTRY := 0; 00241300
SENDSEQ := (SENDSEQ + 1) MOD 64; 00241400
SEQNUM := SENDSEQ; 00241500
END 00241600
ELSE 00241700
IF ( RECVPTYPE EQL NAK ) AND ( RECVSEQ = SEQNUM ) 00241800
THEN NUMNAKRECV := * + 1 00241900
ELSE NUMBADRECV := * + 1 ; 00242000
END 00242100
END; 00242200
END SENDBRK; 00242300
00242400
$PAGE 00242500
PROCEDURE SENDPROC ; 00242600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00242700
% % 00242800
% STATETABLE - SWITCHER FOR THE SEND-PROCEDURE % 00242900
% THS % 00243000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00243100
00243200
BEGIN STARTRUN ; 00243300
EMPTYBUF := TRUE; 00243400
DOEOL := FALSE; 00243500
BEOF := FALSE; 00243600
REPLACE PSEND := SENDPACKET[1] BY NULL FOR 97; 00243700
IF DIRREQUESTRESULT := DIRREQUEST(DIRIN,FALSE) THEN 00243800
BEGIN 00243900
STATE := ABORT; 00244000
IF SERVERMODE THEN SENDERROR(RECVSEQ,ERRDIRREQUEST) 00244100
ELSE ERRORHANDLER(ERRDIRREQUEST) 00244200
END ELSE 00244300
BEGIN 00244400
STATE := NEXTFILE; 00244500
TSV := TITLESTART; 00244600
END; 00244700
WHILE (STATE NEQ ABORT) AND (STATE NEQ COMPLETE) DO 00244800
BEGIN 00244900
CASE STATE OF 00245000
BEGIN 00245100
NEXTFILE : FILEHANDLER; 00245200
INIT : BEGIN 00245300
FIRSTFILETOSEND :=FALSE; SENDINIT 00245400
END; 00245500
FILEHEADER : SENDFILE; 00245600
FILEDATA : SENDDATA; 00245700
EOFFILE : SENDEOF; 00245800
BREAK : SENDBREAK; 00245900
ABORT : ; % NOTHING 00246000
COMPLETE : ; % NOTHING 00246100
END CASE; 00246200
END; 00246300
IF FILGET.OPEN 00246400
THEN CLOSE( FILGET ) ; 00246500
IF DEBUG THEN 00246600
BEGIN 00246700
IF STOPBINARY THEN 00246800
WRITE(JOURNAAL,<"THE OTHER KERMIT CAN'T DO BINARY TRANSPORT">);00246900
WRITE(JOURNAAL, *//, NUMSENDPACK, NUMRECVPACK ); 00247000
WRITE(JOURNAAL, *//, NUMACK, NUMNAK ); 00247100
WRITE(JOURNAAL[SPACE 2],*//, NUMACKRECV, NUMNAKRECV, NUMBADRECV); 00247200
WRITE(JOURNAAL[SPACE 3], <"**********************************">); 00247300
END 00247400
END SENDPROC ; 00247500
$PAGE 00247600
PROCEDURE ISFILEALREADYPRESENT ; 00247700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00247800
% % 00247900
% CHECKS IF THE FILE IS ALREADY PRESENT % 00248000
% AND IF SO HE CHANGES THE NAME OF THE FILE AND CHECKS AGAIN % 00248100
% IF NOT RESIDENT % 00248200
% THEN SET THE FILE - ATTRIBUTES % 00248300
% ELSE GIVE AN ERRORMESSAGE % 00248400
% THS % 00248500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00248600
BEGIN 00248700
00248800
EBCDIC ARRAY 00248900
HULP [1:80] , 00249000
TEMP [ 1:100 ] ; 00249100
00249200
POINTER 00249300
PHULP , 00249400
PTEMP ; 00249500
00249600
INTEGER 00249700
NUM , J ; 00249800
00249900
REAL 00249920
FILTER ; 00249940
LABEL 00250000
EXIT ; 00250100
TRANSLATETABLE CHANGESIGNS ( EBCDIC TO EBCDIC, "." TO "/" , 00250200
"!#$%&'()_=-{}][`*+@\~|<>?" TO "X" ); 00250300
00250400
BEGIN 00250500
NUM := 0 ; 00250600
REPLACE PTEMP := TEMP[ 1 ] BY " " FOR 100; 00250700
IF RECDIR THEN 00250800
REPLACE PTEMP:PTEMP BY SCRATCH[1] FOR LOFSCRATCH,"/"; 00250900
FILTER := REAL( RECBUF[LEN],1 ); 00250920
% skip all characters but not : 00250930
% . 00250940
% 0 -- 9 00250950
% A -- Z 00250960
% a -- z 00250970
% at the end of this fileidentifier. 00250975
WHILE ( (FILTER LEQ 45) OR 00250980
(FILTER EQL 47) OR 00250985
((FILTER GEQ 58) AND (FILTER LEQ 64)) OR 00250988
((FILTER GEQ 91) AND (FILTER LEQ 96)) OR 00250990
(FILTER GEQ 123) ) DO 00250992
BEGIN 00250994
LEN := * - 1; 00250996
FILTER := REAL( RECBUF[LEN],1 ) 00250998
END; 00250999
TRANSTOEBCDIC( RECBUF, 1, LEN ); 00251000
REPLACE RECBUF[ 1 ] BY RECBUF[ 1 ] FOR LEN WITH LTOU ; 00251100
REPLACE PTEMP:PTEMP BY RECBUF[ 1 ] FOR LEN WITH CHANGESIGNS, "."; 00251200
IF (PTEMP - 2) = "/" THEN REPLACE PTEMP:(PTEMP - 2) BY "."; 00251300
FILSTORE.NEWFILE := FALSE ; 00251400
REPLACE FILSTORE.TITLE BY TEMP[ 1 ] ; 00251500
FILSTORE.FILEKIND := RECFILEKINDV ; 00251600
IF BINARY THEN 00251700
BEGIN 00251800
IF (RECFILEKINDV NEQ VALUE(DATA)) THEN 00251900
BEGIN 00252000
STATE := ABORT; 00252100
ERRORHANDLER(BINFAULT); 00252200
GO TO EXIT 00252300
END 00252400
END; 00252500
IF FILSTORE.RESIDENT THEN 00252600
BEGIN 00252700
IF WARNINGS.OPEN THEN 00252800
ELSE 00252820
BEGIN 00252840
IF WARNINGS.RESIDENT THEN 00252860
BEGIN 00252880
OPEN(WARNINGS); 00252890
SPACE(WARNINGS,WARNINGS.LASTRECORD + 1) 00252900
END ELSE 00252920
WARNINGS.NEWFILE := TRUE 00252940
END; 00252960
PRINTLOGHEADING(FALSE); 00253000
WRITE(WARNINGS,<"FILE ALREADY EXISTS">); 00253100
SCAN TEMP[1] FOR J:100 UNTIL = "."; 00253200
REPLACE PHULP:= HULP[1] BY " " FOR 80; 00253300
REPLACE PHULP:PHULP BY "TITLE ",TEMP[1] FOR (100 - J), 00253400
" CHANGED INTO "; 00253500
WHILE ( FILSTORE.RESIDENT AND NUM < 99 ) DO 00253600
BEGIN 00253700
NUM := * + 1 ; 00253800
REPLACE (PTEMP - 1) BY NUM FOR 2 DIGITS, "." ; 00253900
REPLACE FILSTORE.TITLE BY TEMP[ 1 ] 00254000
END ; 00254100
IF NUM < 99 THEN 00254200
BEGIN 00254300
SCAN TEMP[1] FOR J:100 UNTIL = "."; 00254400
REPLACE PHULP:PHULP BY TEMP[1] FOR (100 - J); 00254500
WRITE(WARNINGS,<A80>,HULP[*]) 00254600
END 00254700
END; 00254800
IF ( NUM = 99 AND FILSTORE.RESIDENT ) 00254900
THEN BEGIN 00255000
STATE := ABORT ; 00255100
ERRORHANDLER( CANTNAMEFILE ) ; 00255200
END 00255300
ELSE BEGIN 00255400
FILSTORE.NEWFILE := TRUE ; 00255500
IF (RECFILEKINDV = VALUE(DATA)) THEN ELSE 00255600
BEGIN 00255700
GETCANDEPARAM( RECTYPE ) ; 00255800
IF (SSEQ EQL 0) THEN PSTORE := * + SEQWIDTH; 00255900
END; 00256000
FILSTORE.MAXRECSIZE := RECMAXRECSIZEV ; 00256100
IF(RECMAXRECSIZEV GTR 20) OR (RECFILEKINDV = VALUE(DATA)) 00256200
THEN BEGIN 00256300
FILSTORE (UNITS = 1, 00256400
BLOCKSIZE = 3 * RECMAXRECSIZEV); 00256500
END 00256600
ELSE BEGIN 00256700
FILSTORE.BLOCKSIZE := 30 * RECMAXRECSIZEV ; 00256800
FILSTORE.UNITS := 0 ; 00256900
END ; 00257000
FILSTORE.FLEXIBLE := TRUE ; 00257100
ROOM := MAXRECCHAR := 00257200
IF (RECFILEKINDV = VALUE(DATA)) THEN RECMAXRECSIZEV 00257300
ELSE TEXTWIDTH; 00257400
IF FILSTORE.ATTERR OR FILSTORE.AVAILABLE EQL 12 00257500
THEN STATE := ABORT 00257600
END 00257700
END ; 00257800
00257900
EXIT: 00258000
00258100
END ISFILEALREADYPRESENT ; 00258200
00258300
$PAGE 00258400
PROCEDURE RECEIVEINIT; 00258500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00258600
% % 00258700
% RECEIVE AN SEND-INIT PACKET % 00258800
% ------------------- % 00258900
% IF SO THEN DECODE THE PARAMETERS AND % 00259000
% SEND AN RECEIVE-INIT PACKET % 00259100
% ELSE SEND A NAK - PACKET . % 00259200
% THS % 00259300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00259400
00259500
BEGIN 00259600
NUMTRY := * + 1; 00259700
IF NUMTRY > MAXTRY 00259800
THEN BEGIN 00259900
STATE := ABORT; 00260000
ERRORHANDLER (CANTRECVINIT); 00260100
END 00260200
ELSE BEGIN 00260300
IF DEBUG THEN 00260400
IF (NUMTRY = 1) 00260500
THEN WRITE( JOURNAAL, <"********* RECVINIT "> ) ; 00260600
IF ( RECV := RECEIVEPACKET ) 00260700
THEN BEGIN 00260800
IF (RECVPTYPE EQL SINIT) 00260900
THEN BEGIN 00261000
DECODEPARM; 00261100
IF STOPBINARY THEN 00261200
BEGIN 00261300
SENDANSWER(RECVSEQ,ERROR); 00261400
STATE := ABORT 00261500
END ELSE 00261600
BEGIN 00261700
SENDPTYPE := ACK; 00261800
SENDSEQ := RECVSEQ; 00261900
ENCODEPARM ; 00262000
TRANSMITPACKET; 00262100
STATE := FILEHEADER; 00262200
NUMTRY := 0 ; 00262300
MAXTRY := DEFTRY; 00262400
SEQNUM := (SEQNUM + 1) MOD 64; 00262500
END 00262600
END 00262700
ELSE NUMBADRECV := * + 1 ; 00262800
END 00262900
ELSE SENDANSWER( SEQNUM, NAK ); 00263000
END; 00263100
00263200
END RECEIVEINIT; 00263300
00263400
$PAGE 00263500
PROCEDURE RECEIVEFILE ; 00263600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00263700
% % 00263800
% RECEIVE THE FILE-HEADER PACKET % 00263900
% ----------------------- % 00264000
% IF SO THEN CHECK IF FILENAME IS NOT RESIDENT % 00264100
% SEND AN ACK-PACKET % 00264200
% STATE := FILEDATA % 00264300
% ELSE IF RECEIVING A SEND-INIT PACKET THEN ACK IT % 00264400
% ELSE IF RECEIVING A BREAK-PACKET THEN STATE := COMPLETE % 00264500
% ELSE SEND AN ACK-PACKET OF THE PACKET BEFORE . % 00264600
% THS % 00264700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00264800
00264900
BEGIN 00265000
NUMTRY := * + 1 ; 00265100
IF NUMTRY > MAXTRY 00265200
THEN BEGIN 00265300
STATE := ABORT ; 00265400
ERRORHANDLER ( CANTRECVFH ); 00265500
END 00265600
ELSE BEGIN 00265700
IF DEBUG THEN 00265800
IF (NUMTRY = 1) 00265900
THEN WRITE( JOURNAAL, <"********* RECVFILEHEAD"> ) ; 00266000
IF ( RECV := RECEIVEPACKET ) 00266100
THEN BEGIN 00266200
IF (RECVPTYPE = FILEHEAD) 00266300
THEN BEGIN 00266400
ISFILEALREADYPRESENT; 00266500
IF STATE = ABORT THEN ELSE 00266600
BEGIN 00266700
SENDSEQ := RECVSEQ ; 00266800
SENDANSWER( SENDSEQ, ACK ) ; 00266900
STATE := FILEDATA ; 00267000
NUMTRY := 0 ; 00267100
SEQNUM := (SEQNUM + 1) MOD 64 ; 00267200
END 00267300
END 00267400
ELSE 00267500
IF (RECVPTYPE = SINIT) 00267600
THEN RESENDPACKET 00267700
ELSE 00267800
IF (RECVPTYPE = BRK) 00267900
THEN BEGIN 00268000
SENDSEQ := RECVSEQ ; 00268100
SENDANSWER( SENDSEQ, ACK ) ; 00268200
STATE := COMPLETE ; 00268300
SEQNUM := (SEQNUM + 1) MOD 64 ; 00268400
END 00268500
ELSE NUMBADRECV := * + 1 ; 00268600
END 00268700
ELSE SENDANSWER( SEQNUM - 1, ACK ); 00268800
END ; 00268900
END RECEIVEFILE ; 00269000
00269100
$PAGE 00269200
PROCEDURE RECEIVEDATA ; 00269300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00269400
% % 00269500
% RECEIVE THE DATA - PACKETS % 00269600
% ------------------ % 00269700
% IF SO THEN STORE THE DATA IN A RECORD % 00269800
% SEND AN ACK-PACKET % 00269900
% ELSE IF RECEIVING THE DATA-PACKET OF BEFORE THEN ACK IT % 00270000
% ELSE IF RECEIVING AN EOF-PACKET % 00270100
% THEN CLOSE THE FILE AND CRUNCH IT % 00270200
% SEND AN ACK-PACKET % 00270300
% STATE := FILEHEADER % 00270400
% ELSE SEND AN ACK-PACKET OF THE PACKET BEFORE . % 00270500
% THS % 00270600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00270700
00270800
BEGIN 00270900
NUMTRY := * + 1 ; 00271000
IF NUMTRY > MAXTRY 00271100
THEN BEGIN 00271200
STATE := ABORT; 00271300
ERRORHANDLER( CANTRECVDATA ); 00271400
END 00271500
ELSE BEGIN 00271600
IF DEBUG THEN 00271700
IF (NUMTRY = 1) 00271800
THEN WRITE( JOURNAAL, <"********* RECVDATA"> ) ; 00271900
IF ( RECV := RECEIVEPACKET ) 00272000
THEN BEGIN 00272100
IF (RECVPTYPE = DATA) AND (RECVSEQ = SEQNUM) 00272200
THEN BEGIN 00272300
IF BINARY THEN 00272400
IF REPEAT THEN REPSTOREBININRECORD 00272500
ELSE STOREBININRECORD 00272600
ELSE 00272700
IF REPEAT THEN REPSTOREINRECORD 00272800
ELSE STOREINRECORD; 00272900
SENDSEQ := RECVSEQ ; 00273000
SEQNUM := (SEQNUM + 1) MOD 64 ; 00273100
SENDANSWER( SENDSEQ, ACK ) ; 00273200
NUMTRY := 0 ; 00273300
END 00273400
ELSE 00273500
IF (RECVPTYPE = DATA) AND (RECVSEQ = SEQNUM - 1) 00273600
THEN SENDANSWER( SEQNUM - 1, ACK ) 00273700
ELSE 00273800
IF ( RECVPTYPE = EOF ) 00273900
THEN BEGIN % WRITE FINAL BUFFER 00274000
IF BINARY THEN 00274100
BEGIN 00274200
IF ROOM NEQ RECMAXRECSIZEV THEN 00274300
WRITEBINRECORDTOFILE 00274400
END ELSE 00274500
IF ROOM NEQ MAXRECCHAR THEN 00274600
WRITERECORDTOFILE; 00274700
STATE := FILEHEADER ; 00274800
SEQCOUNT := 0 ; 00274900
IF FILSTORE.OPEN 00275000
THEN CLOSE( FILSTORE, CRUNCH ) ; 00275100
SENDSEQ := RECVSEQ; 00275200
SENDANSWER( SENDSEQ, ACK ); 00275300
SEQNUM := (SEQNUM + 1) MOD 64; 00275400
NUMTRY := 0 ; 00275500
END 00275600
ELSE NUMBADRECV := * + 1 ; 00275700
END 00275800
ELSE SENDANSWER( SEQNUM - 1, ACK ) ; 00275900
END; 00276000
00276100
END RECEIVEDATA ; 00276200
00276300
$PAGE 00276400
PROCEDURE RECEIVEPROC ; 00276500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00276600
% % 00276700
% STATETABLE - SWITCHER FOR RECEIVE-PROCEDURE % 00276800
% THS % 00276900
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00277000
00277100
BEGIN STARTRUN ; 00277200
IF (RUNSTATE NEQ SERVER) THEN STATE := INIT; 00277300
IF BINARY THEN 00277400
BEGIN 00277500
IF(RECMAXRECSIZEV > 512)THEN 00277600
RESIZE(BINRECSTORE[*],RECMAXRECSIZEV); 00277700
REPLACE PBINRECSTORE := BINRECSTORE[1] BY NULL 00277800
FOR RECMAXRECSIZEV; 00277900
END 00278000
ELSE 00278100
REPLACE PSTORE := RECSTORE[1] BY BLANK FOR 255; 00278200
SEQCOUNT := 0; COUNT := 1 ; 00278300
WHILE (STATE NEQ ABORT) AND (STATE NEQ COMPLETE) DO 00278400
BEGIN 00278500
CASE STATE OF 00278600
BEGIN 00278700
INIT : RECEIVEINIT; 00278800
FILEHEADER : RECEIVEFILE; 00278900
FILEDATA : RECEIVEDATA; 00279000
EOFFILE : ; % NOTHING 00279100
BREAK : ; % NOTHING 00279200
ABORT : ; % NOTHING 00279300
COMPLETE : ; % NOTHING 00279400
END CASE; 00279500
END; 00279600
IF FILSTORE.OPEN 00279700
THEN CLOSE( FILSTORE, CRUNCH ) ; 00279800
IF DEBUG THEN 00279900
BEGIN 00280000
IF STOPBINARY THEN 00280100
WRITE(JOURNAAL,<"THE OTHER KERMIT CAN'T DO BINARY TRANSPORT">);00280200
WRITE(JOURNAAL, *//, NUMSENDPACK, NUMRECVPACK ); 00280300
WRITE(JOURNAAL, *//, NUMACK, NUMNAK ); 00280400
WRITE(JOURNAAL[SPACE 2],*//, NUMACKRECV, NUMNAKRECV, NUMBADRECV); 00280500
WRITE(JOURNAAL[SPACE 3], <"**********************************">); 00280600
END 00280700
END RECEIVEPROC ; 00280800
00280900
00281000
$PAGE 00281100
PROCEDURE SERVERPROC ; 00281200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00281300
% % 00281400
% STATETABLE - SWITCHER FOR SERVERPROCEDURE . % 00281500
% THS % 00281600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00281700
BEGIN 00281800
ARRAY TITEL [1:16] ; 00281900
LABEL EXIT; 00282000
INTEGER J; 00282100
POINTER PTITEL ; 00282200
BOOLEAN FIN ; 00282250
00282300
BEGIN 00282400
WRITE(FILOUT,<"Kermit Server running on B7900 host.">); 00282500
WRITE(FILOUT,<"Please type your escape sequence to return to your">); 00282600
WRITE(FILOUT,<"local machine. Shut down the server by typing ">); 00282700
WRITE(FILOUT,<" FINISH - command on your local machine.">); 00282800
WHILE ( NOT FIN ) DO 00282900
BEGIN 00283000
SERVERMODE := TRUE ; 00283100
SEQNUM := SENDSEQ := RECVSEQ := 0; 00283200
IF ( RECV := RECEIVEPACKET ) 00283300
THEN BEGIN 00283400
CASE REAL( RECVPTYPE ) OF 00283500
BEGIN 00283600
00283700
SINIT : BEGIN % INIT-SEND 00283800
SERVERMODE := FALSE ; 00283900
RECEIVEMODE := TRUE; 00284000
DECODEPARM; 00284100
IF STOPBINARY THEN 00284200
BEGIN 00284300
SENDANSWER(RECVSEQ,ERROR); 00284400
GO TO EXIT 00284500
END; 00284600
SENDPTYPE := ACK ; 00284700
ENCODEPARM ; 00284800
TRANSMITPACKET ; 00284900
STATE := FILEHEADER ; 00285000
NUMTRY := 0 ; 00285100
MAXTRY := DEFTRY ; 00285200
SEQNUM := ( SEQNUM + 1 ) MOD 64 ; 00285300
RECEIVEPROC ; 00285400
END ; 00285500
00285600
IINIT : BEGIN % INIT-INFO 00285700
DECODEPARM; 00285800
SENDPTYPE := ACK; 00285900
ENCODEPARM; 00286000
TRANSMITPACKET; 00286100
END ; 00286200
00286300
RINIT : BEGIN % INIT-RECEIVE 00286400
MAXTRY := DEFINITTRY ; 00286500
RECEIVEMODE := FALSE; 00286600
DIRECTORY := FALSE; 00286700
TRANSTOEBCDIC( RECBUF, 1, LEN ) ; 00286800
REPLACE RECBUF[1] BY RECBUF[1] FOR LEN WITH LTOU ; 00286900
IF LEN = 0 THEN 00287000
BEGIN 00287100
SENDERROR(RECVSEQ,NOFILENAME); 00287200
GO TO EXIT 00287300
END 00287400
ELSE 00287500
BEGIN 00287600
IF SENDDIR THEN PDIRIN := HOLDPDIRIN 00287700
ELSE 00287800
REPLACE PDIRIN := DIRIN[1] BY " " FOR 100; 00287900
REPLACE PDIRIN:PDIRIN BY RECBUF[1] FOR LEN; 00288000
IF REAL(RECBUF[LEN],1) EQL "=" THEN 00288100
BEGIN 00288200
DIRECTORY := TRUE; 00288300
PDIRIN := * - 2 00288400
END; 00288500
REPLACE PDIRIN:PDIRIN BY ".",48"00" FOR 1; 00288600
IF DIRECTORY THEN 00288700
BEGIN 00288800
FILSTORE.NEWFILE := FALSE; 00288850
REPLACE FILSTORE.TITLE BY PDIRIN; 00288900
IF FILSTORE.RESIDENT THEN SKIPFIRSTFILE := TRUE 00289000
END 00289100
END; 00289200
FIRSTFILETOSEND := TRUE; 00289300
SENDPROC; 00289400
END; 00289500
00289600
GENERIC: BEGIN 00289700
CASE REAL( RECBUF[ 1 ], 1 ) OF 00289800
BEGIN 00289900
FINISH : BEGIN 00290000
SENDANSWER( RECVSEQ, ACK ); 00290100
FIN := TRUE ; 00290200
END ; 00290300
00290400
ELSE : BEGIN 00290500
SENDERROR( RECVSEQ, NOTIMPLEM ); 00290600
END ; 00290700
END CASE ; 00290800
END ; 00290900
00291000
ERROR: ; 00291100
00291200
00291300
ELSE : SENDERROR( RECVSEQ, NOTIMPLEM ) ; 00291400
END CASE ; 00291500
END 00291600
ELSE SENDANSWER( SEQNUM, NAK ) ; 00291700
END WHILE ; 00291800
END ; 00291900
00292000
00292100
EXIT: IF DEBUG THEN IF STOPBINARY THEN 00292200
WRITE(JOURNAAL,<"THE OTHER KERMIT CAN'T DO BINARY TRANSPORT">)00292300
00292400
00292500
END SERVERPROC ; 00292600
$PAGE 00292700
PROCEDURE HELPPROC ; 00292800
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00292900
% % 00293000
% GIVES A HELP - SCREEN % 00293100
% % 00293200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00293300
BEGIN 00293400
EBCDIC ARRAY 00293500
HELPARR [ 1:72 ] , 00293600
LINEARR [ 1:1480 ] , 00293700
ANSWER [ 1:96 ]; 00293800
00293900
POINTER 00294000
PARR , 00294100
PLINE , 00294200
PANSWER ; 00294300
00294400
INTEGER 00294500
I , 00294600
BEGREC , 00294700
ENDREC ; 00294800
00294900
REAL 00295000
FF , 00295100
HCR , 00295200
HLF ; 00295300
00295400
BOOLEAN 00295500
EH , 00295600
READY ; 00295700
00295800
BEGIN 00295900
READY := FALSE ; 00296000
HCR := 48"0D" ; 00296100
HLF := 48"25" ; 00296200
CASE HELPPARM OF 00296300
BEGIN 00296400
SET : BEGIN 00296500
BEGREC := 9 ; 00296600
ENDREC := 246; 00296700
END ; 00296800
SEND : BEGIN 00296900
BEGREC := 275; 00297000
ENDREC := 290; 00297100
END ; 00297200
SHOW : BEGIN 00297300
BEGREC := 248; 00297400
ENDREC := 257; 00297500
END ; 00297600
EXIT : BEGIN 00297700
BEGREC := 316; 00297800
ENDREC := 323; 00297900
END ; 00298000
SERVER : BEGIN 00298100
BEGREC := 292; 00298200
ENDREC := 314; 00298300
END ; 00298400
RECEIVE : BEGIN 00298500
BEGREC := 259; 00298600
ENDREC := 273; 00298700
END ; 00298800
ELSE : BEGIN 00298900
BEGREC := 0 ; 00299000
ENDREC := 7 ; 00299100
END ; 00299200
END CASE ; 00299300
EH := READ( KERMHELP[ BEGREC ], 72, HELPARR[ * ] ) ; 00299400
WHILE ( NOT READY ) DO 00299500
BEGIN 00299600
I := 0 ; 00299700
REPLACE ANSWER[1] BY " " FOR 96; 00299800
REPLACE PLINE := LINEARR[ 1 ] BY " " FOR 1480; 00299900
WHILE (( I := * + 1 ) LEQ 20 ) AND ( NOT READY ) DO 00300000
BEGIN 00300100
PARR := HELPARR[ 1 ] ; 00300200
REPLACE PLINE:PLINE BY PARR:PARR FOR 72, 00300300
BITSSHIFT( HCR ), BITSSHIFT( HLF ) ; 00300400
EH := READ( KERMHELP[ BEGREC := * + 1 ], 72, HELPARR[ * ] ) ; 00300500
READY := ( BEGREC > ENDREC ) OR EH 00300600
END ; 00300700
WRITE( FILOUT,I * 74,LINEARR[ * ] ) ; 00300800
IF ( NOT READY ) THEN 00300900
BEGIN 00301000
WRITE(FILOUT,<"Enter Q (for Quit) or any other", 00301100
" key to continue. ">); 00301200
READ (FILIN,96,ANSWER[*]); 00301300
PANSWER := ANSWER[1]; 00301400
IF (PANSWER = "Q" FOR 1) OR 00301500
(PANSWER = "q" FOR 1) THEN READY := TRUE 00301600
END 00301700
END ; 00301800
END; 00301900
END HELPPROC ; 00302000
$PAGE 00302100
PROCEDURE PROCESINPUT ; 00302200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00302300
% % 00302400
% SYNTAX - CHECK OF THE INPUT - STRING % 00302500
% IF CORRECT : COMMAND AS FAR AS POSSIBLE EXECUTED , % 00302600
% FILES OPENED OR CREATED, VALUES ASSIGNED % 00302700
% TO THEIR PARAMETERS, OR TO SET A FLAG ; % 00302800
% IF NOT CORRECT : THE ERRORHANDLER IS INVOKED ; % 00302900
% % 00303000
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00303100
00303200
BEGIN 00303300
INTEGER J, K, K1, K2, K3, K4, K5, K6 ; 00303400
BOOLEAN SETCMD; 00303500
00303600
POINTER P1, P2, P3, P4, P5, P6 ; 00303700
00303800
TRUTHSET NUMERIC ( "0123456789" ) , 00303900
SPECIALS ( "!"""#$%&'()*+,-./:;<=>?@[\]^_`{|}~" ), 00304000
COMMANDCHARS ( ALPHA OR SPECIALS ); 00304100
$PAGE 00304200
PROCEDURE PARM ( PP , KTEL ) ; 00304300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00304400
% % 00304500
% LOCATE PLACE AND SIZE OF THE PARAMETERS % 00304600
% % 00304700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00304800
00304900
INTEGER KTEL ; 00305000
00305100
POINTER PP ; 00305200
00305300
BEGIN 00305400
K := J ; KTEL := 0 ; 00305500
PP := PCMD ; 00305600
SCAN PCMD:PCMD FOR J:K WHILE IN COMMANDCHARS; 00305700
KTEL := K-J ; K := J ; 00305800
SCAN PCMD:PCMD FOR J:K UNTIL NEQ " " ; 00305900
END PARM ; 00306000
00306100
$PAGE 00306200
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00306300
% % 00306400
% SYNTAX-CHECK OF SHOW-, EXIT-, SERVER- COMMAND % 00306500
% % 00306600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00306700
PROCEDURE CHKSHOW; 00306800
00306900
BEGIN IF (K2 NEQ 0) THEN RUNSTATE := TOOPARM 00307000
ELSE RUNSTATE := SHOW ; 00307100
END CHKSHOW; 00307200
% 00307300
00307400
PROCEDURE CHKEXIT ; 00307500
00307600
BEGIN IF (K2 NEQ 0) THEN RUNSTATE := TOOPARM 00307700
ELSE RUNSTATE := EXIT ; 00307800
END CHKEXIT ; 00307900
% 00308000
PROCEDURE CHKSERVER ; 00308100
BEGIN IF ( K2 NEQ 0) THEN RUNSTATE := TOOPARM 00308200
ELSE RUNSTATE := SERVER ; 00308300
END CHKSERVER ; 00308400
00308500
PROCEDURE CHKRECEIVE ; 00308600
BEGIN 00308700
IF (K2 NEQ 0) THEN RUNSTATE := TOOPARM 00308800
ELSE RUNSTATE := RECEIVE; 00308900
END CHKRECEIVE ; 00309000
% 00309100
$PAGE 00309200
PROCEDURE CHKHELP ; 00309300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00309400
% % 00309500
% SYNTAX-CHECK OF HELP - CMD % 00309600
% % 00309700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00309800
00309900
BEGIN RUNSTATE := HELP ; 00310000
HELPPARM := 0 ; 00310100
IF ( K3 NEQ 0 ) THEN RUNSTATE := TOOPARM 00310200
ELSE IF ( K2 NEQ 0 ) 00310300
THEN BEGIN 00310400
SCAN P2 FOR J:K2 WHILE IN ALPHA; 00310500
IF ( J NEQ 0 ) THEN RUNSTATE := INVPARM 00310600
ELSE BEGIN 00310700
IF (P2="SET" ) AND (K2=3) THEN HELPPARM:=SET 00310800
ELSE IF (P2="SEND" ) AND (K2=4) THEN HELPPARM:=SEND 00310900
ELSE IF (P2="EXIT" ) AND (K2=4) THEN HELPPARM:=EXIT 00311000
ELSE IF (P2="SHOW" ) AND (K2=4) THEN HELPPARM:=SHOW 00311100
ELSE IF (P2="STA" ) THEN HELPPARM:=SHOW 00311150
ELSE IF (P2="SERVER" ) AND (K2=6) THEN HELPPARM:=SERVER 00311200
ELSE IF (P2="RECEIVE") AND (K2=7) THEN HELPPARM:=RECEIVE 00311300
ELSE RUNSTATE := INVPARM ; 00311400
END ; 00311500
END ; 00311600
END CHKHELP ; 00311700
$PAGE 00311800
PROCEDURE CHKSEND ; 00311900
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00312000
% % 00312100
% SYNTAX-CHECK OF SEND - CMD % 00312200
% % 00312300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00312400
00312500
00312600
BEGIN RUNSTATE := SEND ; 00312700
WRITE(FILOUT[STOP],<"Wait. ">); 00312800
FIRSTFILETOSEND := TRUE; 00312900
DIRECTORY := FALSE; 00313000
IF (K5 NEQ 0) THEN RUNSTATE := TOOPARM 00313100
ELSE IF (K2 EQL 0) THEN RUNSTATE := NOFILENAME 00313200
ELSE 00313300
BEGIN 00313400
IF SENDDIR THEN PDIRIN := HOLDPDIRIN 00313500
ELSE 00313600
REPLACE PDIRIN := DIRIN[ 1 ] BY " " FOR 100; 00313700
REPLACE PDIRIN:PDIRIN BY P2 FOR K2; 00313800
IF REAL(P2 + (K2 - 1),1) EQL "=" THEN %DIRECTORY00313900
BEGIN DIRECTORY := TRUE; PDIRIN := * - 2 END; 00314000
IF (K3 NEQ 0) THEN 00314100
REPLACE PDIRIN:PDIRIN BY " ", P3:P3 FOR K3; 00314200
IF (K4 NEQ 0) THEN 00314300
REPLACE PDIRIN:PDIRIN BY " ", P4:P4 FOR K4; 00314400
REPLACE PDIRIN:PDIRIN BY ".",48"00" FOR 1; 00314500
IF DIRECTORY THEN 00314600
BEGIN 00314700
FILSTORE.NEWFILE := FALSE; 00314750
REPLACE FILSTORE.TITLE BY PDIRIN; 00314800
IF FILSTORE.RESIDENT THEN SKIPFIRSTFILE := TRUE 00314900
END 00315000
END 00315100
00315200
END CHKSEND; 00315300
$PAGE 00315400
PROCEDURE CHKSET; 00315500
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00315600
% % 00315700
% SYNTAX-CHECK OF SET - CMD AND SET THE PARAMETERS % 00315800
% % 00315900
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00316000
00316100
BEGIN 00316200
00316300
INTEGER J ; 00316400
00316500
REAL HEOL, HSOP, HQUOTE ; 00316600
00316700
EBCDIC ARRAY 00316800
HQU [ 1:1 ] ; 00316900
ARRAY TAIP[0:15]; 00317000
POINTER PTAIP; 00317100
00317200
RUNSTATE := SET ; 00317300
IF ( K3 EQL 0 ) THEN RUNSTATE := PARMEXPECT 00317400
ELSE BEGIN 00317500
SCAN P2 FOR J:K2 WHILE IN ALPHA; 00317600
IF ( J NEQ 0 ) THEN RUNSTATE := INVPARM 00317700
ELSE 00317800
IF (P2 = "DEBUG") AND (K2 = 5) 00317900
THEN BEGIN 00318000
IF (P3 = "ON") THEN 00318100
BEGIN 00318200
DEBUG := TRUE; 00318300
IF JOURNAAL.OPEN THEN ELSE 00318400
BEGIN 00318500
OPEN(JOURNAAL); 00318600
PRINTLOGHEADING(TRUE) 00318700
END 00318800
END 00318900
ELSE 00319000
IF (P3 = "OFF")THEN 00319100
BEGIN 00319200
DEBUG := FALSE; 00319300
IF JOURNAAL.OPEN THEN CLOSE(JOURNAAL) 00319400
END 00319500
ELSE 00319600
RUNSTATE := INVPARM 00319700
END 00319800
ELSE 00319900
IF ( P2="EXT" ) THEN 00320000
BEGIN 00320100
IF ( P3 = "ON" ) THEN EXTENSION := TRUE 00320200
ELSE 00320300
IF ( P3 = "OFF" )THEN EXTENSION := FALSE 00320400
ELSE 00320500
RUNSTATE := INVPARM 00320600
END 00320700
ELSE 00320800
IF ( P2 ="REC") THEN 00320900
BEGIN 00321000
IF (P3 = "DIR" ) THEN 00321100
BEGIN 00321200
IF (K4 EQL 0) THEN RECDIR := FALSE 00321300
ELSE 00321400
BEGIN 00321500
SCAN P4 FOR J:K4 WHILE IN TIETELNOSPACE; 00321600
IF (J NEQ 0) THEN RUNSTATE := INVPARM 00321700
ELSE 00321800
BEGIN 00321900
REPLACE PSCRATCH := SCRATCH[1] BY " " FOR 100; 00322000
REPLACE PSCRATCH BY P4 FOR K4; 00322100
LOFSCRATCH := K4; 00322200
RECDIR := TRUE 00322300
END 00322400
END 00322500
END ELSE RUNSTATE := INVPARM 00322600
END 00322700
ELSE 00322800
IF ( P2="DELAY") AND ( K2=5 ) 00322900
THEN BEGIN 00323000
SCAN P3 FOR J:K3 WHILE IN NUMERIC ; 00323100
IF ( J NEQ 0 ) THEN RUNSTATE := INVVALUE 00323200
ELSE BEGIN 00323300
IF ( K4 NEQ 0 ) THEN RUNSTATE := TOOPARM 00323400
ELSE IF ( INTEGER(P3,K3) > 30 ) OR 00323500
( INTEGER(P3,K3) < 0 ) 00323600
THEN RUNSTATE := INVVALUE 00323700
ELSE DELAY := INTEGER( P3,K3 ) ; 00323800
END 00323900
END 00324000
ELSE 00324100
IF ( P2="FILE") AND ( K2=4 ) THEN 00324200
BEGIN 00324300
IF (P3="TYPE") AND (K3=4) THEN 00324400
BEGIN 00324500
IF (K4 EQL 0) THEN RUNSTATE := PARMEXPECT 00324600
ELSE 00324700
BEGIN 00324800
REPLACE PTAIP := P(TAIP) BY P4 WHILE IN ALPHA; 00324900
IF NOT GETFILEKIND(TAIP) THEN RUNSTATE := NOFILEKIND 00325000
ELSE 00325100
BEGIN 00325200
IF (RECFILEKINDV = VALUE(DATA)) THEN ELSE 00325300
GETCANDEPARAM(RECTYPE); 00325400
IF (P4="BIN") THEN 00325500
BEGIN 00325600
BINARY := TRUE; 00325700
MY8BQ := SEND8BQ := 48"26" % QBIN = & 00325800
END ELSE 00325900
BEGIN 00326000
BINARY := FALSE; 00326100
MY8BQ := SEND8BQ := DEF8BQ % QBIN = N 00326200
END; 00326300
IF (K5 NEQ 0) THEN 00326400
BEGIN 00326500
IF (P4="BIN") OR (P4="DAT") THEN 00326600
BEGIN 00326700
IF (P5="REC") THEN 00326800
BEGIN 00326900
IF (K6 EQL 0) THEN RUNSTATE := VALUEXPECT 00327000
ELSE 00327100
BEGIN 00327200
IF P6 = "-" THEN RUNSTATE := INVVALUE 00327300
ELSE 00327400
BEGIN 00327500
IF P6 = "+" THEN 00327600
BEGIN 00327700
P6 := * + 1; K6 := * - 1 00327800
END; 00327900
IF RECMAXRECSIZEV:= 00328000
INTEGER(P6,K6) = 0 00328100
THEN RUNSTATE := INVVALUE 00328200
END 00328300
END 00328400
END ELSE 00328500
RUNSTATE := INVPARM 00328600
END ELSE 00328700
RUNSTATE := INVPARM 00328800
END ELSE % K5 EQL 0 00328900
BEGIN 00329000
IF (P4="BIN") THEN RECMAXRECSIZEV := 128 00329100
ELSE 00329200
IF (P4 ="DAT") THEN RECMAXRECSIZEV := 80 00329300
END 00329400
END 00329500
END 00329600
END ELSE RUNSTATE := INVPARM 00329700
END 00329800
ELSE 00329900
IF ( P2="SEND") AND ( K2=4 ) 00330000
THEN BEGIN 00330100
IF (P3 = "DIR" ) THEN 00330200
BEGIN 00330300
IF (K4 EQL 0) THEN SENDDIR := FALSE 00330400
ELSE 00330500
BEGIN 00330600
SCAN P4 FOR J:K4 WHILE IN TIETELNOSPACE; 00330700
IF (J NEQ 0 ) THEN RUNSTATE := INVPARM 00330800
ELSE 00330900
BEGIN 00331000
REPLACE PDIRIN := DIRIN[1] BY " " FOR 100; 00331100
REPLACE PDIRIN:PDIRIN BY P4 FOR K4,"/"; 00331200
LOFSENDDIR := K4; 00331250
HOLDPDIRIN := PDIRIN; 00331300
SENDDIR := TRUE 00331400
END 00331500
END 00331600
END ELSE 00331700
IF ( K4 EQL 0 ) THEN RUNSTATE := VALUEXPECT 00331800
ELSE BEGIN 00331900
SCAN P3 FOR J:K3 WHILE IN ALPHA; 00332000
IF ( J NEQ 0 ) THEN RUNSTATE := INVPARM 00332100
ELSE IF ( P3="EOL") AND ( K3=3 ) 00332200
THEN BEGIN 00332300
SCAN P4 FOR J:K4 WHILE IN NUMERIC; 00332400
IF ( J NEQ 0 ) OR ( K4 > 3 ) 00332500
THEN RUNSTATE := INVVALUE 00332600
ELSE BEGIN 00332700
HEOL := REAL( INTEGER(P4,K4)) ; 00332800
IF (K5 NEQ 0) THEN RUNSTATE:=TOOPARM 00332900
ELSE 00333000
IF (HEOL EQL SENDSOP) OR 00333100
(HEOL EQL SENDQUOTE) OR 00333200
(HEOL EQL SENDPADCHAR) 00333300
THEN RUNSTATE := INVVALUE 00333400
ELSE 00333500
IF (HEOL = LF) OR (HEOL = CR) 00333600
THEN SENDEOL := HEOL 00333700
ELSE RUNSTATE := INVVALUE 00333800
END 00333900
END 00334000
ELSE 00334100
IF ( P3="PAKLEN") AND ( K3=6 ) 00334200
THEN BEGIN 00334300
SCAN P4 FOR J:K4 WHILE IN NUMERIC ; 00334400
IF ( J NEQ 0 ) THEN RUNSTATE := INVVALUE 00334500
ELSE BEGIN 00334600
IF (K5 NEQ 0) THEN RUNSTATE:=TOOPARM 00334700
ELSE IF (INTEGER(P4,K4) > MAXPACK) OR 00334800
(INTEGER(P4,K4) < MINPACK) 00334900
THEN RUNSTATE := INVVALUE 00335000
ELSE SENDPACKSIZE:=INTEGER(P4,K4);00335100
END ; 00335200
END 00335300
ELSE 00335400
IF ( P3="TIMEOUT") AND ( K3=7 ) 00335500
THEN BEGIN 00335600
SCAN P4 FOR J:K4 WHILE IN NUMERIC ; 00335700
IF ( J NEQ 0 ) THEN RUNSTATE :=INVVALUE 00335800
ELSE BEGIN 00335900
IF (K5 NEQ 0) THEN RUNSTATE :=TOOPARM 00336000
ELSE IF (INTEGER( P4,K4 ) > 90) 00336100
THEN RUNSTATE := TOOVALUE 00336200
ELSE THEIRTIMEOUT:=INTEGER(P4,K4);00336300
END ; 00336400
END 00336500
ELSE 00336600
IF (P3="SOP") AND (K3=3) 00336700
THEN BEGIN 00336800
IF ( K4 GEQ 4 ) THEN RUNSTATE := INVVALUE 00336900
ELSE BEGIN 00337000
SCAN P4 FOR J:K4 WHILE IN NUMERIC ; 00337100
IF (J NEQ 0) THEN RUNSTATE :=INVVALUE 00337200
ELSE BEGIN 00337300
HSOP := REAL( INTEGER(P4,K4)); 00337400
IF (K5 NEQ 0) THEN RUNSTATE:=TOOPARM 00337500
ELSE IF (HSOP EQL SENDEOL) OR 00337600
(HSOP EQL SENDQUOTE) OR 00337700
(HSOP EQL SENDPADCHAR) OR 00337800
NOT (CONTROL(HSOP)) 00337900
THEN RUNSTATE := INVVALUE 00338000
ELSE SENDSOP:= HSOP; 00338100
END 00338200
END 00338300
END 00338400
ELSE 00338500
IF ( P3="QUOTE") AND ( K3=5 ) 00338600
THEN BEGIN 00338700
IF ( K4 NEQ 1 ) THEN RUNSTATE := INVVALUE 00338800
ELSE BEGIN HQUOTE := REAL( P4,K4 ) ; 00338900
REPLACE HQU[1] BY BITSSHIFT(HQUOTE); 00339000
TRANSTOASCII( HQU, 1, 1 ); 00339100
HQUOTE := REAL( HQU[1], 1); 00339200
IF (K5 NEQ 0) THEN RUNSTATE:=TOOPARM 00339300
ELSE 00339400
IF (HQUOTE LEQ 32) OR 00339500
(HQUOTE GEQ 63) OR 00339600
(HQUOTE EQL 38) OR 00339700
(HQUOTE EQL SENDSOP) OR 00339800
(HQUOTE EQL SENDEOL) OR 00339900
(HQUOTE EQL SENDPADCHAR) 00340000
THEN RUNSTATE := INVVALUE 00340100
ELSE SENDQUOTE := HQUOTE 00340200
END 00340300
END 00340400
ELSE 00340500
IF (P3="PADDING") AND (K3=7) 00340600
THEN 00340700
BEGIN 00340800
IF (K6 EQL 0) THEN RUNSTATE:=PARMEXPECT 00340900
ELSE 00341000
BEGIN 00341100
SCAN P4 FOR J:K4 WHILE IN NUMERIC ; 00341200
IF (K4 > 2) OR (J NEQ 0) 00341300
THEN RUNSTATE := TOOVALUE 00341400
ELSE BEGIN 00341500
IF (INTEGER(P4,K4) > 20) 00341600
THEN RUNSTATE := TOOVALUE 00341700
ELSE SENDPAD:=INTEGER(P4,K4); 00341800
END; 00341900
SCAN P5 FOR J:K5 WHILE IN ALPHA; 00342000
IF (J NEQ 0) THEN RUNSTATE:=INVPARM 00342100
ELSE IF (P5="PADCHAR") AND (K5=7) 00342200
THEN 00342300
BEGIN 00342400
SCAN P6 FOR J:K6 WHILE IN NUMERIC; 00342500
IF (J NEQ 0) THEN 00342600
RUNSTATE := INVVALUE ELSE 00342700
BEGIN 00342800
SENDPADCHAR := INTEGER(P6,K6); 00342900
IF (SENDPADCHAR EQL SENDSOP) OR 00343000
(SENDPADCHAR EQL SENDEOL) OR 00343100
(SENDPADCHAR EQL SENDQUOTE) OR00343200
NOT (CONTROL(SENDPADCHAR)) 00343300
THEN RUNSTATE := INVVALUE 00343400
ELSE 00343500
IF (SENDPAD NEQ 0) THEN 00343600
BEGIN 00343700
REPLACE PADARR[1] BY NULL FOR 20;00343800
REPLACE PADARR[1] BY SENDPADCHAR 00343900
FOR SENDPAD; 00344000
TRANSTOEBCDIC(PADARR,1,SENDPAD) 00344100
END 00344200
END 00344300
END 00344400
END 00344500
END 00344600
ELSE RUNSTATE := INVPARM ; 00344700
END 00344800
END 00344900
ELSE RUNSTATE := INVPARM ; 00345000
END; 00345100
END CHKSET ; 00345200
% 00345300
%%%%%%%%% END OF PROCEDURE-DECLARATIONS OF PROCESINPUT %%%%%%%%%%% 00345400
$PAGE 00345500
BEGIN K := 96 ; 00345600
K1:=K2:=K3:=K4:=K5:=K6:=0; 00345700
SCAN PCMD:PCMD FOR J:K WHILE = " "; K := J; 00345800
IF J = 0 THEN RUNSTATE := SPATIE 00345900
ELSE BEGIN 00346000
IF PCMD = "SET" FOR 3 THEN SETCMD := TRUE; 00346100
SCAN PCMD:PCMD FOR J:K UNTIL = ">"; K := J; 00346200
IF (J EQL 0) OR SETCMD THEN 00346300
BEGIN 00346400
PCMD := COMMAND[1] ; 00346500
K := 96 ; 00346600
END 00346700
ELSE BEGIN 00346800
PCMD := PCMD + 1 ; 00346900
K := K - 1 ; 00347000
END ; 00347100
SCAN PCMD:PCMD FOR J:K UNTIL NEQ " " ; 00347200
IF J = 0 THEN RUNSTATE := SPATIE 00347300
ELSE BEGIN 00347400
IF ( J NEQ 0 ) THEN PARM ( P1,K1 ) ; 00347500
IF ( J NEQ 0 ) THEN PARM ( P2,K2 ) ; 00347600
IF ( J NEQ 0 ) THEN PARM ( P3,K3 ) ; 00347700
IF ( J NEQ 0 ) THEN PARM ( P4,K4 ) ; 00347800
IF ( J NEQ 0 ) THEN PARM ( P5,K5 ) ; 00347900
IF ( J NEQ 0 ) THEN PARM ( P6,K6 ) ; 00348000
IF ( J NEQ 0 ) THEN RUNSTATE := TOOPARM 00348100
ELSE BEGIN 00348200
PCMD := COMMAND[1] ; 00348300
SCAN P1 FOR J:K1 WHILE IN ALPHA; 00348400
IF ( P1="SET" ) AND ( K1=3 ) THEN CHKSET 00348500
ELSE IF ( P1="SHOW" ) AND ( K1=4 ) THEN CHKSHOW 00348600
ELSE IF ( P1="STA" ) AND ( K1=3 ) THEN CHKSHOW 00348700
ELSE IF ( P1="STAT" ) AND ( K1=4 ) THEN CHKSHOW 00348800
ELSE IF ( P1="STATU" ) AND ( K1=5 ) THEN CHKSHOW 00348900
ELSE IF ( P1="STATUS" ) AND ( K1=6 ) THEN CHKSHOW 00349000
ELSE IF ( P1="SEND" ) AND ( K1=4 ) THEN CHKSEND 00349100
ELSE IF ( P1="HELP" ) AND ( K1=4 ) THEN CHKHELP 00349200
ELSE IF ( P1="EXIT" ) AND ( K1=4 ) THEN CHKEXIT 00349300
ELSE IF ( P1="SERVER" ) AND ( K1=6 ) THEN CHKSERVER 00349400
ELSE IF ( P1="RECEIVE") AND ( K1=7 ) THEN CHKRECEIVE 00349500
ELSE RUNSTATE := NOCOMMAND ; 00349600
END; 00349700
END; 00349800
END; 00349900
END; 00350000
END PROCESINPUT ; 00350100
$PAGE 00350200
PROCEDURE INITIALIZE ; 00350300
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00350400
% % 00350500
% INITIALISATION % 00350600
% % 00350700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00350800
00350900
BEGIN BEXIT := FALSE ; 00351000
OPEN ( FILIN ) ; 00351100
OPEN ( FILOUT) ; 00351200
SEQNUM := 0 ; 00351300
RECVSEQ := 0 ; 00351400
SENDSEQ := 0 ; 00351500
MYSOP := DEFSOP ; 00351600
SENDSOP := DEFSOP ; 00351700
DELAY := DEFDELAY ; 00351800
CHECKTYPE := DEFCHKTYPE ; 00351900
RECVCHKTYPE := DEFCHKTYPE ; 00352000
MYTIMEOUT := DEFTIMEOUT ; 00352100
THEIRTIMEOUT:= DEFTIMEOUT ; 00352200
RECVPACKSIZE:= MAXPACK ; 00352300
SENDPACKSIZE:= MAXPACK ; 00352400
MYPAD := DEFPAD ; 00352500
SENDPAD := DEFPAD ; 00352600
MYPADCHAR := DEFPADCHAR ; 00352700
SENDPADCHAR := DEFPADCHAR ; 00352800
SENDQUOTE := DEFQUOTE ; 00352900
MYQUOTE := DEFQUOTE ; 00353000
MY8BQ := DEF8BQ ; 00353100
SEND8BQ := DEF8BQ ; 00353200
MYEOL := DEFEOL ; 00353300
SENDEOL := DEFEOL ; 00353400
MYREPT := DEFREPT; 00353500
SENDREPT := DEFREPT; 00353600
RECFILEKINDV:= VALUE(DATA); % DEFAULT DATA 00353700
RECTYPE := 116; 00353800
RECMAXRECSIZEV := 80; 00353900
BINARY := FALSE; 00354000
DEBUG := FALSE; 00354100
EXTENSION := FALSE; 00354200
RECDIR := SENDDIR := FALSE 00354300
END INITIALIZE ; 00354400
% 00354500
$PAGE 00354600
PROCEDURE CLOSEKERMIT ; 00354700
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00354800
% % 00354900
% SHUT KERMIT DOWN % 00355000
% % 00355100
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00355200
00355300
BEGIN CLOSE ( FILOUT ) ; 00355400
CLOSE ( FILIN ) ; 00355500
IF DEBUG THEN CLOSE ( JOURNAAL ); 00355600
IF FILSTORE.OPEN 00355700
THEN CLOSE ( FILSTORE, CRUNCH ) ; 00355800
IF WARNINGS.OPEN THEN LOCK(WARNINGS) 00355900
END CLOSEKERMIT ; 00356000
$PAGE 00356100
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00356200
% % 00356300
% THE M A I N - BLOCK % 00356400
% ============================= % 00356500
% % 00356600
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 00356700
00356800
% 00356900
INITIALIZE ; 00357000
WRITE(FILOUT,<"THE-RC: Kermit Burroughs Large Systems. Version 5.2.">); 00357100
WRITE(FILOUT,<"Warnings,if any,are stored in a permanent disk file.">); 00357200
WRITE(FILOUT,<"TITLE of this file : KERMIT/WARNINGS.">); 00357300
WRITE(FILOUT,<"Type HELP for the available commands.">); 00357400
WHILE (NOT BEXIT) DO 00357500
BEGIN 00357600
REPLACE PCMD := COMMAND[1] BY " " FOR 96 ; 00357700
WRITE (FILOUT[STOP],<"Kermit-Bur >"> ); 00357800
READ ( FILIN [TIMELIMIT 0] ,96 , COMMAND ) ; 00357900
IF DEBUG THEN 00358000
WRITE( JOURNAAL,<"COMMAND:", X3, A96>, COMMAND[*] ) ; 00358100
REPLACE PCMD BY PCMD FOR 96 WITH LTOU; 00358200
PROCESINPUT ; 00358300
CASE RUNSTATE OF 00358400
BEGIN 00358500
SET : ; % NOTHING 00358600
SHOW : SHOWPROC ; 00358700
SEND : BEGIN RECEIVEMODE:=FALSE;SENDPROC END; 00358800
RECEIVE: BEGIN RECEIVEMODE:=TRUE;RECEIVEPROC END; 00358900
SERVER : SERVERPROC ; 00359000
HELP : HELPPROC ; 00359100
EXIT : BEXIT:=TRUE ; 00359200
SPATIE : ; % NOTHING 00359300
ELSE : ERRORHANDLER(RUNSTATE) ; 00359400
END CASE ; 00359500
END ; 00359600
CLOSEKERMIT ; 00359700
END . 00359800
