home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / maibasicfour / mbfshl.bas < prev   
BASIC Source File  |  2020-01-01  |  39KB  |  766 lines
  1. 0100 REM"-------------------------------------------------
  2. 0110 REM"  *  K E R M I T *        File Transfer Utility     MBFSHL.BAS
  3. 0120 REM" ===================                        
  4. 0130 REM"*  BASIC-BB86 Version for MAI Basic Four MPx Series 7000,8000,9000
  5. 0140 REM"*  E. Wastrodowski, Sphere Holdings Limited    88-04-01     V 1.0
  6. 0150 REM"*  The following program implements the Kermit file transfer 
  7. 0151 REM"*  protocol.  The protocol was designed at the Columbia University
  8. 0152 REM"*  Center for Computing Activities (CUCCA) in 1981-82 by Bill
  9. 0153 REM"*  Catchings and Frank da Cruz.
  10. 0154 REM"*    This particular implementation was developed at Sphere Holdings
  11. 0155 REM"*  Limited to run on the MAI Basic Four MPx series of minicomputers.
  12. 0156 REM"*  It implements the protocol as found in the KERMIT Protocol Manual
  13. 0157 REM"*  except for user interaction--a menu is used rather than commands.
  14. 0158 REM"*  Version 1.0 is designed to run as a 'remote' Kermit from the
  15. 0160 REM"*  listing of LUXKER.BAS provided on TAPE C by Columbia University.
  16. 0170 REM"*  It can be run in 'local' mode using the connect option.
  17. 0180 REM"*  It sends files as ASCII delimited with quotes, and commas for 
  18. 0190 REM"*  field separators. 
  19. 0200 REM"*  
  20. 0220 REM"*  Debug printout on LP
  21. 0230 REM"*
  22. 0240 REM"*  Basic dialect similar to Microsoft Basic
  23. 0260 REM"*  -------------------------------------------------
  24. 0280 MAXPACK=80,SOH=1,BRKCHR=192,MAXTRY=5000,MYQUOTE=ASCII("#"),MYPAD=0,MYCHA
  25. 0280:R=128,MYEOL=13,MYTIME=10;REM or is it 50
  26. 0290 MAXTIM=20,MINTIM=2,TRUE=-1,FALSE=0,FD=4,REMFD=1,SP=32,DEL=127,BRF=7,CTRC
  27. 0290:=193,EOL=13
  28. 0294 START0$="",END0$=""
  29. 0295 REM Baud rate cannot be set on MAI B4 hosts
  30. 0296 MYQUOTE$=CHAR(MYQUOTE)
  31. 0297 CLOSE(REMFD);OPEN(REMFD)"T*";PRINT(REMFD)'BO';HOST=TRUE;REM "In case the
  32. 0297:y don't go into connect
  33. 0300 DIM RECPKT$(80),PACKET$(80),INBUFF$(160),Q$(100),SP$(25),VERSION$(12)
  34. 0320 VERSION$="Version 1.0"
  35. 0340 IF TRUE<>TRUE GOTO 600 ELSE GOSUB 4080;ON F-1 GOTO 350,360,410,510,570;R
  36. 0340:EM was WHILE True ON FNHead
  37. 0350 GOSUB 3550;GOTO 330;REM was H=FNConnect; GOTO 330; ! Dumb terminal until
  38. 0350: PF1
  39. 0360 REM-----------Receive files from remote--------------
  40. 0370 GOSUB 2700; IF RETURN0<>FALSE PRINT @(0,15),"ok",SP$ ELSE PRINT @(0,15),
  41. 0370:"Received failed ",SP$;REM "was if FNRecsw..
  42. 0380 IF DEBUG0=TRUE IF RETURN0<>FALSE PRINT(17)"OK",SP$ ELSE PRINT (17)"Recei
  43. 0380:ved failed ",SP$;REM "was IF FNRecsw....
  44. 0390 INPUT "<Push any key to continue> ",'CI',*
  45. 0400 GOTO 590
  46. 0410 REM"------------Send file to remote------------
  47. 0420 RSW=0;GOSUB 3820;IF NFILE<=0 GOTO 590;REM was NFILES=FNFiles(0);IF NFILE
  48. 0420:S<=0 GOTO 590
  49. 0425 IF HOST=TRUE PRINT @(0,15),"Now return to local task to receive files ",
  50. 0425:IFILE$,
  51. 0430 IFILE=1
  52. 0434 IF POS(","=IFILE$)=0 IFILE$=IFILE$+","
  53. 0435 K=POS(","=IFILE$)
  54. 0440 FILNAM$=IFILE$(1,K-1),IFILE$=IFILE$(K+1)
  55. 0450 GOSUB 1560;IF SENDSW=TRUE PRINT @(0,15),"OK",SP$ ELSE PRINT @(0,15)," Se
  56. 0450:nd failed",SP$;REM was IF FNSendsw ; CUR(15,0) 'OK' Sp$; ELSE ; CUR(15,0
  57. 0450:) ' Send failed' Sp$
  58. 0460 INPUT "<Push any key to continue> ",'CI',*
  59. 0470 GOTO 590
  60. 0500 REM"-------- Set debug mode on/off each time ----------
  61. 0510 IF DEBUG0=TRUE DEBUG0=FALSE;CLOSE(17) ELSE DEBUG0=TRUE;OPEN(17)"LP";REM 
  62. 0510:OPEN "pr:" AS FILE 17
  63. 0520 IF DEBUG0=TRUE PRINT @(0,12),"D e b u g  m o d e" ELSE PRINT @(0,12),"N 
  64. 0520:o t  d e b u g   m o d e"
  65. 0530 IF DEBUG0=TRUE PRINT (17)"D e b u g  m o d e"
  66. 0540 GOSUB 4590;REM H=FN(DELAY)
  67. 0550 GOTO 590
  68. 0560 REM"--------End of Kermit Session --------------
  69. 0570 PRINT @(15,20),"E N D  of  K E R M I T  session"
  70. 0580 INPUT "CR to do again, CTL IV to quit ",'CI',*;IF CTL>1 RELEASE
  71. 0590 GOTO 340;REM WEND
  72. 0600 STOP
  73. 0610 REM---------------------------------------------
  74. 0620 REM*    Kermit subroutines, standard from UNIX
  75. 0630 REM---------------------------------------------
  76. 0640 REM* FNSpar$ = spar(data)
  77. 0650 REM send my parameters to other end
  78. 0660 REM---------------------------------------------
  79. 0665 REM"DEF FNSpar$=chr$(Maxpack+32,Mytime+32,Mypad+32,Mypchar XOR 64,Myeol+
  80. 0665:32,Myquote)
  81. 0670 DEF FNSPAR$(Z$)=CHAR$(MAXPACK+32)+CHAR(MYTIME+32)+CHAR(MYPAD+32)+XOR(CHA
  82. 0670:R(MYPCHAR),CHAR(64))+CHAR(MYEOL+32)+CHAR(MYQUOTE)
  83. 0680 REM-------------------------------------------
  84. 0690 REM*  FNRpar = rpar  from 1890,2930
  85. 0700 REM* Unpack data from other end
  86. 0710 REM------------------------------------------
  87. 0720 REM DEF FNRpar(S$) LOCAL Pp,Ss$=6
  88. 0730 SPSIZ=ASCII(S$)-32,TIMINT=ASCII(S$(2))-32
  89. 0740 PAD=ASCII(S$(3))-32,PADCHAR=ASCII(S$(4)),PADCHAR$=XOR(S$(4,1),CHAR(64)),
  90. 0740:PADCHAR=ASC(PADCHAR$)
  91. 0750 EOL=ASCII(S$(5))-32,QUOTE=ASCII(S$(6))
  92. 0760 RETURN
  93. 0765 MAXPACK=SPSIZ,MYTIME=TIMINT,MYPAD=PAD,MYPCHAR=PADCHAR,MYEOL=EOL,MYQUOTE=
  94. 0765:QUOTE
  95. 0766 C$=FNSPAR$(Z$)+"&1~,?"
  96. 0767 ESCAPE
  97. 0770 REM "FNEND
  98. 0780 REM-----------------------
  99. 0790 REM"*  FNBufemp (buf,fd,len)
  100. 0800 REM"* unpack a packet to file
  101. 0810 REM"* Buf   Packet bufer pointer, VARPTR (BUF$)
  102. 0820 REM"* fd    file number
  103. 0830 REM"*lgd    Packet Length (redundant, only for compatiblity)
  104. 0840 REM"________________________
  105. 0850 REM DEF FNBufemp(Buf,Fd,Lgd) LOCAL I,T,Pp
  106. 0860 I=1,PP=BUF,DUMMY$="";FOR PP=1 TO LEN(BUF$)
  107. 0865 LGD=LEN(BUF$)
  108. 0869 REM"was 870 WHILE I<=Lgd : T=PEEK(Pp) : IF T=Myquote GOSUB 900 ELSE ; #F
  109. 0869:d CHR$(T); : Krad=Krad+1
  110. 0870 IF I>LGD ESCAPE ELSE T$=BUF$(PP,1); IF T$=MYQUOTE$ GOSUB 900 ELSE IF T$=
  111. 0870:CHAR(EOL) OR T$=CHAR(10) WRITERECORD(FD)PEEK$;PEEK$="" ELSE PEEK$=PEEK$+
  112. 0870:T$;KRAD=KRAD+1
  113. 0880 I=I+1;NEXT PP;REM WEND
  114. 0881 RETURN; REM remember to empty peek$ with the last eof
  115. 0885 WRITERECORD(FD)PEEK$
  116. 0890 RETURN;REM RETURN Lgd
  117. 0900 REM Unquote function
  118. 0910 I=I+1,PP=PP+1,T$=BUF$(PP,1)
  119. 0920 IF T$=MYQUOTE$ PEEK$=PEEK$+T$;KRAD=KRAD+1;RETURN;REM ## = # was IF T=Myq
  120. 0920:uote ; #Fd CHR$(T); : Krad=Krad+1 : RETURN ! ## = #
  121. 0930 T$=XOR(T$,CHAR(64));IF ASCII(T$)=MYEOL KRAD=0;REM End-ofline was  T=T XO
  122. 0930:R 64 : IF T=Myeol Krad=0 ! End-of-line
  123. 0940 IF ASCII(T$)=9 PEEK$=PEEK$+SP$(8*((KRAD+8)/8)-KRAD);KRAD=8*((KRAD+8)/8);
  124. 0940:RETURN;REM HT--was IF T=9 : #Fd SPACE$(8*((Krad+8)/8)-Krad); : Krad=8*(K
  125. 0940:rad+8)/8) : RETURN ! HT horizontal tab
  126. 0950 PEEK$=PEEK$+T$; RETURN
  127. 0960 REM FNEND
  128. 0970 REM--------------------------
  129. 0980 REM * BUF$=Fnbufill$
  130. 0990 REM* Fill buffer, return size
  131. 1000 REM"------------------------------------
  132. 1005 REM From 2080,2250--get data from file I guess
  133. 1010 REM DEF FNBufill$ LOCAL B$=90,I,T
  134. 1020 B$="";REM B$=''
  135. 1030 IF TRUE=0 GOTO 1100; REM was WHILE True
  136. 1035 IF INBUFF$>"" GOTO 1050;REM left overs from last send
  137. 1036 IF IFILE=1 IF END0$>"" K2$=KEY(2,END=1090); IF K2$(1,LEN(END0$))>END0$ G
  138. 1036:OTO 1090
  139. 1040 READRECORD(2,END=1090)INBUFF$;IF LEN(INBUFF$)=0 OR POS($00$<INBUFF$)=0 G
  140. 1040:OTO 1090;REM was IF LEN(Inbuff$)=0 ON ERROR GOTO 1090 : INPUT LINE #2,In
  141. 1040:buff$
  142. 1042 Y=POS($8A$=INBUFF$);IF Y>0 INBUFF$=INBUFF$(1,Y-1)+""","""+INBUFF$(Y+1); 
  143. 1042:GOTO 1042
  144. 1044 Y=1
  145. 1045 X=POS($00$=INBUFF$(Y));IF X>0 Y=Y+X
  146. 1047 IF POS($00$<INBUFF$(Y))=0 INBUFF$=INBUFF$(1,Y-1) ELSE Y=Y+POS($00$<INBUF
  147. 1047:F$(Y)); GOTO 1045
  148. 1048 IF INBUFF$(LEN(INBUFF$))=$00$ INBUFF$=INBUFF$(1,LEN(INBUFF$)-1) FI; INBU
  149. 1048:FF$=""""+INBUFF$(1,LEN(INBUFF$)-1)
  150. 1049 INBUFF$=INBUFF$+CHAR(13)+CHAR(10); REM "add CR + LF to end of the data
  151. 1050 T=ASCII(INBUFF$(1,1));REM was =ASCII(AND(INBUFF$(1,1),CHAR(127)));REM T=
  152. 1050:ASCII(Inbuff$) AND 127
  153. 1060 IF T<SP OR T=MYQUOTE OR T=DEL IF LEN(B$)>SPSIZ-9 RETURN ELSE GOSUB 4400;
  154. 1060:B$=B$+RETURN0$ FI ELSE B$=B$+CHAR$(T);REM RETURN B$
  155. 1070 INBUFF$=INBUFF$(2); IF LEN(B$)>=SPSIZ-8 RETURN;REM was Inbuff$=RIGHT$(In
  156. 1070:buff$,2) : if LEN(B$)>=Ssiz-8 RETURN B$
  157. 1080 GOTO 1030; REM "WEND
  158. 1090 REM "RESUME
  159. 1100 RETURN;REM return b$
  160. 1110 REM"FNEND
  161. 1120 REM-------------------------
  162. 1130 REM* FNSpack(type,num,length,data$) from 1820,2030,2370,2610,2940,3080, 
  163. 1130:            3130,3210,3250,3390
  164. 1140 REM* Send packet to other end - call by name!
  165. 1150 REM--------------------------
  166. 1160 REM DEF FNSpack(Type,Num,Length,Data$) LOCAL Chksum,Buffer$=90,I
  167. 1170 DIM BUFFER$(PAD,PADCHAR$);BUFFER$=BUFFER$+CHAR(SOH)+CHAR(LENGTH+35)+CHAR
  168. 1170:(NUM0+32)+CHAR(TYPE)+DATA$
  169. 1175 GOTO 1197; REM"I don't think the proper check sum is calculated original
  170. 1175:ly? in Protocol manual section 6.1 pp23,24 it appears to include the toc
  171. 1175:har() function in the calculation of the arithmetic sum, which means tha
  172. 1175:t the +32 is included!  on pp 40 it says that the "/" signifies integer 
  173. 1175:division
  174. 1176 REM"amazing see 1390-  was this program inconsisent or what?
  175. 1180 CHKSUM=LENGTH+NUM0+TYPE
  176. 1185 I=1
  177. 1190  IF I<=LENGTH CHKSUM=CHKSUM+ASCII(DATA$(I));I=I+1; GOTO 1190;REM was WHI
  178. 1190:LE I<=Length : Chksum=Chksum+ASCII(MID$(Data$,I,1)) : I=I+1 : WEND
  179. 1195 X=INT(CHKSUM/256);E1$=BIN(CHKSUM,X+1);DIM Y$(X+1,$C0$);E1$=AND(E1$,Y$),E
  180. 1195:1=INT(DEC(E1$)/64)+CHKSUM,X=INT(CHKSUM/256),E2$=BIN(CHKSUM,X+1);DIM Y$(X
  181. 1195:+1,$3F$);E2$=AND(E2$,Y$),CHKSUM=DEC(E2$)
  182. 1196 ESCAPE
  183. 1197 CHKSUM=0; FOR I=2+PAD TO LEN(BUFFER$); CHKSUM=CHKSUM+ASCII(BUFFER$(I));N
  184. 1197:EXT I
  185. 1198 E1$=BIN(CHKSUM,2),E1$=AND(E1$,$C0C0$),E1=DEC(E1$)/64,CHKSUM=MOD(CHKSUM+E
  186. 1198:1,64)           
  187. 1200 REM" Chksum=(Chksum+(Chksum AND 192)/64) AND 63
  188. 1210 BUFFER$=BUFFER$+CHAR(CHKSUM+32)+CHAR(EOL)+CHAR(10);REM was Buffer$=Buffe
  189. 1210:r$+CHR$(Chksum+32,Eol,10),CHR$(10)=$8A$=newline?
  190. 1220 PRINT (REMFD,TBL=9950)BUFFER$; IF HOST=FALSE PRINT @(0,15),"Send packet 
  191. 1220:",N," ",CHAR(TYPE)," ",NUMTRY,"  ",
  192. 1230 IF DEBUG0=TRUE PRINT (17)"Send packet ",N," ",CHAR(TYPE)," ",NUMTRY
  193. 1240 IF DEBUG0=TRUE PRINT(17)BUFFER$
  194. 1250 H=LEN(BUFFER$); RETURN; REM RETURN LEN(Buffer$)
  195. 1260 REM FNEND
  196. 1270 REM-------------------------------------
  197. 1280 REM * FNRpack(&len,&num,&data$) - return type--from 1830,2040,2200,2390,
  198. 1280:2620,2900,3030,3340
  199. 1290 REM* Receive packet - store into data$ unpdate varoot
  200. 1300 REM* Store len, num via pointers, return type
  201. 1310 REM------------------------------------
  202. 1320 REM DEF FNRpack(Length,Num,Datax) LOCAL T,Chksum,L,Pdata,Done,Type
  203. 1330 REM gosub 4470 ! RETURN FNQrpack(Length,Num,Datax)
  204. 1340 IF TIMINT>MAXTIM OR TIMINT<MINTIM THEN TIMINT=MYTIME
  205. 1345 T=0,TYPE=FALSE
  206. 1346 GOSUB 4000;REM"GO GET A PACKET FROM REMFD
  207. 1347 IF T<0 RETURN0=FALSE;GOTO 1345;REM was RETURN
  208. 1348 IF DUMMY$="" GOTO 1345 ELSE FOR PP=1 TO LEN(DUMMY$); T=ASCII(DUMMY$(PP,1
  209. 1348:))
  210. 1349 REM"find Soh in the buffer
  211. 1350 IF T=SOH EXITTO 1360 ELSE NEXT PP;RETURN0=FALSE;IF HOST=FALSE INPUT "ABO
  212. 1350:UT TO ABORT @1350-NO SOH FOUND! ",'CI','RB',* FI;RETURN ;REM was T=0 : W
  213. 1350:HILE T><Soh: T=FNGetch : IF T<0 RETURN False
  214. 1360 REM WEND : Done=False
  215. 1370 REM" was "WHILE Done=False why i don't know. yes i do, it finds the last
  216. 1370: packet in the input buffer and uses that one, ignoring all the rest!
  217. 1375 PP=PP+1
  218. 1380 T=ASCII(DUMMY$(PP,1)); IF T<0 RETURN0=FALSE;RETURN ELSE IF T=SOH GOTO 14
  219. 1380:60;REM was T=FNGetch ...
  220. 1388 IF DEBUG0=TRUE X$="LENGTH+32";PRINT(17)IOL=7717
  221. 1389 REM"amazing..here we start the chksum including the +35 on the length
  222. 1390 CHKSUM=T;L=T-35;LENGTH=L,PP=PP+1,T=ASCII(DUMMY$(PP,1)); IF T<0 RETURN0=F
  223. 1390:ALSE;IF HOST=FALSE INPUT"ABOUT TO ABORT @1390 ",'CI','RB',* FI;RETURN EL
  224. 1390:SE IF T=SOH GOTO 1460 REM was Chksum=Chksum+T : L=T-35 : POKE Length,L,S
  225. 1390:WAP%(L) : T=FNGetch ...
  226. 1398 IF DEBUG0=TRUE X$="SEQ.NUMBER+32";PRINT(17)IOL=7717
  227. 1399 REM" and now the sequence number field--also a +32 here
  228. 1400 CHKSUM=CHKSUM+T,NUM0=T-32,PP=PP+1,T=ASCII(DUMMY$(PP,1));IF T<0 X=1400;GO
  229. 1400:TO 1551 ELSE IF T=SOH GOTO 1460;REM was Chksum=Chksum+T : POKE Num,T-32,
  230. 1400:0 : T=FNGetch ...
  231. 1408 IF DEBUG0=TRUE X$="TYPE FIELD";PRINT(17)IOL=7717
  232. 1409 REM" and now the type field--no +32 here tho
  233. 1410 CHKSUM=CHKSUM+T,TYPE=T,DATA$="",DATA$=DUMMY$(PP+1,L);REM was ...Pp=PEEK2
  234. 1410:(Datax+2) : POKE Datax+4,0,0 ! VAROOT=maxsiz,pointer,len
  235. 1415 I=0
  236. 1420 IF I>=L GOTO 1431 ELSE PP=PP+1,T=ASCII(DUMMY$(PP,1));IF T<0 X=1420;GOTO 
  237. 1420:1551 ELSE IF T=SOH GOTO 1460; REM was I=0 : WHILE I<L : T=FNGetch ...
  238. 1428 IF DEBUG0=TRUE X$="DATA    ";PRINT (17)IOL=7717
  239. 1430 CHKSUM=CHKSUM+T,I=I+1; GOTO 1420; REM was .. POKE Pp,T : Pp=Pp+1 : I=I+1
  240. 1430: : WEND
  241. 1439 REM"and now for the check character at the end, also including the +32
  242. 1440 PP=PP+1,T=ASCII(DUMMY$(PP));IF T<0 X=1440;GOTO 1551 ELSE IF T=SOH GOTO 1
  243. 1440:460;REM was T=FNGetch :..
  244. 1448 IF DEBUG0=TRUE X$="CHECK ";PRINT (17)IOL=7717
  245. 1450 DONE=TRUE
  246. 1460 IF DONE<>TRUE GOTO 1370; REM WEND
  247. 1464 E1$=BIN(CHKSUM,2),E1$=AND(E1$,$C0C0$),E1=DEC(E1$)/64,CHKSUM=MOD(CHKSUM+E
  248. 1464:1,64); GOTO 1470
  249. 1465 E1$=AND(CHAR(CHKSUM),CHAR(192)),E1=ASCII(E1$)/64+CHKSUM,E2$=AND(CHAR(E1)
  250. 1465:,CHAR(63)),CHKSUM=ASCII(E2$); REM this one doesn't work! error 41
  251. 1468 ESCAPE
  252. 1469 E1=E1+CHKSUM,CHKSUM=MOD(E1,64);REM" Assuming that the AND 192 is a modul
  253. 1469:o -- see 2080,2440
  254. 1470 REM "Chksum=(Chksum+(Chksum AND 192)/64) AND 63--the char of 192 yields 
  255. 1470:$40$ and the chr(192) is $C0$--kodak says to use $C0$--the char of 64 yi
  256. 1470:elds $C0$, the chr(64) is $40$--kodak says to use $40$--so the 192 and t
  257. 1470:he 64 are interrelated in high/low order bits!  What is integer division
  258. 1470: by 64?--the anding function  AND($01$,$10$) is $00$..so a 1 AND 0 is 0
  259. 1480 IF CHKSUM><T-32 IF DEBUG0=TRUE X$="NOT MATCHED";PRINT(17)IOL=7717 ELSE R
  260. 1480:ETURN0=FALSE;RETURN
  261. 1490 IF HOST=FALSE PRINT @(40,15)," Receive packet ",NUM0," ",N," ",CHAR(TYPE
  262. 1490:)," ",L," ",;REM was PEEK2(Num)...
  263. 1500 IF DEBUG0=TRUE PRINT(17)" Receive packet ",NUM0," ",N," ",CHAR(TYPE)," L
  264. 1500:en=",L;REM was PEEK2(Num)
  265. 1510 IF DEBUG0=FALSE RETURN0=TYPE;RETURN; REM was POKE Datax+4,L,0 : IF NOT D
  266. 1510:ebug RETURN type
  267. 1520 REM"POKE VAROOT(Q$)+2,PEEK(Datax+2),PEEK(Datax+3),PEEK(Datax+4),PEEK(Dat
  268. 1520:ax+5)
  269. 1530 PRINT(17)DATA$;REM was ; #17 CHR$(L+35,PEEK(Num)+32)+Q$+CHR$(T+32)
  270. 1540 RETURN0=TYPE
  271. 1550 RETURN;REM"FNEND
  272. 1551 IF HOST=FALSE PRINT "ABORT FROM ",X," ",;INPUT'RB','CI',*
  273. 1555 RETURN0=FALSE;RETURN
  274. 1560 REM------------------------------------------ from 450
  275. 1570 REM  * FNSendsw                                          Send Supervisor
  276. 1580 REM-----------------------------------------
  277. 1590 REM"DEF FNSendsw --- function def  return value in sendsw
  278. 1595 STATE=ASCII("S"),N=0,NUMTRY=0
  279. 1600 IF TRUE=0 GOTO 1701;REM was WHILE True
  280. 1609 REM"ON INSTR(1,'DFZSBCA',CHR$(State))+1 GOTO 1620,1630,1640,1650,1660,16
  281. 1609:70,1680,1690
  282. 1610 ON POS(CHAR(STATE)="DFZSBCA") GOTO 1620,1630,1640,1650,1660,1670,1680,16
  283. 1610:90
  284. 1611 REM                                       D    F    Z    S    B    C   A
  285. 1620 SENDSW=FALSE; GOTO 1710;REM "was RETURN false ! unknown state - fail
  286. 1630 GOSUB 2140;GOTO 1700;REM was STATE=FNSdata ; GOTO 1600  ! "Data-Send sta
  287. 1630:te^^
  288. 1640 GOSUB 1960;GOTO 1700 REM was STATE=FNSfile; GOTO 1600 ! REM File-Send st
  289. 1640:ate
  290. 1650 GOSUB 2300; GOTO 1700;REM was State=FNSeof ;GOTO 1600;REM"End-of-file
  291. 1660 GOSUB 1720;GOTO 1700;REM"State=FNSinit gosub to SEND-INIT @ 1720 output 
  292. 1660:into state variable via RETURN ASCII('A'),etc!
  293. 1670 GOSUB 2540;GOTO 1700;REM was State=FNSbreak; GOTO 1610;REM"Break-send
  294. 1680 SENDSW=TRUE;GOTO 1710 REM"was RETURN True ! Complete 
  295. 1690 SENDSW=FALSE;GOTO 1710 REM"was RETURN False ! Abort
  296. 1700 GOTO 1600;REM"WEND
  297. 1710 RETURN;REM "FNEND
  298. 1720 REM----------------------------------
  299. 1730 REM  fnsinit  -  Send initiate    from 1660
  300. 1740 REM Send my paramters, get other side's back
  301. 1750 REM---------------------------------------
  302. 1760 REM DEF FNSinit LOCAL Num,Length,Type
  303. 1770 IF DEBUG0=TRUE PRINT @(0,14),"Sinit                                     
  304. 1770:    "
  305. 1780 IF NUMTRY>MAXTRY STATE=ASCII("A");RETURN;REM Too many retries, give  up
  306. 1790 NUMTRY=NUMTRY+1
  307. 1800 PACKET$=FNSPAR$(Z$)+"&1~,?"; REM was Packet$=FNSpar$ 
  308. 1810 IF DEBUG0=TRUE PRINT (17)"Packet # ",N
  309. 1820 TYPE=ASCII("S"),NUM0=N,LENGTH=LEN(PACKET$),DATA$=PACKET$;GOSUB 11030; RE
  310. 1820:M"H=FNSpack(ASCII('S'),N,6,Packet$) ! Send an S-packet
  311. 1830 GOSUB 1280;REM Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 
  312. 1830:! What was the reply?
  313. 1840 IF TYPE=ASCII("N") RETURN;REM state ! Nak
  314. 1850 IF TYPE=0 RETURN;REM State ! Receive failure, stay in S
  315. 1860 IF TYPE><ASCII("Y") STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 1860-w
  316. 1860:rong packet type",'CI','RB',* FI;RETURN;REM Somthin bad - abort
  317. 1870 REM Type = 'Y'
  318. 1880 IF N<>NUM0 RETURN;REM State ! Wrong ACK stay S
  319. 1890 S$=DATA$;GOSUB 680;REM H=FNRpar(Recpkt$) ! Get other side's info
  320. 1900 IF EOL=0 EOL=13; REM "Check and set defaults
  321. 1910 IF QUOTE=0 QUOTE=ASCII("#");REM"conrol prefix quote
  322. 1920 NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63)));IF DEBUG0=TRUE PRINT(17)"Openi
  323. 1920:ng ",FILNAM$;REM"Open file to be sent; was I+1?
  324. 1930 CLOSE(2); OPEN(2)FILNAM$;IF HOST=FALSE PRINT @(0,14),"Sending ",FILNAM$,
  325. 1930:"                                   ";REM "OPEN Filnam$ AS FILE 2
  326. 1940 STATE=ASCII("F");RETURN;REM Switch state to F
  327. 1950 REM FNEND
  328. 1960 REM------------------------------------------------
  329. 1970 REM FNSfile              Send file header  from 1640
  330. 1980 REM-----------------------------------------------
  331. 1990 REM DEF FNSfile LOCAL Num,Length,H,Type
  332. 2000 IF DEBUG0=TRUE PRINT(17)" Sfile"
  333. 2010 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2010 too 
  334. 2010:many tries ",'CI','RB',* FI;RETURN;REM"Too many Retries, give up
  335. 2020 NUMTRY=NUMTRY+1
  336. 2030 LENGTH=LEN(FILNAM$),DATA$=FILNAM$,NUM0=N,TYPE=ASCII("F");GOSUB 11030 ;RE
  337. 2030:M H=FNSpack(ASCII('F'),N,Length,Filnam$) ! Send an F Packet
  338. 2040 GOSUB 1280;REM type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 
  339. 2040:! What was the reply?
  340. 2049 REM"ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 goto 2110,2080,2070,2100
  341. 2050 ON POS(CHAR(TYPE)="NY"+CHAR(0)) GOTO 2110,2060,2070,2100
  342. 2051 REM                                        N    Y    0
  343. 2060 NUM0=ASCII(AND(CHAR(NUM0-1),CHAR(63)));IF N<>NUM0 RETURN;REM State ! NAK
  344. 2060: Stay in state
  345. 2065 REM"else they are NAKing the next one, well by golly, we better send it
  346. 2070 IF N<>NUM0 RETURN;REM State ! Wrong ACK - stay in F state
  347. 2075 IF IFILE=1 IF START0$>"" READ(2,KEY=START0$,DOM=2076)
  348. 2080 NUMTRY=0,N=MOD(N+1,64);GOSUB 1000;PACKET$=B$,SIZE=LEN(PACKET$);IF SIZE=0
  349. 2080: STATE=ASCII("Z");RETURN
  350. 2090 STATE=ASCII("D");RETURN;REM"Switch state to D
  351. 2100 RETURN;REM"State ! Receive failure - stay in F
  352. 2110 STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2110 wrong packet ",'CI','
  353. 2110:RB',* FI;RETURN;REM Something else, just abort
  354. 2120 RETURN;REM FNEND; i think it will have to be gosubs
  355. 2130 REM----------------------------------------
  356. 2140 REM  FNSdata  -  Send Data File   from 1630
  357. 2150 REM---------------------------------------
  358. 2160 REM DEF FNSdata LOCAL Num,Length,H
  359. 2170 IF NUMTRY>MAXTRY STATE=ASCII("A");RETURN;REM Too many tries - give up
  360. 2180 NUMTRY=NUMTRY+1
  361. 2190 TYPE=ASCII("D"),NUM0=N,LENGTH=LEN(PACKET$),DATA$=PACKET$;GOSUB 1130;REM 
  362. 2190:H=FNSpack(ASCII("D"),N,SIZE,PACKET$) ! Send a D packet
  363. 2200 GOSUB 1280;REM Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 
  364. 2200:! What was the reply?
  365. 2209 REM"ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 goto 2280,2220,2230,2270
  366. 2210 ON POS(CHAR$(TYPE)="NY"+CHAR(0)) GOTO 2280,2220,2230,2270
  367. 2211 REM                                         N   Y   0
  368. 2220 NUM0=ASCII(AND(CHAR(NUM0-1),CHAR(63))); IF N><NUM0 RETURN;REM State ! un
  369. 2220:less Nak for next packet
  370. 2225 REM else they are NAKing the next one, well by golly, send it!
  371. 2230 IF N<>NUM0 RETURN;REM State ! Wrong ACK - stay in D state
  372. 2240 OLDTRY=NUMTRY,NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),PKTNUM=PKTNUM+1;
  373. 2240:REM"Bump packet count
  374. 2250 GOSUB 1000;PACKET$=B$,SIZE=LEN(PACKET$); IF SIZE=0 STATE=ASCII("Z");RETU
  375. 2250:RN;REM PACKET$=FNBufill,size=LEN(packet$);if size=0 state=ascii("Z");ret
  376. 2250:urn:rem EOF
  377. 2260 STATE=ASCII("D");RETURN;REM Good data, stay in D
  378. 2270 RETURN;REM"State ! Receive failure
  379. 2280 STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2280 Unknown reply ",'CI',
  380. 2280:'RB',* FI;RETURN;REM Unknown reply, Abort
  381. 2290 RETURN;REM FNEND; i think these will be gosubs
  382. 2300 REM-------------------------------------------------
  383. 2310 REM  FNSeof  -  Send End-of-file   from 1650
  384. 2320 REM-------------------------------------------------
  385. 2330 REM"DEF FNSeof LOCAL Num,Length,H  - function definition in the original
  386. 2340 IF DEBUG0=TRUE PRINT (17)"Seof"
  387. 2350 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "ABOUT TO ABORT @2
  388. 2350:350 -Too many tries",'RB','CI',* FI;RETURN;REM Too many tries - give up
  389. 2360 NUMTRY=NUMTRY+1
  390. 2370 TYPE=ASCII("Z"),NUM0=N,LENGTH=0,DATA$="";GOSUB 11020;REM was H=FNSpack(A
  391. 2370:SCII("Z"),N,0,'') ! send a Z packet
  392. 2380 IF DEBUG0=TRUE PRINT (17)"Seof1"
  393. 2390 GOSUB 1280;REM Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$)) 
  394. 2390:! Check reply
  395. 2399 REM"ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 goto 2520,2410,2420,2510
  396. 2400 ON POS(CHAR$(TYPE)="NY"+CHAR$(0)) GOTO 2520,2410,2420,2510
  397. 2401 REM                                           N   Y   0
  398. 2410 NUM0=ASCII(AND(CHAR(NUM0-1),CHAR(63)));IF N<>NUM0 RETURN;REM State ! Nak
  399. 2410:, stay in state
  400. 2420 IF DEBUG0=TRUE PRINT(17)"SEOF2"
  401. 2430 IF N<>NUM0 RETURN;REM State ! if wrong ACK, hold out
  402. 2440 NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63)));REM"reset try-counter and bump
  403. 2440: counter
  404. 2450 IF DEBUG0=TRUE PRINT(17)"Closing ",FILNAM$
  405. 2460 CLOSE(2); IF DEBUG0=TRUE PRINT(17)"OK, Getting next file"
  406. 2470 IFILE=IFILE+1;IF IFILE>NFILES STATE=ASCII("B");RETURN;REM"EOT - all done
  407. 2480 FILNAM$=IFILE$(IFILE);IF DEBUG0=TRUE PRINT(17)"New file is ",FILNAM$
  408. 2490 OPEN(2)FILNAM$;REM"OPEN Filnam$ AS FILE 2
  409. 2500 STATE=ASCII("F");RETURN;REM More files, switch to F
  410. 2510 PRINT "RECEIVE FAILURE @2510 ";RETURN;REM State ! Receive failure, stay 
  411. 2510:in state Z
  412. 2520 STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2520 did not reply properl
  413. 2520:y ",'CI','RB',* FI;RETURN;REM"Something else, Abort
  414. 2530 RETURN;REM FNEND i think these must be gosubs
  415. 2540 REM-------------------------------------------------
  416. 2550 REM  FNSbreak -  Send Break (EOT)  from 1670
  417. 2560 REM------------------------------------------------
  418. 2570 REM DEF FNSbreak LOCAL Num,Length,H,Type -- function def stuff??
  419. 2580 IF DEBUG0=TRUE PRINT(17)"Sbreak"
  420. 2590 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "abort @ 2590-too 
  421. 2590:many tries ",'RB','CI' FI;RETURN
  422. 2600 NUMTRY=NUMTRY+1
  423. 2610 TYPE=ASCII("B"),NUM0=N,LENGTH=0,DATA$="";GOSUB 11020;REM was H=FNSPACK(A
  424. 2610:SCII("B"),N,0,'') ! send a B packet
  425. 2620 GOSUB 1280;REM Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Recpkt$))
  426. 2629 REM"ON INSTR(1,'NY'+CHR$(0),CHR$(Type))+1 goto 2680,2640,2650,2670
  427. 2630 ON POS(CHAR$(TYPE)="NY"+CHAR(0)) GOTO 2680,2640,2650,2670
  428. 2631 REM                                           N   Y   0
  429. 2640 NUM0=ASCII(AND(CHAR(NUM0-1),CHAR(63)));IF N<>NUM0 RETURN;REM State
  430. 2650 IF N<>NUM0 RETURN;REM State ! if wrong ACK, fail
  431. 2660 NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),STATE=ASCII("C");RETURN;REM Sw
  432. 2660:itch State to Complete
  433. 2670 RETURN;REM State
  434. 2680 STATE=ASCII("A");IF HOST=FALSE PRINT"ABORT @2680 Wrong reply packet ",DU
  435. 2680:MMY$,;INPUT'RB','CI',* FI;RETURN
  436. 2690 RETURN;REM"FNEND probably a gosub in MAI B4 lingo!
  437. 2700 REM-------------------------------------------------
  438. 2710 REM  FNRecsw  - State table switcher for receive files
  439. 2720 REM-------------------------------------------------
  440. 2730 REM DEF FNRecsw  -- function definition stuff set this up for a gosub in
  441. 2730: MAI B4 lingo
  442. 2740 RSW=1;GOSUB 3820;IFILE=0;REM was Nfiles=FNFiles(1) : FILE=0 ! Assign loc
  443. 2740:al file names if necessary
  444. 2745 IF HOST=TRUE PRINT @(0,15),"Now return to local task to send files",
  445. 2750 STATE=ASCII("R"),N=0,NUMTRY=0; REM WHILE True -- what does it mean?
  446. 2759 REM"ON INSTR(1,'DFRCA',CHR$(State)) GOTO 2770,2780,2790,2800,2810
  447. 2760 ON POS(CHAR$(STATE)="DFRCA") GOTO 2810,2770,2780,2790,2800,2810
  448. 2761 REM                                     D    F    R    C     A
  449. 2770 GOSUB 3280;GOTO 2820
  450. 2780 GOSUB 2970;GOTO 2820;REM"State=FNRfile : GOTO 2820 ! File Receive State
  451. 2790 GOSUB 2840;GOTO 2820;REM"State=FNRinit : GOTO 2820 ! Send initiate State
  452. 2800 RETURN0=TRUE;RETURN;REM Complete state
  453. 2810 RETURN0=FALSE;IF HOST=FALSE INPUT "ABOUT TO ABORT @ 2810 ",'CI','RB',* F
  454. 2810:I;RETURN;REM Abort State
  455. 2820 GOTO 2760;REM"WEND
  456. 2830 REM"FNEND -- when does it fall thru the WEND?
  457. 2840 REM--------------------------------
  458. 2850 REM  FNRinit  -   Receive Initialization
  459. 2860 REM--------------------------------
  460. 2870 REM"DEF FNRinit LOCAL Num,Length,Type -- function definition stuff
  461. 2880 IF NUMTRY>MAXTRY STATE=ASCII("A");RETURN;REM Too many tries - abort
  462. 2890 NUMTRY=NUMTRY+1
  463. 2900 GOSUB 1270;REM"Type =FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(packet$))
  464. 2910 IF TYPE=FALSE RETURN;REM State ! Did not get a packet, keep waiting
  465. 2920 IF TYPE <>ASCII("S") STATE=ASCII("A");RETURN;REM Some unexpected packet 
  466. 2920:- abort
  467. 2925 S$=DATA$
  468. 2930 GOSUB 680;PACKET$=FNSPAR$(Z$);REM"H=FNRpar(Packet$) : Packet$=FNSpr$
  469. 2940 TYPE=ASCII("Y"),NUM0=N,LENGTH=LEN(PACKET$),DATA$=PACKET$;GOSUB 1120;OLDT
  470. 2940:RY=NUMTRY;REM"H=FNSpack(ASCII('Y'),N,6,Packet$)
  471. 2950 NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),STATE=ASCII("F");RETURN
  472. 2960 RETURN;REM"FNEND must be a gosub with state as output
  473. 2970 REM-----------------------------------------
  474. 2980 REM  FNRfile  -  Receive file Header
  475. 2990 REM--------------------------------
  476. 3000 REM DEF FNRfile LOCAL Length,Num,Type,H,Filenam$=2 
  477. 3010 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT"ABORT @3010 ON TRY
  478. 3010:S ",'CI','RB',* FI;RETURN;REM Too many tries, abort
  479. 3020 NUMTRY=NUMTRY+1
  480. 3030 GOSUB 1270;REM"Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$)
  481. 3039 REM"ON INSTR(1,'SZFB'+CHR$(0),CHR$(Type))+1 goto 3050,3060,3110,3140,323
  482. 3039:0,3260
  483. 3041 ON POS(CHAR(TYPE)="SZFB"+CHAR(0)) GOTO 3050,3060,3110,3140,3230,3260
  484. 3042 REM"                                         S     Z    F   B
  485. 3050 STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 3050 ON STATE ",'CI','RB'
  486. 3050:,* FI;RETURN;REM Default  - Abort, unknown packet
  487. 3060 OLDTRY=OLDTRY+1;IF OLDTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "A
  488. 3060:BORT AT 3060 TOO MANY TRYS ",'RB','CI',* FI;RETURN;REM Too many tries - 
  489. 3060:abort
  490. 3070 IF NUM0<>ASCII(AND(CHAR(N-1),CHAR(63))) STATE=ASCII("A");IF HOST=FALSE P
  491. 3070:RINT "ABORT @ 3070 PACKETS OUT OF SEQUENCE ",NUM0," ",N,;INPUT 'RB','CI'
  492. 3070:,* FI;RETURN;REM Not previous packet, abort
  493. 3080 GOSUB 640;TYPE=ASCII("Y"),LENGTH=0,DATA$="";GOSUB 1120;REM"Packet$=FNSpa
  494. 3080:r$ : H=FNSpack(ASCII('Y'),Num,6,Packet$)
  495. 3090 NUMTRY=0;RETURN;REM State
  496. 3100 REM Case Z - End-of-file
  497. 3110 OLDTRY=OLDTRY+1;IF OLDTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "A
  498. 3110:BORT @ 3110 TOO MANY TRYS ",'CI','RB',* FI;RETURN
  499. 3120 IF NUM0<>ASCII(AND(CHAR(N-1),CHAR(63))) STATE=ASCII("A");IF HOST=FALSE I
  500. 3120:NPUT"ABORT @ 3120 WRONG SEQUENCE ",'RB','CI',* FI;RETURN;REM Not previou
  501. 3120:s packet, abort
  502. 3130 LENGTH=0,TYPE=ASCII("Y"),DATA$="";GOSUB 1120;NUMTRY=0;RETURN;REM"H=FNSpa
  503. 3130:ck(ASCII('Y'),Num,0,'') : Numtry=0 : RETURN State
  504. 3140 REM Case F - File header
  505. 3150 IFILE=IFILE+1;REM Another file
  506. 3160 IF NUM0<>N STATE=ASCII("A");IF HOST=FALSE INPUT"ABORT @ 3160 WRONG SEQUE
  507. 3160:NCE ",'CI','RB',* FI;RETURN;REM ('A') ! Wrong sequence-right block type
  508. 3170 AA$=DATA$;GOSUB 4290;IF RETURN0=FALSE IF HOST=FALSE PRINT @(0,15),"Could
  509. 3170: not create ",DATA$ FI;STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 31
  510. 3170:70 ",'CI','RB',* FI;RETURN;REM"('A')^^^
  511. 3180 FILENAM$=A$;REM IF IFILE<=NFILE K=POS(","=IFILE$), FILENAM$=IFILE$(1,K-1
  512. 3180:),IFILE$=IFILE$(K+1) ELSE FILENAM$=A$
  513. 3190 IF HOST=FALSE PRINT @(0,14)," Receiving ",FILENAM$,"                    
  514. 3190:"
  515. 3200 IF DEBUG0=TRUE PRINT(17)" Receiving ",FILENAM$
  516. 3210 TYPE=ASCII("Y"),NUM0=N,LENGTH=0,DATA$="";GOSUB 1120;REM"H=FNSpack(ASCII(
  517. 3210:'Y'),N,0,'') ! acknowledge file header
  518. 3220 OLDTRY=NUMTRY,NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),STATE=ASCII("D")
  519. 3220:; RETURN;REM" Switch to Data State
  520. 3230 REM Case B  -  End-of-Transmission
  521. 3240 IF NUM0<>N STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT @ 3240 WRONG SEQU
  522. 3240:ENCE ",'RB','CI',* FI;RETURN;REM ('A') ! Need right packet number here
  523. 3250 TYPE=ASCII("Y"),NUM0=N,LENGTH=0,DATA$="";GOSUB 1120;STATE=ASCII("C");RET
  524. 3250:URN;REM"H=FNSpack(ASCII('Y'),N,0,'') : RETURN ASCII('C') ! Goto Complete
  525. 3250: State
  526. 3260 RETURN;REM State ! Case False
  527. 3270 RETURN;REM FNEND this is now a gosub to 2970 with State as output
  528. 3280 REM-----------------------------
  529. 3290 REM   FNRdata  - Receive Data  from 2770
  530. 3300 REM----------------------------
  531. 3310 REM DEF FNRdata LOCAL Num,Length,H,Type -- function definition stuff
  532. 3320 IF NUMTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 3320 TOO
  533. 3320: MANY TRIES ",'CI','RB',* FI;RETURN;REM Too many tries - abort
  534. 3330 NUMTRY=NUMTRY+1
  535. 3340 GOSUB 1270;REM"Type=FNRpack(VARPTR(Length),VARPTR(Num),VAROOT(Packet$))
  536. 3350 IF DEBUG0=TRUE PRINT(17)" Rx ",LENGTH,NUM0,PACKET$
  537. 3359 REM"ON INSTR(1,'DFZ'+CHR$(0),CHR$(Type))+1 GOTO 3370,3380,3430,3460,3490
  538. 3360 ON POS(CHAR(TYPE)="DFZ"+CHR$(0)) GOTO 3370,3380,3430,3460,3490
  539. 3370 STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 3370 SOME OTHER PACKET ",
  540. 3370:'CI','RB',* FI;RETURN;REM Default - someother packet, abort
  541. 3380 IF NUM0=N GOTO 3400 ELSE OLDTRY=OLDTRY+1;IF OLDTRY>MAXTRY STATE=ASCII("A
  542. 3380:");RETURN
  543. 3390 IF NUM0=ASCII(AND(CHAR(N-1),CHAR(63))) TYPE=ASCII("Y"),LENGTH=LEN(PACKET
  544. 3390:$),DATA$=PACKET$;GOSUB 1120;NUMTRY=0;RETURN ELSE STATE=ASCII("A");RETURN
  545. 3390:;REM "if Num=((N-1) AND 63) H=FNSpack (ASCII('Y'),Num,6,Packet$) : Numtr
  546. 3390:y=0 : RETURN State Else RETURN ASCII('A')
  547. 3400 TYPE=ASCII("Y"),NUM0=N,LENGTH=0,BUF$=DATA$,DATA$="";GOSUB 1120
  548. 3405 LGD=LEN(BUF$);GOSUB 780;REM TYPE=ASCII("Y"),NUM0=N,LENGTH=0,DATA$="";GOS
  549. 3405:UB 1120
  550. 3410 OLDTRY=NUMTRY,NUMTRY=0,N=ASCII(AND(CHAR(N+1),CHAR(63))),STATE=ASCII("D")
  551. 3410:;RETURN
  552. 3420 REM Case F - File header
  553. 3440 OLDTRY=OLDTRY+1;IF OLDTRY>MAXTRY STATE=ASCII("A");IF HOST=FALSE INPUT"AB
  554. 3440:ORT @ 3440 TOO MANY TRIES ",'CI','RB',* FI;RETURN
  555. 3450 REM Case Z - End-of-file
  556. 3460 IF NUM0<>N STATE=ASCII("A");IF HOST=FALSE INPUT "ABORT AT 3460 WRONG SEQ
  557. 3460:UENCE ",'CI','RB',* FI;RETURN
  558. 3465 IF PEEK$>"" GOSUB 885
  559. 3470 TYPE=ASCII("Y"),NUM0=N,LENGTH=0,DATA$="";GOSUB 1120;CLOSE(FD);N=ASCII(AN
  560. 3470:D(CHAR(N+1),CHAR(63))),STATE=ASCII("F");RETURN
  561. 3480 TYPE=ASCII("N"),NUM0=N,LENGTH=0,DATA$="";GOSUB 1120;REM "Nacka 
  562. 3490 RETURN;REM state
  563. 3500 RETURN;REM FNEND
  564. 3510 REM-----------------------------------------
  565. 3520 REM  FNConnect  -  Establish virtual terminal to remote host
  566. 3530 REM-----------------------------------------
  567. 3540 REM DEF FNConnect LOCAL Dummy$=
  568. 3550 REM IF HOST=TRUE PRINT @(15,0),"Kermit: nothing to connect in host mode 
  569. 3550:",'RB','RB';RETURN
  570. 3554 INPUT(0,ERR=3554)'EO','BE',@(0,14),"ENTER PORT (CR=become host) ",'CI',P
  571. 3554:ORT$;IF PORT$="" CLOSE(REMFD);OPEN(REMFD)"T*";HOST=TRUE; GOTO 3585
  572. 3560 PRINT @(0,16),"Kermit: connected - terminal mode with host - Push PF1 to
  573. 3560: exit"
  574. 3570 REM "ON ERROR GOTO 3600
  575. 3580 REMFD=1,HOST=FALSE;CLOSE(REMFD);OPEN(REMFD,ERR=3600)PORT$;REM"OPEN 'V24:
  576. 3580:TSA30B24.' CHR$(Brf+48,Brf+48,65) AS FILE 1; GET #1,A$
  577. 3585 GOSUB 4590
  578. 3587 PRINT(REMFD)'BO'
  579. 3590 RETURN
  580. 3600 REM RESUME
  581. 3605 PRINT "ERROR ",ERR," ON OPEN OF ",PORT$
  582. 3610 PRINT "Kermit: disconnected";WAIT 2;RETURN;REM"ON ERROR GOTO : ; --:H=FN
  583. 3610:Delay
  584. 3620 RETURN;REM FNEND
  585. 3630 REM----------------------------
  586. 3640 REM  FNInchr$ - get char from remote line
  587. 3650 REM----------------------------
  588. 3660 REM"DEF FNInchr$ LOCAL Dummy$=
  589. 3670 INPUT(REMFD,TIM=MAXTIM,ERR=3671)DUMMY$;DIM X$(LEN(DUMMY$),CHAR(127));DUM
  590. 3670:MY$=AND(DUMMY$,X$);RETURN;REM"GET #Remfd Dummy$ : RETURN CHR$(ASCII(Dumm
  591. 3670:y$) AND 127) ! strip parity bit
  592. 3680 RETURN;REM"FNEND
  593. 3690 REM-------------------------
  594. 3700 REM  FNBaud%(B%) - set up baud rate
  595. 3710 REM Input: Baud rate
  596. 3720 REM Output: Port setting
  597. 3730 REM---------------------------
  598. 3740 REM" DEF FNBaud(B) LOCAL I,Nb,K
  599. 3750 I=1;REM RESTORE
  600. 3760 READ NB
  601. 3765 REM DATA 8,110,300,600,1200,2400,4800,9600,19200
  602. 3770 IF I>NB GOTO 3790 ELSE READ K; IF B=K RETURN0=I;RETURN;REM "WHILE I<=Nb 
  603. 3770:: READ K : IF B=K RETURN I
  604. 3780 I=I+1
  605. 3790 REM WEND
  606. 3800 PRINT @(13,0),"**** Bad Baud rate =",B," Not permitted  ****",'RB','RB',
  607. 3800:'RB';RETURN
  608. 3810 REM FNEND
  609. 3820 REM------------------------------
  610. 3830 REM FNFiles - input file names - check files  from 420,2740
  611. 3840 REM-----------------------------
  612. 3850 REM"DEF FNFiles(Rsw) LOCAL Nfile,Aa$=162,i
  613. 3860 NFILE=0,IFILE$="";PRINT @(0,12),"Specify File names (use , between names
  614. 3860:)    ",;DIM SPACE$(162)
  615. 3870 PRINT SPACE$,@(0,13),;INPUT AA$; IF AA$="" RETURN;REM was Aa$=LEFT$(Aa$,
  616. 3870:LEN(Aa$)-2) : IF LEN(Aa$)=0 RETURN (maybe 0?)
  617. 3880 NFILE=NFILE+1
  618. 3890 K=POS(","=AA$)
  619. 3895 IF K=1 AA$=AA$(K+1); GOTO 3880;REM "null file?
  620. 3900 IF K>0 IFILE$=IFILE$+AA$(1,K-1)+",",AA$=AA$(K+1);GOTO 3880
  621. 3910 IFILE$=IFILE$+AA$;REM aa$ is either null if it ends in a , or the last f
  622. 3910:ile name you want
  623. 3920 IF RSW>0 RETURN; REM "Receive mode, no filename check
  624. 3930 SETERR 3960;I=0,AA$=IFILE$
  625. 3935 K=POS(","=AA$); IF K=1 AA$=AA$(K+1); GOTO 3935 ELSE IF K=0 AND AA$="" GO
  626. 3935:TO 3950
  627. 3937 IF K=0 X$=AA$ ELSE X$=AA$(1,K-1),AA$=AA$(K+1)
  628. 3940 IF I>NFILE GOTO 3950 ELSE CLOSE(2);OPEN(2)X$;FID2$=FID(2);CLOSE(2);I=I+1
  629. 3940:;IF (ASC(FID2$(10))=2 AND DEC(FID2$(15,2))=0) OR ASC(FID2$(10))=4  PRINT
  630. 3940: X$, "is not a data file!"  ELSE IF I>1 GOTO 3935
  631. 3942 INPUT(0,ERR=3942)@(0,17),"Enter starting key (cr=first) ",START0$
  632. 3945 INPUT(0,ERR=3945)@(0,18),"Enter ending key (cr=last) ",END0$; IF CTL>1 G
  633. 3945:OTO 3942 ELSE IF END0$="" END0$=$FF$
  634. 3947 GOTO 3935
  635. 3959 SETERR 15700;RETURN; REM "ON ERROR GOTO : RETURN Nfile
  636. 3960 REM"RESUME
  637. 3970 PRINT @(0,14),"file ",X$," does not exist - (ERROR=",ERR,") abort !!!!";
  638. 3970: INPUT A$;RETURN
  639. 3980 REM FNEND
  640. 3990 REM----------------------------------
  641. 4000 REM  FNGetch - Get line char one by one from 1350,1380 now 1346
  642. 4010 REM Basic BASIC - version, for level 1.000
  643. 4020 REM-------------------------------------
  644. 4030 REM DEF FNGetch LOCAL Sec,I,Dummy$=
  645. 4040 REM SEC=PEEK(65524)+Timint+1; If Sec>59 Sec=Sec-60
  646. 4050 REM If PEEK2(PEEK2(65500)+6) RETURN ASCII(FNInchr$)
  647. 4060 REM"IF Sec=PEEK(65524) RETURN -1 ELSE goto 4050
  648. 4064 DUMMY$=""
  649. 4065 INPUT(REMFD,ERR=4066,TIM=TIMINT)DUMMY$;IF HOST=FALSE PRINT @(0,16),DUMMY
  650. 4065:$, FI;RETURN
  651. 4067 T=-1
  652. 4068 IF HOST=FALSE PRINT @(50,16),"TIME OUT"
  653. 4070 REM FNEND
  654. 4075 RETURN
  655. 4080 REM-----------------------------------------
  656. 4090 REM  FNHead - Print Meny - input command
  657. 4100 REM-----------------------------------------
  658. 4110 REM DEF FNHead LOCAL f,F$=1,Baud
  659. 4120 REM RESTORE 3760 : READ Baud
  660. 4126 BAUD=1200;GOTO 4140
  661. 4130 IF BRF>0 FOR I=1 TO BRF; READ BAUD;NEXT I ELSE BAUD=1200
  662. 4140 SETERR 4270;REM"ON ERROR GOTO 4270
  663. 4145 DIM SPACE$(20)
  664. 4150 PRINT @(0,0),'CS',"   K E R M I T  f o r  M A I   B B 8 6 ",SPACE$,VERSI
  665. 4150:ON$
  666. 4190 PRINT 'LF',"1)  Connect to host computer"
  667. 4200 PRINT "2)  Receive files from you"
  668. 4210 PRINT "3)  Send files to you"
  669. 4230 PRINT "4)  Turn on debug mode"
  670. 4240 PRINT "5)  Exit Kermit"
  671. 4259 PRINT @(0,11),"Specify function ",'CI',; INPUT F$; PRINT F$;F=NUM(F$,ERR
  672. 4259:=4259);IF F>5 PRINT "not yet implemented";GOTO 4259
  673. 4260 IF F>0 SETERR 15700;RETURN ELSE GOTO 4259
  674. 4270 REM RESUME
  675. 4271 SETERR 15700
  676. 4280 RETURN;REM FNEND
  677. 4290 REM----------------------
  678. 4300 REM FNGetfil(A$)  -  Create new file from 3170
  679. 4310 REM-------------------------------
  680. 4320 REM"DEF FNGetfil(Aa$) LOCAL A$=1
  681. 4330 A$=AA$;IF IFILE<=NFILE X=POS(","=IFILE$);IF X>0 A$=IFILE$(1,X-1),IFILE$=
  682. 4330:IFILE$(X+1)
  683. 4335 FA=LEN(A$); IF FA<6 FA$="%"+STR(FA)+A$ ELSE FA$=A$
  684. 4336 FA$=".DOWNLOAD."+FA$;REM" should put the download directory namne as a p
  685. 4336:aramter too!
  686. 4340 SETERR 4341;CREATE ATTR="NAME="+FA$+"  ORGANIZATION=SER";SETERR 15700;OP
  687. 4340:EN(FD)FA$;LOCK(FD);KRAD=0;RETURN0=TRUE;RETURN ;REM"prepare a$ as file fd
  688. 4340: ; krad=0 : RETURN True
  689. 4342 IF ERR<>12 GOTO 4350 ELSE IF HOST=TRUE GOTO 4344
  690. 4343 PRINT @(0,14),"File ",FA$," already exists..cr to use it, ctl II to eras
  691. 4343:e first, ctl iv to exit ",;INPUT'CI',*; IF CTL=2 CLOSE(FD);ERASE FA$; RE
  692. 4343:TRY ELSE IF CTL>2 RETURN0=FALSE;RETURN
  693. 4344 CLOSE(FD);OPEN(FD)FA$;LOCK(FD)
  694. 4345 KRAD=0,RETURN0=TRUE;RETURN
  695. 4350 REM sorry pal - bad name
  696. 4360 REM RESUME
  697. 4370 SETERR 15700; PRINT @(0,14),"File ",A$," illegal file name(ERROR=",ERR,"
  698. 4370:) "; RETURN0=FALSE;RETURN
  699. 4380 REM FNEND
  700. 4390 REM----------------------------------------
  701. 4400 REM   FNQ$(T)  - quote a char  from 1060
  702. 4410 REM-----------------------------------------
  703. 4420 REM DEF FNQ$(T)
  704. 4430 IF T=MYQUOTE RETURN0$=CHAR(T)+CHAR(T);RETURN;REM "# is sent as ##
  705. 4440 RETURN0$=CHAR$(MYQUOTE)+XOR(CHAR(T),CHAR(64));REM "<32 or DEL toggle con
  706. 4440:trol bit
  707. 4445 RETURN0$(2)=CHAR(ASC(RETURN0$(2)))
  708. 4450 RETURN; REM FNEND
  709. 4460 REM-------------------------------
  710. 4470 REM  FNQrpack(&len,&num,&data$) - Emulate Rpack from keyboard from 1330
  711. 4480 REM----------------------------------------------------------
  712. 4490 REM DEF FNQrpack(Length,Num,Datax) LOCAL Typ,Pp,L1,Nn,Dd$=90,Typ$=1
  713. 4500 DIM SPACE$(79);PRINT @(0,22),SPACE$,@(0,22),"typ,num,text: ",;INPUT TYP$
  714. 4500:,NN,DD$
  715. 4510 TYP=ASCII(TYP$),L1=LEN(DD$);REM POKE Length,L1,SWAP%(L1);POKE Num,Nn,SWA
  716. 4510:P%(Nn)
  717. 4520 PP=PEEK2(DATAX+2);REM POKE Datax+4,L1,SWAP%(l1)
  718. 4530 I=1;IF I>L1 GOTO 4541 ELSE REM POKE Pp,ASCII(MID$(Dd$,I,1))
  719. 4540 I=I+1;PP=PP+1; GOTO 4530
  720. 4550 PRINT @(40,15)," Receive packet ",N," ",CHAR(TYP),SP$
  721. 4560 IF DEBUG0=TRUE PRINT(17)" Receive packet ",PEEK2(NUM0)," ",N,CHAR(TYP)
  722. 4570 RETURN0=TYP;RETURN
  723. 4580 REM FNEND
  724. 4590 REM------------------------------
  725. 4600 REM  FNDelay  delay 2 seconds  from 540,,3585
  726. 4610 REM-----------------------------
  727. 4620 REM DEF FNDelay LOCAL X
  728. 4625 WAIT 2; GOTO 4650
  729. 4630 X=1
  730. 4640 IF X<15 X=X+1; GOTO 4640
  731. 4650 RETURN; REM FNEND
  732. 7717 IOLIST PP," ",X$,T," CHAR=",CHAR(T)," HTA=",HTA(DUMMY$(PP,1))," CHKSUM =
  733. 7717:",CHKSUM
  734. 7727 IOLIST PP," ",X$,T," CHR=",CHR(T)," HTA=",HTA(DUMMY$(PP,1))," CHKSUM =",
  735. 7727:CHKSUM
  736. 9949 REM CONVERSION TABLE: B4 ASCII TO STANDARD ASCII
  737. 9950 TABLE 7F000102030405060708090A0B0C0D0E0F101112131415161718191A1B1C1D1E1F
  738. 9950:202122232425262728292A2B2C2D2E2F303132333435363738393A3B3C3D3E3F40414243
  739. 9950:4445464748494A4B4C4D4E4F505152535455565758595A5B5C5D5E5F6061626364656667
  740. 9950:68696A6B6C6D6E6F707172737475767778797A7B7C7D7E7F
  741. 9959 REM CONVERSION TABLE: STANDARD ASCII TO B4 ASCII
  742. 9960 TABLE 7F808182838485868788898A8B8C8D8E8F909192939495969798999A9B9C9D9E9F
  743. 9960:A0A1A2A3A4A5A6A7A8A9AAABACADAEAFB0B1B2B3B4B5B6B7B8B9BABBBCBDBEBFC0C1C2C3
  744. 9960:C4C5C6C7C8C9CACBCCCDCECFD0D1D2D3D4D5D6D7D8D9DADBDCDDDEDFE0E1E2E3E4E5E6E7
  745. 9960:E8E9EAEBECEDEEEFF0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF
  746. 10000 CHKSUM=0;FOR PP=2 TO LEN(DUMMY$)-1
  747. 10010 CHKSUM=CHKSUM+ASC(AND($3F$,DUMMY$(PP,1)))
  748. 10020 NEXT PP
  749. 10030 ESCAPE
  750. 11000 REM"DOIT IN LOW ORDER ASSKEY
  751. 11070 DIM BUFFER$(PAD,PADCHAR$);BUFFER$=BUFFER$+CHR(SOH)+CHR(LENGTH+35)+CHR(NU
  752. 11070:M0+32)+CHR(TYPE)+TBL(DATA$,9950)
  753. 11097 CHKSUM=0; FOR I=2+PAD TO LEN(BUFFER$); CHKSUM=CHKSUM+ASC(BUFFER$(I));NEX
  754. 11097:T I
  755. 11098 E1$=BIN(CHKSUM,2),E1$=AND(E1$,$C0C0$),E1=DEC(E1$)/64,CHKSUM=MOD(CHKSUM+E
  756. 11098:1,64)           
  757. 12010 BUFFER$=BUFFER$+CHR(CHKSUM+32)+CHR(EOL)+CHR(10);REM was Buffer$=Buffer$+
  758. 12010:CHR$(Chksum+32,Eol,10),CHR$(10)=$8A$=newline?
  759. 12020 PRINT (REMFD)BUFFER$; IF HOST=FALSE PRINT @(0,15),"Send packet ",N," ",C
  760. 12020:HAR(TYPE)," ",NUMTRY,"  ",
  761. 12030 IF DEBUG0=TRUE PRINT (17)"Send packet ",N," ",CHR(TYPE)," ",NUMTRY
  762. 12040 IF DEBUG0=TRUE PRINT(17)BUFFER$
  763. 12050 H=LEN(BUFFER$); RETURN; REM RETURN LEN(Buffer$)
  764. 12090 RETURN
  765. 16000 END
  766.