$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 ">); 00066116 IF SENDDIR THEN 00066118 WRITE( FILOUT, <" SEND DIRectory IS : ",A*>,LOFSENDDIR,DIRIN[*]) 00066120 ELSE 00066122 WRITE( FILOUT, <" SEND DIRectory IS ">); 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,); 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,,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