Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / burroughs / b68ker.alg next >

Wrap

Text File | 2020-01-01 | 84KB | 1,033 lines

$SET LIST STACK LINEINFO LISTINCL FORMAT $ ERRLIST 00000001 $SET LEVEL 2 00000002 PROCEDURE KERMIT (INIT); 01000000 ARRAY INIT[*]; 01001000 BEGIN 01002000 DEFINE 10000000 % PACKET LENGTH DEFINES 10001000 MYPAD = 10 # % # OF PAD CHARS (SET EXPERIMENTALLY) 10002000 , MYTIMOUT= 5 # % SECONDS TO WAIT BEFORE TIMEOUT 10002500 , MAXPACKET = 96 # % MAXIMUM LENGTH OF A PACKET 10003000 , MAXDATA = (MAXPACKET - 5) # % MOST DATA IN PACKET 10004000 , PADPACKETLENGTH = (MAXPACKET + MYPAD) # % MOST WE MIGHT RECEIVE10005000 , MAXINTEGER = 4"7FFFFFFFFF" # % LARGEST INTEGER ON B6800 10005250 , RETRYLIMIT = 10 # % NUMBER OF NAK RETRIES BEFORE ABORT 10005500 ; 10006000 REAL MARK, SEQ, STATE 11000000 , YOURMAXBUFF, YOURNPAD, YOURPAD, YOUREOL, YOURQUOTE, YOUR8BIT 11000250 , YOURREPEAT, YOURTIMOUT 11000500 ; 11000750 BOOLEAN DEBUGGING, RSLT, AUTOING; 11001000 FILE RMT (KIND=REMOTE,FRAMESIZE=8, MYUSE=IO 11002000 ,MAXRECSIZE=PADPACKETLENGTH,MINRECSIZE=1 11003000 ) 11004000 , FYLE (KIND=DISK, FRAMESIZE=8) 11004500 , DEBUGFILE (KIND=PRINTER, FRAMESIZE=8) 11005000 ; 11006000 ARRAY CTLCHARS [0:7]; % DYNAMIC TRUTHSET: CHARS NEEDING CTL QUOTING 11700000 DEFINE B = BOOLEAN # 120010020.01.002 , R = REAL # 120010040.01.002 , P = POINTER # 120010060.01.002 , INT = INTEGER # 120010080.01.002 , SIGNF = [46:1] # 1200101001.188.000 , LISTOF2(L1,L2) = L1,L2 #1200101201.188.004 , LISTOF3(L1,L2,L3) = L1,L2,L3 #1200101401.188.004 , LISTOF4(L1,L2,L3,L4) = L1,L2,L3,L4 #1200101601.188.004 , LISTOF5(L1,L2,L3,L4,L5) = L1,L2,L3,L4,L5 #1200101801.188.004 , LISTOF6(L1,L2,L3,L4,L5,L6) = L1,L2,L3,L4,L5,L6 #1200102001.188.004 , LISTOF7(L1,L2,L3,L4,L5,L6,L7) = L1,L2,L3,L4,L5,L6,L7 #1200102201.188.004 , LISTOF8(L1,L2,L3,L4,L5,L6,L7,L8) = L1,L2,L3,L4,L5,L6,L7,L8 #1200102401.188.004 , LISTOF9(L1,L2,L3,L4,L5,L6,L7,L8,L9)= L1,L2,L3,L4,L5,L6,L7,L8,L9 #1200102601.188.004 , FILEEOF = [9:1] # 1200102801.188.000 , FILEBRK = [13:1] # 1200103001.188.000 , ALLONES = REAL(NOT FALSE) # 1200103201.188.007 , ORD(X) = REAL(X,1) # %ORDINAL OF CHARACTER 120010340.01.002 , CHAR(X) = ((X).[7:48]) FOR 1 # % CHARACTER VALUE OF INTEGER 12001036 % OR ALPHA EXPRESSION 120010380.01.002 , ERRORCODEF = [47:47] # % FOR PUTTING A REAL VALUE INTO A BOOLEAN12001040 , POP(X) = X:=*.ERRORCODEF # 12001042 , POPPED(X) = (X).ERRORCODEF # 12001044 , PUSHIN(X) = (X) ERRORCODEF # 12001046 , BOOLINTOBOOL (B1,B2) = B2 & PUSHIN(B1) # 12001048 , REALINTOBOOL (R,B) = BOOLINTOBOOL (BOOLEAN(R),B)# 12001050 , LINKF = [19:20] # % STANDARD LINK FIELD 12001052 , SZ(X) = 0:X-1 # % FOR ARRAY DECLARATION 12001054 ; 12001056 PROCEDURE DUMPARRAY (WIRETAP,L,SOU,TYPE,INASCII); 12002010 VALUE L,SOU,TYPE,INASCII ; 12002020 FILE WIRETAP ; 12002030 REAL L, TYPE ; 12002040 POINTER SOU ; 12002050 BOOLEAN INASCII ; 12002060 COMMENT: PRODUCES A HEX AND ALPHANUMERIC DUMP OF THE CONTENTS OF AN 12002080 ARRAY TO A PRINTER FILE. 12002090 IT WILL LOOK SOMETHING LIKE: 12002100 12002110 -TYPE- C O N T E N T S O F T H E A R 12002120 C1D6D5E3C5D5 E3E240D6C640 E3C8C540C1D9 12002130 12002140 R A Y 12002150 D9C1E8 12002160 12002170 PARAMETERS: 12002180 WIRETAP: IS A PRINTER FILE ONTO WHICH THE DUMP IS MADE. 12002190 L: IS THE LENGTH (NUMBER OF CHARACTERS TO DUMP). 12002200 SOU: IS THE SOURCE POINTER -- POINTS TO THE FIRST CHARACTER 12002210 TO DUMP. 12002220 TYPE: SHOULD CONTAIN A SIX CHARACTER IDENTIFICATION MESSAGE.12002230 IT IS PRINTED ON THE DUMP TO THE LEFT OF THE ARRAY 12002240 CONTENTS. 12002250 INASCII: IF TRUE, THE ARRAY CONTENTS ARE CONSIDERED TO BE IN12002260 ASCII AND WILL BE TRANSLATED TO EBCDIC FOR THE 12002270 ALPHA PART OF THE DUMP. 12002280 ; 12002290 BEGIN 1200232001.188.001 ARRAY A1[0:9], A2[0:18], ED[0:20] %EDITED BY PICTURE 12002330 ; 1200234001.188.001 BOOLEAN BOO; 1200235001.188.001 REAL RM % REMAINING 1200236001.188.001 , CTS % CHARACTERS TO SHOW (ON THIS LINE) 1200237001.188.001 , BL % BLANKS TO PUT AT END 1200238001.188.001 , PLL % PRINT LINE LENGTH 12002390 ; 1200240001.188.001 POINTER PA2 1200241001.188.001 , SLO % SOURCE LEFT OFF 1200242001.188.001 ; 1200243001.188.001 PICTURE ALPHALINE( AXAXAXAXAXAXX AXAXAXAXAXAXX AXAXAXAXAXAXX 1200244001.188.001 AXAXAXAXAXAXX AXAXAXAXAXAXX AXAXAXAXAXAXX 1200245001.188.001 AXAXAXAXAXAXX AXAXAXAXAXAXX AXAXAXAXAXAXX 1200246001.188.001 ) 1200247001.188.001 , HEXLINE ( A(12)X A(12)X A(12)X 1200248001.188.001 A(12)X A(12)X A(12)X 1200249001.188.001 A(12)X A(12)X A(12)X 1200250001.188.001 ) 1200251001.188.001 ; 1200252001.188.001 1200253001.188.001 PA2:=P(A2); 1200254001.188.001 SLO:=SOU; 1200255001.188.001 RM :=L; 1200256001.188.001 REPLACE P(ED) BY TYPE FOR 6, " " FOR 20 WORDS; 1200257001.188.001 1200258001.188.001 DO 1200259001.188.001 BEGIN 1200260001.188.001 BL:=54-(CTS:=MIN(RM,54)); 1200261001.188.001 IF INASCII THEN % WHAT WE ARE WRITING IS IN ASCII 1200262001.188.001 BEGIN 1200263001.188.001 REPLACE P(A1,7) BY SLO:SLO FOR CTS; 1200264001.188.001 REPLACE PA2 BY P(A1,7) FOR CTS WITH ASCIITOEBCDIC 1200265001.188.001 , " " FOR BL 1200266001.188.001 END 1200267001.188.001 ELSE 1200268001.188.001 BEGIN 1200269001.188.001 REPLACE P(A1) BY SLO:SLO FOR CTS; 1200270001.188.001 REPLACE PA2 BY P(A1) FOR CTS, " " FOR BL 1200271001.188.001 END; 1200272001.188.001 REPLACE P(ED[1])+1 BY PA2 WITH ALPHALINE; 1200273001.188.001 PLL := IF WIRETAP.FRAMESIZE = 48 THEN 21 12002740 ELSE 126; 12002750 BOO:=WRITE(WIRETAP,PLL,ED); 12002760 1200277001.188.001 REPLACE PA2 BY P(A1,4) FOR CTS*2 WITH HEXTOEBCDIC 1200278001.188.001 , " " FOR BL*2; 1200279001.188.001 REPLACE P(ED) BY " " FOR 7 1200280001.188.001 , PA2 WITH HEXLINE; 1200281001.188.001 BOO:=WRITE(WIRETAP[SPACE 2],PLL,ED); 12002820 1200283001.188.001 REPLACE P(ED[1]) BY " " FOR 20 WORDS; 1200284001.188.001 END 12002850 UNTIL RM:=*-CTS = 0 12002860 END D E B U G W R I T E ; 12002870 DEFINE DEBUGARRAY (L,PTR,TYPE,INASCII)= 12003000 IF DEBUGGING THEN DUMPARRAY(DEBUGFILE,L,PTR,TYPE,INASCII) # 12004000 ; 12005000 DEFINE 13000000 % BASIC KERMIT TRANSFORMATION FUNCTIONS: 13001000 UNCHAR(X) = (ORD(X) -32) # % FROM PRINTABLE TO BINARY 13002000 , KERCHAR(X) = CHAR(X+32) # % BINARY TO PRINTABLE 13003000 , CTL(X) = (REAL(NOT(B(X)EQV B(64))).[7:8]) # %CTL TO PRINTABLE--13004000 , CTLCHAR(X) = CHAR(CTL(X)) # %OR VISE VERSA 13004500 ; 13005000 DEFINE AUTORCV = 48"BF" # % NDL -- AUTOMATICALLY RCV "D" PACKETS 18001000 , ASCIICRVAL = 13 # % DECIMAL VALUE OF AN ASCII CR 18002000 , ASCIILFVAL = 10 # % DECIMAL VALUE OF AN ASCII LF (OR NL) 18003000 18004000 , CAND (X,Y) = IF X THEN Y ELSE FALSE # 18005000 , COR (X,Y) = IF X THEN TRUE ELSE Y # 18006000 ; 18007000 DEFINE % PACKET TYPE CODES (FOR INTERNAL COMMUNICATIONS) 19000000 % DATA PACKETS (EVEN) 19001000 DATA_TYPE = 0 # 19002000 , AUTO_TYPE = 2 # 19003000 % CONTROL PACKETS (ODD) 19004000 , ACK_TYPE = 1 # 19005000 , NAK_TYPE = 3 # 19006000 , S_TYPE = 5 # % SEND PACKET 19007000 , F_TYPE = 7 # % FILE SPEC PACKET 19008000 , Z_TYPE = 9 # % EOF PACKET 19009000 , B_TYPE = 11 # % BREAK PACKET 19010000 , ERR_TYPE = -1 # % BAD NEWS, "E" PACKET, IO ERROR, OR FAULT 19011000 ; 19012000 REAL PROCEDURE ACCUM_CHECKSUM (CH,L); 20000000 VALUE CH,L; 20001000 POINTER CH; % FIRST CHAR TO CHECKSUM 20002000 REAL L; % # OF CHARS TO CHECKSUM 20003000 BEGIN 20004000 REAL A; % ACCUMULATOR 20005000 20006000 DO 20007000 BEGIN 20008000 A:=*+ ORD(CH); 20009000 CH:=*+ 1 20010000 END 20011000 UNTIL L:=*- 1 = 0; 20012000 A:=A.[7:8]; 20013000 ACCUM_CHECKSUM:=(A + A.[7:2]).[5:6]; 20014000 END A C C U M C H E C K S U M ; 20015000 ASCII ARRAY PKT[0:PADPACKETLENGTH]; % PACKET GOES HERE 22000000 REAL PKL; % LENGTH OF PACKET 22001000 DEFINE % PACKET CONTROL CHARACTERS 22002000 MARK_CHAR = PKT[0] # 22003000 , COUNT_CHAR = PKT[1] # % # CHARS IN PACKET 22004000 , SEQ_CHAR = PKT[2] # % MESSAGE # 22005000 , TYPE_CHAR = PKT[3] # % TYPE OF PACKET 22006000 , FIRST_DATA = PKT[4] # % FIRST CHAR OF DATA 22007000 ; 22008000 DEFINE % VALUES RETURNED FROM PGET 22009000 % PACKET IS OK: 22010000 PG_OK = 0 # % PACKET IS OK 22011000 % IO ERRORS (NO PACKET RECEIVED): 22012000 , PG_TIMEOUT = 1 # % TIMEOUT 22013000 , PG_EOF = 2 # % EOF 22014000 , PG_IOERR = 3 # % IO ERROR ON RECV 22015000 % BADLY FORMED PACKET 22016000 , PG_NOMARK = 4 # % NO MARK (SOH) CHARACTER FOUND 22017000 , PG_SHORT = 5 # % PACKET SHORTER THAN LENGTH CHAR SEZ 22018000 , PG_CKSM = 6 # % CHECKSUM ERROR 22019000 % PACKET OUT OF SEQUENCE 22020000 , PG_SQHIGH = 7 # % SEQ IN PACKET = SEQ + 1 22021000 , PG_SQLOW = 8 # % SEQ IN PACKET = SEQ - 1 22022000 , PG_SEQERR = 9 # % WAY OUT OF SEQUENCE 22023000 ; 22024000 REAL PROCEDURE PGET(TL); 22025000 VALUE TL; 22025250 BOOLEAN TL; % TIME LIMIT -- IF TRUE ENFORCE TIME LIMIT ON RCV: 22025500 COMMENT: THIS IS THE PRIMITIVE PACKET GET ROUTINE. IT READS THE 22026000 DATACOM FILE TO TRY AND GET A PACKET. IT MAY TIMEOUT, 22027000 GET AN IO ERROR OR RECEIVE SOMETHING. IF IT GETS SOMETHING 22028000 IT LOOKS FOR A MARK (SOH) WHICH SIGNALS A KERMIT PACKET. 22029000 IF A MARK IS FOUND, THE PACKET IS TRANSLATED TO ASCII, ALIGNED22030000 TO THE PREDEFINED LOCATIONS OF THE PACKET CONTROL CHARACTERS 22031000 AND VERIFIED AS A GOOD PACKET. A ZERO IS RETURNED IF A VALID 22032000 PACKET HAS BEEN RECEIVED. A NON-ZERO VALUE SIGNALS SOME KIND 22033000 OF ABNORMAL CONDITION. THE POSSIBLE VALUES RETURNED ARE 22034000 DEFINED ABOVE. IT IS UP TO THE CALLER TO TAKE THE APPROPRIATE22035000 ACTION WHEN AN ABNORMALL CONDITION OCCURS. 22036000 22037000 IF A PACKET IS RECEIVED FROM THE AUTO RECEIVE HANDLER IN NDL 22038000 (NDL HAS VERIFIED THE PACKET, ACKED IT, AND HANDLED CONTROL 22039000 CHARACTER QUOTING) THE PACKET WILL BE PRECEDED BY 48"BF". 22040000 THIS AUTORCV CODE IS PLACED IN MARK_CHAR WITH THE PACKET 22041000 CONTENTS (CONVERTED TO ASCII) IMMEDIATELY FOLLOWING. 22042000 22043000 PKL IS SET TO THE LENGTH OF THE DATA PORTION OF THE PACKET. 22044000 ; 22045000 BEGIN 22046000 REAL S; 22047000 POINTER PP; 22048000 22049000 IF TL THEN RMT.TIMELIMIT:= YOURTIMOUT; % ENFORCE TIME LIMIT? 22049500 IF RSLT:=READ (RMT,PADPACKETLENGTH,PKT) THEN 22050000 BEGIN 22051000 IF DEBUGGING THEN 22052000 WRITE (DEBUGFILE,<8"RECV ERR: ",H12>,REAL(RSLT)); 22053000 PGET:= 22054000 IF RSLT.[15:1] THEN PG_TIMEOUT 22055000 ELSE 22056000 IF RSLT.[9:1] THEN PG_EOF 22057000 ELSE PG_IOERR 22058000 END 22059000 ELSE % HANDLE GOOD RECIVE HERE--IS IT A GOOD PKT? 22060000 BEGIN 22061000 PKL:= RMT.CURRENTRECORD; 22062000 DEBUGARRAY (PKL,PKT,8"> IN >",COR(AUTOING,PKT=AUTORCV)); 22063000 IF PKT= AUTORCV THEN 22064000 BEGIN 22064500 PKL:=*-1; % DON'T COUNT AUTORCV CHAR 22065000 AUTOING:= TRUE % MAKE A NOTE THAT WE'RE AUTO RECEIVING 22065500 END 22067500 ELSE % NOT AUTO "D" PKT FROM NDL 22069000 BEGIN 22070000 SCAN PP:PKT FOR PKL:PKL UNTIL = MARK; 22071000 IF PKL< 5 THEN % NO MARK OR TOO SHORT TO BE VALID PACKET 22072000 PGET:= PG_NOMARK 22073000 ELSE 22074000 BEGIN 22075000 IF AUTOING THEN 22076100 BEGIN 22076200 % JUST GOT OUT OF NDL AUTO RECV. THERE IS NO 22076225 % PADDING BEFORE THE PACKET, AND THE SEQ CHAR HAS 22076250 % BEEN VERIFIED BY NDL. THE COUNT, SEQ, AND TYPE 22076275 % CHARACTERS ARE IN ASCII, BUT THE REST ARE IN 22076280 % EBCDIC 22076290 AUTOING:= FALSE; 22076300 REPLACE MARK_CHAR BY PP:PP FOR 4; % MK,CNT,SEQ,TYPE 22076320 REPLACE FIRST_DATA BY PP FOR PKL-4 22076325 WITH EBCDICTOASCII; 22076350 SEQ:= UNCHAR(SEQ_CHAR) % RE-SYNC 22076400 END 22076500 ELSE REPLACE MARK_CHAR BY PP FOR PKL WITH EBCDICTOASCII;22076750 IF PKL < PKL:=UNCHAR(COUNT_CHAR) THEN 22077000 PGET:= PG_SHORT 22078000 ELSE 22079000 IF ACCUM_CHECKSUM (COUNT_CHAR,PKL) NEQ 22080000 UNCHAR((COUNT_CHAR)+PKL) 22081000 THEN PGET:= PG_CKSM 22082000 ELSE % CHECKSUM OK 22083000 BEGIN 22084000 PKL:=* -3; % JUST COUNT OF DATA BYTES 22085000 IF S:= UNCHAR(SEQ_CHAR) - SEQ.[5:6] NEQ 0 22086000 THEN % OUT OF SEQUENCE 22087000 PGET:= 22088000 IF S = 1 THEN PG_SQHIGH 22089000 ELSE IF S = -1 THEN PG_SQLOW 22090000 ELSE PG_SEQERR 22091000 ELSE % GOOD PACKET 22091250 IF TYPE_CHAR = 7"Y" THEN % ACK PACKET 22091500 SEQ:= *+1 22091750 END END END END; 22092000 22093000 RMT.TIMELIMIT:= 0 22094000 END P G E T ; 22095000 EBCDIC ARRAY OPKT[0:MAXPACKET]; % LENGTH MAY CHANGE IF PADDING REQ'D 24000000 BOOLEAN PROCEDURE PPUT (PTYPE,DATAL); 24001000 COMMENT: PRIMITIVE PUT ROUTINE: 24002000 FORMATS AND SENDS A PACKET OF THE TYPE ENCODED IN PTYPE. THE 24003000 TYPE, SEQ AND COUNT FIELDS WILL BE SET TO PROPER VALUES. DATAL 24004000 BYTES OF DATA (IN ASCII) ARE ASSUMED TO BE PRESENT STARTING AT 24005000 FIRST_DATA. NO QUOTING IS DONE BY PPUT, AND THUS MUST BE DONE 24006000 BEFORE CALLING PPUT. PPUT WILL CALCULATE A CHECKSUM AND INSERT 24007000 IT INTO THE PACKET. THE PACKET IS THEN SENT TO THE REMOTE 24008000 COMPUTER. 24009000 24010000 THE STATUS WORD FROM THE WRITE TO THE REMOTE COMPUTER IS 24011000 RETURNED. THE NORMAL VALUE RETURNED IS THUS FALSE, BUT WILL 24012000 BE TRUE IN THE CASE OF AN IO ERROR. 24013000 ; 24014000 VALUE PTYPE,DATAL; 24015000 REAL PTYPE; % CODE FOR TYPE OF PACKET TO SEND 24016000 REAL DATAL; % # OF CHARS TO SEND--THEY START AT FIRST_DATA 24017000 BEGIN 24018000 POINTER CKSM; % POINTS TO LOCATION FOR CHECKSUM BYTE 24019000 BOOLEAN RSLT; 24020000 24021000 CKSM:= OPKT; 24022000 THRU YOURNPAD DO REPLACE CKSM:CKSM BY CHAR(YOURPAD); 24023000 REPLACE CKSM:OPKT BY CHAR(MARK), KERCHAR(DATAL+3) 24024000 ,KERCHAR(SEQ.[5:6]); 24025000 ; 24026000 CASE PTYPE OF 24027000 BEGIN 24028000 (DATA_TYPE) : REPLACE CKSM:CKSM BY 7"D"; 24029000 (ACK_TYPE) : REPLACE CKSM:CKSM BY 7"Y"; 24030000 (NAK_TYPE) : REPLACE CKSM:CKSM BY 7"N"; 24031000 (S_TYPE) : REPLACE CKSM:CKSM BY 7"S"; 24032000 (F_TYPE) : REPLACE CKSM:CKSM BY 7"F"; 24033000 (Z_TYPE) : REPLACE CKSM:CKSM BY 7"Z"; 24034000 (B_TYPE) : REPLACE CKSM:CKSM BY 7"B"; 24035000 ELSE : REPLACE CKSM:CKSM BY 7"E"; 24036000 PTYPE:= ERR_TYPE 24037000 END; 24038000 REPLACE CKSM:CKSM BY FIRST_DATA FOR DATAL; 24039000 24040000 REPLACE CKSM BY KERCHAR(ACCUM_CHECKSUM(OPKT[1],DATAL+3)); 24041000 IF CKSM = 7" " THEN % THIS IS TROUBLESOME TO KERMIT ON THE ALTOS 24042000 BEGIN 24043000 REPLACE CKSM:=*+1 BY 7"X"; % MAKE IT SEE THE CHECKSUM 24044000 DATAL:=*+1 % AND BE SURE THE EXTRA CHAR IS SENT 24045000 END; 24046000 24047000 REPLACE CKSM+1 BY CHAR(YOUREOL); 24048000 24049000 REPLACE OPKT BY OPKT FOR DATAL:=*+6 WITH ASCIITOEBCDIC; 24050000 24051000 DEBUGARRAY (DATAL,OPKT,8"< OUT<",FALSE); 24052000 WHILE RMT.CENSUS > 0 DO % FLUSH EXTRA MSG 24053000 RSLT:= READ(RMT,0,PKT); 24054000 IF NOT RSLT THEN 24055000 IF NOT RSLT:= WRITE(RMT[STOP],DATAL,OPKT) THEN 24055250 IF PTYPE = ACK_TYPE THEN SEQ:=*+1; 24055500 PPUT:= IF RSLT THEN RSLT 24056000 ELSE IF PTYPE=ERR_TYPE THEN TRUE % REPORT TYPE ERROR 24057000 ELSE FALSE % OR OK 24058000 END P P U T ; 24059000 % SEND AN ERROR MESSAGE TO ABORT OTHER END WITH THIS DEFINE 25000000 POINTER PERREND; % POINT TO END OF ERROR MESSAGE 25001000 25002000 DEFINE ERROUT(MSG) = % NOTE: MSG IS AN ASCII STRING 25003000 BEGIN 25004000 REPLACE PERREND:FIRST_DATA BY MSG; 25005000 PPUT (ERR_TYPE,DELTA(FIRST_DATA,PERREND)) 25006000 END # 25007000 ; 25008000 25009000 25010000 25011000 25012000 REAL PROCEDURE GETPACKET(TL); 30000000 VALUE TL; 30000250 BOOLEAN TL; % TIMELIMIT -- TRUE IF A TIMELIMIT 30000500 COMMENT: 30001000 THE PURPOSE OF GETPACKET IS TO RETRIEVE THE NEXT VALID PACKET 30002000 FROM THE REMOTE COMPUTER. GETPACKET WILL NAK IMPROPERLY 30003000 FORMED PACKETS AND WILL NAK IN THE CASE OF A TIMEOUT. IF TOO 30004000 MANY NAKS ARE SENT (AS DEFINED BY RETRYLIMIT), GETPACKET WILL 30005000 ACT AS IF IT HAD JUST RECEIVED AN ERROR (ABORT) PACKET. AN 30006000 ERROR PACKET WILL ALSO BE REPORTED IN THE CASE OF AN IO ERROR 30007000 ON THE READ OF THE REMOTE FILE. 30008000 30009000 GETPACKET HANDLES CONTROL QUOTING. ANY CONTROL CHARACTERS IN 30010000 THE PACKET WHICH WERE QUOTED FOR TRANSFER THROUGH THE DATACOM 30011000 LINK WILL BE RESTORED. THE PACKET TYPE WILL BE CONVERTED TO 30012000 THE PACKET TYPE CODE AND RETURNED BY THE GETPACKET PROCEDURE. 30013000 THE DATA CONTAINED IN THE PACKET MAY BE ACCESSED STARTING AT 30014000 FIRST_DATA. THE DATA FROM AN AUTO_TYPE PACKET WILL START AT 30015000 COUNT_CHAR. THE COUNT OF NUMBER OF BYTES OF DATA WILL BE 30016000 FOUND IN PKL. 30017000 ; 30018000 BEGIN 30019000 REAL E % ERROR CODE RETURNED FROM PGET 30020000 , RETRY % COUNTDOWN OF RETIES LEFT BEFORE ABORT 30021000 ; 30022000 DEFINE DONE (RETURNV) = 30023000 BEGIN 30024000 E:= 0; % GET OUT OF THE NAK LOOP 30025000 GETPACKET:= RETURNV 30026000 END # 30027000 , ACK = 30028000 BEGIN 30028500 IF PPUT(ACK_TYPE,0) THEN DONE(ERR_TYPE) 30029000 END # 30030000 , NAK = 30032000 BEGIN 30033000 IF DECREMENTRETRY THEN % TOO MANY RETRIES 30034000 DONE(ERR_TYPE) 30035000 ELSE 30036000 IF PPUT(NAK_TYPE,0) THEN 30037000 DONE(ERR_TYPE) % UNSUCCESSFUL XMIT 30038000 %ELSE LOOP BACK FOR ANOTHER TRY 30039000 END # 30040000 ; 30041000 DEFINE % ASCII CHARACTER HEX EQUIVALENTS (CASE WON'T TAKE 7"X") 30042000 ASC_CHAR_B = 4"42" # 30043000 , ASC_CHAR_D = 4"44" # 30044000 , ASC_CHAR_F = 4"46" # 30045000 , ASC_CHAR_S = 4"53" # 30046000 , ASC_CHAR_Z = 4"5A" # 30047000 ; 30048000 BOOLEAN PROCEDURE DECREMENTRETRY; 30049000 BEGIN 30050000 POINTER P1; 30051000 IF RETRY:=*-1 < 0 THEN 30052000 BEGIN 30053000 ERROUT (7"TOO MANY UNSUCCESSFUL ATTEMPTS TO RECEIVE"); 30054000 DECREMENTRETRY:= TRUE; 30056000 END 30057000 END D E C R E M E N T R E T R Y ; 30058000 PROCEDURE UNQUOTE; 30059000 BEGIN 30060000 POINTER P1,P2; 30061000 REAL L; 30062000 30063000 L:= PKL; 30064000 P1:= P2:= FIRST_DATA; 30065000 30066000 WHILE L>0 DO 30067000 BEGIN 30068000 REPLACE P2:P2 BY P1:P1 FOR L:L UNTIL = YOURQUOTE; 30069000 IF L>0 THEN % FOUND A QUOTE 30070000 IF L=1 THEN % SHOULD NEVER BE 30071000 BEGIN 30072000 REPLACE P2:P2 BY P1:P1 FOR 1; 30073000 L:=*-1 30074000 END 30075000 ELSE 30076000 BEGIN 30077000 PKL:=*-1; % PACKET WILL BE SHORTER--NO MORE QUOTE 30078000 IF P1:=*+1 = CHAR(YOURQUOTE) THEN % QUOTE QUOTE % 30079000 REPLACE P2:P2 BY YOURQUOTE % = QUOTE % 30080000 ELSE REPLACE P2:P2 BY CTLCHAR(ORD(P1)); 30081000 P1:=*+1; % POINT PAST QUOTED CHAR 30082000 L:=*-2 30083000 END END 30084000 END U N Q U O T E ; 30085000 % GETPACKET STATEMENTS: 30086000 30087000 RETRY:= RETRYLIMIT; 30088000 30089000 DO 30090000 IF E:=PGET(TL) = 0 THEN % GOT A GOOD PACKET 30091000 IF MARK_CHAR = AUTORCV THEN % ALREADY NAKED AND DEQUOTED 30092000 GETPACKET:= AUTO_TYPE % BY THE NDL 30093000 ELSE % NORMAL PACKET-- WHAT DO WE DO WITH THIS KIND? 30094000 CASE ORD(TYPE_CHAR) OF 30095000 BEGIN 30096000 (ASC_CHAR_D) : UNQUOTE; 30097000 (ASC_CHAR_S) : GETPACKET:= S_TYPE; 30098000 (ASC_CHAR_F) : UNQUOTE; 30099000 GETPACKET:= F_TYPE; 30100000 (ASC_CHAR_Z) : ACK; 30101000 GETPACKET:= Z_TYPE; 30102000 (ASC_CHAR_B) : ACK; 30103000 GETPACKET:= B_TYPE; 30104000 ELSE: ACK; 30105000 GETPACKET:= ERR_TYPE 30106000 END CASE 30107000 ELSE % BAD PACKET OR NO PACKET AT ALL RECEIVED 30108000 CASE E-1 OF % WHAT KIND OF ERROR? 30109000 BEGIN 30110000 NAK; % TIMEOUT 30111000 DONE(ERR_TYPE); % EOF 30112000 DONE(ERR_TYPE); % OTHER IO ERROR 30113000 IF DECREMENTRETRY THEN DONE(ERR_TYPE); % NO MARK 30114000 NAK; % SHORT 30115000 NAK; % BAD CHECKSUM 30116000 NAK; % WE MISSED A PACKET 30117000 BEGIN % IT MISSED OUR ACK-- TRY ACKING AGAIN 30118000 SEQ:=*-1; 30119000 ACK 30120000 END; 30121000 NAK; % BAD SEQ 30122000 END 30123000 UNTIL E=0; 30124000 END G E T P A C K E T ; 30125000 BOOLEAN PROCEDURE PUTPACKET(PTYPE, DATAL); 35000000 COMMENT: 35001000 PUTPACKET ADDS ACKNOWLEDGEMENT TO THE SERVICES PROVIDED BY 35002000 PPUT. PUTPACKET WILL SEND THE PACKET REPEATEDLY UNTIL EITHER 35003000 AN ACK PACKET IS RECEIVED, AN IO ERROR OCCURS OR UNTIL THE 35004000 NUMBER OF RETRIES ATTEMPTED EQUAL THE VALUE IN RETRYLIMIT. 35005000 IF THE PACKET IS SUCCESSFULLY SENT AND ACKNOWLEDGED, PUTPACKET 35006000 RETURNS A VALUE OF FALSE. IF PUTPACKET FAILS IN ITS MISSION 35007000 IT RETURNS A TRUE VALUE AFTER ATTEMPTING TO NOTIFY THE REMOTE 35008000 COMPUTER THAT THIS PROGRA IS NOW ABORTING. 35009000 35010000 THE PARAMETERS TO PUTPACKET ARE THE SAME AS THOSE TO PPUT, AND 35011000 THE DATA IS NOT MODIFIED, MOVED, OR OTHERWISE CHANGED BEFORE 35012000 BEING SENT ON TO PPUT. 35013000 ; 35014000 VALUE PTYPE, DATAL; 35015000 REAL PTYPE % CODE FOR TYPE OF PACKET BEING SENT 35016000 , DATAL % NUMBER OF BYTES TO SEND 35017000 ; 35018000 BEGIN 35019000 REAL RETRY, GETCODE; 35020000 BOOLEAN RSLT; 35021000 35022000 PROCEDURE SENDFAILURENOTICE; 35023000 BEGIN 35024000 ERROUT (7"TOO MANY FAILED ATTEMPTS TO SEND A PACKET"); 35026000 PUTPACKET:= TRUE % LET CALLER KNOW OF OUR FAILURE 35029000 END; 35030000 DEFINE ABORT = % WHEN THINGS ARE TOO DISMAL 35031000 BEGIN 35032000 RETRY:= 0; 35033000 PUTPACKET:= TRUE; 35034000 PPUT(ERR_TYPE,0); % ATTEMPT TO LET REMOTE KNOW 35035000 END # 35036000 , TRYAGAIN = % GOT NAK OR EQUIVALENT 35037000 BEGIN 35038000 IF RETRY:=*-1 = 0 THEN SENDFAILURENOTICE 35039000 END # 35040000 ; 35041000 35042000 RETRY:= RETRYLIMIT; 35043000 WHILE RETRY > 0 DO 35044000 35045000 IF RSLT:= PPUT(PTYPE,DATAL) THEN % IO ERROR--FAILURE 35046000 BEGIN 35047000 RETRY:= 0; % LEAVE LOOP 35048000 PUTPACKET:= RSLT; % RETURN NOTICE OF OUR FAILURE 35049000 PPUT (ERR_TYPE,0); % MAKE A DOUBTFUL ATTEMPT TO NOTIFY THE 35050000 % REMOTE COMPUTER OF OUR FAILURE 35051000 END 35052000 ELSE % SENT PACKET OK--NOW GET ACKNOWLEDGMENT 35053000 35054000 CASE PGET(TRUE) OF 35055000 BEGIN 35056000 % GOT A GOOD PACKET -- IS IT AN ACK? 35057000 IF TYPE_CHAR=7"Y" THEN RETRY:=0 % SUCCESS !!! 35058000 ELSE 35059000 IF TYPE_CHAR=7"E" THEN % DISMAL FAILURE ON OTHER END 35060000 BEGIN 35061000 RETRY:= 0; 35062000 PUTPACKET:= TRUE % PASS ON OUR FAILURE 35063000 END 35064000 ELSE TRYAGAIN; % TREAT ANYTHING ELSE AS A NAK 35065000 35066000 % NOT A GOOD PACKET (IN VARIOUS FLAVORS): 35067000 TRYAGAIN; % TIMEOUT 35068000 ABORT; % EOF 35069000 ABORT; % IO ERROR 35070000 TRYAGAIN; % NOT A PACKET 35071000 TRYAGAIN; % SHORT 35072000 TRYAGAIN; % CHECKSUM ERROR 35073000 RETRY:=0; % IT'S ON NEXT PACKET--ASSUME ACK MISSED35074000 TRYAGAIN; % PRIOR PACKET NUMBER--MAY BE BAD NEWS 35075000 TRYAGAIN % BAD PACKET NUMBER 35076000 END CASE; 35077000 END P U T P A C K E T ; 35078000 PROCEDURE GETINIT; % EXTRACT INITIALIZATION VALUES FROM SEND-INIT 40000000 % PACKET OR FROM ACK OF OUR SEND-INIT 40001000 BEGIN 40002000 REAL CHARNBR; 40003000 POINTER PCH; % POINTER TO CURRENT CHAR 40004000 40005000 % ESTABLISH DEFAULTS: 40006000 YOURMAXBUFF:= MAXPACKET; 40007000 YOURQUOTE:= 7"#"; 40008000 YOUR8BIT:= 7"N"; 40009000 40010000 % NOW GET THE SPECIFIC VALUES FROM OTHER KERMIT 40011000 PCH:= FIRST_DATA; 40012000 WHILE PKL> 0 AND CHARNBR < 11 DO 40013000 BEGIN 40014000 IF PCH NEQ 7" " THEN 40016000 CASE CHARNBR OF 40017000 BEGIN 40018000 YOURMAXBUFF:= UNCHAR(PCH); % BUFSZ 40019000 IF YOURTIMOUT:= UNCHAR(PCH) = MYTIMOUT THEN % TIMOUT40020000 YOURTIMOUT:=*+ 1; % PREVENT CONTINUOUS COLLISIONS 40021000 YOURNPAD:= UNCHAR(PCH); % NPAD 40022000 YOURPAD:= CTL(ORD(PCH)); % PAD 40023000 YOUREOL:= UNCHAR(PCH); % EOL 40024000 YOURQUOTE:= ORD(PCH); % QUOTE 40025000 YOUR8BIT:= ORD(PCH); % 8 BIT QUOTE 40026000 ; % CHKTYPE 40027000 YOURREPEAT:= ORD(PCH); % REPEAT QUOTE 40028000 ;; % RESERVED 40029000 END; 40030000 PCH:=*+1; PKL:=*-1; 40030500 CHARNBR:=*+ 1 40031000 END; 40032000 IF DEBUGGING THEN WRITE(DEBUGFILE,*/,YOURMAXBUFF, YOURTIMOUT 40033000 ,YOURNPAD, YOURPAD 40034000 ,YOUREOL, YOURQUOTE, YOUR8BIT 40035000 ,YOURREPEAT 40036000 ); 40037000 40038000 % SET BIT IN CONTROL CHAR TRUTHSET FOR CONTROL QUOTE CHAR: 40039000 CTLCHARS[YOURQUOTE.[7:3]].[(31-YOURQUOTE.[4:5]):1]:= 1; 40040000 END G E T I N I T ; 40041000 REAL PROCEDURE SETINIT; % RETURNS COUNT OF CHARACTERS SET IN BUILD 42000000 BEGIN 42001000 REPLACE FIRST_DATA BY KERCHAR(94) % BLKSZ 42002000 ,KERCHAR(MYTIMOUT) % TIMOUT 42003000 ,KERCHAR(MYPAD) % NPAD 42004000 ,CTLCHAR(0) % PAD 42005000 ,KERCHAR(ASCIICRVAL) % EOL 42006000 ,7"#" % QUOTE 42007000 ,7" " % NO 8 BIT QUOTING 42008000 ,7"1" % CHKTYPE 42009000 ,7" " % REPEAT-- NOT YET IMPLEMENTD42010000 ; 42011000 SETINIT:=9 42012000 END S E T I N I T ; 42013000 BOOLEAN PROCEDURE SEND_DATA (MRSZ); 60000000 VALUE MRSZ; 60001000 REAL MRSZ; % MAXRECSIZE 60002000 BEGIN 60003000 EBCDIC ARRAY FREC [0:MRSZ+1]; 60004000 BOOLEAN RTN, DONE; % TEMP STORAGE FOR VALUE RETURNED, LOOP CONTROL 60005000 REAL SZ, SZ2; 60006000 POINTER P1,P2; 60007000 REAL I,J; 60008000 REAL FL,PL; % FILE AND PACKET CHARS LEFT 60009000 POINTER FP,PP; % FILE AND PACKET POINTERS 60010000 TRUTHSET NULLBLANK (48"00"" "); 60011000 DEFINE 60012000 YOURMAXDATA = YOURMAXBUFF - 5 # 60012500 , RESETPKT = % START BUILDING A NEW DATA PACKET 60013000 BEGIN 60014000 PP:= FIRST_DATA; 60015000 PL:= YOURMAXDATA 60016000 END # 60017000 , UNLOOP = 60018000 BEGIN 60019000 SEND_DATA:= DONE:= TRUE; 60020000 FL:= -1; % GET OUT OF LOOP 60021000 END # 60022000 , SENDIT = 60023000 IF PUTPACKET (DATA_TYPE,YOURMAXDATA-PL) THEN 60024000 UNLOOP 60025000 ELSE 60026000 RESETPKT # 60027000 , ERR(X) = 60028000 BEGIN 60029000 ERROUT(X); 60030000 UNLOOP 60031000 END # 60032000 ; 60033000 60034000 RESETPKT; % START A NEW DATA PACKET 60035000 60036000 DO 60037000 IF RTN:= READ(FYLE,MRSZ,FREC) THEN 60038000 IF RTN.[9:1] THEN % EOF: 60039000 BEGIN 60040000 SENDIT; % SEND ANYTHING LEFT IN BUFFER 60041000 DONE:= TRUE % AND EXIT LOOP 60042000 END 60043000 ELSE 60044000 ERR (7"IO ERROR ENCOUNTERED IN READ OF FILE") 60045000 ELSE 60046000 BEGIN 60047000 % REMOVE TRAILING BLANKS (AND NULLS FOLLOWING) 60048000 P2:= FREC; SZ2:= MRSZ; 60049000 DO % TRUNCATE TRAILING SPACES AND NULLS 60050000 BEGIN 60051000 SCAN P1:P2 FOR SZ:SZ2 UNTIL IN NULLBLANK; 60052000 SCAN P2:P1 FOR SZ2:SZ WHILE = 8" "; 60053000 SCAN P2:P2 FOR SZ2:SZ2 WHILE = 0; 60054000 END 60055000 UNTIL SZ2 = 0; 60056000 60057000 % COUNT WHAT REMAINS, CONVERT IT TO ASCII 60058000 % AND PLACE CRLF RECORD DELIMITER AT END 60059000 REPLACE FREC BY FREC FOR FL:= MRSZ-SZ WITH EBCDICTOASCII 60060000 , CHAR(ASCIICRVAL), CHAR(ASCIILFVAL); 60061000 FL:= *+2; % ADD CR AND LF TO COUNT 60062000 FP:= FREC; 60063000 60064000 % QUOTE CONTROL CHARACTERS, DIVIDE UP INTO PACKETS AND 60065000 % SEND OUT THE PACKETS: 60066000 WHILE FL > 0 DO % DON'T NEED NEW READ OF INPUT FILE 60067000 BEGIN 60068000 I := MIN(FL,PL); 60069000 REPLACE PP:PP BY FP:FP FOR J:I UNTIL IN CTLCHARS[0]; 60070000 FL:=*- (I-J); 60071000 PL:=*- (I-J); 60072000 60073000 IF J > 0 THEN % POINTING TO CTL CHAR--QUOTE IT 60074000 BEGIN 60075000 IF PL=1 THEN SENDIT % NO ROOM FOR IT 60076000 ELSE 60077000 BEGIN 60078000 IF FP=CHAR(YOURQUOTE) THEN 60079000 % REPRESENT QUOTE CHAR BY QUOTE QUOTE: 60080000 REPLACE PP:PP BY FP FOR 1, FP FOR 1 60081000 ELSE 60082000 REPLACE PP:PP BY CHAR(YOURQUOTE) 60083000 , CTLCHAR(ORD(FP)); 60084000 FP:=*+ 1; 60085000 FL:=*- 1; 60086000 PL:=*- 2; 60087000 END END; 60088000 60089000 IF PL = 0 THEN SENDIT % NEED TO SEND PACKET 60090000 END END 60091000 UNTIL DONE; 60092000 END SEND_DATA; 60093000 BOOLEAN PROCEDURE SEND_INIT; 65000000 BEGIN 65001000 REAL L,E; 65002000 POINTER P1; 65003000 BOOLEAN DONE; 65004000 65005000 DEFINE ABORT = 65006000 BEGIN 65007000 SEND_INIT:= TRUE; 65008000 E:= 0 65009000 END # 65010000 , SHUTDOWN = 65011000 BEGIN 65012000 ERROUT(7"IO ERROR"); 65013000 ABORT 65014000 END # 65015000 , TRYAGAIN = # 65016000 ; 65017000 65018000 SEQ:= 0; 65019000 65020000 DO % LOOP UNTIL SUCCESSFUL SEND AND ACK OR ABOSLUTE FAILURE 65021000 BEGIN 65022000 L:= SETINIT; 65023000 IF PPUT(S_TYPE,L) THEN % IO ERROR 65024000 SHUTDOWN 65025000 ELSE % SENT S PACKET--NOW GET ACK 65026000 CASE E:= PGET(TRUE) OF 65027000 BEGIN 65028000 IF TYPE_CHAR = 7"Y" THEN % GOT GOOD PKT--IS IT ACK? 65029000 GETINIT % YES ACK, GET SPECS 65030000 ELSE 65031000 IF TYPE_CHAR = 7"E" THEN ABORT % ERROR ON OTHER END 65032000 ELSE E:= 1; % ANYTHING ELSE SEEN AS NAK--TRY AGAIN 65033000 65034000 TRYAGAIN; % TIMEOUT 65035000 ABORT; % EOF 65036000 SHUTDOWN; % IO ERROR 65037000 TRYAGAIN; % NOT A PACKET 65038000 TRYAGAIN; % SHORT PACKET 65039000 TRYAGAIN; % CHECKSUM ERROR 65040000 SEQ:=*+ 1; % BAD SEQ: ADAPT TO IT AND TRY AGAIN 65041000 SEQ:=*- 1; % BAD SEQ: ADAPT TO IT AND TRY AGAIN 65042000 SEQ:=*+ 1 % BAD SEQ: TRY TO ADAPT 65043000 END END 65044000 UNTIL E = 0 65045000 END SEND_INIT; 65046000 PROCEDURE SEND; 69000000 BEGIN 69001000 POINTER P1; 69002000 69003000 YOUREOL:= ASCIICRVAL; % DEFAULT EOL CHAR 69004000 69005000 IF BOOLEAN(FYLE.AVAILABLE) THEN 69006000 IF NOT FYLE.ATTERR THEN % COMPATABLE ATTRIBUTES 69007000 IF FYLE.BLOCKSTRUCTURE = VALUE(FIXED) THEN 69008000 BEGIN 69009000 WRITE(RMT,<4"07">); % DEL -- LET 'EM KNOW WE'RE UP 69010000 WHEN(1); % ALLOW TIME FOR OTHER END TO GET READY 69010500 69010750 IF SEND_INIT THEN % COULD NOT INITIATE COMMUNICATIONS 69011000 ELSE 69012000 BEGIN 69013000 69014000 % SEND THE REMOTE FILE NAME BACK TO REMOTE SYSTEM 69015000 SCAN P1:P(INIT) UNTIL = 0; 69016000 REPLACE FIRST_DATA BY P(INIT) FOR OFFSET(P1)+1 69017000 WITH EBCDICTOASCII; 69018000 IF PUTPACKET (F_TYPE,OFFSET(P1)+1) THEN 69019000 % FAILED SEND 69019500 ELSE 69020000 69021000 % SEND CONTENTS OF FILE 69022000 IF SEND_DATA (IF FYLE.FRAMESIZE=48 THEN 69023000 6 * FYLE.MAXRECSIZE 69024000 ELSE FYLE.MAXRECSIZE 69025000 ) 69026000 THEN % COULD NOT SEND ENTIRE FILE 69027000 CLOSE(FYLE) 69028000 ELSE 69029000 BEGIN 69030000 CLOSE(FYLE); 69031000 IF PUTPACKET(Z_TYPE,0) THEN % SEND EOF 69032000 ELSE PUTPACKET (B_TYPE,0) % BREAK--DONE 69033000 END END END 69034000 ELSE WRITE(RMT,<"FILE STRUCTURE IS NOT READABLE BY KERMIT" 69035000 4"3D">) 69035500 ELSE % SYSTEM SHOULD HAVE SENT FILE ATTR ERR MSG 69036000 ELSE WRITE(RMT,<8"THE FILE YOU REQUESTED IS NOT AVAILABLE"4"3D">) 69037000 END SEND; 69038000 BOOLEAN PROCEDURE RCV_DATA(MINREC,MAXREC); 70000000 VALUE MINREC,MAXREC; 70001000 REAL MINREC,MAXREC; 70002000 BEGIN 70003000 REAL T,LI,L2,LO; % PACKET TYPE, CHARACTER COUNTS 70004000 POINTER PI,PO; % INPUT AND OUTPUT POINTERS 70005000 EBCDIC ARRAY OUTBUFF[0:MAXREC-1]; 70006000 DEFINE CR=47"0D"#, LF=47"0A"#; 70007000 TRUTHSET NEWLINE (CR OR LF); 70008000 70009000 DEFINE FORWARD(X)= 70010000 BEGIN 70011000 PI:=*+(X); 70012000 LI:=*-(X) 70013000 END # 70014000 , CLEAROUTBUFF = 70015000 BEGIN 70016000 LO:= 0; % NO CHARS IN BUFFER 70017000 REPLACE PO:= OUTBUFF BY 8" " FOR MAXREC 70018000 END # 70019000 ; 70020000 70021000 $SET OMIT= NDLSETUP 70021250 DEFINE INITAUTO= PPUT(ACK_TYPE,0) #; % NDL DOES NOT SUPPORT AUTO RCV70021500 $POP OMIT SET OMIT= NOT NDLSETUP 70021750 BOOLEAN PROCEDURE INITAUTO; % NDL SUPPORTS AUTO RECV 70022000 % % INITIATE NDL AUTOMATIC DATA PACKET RECEIVE 70023000 BEGIN 70024000 REPLACE PKT BY AUTORCV, KERCHAR(YOURNPAD),KERCHAR(YOURPAD) 70025000 , KERCHAR(0), KERCHAR(SEQ.[5:6]),8"D"; 70026000 INITAUTO:= WRITE(RMT[STOP],6,PKT); 70027000 DEBUGARRAY (6,PKT,8"AUTINT",TRUE); 70028000 END; 70029000 $POP OMIT 70029500 BOOLEAN PROCEDURE REINIT; % NDL DROPPED OUT OF AUTO RECEIVE 70030000 BEGIN 70031000 IF NOT INITAUTO THEN % SENT INIT TO NDL OK 70032000 BEGIN 70033000 REPLACE COUNT_CHAR BY FIRST_DATA FOR PKL; % LIKE AN AUTOPKT70034000 REINIT:= TRUE; % TRUE RESULT INDICATES SUCCESS 70035000 END 70036000 END REINIT; 70037000 70038000 % RCV_DATA STATEMENTS: 70039000 CLEAROUTBUFF; % PREPARE OUTPUT BUFFER AND POINTER 70040000 70041000 % PUT NDL INTO AUTO RECEIVE MODE: 70042000 IF INITAUTO THEN % FAILED 70043000 RCV_DATA:= TRUE % REPORT FAILURE TO RECEIVE FILE 70044000 ELSE 70045000 70046000 %LOOP FOR EVERY DATA PACKET 70047000 WHILE 70048000 IF LO > MAXREC THEN FALSE % ABORT EXIT 70049000 ELSE 70050000 IF BOOLEAN(T:= GETPACKET(FALSE)) THEN 70051000 FALSE % NOT DATA PACKET 70051500 ELSE % DATA PACKET--AUTO OR OTHERWISE 70052000 IF T = DATA_TYPE THEN 70053000 REINIT % GOOD PACKET--BUT ALSO RESTART NDL AUTO70054000 ELSE TRUE % GOOD AUTO PACKET--CONTINUE LOOPING 70055000 DO 70056000 BEGIN 70057000 PI:= COUNT_CHAR; % DATA PART OF PACKET STARTS HERE 70057250 LI:= PKL; % LENGTH OF DATA IN PACKET 70057500 70057750 % BREAK INTO LOGICAL RECORDS: 70058000 DO 70059000 BEGIN 70060000 SCAN PI FOR L2:LI UNTIL IN NEWLINE; 70061000 L2:= LI-L2; % # CHARS TO END OF LINE 70062000 LI:= *-L2; % # CHARS LEFT IN INPUT AFTER THIS LINE 70063000 IF LO:=*+L2 > MAXREC THEN % RECORD TOO LARGE 70064000 BEGIN 70065000 LI:=0; % SIMULATE END OF PACKET TO EXIT LOOP 70066000 ERROUT(7"RECORD TOO LONG TO FIT INTO FILE"); 70067000 RCV_DATA:= TRUE; % REPORT FAILURE TO CALLER 70068000 END 70069000 ELSE 70070000 BEGIN 70071000 REPLACE PO:PO BY PI:PI FOR L2 WITH ASCIITOEBCDIC; 70072000 IF LI > 0 THEN % STILL DATA CHARS IN PKT 70072500 IF PI IN NEWLINE THEN % END OF A RECORD 70073000 BEGIN 70074000 IF PI=CR THEN 70075000 IF CAND (LI>1, PI+1=LF) THEN 70075500 FORWARD(2) % CRLF 70076000 ELSE FORWARD(1) % CR 70077000 ELSE FORWARD(1); % LF 70078000 WRITE (FYLE,MAX(MINREC,LO),OUTBUFF); 70079000 70080000 CLEAROUTBUFF 70081000 END END END 70082000 UNTIL LI=0 % LOOP UNTIL END OF INPUT REC 70083000 END; % LOOP UNTIL ALL PACKETS HAVE BEEN RECEIVED 70084000 70085000 % CLOSE FILE...IF SUCCESSFULLY RECEIVED ENTIRE FILE THE FILE 70086000 % IS CLOSED WITH LOCK, OTHERWISE JUST RELEASED 70087000 IF T = Z_TYPE THEN % GOT EOF PACKET 70088000 LOCK(FYLE,CRUNCH) 70089000 ELSE 70089250 BEGIN 70089500 CLOSE(FYLE); 70090000 RCV_DATA:= T= ERR_TYPE % DO NOT WAIT FOR BREAK IF ERROR 70090250 END 70090500 END RCV_DATA; 70091000 BOOLEAN PROCEDURE RCV_INIT; 75000000 BEGIN 75001000 REAL E; % ERROR CODE FROM PGET 75002000 DEFINE TRYAGAIN = % E IS ALREADY NON-ZERO SO CONTINUE LOOP75003000 BEGIN 75004000 IF PPUT (NAK_TYPE,0) THEN ABORT 75005000 END # 75006000 , ABORT = 75007000 BEGIN 75008000 RCV_INIT:= TRUE; % NOTIFY CALLER OF FAILURE 75009000 E:= 0 % GET OUT OF LOOP 75010000 END # 75011000 , SHUTDOWN = 75012000 BEGIN 75013000 ERROUT(7"IO ERROR"); % TRY TO TELL REMOTE 75014000 ABORT % NOW GO AWAY 75015000 END # 75016000 , SYNC_SEQ = % GOT AN UNEXPECTED SEQ VALUE 75017000 BEGIN 75018000 SEQ:= ORD(SEQ_CHAR); % CHANGE OUR EXPECTATION 75019000 TRYAGAIN 75020000 END # 75021000 ; 75022000 75023000 DO % LOOP UNTIL AN S-PACKET IS RECEIVED 75024000 CASE E:= PGET(TRUE) OF 75025000 BEGIN 75026000 % A GOOD PACKET-- IS IT AN "S" PACKET? 75027000 IF TYPE_CHAR = 7"S" THEN 75028000 BEGIN 75029000 GETINIT; % EXTRACT S PACKET PARAMETERS 75030000 E:= SETINIT; % SET UP ACK PACKET PARAMETERS 75031000 IF PPUT(ACK_TYPE,E) THEN % AND SEND ACK 75032000 ABORT % FATAL IO ERROR 75033000 ELSE E:= 0 % SUCCESS -- GET OUT OF LOOP 75034000 END 75035000 ELSE 75036000 IF TYPE_CHAR = 7"E" THEN 75037000 ABORT % INDICATE FATAL ERROR--EXIT LOOP 75038000 ELSE % TREAT ANY OTHER PACKET AS A NAK 75039000 E:= 1; % AND LOOP BACK FOR MORE 75040000 75041000 % NO PACKET RECEIVED: 75042000 TRYAGAIN; % TIMEOUT 75043000 ABORT; % EOF 75044000 SHUTDOWN; % IO ERROR 75045000 TRYAGAIN; % NOT A PACKET 75046000 TRYAGAIN; % SHORT PACKET 75047000 TRYAGAIN; % CHECKSUM ERROR 75048000 SYNC_SEQ; % 75049000 SYNC_SEQ; % OUT OF SEQUENCE--RESET SEQ AND RETRY 75050000 SYNC_SEQ; % 75051000 END CASE 75052000 UNTIL E=0 75053000 END RCV_INIT; 75054000 PROCEDURE RECV; 79000000 BEGIN 79001000 % IF CAND(NOT FYLE.NEWFILE, FYLE.RESIDENT) THEN 79002000 % WRITE(RMT,<8"A FILE ALREADY EXISTS WITH THE SAME NAME AS " 79004000 % 8"THE FILE YOU WISHED TO CREATE" 4"3D">) 79005000 % ELSE 79006000 IF COR(FYLE.BLOCKSTRUCTURE=VALUE(FIXED) 79007000 ,FYLE.BLOCKSTRUCTURE=VALUE(EXTERNAL) AND 79008000 FYLE.KIND=VALUE(REMOTE) OR FYLE.KIND=VALUE(PRINTER) 79009000 OR FYLE.KIND=VALUE(TAPE) 79010000 ) 79011000 THEN % ACCEPTABLE BLOCK STRUCTURE 79012000 BEGIN 79013000 FYLE.OPEN:= TRUE; 79014000 WHEN(1); % ACCOMODATE POKEY APPLE 79014500 IF FYLE.ATTERR THEN % TELL OTHER END WE'VE FAILED 79015000 WRITE(RMT,<4"3D">) % BY SENDING A NAK 79016000 ELSE 79017000 BEGIN 79018000 WRITE(RMT,<4"07">); % DEL TO LET 'EM KNOW WE'RE READY 79019000 IF RCV_INIT THEN % UNABLE TO ESTABLISH 79020000 ELSE % KERMIT TALKING TO KERMIT OK 79021000 % GET AND IGNORE FILE ID PACKET 79022000 IF GETPACKET(TRUE) = F_TYPE THEN 79023000 BEGIN 79024000 79024250 % ACTUAL FILE TRANSFER: 79024500 IF NOT RCV_DATA 79025000 (IF FYLE.MINRECSIZE=0 THEN 79025050 FYLE.MAXRECSIZE 79025100 ELSE FYLE.MINRECSIZE 79025150 ,FYLE.MAXRECSIZE 79025200 ) 79025250 THEN 79025500 IF GETPACKET(TRUE) NEQ B_TYPE THEN 79026000 ERROUT(7"CAN ONLY RECEIVE ONE FILE") 79027000 END END END 79028000 ELSE WRITE(RMT,<8"ILLEGAL BLOCKSTRUCTURE"4"3D">) 79029000 END R E C V ; 79030000 % OUTER BLOCK STATEMENTS START HERE: 90000000 90002000 REPLACE P(CTLCHARS,0) BY 4"0000FFFFFFFF" FOR 1 WORDS, 0 FOR 2 WORDS 90003000 , 4"000000000001" FOR 1 WORDS 90004000 , P(CTLCHARS,0) FOR 4 WORDS 90005000 ; % SET UP DYNAMIC TRUTHSET--LATER ADD CTL QUOTE90006000 YOURTIMOUT:= MYTIMOUT+1; % THE TWO TIMEOUTS SHOULD BE DIFFERENT 90007000 MARK:=1; % MARK DEFAULTS TO ASCII SOH CHARACTER 90008000 DEBUGGING:= BOOLEAN(MYSELF.TASKVALUE); 90009000 90011000 IF FYLE.MYUSE = VALUE(IN) THEN SEND 90012000 ELSE RECV 90013000 END. 99999999