1  !  RE-SAVE  "HPBASC"
3  !  KERMIT - Version 1.03
4  !  For Hewlett-Packard Co.
5  !  Family 9000 - Series 200/300
6  !  HP-BASIC (RMB) Workstations
7  !==================================================================
8  ! Revision History:
9  !------------------------------------------------------------------
10 ! Revision 1.03    -  Feb 20, 1990
11 ! Added Columbia University File Naming for HPB prefix
12 ! Transfer Status shown in STATUS command
13 ! Parity OFF Fixed (SET PARITY OFF)
14 ! Ksendf: changed IF R_capas=1 to Rcap_a=1 to shutoff A Packets
15 ! fixed SET SEND ATTRIBUTE OFF command, added send_at to COM decl
16 ! changed capas mask to 40 '(' from 42 '*' to eliminate long packets
17 !-------------------------------------------------------------------
18 ! Revision 1.03  -  Oct 11 1989
19 ! RPACK: Hardcoded Unchar Function to trap NUM("null") problem
20 ! Disabled Serial Port Interrupts - not really needed
21 ! Revised VT100 terminal escape processor
22 ! Added Client capability (GET Command)
23 ! Fixed Problem with the SET PARITY command not changing parity.
24 ! Fixed the SET DISPLAY 8/ON command to display non-printable
25 !  characters in the ranges 0-31, 128-256
26 ! Fixed Problem with MORE command printing to printer
27 ! Added xon/xoff flow to terminal emulator 'GET_INLENGTH' code
28 ! Added hardware xon/xoff to Sf28 (Set_frame on 98628)
29 ! Change Output Buffer to 1024b Input Buffer to 4096b
30 ! Added transfers shutdown in QUIT command
31 ! Added SET MARK command - to change 'start of packet' mark
32 ! Fixed SET SOURCE and SET DESTINATION Disc Drive Code
33 ! Add Newline toggle in Terminal Escape line
34 ! Fixed Terminal Session Logging
35 ! Grouped CSUBS at end of program code
36 ! Add VT100 APPL Mode Sequences for CTRL-0--9 keys
37 ! Add SET PARITY ON/OFF to disable parity CHECKING
38 !------------------------------------------------------------------
39 ! Revision 1.02  -  Apr 3 1989
40 ! Fixed prob with path msi$ not DIM long enough
41 ! removed pause when remote switch is set on serial card
42 ! removed trap preventing receive of PROG file type
43 ! added code to detect and ignore SRM interfaces
44 ! added ability to specify any filetype in CONVERT command
45 !------------------------------------------------------------------
46 ! Revision 1.01  -  Mar 20 1989
47 ! Two errors in Kreceive decoding &#& and &## Binary Sequences
48 ! Implemented PROG file transfers
49 ! Problem with modem disconnecting before Send or Receive
50 ! Trap for no serial ports found
51 ! Terminal leaving stray cursors on screen
52 ! Error Check on remote S packet - non-numeric sent for blk chk type
53 !------------------------------------------------------------------
54 ! Revision 1.0
55 ! Original Release Mar 1 1989
56 !==========================================================================
57 !  To obtain a copy of this software contact:
58 !
59 !  |  KERMIT Distributon
60 !  |  Columbia University
61 !  |  Center For Computing Activities
62 !  |  612 W. 115 St.
63 !  |  New York, N.Y.     10025
64 ! or
65 !  |  INTEREX - HP Users Group (Requires Membership)
66 !  |  680 Almanor Ave
67 !  |  Sunnyvale, CA.   94086-3513
68 !-----------------------------------------------
69 ! Written By:
70 ! Andrew Campagnola
71 ! Hewlett-Packard Co.
72 ! Mesurement Systems Operation
73 ! P.O. Box 301
74 ! Loveland, Colorado  80539-0301
75 !
76 ! You're encouraged to write with comments, suggestions,
77 ! and bug reports.
78 !==========================================================================
79  ! KERMIT   Copyright (C) 1981,1988
80  ! Trustees of Columbia University, New York City, N.Y.
81  ! Permission is granted to any individual or institution to use, copy or
82  ! redistribute this software provided it is not sold, and this copyright
83  ! is retained.
84  !==========================================================================
85  ! DISCLAIMER:
86  ! This software is provided as is.
87  ! No warantee is made of any kind with respect to this program including,
88  ! but not limited to, implied warantees of merchantability or fitness for
89  ! a particular purpose.
90  ! Neither Hewlett-Packard nor the author shall be liable for errors or
91  ! incidental damages in connection with the use of this material.
92 !==========================================================================
93    CONTROL KBD,3;4,40        ! speed up keyboard
94    COM Version$[80],K$[180],Setup$[80]
95    COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
96    COM /Port/ @Out_buff,@Com_out,Output_buffer$[1000] BUFFER
97    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$[4000] BUFFER,Com_card
98    COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
99    COM /Frame/ Flow$[10],Hshake$[10]
100   COM /Portsc/ Sports(1:10)
101   COM /Path/ Cur_msi$[256],S_path$[256],S_msi$[20],D_path$[256],D_msi$[20]
102   !========================================================================
103 Version:Version$="HP-9000  Kermit-RMB  
Release 1.03  20 Feb 1990 
"
104   Active=0
105   In_term=0
106   CONTROL CRT,21;1   ! Reset CRT
107   PRINTER IS CRT
108   GRAPHICS ON
109   WINDOW 0,80,26,0
110   CSIZE 3.5
111   KEY LABELS OFF
112  !------------------------------
113   CLEAR ERROR
114   GOSUB Config
115   CALL Kermit
116  !------------------------------
117   CALL Shutdown
118   CONTROL CRT,21;1
119   KEY LABELS ON
120   MASS STORAGE IS Cur_msi$
121   PRINT TABXY(1,Crt_lines);"KERMIT DONE."
122   CONTROL KBD,3;6,60        ! restore kbd speed
123   STOP
124!======================================================================
125 Config:!
126   COM /Crt/ Crt_lines,Crt_width
127   STATUS CRT,9;Crt_width
128   STATUS CRT,13;Crt_lines
129   Crt_lines=Crt_lines-7
130   No_com_ports=0
131   Com_card=0
132 !
133 ! Check For BIN Files Loaded
134 !
135   Sbin=0
136   Dbin=0
137   Sbin=VAL(SYSTEM$("VERSION: SERIAL"))
138   Dbin=VAL(SYSTEM$("VERSION: DCOMM "))
139   IF Sbin=0 OR Dbin=0 THEN 
140     BEEP 2000,.05
141     WAIT .05
142     BEEP 2000,.05
143   END IF
144   IF Sbin=0 THEN PRINT "SERIAL BIN not Loaded, LOAD BIN or Continue (F2)"
145   IF Dbin=0 THEN PRINT "DCOMM  BIN not Loaded, LOAD BIN or Continue (F2)"
146   IF Dbin=0 OR Sbin=0 THEN PAUSE
147 !
148 ! Identify the Com Ports installed
149 !
150   ON ERROR GOSUB Sc_err
151   FOR Sc=8 TO 31
152     RESET Sc
153     STATUS Sc,0;Id
154     SELECT Id
155     CASE 2
156       Com_port=Sc
157       No_com_ports=No_com_ports+1
158       Com_card=98626              ! COULD BE 98644 IF JUMPER IS CUT
159       Sports(No_com_ports)=Sc
160     CASE 52                       ! 98628 or SRM
161       STATUS Sc,3;Com_protocol   ! SRM=3 Datacomm=1,2
162       IF Com_protocol<3 THEN     ! Not an SRM Card
163         Com_port=Sc
164         No_com_ports=No_com_ports+1
165         Com_card=98628
166         Sports(No_com_ports)=Sc
167       END IF
168     CASE 66
169       Com_port=Sc
170       No_com_ports=No_com_ports+1
171       Com_card=98644
172       Sports(No_com_ports)=Sc
173     CASE 180
174       BEEP 2000,.05
175       PRINT "Remote Switch is set on Serial Port ";Sc;" - Port can't be used"
176     END SELECT
177   NEXT Sc
178   OFF ERROR 
179   IF No_com_ports=0 THEN 
180     BEEP 
181     PRINT TABXY(1,Crt_lines);"No Serial Ports Found "
182   ELSE
183     REDIM Sports(1:No_com_ports)
184   END IF
185   IF No_com_ports>1 THEN 
186     PRINT USING "////"
187     PRINT "Serial Ports Found at Select Codes ";
188     FOR P=1 TO No_com_ports
189       PRINT Sports(P);
190     NEXT P
191     Com_port=Sports(1)
192     PRINT 
193     PRINT "Active Port is Select Code  ";Com_port
194     PRINT "Use Kermit SET PORT Command to Change"
195   END IF
196 !
197 ! Identify Card Model
198 !
199   IF No_com_ports>0 THEN 
200     STATUS Com_port,0;Id
201     SELECT Id
202     CASE 2
203       Com_card=98626              ! COULD BE 98644 IF JUMPER IS CUT
204     CASE 52
205       Com_card=98628
206     CASE 66
207       Com_card=98644
208     CASE ELSE
209       BEEP 
210       PRINT "Unknown Card Type, Reporting Card ID as: ";Id
211     END SELECT
212 !
213 ! Reset the Serial Interface
214 !
215     CALL Reset_port
216   END IF
217   RETURN 
218 !------------------------------------------
219 Sc_err:  !
220   Id=0
221   CLEAR ERROR
222   ERROR RETURN
223  !-----------------------------------------
224   END
225 !=========================================================================
226 Kinit:SUB Kermit_com_init
227 Kci:  !
228     OPTION BASE 1
229     DIM Misc$[100]
230     ON ERROR GOSUB Kci_err
231    !
232    ! Initialize all constants here
233    !
234     COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
235     Maxp=94
236     Maxtry=10
237     Mypad=0
238     Mytmo=8                ! my timeout period
239     Mypchar=0
240     Myeol=NUM("
")          ! LF
241     Myquote=NUM("#")
242    !
243     COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas,Send_at
244     Size=0
245     Rpsiz=94
246     Spsiz=94
247     Pad=0
248     Ptmo=8
249     Capas=0     ! extended capabilities off
250     Send_at=1   ! use attribute packets if possible
251    !
252     COM /Kerm/ INTEGER Image,Parflg,Pktdeb
253     Remote=0
254     Image=0
255     Parflg=0
256     Turn=0
257     Lecho=0
258     Debug=0
259     Pktdeb=0
260     Display=8     ! Shut Off Send and receive Packets
261    !
262     COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol,Smark
263     Filnamcnv=0
264     Filecount=0
265     Timer=1
266     Quote=NUM("#")
267     Eol=10              ! Linefeed
268     Blk_chk=1
269     Smark=1        ! CHR$(1)
270    !
271     COM /Kerm2/ State$[1],Cchksum$[1],Eof_mode$[10],INTEGER Eof_mode,Timer,Ptmo
272     State$="S"
273     Eof_mode$="CTRL-Z ON"
274     Eof_mode=1
275    !
276    ! Other COM areas
277    !
278     COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
279     COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
280     COM /Frame/ Flow$,Hshake$
281     COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
282     COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
283     COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
284     COM /Term/ Kerm_esc$[2],S_log$[80],D_log$[80],INTEGER Remote,Lecho,Turn,Display
285     COM /Term/ Term_mode$[10]
286     COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
287     COM /Mode/ Mode_line,Newline
288  !
289  !  Initialize Serial Port
290     Newline=1           ! Auto append Lf in terminal after Cr
291     Mode_line=1         ! baud and parity indicator line in terminal on|off
292     Lecho=1
293     Baud=9600
294     Flow$="XON/XOFF"
295     Hshake$="NONE"
296     Term_type$="VT100"
297     Term_mode$="NUMERIC"
298     Data_bits=8
299     Stop_bits=1
300     On_off$="OFF"        ! Parity Checking
301     Parity_type$="NONE"
302     Filewarn=1
303   !
304     REPEAT
305       Bad_msi=1
306       Cur_msi$=SYSTEM$("MSI")
307       MASS STORAGE IS Cur_msi$
308     UNTIL Bad_msi
309     Misc=POS(Cur_msi$,"CS80")
310     IF Misc THEN Cur_msi$=Cur_msi$[1,Misc-1]&Cur_msi$[Misc+4]
311     Misc$=Cur_msi$
312     S_msi$=Misc$[POS(Misc$,":")]
313     D_msi$=Misc$[POS(Misc$,":")]
314     IF POS(Misc$,"/") THEN          ! get  d_path$
315       D_path$=Misc$[1,POS(Misc$,":")-1]&"/"
316       S_path$=Misc$[1,POS(Misc$,":")-1]&"/"
317     ELSE
318       D_path$=""
319       S_path$=""
320     END IF
321   !
322     S_log$=D_path$&"SES_LOG"&D_msi$
323     D_log$=D_path$&"PKT_LOG"&D_msi$
324     S_log=0
325     D_log=0
326     !
327     Remote=0
328     Kermit_exit=0
329     Kerm_esc$=CHR$(29)&"C"        ! CTRL-] C
330     SUBEXIT    !-----------------------------------------------------
331 Kci_err:  !
332     SELECT ERRN
333     CASE 90! mass storage system error
334       RESET 7       ! assumes mass storage on 7
335     CASE 76,72,52   ! bad unit code in msi, drive not found
336       DISP "Mass Storage Volume not On-line please enter a valid MSI "
337       OUTPUT KBD;Cur_msi$;"ÿH";
338       ENTER KBD;Cur_msi$
339       DISP 
340       Bad_msi=0
341       ERROR RETURN
342     CASE 163,167
343       CLEAR ERROR
344       ERROR RETURN
345     CASE ELSE
346       DISP ERRM$
347       PAUSE
348     END SELECT
349     RETURN 
350   SUBEND
351    !================  End of  Kermit Com Init ============================
352 Kermit:SUB Kermit
353     IF NOT Active THEN CALL Kermit_com_init
354     OPTION BASE 1
355     COM Version$,K$,Setup$
356     COM /Crt/ Crt_lines,Crt_width
357     COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
358     COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
359     COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
360     COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
361     COM /Frame/ Flow$,Hshake$
362     COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
363     COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas,Send_at
364     COM /Kerm/ INTEGER Image,Parflg,Pktdeb
365     COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol,Smark
366     COM /Kerm2/ State$,Cchksum$,Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
367     COM /Term/ Term_type$,S_log,D_log,Filewarn,Discard,@S_log,@D_log
368     COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
369     COM /Term/ Term_mode$
370     COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
371     COM /Mode/ Mode_line,Newline
372     COM /Def/ Define$(5,10)[30],No_define
373     COM /Portsc/ Sports(1:10)
374    !
375     DIM Kl$[300],Cmds$(1:80)[50]
376     DIM Init_cmd$[300],Cat$(1:1)[80]
377     DIM Def_cmd$[30],Filename$[256],Localname$[256]
378     DIM F$[80],F_path$[80],F_msi$[80],Fp$[80],Fm$[80],T_msi$[80],T_path$[80]
379     DIM Line$[512],Misc$[80],Msg$[80],Misc2$[80],Misc3$[80]
380     INTEGER Rc,Bdat_item
381  !---------------------------------------------------------------------------------
382  ! Entry point from Terminal Emulator - Kermit Shell
383     IF Remote=1 THEN GOTO Shell_entry
384  !---------------------------------------------------------------------------------
385  !  Initialize Serial Port
386     CALL Set_frame(Baud)  ! Other values passed in COM
387  !
388     CONTROL CRT,10;1
389     IF NOT Active THEN    ! Look for HPBINIT File
390       Active=1
391       PRINT TABXY(1,Crt_lines-1)
392       PRINT Version$
393       PRINT "? For Help"
394       PRINT 
395       Init_file=0
396       ASSIGN @File TO "HPBINIT";RETURN Rc
397       IF NOT Rc THEN Init_file=1
398     END IF
399     Remote=0
400     Kermit_exit=0
401     Prompt$="KERMIT-RMB>"
402     DISP 
403     IF Init_file THEN 
404       PRINT "KERMIT Initialization: "
405       PRINT 
406       Cmds$(1)="TAKE"
407       Cmds$(2)="HPBINIT"
408       GOTO Kermit_exec
409     END IF
410 Shell_entry: !------------------------------------------------------------------
411     Prompt$="KERMIT-RMB>"
412     REPEAT     ! Until Exit or Quit Command is given
413       ON ERROR GOSUB K_error
414 Parse1:  !
415       REPEAT   ! Until Kermit Command is Entered
416         OUTPUT KBD;Prompt$&Kl$;      ! kl$ may have errored kermit line
417         ENTER KBD;Kl$
418         Parse_kl(Kl$,Cmds$(*),No_cmds,Prompt$)  ! return Kl$ as Kl$(2..)
419       UNTIL No_cmds>0
420       DISP 
421       Msg$=" Not Recognized         "
422     !
423 Kermit_exec:  !
424  !
425  ! Notes on Kermit Shell:
426  !
427  ! Error Levels  1,2,3,4         That command is not a kermit command
428  ! Error Levels  20,30,40        That parameter is missing
429  ! Ni=1                          Valid Kermit Command Not Implemented
430  ! Err_level     -1              Print Msg$
431  !
432       ON ERROR GOSUB K_error
433       SELECT Cmds$(1)             ! Do a Select on the Kermit Command
434  !--------------------------------
435 A:    CASE ""
436 B:    CASE "BYE"
437         Ni=1
438 C:    CASE "CLEAR","CLR"       ! Clear Serial Buffer, cycle transfers
439         CALL Clear
440       CASE "CLS"
441         CLEAR SCREEN
442       CASE "CLOSE","CLO"
443         SELECT Cmds$(2)
444         CASE "PACKET","PAC","P"
445           D_log=0                 ! Close  PKT_LOG
446           OUTPUT @D_log;END
447           ASSIGN @D_log TO *
448         CASE "SESSION","SES","S"
449           S_log=0                 ! Close  SES_LOG
450           OUTPUT @S_log;END
451           ASSIGN @S_log TO *
452         CASE ELSE
453           Err_level=2
454         END SELECT
455       CASE "COMMENT","COM"
456         Ni=1
457       CASE "CONNECT","C","CON"
458         IF Cmds$(1)="C" THEN Cmds$(1)="CONNECT"
459         Remote=1
460         IF NOT In_term THEN 
461           CALL Terminal
462           PRINTER IS CRT
463           PRINT TABXY(1,Crt_lines);
464           In_term=0
465         ELSE
466           GOTO Ex      ! goto EXIT command code - don't respawn term
467         END IF
468         Supress_echo=1
469       CASE "CONVERT"               ! Unique Command
470         Misc$=Cmds$(2)    ! filename to convert
471         IF Cmds$(3)="TO" THEN 
472           New_type$=Cmds$(4)
473           IF LEN(Cmds$(5)) THEN Flen=VAL(Cmds$(5))
474         ELSE
475           New_type$=Cmds$(3)
476           IF LEN(Cmds$(4)) THEN Flen=VAL(Cmds$(4))
477         END IF
478         IF NOT LEN(New_type$) THEN 
479           PRINT "Usage:  CONVERT  <Filename> [TO] <Filetype> [Secors]"
480           PRINT "<Filetype>  -nnnn | ASCII | HPUX | BDAT | PROG "
481           Supress_echo=1
482         ELSE
483           IF Flen THEN 
484             CALL Convert(Misc$,New_type$,Rc,Flen)
485           ELSE
486             CALL Convert(Misc$,New_type$,Rc)
487           END IF
488         END IF
489       CASE "COPY"
490         IF Cmds$(3)="TO" THEN 
491           Cmds$(3)=Cmds$(4)      ! Normalize to cmds$(3)=destination
492         END IF
493         IF Cmds$(3)[1,1]=":" THEN   ! Add name to msi
494           Misc$=Cmds$(2)
495           Parse_filename(Misc$,F_msi$,F_path$)
496           Misc2$=Misc$      ! save filename
497           Misc$=Cmds$(3)
498           Parse_filename(Misc$,F_msi$,F_path$)
499           Cmds$(3)=F_path$&Misc2$&F_msi$
500         END IF
501 !
502         COPY Cmds$(2) TO Cmds$(3)
503       CASE "MSI","CD"
504         ON ERROR GOTO Nocwd
505         MASS STORAGE IS Cmds$(2)
506         GOTO Cwdok
507 Nocwd:  !
508         Msg$="Can't access: "&Cmds$(2)
509         Err_level=-1
510 Cwdok:  ON ERROR GOSUB K_error
511 D:    CASE "DEFINE","DEF"   ! Define a command macro
512       !
513       ! determine if macro is being defined or purged
514       !
515         Def_id=0
516         FOR I=1 TO No_define
517           IF Define$(I,1)=Cmds$(2) THEN   ! macro exists
518             Def_id=I
519             IF No_cmds=2 THEN      ! purge macro
520               FOR X=1 TO 10
521                 Define$(Def_id,X)=""
522               NEXT X
523               Def_id=-1
524             END IF
525           END IF
526         NEXT I
527         IF Def_id=0 THEN    ! create a new macro
528           No_define=No_define+1
529           Def_id=No_define
530           Define$(Def_id,1)=Cmds$(2)     ! macro name
531        !
532        ! need to pack commands up to comma
533        !
534           I=3
535           Def_cmd=2
536           REPEAT
537             IF Cmds$(I)="," THEN 
538               Define$(Def_id,Def_cmd)=Def_cmd$
539               Def_cmd=Def_cmd+1
540               Def_cmd$=""
541             ELSE
542               Def_cmd$=Def_cmd$&Cmds$(I)&" "
543             END IF
544             I=I+1
545           UNTIL I=No_cmds+1
546           Define$(Def_id,Def_cmd)=Def_cmd$
547           Def_cmd$=""
548         END IF! define macro
549        !
550       CASE "DELETE","DEL","PURGE"
551         PURGE Cmds$(2)
552         PRINT "Purged ";Cmds$(2)
553         Supress_echo=1
554       CASE "DIAL"           ! Call Terminal and Dial a Modem
555         Remote=1
556         Modem_init$="AT L2 C1"
557         CALL Terminal(Cmds$(2),Modem_init$,"HAYES")
558       CASE "DO"
559         Do=0
560         FOR I=1 TO No_define
561           IF Cmds$(2)=Define$(I,1) THEN Do=I
562         NEXT I
563         IF Do THEN 
564           PRINT "Executing Macro ";Define$(Do,1)
565           Shell=1
566           FOR I=2 TO 10
567             IF LEN(Define$(Do,I)) THEN 
568               PRINT "<exec> ";Define$(Do,I)
569               Kl$=Prompt$&Define$(Do,I)
570               Parse_kl(Kl$,Cmds$(*),No_cmds,Prompt$)! return Kl$ as Kl$(2..)
571               GOSUB Kermit_exec
572             END IF
573           NEXT I
574           Shell=0
575         ELSE
576           PRINT "Macro: ";Cmds$(2);"  not defined"
577         END IF
578       CASE "DUMP"                     ! Unique command to RMB
579         ON ERROR GOTO No_hexedit
580         CALL Hex_edit(Cmds$(2))
581         Supress_echo=1
582         GOTO Dump_exit
583 No_hexedit:!
584         ON ERROR GOSUB No_hexedit_file
585         Misc$="HPBMISC"
586         DISP "Loading Hex Editor, Please Wait ..."
587         LOADSUB Hex_edit FROM Misc$
588         DISP 
589         CALL Hex_edit(Cmds$(2))
590         GOTO Dump_exit
591 No_hexedit_file: !
592         DISP "Cant load Hex Editor  - file: HPBMISC not found - plese enter path and MSI  "
593         OUTPUT KBD;Misc$&Source_msi$;
594         ENTER KBD;Misc$
595         DISP 
596         ON ERROR GOTO Dump_exit
597         RETURN 
598 Dump_exit:  !
599       CASE "CAT","DIR"
600         IF LEN(Cmds$(2)) THEN 
601           CAT Cmds$(2)
602         ELSE
603           CAT 
604         END IF
605         Supress_echo=1
606 E:    CASE "ECHO"                     ! Macro Command
607         PRINT Kl$
608         Supress_echo=1
609       CASE "EDIT"                     ! Unique command to RMB
610         GOTO No_edit_yet
611         ON ERROR GOTO Load_editor
612         Parse_filename(Cmds$(2),F_msi$,F_path$)
613         IF NOT (LEN(F_msi$)) THEN F_msi$=S_msi$
614         IF NOT (LEN(F_path$)) THEN F_path$=S_path$
615         Filename$=F_path$&Cmds$(2)&F_mai$
616         CALL Edit(Filename$)
617         GOTO Edit_there
618 Load_editor:ON ERROR GOSUB K_error
619         LOADSUB ALL FROM "HPBEDIT"
620         CALL Edit(Cmds$(2),S_msi$,S_path$)
621 Edit_there:  !
622 No_edit_yet:!
623         Ni=1
624       CASE "EXIT"
625 Ex:     Kermit_exit=1
626         PRINTER IS CRT;EOL CHR$(10)
627 F:    CASE "FINISH"       ! Suspend Remote Server
628         Ni=1
629  !--------------------------------------------------------------------------
630 G:    CASE "GET"          ! Client Receive file via Server
631         Get_cmd=1
632         SELECT Cmds$(2)
633         CASE "?"
634           PRINT "Syntax:  GET  <Remote File> [<Local File> | , ]  [File Type] [File Length] "
635           PRINT "         GET  <Remote File> [<Local File> | , ]     <BDAT>  [# Records | , ] [Recl] "
636         CASE ELSE
637           Filename$=Cmds$(2)
638 !
639 !  Process Filename, MSI, and Path
640 !
641           IF LEN(Cmds$(3)) THEN 
642             Localname$=Cmds$(3)
643             IF LEN(Localname$) AND Localname$<>"," THEN 
644               CALL Parse_filename(Localname$,F_msi$,F_path$)
645             ELSE
646               Localname$=""
647             END IF
648      !
649             IF (LEN(F_msi$)=0) THEN  ! msi for incomming file not spec
650               F_msi$=D_msi$
651               F_path$=D_path$
652             END IF
653           END IF
654         !
655           IF LEN(Localname$) THEN 
656             K_receive(Filename$,F_msi$,F_path$,Ftype$,Recl,File_length,Get_cmd,Localname$)
657           ELSE
658             K_receive(Filename$,F_msi$,F_path$,Ftype$,Recl,File_length,Get_cmd)
659           END IF
660         END SELECT
661 !--------------------------------------------------------------------------
662 H:    CASE "HANGUP"             ! Disconnect Modem (lower DTR)
663         SELECT Com_card
664         CASE 98626,98644
665           STATUS Com_port,5;C5
666           CONTROL Com_port,5;BINAND(C5,254)
667         CASE 98628
668         CASE ELSE
669           DISP "UNKNOWN COM CARD ";Com_card
670         END SELECT
671       CASE "HELP","?"               ! ? as first command involkes full help
672         Kh=0
673         Help_filename$="HPBHELP"
674         REPEAT
675           ON ERROR GOTO No_help
676           CALL Kermit_help(Cmds$(*),No_cmds,Kl$)
677           Kh=1
678           GOTO Khdone
679 No_help:  OFF ERROR 
680           ON ERROR GOTO No_help_file
681           DISP "Loading Help File"
682           LOADSUB ALL FROM Help_filename$
683           GOTO Khdone
684           DISP 
685 No_help_file:OFF ERROR 
686           Help_found=0
687           DISP "Can't Find File - Give MSI "
688           OUTPUT KBD;Help_filename$;
689           ENTER KBD;Help_filename$
690           IF NOT POS(Help_filename$,":") THEN Kh=1
691           DISP 
692 Khdone:        !
693         UNTIL Kh
694         Supress_echo=1
695       CASE "HOST"          ! Send command for HOST execution
696         Ni=1
697 I:    CASE "INPUT"         ! Wait on COM Port for this ascii string
698         Ni=1
699 L:    CASE "LOCAL"         ! Execute a local BASIC command
700         ON ERROR GOTO Local_err   !Warning - doesn't trap kbd line execution
701         OUTPUT KBD;Kl$;"ÿE";
702         GOTO Local_exit
703 Local_err: !
704         PRINT ERRM$
705 Local_exit:OFF ERROR 
706         CLEAR LINE
707       CASE "LOG"        ! Session Log Commands
708         ON ERROR GOSUB K_error
709         Slog_try=0      ! Attemps to open file
710         Dlog_try=0
711         SELECT Cmds$(2)
712         CASE "SESSION","S","SES"          ! Activate session logging
713           S_log=1
714           IF S_log THEN 
715             IF LEN(Cmds$(3)) THEN 
716               Misc$=Cmds$(3)
717               Parse_filename(Misc$,Misc2$,Misc3$)
718               IF NOT LEN(Misc$) THEN Misc$="SES_LOG"
719               IF NOT LEN(Misc2$) THEN Misc2$=D_msi$
720               IF NOT LEN(Misc3$) THEN Misc3$=D_path$
721               S_log$=Misc3$&Misc$&Misc2$
722             END IF
723           END IF
724  !
725           REPEAT
726             Slog_try=Slog_try+1
727             ASSIGN @S_log TO S_log$;FORMAT ON,RETURN Rc
728             IF Rc THEN CREATE S_log$,10000
729             IF NOT Rc THEN Slog_open=1
730             IF Rc=76 THEN 
731               Slog_open=0
732               Slog_try=4
733             END IF
734           UNTIL (NOT Rc) OR (Slog_try>3)
735           IF Slog_try>3 THEN 
736             DISP "CAN'T OPEN ";S_log$
737             S_log=0
738           ELSE
739             DISP "Session Logging on to ";S_log$
740           END IF
741       !
742         CASE "PACKET","PAC","P"        ! Open Packet (debug) logging
743           D_log=1
744           IF D_log THEN 
745             IF LEN(Cmds$(3)) THEN 
746               Misc$=Cmds$(3)
747               Parse_filename(Misc$,Misc2$,Misc3$)
748               IF NOT LEN(Misc$) THEN Misc$="PKT_LOG"
749               IF NOT LEN(Misc2$) THEN Misc2$=D_msi$
750               IF NOT LEN(Misc3$) THEN Misc3$=D_path$
751               D_log$=Misc3$&Misc$&Misc2$
752             END IF
753           END IF
754         !
755           REPEAT
756             Dlog_try=Dlog_try+1
757             ASSIGN @D_log TO D_log$;RETURN Rc
758             IF Rc THEN CREATE ASCII D_log$,100
759             IF NOT Rc THEN Dlog_open=1
760             IF Rc=76 THEN 
761               Dlog_open=0
762               Dlog_try=4
763             END IF
764           UNTIL (NOT Rc) OR (Dlog_try>3)
765           IF Dlog_try>3 THEN PRINT "CAN'T OPEN ";D_log$
766           IF Dlog_try>3 THEN D_log=0
767         END SELECT
768         OFF ERROR 
769 M:    CASE "MU"
770         PRINT "Available Memory: ";SYSTEM$("AVAILABLE MEMORY")
771         Supress_echo=1
772 N: !
773 O:    CASE "OUTPUT","OUT"                  ! Pipe Output to Com Port
774         OUTPUT @Out_buff;Kl$
775 P:    CASE "PAUSE"                         !Macro command
776         WAIT VAL(Cmds$(2))
777       CASE "PRINT","TYPE","MORE"           ! (filename) [device]
778         Filename$=Cmds$(2)
779         IF Cmds$(1)[1,1]="P" THEN 
780           IF No_cmds>2 THEN 
781             Pdev=VAL(Cmds$(3))
782           ELSE
783             Pdev=701
784           END IF
785         ELSE   ! More or Type to Screen
786           Pdev=CRT
787         END IF
788         CALL More(Filename$,Pdev,Cmds$(1))
789       CASE "PROGRAM","PRO"
790         Ni=1
791       CASE "PUSH"  ! NA
792         Ni=1
793 Q:    CASE "QUIT","Q","QUI"
794         Kermit_exit=1
795 R:    CASE "RECEIVE","REC"      ! RECeive  <Filetype> <FILENAME | , >
796         SELECT Cmds$(2)
797         CASE "HP-UX","HPUX","ASCII","BDAT","PROG","SYSTM","BIN",""
798           Filetype$=Cmds$(2)
799           F$=Cmds$(3)    ! Filename, MSI, and Path are all part of
800           F_msi$=""      ! Cmds$(3)
801           F_path$=""
802           Rec=0          ! will be sent as "0" if not
803           Recl=0         ! specified in the command
804      !
805           IF No_cmds>3 THEN 
806             IF Cmds$(4)="," THEN 
807               Rec=0
808             ELSE
809               Rec=VAL(Cmds$(4))
810             END IF
811           END IF
812           IF No_cmds>4 THEN Recl=VAL(Cmds$(5))
813      !
814      ! RULES For Filespec:
815      !
816      ! 1. If Filename is given only then USE D_msi and D_path.
817      ! 2. If MSI is given with Filename then DON'T USE D_path.
818      ! 3. If PATH is given then use it with D_MSI
819      ! 4. If all three are given use all three.
820      !
821      !  Process Filename, MSI, and Path
822      !
823           IF LEN(F$) AND F$<>"," THEN 
824             CALL Parse_filename(F$,F_msi$,F_path$)
825           END IF
826      !
827           IF NOT (LEN(F_msi$)) THEN    ! msi given - invalidate path
828             F_msi$=D_msi$
829             F_path$=D_path$
830           END IF
831           IF Debug THEN DISP F$,F_msi$,F_path$
832           CALL K_receive(F$,F_msi$,F_path$,Filetype$,Recl,Rec,0)
833         CASE ELSE
834           PRINT "Syntax:  RECeive   [<Filetype>] [<FILENAME> | , ]  [File Length] "
835           PRINT "         RECeive    <BDAT>  [<FILENAME> | , ]  [# Records | , ] [Recl] "
836         END SELECT
837     !-------------------------------------------------------------
838         Supress_echo=1
839       CASE "REMOTE","REM"
840         Ni=1
841       CASE "RENAME","REN"
842         IF Cmds$(3)="TO" THEN 
843           Cmds$(3)=Cmds$(4)
844         END IF
845         RENAME Cmds$(2) TO Cmds$(3)
846       CASE "RUN"
847         Ni=1
848 S:    CASE "SEND","SEN"
849         IF NOT (LEN(Cmds$(2))) THEN Cmds$(2)="?"
850         SELECT Cmds$(2)
851         CASE "?"   ! Syntax Help
852           PRINT "usage:  SEND  <[Path] Filename [MSI]> [Bdat Item]"
853           PRINT "Bdat Item: <INTEGER | REAL>"
854           PRINT 
855         CASE ELSE
856           F$=Cmds$(2)
857           SELECT Cmds$(3)
858           CASE ""
859             Bdat_item=0  ! Not specified
860           CASE "INTEGER","INT","INTEGERS"
861             Bdat_item=1
862           CASE "REAL","REALS"
863             Bdat_item=2
864           CASE ELSE
865             Bdat_item=3
866           END SELECT
867           CALL K_send(F$,Bdat_item)
868         END SELECT
869         Supress_echo=1
870  !
871       CASE "SCRIPT","SCR"
872         Ni=1
873       CASE "SERVER","SER"
874         Ni=1
875  !
876 Set:  !----------------------------    SET COMMANDS   ---------------------
877  !
878       CASE "SET","S"
879         Cmds$(1)="SET"
880     !
881     !  Check for proper number of params ??
882     !
883         IF No_cmds=4 THEN          ! make sure all parms exist
884           ON ERROR GOSUB Valerr_4
885         ELSE
886           ON ERROR GOSUB Valerr_3
887         END IF
888      !
889         SELECT Cmds$(2)
890         CASE "?"
891           PRINT "BAUD     DEBUG       DEStination (DES)      SOURCE       DISPLAY"
892           PRINT "DUPLEX   ECHO        HandShake (HS)         ESCAPE       FILE   "
893           PRINT "FLOW     EOF         INComplete (ON=KEEP)   PORT         MARK   "
894           PRINT "REMOTE   RETRY       SEND        TAKE       TERM         TIMER     "
895           PRINT 
896           PRINT 
897         CASE ""
898           Err_level=20                      ! missing second parm
899         CASE "BAUD","SPEED","B"             ! set baud (rate)
900           IF POS(Kl$,"B ") THEN Kl$="BAUD"&Kl$[(POS(Kl$,"B"))+1]
901           Req_baud=VAL(Cmds$(3))
902           IF NOT Err_level THEN CALL Set_frame(Req_baud)
903         CASE "BLOCK-CHECK"
904           Ni=1
905         CASE "COLOR"
906           SELECT Cmds$(3) ! BLACK,WHite, etc
907           CASE "BLACK","BLK"
908             Apen=0
909           CASE "W","WHITE"
910             Apen=1
911           CASE "R","RED"
912             Apen=2
913           CASE "Y","YELLOW"
914             Apen=3
915           CASE "G","GREEN"
916             Apen=4
917           CASE "C","CYAN"
918             Apen=5
919           CASE "BL","BLUE"
920             Apen=6
921           CASE "M","MAGENTA"
922             Apen=7
923           END SELECT
924           SELECT Cmds$(4)
925           CASE "FG","ALPHA",""
926             CONTROL CRT,5;Apen
927           CASE "BG","BACKGROUND"
928             MOVE 0,0
929             AREA PEN Apen
930             RECTANGLE 1000,1000,FILL
931           CASE ELSE
932           END SELECT
933         CASE "DEBUG"                        ! set debug (on|off)
934           Debug=1
935           IF Cmds$(3)="OFF" THEN Debug=0
936         CASE "DEFAULT","DEF"
937           Msg$="Use SET SOURCE or SET DESTINATION commands"
938           Err_level=-1
939         CASE "DELAY"                ! My Delay before "S" init packet
940           Sdelay=Sval
941 Setd: !--------------------------------------------------------------------
942         CASE "DESTINATION","DES","DEST"   ! (Disc drive)
943           IF NOT LEN(Cmds$(3)) THEN      ! sync with SYSTEM$("MSI")
944             Misc$=SYSTEM$("MSI")
945             Parse_filename(Misc$,D_msi$,D_path$)
946             D_path$=D_path$&Misc$
947           ELSE  ! a mass storage device was given
948             REPEAT! strip off quotes from msvs
949               Qp=POS(Cmds$(3),"""""") ! check for quotes in string
950               IF Qp THEN Cmds$(3)[Qp,Qp]=""
951             UNTIL Qp=0
952  !
953             Misc$=TRIM$(Cmds$(3))
954             IF Misc$[1,1]="/" THEN   ! full path given
955               Parse_filename(Misc$,T_msi$,T_path$)   ! Misc$= Directory
956               T_path$=T_path$&Misc$&"/"   ! not valid until tested
957               IF LEN(Misc$)=0 THEN T_path$="/"  ! avoid //
958             ELSE  ! a relative directory given
959               IF Misc$[1,1]=":" THEN Setlif=1
960               Parse_filename(Misc$,T_msi$,T_path$)  ! temp paths
961               IF Setlif THEN 
962                 T_path$=""
963               ELSE
964                 T_path$=D_path$&Misc$&"/"
965                 IF LEN(Misc$)=0 THEN T_path$="/"! avoid //
966               END IF
967               Setlif=0
968             END IF
969             IF LEN(Misc$)=0 THEN D_path$="/"  ! if root / was given only
970  !
971             ON ERROR GOTO Nodmsi
972             MASS STORAGE IS T_path$&T_msi$
973             D_path$=T_path$   ! t_path$ OK make permanent
974             IF LEN(T_msi$) THEN D_msi$=T_msi$
975             GOTO Dmsiok
976 Nodmsi:     PRINT TABXY(1,Crt_lines);"Can't Access: ";T_path$&T_msi$;RPT$(" ",20)
977 Dmsiok:     OFF ERROR 
978           END IF
979 Sets:      !--------------------------------------------------------
980         CASE "SOURCE","SRC"
981           IF NOT LEN(Cmds$(3)) THEN      ! sync with SYSTEM$("MSI")
982             Misc$=SYSTEM$("MSI")
983             Parse_filename(Misc$,S_msi$,S_path$)
984             S_path$=S_path$&Misc$
985           ELSE  ! a mass storage device was given
986             REPEAT! strip off quotes from msvs
987               Qp=POS(Cmds$(3),"""""") ! check for quotes in string
988               IF Qp THEN Cmds$(3)[Qp,Qp]=""
989             UNTIL Qp=0
990  !
991             Misc$=TRIM$(Cmds$(3))
992             IF Misc$[1,1]="/" THEN   ! full path given
993               Parse_filename(Misc$,T_msi$,T_path$)   ! Misc$= Directory
994               T_path$=T_path$&Misc$&"/"   ! not valid until tested
995               IF LEN(Misc$)=0 THEN T_path$="/"  ! avoid //
996             ELSE  ! a relative directory given
997               IF Misc$[1,1]=":" THEN Setlif=1
998               Parse_filename(Misc$,T_msi$,T_path$)  ! temp paths
999               IF Setlif THEN 
1000                T_path$=""
1001              ELSE
1002                T_path$=S_path$&Misc$&"/"
1003                IF LEN(Misc$)=0 THEN T_path$="/"! avoid //
1004              END IF
1005              Setlif=0
1006            END IF
1007            IF LEN(Misc$)=0 THEN S_path$="/"  ! if root / was given only
1008 !
1009            ON ERROR GOTO Nosmsi
1010            MASS STORAGE IS T_path$&T_msi$
1011            S_path$=T_path$   ! t_path$ OK make permanent
1012            IF LEN(T_msi$) THEN S_msi$=T_msi$
1013            GOTO Dmsiok
1014 Nosmsi:    PRINT TABXY(1,Crt_lines);"Can't Access: ";T_path$&T_msi$;RPT$(" ",20)
1015 Smsiok:    OFF ERROR 
1016          END IF
1017 !-------------------------------------------------------------------------
1018        CASE "DISPLAY"          ! Set Display for kermit or terminal
1019          SELECT Cmds$(3)
1020          CASE "OFF"
1021            Display=0           ! Turn off display during file transfer
1022          CASE "ON","8","8BIT","8-BIT"
1023            Display=8           ! Show control chars on terminal screen
1024          CASE "7","7BIT","7-BIT"
1025            Display=7
1026          CASE ELSE
1027            Err_level=3
1028          END SELECT
1029        CASE "DUPLEX"               ! Set-Duplex-(HALF|FULL)
1030          Duplex$="FULL"
1031          SELECT Cmds$(3)
1032          CASE "ON","FULL"
1033            Duplex$="FULL"
1034          CASE "OFF","HALF"
1035            Duplex$="HALF"
1036            Ni=1
1037          END SELECT
1038 Se:    CASE "ECHO","LOCAL-ECHO"            ! set echo (local | remote)
1039          Lecho=1
1040          SELECT Cmds$(3)
1041          CASE "OFF","REMOTE"
1042            Lecho=0
1043          CASE "ON","LOCAL",""
1044            Lecho=1
1045          CASE ELSE
1046            Err_level=3
1047          END SELECT
1048        CASE "EOF"                        ! Set-EndOfFile-(CTRL-Z|NONE)
1049          SELECT Cmds$(3)
1050          CASE "CTRL-Z","Z","ON"
1051            Eof_mode$="CTRL-Z"            ! Append ^Z at end of ascii file
1052            Eof_mode=1
1053          CASE "NONE","OFF","NO CTRL-Z"
1054            Eof_mode$="NONE"
1055            Eof_mode=0
1056          CASE ELSE
1057            Err_level=3
1058          END SELECT
1059        CASE "ESCAPE","ESC"                 ! set escape
1060          Kerm_esc$[1,1]=TRIM$(UPC$(Cmds$(3)[1,1]))
1061 Sfi:   CASE "FILE","F"                     ! set file (parameters)
1062          SELECT Cmds$(3)   ![1,3]
1063          CASE "?"
1064            PRINT "NAME     MODE     WARNING (WARN)   SUPERCEDE (SUP)"
1065            PRINT 
1066            PRINT 
1067          CASE "NAME","NAM"            ! Set-File-Name
1068          CASE "TYPE","T","MODE"        ! Set-File-Type
1069            IMAGE=0
1070            SELECT Cmds$(4)
1071            CASE "BINARY","BIN","IMAGE","B"
1072              Image=1
1073            CASE ELSE
1074              Image=0
1075            END SELECT
1076          CASE "WARNING","WARN"         ! Set-File-Warning
1077            Filewarn=1
1078            IF Cmds$(4)="OFF" THEN Filewarn=0
1079          CASE "SUPERCEDE","SUP"        ! Set-File-Supercede
1080            Ni=1
1081          CASE ELSE
1082            Err_level=3
1083          END SELECT
1084 Sf:    CASE "FLOW-CONTROL","FLOW","FC"  !  Set-FlowControl
1085          SELECT Cmds$(3)
1086          CASE "XON","XOFF","X","XONXOFF"
1087            Flow$="XON/XOFF"
1088          CASE "ENQ","ENQ/ACK"
1089            Flow$="ENQ/ACK"
1090          CASE "NONE","OFF"
1091            Flow$="NONE"
1092          CASE ELSE
1093            Err_level=3
1094          END SELECT
1095 Sh:    CASE "HANDSHAKE","HS"   ! TURNAROUND CHAR
1096          Hshake$="NONE"
1097          IF Cmds$(3)="ON" THEN Hshake$="ON"
1098        CASE "IBM"
1099          Ni=1
1100        CASE "INCOMPLETE","INC" ! Set-Incomplete  (KEEP|DISCARD)
1101          Discard=0
1102          SELECT Cmds$(3)
1103          CASE "OFF","DISCARD","DIS"
1104            Discard=1
1105          CASE "ON","KEEP","K"
1106            Discard=0
1107          CASE ELSE
1108            Err_level=3
1109          END SELECT
1110        CASE "INPUT","INP"
1111          Ni=1
1112        CASE "KEY"
1113          Ni=1
1114 Sl: !
1115 Setport:CASE "PORT","LINE","LIN","POR","P"  ! set port number
1116          IF POS(Kl$,"P ") THEN Kl$="PORT"&Kl$[(POS(Kl$,"P"))+1]
1117          IF Cmds$(3)="?" THEN 
1118            PRINT "Serial Ports:  ";Sports(*)
1119            PRINT USING "//"
1120          ELSE
1121            Shutdown
1122            Com_port=VAL(Cmds$(3))
1123            STATUS Com_port,0;Id
1124            SELECT Id
1125            CASE 2
1126              Com_card=98626      ! COULD BE 98644 IF JUMPER IS CUT
1127            CASE 52
1128              Com_card=98628
1129            CASE 66
1130              Com_card=98644
1131            CASE 180
1132              BEEP 
1133              INPUT "98628 - REMOTE SW IS SET - PLEASE CORRECT ",Dum$
1134            END SELECT
1135            CALL Reset_port
1136          END IF
1137          Startup
1138 Sm:    CASE "MARKER","MAR","MARK"        ! set start-of-packet character
1139      !
1140      ! Takes form: SET MARK  <actual single character>  or
1141      !             SET MARK  ^A  notation
1142      !
1143          SELECT LEN(Cmds$(3))
1144          CASE 1
1145            Smark=NUM(Cmds$(3)[1,1])
1146          CASE 2
1147            Smark$=CHR$(FNCtl(Cmds$(3)[2,2]))   ! ^A  notation
1148            Smark=NUM(Smark$)
1149          CASE >2
1150            Err_level=3
1151          END SELECT
1152        CASE "MODE-LINE","ML","MODELINE"
1153          SELECT Cmds$(3)
1154          CASE "OFF"
1155            Mode_line=0
1156          CASE "ON"
1157            Mode_line=1
1158          END SELECT
1159        CASE "MODEM","MOD"
1160          SELECT Cmds$(3)
1161          CASE "VT100"
1162            Term$="VT100"
1163          CASE ELSE
1164            Err_level=3
1165          END SELECT
1166 Sn:    CASE "NEWLINE","NL"
1167          Newline=1
1168          SELECT Cmds$(3)
1169          CASE "ON"
1170            Newline=1
1171          CASE "OFF"
1172            Newline=0
1173          END SELECT
1174 Sp:    CASE "PARITY","PAR"
1175          SELECT Cmds$(3)
1176          CASE "ODD","EVEN","ZERO","MARK","SPACE","ONE"
1177            Parity_type$=Cmds$(3)
1178            Data_bits=7
1179          CASE "NONE"
1180            Parity_type$=Cmds$(3)
1181            Data_bits=8
1182          CASE "OFF","DISABLE"
1183            On_off$="OFF"
1184          CASE "ON","ENABLE"
1185            On_off$="ON"
1186          CASE ""
1187            Err_level=30
1188          CASE ELSE
1189            Err_level=4
1190          END SELECT
1191          CALL Set_frame(Baud)! Other values passed in COM
1192     !  CASE "PORT"                       ! same as LINE
1193        CASE "PROMPT"
1194          Prompt$=Cmds$(3)&">"
1195     !
1196     !  SET - REMOTE (receive)  KERMIT PARAMETERS
1197     !
1198 Sr:    CASE "RECEIVE","REC","REMOTE","REM"   ! SET  RECEIVE PARAMETERS
1199          ON ERROR GOSUB Valerr_4  ! CMDS$(4) MAY NEED TO BE A VALID NUMBER
1200          SELECT Cmds$(3)
1201          CASE ""
1202            Err_level=30
1203          CASE "?"
1204            PRINT "END-OF-PACKET (EOP)        PACKET-LENGTH (PL)"
1205            PRINT "PAD-CHARACTER (PC)         PADDING (PAD)"
1206            PRINT "START-OF-PACKET (MARK)     TIMEOUT (TMO)"
1207            PRINT 
1208        !
1209          CASE "END-OF-PACKET","EOP","EOL"
1210          CASE "PACKET-LENGTH","PL"    ! Set-Receive-PacketLength
1211            Rpsiz=VAL(Cmds$(4))
1212          CASE "PAD-CHARACTER","PC"    ! Set-Receive-PadChar
1213            Padchar$=Cmds$(4)
1214            Padchar=NUM(Padchar$)
1215          CASE "PADDING","PAD"
1216            Pad=VAL(Cmds$(4))
1217          CASE "PAUSE"
1218          CASE "START-OF-PACKET","SOP","MARK"
1219            Smark=NUM(Cmds$(4))
1220          CASE "TIMEOUT","TMO"                   ! set receive timeout
1221            Ptmo=VAL(Cmds$(4))
1222          CASE ELSE
1223            Err_level=3
1224          END SELECT
1225          OFF ERROR 
1226    !   End Of SET - RECEIVE commands
1227    !
1228        CASE "RETRY","RET"          ! Set the max retry limit
1229          Maxtry=VAL(Cmds$(3))
1230        CASE "SERVER"            ! Set Server (Timeout, etc)
1231          Ni=1
1232     !
1233     !  SET - LOCAL (SEND) KERMIT PARAMETERS ============
1234     !
1235 Ss:    CASE "SEND","SEN"          ! SET-SEND-[Parameter]-[value]
1236 Ssend:   ON ERROR GOSUB Valerr_4
1237          SELECT Cmds$(3)
1238          CASE "?"," ",""
1239            PRINT 
1240            PRINT "ATTRIBUTE (AT)             PACKET-LENGTH (PL)"
1241            PRINT "END-OF-PACKET (EOP)        PAD-CHARACTER (PC)"
1242            PRINT "PREFIX CONTROL             PADDING (PAD)"
1243            PRINT "PREFIX 8BIT                PREFIX REPEAT"
1244            PRINT "TIMEOUT (TIM)              START-OF-PACKET (SOP)"
1245            PRINT 
1246      !     Err_level=30
1247          CASE "AT","ATTRIB","ATTRIBUTE"
1248            Send_at=1
1249            IF POS(Cmds$(4),"OFF") THEN Send_at=0
1250          CASE "END-OF-PACKET","EOP","EOL"     ! SET-SEND-EOP
1251            Myeol$=Cmds$(4)
1252          CASE "PACKET-LENGTH","PL","LEN"      ! Set-Send-Packet Length
1253            Spsiz=VAL(Cmds$(4))
1254          CASE "PAD-CHARACTER","PC"
1255            Padchar$=Cmds$(4)
1256          CASE "PADDING","PAD"
1257            Mypad=VAL(Cmds$(4))
1258          CASE "PAUSE"
1259            Ni=1
1260          CASE "PREFIX"               ! set-send-prefix-[type]
1261            SELECT Cmds$(4)
1262            CASE "CONTROL"
1263              Myquote$=Cmds$(5)
1264            CASE "8BIT"
1265              Myprefix$=Cmds$(5)
1266            CASE "REPEAT","REP"
1267              Myrepeat$=Cmds$(5)
1268            END SELECT
1269          CASE "TIMEOUT","TIM"       ! set-send-timeout-[value]
1270            Mytmo=VAL(Cmds$(4))
1271          CASE "START-OF-PACKET","SOP"
1272          END SELECT !   SET - SEND options
1273    !
1274    !  END OF SET-SEND PARAMETERS =====================
1275    !
1276 St:    CASE "TAKE","TAKE-ECHO"
1277          Take_echo=1
1278          IF Cmds$(3)="OFF" THEN Take_echo=0
1279          IF Cmds$(3)<>"ON" AND Cmds$(3)<>"OFF" THEN Err_level=3
1280        CASE "TERMINAL","TERM","T"               ! Set-Terminal
1281          Term_type$="VT100"
1282          SELECT Cmds$(3)
1283          CASE "VT100"
1284            Term_type$="VT100"
1285          CASE "VT102"
1286            Term_type$="VT102"
1287          CASE "MODE"
1288            SELECT Cmds$(4)
1289            CASE "APPL","APPLICATION"
1290              Term_mode$="APPL"
1291            CASE "NUM","NUMERIC"
1292              Term_mode$="NUMERIC"
1293            CASE ELSE
1294              PRINT "Syntax:  SET TERM MODE <APPL | NUMERIC>"
1295              Err_level=4
1296            END SELECT
1297          CASE ELSE
1298            PRINT TABXY(1,Crt_lines);"Terminal Type ";Cmds$(3);"  Not Implemented - How would you like to write one ?"
1299          END SELECT
1300        CASE "TIMER","TIM"                       ! Set-Timer (ON|OFF)
1301          Timer=1
1302          IF Cmds$(3)="OFF" THEN Timer=0
1303        CASE "TRANSLATION","TRA","TRANS"
1304          Ni=1
1305        CASE "WINDOW","WIN"
1306          Ni=1
1307        CASE ELSE
1308          Err_level=2
1309        END SELECT     ! KERMIT SET COMMAND
1310        OFF ERROR 
1311   !=======================================================================
1312   !            END  OF  SET  COMMANDS
1313   !=======================================================================
1314 Sz:!
1315 Show:CASE "SHOW","SHO"     ! SHOW THE SET PARAMETERS
1316        PRINT 
1317        SELECT Cmds$(2)
1318        CASE "COMMUNICATIONS","COM","COMM","TERMINAL","TERM"
1319          PRINT "TERMINAL TYPE",TAB(35);Term_type$
1320          PRINT "BAUD RATE",TAB(35);Baud
1321          PRINT "COM PORT",TAB(35);Com_port
1322          PRINT "LOCAL ECHO",TAB(35);Local_echo
1323          PRINT "HANDSHAKE",TAB(35);Hshake$
1324          PRINT "PARITY",TAB(35);Parity_type$,On_off$
1325          PRINT "FLOW CONTROL",TAB(35);Flow$
1326          PRINT "DEBUG",TAB(35);Debug
1327          PRINT "MODEM LINES ACTIVE:  ";TAB(35);
1328          STATUS Com_port,11;Ml
1329          IF BIT(Ml,4) THEN PRINT "CTS  ";
1330          IF BIT(Ml,5) THEN PRINT "DSR  ";
1331          IF BIT(Ml,6) THEN PRINT "RI  ";
1332          IF BIT(Ml,7) THEN PRINT "CD  ";
1333          PRINT 
1334          PRINT "TERMINAL LINES ACTIVE:  ";TAB(35);
1335          STATUS Com_port,5;Ml
1336          IF BIT(Ml,0) THEN PRINT "RTS  ";
1337          IF BIT(Ml,1) THEN PRINT "DTR  ";
1338          PRINT 
1339        CASE "FILE"
1340          PRINT "CURRENT MSI",TAB(35);Cur_msi$
1341          PRINT "DEFAULT MSI",TAB(35);D_path$,D_msi$
1342          PRINT "EOF MODE",TAB(35);Eof_mode$
1343          PRINT "INCOMPLETE FILE",TAB(35);Discard
1344          PRINT "FILE OVERWRITE",TAB(35);File_warn
1345          PRINT "TAKE ECHO",TAB(35);Take_echo
1346          PRINT "ATTRIBUTE PACKETS",TAB(35);Att_on
1347        CASE "LOGGING","LOG"
1348          PRINT "PACKET LOGGING",TAB(35);D_log
1349          PRINT "PACKET LOG FILE",TAB(35);D_log$
1350          PRINT "SESSION LOGGING",TAB(35);S_log
1351          PRINT "SESSION LOG FILE",TAB(35);S_log$
1352        CASE "MACRO","MAC"
1353          IF No_define THEN 
1354            PRINT USING VAL$(No_define)&"(10(K,2(X)),/)";Define$(*)
1355          ELSE
1356            PRINT "No MACROs currently defined"
1357          END IF
1358        CASE "MODEM"
1359          PRINT "NOT IMPLEMENTED"
1360        CASE "PROTOCOL"
1361          CALL Kstatus
1362        CASE "SERVER"
1363          PRINT "NOT IMPLEMENTED"
1364        CASE ELSE
1365          PRINT "Syntax:  COMM , TERMINAL , FILE , LOG , MODEM , MACRO , PROTOCOL "
1366        END SELECT
1367        PRINT 
1368        Supress_echo=1
1369     !
1370      CASE "SPACE","SPA"
1371        IF NOT LEN(Cmds$(2)) THEN Cmds$(2)=D_msi$
1372        Disc_space(Cmds$(2),Total,Largest_hole,Hole_sum,Format$)
1373        Cmds$(2)=":"&Cmds$(2)[POS(Cmds$(2),",")]
1374        CLEAR SCREEN
1375        PRINT TABXY(1,Crt_lines);
1376        PRINT "Volume:        ";Cmds$(2)
1377        PRINT "Format:        ";Format$
1378        PRINT "Space:         ";Total;TAB(35);Total*256
1379        PRINT "Frags:         ";Hole_sum;TAB(35);Hole_sum*256
1380        PRINT "Largest Hole:  ";Largest_hole;TAB(35);Largest_hole*256
1381        PRINT 
1382        Supress_echo=1
1383      CASE "STATISTICS"
1384        Ni=1
1385      CASE "STATUS","STAT"       !
1386        CALL Kstatus
1387        Supress_echo=1
1388      CASE "SUBMIT","SUB"    ! BATCH PROCESS
1389        Ni=1
1390 T:   CASE "TAKE","TAK"             ! execute a command file
1391        ASSIGN @File TO Cmds$(2);RETURN Rc
1392        IF Rc THEN GOTO Take_done
1393        Init_file=1
1394        Shell=1
1395        IF NOT Init_file THEN PRINT TABXY(1,Crt_lines);"KERMIT Initialization File"
1396        REPEAT
1397          Init_cmd$=""
1398          ENTER @File;Init_cmd$
1399          Init_cmd$=UPC$(Init_cmd$)
1400          Init_cmd$=Init_cmd$[POS(Init_cmd$,"!")+1]
1401          Cmt=POS(Init_cmd$,"!")
1402          IF Cmt THEN Init_cmd$=Init_cmd$[1,POS(Init_cmd$,"!")-1]      ! extract from line comment
1403          IF NOT LEN(TRIM$(Init_cmd$)) THEN GOTO Skip_cmd
1404          IF POS(Init_cmd$,"STOP") THEN 
1405            Init_file=0
1406            Kl$=""
1407          ELSE
1408            Cmt=POS(Init_cmd$,"COMMENT")
1409            IF NOT Cmt THEN 
1410              Kl$=Prompt$&Init_cmd$
1411              Parse_kl(Kl$,Cmds$(*),No_cmds,Prompt$)! return Kl$ as Kl$(2..)
1412              PRINT Cmds$(1)&" ";Kl$
1413              GOSUB Kermit_exec
1414            END IF
1415          END IF
1416 Skip_cmd:       !
1417        UNTIL Init_file=0
1418        Shell=0
1419        Supress_echo=1
1420 Take_done:DISP 
1421      CASE "TRANSMIT","TRANS"     ! Transmit <filename> [format on/off]
1422        IF NOT LEN(Cmds$(3)) THEN 
1423          IF Cmds$(3)<>"OFF" AND Cmds$(3)<>"ON" THEN 
1424            INPUT "Read File with Format ON or OFF ? ",Cmds$(3)
1425            Cmds$(3)=UPC$(Cmds$(3))
1426          END IF
1427          CALL Transmit(Cmds$(2),Cmds$(3))
1428        ELSE
1429          CALL Transmit(Cmds$(2))
1430        END IF
1431   !  CASE "TYPE"  ! same as  PRINT
1432 V:   CASE "VER","VERSION"
1433        PRINT TABXY(1,Crt_lines);Version$
1434 W:   CASE "WHO"
1435        Ni=1
1436 X:   CASE "XYZZY"
1437        Msg$="I see no cave here."
1438        Err_level=-1
1439      CASE ELSE
1440 Y:     Err_level=1   ! invalid kermit command
1441 Z:!
1442      END SELECT  ! KERMIT COMMANDS
1443 !-------------------------------------------------------------------------
1444   !
1445   ! Process Err_level or echo command
1446   !
1447      SELECT Err_level
1448      CASE 0   ! Valid command - check if implemented before echoing
1449        IF Ni THEN 
1450          PRINT Cmds$(1)&"  "&Kl$&"  NOT IMPLEMENTED"
1451        ELSE
1452          IF (Display AND (NOT Init_file)) OR (Init_file AND Take_echo) THEN 
1453            IF (NOT In_term) AND (NOT Supress_echo) THEN 
1454              PRINT Cmds$(1)&" "&Kl$&RPT$(" ",80)! command executed OK
1455            END IF
1456          END IF
1457        END IF
1458        Kl$=""
1459      CASE -1
1460        PRINT Msg$
1461      CASE 1
1462        PRINT CHR$(129);Cmds$(Err_level);CHR$(128);" not a KERMIT command"
1463      CASE 2,3,4
1464        Line$=""
1465        FOR I=1 TO Err_level-1
1466          Line$=Line$&Cmds$(I)&" "
1467        NEXT I
1468        PRINT Line$&CHR$(129);Cmds$(Err_level);CHR$(128);" ";Msg$
1469      CASE 20,30,40
1470        Err_level=Err_level/10
1471        PRINT "Parameter # ";Err_level;"  Required"
1472      CASE ELSE
1473      END SELECT
1474  !
1475      IF Err_level THEN 
1476        IF Err_level>1 THEN Kl$=Cmds$(1)&" "
1477        IF Err_level>2 THEN Kl$=Kl$&Cmds$(2)&" "
1478        IF Err_level>3 THEN Kl$=Kl$&Cmds$(3)&" "
1479        IF Err_level=1 THEN 
1480          Kl$=""
1481        END IF
1482        Err_level=0
1483      END IF
1484      Ni=0
1485      Supress_echo=0
1486      IF Shell THEN RETURN     ! recursive gosub to kermit command parser
1487    UNTIL Remote OR Kermit_exit
1488    SUBEXIT
1489 !---------------------------------
1490 Valerr_4:  ! BAD VALUE IN SET-RECEIVE
1491    Err_level=4
1492    IF NOT LEN(Cmds$(4)) THEN Err_level=40
1493    ERROR RETURN
1494    RETURN 
1495 !------------------------------------
1496 Valerr_3:!
1497    Err_level=3
1498    IF NOT LEN(Cmds$(3)) THEN Err_level=30  ! missing third parameter
1499    ERROR RETURN
1500    RETURN 
1501 !------------------------------------------
1502 K_error: !
1503    SELECT ERRN
1504    CASE 76        ! INCORRECT MSVS
1505      PRINT ERRM$
1506      Rc=76
1507      ERROR RETURN
1508    CASE 59        ! EOF
1509      Init_file=0
1510      PRINT "End OF File"
1511      ERROR RETURN
1512    CASE ELSE
1513      PRINT "KERMIT: ";ERRM$
1514      ERROR RETURN
1515    END SELECT
1516    RETURN 
1517 !-----------------------------------------
1518  SUBEND
1519 !=====================================================================
1520 Parser:SUB Parse_kl(Kl$,Cmds$(*),No_cmds,Prompt$)
1521 Parse:!
1522    Kl$=TRIM$(UPC$(Kl$))
1523    DIM Kl_return$[100]
1524    MAT Cmds$= ("")
1525    Begin_cmd=POS(Kl$,Prompt$)+LEN(Prompt$)
1526    IF Begin_cmd=LEN(Prompt$) THEN SUBEXIT
1527    Kl$=TRIM$(Kl$[Begin_cmd,LEN(Kl$)])   ! SEPARATE OFF PROMPT
1528    I=0
1529    REPEAT
1530      I=I+1
1531      Cmd_end=POS(Kl$," ")
1532      IF Cmd_end=0 THEN      ! IF NO BLANKS THEN KL$= LAST COMMAND
1533        Cmds$(I)=Kl$[1,80]
1534        No_cmds=I
1535        Parse_done=1
1536      ELSE
1537        Cmds$(I)=Kl$[1,Cmd_end-1]
1538      END IF
1539      IF I=2 THEN Kl_return$=Kl$         ! No, Return Null if single cmd
1540      Kl$=TRIM$(Kl$[Cmd_end+1])          ! TRUNCATE KL$
1541    !
1542    ! Return the argument line (cmd 2-end) as Kl$
1543    !
1544   !
1545   ! Eliminate any Quote Marks in Command
1546   !
1547      REPEAT
1548        Qm=POS(Cmds$(I),"""")
1549        IF Qm THEN Cmds$(I)[Qm,Qm]=" "
1550      UNTIL Qm=0
1551      Cmds$(I)=TRIM$(Cmds$(I))
1552   !
1553    UNTIL Parse_done
1554    Kl$=Kl_return$
1555  SUBEND
1556 !=========================================================================
1557 Transmit:SUB Transmit(Filename$,OPTIONAL Fmt$)
1558 Tr:!
1559    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
1560    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
1561    DIM Line$[256],Out_buff$[512] BUFFER,K$[80],A$[1]
1562    REAL Real_no
1563    INTEGER Int_no,Slow,Abort_txmit
1564  !
1565  ! PRINTER IS CRT;EOL ("
"),WIDTH OFF
1566    ON ERROR GOSUB Txmit_err
1567    Fmt_onoff$="ON"
1568    IF NPAR>1 THEN Fmt_onoff$=Fmt$
1569    REPEAT
1570      IF Fmt_onoff$="OFF" THEN 
1571        ASSIGN @File TO Filename$;FORMAT OFF,RETURN Rc
1572      ELSE
1573        ASSIGN @File TO Filename$;FORMAT ON,RETURN Rc
1574      END IF
1575      IF Rc<>0 THEN  ! File Couldn't Be Opened
1576        DISP "Can't open file:  ";Filename$;"  (blank name to abort)"
1577        OUTPUT KBD;Filename$;"ÿH";
1578        ENTER KBD;Filename$
1579        Filename$=TRIM$(Filename$)
1580        DISP 
1581        IF NOT (LEN(Filename$)) THEN SUBEXIT
1582      END IF
1583    UNTIL Rc=0
1584  !
1585    DISP "Transmitting FILE: ";Filename$;"   CTRL-C to Exit   CTRL-S  Screen"
1586 Get_type:STATUS @File,1;File_type
1587    SELECT File_type
1588    CASE 2    ! BDAT
1589      INPUT "ASCII / INTEGERS / REALS  ?  [ A / I / R ] ",Data_type$
1590    CASE 3    ! ASCII
1591      Data_type$="ASCII"
1592    CASE 4    ! HPUX
1593      Data_type$="ASCII"
1594    END SELECT
1595    ON END @File GOTO Txmit_done
1596    ON KBD,2 GOSUB K_serve
1597    Startup
1598    Scr_echo=1
1599    LOOP
1600    EXIT IF Abort_txmit=1
1601      SELECT UPC$(Data_type$[1,1])
1602      CASE "A"
1603        ENTER @File;Line$   ! Enter the line and convert to Ascii
1604        OUTPUT @Out_buff;Line$     ! Line Used for DMA Transmit
1605        IF Scr_echo THEN PRINT Line$
1606      CASE "R"
1607        DISP "Transmitting REALS from FILE: ";File_name$
1608        LOOP
1609          ENTER @File;Real_no
1610          DISP "TRANSMITTING RECORD # ";Rec,Line$
1611          OUTPUT @Out_buff;Real_no   ! This Will Convert REAL to Ascii
1612          IF Scr_echo THEN PRINT Real_no
1613        END LOOP
1614      CASE "I"
1615        ENTER @File;Int_no
1616        OUTPUT @Out_buff;Int_no
1617        IF Scr_echo THEN PRINT Int_no
1618      CASE ELSE
1619        BEEP 
1620        INPUT "BAD DATA TYPE - INPUT AGAIN ",Data_type$
1621      END SELECT
1622      Rec=Rec+1
1623      GOSUB Response
1624    END LOOP
1625 Txmit_done:  !
1626    INPUT "Enter any End-of-file mark to send: ",Endofile$
1627    IF LEN(Endofile$) THEN 
1628      OUTPUT @Out_buff;Endofile$
1629    END IF
1630    DISP "File Transfer Complete "
1631    ASSIGN @File TO *
1632    OFF ERROR 
1633    OFF KBD
1634    Shutdown
1635    SUBEXIT    ! Return to Kermit
1636 !-----------------------------------------------------------------------
1637 Response:!
1638    DISABLE 
1639    IF Com_card=98628 THEN 
1640      STATUS Com_port,5;In_length
1641    ELSE
1642      STATUS @In_buff,4;In_length
1643    END IF
1644  !
1645    WHILE In_length
1646      ENTER @In_buff USING "#,A";A$
1647      Char=NUM(A$)
1648 Handle_char: !
1649      SELECT Char
1650      CASE 32 TO 126      ! sp to ~
1651        PRINT A$;
1652    !-----------------------------------------
1653    ! SELECTED CONTROL CHARACTERS
1654    !-----------------------------------------
1655      CASE 5                        !""         ! ENQ/ACK
1656        OUTPUT @Out_buff;CHR$(6);
1657      CASE 10
1658        PRINT "
";
1659      CASE 13
1660        PRINT "";
1661      CASE 7
1662        BEEP 800,.1
1663      CASE 8                          !     Backspace
1664        STATUS CRT,0;Cx
1665        CONTROL CRT,0;MAX(Cx-1,1)
1666      CASE 17    !
1667        K$=KBD$
1668        ENABLE 
1669        RETURN 
1670      CASE ELSE
1671        WAIT .3
1672      END SELECT
1673 Skip_cp:   !
1674      IF Com_card=98628 THEN 
1675        STATUS Com_port,5;In_length
1676      ELSE
1677        STATUS @In_buff,4;In_length
1678      END IF
1679    END WHILE
1680    ENABLE 
1681    RETURN 
1682 !--------------------------------------
1683 Txmit_err:  !
1684    BEEP 
1685    DISP ERRM$&"  PAUSED "
1686    PAUSE
1687    RETURN 
1688!---------------------------------------
1689 K_serve: !
1690    K$=KBD$
1691    SELECT K$
1692    CASE "ÿE","ÿÿE"
1693      Abort_txmit=0
1694    CASE ""            ! CTRL-S
1695      IF Scr_echo THEN 
1696        Scr_echo=0
1697      ELSE
1698        Scr_echo=1
1699      END IF
1700    CASE ELSE
1701      Abort_txmit=1
1702    END SELECT
1703    Ok_cont=1
1704    RETURN 
1705  SUBEND
1706!======================================================================
1707  SUB Terminal(OPTIONAL Phone$,Modinit$,Modem$)
1708    OPTION BASE 1
1709    COM Version$,K$,Setup$
1710    COM /Crt/ Crt_lines,Crt_width
1711    COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
1712    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
1713    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
1714    COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
1715    COM /Frame/ Flow$,Hshake$
1716    COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
1717    COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
1718    COM /Term/ Term_mode$
1719    COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
1720    COM /Mode/ Mode_line,Newline
1721 !
1722    DIM A$[80],Hlchar$[1]
1723    DIM Key1$[1],Key2$[1],Key3$[1],Esc_seq$[5]
1724    INTEGER Cx,Cy,Save_cx,Save_cy,Hl,Hlx,Hly,Ie,If,Il
1725    INTEGER Key1,Key2,Key3,Oe,Of,Ol
1726    INTEGER Max_buff,Xoff,R_xoff
1727    DIM File_buff$[256]
1728    Max_buff=MAXLEN(File_buff$)
1729    DIM Line$[256]
1730    DIM Dial_ext$[80]
1731 !
1732 ! Vt100 escape processor  (Receive_char)
1733 !
1734    DIM Esc_seq_str$[20]      !  ,Esc_buf$(0:10)[1]
1735    INTEGER Esc_colon(0:5)
1736    INTEGER Pn0,Pn1,Pn2,Pn3
1737    INTEGER Buf_ptr,Ec,Esc_length,Max_esc_length
1738 !
1739 Term:!
1740    Max_esc_length=10     ! tunable - max length for vt100 seq before abort
1741    Blink=.2                               ! cursor speed
1742    IF Debug THEN Blink=100
1743    In_term=1                              ! In-Terminal Flag
1744  ! IF Crt_lines>26 THEN ALPHA HEIGHT 31   ! 24 line terminal emulator
1745  !
1746  ! Trying to get a 24 line emulator - needs work
1747  !
1748    SYSTEM PRIORITY 0               ! In case terminal is accidentally
1749                                    ! entered recursively form kermit
1750    !-------------------------------]
1751    ! Interrupt Levels for TERM:
1752    !
1753    ! 1- Idle Loop - Receive Char
1754    !    ON TIMEOUT - Com_port
1755    !    ON CYCLE Blink Cursor
1756    ! 3- ON KBD Send Character KBD
1757    ! 4-
1758    ! 5- ON INTR COM_PORT
1759    !--------------------------------
1760    PRINTER IS CRT;EOL (CHR$(10)),WIDTH OFF
1761  ! CONTROL CRT,21;1                     ! clear screen and color map
1762    CLEAR SCREEN
1763    IF NOT Debug THEN CONTROL CRT,10;0   ! CURSOR OFF
1764    Cx=1
1765    Cy=1
1766    CONTROL CRT,0;Cx,Cy                  ! home cursor
1767    Hlx=1                                ! cursor highlight position
1768    Hly=1
1769   !------------------  SET  ON-EVENTs  Before TRANSFER starts
1770    CALL Shutdown        !shutoff transfers if on
1771 !  ON INTR Com_port,5 GOSUB Term_intr
1772    SELECT Com_card
1773    CASE 98626,98644
1774      CONTROL Com_port,5;1+2            ! Force DTR and RTS Active
1775      IF Hshake$="NONE" THEN            ! Disable Modem HS Lines
1776        CONTROL Com_port,12;128+32+16   ! 128=DTR  32=RTS  16=CTS
1777      ELSE
1778        CONTROL Com_port,12;0       ! Enable Modem HS Lines
1779      END IF
1780  !   ENABLE INTR Com_port;8+4
1781    CASE 98628
1782      CONTROL Com_port,8;1+2        ! RTS  DTR  Set Active
1783    ! CONTROL Com_port,13;164       ! INT MASK  UART/lost car/break
1784    ! CONTROL 23; for HS Lines
1785    END SELECT
1786   !----------------------------------
1787    ON ERROR GOSUB Term_err
1788    ON KBD,3 GOSUB Send_char
1789    ON TIMEOUT Com_port,10 GOSUB Com_tmo
1790    IF NOT Debug THEN ON CYCLE Blink,1 GOSUB Blink
1791    CALL Startup
1792    STATUS @In_buff,2;Inbuff_size
1793    Inbuff_max=.8*Inbuff_size
1794    Inbuff_min=.6*Inbuff_size
1795    GOSUB Disp_modeline
1796    IF NPAR THEN GOSUB Dial_modem
1797    REPEAT
1798      GOSUB Get_inlength                        ! XON / XOFF
1799      IF In_length THEN 
1800        GOSUB Receive_char
1801      END IF
1802    UNTIL Remote=0             ! terminal escape seq trapped in Send_char
1803!
1804    CONTROL CRT,10;1           ! restore system cursor
1805    IF Hl THEN GOSUB Blink     ! remove cursor turds
1806    In_term=0                  ! notify Kermit we're out
1807    SUBEXIT
1808 !========================================================================
1809 Disp_modeline:!
1810    GCLEAR
1811    IF Mode_line THEN 
1812      WINDOW 0,80,26,0
1813      MOVE 0,26
1814      CSIZE 3
1815      Kesc_char$=CHR$(NUM(Kerm_esc$[1,1])+64)
1816      LABEL "ESC: ^";Kesc_char$;"C  ";Baud;Data_bits;Parity_type$;"  ";On_off$;
1817      IF S_log THEN LABEL "  LOG"
1818    END IF
1819    RETURN 
1820 !-------------------------------------------------------------------------
1821 Term_intr: !
1822    CALL Com_interrupt
1823 !
1824 ! ON INTR BRANCHES Must be setup with transfers off
1825 !
1826    Shutdown
1827 !  ON INTR Com_port,5 GOSUB Term_intr
1828    SELECT Com_card
1829    CASE 98628
1830      CONTROL Com_port,13;164      ! MASK  4=UART  32=lost carr 128=break
1831    CASE 98626,98644
1832  !   ON INTR Com_port,1 GOSUB Term_intr
1833      ENABLE INTR Com_port;8+4
1834    END SELECT
1835    ON ERROR GOSUB Term_err
1836    Startup
1837    RETURN 
1838 !----------------------------------------------------------------------
1839 Blink:!
1840    IF NOT Hl THEN 
1841   !
1842   ! Produce underscore at current print position
1843   ! Establish the current (legal) print position
1844   ! And read the crt character at that position
1845   !
1846      DISABLE        ! disable kbd interrupt
1847      STATUS CRT,0;Hlx,Hly
1848      Hly=MAX(Hly,1)
1849      IF Hly>Crt_lines THEN 
1850        Need_scroll=1
1851        Hly=MIN(Crt_lines,Hly)    ! hlx=20 after CR on line 19
1852      END IF
1853    !
1854      IF Hlx>80 THEN          ! fixes bug with pos 81 printing in pos 80
1855        Hlx=80
1856        Wrap=1
1857        CONTROL CRT,0;Hlx,Hly ! move to 80
1858        IF Hly<=Crt_lines THEN ENTER CRT USING "#,K";Hlchar$
1859      ELSE
1860        ! leave cx and cy where they are
1861        IF Hly<=Crt_lines THEN ENTER CRT USING "#,K";Hlchar$
1862      END IF
1863    !
1864    ! If crt char is null then make it a space
1865    !
1866      IF Hlchar$="" THEN Hlchar$=" "
1867      STATUS CRT,4;Dfm   ! Check Display Functions Mode
1868      IF NOT Dfm THEN    ! Don't display CHR$(132) with Display functions on
1869    !
1870    ! Draw (or redraw) the character with an underscore
1871    !
1872        PRINT TABXY(Hlx,Hly);CHR$(132);Hlchar$;CHR$(128);
1873      END IF
1874    !
1875    ! Wrap flag indicates that the cursor has moved to a new line
1876    !
1877      IF Need_scroll THEN 
1878        PRINT 
1879        Need_scroll=0
1880      END IF
1881  !
1882      IF Wrap THEN              ! wrap around, but leave hlx,hly at 81,hly
1883        CONTROL CRT,0;1,Hly+1
1884        Wrap=0
1885      ELSE
1886        CONTROL CRT,0;Hlx,Hly   ! highlighting pushes cursor ahead 1 pos
1887      END IF
1888    !
1889      Hl=1
1890      ENABLE 
1891  ! END IF
1892  !
1893    ELSE      !============================================================
1894 Unblink: !
1895 Ub:!
1896  ! Un-blink, remove the underscore
1897  !
1898      DISABLE 
1899      IF Bld THEN PAUSE
1900  !
1901  !  Record current print position
1902  !  Move to underscore highlight
1903  !
1904      STATUS CRT,0;Cx,Cy      ! remember current cursor
1905      IF Ub THEN PAUSE
1906      !
1907      IF Cy>Crt_lines THEN 
1908        Need_scroll=1
1909  !  Cy=Crt_lines                 ! leave cy=20
1910  !   Cy=MIN(Crt_lines,Cy)
1911      END IF
1912      CONTROL CRT,0;Hlx,Hly   ! locate to old cursor position
1913  !
1914  ! Enter the crt char at the old underscore
1915  !
1916      IF Hly<=Crt_lines THEN ENTER CRT USING "#,K";Hlchar$  ! #A doesn't enter null
1917  !
1918  ! The underscore can't be a null (remove this code)
1919  !
1920  ! CRT space characters get entered as nulls ???
1921  !
1922      IF Hlchar$="" THEN 
1923        Hlchar$=" "                                ! avoid null
1924      ELSE  ! we have just cleared a character at the end of the line - move
1925        IF Cx=80 THEN     ! wrap around
1926          IF Hlx=80 THEN 
1927            Cy=MIN(Crt_lines,Cy+1)
1928            Cx=1
1929          END IF
1930        END IF
1931      END IF
1932   !
1933   ! redraw the character without the underscore
1934   !
1935      STATUS CRT,4;Dfm
1936      IF NOT Dfm THEN 
1937        PRINT TABXY(Hlx,Hly);CHR$(128);Hlchar$;        ! unhighlight
1938      END IF
1939   !
1940   ! Restore the current print position
1941   !
1942      IF Need_scroll THEN 
1943        PRINT 
1944        Need_scroll=0
1945      END IF
1946   !
1947      CONTROL CRT,0;Cx,Cy
1948      Hl=0
1949      ENABLE 
1950    END IF  ! hl on or not
1951    IF Debug THEN ON CYCLE Blink,1 GOSUB Blink
1952    RETURN 
1953 !-----------------------------------------------------------------------
1954 Dial_modem:!
1955    STATUS Com_port,10;Uart
1956 !  Dial_ext$=",,,add your phone card # here "
1957    IF NPAR>1 THEN 
1958      OUTPUT @Out_buff;Modinit$
1959    ELSE
1960      OUTPUT @Out_buff;"AT L2 C1 "
1961    END IF
1962    WAIT .5
1963    OUTPUT @Out_buff;"ATDT"&Phone$&Dial_ext$
1964    RETURN 
1965  !------------------------------------------------
1966 Send_char:!
1967 Sc:!
1968    K$=KBD$
1969 K: LOOP
1970      IF NOT LEN(K$) THEN 
1971        GOSUB Receive_char
1972        K$=KBD$  ! Check For any keys pressed during Receive_char
1973        IF NOT LEN(K$) THEN RETURN 
1974      END IF
1975 !
1976 ! Process K$
1977 !----------------------------
1978      Key1$=K$[1,1]
1979      Key1=NUM(Key1$)
1980      K$=K$[2]
1981      IF Key1=255 THEN         ! Function Key
1982        Key2=NUM(K$)
1983        Key2$=CHR$(Key2)
1984        K$=K$[2]
1985  !
1986        IF Key2=255 THEN        ! CTRL + Function Key
1987          Key3=NUM(K$)
1988          Key3$=CHR$(Key3)
1989          K$=K$[2]
1990          SELECT Key3$
1991          ! Not using any CTRL-Function Keys
1992          CASE "E"   !ÿE
1993            IF Kp_mode$="APPL" AND R_xoff=0 THEN OUTPUT @Out_buff;"OM";
1994          END SELECT
1995        ELSE                             ! Function Key   ÿ>
1996          SELECT Key2$
1997          CASE "E","X"                   ! ENTER
1998            IF Newline THEN 
1999              IF R_xoff=0 THEN OUTPUT @Out_buff;"
";  ! CR-LF
2000              IF Lecho THEN 
2001                IF Hl THEN GOSUB Blink
2002                PRINT "
";
2003              END IF
2004            ELSE
2005              IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2006              IF Lecho THEN PRINT "";
2007            END IF
2008 !------------------------------------------------ log session
2009            IF S_log THEN 
2010              File_buff$=File_buff$&"
"
2011              Fblen=LEN(File_buff$)
2012              IF Fblen>=Max_buff-20 THEN 
2013                DISP CHR$(129);" ";CHR$(128)
2014                OUTPUT @S_log;File_buff$;
2015                DISP 
2016                File_buff$=""
2017              END IF
2018            END IF
2019 !-----------------------------------------------------------
2020 Vt100:! vt-100 Esc Sequences implemented here                         VT100
2021 !-----------------------------------------------------------
2022          CASE "B"                       ! Backspace (Del)
2023            IF R_xoff=0 THEN OUTPUT @Out_buff;CHR$(8);
2024            IF Lecho THEN PRINT "";
2025  !
2026  ! In Cursor_mode$=VT52 action is not taken locally so that the
2027  ! remote vi session will echo back the proper character.
2028  !
2029          CASE "<"                       ! Left Arrow
2030            IF Cursor_mode$="VT52" THEN 
2031              IF R_xoff=0 THEN OUTPUT @Out_buff;"OD";
2032            ELSE
2033              IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2034              STATUS CRT,0;Px,Py
2035              CONTROL CRT,0;MAX(1,Px-1),Py
2036            END IF
2037          CASE ">"                       ! Right Arrow
2038            IF Cursor_mode$="VT52" THEN 
2039              IF R_xoff=0 THEN OUTPUT @Out_buff;"OC";
2040            ELSE
2041              IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2042              STATUS CRT,0;Px,Py
2043              CONTROL CRT,0;MIN(Crt_width,Px+1),Py
2044            END IF
2045          CASE "^"
2046            IF Cursor_mode$="VT52" THEN 
2047              IF R_xoff=0 THEN OUTPUT @Out_buff;"OA";
2048            ELSE
2049              IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2050              STATUS CRT,0;Px,Py
2051              CONTROL CRT,0;Px,MAX(1,Py-1)
2052            END IF
2053          CASE "V"                          ! Down Arrow
2054            IF Cursor_mode$="VT52" THEN 
2055              IF R_xoff=0 THEN OUTPUT @Out_buff;"OB";
2056            ELSE
2057              IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2058              STATUS CRT,0;Px,Py
2059              CONTROL CRT,0;Px,Py+1
2060            END IF
2061          CASE "\"                             ! home
2062            IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2063            CONTROL CRT,0;1,1
2064          CASE "%"                             ! clr-end
2065            IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2066            STATUS CRT,9;Crt_width
2067            STATUS CRT,0;Cx
2068            PRINT RPT$(" ",Crt_width-Cx);
2069          CASE "#"                             ! clr-line
2070            IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2071            CONTROL CRT,0;1
2072            STATUS CRT,9;Crt_width
2073            PRINT RPT$(" ",Crt_width);
2074          CASE "K"                             ! cls
2075            IF R_xoff=0 THEN OUTPUT @Out_buff;""
2076            CLEAR SCREEN
2077            GOSUB Disp_modeline
2078          CASE "U"                             ! caps lock
2079            STATUS KBD,0;Capstat
2080            IF Capstat THEN 
2081              CONTROL KBD,0;0
2082            ELSE
2083              CONTROL KBD,0;1
2084            END IF
2085          CASE ")"                            ! tab ==>
2086            IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2087            STATUS CRT,0;Cx
2088            CONTROL CRT,0;Cx+8
2089          CASE ELSE
2090            BEEP 300,.01     ! this function key not implemented
2091          END SELECT
2092        END IF   ! CTRL - Function Key
2093      END IF     ! Fuunction Key
2094 !
2095 !----------------   Ascii and  CTRL-Ascii Processing
2096 !
2097 Ak:!
2098      SELECT Key1
2099 Kesc:CASE NUM(Kerm_esc$[1,1])           !  KERMIT Escape  CTRL-]
2100        DISP "C: Exit  B:Break  K:Kermit Q:Stop Log  R:Resume Log  M: Modeline E: Echo  N: Nl"
2101        Esc_seq$=K$[1,1]
2102        WHILE LEN(Esc_seq$)<1    ! Wait for Kermit Escape Completion
2103          K$=KBD$
2104          Esc_seq$=K$[1,1]
2105        END WHILE
2106        SELECT UPC$(Esc_seq$)    ! Second Sequence of Kermit Escape
2107        CASE "C"                                ! cancel - exit
2108          Remote=0
2109          OFF KBD
2110          IF Mode_line THEN GCLEAR
2111          CLEAR SCREEN
2112          STATUS @S_log,0;S
2113          IF S THEN ASSIGN @S_log TO *
2114          S_log=0
2115        CASE "B"                                ! send break
2116          IF Com_card=98628 THEN 
2117            BREAK Com_port
2118          ELSE
2119            Shutdown
2120            BREAK Com_port
2121            Startup
2122          END IF
2123     !    OUTPUT @Out_buff;""     ! work around for FIDO Bulletin Board
2124        CASE "S"                                ! stat
2125          CALL Kstatus
2126          PRINTER IS CRT;EOL (CHR$(10)),WIDTH OFF
2127        CASE "Q"                                ! stop logging
2128          IF S_log THEN 
2129            STATUS @S_log,0;S
2130            IF S THEN OUTPUT @S_log;File_buff$;END
2131            File_buff$=""
2132          END IF
2133          S_log=0
2134          GOSUB Disp_modeline
2135        CASE "R"                                ! resume logging
2136          S_log=1
2137          GOSUB Disp_modeline
2138        CASE "O","0"                            ! transmit null
2139          IF R_xoff=0 THEN OUTPUT @Out_buff;"";
2140        CASE "?"                                ! help
2141        CASE "K"                                ! Kermit Shell
2142          PRINTER IS CRT
2143          CALL Kermit
2144          Remote=1      ! (stay in emulator)
2145          Kermit_exit=0
2146          CONTROL CRT,10;0
2147          PRINTER IS CRT;EOL (CHR$(10)),WIDTH OFF
2148          GOSUB Disp_modeline
2149        CASE "E"
2150          IF Lecho THEN 
2151            Lecho=0
2152          ELSE
2153            Lecho=1
2154          END IF
2155        CASE "M"          ! Toggle Mode Line
2156          IF Mode_line THEN 
2157            Mode_line=0
2158          ELSE
2159            Mode_line=1
2160          END IF
2161          GOSUB Disp_modeline
2162        CASE "N"     ! toggle newline
2163          IF Newline THEN 
2164            Newline=0
2165          ELSE
2166            Newline=1
2167          END IF
2168        CASE ELSE
2169        END SELECT         ! second char of kermit terminal escape
2170        DISP 
2171    !----------------------------------------------
2172 Text:CASE 32 TO 47,58 TO 126                            ! printable except numeric
2173        IF Lecho THEN PRINT Key1$;              ! ascii character
2174        IF R_xoff=0 THEN OUTPUT @Out_buff;Key1$;
2175 !
2176        IF S_log THEN 
2177          File_buff$=File_buff$&Key1$
2178          Fblen=LEN(File_buff$)
2179          IF Fblen>=Max_buff-20 THEN 
2180            DISP CHR$(129);" ";CHR$(128)
2181            OUTPUT @S_log;File_buff$;
2182            DISP 
2183            File_buff$=""
2184          END IF
2185        END IF
2186    !----------------------------------------------
2187      CASE 48 TO 57     ! numerics
2188        IF R_xoff=0 THEN OUTPUT @Out_buff;Key1$;
2189        IF Lecho THEN PRINT Key1$;
2190    !----------------------------------------------
2191      CASE 0 TO 15,26 TO 31
2192 Ctl_char: !
2193        IF R_xoff=0 THEN OUTPUT @Out_buff;Key1$;
2194        IF Lecho AND Display=8 THEN 
2195          DISPLAY FUNCTIONS ON
2196          PRINT Key1$;
2197          DISPLAY FUNCTIONS OFF
2198        END IF
2199 !
2200      CASE 16 TO 25               ! ANSI - APPLICATION Mode
2201                                  ! VT52 Application Mode not Implemented  (? instead of O)
2202        IF Kp_mode$="APPL" THEN    ! vt100 application keypad
2203          IF R_xoff=0 THEN OUTPUT @Out_buff;"O"&CHR$(Key1+96);
2204        ELSE
2205          IF R_xoff=0 THEN OUTPUT @Out_buff;Key1$;
2206        END IF
2207        IF Lecho AND Display=8 THEN 
2208          DISPLAY FUNCTIONS ON
2209          PRINT Key1$;
2210          DISPLAY FUNCTIONS OFF
2211        END IF
2212      END SELECT
2213   !------------------------------------------------
2214    EXIT IF Remote=0
2215      K$=KBD$            ! flush keyboard buffer
2216    END LOOP
2217    RETURN 
2218!======================================================================
2219 Receive_char: !
2220 Rc:!
2221    GOSUB Get_inlength     ! find In_length of Inbound Buffer
2222  !
2223    WHILE In_length
2224      ENTER @In_buff USING "#,A";A$
2225      Char=NUM(A$)
2226      IF S_log THEN 
2227        File_buff$=File_buff$&A$
2228        IF Char=13 AND Newline THEN File_buff$=File_buff$&"
"
2229        Fblen=LEN(File_buff$)
2230        IF (Char=13 AND Fblen>=Max_buff-80) OR (Fblen>=Max_buff-10) THEN 
2231          DISP CHR$(129);" ";CHR$(128)
2232          OUTPUT @S_log;File_buff$;
2233          File_buff$=""
2234        END IF
2235      END IF
2236 Handle_char: !
2237      SELECT Char
2238      CASE 32 TO 126      ! sp to ~
2239        PRINT A$;
2240    !-----------------------------------------
2241    ! SELECTED CONTROL CHARACTERS
2242    !-----------------------------------------
2243      CASE 127     ! backspace "del"
2244        STATUS CRT,0;Cx,Cy
2245        IF Cx>1 THEN 
2246          CONTROL CRT,0;Cx-1,Cy
2247          OUTPUT CRT;" ";
2248          CONTROL CRT,0;Cx-1,Cy
2249        END IF
2250      CASE 5                        !""         ! ENQ/ACK
2251        OUTPUT @Out_buff;CHR$(6);
2252        IF Flow$="ENQ/ACK" THEN 
2253          OUTPUT @Out_buff;CHR$(6);
2254        END IF
2255      CASE 10                       ! LF
2256        IF Hl THEN GOSUB Blink
2257        PRINT "
";
2258        IF S_log THEN OUTPUT @S_log;File_buff$
2259        File_buff$=""
2260      CASE 13
2261        PRINT "";
2262      CASE 7
2263        BEEP 800,.1
2264      CASE 8                          !     Backspace
2265        STATUS CRT,0;Cx
2266        CONTROL CRT,0;MAX(Cx-1,1)
2267      CASE 17                         ! Xon Received
2268        IF Flow$="XON/XOFF" THEN 
2269          R_xoff=0
2270        END IF
2271      CASE 19                         ! Xoff Received
2272        IF Flow$="XON/XOFF" THEN 
2273          R_xoff=1
2274        END IF
2275!
2276! ESCAPE PROCESSING
2277!
2278      CASE 27                         !     Escape
2279     !------------------------
2280     !    VT-100  SEQUENCES
2281 Rvt:!------------------------
2282     !  need to check for buffer length here to avoid end of buffer
2283     !
2284     ! Repeat until a vt100 escape sequence terminator is found
2285     !
2286     !
2287     !
2288 Get_vt100: !
2289 Gv: !
2290        Esc_seq_str$=""
2291        Vt52_seq=0
2292        Vt100_seq=0
2293        Esc_cmplt=0
2294        Esc_cmplt$=""
2295        Esc_length=0
2296 !
2297        REPEAT
2298          GOSUB Get_inlength
2299        UNTIL In_length
2300        ENTER @In_buff USING "#,A";A$    ! [ for vt100
2301        Esc_seq_str$=Esc_seq_str$&A$
2302  !
2303        IF A$="[" THEN       ! vt100 sequence
2304          Vt100_seq=1
2305          REPEAT
2306            REPEAT
2307              GOSUB Get_inlength
2308            UNTIL In_length
2309            ENTER @In_buff USING "#,A";A$
2310            Esc_seq_str$=Esc_seq_str$&A$
2311            IF POS("ABCDHJKRZ=>cghlmnqrxy",A$) THEN   ! '?' is not a seq end
2312              Esc_cmplt=1
2313              Esc_cmplt$=A$
2314            END IF
2315            Esc_length=Esc_length+1
2316          UNTIL Esc_cmplt OR Esc_length>Max_esc_length
2317        ELSE !-------------------------------------------------------
2318          Vt52_seq=1
2319          REPEAT
2320            IF POS("78ABCDEHM=><",A$) THEN        ! vt52
2321              Esc_cmplt=1
2322              Esc_cmplt$=A$
2323              GOTO Gv2
2324            END IF
2325            REPEAT
2326              GOSUB Get_inlength
2327            UNTIL In_length
2328            ENTER @In_buff USING "#,A";A$
2329            Esc_seq_str$=Esc_seq_str$&A$
2330            Esc_length=Esc_length+1
2331          UNTIL Esc_cmplt OR Esc_length>Max_esc_length
2332        END IF! vt52 or vt100
2333  !=-----------------------------------------------------------------------------------
2334  !
2335  ! Esc_seq_str$ = received VT escape sequence
2336  !
2337        IF Debug THEN 
2338          PRINT Esc_seq_str$;
2339          GOTO Vt100_exit
2340        END IF
2341  !
2342 Gv2:   IF Vt100_seq THEN GOSUB Parse_esc      ! hcolon, left_brak, pn1,pn2,pn3
2343        STATUS CRT,0;Cx,Cy                ! current cursor
2344        SELECT Esc_cmplt$
2345  !
2346  ! Cursor Movement
2347  !
2348        CASE "A","B","C","D"              ! [#A
2349        !
2350        ! Esc_ptr points to completion char (ABCD etc)
2351        !
2352          IF Pn1=0 THEN Pn1=1
2353          SELECT Esc_cmplt$
2354          CASE "A"   !up
2355            Cy=MAX(1,Cy-Pn1)
2356            CONTROL CRT,1;Cy
2357          CASE "B"   !down
2358            Cy=MIN(Crt_lines,Cy+Pn1)
2359            CONTROL CRT,1;Cy
2360          CASE "C"   !fwd
2361            Cx=MIN(Crt_width,Cx+Pn1)
2362            CONTROL CRT,0;Cx
2363          CASE "D"   !bkwd
2364            Cx=MAX(1,Cx-Pn1)
2365            CONTROL CRT,0;Cx
2366          END SELECT
2367        CASE "H"                 ! set cursor or !! SET TAB = Esc-H
2368 Vt_h:  !                        ! y;cxH
2369                                 !  = home cursor
2370          Cy=Pn1
2371          Cx=Pn2
2372          IF Cy=0 THEN Cy=1      ! Pn1=Line
2373          IF Cx=0 THEN Cx=1
2374 Cursor_pos: !
2375          CONTROL CRT,0;Cx,Cy
2376        CASE "J"
2377          SELECT Pn1
2378               ! Need to know number of lines on screen
2379          CASE 0         ! erase to end of scr
2380          CASE 1         ! erase up to cursor
2381          CASE 2         ! CLS
2382            CLEAR SCREEN
2383          END SELECT
2384        CASE "K"
2385          SELECT Pn1
2386          CASE 0         ! clear to end
2387            OUTPUT KBD;"ÿ%";                ! clr-end
2388          CASE 1                            ! clr to cursor
2389          CASE 2                            ! clr line
2390            OUTPUT KBD;"ÿ#";
2391          END SELECT
2392        CASE "R"
2393          OUTPUT @Out_buff;"[";Cy;";";Cx;"R"
2394        CASE "c","Z"  ! Device Attribute (DA) report
2395          IF Pn=1 THEN 
2396            OUTPUT @Out_buff;"[?0;0c"
2397          ELSE
2398            OUTPUT @Out_buff;"[?1;0c"
2399          END IF
2400        CASE "g"  ! tab stops
2401        CASE "h"  ! set modes
2402          SELECT Esc_seq_str$
2403          CASE "[?1h"  ! Set ANSI/Cursor Keymode (OA)
2404            Cursor_mode$="VT52"
2405          CASE "[?2h"  ! Set ANSI Mode
2406            Term_mode$="ANSI"
2407          END SELECT
2408        CASE "l"  ! clear modes
2409          SELECT Esc_seq_str$
2410          CASE "[?1l"  ! ANSI/Cursor Keymode Reset ()
2411            Cursor_mode$="ANSI"
2412          CASE "[?2l"  ! Set VT52 Mode
2413            Term_mode$="VT52"
2414          END SELECT
2415        CASE "m"  ! graphics rendition
2416          SELECT Pn1
2417          CASE 0
2418            PRINT CHR$(128);
2419          CASE 7
2420            PRINT CHR$(129);
2421          CASE ELSE
2422          END SELECT
2423        CASE "n"
2424        CASE "q"
2425        CASE "r"         ! Set Scrolling Region
2426          Top_line=Pn1
2427          Bot_line=Pn2
2428          Scroll_lines=Bot_line-Top_line+1
2429     !    ALPHA HEIGHT Scroll_lines
2430     !
2431     ! 24 line emulator needs work
2432     !
2433        CASE "x"         ! request report frame (parity,data bits etc)
2434          !  IF Pn1=0 THEN      ! term can send unsolicited reports
2435          !  IF Pn1=1 THEN      ! term may only respond to a "x" request
2436          !  IF Pn1=2 THEN      ! host sending a port parm report
2437          !  IF Pn1=3 THEN      ! AND of bits 0 and 1
2438        CASE "n"         ! request report on terminal status
2439          IF Pn1=5 THEN OUTPUT @Out_buff;""
2440          IF Pn1=6 THEN 
2441            STATUS CRT,0;Cx,Cy
2442            OUTPUT @Out_buff;"["&VAL$(Cx)&","&VAL$(Cy)&","&"R"
2443          END IF
2444        CASE "="      ! enter appl keypad mode     ! =
2445          Kp_mode$="APPL"
2446        CASE "<"      ! return to ANSI mode       ! <
2447          Term_mode$="ANSI"
2448        CASE ">"      ! exit appl keypad mode      ! >
2449          Kp_mode$="NUMERIC"
2450        CASE "7"      ! save cursor
2451          Save_cx=Cx
2452          Save_cy=Cy
2453        CASE "8"      ! restore cursor
2454          Cx=Save_cx
2455          Cy=Save_cy
2456        CASE ELSE
2457          PRINT Esc_seq_str$;
2458        END SELECT            ! of esc-VT100 argument
2459 Vt100_exit:  ! ------------------------------- End ESCAPE Processing
2460      CASE 0 TO 31       ! Control Char
2461        IF Debug THEN 
2462          PRINT "^"&CHR$(NUM(A$)+32);
2463        END IF
2464      CASE 128 TO 255
2465        IF Debug THEN 
2466          PRINT "^&"&CHR$(NUM(A$)-128);
2467        ELSE
2468          IF Display=8 THEN 
2469            DISPLAY FUNCTIONS ON
2470            PRINT A$;
2471            DISPLAY FUNCTIONS OFF
2472          END IF
2473        END IF
2474      CASE ELSE
2475        IF Debug THEN PRINT A$;
2476      END SELECT
2477  !
2478      GOSUB Get_inlength
2479    END WHILE
2480    RETURN 
2481 Rc2: !
2482 !-------------------------------------------
2483 Parse_esc: !
2484 Pe: !
2485  !
2486  ! POS of "[" = Lef_brak  (0=not found for vt52)
2487  ! POS of ";" = esc_colon(0:5)      esc_colon(0)=# of colons
2488  ! numeric parameters:  pn1,pn2,pn3
2489  !
2490    MAT Esc_colon= (0)
2491    Esc_colon_done=0
2492  !
2493    Lef_brak=POS(Esc_seq_str$,"[")    ! find left bracket
2494  !
2495  ! Find all occurances of ";"
2496  !
2497    GOTO Skip_scolon
2498    REPEAT
2499      Ec=POS(Esc_seq_str$[Ec_ptr],";")
2500      IF Ec THEN 
2501        Esc_colon(0)=Esc_colon(0)+1
2502        Esc_colon(Esc_colon(0))=Ec_ptr+Ec-1
2503        Ec_ptr=Ec+1
2504      END IF
2505    UNTIL Ec=0
2506 Skip_scolon: !
2507  !
2508  ! find values of pn1,pn2...
2509  ! Use VAL function to parse multiple values
2510  !
2511  !
2512    Pn0=0
2513    Pn1=0
2514    Pn2=0
2515    Pn3=0
2516    ON ERROR GOTO Pn_done
2517    ENTER Esc_seq_str$;Pn1,Pn2,Pn3            !   << how to parse this ?
2518    Pn0=0
2519    ! pn0=number of parameters passed (not used)
2520 Pn_done:OFF ERROR 
2521    GOTO Pe_exit
2522    ON ERROR GOSUB Term_err
2523  !
2524    DISPLAY FUNCTIONS ON
2525    PRINT TABXY(1,18);
2526    PRINT USING "#,(K,X)";Esc_seq_str$
2527    DISP "Pn values: ";Pn1,Pn2,Pn3,"#= ";Pn0
2528    CONTROL CRT,0;Cx,Cy
2529    DISPLAY FUNCTIONS OFF
2530 Pe_exit:ON ERROR GOSUB Term_err
2531    RETURN 
2532 !-------------------------------------------
2533 Get_inlength: !
2534   !  SELECT Com_card
2535  !   CASE 98626,98644
2536  !     STATUS @In_buff,3;Fp,In_length,Ep
2537  !   CASE 98628
2538  !     STATUS Com_port,5;In_length
2539  !   END SELECT
2540  !
2541    IF Com_card=98628 THEN 
2542     ! Xon/Xoff implemented in Hardware
2543    ELSE
2544      STATUS @In_buff,4;In_length
2545      IF (NOT Xoff) AND (In_length>Inbuff_max) THEN 
2546        IF Flow$="XON/XOFF" THEN 
2547          OUTPUT @Out_buff;CHR$(19);
2548          Xoff=1
2549          BEEP 500,.01
2550        END IF
2551      END IF
2552!
2553      IF (Xoff) AND (In_length<Inbuff_min) THEN 
2554        IF Flow$="XON/XOFF" THEN 
2555          OUTPUT @Out_buff;CHR$(17)   ! XON
2556          Xoff=0
2557          BEEP 2000,.01
2558        END IF
2559      END IF
2560!
2561    END IF
2562    RETURN 
2563 !-------------------------------------------
2564 Com_tmo:!
2565    DISP "Serial  Port Timeout - Paused "
2566    PAUSE
2567    DISP 
2568    RETURN 
2569 !-------------------------------------------
2570 Term_err:!
2571    IF Debug THEN PRINT ERRM$
2572    SELECT ERRN
2573    CASE 59  ! End of Log File
2574      IF S_log THEN 
2575        ASSIGN @S_log TO *
2576        S_log=0
2577        GOSUB Disp_modeline
2578      END IF
2579    CASE 167 ! IO STATUS ERROR
2580      GOSUB Term_intr
2581    CASE 314  ! RECEIVE BUFFER OVERFLOW
2582      BEEP 
2583      DISP ERRM$," Paused in Term_err"
2584      PAUSE
2585      DISP 
2586    CASE ELSE
2587      BEEP 
2588      DISP ERRM$,"paused"
2589      PAUSE
2590   !  CLEAR ERROR
2591      ERROR RETURN
2592      DISP 
2593    END SELECT
2594    RETURN 
2595 !--------------------------------------------------------------------
2596  SUBEND
2597 !====================================================================
2598 Kstatus:SUB Kstatus
2599    OPTION BASE 1
2600    COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
2601    COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
2602    COM /Frame/ Flow$,Hshake$
2603    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
2604    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
2605    COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
2606    COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas,Send_at
2607    COM /Kerm/ INTEGER Image,Parflg,Pktdeb
2608    COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol,Smark
2609    COM /Kerm2/ State$[1],Cchksum$[1],Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
2610    COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
2611    COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
2612    COM /Term/ Term_mode$
2613    COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
2614    DIM D_log_stat$[40],S_log_stat$[40]
2615    PRINTER IS CRT
2616    PRINT RPT$("=",15)&" S T A T U S "&RPT$("=",15)
2617    !
2618    PRINT CHR$(132);"COMMUNICATIONS PORT";CHR$(128);
2619    PRINT TAB(50);CHR$(132);"TERMINAL";CHR$(128)
2620    !
2621    PRINT "Baud Rate ";TAB(20);Baud;
2622    PRINT TAB(50);"Terminal Type ";TAB(70);Term_type$
2623    !
2624    PRINT "COM Port ";TAB(20);Com_port;
2625    PRINT TAB(50);"          ";TAB(70);"    "
2626    !
2627    PRINT "Parity ";TAB(20);Data_bits;"/";Parity_type$;"/";On_off$;
2628    PRINT TAB(50);CHR$(132);"LOCAL TRANSFER PARAMETERS";CHR$(128)
2629    !
2630    Lecho$="REMOTE"
2631    IF Lecho THEN Lecho$="LOCAL"
2632    PRINT "ECHO       ";TAB(20);Lecho$;
2633    PRINT TAB(50);"Packet Timeout ";TAB(70);Mytmo
2634    !
2635    PRINT "Flow Control";TAB(20);Flow$;
2636    PRINT TAB(50);"Control Quote";TAB(70);CHR$(Myquote)
2637    !
2638    PRINT "Handshake  ";TAB(20);Hshake$;
2639    PRINT TAB(50);"Packet Size ";TAB(70);Spsiz
2640    !
2641    PRINT "Source  MSI  ";TAB(20);S_path$&S_msi$;
2642    PRINT TAB(50);"Padding Character";
2643    DISPLAY FUNCTIONS ON
2644    PRINT TAB(70);CHR$(Mypad);
2645    DISPLAY FUNCTIONS OFF
2646    PRINT 
2647    !
2648    PRINT "Destination  MSI ";TAB(20);D_path$&D_msi$;
2649    PRINT TAB(50);"             ";TAB(70);"   "
2650    !
2651    Filewarn$="OVERWRITE"
2652    IF Filewarn THEN Filewarn$="AVOID OVERWRITE"
2653    PRINT "Overwrite  Warn.   ";TAB(20);Filewarn$;
2654    PRINT TAB(50);CHR$(132);"REMOTE TRANSFER PARAMETERS";CHR$(128)
2655    !
2656    Discard$="KEEP     "
2657    IF Discard THEN Discard$="DISCARD"
2658    PRINT "Incomplete File    ";TAB(20);Discard$;
2659    PRINT TAB(50);"Packet Timeout";TAB(70);Ptmo
2660    !
2661    PRINT "EOF Mode  ";TAB(20);Eof_mode$;
2662    PRINT TAB(50);"Packet Size ";TAB(70);Rpsiz
2663    !
2664    S_log_stat$="OFF          "
2665    IF S_log THEN S_log_stat$=S_log$
2666    PRINT "Session Log  ";TAB(20);S_log_stat$;
2667    !
2668    PRINT TAB(50);"Padding Character";
2669    DISPLAY FUNCTIONS ON
2670    PRINT TAB(70);CHR$(Pad);
2671    DISPLAY FUNCTIONS OFF
2672    PRINT 
2673    !
2674    D_log_stat$="OFF"
2675    IF D_log THEN D_log_stat$=D_log$
2676    PRINT "Packet  Log ";TAB(20);D_log_stat$;
2677    PRINT TAB(50);"Control Quote ";TAB(70);CHR$(Quote)
2678    !
2679    Timeron$="ON"
2680    IF NOT Timer THEN Timeron$="OFF"
2681    PRINT "Timer        ";TAB(20);Timeron$;
2682    PRINT TAB(50);"EOL Char      ";
2683    DISPLAY FUNCTIONS ON
2684    PRINT TAB(70);CHR$(Eol);
2685    DISPLAY FUNCTIONS OFF
2686    PRINT 
2687    !
2688    Debug$="OFF"
2689    IF Debug THEN Debug$="ON         "
2690    PRINT "Debug Mode   ";TAB(20);Debug$;
2691    PRINT TAB(50);"Pkt. Retry  Limit  ";TAB(70);Maxtry
2692    !
2693    PRINT "Kermit Escape ";
2694    PRINT TAB(20);"^"&CHR$(NUM(Kerm_esc$[1,1])+64)&Kerm_esc$[2,2];
2695    PRINT TAB(50);"Block Check Type  ";TAB(70);Blk_chk
2696    !
2697    Filetype$="ASCII"
2698    IF Image THEN Filetype$="BINARY"
2699    PRINT "File Mode    ";TAB(20);Filetype$;
2700    DISPLAY FUNCTIONS ON
2701    PRINT TAB(50);"Packet Mark        ";TAB(70);CHR$(Smark);
2702    DISPLAY FUNCTIONS OFF
2703  !
2704    PRINT 
2705    STATUS @In_buff,0;Valid_path
2706    IF Valid_path=3 THEN  ! buffer
2707      STATUS @In_buff,10;I_stat
2708      IF (I_stat AND 14) THEN Txfer_stat$="Terminated OK"
2709      IF (I_stat AND 48) THEN Txfer_stat$="Error/Abort"
2710      IF (I_stat AND 64) THEN Txfer_stat$="On"
2711      IF (I_stat=0) THEN Txfer_stat$="Off"
2712    ELSE
2713      Txfer_stat$="Not Assigned"
2714    END IF
2715    PRINT "Inbound DMA";TAB(20);Txfer_stat$;
2716  !
2717    STATUS @Out_buff,0;Valid_path
2718    IF Valid_path=3 THEN  ! buffer
2719      STATUS @Out_buff,11;O_stat
2720      IF (O_stat AND 14) THEN Txfer_stat$="Terminated OK"
2721      IF (O_stat AND 48) THEN Txfer_stat$="Error/Abort"
2722      IF (O_stat AND 64) THEN Txfer_stat$="On"
2723      IF (O_stat=0) THEN Txfer_stat$="Off"
2724    ELSE
2725      Txfer_stat$="Not Assigned"
2726    END IF
2727    PRINT TAB(50);"Outbound DMA";TAB(70);Txfer_stat$;
2728  !
2729    PRINT 
2730  SUBEND
2731  !=======================================================================
2732 Tochar:DEF FNTochar$(INTEGER C)
2733    RETURN CHR$(C+32)        ! +" "
2734  FNEND
2735  !------------------------------------------------------------------------
2736 Unchar:DEF FNUnchar(C$)
2737    RETURN NUM(C$)-32
2738  FNEND
2739  !------------------------------------------------------------------------
2740 Ctl:DEF FNCtl(C$)
2741    C=NUM(C$)
2742    C=BINEOR(C,64)  ! toggle bit 7
2743    RETURN C
2744  FNEND
2745  !----------------------------------------------------------------------
2746 Ksend:SUB K_send(F$,OPTIONAL INTEGER Bdat_item)
2747  !
2748  ! Kermit Send File Protocol
2749  !
2750    OPTION BASE 1
2751    COM Version$,K$,Setup$
2752    COM /Crt/ Crt_lines,Crt_width
2753    COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
2754    COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
2755    COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas,Send_at
2756    COM /Kerm/ INTEGER Image,Parflg,Pktdeb
2757    COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol,Smark
2758    COM /Kerm2/ State$[1],Cchksum$[1],Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
2759    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
2760    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
2761    COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
2762    COM /Frame/ Flow$,Hshake$
2763    COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
2764    COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
2765    COM /Term/ Term_mode$
2766    COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
2767  !
2768    INTEGER Chksum,Rc,Plen,Dlen,Cchksum,Qbin,Rep_ch
2769    INTEGER Ftype,Volnum,Prot,Recsize,Sec_data(1:256),Lsb,Msb
2770    INTEGER Npak,Numtry,Oldtry,Rseq
2771    INTEGER Com_err,User_break
2772    INTEGER Spacks,Fpacks,Apacks,Dpacks,Zpacks,Bpacks,Epacks
2773    INTEGER Atl
2774    INTEGER Bdat_int
2775    REAL File_st,F_sec,File_length,At_rec,At_recl,At_len
2776    DIM Misc$[80],Filename$[80],F_path$[256]
2777    DIM A$[1],File_buff$[1024],File_get$[256],Wmsg$[80],Emsg$[80]
2778    DIM Myquote$[1],Qbin$[1]
2779    DIM File_eol$[2],Cat$(10)[80],Cat_entry$[80],Sav_msi$[256]
2780  !
2781    Sav_msi$=SYSTEM$("MSI")
2782    File_eol$=CHR$(13)&CHR$(10)
2783    ALLOCATE Rcvpkt$[Maxp],Sndpkt$[Spsiz+2],Packet$[Spsiz+2],Rdata$[Maxp]
2784    Com_err=0
2785    Shutdown         ! Shut off transfers while doing ON-EVENTS
2786    SELECT Com_card
2787    CASE 98626,98644
2788      CONTROL Com_port,12;128+32+16          ! ELIMINATE HANDSHAKE
2789      CONTROL Com_port,5;1+2                 ! force dtr,rts
2790    CASE 98628
2791      CONTROL Com_port,13;164     ! INT MASK  4=UART  32=lost car 128=break
2792    END SELECT
2793    ON ERROR GOSUB Send_err
2794    ON INTR Com_port,15 GOSUB Send_intr
2795    Startup
2796  !
2797    CLEAR SCREEN
2798    IF Display THEN 
2799      PRINT TABXY(1,2);Version$
2800      PRINT TABXY(15,5);"Filename: ";F$                 ! LINE 5
2801      PRINT TAB(6);"Bytes Transferred: ";TAB(25);Kbx    ! 6
2802      PRINT TAB(6);"    % Transferred: ";TAB(25);Kbx    ! 7
2803      PRINT TAB(16);"SENDING: In Progress           "   ! 8
2804      PRINT                                             ! 9
2805      PRINT TAB(6);"Number of Packets: ";TAB(25);Npak   ! 10
2806      PRINT TAB(6);"Number of Retries: ";TAB(25);Oldtry ! 11
2807      PRINT TAB(13);"Last Error: "                      ! 12
2808      PRINT TAB(11);"Last Message: "                    ! 13
2809                                                        ! 14 blank
2810      IF Debug THEN 
2811        PRINT TABXY(11,15);"REC. PACKET : "                  ! 15
2812        PRINT TABXY(11,16);"SEND PACKET : "                  ! 16
2813      END IF
2814      PRINT TABXY(1,Crt_lines-1);CHR$(129);"^X cancels File, ^E Quits Protocol, ^C Quits, Return retries";CHR$(128)
2815    ELSE
2816      DISP "Sending ";F$;" ... "
2817    END IF
2818    !--------------------------------------------------------------------
2819    ! The filename in whatever form is passed in as F$
2820    !
2821    ! 1. If msi not specified then
2822    !       use Source Msi
2823    !       use source path
2824    !
2825    ! 2. If msi is specified dont use source path
2826    !
2827    IF NOT POS(F$,":") THEN 
2828      F_msi$=S_msi$
2829      IF NOT POS(F$,"/") THEN F_path$=S_path$
2830      F$=F_path$&F$&F_msi$
2831    END IF
2832    Parse_filename(F$,F_msi$,F_path$)
2833    Filename$=F_path$&F$&F_msi$
2834    IF F_path$&F$="/T" THEN GOTO Test_send
2835  !
2836  ! Catalog File entry on F_path$ and F_msi$
2837  ! Get File's parameters  Cat_entry$,At_length,At_type$
2838  !
2839    GOSUB Get_file_entry    ! F$,F_msi$,F_path$,File_found,Cat_entry$,Filetype$
2840  !
2841  ! If a ramdisc is required call init_ramdisc
2842  !
2843    IF At_type$="PROG" OR At_type$="BIN" OR At_type$="SYSTM" THEN 
2844      Image=1
2845  !
2846  ! PROG Files must use a ramdisc
2847  ! Create one now in case we need it later
2848  !
2849      Ram_msi$=":,0,0"
2850      GOSUB Check_for_rdisc  ! set ramdisc flag
2851      IF NOT Ramdisc THEN 
2852        CALL Init_ramdisc(Kbytes)     ! Init_ramdisc sizes the Kbytes
2853        IF Kbytes THEN Ramdisc=1
2854      ELSE                            ! Existing one large enough ?
2855        IF Kbytes<(File_length/1000) THEN 
2856          Avm=VAL(SYSTEM$("AVAILABLE MEMORY"))
2857          Avl_kbytes=(Avm-100000)/1000
2858          IF Avl_kbytes>(File_length/1000) THEN  ! can recreate
2859            DISP "Can I re-create the Ram Disc ?"
2860            OUTPUT KBD;"Y";"ÿH";
2861            ENTER KBD;Ans$
2862            IF POS(UPC$(Ans$),"Y") THEN 
2863              CALL Init_ramdisc(Kbytes)
2864            END IF
2865          END IF
2866        END IF
2867      END IF
2868  !
2869      IF Kbytes<(File_length/1000) THEN 
2870        BEEP 
2871        PRINT TABXY(1,Crt_lines);"Cannot create sufficient ramdisc - aborting SEND"
2872        SUBEXIT
2873      END IF
2874  !
2875      DISP "copying image file to ramdisc... "
2876  !
2877  ! Try to assign to a PROG type file - if file exists error 58 will result
2878  !
2879      ASSIGN @Test TO F$&Ram_msi$;RETURN Rc
2880      IF Rc=0 THEN Rc=58
2881      SELECT Rc
2882      CASE 0
2883      ! File was assignable - This is probably the second time
2884      ! trying to send this PROG file - It's already on the ram disc
2885      ! Rc is set to 58 to prompt for purging of existing file
2886      CASE 58             ! improper filetype error - file exists
2887        Prompt("Overwrite File On Ramdisc ? ","Y",Ans$,Flag)
2888        IF Flag THEN 
2889          ASSIGN @Test TO *
2890          PURGE F$&Ram_msi$
2891          COPY Filename$ TO F$&Ram_msi$
2892        END IF
2893      CASE ELSE    ! file not found
2894        COPY Filename$ TO F$&Ram_msi$
2895      END SELECT  ! file is on ramdisc or not
2896      F_path$=""
2897      F_msi$=Ram_msi$
2898      Convert(F$&Ram_msi$,"HP-UX",Rc)
2899      GOSUB Get_file_entry         ! update file attributes
2900    END IF      ! if file is un-assignable (PROG or BIN)
2901   !-----------------------------------------------------
2902    Filename$=F_path$&F$&F_msi$
2903  !
2904    SELECT Bdat_item
2905    CASE 0
2906      ASSIGN @File TO Filename$;FORMAT ON
2907    CASE ELSE
2908      ASSIGN @File TO Filename$;FORMAT OFF
2909    END SELECT
2910    STATUS @File,1;File_type
2911 Test_send:   !
2912   !-------------------------------------    send  init
2913    Spacks=0         ! retry counters
2914    Fpacks=0
2915    Apacks=0
2916    Dpacks=0
2917    Zpacks=0
2918    Bpacks=0
2919    Oldtry=0
2920    File_buff$=""    ! file buffer to be quoted
2921    File_get$=""     ! file enter buffer
2922    Sdata_done=0     ! sending data done
2923    At_eof=0         ! EOF reached on file read
2924    Max_buff=MAXLEN(File_buff$)
2925 !------------------------------------------------------------------------
2926 Ksends:State$="S"
2927    REPEAT
2928      SELECT State$
2929      CASE "S"
2930        GOSUB Spar                       ! Set our Init Parameters
2931        Spack(Packet$,State$,Npak,Sndpkt$)
2932        IF NOT Spacks THEN PRINT TABXY(25,13);"Exchanging Initialization Packets"
2933        OUTPUT @Out_buff;Sndpkt$
2934        IF Debug THEN PRINT TABXY(25,16);Sndpkt$&RPT$(" ",100)
2935        IF D_log THEN OUTPUT @D_log;Sndpkt$
2936  !
2937        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Spacks,User_break,Emsg$)
2938        IF Debug THEN PRINT TABXY(25,15);Rcvpkt$&"                "
2939        IF D_log THEN OUTPUT @D_log;Rcvpkt$
2940        SELECT Pktype$
2941        CASE "N"
2942        CASE "Y"
2943          GOSUB Rpar     ! Decode remote parameters
2944          State$="F"
2945          Oldtry=Oldtry+Spacks
2946        CASE "E"
2947          Emsg$=Rdata$
2948          State$="E"
2949        CASE "T"
2950          Wmsg$="Packet Timeout"
2951        CASE "Q"
2952          Wmsg$="Bad Checksum  or Sequence"
2953  !
2954  ! If Pktype$="X" then local Kermit interrupted file sending.  User_break
2955  ! flag is set to determine which side is erroring (in case of ^E).
2956  ! Rdata$ can be used to determine ^X or ^Z.
2957  !
2958        CASE "X"
2959          State$="Z"  ! jump to end of file
2960          Wmsg$="User abort of Send File"
2961        CASE ELSE
2962          Wmsg$="Unknown Packet Type: "&Pktype$
2963        END SELECT
2964    !
2965        IF Pktype$="Y" THEN 
2966          Npak=Npak+1
2967        ELSE
2968          Spacks=Spacks+1
2969        END IF
2970   !
2971        IF Spacks>Maxtry THEN 
2972          State$="E"
2973          Emsg$="Can't Receive (S) Ack from Host"
2974        END IF
2975   !
2976        PRINT TABXY(25,10);Npak
2977        PRINT TABXY(25,11);Oldtry+Spacks
2978        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
2979        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
2980        IF State$<>"S" THEN Oldtry=Oldtry+Spacks
2981    !--------------------------------------------------------------------
2982 Ksendf:CASE "F"      ! Send File Header  'F'
2983      !
2984        Packet$=F$    ! just send filename part
2985        Spack(Packet$,State$,Npak,Sndpkt$)
2986        PRINT TABXY(25,13);"Sending Filename"&RPT$(" ",28)
2987        OUTPUT @Out_buff;Sndpkt$
2988        PRINT TABXY(25,10);Npak
2989        PRINT TABXY(25,11);Oldtry+Fpacks
2990  !
2991        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Fpacks,User_break,Emsg$)
2992        IF Debug THEN 
2993          PRINT TABXY(25,15);Rcvpkt$&"                "
2994          PRINT TABXY(25,16);Sndpkt$&"                "
2995        END IF
2996        IF D_log THEN OUTPUT @D_log;Sndpkt$,Rcvpkt$
2997  !
2998        SELECT Pktype$
2999        CASE "N"
3000        CASE "Y"
3001          Npak=Npak+1
3002          Oldtry=Oldtry+Fpacks
3003          IF Rcap_a THEN        ! if remote can use attribute packets
3004            State$="A"
3005          ELSE
3006            State$="D"
3007          END IF
3008        CASE "E"
3009          Emsg$=Rdata$
3010          State$="E"
3011        CASE "T"
3012          Wmsg$="Packet Timeout"
3013        CASE "Q"
3014          Wmsg$="Bad Checksum or Sequence"
3015        CASE "X"
3016          State$="Z"  ! jump to end of file
3017          Wmsg$="User abort of Send File"
3018        CASE ELSE
3019          Wmsg$="Unknown Packet Type: "&Pktype$
3020        END SELECT
3021  !
3022        IF Pktype$="N" THEN 
3023          Fpacks=Fpacks+1
3024          IF Fpacks>Maxtry THEN 
3025            Emsg$="Can't Receive (F) Ack from Host"
3026            State$="E"
3027          END IF
3028        END IF
3029        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
3030        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
3031        PRINT TABXY(25,5);Filename$
3032        IF State$="D" THEN Ft_start=TIMEDATE  ! START SEND CLOCK
3033    !------------------------------------------------------
3034 Ksenda:CASE "A"
3035        IF Debug THEN PRINT TABXY(47,8);State$
3036        Packet$=""
3037        GOSUB Set_at             ! Form  Attribute Data into Packet$
3038        Spack(Packet$,State$,Npak,Sndpkt$)
3039        PRINT TABXY(25,13);"Sending File Attributes"&RPT$(" ",32)
3040        OUTPUT @Out_buff;Sndpkt$
3041        IF D_log THEN OUTPUT @D_log;Sndpkt$
3042  !
3043        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Apacks,User_break,Emsg$)
3044        PRINT TABXY(25,10);Npak
3045        PRINT TABXY(25,11);Oldtry+Apacks
3046        IF Debug THEN 
3047          PRINT TABXY(25,15);Rcvpkt$&"                "
3048          PRINT TABXY(25,16);Sndpkt$&"                "
3049        END IF
3050        IF D_log THEN OUTPUT @D_log;Rcvpkt$
3051  !
3052        SELECT Pktype$
3053        CASE "N"
3054        CASE "Y"
3055          Npak=Npak+1
3056          State$="D"
3057        CASE "E"
3058          Emsg$=Rdata$
3059          State$="E"
3060        CASE "T"
3061          Wmsg$="Packet Timeout"
3062        CASE "Q"
3063          Wmsg$="Bad Checksum  or Sequence"
3064        CASE "X"
3065          State$="Z"  ! jump to end of file
3066          Wmsg$="User abort of Send File"
3067        CASE ELSE
3068          Wmsg$="Unknown Packet Type: "&Pktype$
3069        END SELECT
3070  !
3071        IF Pktype$="Y" THEN 
3072        ELSE
3073          Apacks=Apacks+1
3074          IF Apacks>Maxtry THEN 
3075            Emsg$="Can't Receive (A) Ack from Host"
3076            State$="E"
3077          END IF
3078        END IF
3079        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
3080        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
3081        IF State$<>"A" THEN Oldtry=Oldtry+Apacks
3082        IF State$="D" THEN Ft_start=TIMEDATE  ! START SEND CLOCK
3083    !--------------------------------------------------------------------
3084 Ksendd:CASE "D"      ! Send File Data    'D'
3085     !
3086     ! The way in which characters are fed into the File_buff$ variable
3087     ! is dependent on file type (At_type$), and the value of Image flag.
3088     !
3089     ! ASCII:  Image is ignored and interpreted as Image=0
3090     ! HP-UX:  Image=1 transmits file as is.
3091     !         Image=0 appends Cr-Lf on each text line
3092     ! BDAT:   Image=1 transmits as-is
3093     !  ***    Image=0 Kermit tries to read file and covert # to ascii
3094     !
3095        IF NOT Dstate_init THEN 
3096          ON END @File GOTO At_eof
3097          Dstate_init=1
3098          PRINT TABXY(25,13);"Sending File Data"&RPT$(" ",27)
3099        END IF
3100    !
3101 Fill_buff: !
3102        Bl=LEN(File_buff$)        ! Bl Buffer Length
3103        Fg=LEN(File_get$)         ! Fg = File Get (buffer)
3104     !
3105     ! First Append Residue File_get$ and refresh File_get$
3106     !
3107        IF (Bl<Spsiz) AND (NOT At_eof) AND (Bl+Fg<Max_buff) THEN 
3108     !
3109     ! If Bl<Spsiz [not enough in buffer to fill a packet] AND
3110     ! Bl+Fg<Max_buff [if adding Fget to buffer wont overflow] THEN
3111     ! append Fget to buffer.
3112     !
3113          IF Fg THEN ! Otherwise DON'T Because EOL gets stuffed Each Loop
3114            IF Image THEN 
3115              File_buff$=File_buff$&File_get$ ! IMAGE FILL
3116            ELSE
3117              File_buff$=File_buff$&File_get$&File_eol$
3118            END IF
3119            File_get$=""
3120          END IF
3121      !
3122      ! Then refill File_get$
3123      !
3124      ! #,-K   Fills File_get$ to dimensioned length, or EOF
3125      !
3126          REPEAT             ! Until Buff_full
3127            SELECT File_type
3128 Bdat:      CASE 2             !bdat
3129              IF Image THEN 
3130                ENTER @File USING "#,-K";File_get$   ! Enter bytes
3131              ELSE
3132              !
3133              ! **  Enter:   INTEGER
3134              !              REAL
3135              !              STRING (w/Format Off)
3136              !
3137              ! Bdat_item spec as OPTIONAL parameter
3138              !
3139                REPEAT
3140                  Bdat_item_ok=1
3141                  SELECT Bdat_item
3142                  CASE 1          ! integer
3143                !   DISP "Converting Integers to Ascii"
3144                    ENTER @File;Bdat_int
3145                    File_get$=VAL$(Bdat_int)
3146                  CASE 2          ! reals
3147                !   DISP "Converting Reals to Ascii"
3148                    ENTER @File;Bdat_real
3149                    File_get$=VAL$(Bdat_real)
3150                  CASE ELSE   ! not spec - best effort
3151                    ENTER @File;File_get$
3152                  END SELECT
3153                UNTIL Bdat_item_ok
3154              END IF
3155            CASE 4         ! hp-ux
3156              IF Image THEN 
3157                ENTER @File USING "#,-K";File_get$
3158              ELSE
3159                PAUSE
3160              !
3161                ENTER @File;File_get$
3162              END IF
3163            CASE 3             ! ascii
3164              ENTER @File;File_get$
3165            CASE ELSE
3166              BEEP 
3167              DISP "FILE TYPE = ";File_type;"  Not implemented "
3168              PAUSE
3169            END SELECT
3170            DISP 
3171            GOTO Fill_it
3172 !-------------------------------------------------------------------
3173 ! Enter here ON END @File ...
3174 ! If EOF then combine last file_get$ to buffer and set buff_full
3175 ! Prog wont return to this loop because at_eof is set.
3176 !
3177 At_eof:    At_eof=1
3178            IF Debug THEN PRINT TABXY(1,Crt_lines);"AT EOF","BUFF LEN = ";LEN(File_buff$)
3179            Buff_full=1     ! avoid looping and appending CR-LF
3180            IF Image THEN 
3181              File_buff$=File_buff$&File_get$
3182            ELSE
3183              File_buff$=File_buff$&File_get$&File_eol$
3184            END IF
3185            File_get$=""
3186            GOTO Full
3187 !-------------------------------------------------------------------
3188 Fill_it:!
3189            Bl=LEN(File_buff$)
3190            Fg=LEN(File_get$)
3191            IF Bl+Fg+2>Max_buff THEN 
3192              Buff_full=1                 ! leave File_get$ in tact
3193            ELSE
3194              IF Image THEN 
3195                File_buff$=File_buff$&File_get$
3196              ELSE
3197                File_buff$=File_buff$&File_get$&File_eol$    !<<<<<<<<< WILL CORRUPT A BINARY FILE
3198              END IF
3199              File_get$=""
3200            END IF
3201 Full:    UNTIL Buff_full
3202          DISP 
3203        END IF                  ! buffer smaller than next packet   Bl<Spsiz
3204    !-------------------------------------------------------------------
3205        Buff_full=0             ! allow buffer to fill next time
3206        Bl=LEN(File_buff$)      ! file buffer length
3207    !
3208    ! Debug: Buffer should not get to this point unless it contains at
3209    ! least a packet full of data (if not EOF)
3210      ! IF (Bl<Spsiz) AND (NOT At_eof) THEN
3211      !   BEEP
3212      !   DISP "BUFFER IS ";Bl;"  LONG","SPSIZ = ";Spsiz
3213      ! END IF
3214    !----------------------------------------------------------------------
3215        IF State$="E" THEN GOTO Ksendd_exit
3216        B=1                              ! because buff has been truncated
3217        P=1                              ! new packet
3218        Packet$=""        ! flush packet
3219        Pack_full=0
3220 Encode_pack:  !
3221        Bytes_a=LEN(File_buff$)
3222        Encode_pack(File_buff$,Packet$,Myquote,Qbin,Rep_ch,Spsiz)
3223        Bytes_b=LEN(File_buff$)
3224        Bytes_x=Bytes_x+(Bytes_a-Bytes_b)
3225        Bytes_old=Bytes_x
3226        IF At_eof AND (LEN(File_buff$)=0) THEN Sdata_done=1
3227   !
3228        Spack(Packet$,State$,Npak,Sndpkt$)
3229        IF Debug THEN 
3230          PRINT TABXY(25,6);Bytes_old,INT(Bytes_x/(TIMEDATE-Ft_start));"  B/SEC"
3231        ELSE
3232          PRINT TABXY(25,6);Bytes_old
3233        END IF
3234        PRINT TABXY(25,7);INT((Bytes_x/File_length)*100)
3235        PRINT TABXY(25,10);Npak
3236        PRINT TABXY(25,11);Oldtry+Dpacks
3237      !
3238      ! Send Packet Until Ack
3239      !
3240        REPEAT
3241          OUTPUT @Out_buff;Sndpkt$
3242          Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Dpacks,User_break,Emsg$)
3243          IF Debug THEN 
3244            PRINT TABXY(25,15);Rcvpkt$&"                "
3245            PRINT TABXY(25,16);Sndpkt$&"                "
3246          END IF
3247          IF D_log THEN OUTPUT @D_log;Sndpkt$,Rcvpkt$
3248  !
3249          SELECT Pktype$
3250          CASE "N"
3251          CASE "Y"
3252            Npak=Npak+1
3253            IF Sdata_done THEN 
3254              State$="Z"
3255              PRINT TABXY(25,13);"Sending End of File"&RPT$(" ",27)
3256            END IF
3257          CASE "E"
3258            Emsg$=Rdata$
3259            State$="E"
3260          CASE "T"
3261            Wmsg$="Packet Timeout"
3262          CASE "Q"
3263            Wmsg$="Bad Checksum or Sequence"
3264          CASE "X"
3265            State$="Z"! jump to end of file
3266            Wmsg$="User abort of Send File"
3267          CASE ELSE
3268            Wmsg$="Unknown Packet Type  "&Pktype$
3269          END SELECT
3270 Ksendd_exit:  ! File access errors jump and exit here
3271          PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
3272          PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
3273             !
3274          IF Pktype$="Y" THEN 
3275            Old_try=Old_try+Dpacks
3276          ELSE
3277            Dpacks=Dpacks+1
3278            IF Dpacks>Maxtry THEN 
3279              State$="E"
3280              Emsg$="Can't Receive (D) Ack from Host"
3281            END IF
3282          END IF
3283     !
3284        UNTIL Pktype$="Y" OR State$="E"
3285    !----------------------------------------------------------------------
3286 Ksendz:CASE "Z"
3287  !
3288  ! This state might be entered from local user interrruption.
3289  ! Check User_break to determine. Rdata$= "X" or "Z" depending on intr.
3290  ! Packet$="D" for user break discard.
3291  !
3292        IF Debug THEN PRINT TABXY(47,8);State$
3293        IF User_break THEN 
3294          Packet$="D"
3295        ELSE
3296          Packet$=""
3297        END IF
3298        IF NOT POS(Rdata$,"^C") THEN   ! Ok to notify host
3299          Spack(Packet$,State$,Npak,Sndpkt$)
3300          OUTPUT @Out_buff;Sndpkt$
3301          IF Debug THEN PRINT TABXY(25,16);Sndpkt$&"                "
3302          Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Zpacks,User_break,Emsg$)
3303        ELSE
3304         ! fall thru and process State$="X" for ^C event
3305        END IF
3306        IF Debug THEN PRINT TABXY(25,15);Rcvpkt$&"                "
3307        IF D_log THEN OUTPUT @D_log;Sndpkt$,Rcvpkt$
3308        SELECT Pktype$
3309        CASE "N"
3310        CASE "Y"
3311          Npak=Npak+1
3312          State$="B"
3313        CASE "E"
3314          Emsg$=Rdata$
3315          State$="E"
3316        CASE "T"
3317          Wmsg$="Packet Timeout"
3318        CASE "Q"
3319          Wmsg$="Bad Checksum"
3320        CASE "X"
3321          State$="B"
3322          IF Rdata$="^C" THEN 
3323            State$="X"  ! Dont notify host just exit
3324          END IF
3325        CASE ELSE
3326          Wmsg$="Unknown  Packet Type "
3327        END SELECT
3328  !
3329        IF Pktype$="Y" THEN 
3330        ELSE
3331          Zpacks=Zpacks+1
3332          IF Zpacks>Maxtry THEN 
3333            State$="E"
3334            Emsg$="Can't receive (Z) Acknowledge from host"
3335          END IF
3336        END IF
3337        PRINT TABXY(25,10);Npak
3338        PRINT TABXY(25,11);Oldtry+Zpacks
3339        IF State$<>"Z" THEN Oldtry=Oldtry+Zpacks
3340  !---------------------------------------------------------------------
3341 Ksendb:CASE "B"
3342        IF Debug THEN PRINT TABXY(47,8);State$
3343        Packet$=""
3344        Spack(Packet$,State$,Npak,Sndpkt$)
3345        PRINT TABXY(25,10);Npak
3346        PRINT TABXY(25,11);Oldtry
3347        PRINT TABXY(25,13);RPT$(" ",55)
3348        OUTPUT @Out_buff;Sndpkt$
3349        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Bpacks,User_break,Emsg$)
3350        IF Debug THEN 
3351          PRINT TABXY(25,16);Sndpkt$&"                "
3352          PRINT TABXY(25,15);Rcvpkt$&"                "
3353        END IF
3354        IF D_log THEN OUTPUT @D_log;Sndpkt$
3355        IF D_log THEN OUTPUT @D_log;Rcvpkt$
3356  !
3357        SELECT Pktype$
3358        CASE "N"
3359        CASE "Y"
3360          Oldtry=Oldtry+Bpacks
3361          Npak=Npak+1
3362          State$="C"
3363        CASE "E"
3364          Emsg$=Rdata$
3365          State$="E"
3366        CASE "T"
3367          Wmsg$="Packet Timeout"
3368        CASE "Q"
3369          Wmsg$="Bad Checksum or Sequence"
3370        CASE "X"
3371        CASE ELSE
3372          Wmsg$="Unknown Packet Type"
3373        END SELECT
3374  !
3375        IF Pktype$="Y" THEN 
3376        ELSE
3377          Bpacks=Bpacks+1
3378          IF Bpacks>Maxtry THEN 
3379            State$="E"
3380            Emsg$="Can't receive (B) Acknowledge from host"
3381          END IF
3382        END IF
3383        PRINT TABXY(25,10);Npak
3384        PRINT TABXY(25,11);Oldtry+Bpacks
3385        IF State$<>"B" THEN Oldtry=Oldtry+Bpacks
3386  !------------------------------------------------------------------------
3387 Ksende:CASE "E"    !
3388   !
3389   ! Need to know if this is a local error or host error
3390   ! User_break=Local Error
3391   !
3392        IF User_break THEN 
3393          Packet$=Emsg$
3394          Spack(Packet$,State$,Npak,Sndpkt$)
3395          OUTPUT @Out_buff;Sndpkt$
3396          IF D_log THEN OUTPUT @D_log;Sndpkt$
3397          IF Debug THEN PRINT TABXY(25,16);Sndpkt$&"                "
3398        ELSE! host error
3399        END IF
3400   !
3401        PRINT TABXY(25,10);Npak
3402        PRINT TABXY(25,11);Oldtry
3403        State$="X"
3404      END SELECT
3405  !---------------------------------------------------------------------
3406    UNTIL State$="C" OR State$="X"      ! Complete or Abort
3407    PRINT TABXY(1,Crt_lines);RPT$(" ",80)
3408    IF State$="C" THEN 
3409      PRINT "SEND FILE COMPLETE"
3410    ELSE
3411      IF State$="X" THEN 
3412        PRINT "User Abort"
3413      ELSE
3414        PRINT "SEND FILE FAILED - Host Error";Emsg$
3415      END IF
3416    END IF
3417    MASS STORAGE IS Sav_msi$
3418    SUBEXIT
3419  !========================================================================
3420 Check_for_rdisc:!
3421    Ramdisc=1
3422 Check_rdisc:MASS STORAGE IS ":,0,0"     ! err 76 incorrect unit code ?
3423    RETURN 
3424 !--------------------------------------------------------------------------
3425 Get_file_entry: !
3426    REPEAT
3427      Get_cat_entry(F$,F_msi$,F_path$,Filename$,File_found,Cat_entry$)
3428      IF NOT File_found THEN 
3429        DISP "File not Found - reenter file spec - blank to abort "
3430        OUTPUT KBD;Filename$;"ÿH";
3431        ENTER KBD;Misc$
3432        DISP 
3433        IF NOT LEN(Misc$) THEN SUBEXIT
3434        Parse_filename(Misc$,F_msi$,F_path$)
3435        F$=Misc$
3436        Filename$=F_path$&F$&F_msi$
3437      END IF
3438    UNTIL File_found
3439    IF NOT File_found THEN SUBEXIT
3440    At_file$=TRIM$(Cat_entry$[1,21])
3441    At_type$=TRIM$(Cat_entry$[32,36])
3442    At_rec=VAL(Cat_entry$[37,45])
3443    At_recl=VAL(Cat_entry$[46,54])
3444    At_time$=TRIM$(Cat_entry$[56,71])
3445    File_length=At_rec*At_recl*1.00
3446    RETURN 
3447  !------------------------------------------------------------------------
3448 Set_at: !   FORM FILE ATTRIBUTES PACKET DATA
3449   !
3450   ! Put File Attributes for F$ into Packet$
3451   ! Packet$ is in form:  ATTRIBUTE(char), LENGTH(unchar), DATA(char)
3452     !
3453     ! ! or 1    File length (Bytes)
3454     ! "         Data Type
3455     ! #         Creation Date
3456     ! .         Machine and OS
3457     ! /         Format Of Data          File_format$,File_type,File_delim$
3458     !
3459  ! CAT F_path$&F_msi$ TO Cat$(*);SELECT F$  ! FILE IS ELMENT 8
3460   !
3461   ! LIF:    TYPE  32-36  [5]
3462   !         REC   37-45  [9]
3463   !         RECL  46-54  [9]
3464   !         TIME  56-71  [22]
3465   !
3466    At_length$=VAL$(File_length)        ! BYTES
3467    At_os$="H4"                         !  Machine and OS !  H4=hp9000 RMB
3468    SELECT At_type$
3469    CASE "HP-UX"    ! w/ format on
3470      At_fmt$="A"
3471    CASE "ASCII"
3472      At_fmt$="D"
3473    CASE "BDAT"      ! w/ format off       ! M=recl  status reg 4
3474      At_fmt$="F"
3475      STATUS @File,4;At_recl
3476    END SELECT
3477   !------------  start attribute packet
3478    Next_at=1
3479    Packet$[Next_at;1]="1"                !1  file length (bytes)
3480    Atl=LEN(At_length$)
3481    Packet$[Next_at+1;1]=FNTochar$(Atl)
3482    Packet$[Next_at+2;Atl]=At_length$
3483    Next_at=Next_at+2+Atl
3484   !
3485   ! Data Format  (use file type)
3486   !
3487    Packet$[Next_at;1]=""""               !"    file (data) type
3488    Atl=LEN(At_type$)
3489    Packet$[Next_at+1;1]=FNTochar$(Atl)
3490    Packet$[Next_at+2;Atl]=At_type$
3491    Next_at=Next_at+2+Atl
3492   !
3493    Packet$[Next_at;1]="/"                !/    data format  on/off
3494    Atl=LEN(At_fmt$)
3495    Packet$[Next_at+1;1]=FNTochar$(Atl)
3496    Packet$[Next_at+2;Atl]=At_fmt$
3497    Next_at=Next_at+2+Atl
3498  !
3499                                  ! Creation Date [yy]yymmdd[  hh:mm[ :ss]
3500    Packet$[Next_at;1]="#"        !#    timedate
3501    Atl=LEN(At_time$)
3502    Packet$[Next_at+1;1]=FNTochar$(Atl)
3503    Packet$[Next_at+2;Atl]=At_time$
3504    Next_at=Next_at+2+Atl
3505   !
3506    Packet$[Next_at;1]="."        !.    Machine and Operating System
3507    Atl=LEN(At_os$)
3508    Packet$[Next_at+1;1]=FNTochar$(Atl)
3509    Packet$[Next_at+2;Atl]=At_os$
3510    Next_at=Next_at+2+Atl
3511   !
3512    RETURN 
3513   !-----------------------------------------------------------------------
3514 Send_intr: !      ! COMM PORT INTERRUPT HANDLER
3515    CALL Com_interrupt
3516    Shutdown
3517    ON INTR Com_port,15 GOSUB Send_intr
3518    SELECT Com_card
3519    CASE 98628
3520      CONTROL Com_port,13;164      ! MASK  4=UART  32=lost carr 128=break
3521    CASE 98626,98644
3522      ENABLE INTR Com_port;4
3523    END SELECT
3524    ON ERROR GOSUB Send_err
3525    Startup
3526    RETURN 
3527  !-----------------------------------------------
3528 Send_err:  !
3529    SELECT ERRN
3530    CASE 29   ! illegal floating point number
3531      Wmsg$="Illegal Floating Point Number"
3532      Emsg$="File I/O Error - cannot continue"
3533      State$="E"
3534      User_break=1
3535      ERROR RETURN
3536    CASE 52,73,76 ! Improper MSVS,device type,Unit Number
3537    !
3538    ! Checking for existance of Ramdisc
3539    !
3540      IF ERRL(Check_rdisc) THEN 
3541        Ramdisc=0
3542        ERROR RETURN
3543      ELSE
3544        DISP ERRM$
3545      END IF
3546    CASE 53        ! improper filename
3547      DISP "Improper filename, please correct "
3548      OUTPUT KBD;Filename$;"ÿH";
3549      ENTER KBD;F$
3550      Parse_filename(F$,F_msi$,F_path$)
3551      Filename$=F_path$&F$&F_msi$
3552      DISP 
3553    CASE 54   ! Duplicate File Name
3554      ASSIGN @Test TO *
3555      PRINT TABXY(25,13);"Purged and Overwrite ";F$&Ram_msi$
3556      PURGE F$&Ram_msi$
3557    CASE 56   ! Filename Undefined
3558      DISP "Cannot Access FILE  -  blank Filename will exit"
3559      OUTPUT KBD;Filename$;
3560      ENTER KBD;F$
3561      Parse_filename(F$,F_msi$,F_path$)
3562      DISP 
3563      IF NOT LEN(F$) THEN SUBEXIT
3564      Filename$=F_path$&F$&F_msi$
3565    CASE 58   ! Improper File Type
3566      DISP "Improper filename, please correct "
3567      OUTPUT KBD;Filename$;"ÿH";
3568      ENTER KBD;Misc$
3569      Parse_filename(Misc$,F_msi$,F_path$)
3570      F_path$=F_path$&Misc$
3571      DISP 
3572    CASE 90   ! Mass Storage System Error
3573      RESET 7
3574    CASE 157  ! No ENTER Terminator found
3575    !
3576    ! If sending BDAT files, exit
3577    ! if the ascii terminator not found
3578    !
3579      IF NOT Image THEN 
3580        Wmsg$="File contents not ASCII"
3581        Emsg$="File I/O Error - cannot continue"
3582        State$="E"
3583        User_break=1
3584        ERROR RETURN
3585      END IF
3586    CASE 167,168
3587      CALL Com_interrupt              ! Trap previous activity at com port
3588    CASE ELSE
3589      BEEP 
3590      DISP ERRM$&"  PAUSED"
3591      PAUSE
3592    END SELECT
3593   !
3594    DISP 
3595    RETURN 
3596 !-------------------------------------------------------------------------
3597 Spar:  !  Form Initialization Packet
3598  !
3599  ! Packet$="^A, S~(  *#&1 *"
3600  !
3601    Packet$=""                         !^A   PACKET MARK
3602                                       ! ,   44-32=12   PKT LENGTH
3603                                       ! sp  32-32=0    SEQUENCE
3604                                       ! S   PACKET TYPE (INIT)
3605    Packet$[1,1]=FNTochar$(Maxp)       ! ~   126-32=94
3606    Packet$[2,2]=FNTochar$(Mytmo)      ! (    40-32=8
3607    Packet$[3,3]=FNTochar$(Mypad)      ! sp   32-32=0
3608    Packet$[4,4]=FNTochar$(Mypchar)    ! sp   32-32=0
3609    Packet$[5,5]=FNTochar$(Myeol)      ! *    42-32=10
3610    Packet$[6,6]=CHR$(Myquote)         ! #    CONTROL QUOTE (0-31)
3611    Packet$[7,7]="&"                   ! &    8TH BIT PREFIX
3612    Packet$[8,8]="1"                   ! 1    CHECK TYPE
3613    Packet$[9,9]=" "                   ! sp   NO REPEAT COUNT PROCESS
3614    IF Send_at THEN 
3615      Packet$[10,10]="("               ! USE ATTRIBUTE PACKETS
3616    END IF
3617   !-----------------------------------!------------------------------
3618  ! EXTENDED PACKET SIZE               ! sp sp ~
3619    RETURN 
3620  !------------------------------------------------------------------------
3621 Rpar:  ! Receive Packet Initialization FROM REMOTE
3622        ! Rdata$[] DATA STRIPPED FROM INCOMING PACKET
3623    Rpsiz=FNUnchar(Rdata$[1])
3624    Ptmo=FNUnchar(Rdata$[2])
3625    Pad=FNUnchar(Rdata$[3])
3626    Padchar=FNUnchar(Rdata$[4])
3627    Eol=FNUnchar(Rdata$[5])
3628    IF Eol=0 THEN Eol=Myeol
3629    Myquote=NUM(Rdata$[6,6])
3630    Myquote$=CHR$(Myquote)
3631    IF LEN(Rdata$)>6 THEN Qbin=NUM(Rdata$[7,7])
3632    Qbin$=CHR$(Qbin)
3633    IF Qbin=89 THEN Qbin=38     ! 89=Y , 38=&
3634    IF Qbin=0 THEN Qbin=38
3635    IF LEN(Rdata$)>7 THEN R_bchk=VAL(Rdata$[8,8])
3636    IF LEN(Rdata$)>8 THEN Rep_char=NUM(Rdata$[9,9])
3637    IF LEN(Rdata$)>9 THEN R_capas=FNUnchar(Rdata$[10,10])
3638    IF BIT(R_capas,1) THEN    ! extended length packets
3639      Rcap_lp=1
3640      R_windo=FNUnchar(Rdata$[11,11])
3641      R_maxl1=FNUnchar(Rdata$[12,12])
3642      R_maxl2=FNUnchar(Rdata$[13,13])
3643      R_maxl=R_maxl1*95+R_maxl2
3644    END IF
3645    IF BIT(R_capas,3) THEN Rcap_a=1
3646    RETURN 
3647  !-----------------------------------------------------------------
3648  SUBEND                          ! END OF KERMIT SEND
3649  !=======================================================================
3650 Set_frame:SUB Set_frame(Req_baud)
3651  !
3652  ! Resets HW and SW Handshake registers, does not reset INT MASK
3653  !
3654    COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
3655    COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
3656    COM /Frame/ Flow$,Hshake$
3657    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
3658    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
3659    INTEGER Transfer_on,P,Pt,B,S
3660  !
3661    SELECT Req_baud
3662    CASE <301
3663      Baud=300
3664    CASE <1201
3665      Baud=1200
3666    CASE <2401
3667      Baud=2400
3668    CASE <4801
3669      Baud=4800
3670    CASE <9601
3671      Baud=9600
3672    CASE ELSE
3673      Baud=19200
3674    END SELECT
3675    IF Active THEN 
3676      Shutdown(Transfer_on)
3677    END IF
3678    SELECT Com_card
3679    CASE 98626,98644
3680      GOSUB Sf26
3681    CASE 98628
3682      GOSUB Sf28
3683    CASE ELSE
3684      BEEP 
3685      DISP "com card = ";Com_card,"unknown (paused)"
3686      PAUSE
3687    END SELECT
3688    IF Transfer_on THEN 
3689      Startup
3690    END IF
3691    SUBEXIT
3692  !----------------------
3693 Sf28:  !  SET FRAME ON 98628 DATACOMM CARD
3694    SELECT Baud
3695    CASE 300
3696      Bd=7
3697    CASE 1200
3698      Bd=9
3699    CASE 2400
3700      Bd=11
3701    CASE 4800
3702      Bd=13
3703    CASE 9600
3704      Bd=14
3705    CASE 19200
3706      Bd=15
3707    CASE ELSE
3708      BEEP 
3709      DISP "BAUD RATE: ";Baud;"  NOT IMPLEMENTED "
3710      PAUSE
3711    END SELECT
3712    SELECT Data_bits
3713    CASE 7
3714      B=2
3715    CASE 8
3716      B=3
3717    END SELECT
3718    SELECT Stop_bits
3719    CASE 1
3720      S=0
3721    CASE 2
3722      S=2
3723    END SELECT
3724    SELECT TRIM$(UPC$(On_off$))
3725    CASE "ON"
3726      Pt=5
3727    CASE "OFF"
3728      Pt=0
3729    END SELECT
3730 Set_pt: !
3731    IF Pt THEN                ! IF PARITY IS ON THEN
3732      SELECT UPC$(Parity_type$)
3733      CASE "NONE","OFF"
3734        Pt=0
3735      CASE "ODD"
3736        Pt=1
3737      CASE "EVEN"
3738        Pt=2
3739      CASE "MARK","1"
3740        Pt=4
3741      CASE "SPACE","0"
3742        Pt=3
3743      END SELECT
3744    END IF
3745    IF Pt>4 THEN 
3746      BEEP 
3747      INPUT "WHAT PARITY TYPE ? [NONE,ODD,EVEN,1,0] ",Parity_type$
3748      IF TRIM$(UPC$(Parity_type$))="NONE" THEN Pt=0
3749      GOTO Set_pt
3750    END IF
3751    CONTROL Com_port,20;Bd       ! SET BAUD RATE
3752    CONTROL Com_port,21;Bd       ! SET Rec  RATE
3753    CONTROL Com_port,34;B,S,Pt   ! SET DATA BITS, STOP, PARITY
3754    CONTROL Com_port,8;1+2       ! RTS  DTR  Set Active
3755    SELECT Flow$
3756    CASE "XON/XOFF"
3757      CONTROL Com_port,22;5  ! Protocol (sw) off  2:enq/ack  5/XON-XOFF
3758    CASE "ENQ/ACK"
3759      CONTROL Com_port,22;2  ! Protocol (sw) off  2:enq/ack  5/XON-XOFF
3760    CASE ELSE
3761      CONTROL Com_port,22;0  ! Protocol (sw) off  2:enq/ack  5/XON-XOFF
3762    END SELECT
3763    IF Hshake$="ON" THEN 
3764      CONTROL Com_port,23;1  ! Handshake On
3765    ELSE
3766      CONTROL Com_port,23;0  ! Handshake Off
3767    END IF
3768    RETURN 
3769    !----------------------------------
3770 Sf26:   !     SET FRAME FOR 98626/98644
3771    SELECT Data_bits
3772    CASE 7
3773      B=2
3774    CASE 8
3775      B=3
3776    END SELECT
3777    SELECT Stop_bits
3778    CASE 1
3779      S=0
3780    CASE 2
3781      S=4
3782    END SELECT
3783    SELECT TRIM$(UPC$(On_off$))
3784    CASE "ON"
3785      P=8
3786    CASE "OFF"
3787      P=0
3788    END SELECT
3789    SELECT UPC$(Parity_type$)
3790    CASE "ODD"
3791      Pt=0
3792    CASE "EVEN"
3793      Pt=16
3794    CASE "MARK","1"
3795      Pt=32
3796    CASE "SPACE","0"
3797      Pt=48
3798    END SELECT
3799    CONTROL Com_port,3;Baud,B+S+P+Pt   ! set reg 3 and 4
3800    CONTROL Com_port,5;1+2             ! set RTS and DTR Active
3801    IF Hshake$="ON" THEN 
3802      CONTROL Com_port,12;0  ! Handshake On
3803    ELSE
3804      CONTROL Com_port,12;128+32+16    ! Ignore CTS,DSR,CD
3805    END IF
3806    RETURN 
3807 !--------------------------
3808  SUBEND
3809 !========================================================================
3810 Ci:SUB Com_interrupt         ! transfers may be running
3811   !
3812    OPTION BASE 1
3813    DISP CHR$(129);"CI"
3814  ! uses:
3815  ! Com_card, Com_port, Debug
3816  !
3817    COM /Crt/ Crt_lines,Crt_width
3818    COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
3819  ! COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
3820  ! COM /Frame/ Flow$,Hshake$
3821    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
3822    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
3823  !
3824    ON ERROR GOSUB Local_err
3825    Errno=ERRN
3826    IF Errno=0 THEN 
3827      Errno=167                 ! INCASE THIS IS A REAL INTERRUPT NOT ERROR
3828    END IF
3829    GOSUB Local_err             ! PROCESS ERROR 167 - UART
3830    DISP CHR$(128)
3831    SUBEXIT
3832  !-------------------------------------
3833 Local_err: !
3834    SELECT Errno
3835    CASE 167                    ! process interrupt as error 167
3836      SELECT Com_card
3837      CASE 98644,98626
3838        GOSUB Com_intr_26
3839      CASE 98628
3840        GOSUB Com_intr_28
3841      CASE ELSE
3842      END SELECT
3843    CASE 163     ! io interace driver not present
3844      DISP ERRM$
3845      PAUSE
3846    CASE 59        ! end of buffer found
3847    ! do nothing -
3848      CLEAR ERROR
3849    CASE ELSE
3850      DISP ERRM$;" Com_interrupt  "
3851      PAUSE
3852    END SELECT
3853  !-----------------------------------------------------------------------
3854 Com_intr_26: !
3855   !
3856   ! Reg. 9:  Bit 0      Set when all conditions are clear
3857   !          Bit 1,2    Interrupt Cuase
3858   !
3859    STATUS Com_port,9;Int_cause,Uart_err    ! and clear int
3860    REPEAT
3861      Ic=BINAND(Int_cause,7)   ! Look at bits 0-1-2
3862      SELECT Ic
3863      CASE 0                      ! change in modem status lines
3864        STATUS Com_port,11;Mc     ! Modem Change
3865        IF (BIT(Mc,4)) OR (BIT(Mc,5)) OR (BIT(Mc,6)) OR (BIT(Mc,7)) THEN 
3866          IF Debug THEN PRINT TABXY(1,Crt_lines);"Serial Interrupt: Modem Line Disconnect"
3867        ELSE
3868          IF Debug THEN PRINT TABXY(1,Crt_lines);"Serial Interrupt: Modem Line Change "
3869        END IF
3870      CASE 2
3871      CASE 4
3872        IF Debug THEN PRINT "RECEIVE BUFFER FULL"
3873        STATUS Com_port,6;Rec     ! Clear Interrupt
3874      CASE 6                      ! UART Error
3875        STATUS Com_port,6;Rec     ! Clear Interrupt
3876        IF Debug THEN 
3877          PRINT "UART ERROR: ";Uart_err
3878          IF BIT(Uart_err,0) THEN PRINT "Rec. Buffer Full";   ! (1)
3879    !     IF BIT(Uart_err,1) THEN PRINT "Rec. Buffer Overrun";     ! (2)
3880          IF BIT(Uart_err,2) THEN PRINT "Parity Error";          ! (4)
3881          IF BIT(Uart_err,3) THEN PRINT "Framing Error";    ! (8)
3882          IF BIT(Uart_err,4) THEN PRINT "Break Received ";  ! (16)
3883    !     IF BIT(Uart_err,5) THEN PRINT "Trans. Hold. Reg ";! (32)
3884    !     IF BIT(Uart_err,6) THEN PRINT "Trans. Shift Reg ";! (64)
3885          PRINT 
3886        END IF
3887      END SELECT
3888      STATUS Com_port,9;Int_cause,Uart_err    ! BIT 0= SET when all intr are clear
3889    UNTIL Int_cause=1
3890    RETURN 
3891 !======================================================================
3892 Com_intr_28: !
3893 Rc28: !
3894 !
3895    STATUS Com_port,4;Int_bits      ! RESET INTERRUPT
3896    IF Debug THEN 
3897      PRINT "INTERRUPT CAUSE:  "
3898      IF BIT(Int_bits,0) THEN PRINT "DATA";
3899      IF BIT(Int_bits,1) THEN PRINT "PROMPT REC.";
3900      IF BIT(Int_bits,2) THEN PRINT "PARITY ERROR ";
3901      IF BIT(Int_bits,3) THEN PRINT "MODEM LINE CHANGE ";
3902      IF BIT(Int_bits,4) THEN PRINT "NO ACTIVITY TIMEOUT ";
3903      IF BIT(Int_bits,5) THEN PRINT "LOST CARRIER ";
3904      IF BIT(Int_bits,6) THEN PRINT "EOL RECEIVED ";
3905      IF BIT(Int_bits,7) THEN PRINT "BREAK RECEIVED ";
3906      PRINT 
3907    END IF
3908    RETURN 
3909  SUBEND          ! Comm Interrupt-98628
3910  !======================================================================
3911 Krec:SUB K_receive(Filename$,F_msi$,F_path$,Ftype$,Recl,File_length,Get_cmd,OPTIONAL Localname$)
3912  !
3913  ! Kermit Receive  File Protocol
3914  !
3915  ! File_length:     Bytes    if Filetype HPUX
3916  !                  Records  if Filetype BDAT
3917  !                  Sectors  if Filetype ASCII,SYSTM,BIN,PROG
3918  !
3919  ! Recl             Record length (BDAT ONLY)
3920  !
3921    OPTION BASE 1
3922    COM Version$,K$,Setup$
3923    COM /Crt/ Crt_lines,Crt_width
3924    COM /Flags/ Kermit_exit,INTEGER Active,Debug,In_term
3925    COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
3926    COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas,Send_at
3927    COM /Kerm/ INTEGER Image,Parflg,Pktdeb
3928    COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol,Smark
3929    COM /Kerm2/ State$[1],Cchksum$[1],Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
3930    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
3931    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
3932    COM /Frame/ Baud,Data_bits,Stop_bits,On_off$[3],Parity_type$[4]
3933    COM /Frame/ Flow$,Hshake$
3934    COM /Term/ Term_type$[10],S_log,D_log,Filewarn,Discard,@S_log,@D_log
3935    COM /Term/ Kerm_esc$[2],S_log$,D_log$,INTEGER Remote,Lecho,Turn,Display
3936    COM /Term/ Term_mode$
3937    COM /Path/ Cur_msi$,S_path$,S_msi$,D_path$,D_msi$
3938  !
3939  ! Local Vars
3940  !
3941    INTEGER Qbin,Rep_ch   ! not in kermit COM
3942    INTEGER Chksum,Rc,Plen,Dlen,Cchksum,Rseq
3943    INTEGER Ftype,Volnum,Prot,Recsize,Sec_data(1:256),Sectors
3944    INTEGER File_open
3945    INTEGER Npak,Oldtry,Spacks,Fpacks,Apacks,Dpacks,Zpacks,Bpacks,Epacks
3946    INTEGER R_maxl1,R_maxl2,R_maxl
3947    INTEGER User_break,Spillfile,Use_ram
3948    REAL File_st,F_sec
3949    ALLOCATE Rcvpkt$[1024],Sndpkt$[Spsiz],Rdata$[1024],A$[1],Packet$[Spsiz]
3950    ALLOCATE File_buff$[4096],Sector$[256]
3951    DIM Emsg$[100],Wmsg$[100],Pkt$[1]                 !,Cat$(10)[80]
3952    DIM Asc_eol$[2]
3953    DIM F$[80],Sav_msi$[256]
3954  !--------------------------------------------
3955    ON ERROR GOSUB Rec_err
3956    Spillfile=0      ! indicates that a spillfile was needed
3957    Use_ram=0
3958    Asc_eol$=CHR$(13)&CHR$(10)
3959    Buff_len=MAXLEN(File_buff$)
3960    Sav_msi$=SYSTEM$("MSI")
3961 !-------------------------------
3962    IF POS(F_msi$,":MEMORY") OR POS(F_msi$,":,0") OR POS(F_msi$,":, 0") THEN Use_ram=1
3963    IF Ftype$="PROG" OR Ftype$="BIN" OR Ftype$="SYSTM" THEN Use_ram=1
3964    IF Use_ram THEN 
3965      Ramdisc=0
3966 Check_ramdisc:MASS STORAGE IS ":,0,0"   ! check in rec_err
3967      MASS STORAGE IS Sav_msi$
3968      IF Kbytes=0 THEN 
3969        Disc_space(":,0,0",Total,Largest_hole,Hole_sum,Format$)
3970        IF Largest_hole>0 THEN Ramdisc=1
3971        Kbytes=Largest_hole*256
3972      END IF
3973    END IF
3974  !------------------------------
3975    CALL Shutdown
3976   !
3977   ! 98626 overrun error cannot be trapped during transfers - therefore
3978   ! they only show up as error 167 IO status error
3979   !
3980    SELECT Com_card
3981    CASE 98626,98644
3982  !   CALL Reset_port             ! Accidentally  Disconnects Modem
3983      ENABLE INTR Com_port;8+4               ! 8=modem   4=UART or Overrun
3984    CASE 98628                               ! 2=tx reg  1=rec buff full
3985  !   CALL Reset_port
3986      CONTROL Com_port,13;164     ! INT MASK  4=UART  32=lost car 128=break
3987    END SELECT
3988  !
3989    ON INTR Com_port,5 GOSUB Rec_intr
3990    ON TIMEOUT 7,.5 GOSUB No_printer
3991    ON KBD,3 GOSUB Kbr_int
3992    CLEAR SCREEN
3993    IF Display THEN 
3994      PRINT TABXY(1,2);Version$
3995      PRINT TABXY(15,5);"Filename: "                    ! LINE 5
3996      PRINT TAB(6);"Bytes Transferred: ";TAB(25);Kbx   ! 6
3997      PRINT 
3998      PRINT TAB(16);"RECEIVE: In Progress"              ! 8
3999      PRINT                                             ! 9
4000      PRINT TAB(6);"Number of Packets: ";TAB(25);Npak   ! 10
4001      PRINT TAB(6);"Number of Retries: ";TAB(25);Oldtry ! 11
4002      PRINT TAB(13);"Last Error: "                      ! 12
4003      PRINT TAB(11);"Last Warning: "                    ! 13
4004                                                        ! 14
4005      IF Debug THEN 
4006        PRINT TABXY(11,15);"SPACK:        "             ! 15
4007        PRINT TABXY(11,16);"RPACK:        "             ! 16
4008      END IF
4009    END IF
4010    PRINT TABXY(1,Crt_lines-1);CHR$(129);"^X cancels File, ^E Quits Protocol, ^C Quits, Return retries";CHR$(128)
4011    CALL Startup     ! re-activate transfers
4012 Krecs:    !-------------------------------------  Receive
4013    Input_buffer$=""
4014    Npak=0
4015    State$="S"
4016  !------------------------ GET R Packet --------------------------------
4017    IF Get_cmd THEN 
4018 Krecr:State$="R"
4019      Packet$=Filename$
4020      Spack(Packet$,State$,Npak,Sndpkt$)
4021      PRINT TABXY(25,13);"Requesting File Send"
4022      OUTPUT @Out_buff;Sndpkt$
4023      IF Debug THEN PRINT TABXY(25,15);Sndpkt$&RPT$(" ",100)
4024      IF D_log THEN OUTPUT @D_log;Sndpkt$
4025      State$="S"
4026    !
4027      IF NPAR>7 THEN 
4028        Filename$=Localname$
4029      ELSE
4030    ! Need to check here for a "DOS" type illegal filename
4031      END IF
4032    END IF
4033  !
4034  !------------------------  Receive  Sequence  --------------------------
4035  !
4036    REPEAT   ! Until State$="X","C"   receive done
4037      SELECT State$         ! state switcher
4038      CASE "S"
4039 Sinit:  !
4040        Packet$=""   ! Packet Data
4041        Pkt$="N"     ! Nak unless expected packet arives
4042        PRINT TABXY(25,13);"Exchanging Initialization Packets"
4043        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Spacks,User_break,Emsg$)
4044        IF (Debug) THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",20)
4045        IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
4046        SELECT Pktype$
4047        CASE "S"
4048          GOSUB Rrpar         ! Get remote Parameters
4049          GOSUB Rspar         ! Form Packet$ with our parameters
4050          Pkt$="Y"
4051          State$="F"
4052        CASE "E"            ! Either received or user abort E
4053          IF NOT User_break THEN Emsg$=Rdata$
4054          State$="E"
4055        CASE "T"
4056          Wmsg$="Packet Timeout"
4057        CASE "Q"
4058          Wmsg$="Bad Checksum"
4059        CASE "F","A","D"
4060          ! just Nak the expected packet number
4061        CASE "Z","B"
4062          State$=Pktype$         ! jump to eof or break state
4063        CASE "X"            ! User Quit
4064          Pkt$="Y"
4065          Packet$=Rdata$    ! X or Z in ack packet will abort sender
4066          State$="Z"        ! let Z state process closure
4067        CASE "N"
4068          IF Get_cmd THEN 
4069            OUTPUT @Out_buff;Sndpkt$  ! Re-send "R" Packet
4070          END IF
4071        END SELECT
4072      !
4073        Spack(Packet$,Pkt$,Npak,Sndpkt$)
4074        OUTPUT @Out_buff;Sndpkt$
4075      !
4076        IF Spacks>Maxtry THEN 
4077          State$="E"
4078          User_break=1
4079          Emsg$="Unable to receive initiate"
4080          Packet$=Emsg$
4081        END IF
4082        IF Pkt$="Y" THEN 
4083     !    State$="F"            ! could  be X if aborting
4084          Npak=Npak+1
4085          Oldtry=Oldtry+Spacks
4086        ELSE
4087          Spacks=Spacks+1
4088        END IF
4089      !
4090        PRINT TABXY(25,10);Npak
4091        PRINT TABXY(25,11);Oldtry+Spacks
4092        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4093        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4094        IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-(LEN(Sndpkt$)))
4095        IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4096    !-----------------------------------     Receive File Header (F)
4097 Krecf:CASE "F"      ! Enter Npak=1
4098        Packet$=""
4099        IF Debug THEN PRINT TABXY(25,4);State$
4100        Pkt$="N"
4101        PRINT TABXY(25,13);"Receiving Filename"&RPT$(" ",26)
4102        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Fpacks,User_break,Emsg$)
4103        IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",80-LEN(Rcvpkt$))
4104        IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
4105        SELECT Pktype$
4106        CASE "S"
4107          OUTPUT @Out_buff;Sndpkt$   !  S Packet Sndpkt$ still in tact
4108          IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4109        CASE "E"
4110          Emsg$=Rdata$
4111          State$="E"
4112        CASE "T"
4113          Wmsg$="Packet Timeout"
4114        CASE "Q"
4115          Wmsg$="Bad Checksum"
4116        CASE "A","D"
4117        ! Just Nak               ! probably should abort here
4118        CASE "Z","B"
4119          State$=Pktype$
4120        CASE "X"
4121          Pkt$="Y"
4122          Packet$=Rdata$
4123          State$="Z"
4124        CASE "F"
4125          Pkt$="Y"
4126          Oldtry=Oldtry+Spacks
4127          IF Rcap_a THEN            ! Attribute Packets in use
4128            State$="A"
4129          ELSE
4130            State$="D"
4131          END IF
4132          GOSUB Verify_fname        ! Create F_path$, F_msi$, Filename$
4133        END SELECT
4134        Spack(Packet$,Pkt$,Npak,Sndpkt$)
4135        OUTPUT @Out_buff;Sndpkt$
4136      !
4137        IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
4138        IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4139        IF Fpacks>Maxtry THEN 
4140          State$="E"
4141          User_break=1
4142          Packet$="Unable to receive filename"
4143        END IF
4144        PRINT TABXY(25,10);Npak
4145        PRINT TABXY(25,11);Oldtry+Fpacks
4146        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4147        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4148      !
4149        IF Pkt$="Y" THEN 
4150          Npak=Npak+1
4151        ELSE
4152          Fpacks=Fpacks+1
4153        END IF
4154    !--------------------------------------  File Attributes
4155      CASE "A"   ! F-path$ corrupted before here
4156 Kreca:  !
4157        Packet$=""
4158        IF Debug THEN PRINT TABXY(25,4);State$
4159        Pkt$="N"
4160        PRINT TABXY(25,13);"Receiving File Attributes"&RPT$(" ",19)
4161        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Apacks,User_break,Emsg$)
4162        IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",60-LEN(Rcvpkt$))
4163        IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
4164        SELECT Pktype$
4165        CASE "A"
4166          GOSUB Get_at
4167          Pkt$="Y"
4168          IF File_length THEN 
4169            PRINT TABXY(10,7);"% Transferred:"
4170          END IF
4171          State$="D"
4172        CASE "Z","B"
4173          State$=Pktype$
4174        CASE "E"
4175          Emsg$=Rdata$
4176          State$="E"
4177        CASE "T"
4178          Wmsg$="Packet Timeout"
4179        CASE "Q"
4180          Wmsg$="Bad Checksum"
4181        CASE "X"
4182          Pkt$="Y"
4183          Packet$=Rdata$
4184          State$="Z"
4185        END SELECT
4186      !
4187        Spack(Packet$,Pkt$,Npak,Sndpkt$)
4188        OUTPUT @Out_buff;Sndpkt$
4189        IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
4190        IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4191        PRINT TABXY(25,10);Npak
4192        PRINT TABXY(25,11);Oldtry+Apacks
4193        IF Apacks>Maxtry THEN 
4194          State$="E"
4195          User_break=1
4196          Packet$="Unable to receive attribute packet"
4197        END IF
4198        IF Pkt$="Y" THEN 
4199          Npak=Npak+1
4200          Oldtry=Oldtry+Spacks
4201        ELSE
4202          Apacks=Apacks+1
4203        END IF
4204        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4205        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4206    !--------------------------------------  Receive File Data  "D"
4207      CASE "D"
4208 Krecd: !
4209        Packet$=""
4210        Rdata$=""
4211        Pkt$="N"
4212     !
4213        IF NOT Dinit THEN 
4214          PRINT TABXY(25,13);"Receiving File Data"&RPT$(" ",25)
4215          Dinit=1
4216        END IF
4217        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Dpacks,User_break,Emsg$)
4218        IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",20)
4219        IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
4220        SELECT Pktype$
4221        CASE "F","S","A"
4222          Emsg$="Packets out of sequence"
4223          State$="E"
4224          User_break=1
4225        CASE "Z","B"         ! Process State Z here
4226          PRINT TABXY(25,13);"Receiving End of File"&RPT$(" ",25)
4227       !
4228       ! Write Remaining File Lines
4229       !
4230          IF File_open THEN 
4231            SELECT Filetype$
4232            CASE "ASCII"
4233              OUTPUT @File;File_buff$
4234            CASE "HPUX","BDAT"
4235              OUTPUT @File USING "#,K";File_buff$
4236            CASE ELSE
4237              OUTPUT @File;File_buff$;
4238            END SELECT
4239            OUTPUT @File;END
4240            ASSIGN @File TO *
4241            File_open=0
4242          END IF! file open
4243          Pkt$="Y"
4244          State$="B"              ! Skip over Z state (done here )
4245          Oldtry=Oldtry+Spacks
4246        CASE "E"
4247          Emsg$=Rdata$
4248          State$="E"
4249        CASE "T"
4250          Wmsg$="Packet Timeout"
4251        CASE "Q"
4252          Wmsg$="Bad Checksum or Sequence"
4253        CASE "X"
4254          Pkt$="Y"
4255          Packet$=Rdata$
4256          State$="Z"
4257          User_break=1
4258     !---------------------------------------  File Data Received
4259        CASE "D"
4260          Pkt$="Y"
4261        CASE ELSE
4262        END SELECT
4263    !
4264        Spack(Packet$,Pkt$,Npak,Sndpkt$)
4265        OUTPUT @Out_buff;Sndpkt$
4266        IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
4267        IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4268        PRINT TABXY(25,10);Npak
4269        PRINT TABXY(25,11);Oldtry+Dpacks
4270        IF Dpacks>Maxtry THEN 
4271          State$="E"
4272          User_break=1
4273          Packet$="Unable to receive file data packet"
4274        END IF
4275      !
4276        IF Pkt$="Y" THEN 
4277          Npak=Npak+1
4278        ELSE
4279          Dpacks=Dpacks+1
4280        END IF
4281        IF Display THEN 
4282          PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4283          PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4284        END IF
4285        IF (User_break) OR (State$<>"D") THEN GOTO Krecd_exit
4286     !
4287        IF Pkt$="Y" THEN            !- PACKET IS "Y" - RECEIVE DATA
4288          IF User_break THEN GOTO Krecd_exit   ! Avoid Data Packet
4289          DISABLE 
4290 Of: ! ---- Create and Open File
4291          IF NOT File_open THEN 
4292          !
4293            IF NOT (LEN(Ftype$)) THEN Ftype$="HPUX"
4294       !
4295       ! Process Filelength
4296       !
4297            IF File_length=0 THEN   ! Attribute Packet Not Used
4298              SELECT Ftype$
4299              CASE "HPUX","PROG"
4300                IF Hfs_disc THEN 
4301                  File_length=1
4302                ELSE
4303                  IF Ramfile THEN File_length=Kbytes
4304                  IF NOT Ramfile THEN File_length=50000  ! bytes
4305                END IF
4306              CASE ELSE
4307                IF Hfs_disc THEN 
4308                  File_length=1
4309                ELSE
4310                  IF Ramfile THEN File_length=Kbytes
4311                  IF NOT Ramfile THEN File_length=50000
4312                END IF
4313              END SELECT
4314            ELSE           ! file length spec in attribute packet
4315              IF Ramdisc THEN 
4316                IF File_length>(Kbytes*1000) THEN  ! ramdisc too small
4317                  Wmsg$="File larger than Mass Storage"
4318                  Emsg$="Mass Storage Overflow"
4319                  State$="E"
4320                  User_break=1
4321                  GOTO Krecd_exit
4322                END IF
4323              END IF
4324            END IF        ! File Length = 0
4325        !
4326        ! Code to check for residual file not working add an extra sector
4327        !
4328        !   Res=File_length MOD 256
4329        !   IF NOT Res THEN
4330        !   Sectors=MAX(1,INT(File_length/256))
4331        !   ELSE
4332            Sectors=MAX(1,INT(File_length/256)+1)
4333        !   END IF
4334        !
4335            SELECT Ftype$
4336            CASE "HP-UX","HPUX"
4337              CREATE F_path$&Filename$&F_msi$,File_length+1
4338            CASE "BDAT"
4339              IF Recl>0 THEN 
4340                CREATE BDAT F_path$&Filename$&F_msi$,Sectors,Recl
4341              ELSE
4342                CREATE BDAT F_path$&Filename$&F_msi$,Sectors
4343              END IF
4344            CASE "ASCII"
4345              CREATE ASCII F_path$&Filename$&F_msi$,Sectors
4346            CASE ELSE    ! "SYSTM","BIN","PROG"
4347              CREATE F_path$&Filename$&F_msi$,File_length   ! Use HP-UX then convert later
4348            END SELECT
4349          !
4350            IF State$="E" THEN               ! Mass Storage Overflow ?
4351              User_break=1
4352              GOTO Krecd_exit
4353            END IF
4354            ASSIGN @File TO F_path$&Filename$&F_msi$;FORMAT OFF
4355            File_open=1
4356          ! ---------------------------------  Init Process Rdata$
4357            P=1         ! packet contents pointer
4358            Qon=0       ! quoting on flag
4359            Biton=0     ! 8 bit prefixing flag
4360            Rept=0      ! repeat prefix flag
4361          END IF  ! file not open
4362        END IF    !   D Packet and File Not open
4363     !---------------------------------------------  Pack File_buff$(*)
4364 Decode: !
4365        IF Pktype$="D" THEN 
4366                                    ! strip parity bits here  ????????????
4367          CALL Decode_pack(Rdata$,Quote,Qbin,Rep_ch)
4368          File_buff$=File_buff$&Rdata$
4369          Pl=LEN(Rdata$)            ! Pl = Packet Length
4370          P=P+Pl                    ! P  = Buffer Pointer (File_buff$)
4371        END IF   ! D Packet
4372      !
4373        Kbx=Kbx+Pl                  ! Kbx = Bytes Transferred
4374        PRINT TABXY(25,6);Kbx           !INT(Kbx/1000)
4375        IF At_filelength THEN 
4376          PRINT TABXY(25,7);MIN(100,INT((Kbx*100)/File_length));"%"
4377        END IF
4378      !
4379      ! Check Buffer Length and write File
4380      !
4381        IF P>Buff_len-100 THEN               !write file
4382          IF Debug THEN DISP "Writing File ";F_path$&Filename$&F_msi$
4383          SELECT Ftype$
4384          CASE "ASCII"
4385        !
4386        ! The File_buff$ is parsed for CR-LF (Ascii_eol$)
4387        ! The Eol$ is removed, and each line is written to the Ascii
4388        ! File creating Length-header delimited data.
4389        !
4390            Ascii_eol$="
"
4391            Eol_l=LEN(Ascii_eol$)
4392            REPEAT
4393              Eolpos=POS(File_buff$,Ascii_eol$)
4394              IF Eolpos THEN 
4395                Sector$=File_buff$[1,Eolpos]
4396              ELSE    ! the last fragment has no eol in the packet
4397                Sector$=File_buff$
4398              END IF
4399              OUTPUT @File;Sector$;
4400              File_buff$=File_buff$[Eolpos+Eol_l]  ! truncate and remove eol
4401            UNTIL Eolpos=0
4402          CASE ELSE
4403            OUTPUT @File USING "#,K";File_buff$      ! supress <null> eol
4404          END SELECT
4405          File_buff$=""
4406          P=0
4407        END IF
4408 Krecd_exit: !ENABLE
4409    !----------------------------------------------------------------------
4410 Krecz:CASE "Z"
4411     !
4412     !  State Z is normally processed in D State Handling -
4413     !  Rdata$ in tact
4414     !---------------------------------------------------------------------
4415     !  This state is entered in 2 situations -
4416     !
4417     ! 1. Sender sends a Z packet prematurely
4418     ! 2. User (receiver) abort
4419     !  This state may be entered forom a user-abort sequence ^X  ^Z
4420     !  If so, then the user_break flag will be set, and Rdata$ will be
4421     !  X if ^X was invoked, or Z if ^Z was invoked.
4422     !--------------------------------------------------------------------
4423     ! Variables set after user break conditions
4424  !
4425  !          Pktype$     Rdata$    State$
4426  !   ^X       X           X        --
4427  !   ^Z       X           Z        --
4428  !   ^E       E          --        E
4429  !   ^C       X          ^C        X   (unless changed in other states)
4430  !
4431  !
4432        IF User_break THEN 
4433          IF NOT POS(Rdata$,"^C") THEN             ! Ok to notify host
4434          !
4435          ! ^X and ^Z:  send ack with X or Z in data field
4436          !
4437            Packet$=Rdata$
4438            Spack(Packet$,State$,Npak,Sndpkt$)
4439            OUTPUT @Out_buff;Sndpkt$
4440            IF Debug THEN PRINT TABXY(25,16);Sndpkt$&"                "
4441            Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Zpacks,User_break,Emsg$)
4442          ELSE   ! ^C processing just abort
4443           ! fall thru to check pktype
4444          END IF
4445        ELSE
4446          Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Bpacks,User_break,Emsg$)
4447        END IF
4448        IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",60-LEN(Rcvpkt$))
4449        IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
4450        Pkt$="N"
4451 Check_z:!
4452        SELECT Pktype$
4453        CASE "Z"
4454       ! ** Should inspect Rdata$ for a "D)iscard" instruction"
4455       ! if Rdata$="D" then discard file.
4456       !
4457       ! Write Remaining File Lines **
4458       !
4459          IF Rdata$="D" THEN 
4460       ! discard file here
4461            DISP "Received Abort from Sender and signal to discard file - purge file ? "
4462            OUTPUT KBD;"Y";"ÿH";
4463            ENTER KBD;Ans$
4464            DISP 
4465            IF UPC$(Ans$)="Y" THEN 
4466              DISP "Purging File: ";Filename$
4467              PURGE Filename$
4468            END IF
4469          ELSE     ! close file normally
4470            IF File_open THEN 
4471              Bl=LEN(File_buff$)
4472              SELECT Filetype$
4473              CASE "HPUX","BDAT"
4474                OUTPUT @File;File_buff$;END
4475                PRINT File_buff$
4476              CASE "ASCII"
4477                OUTPUT @File;File_buff$;END
4478              END SELECT
4479              ASSIGN @File TO *
4480              File_open=0
4481              DISP 
4482            ELSE
4483              Wmsg$="(Z) File not Open "
4484            END IF! file open
4485          END IF
4486          Pkt$="Y"
4487          State$="B"
4488          Oldtry=Oldtry+Zpacks
4489        CASE "B"
4490          State$="C"              ! File Transfer Complete
4491          Pkt$="Y"
4492        CASE "E"
4493          Emsg$=Rdata$
4494          State$="E"
4495        CASE "T"
4496          Wmsg$="Packet Timeout"
4497        CASE "Q"
4498          Wmsg$="Bad Checksum"
4499        CASE "X"
4500          State$="X"    ! abort
4501        END SELECT
4502    !
4503        Spack(Packet$,Pkt$,Npak,Sndpkt$)   !?????????????????????
4504        OUTPUT @Out_buff;Sndpkt$
4505        IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
4506        IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4507      !
4508        IF Zpacks>Maxtry THEN 
4509          State$="E"
4510          User_break=1
4511          Packet$="Unable to receive EOF (Z)  packet"
4512          Emsg$="Unable to receive EOF (Z)  packet"
4513        END IF
4514      !
4515        IF Pkt$="Y" THEN 
4516          Npak=Npak+1
4517        ELSE
4518          Zpacks=Zpacks+1
4519        END IF
4520      !
4521 Krecz_exit:!
4522        PRINT TABXY(25,10);Npak
4523        PRINT TABXY(25,11);Oldtry+Bpacks
4524        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4525        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4526  !---------------------------------------------------------------------
4527 Krecb:CASE "B"
4528     !
4529        Packet$=""
4530        IF Debug THEN PRINT TABXY(25,4);State$
4531        Pkt$="N"
4532        PRINT TABXY(25,13);RPT$(" ",55)
4533        Rpack(Pktype$,Rdata$,Rseq,Rcvpkt$,Sndpkt$,Npak,Bpacks,User_break,Emsg$)
4534        IF Debug THEN PRINT TABXY(20,16);Rcvpkt$&RPT$(" ",60-LEN(Rcvpkt$))
4535        IF D_log THEN OUTPUT @D_log;"rpack: ";Rcvpkt$
4536        SELECT Pktype$
4537        CASE "Z"
4538          Pkt$="Y"
4539          State$="B"              ! Skip over Z state (done here )
4540          Oldtry=Oldtry+Zpacks
4541        CASE "B"
4542          State$="C"              ! File Transfer Complete
4543          Pkt$="Y"
4544        CASE "E"
4545          Emsg$=Rdata$
4546          State$="E"
4547        CASE "T"
4548          Wmsg$="Packet Timeout"
4549        CASE "Q"
4550          Wmsg$="Bad Checksum"
4551        CASE "X"
4552        END SELECT
4553    !
4554        Spack(Packet$,Pkt$,Npak,Sndpkt$)
4555        OUTPUT @Out_buff;Sndpkt$
4556        IF Debug THEN PRINT TABXY(20,15);Sndpkt$&RPT$(" ",60-LEN(Sndpkt$))
4557        IF D_log THEN OUTPUT @D_log;"Spack: ";Sndpkt$
4558        PRINT TABXY(25,10);Npak
4559        PRINT TABXY(25,11);Oldtry+Bpacks
4560      !
4561        IF Bpacks>Maxtry THEN 
4562          State$="E"
4563          User_break=1
4564          Packet$="Unable to receive break packet"
4565          Emsg$="Unable to receive break packet"
4566        END IF
4567      !
4568        IF Pkt$="Y" THEN 
4569          IF User_break THEN 
4570            State$="X"
4571          ELSE
4572            State$="C"
4573          END IF
4574          Npak=Npak+1
4575        ELSE ! pkt$="N"
4576          Bpacks=Bpacks+1
4577        END IF
4578      !
4579        PRINT TABXY(25,10);Npak
4580        PRINT TABXY(25,11);Oldtry+Bpacks
4581        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4582        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4583  !
4584        IF Ftype$="PROG" THEN 
4585          CALL Convert(F_path$&Filename$&F_msi$,"PROG",Rc)
4586          PRINT TABXY(1,18);"PROG File exists on Ram Disc - Copy file to disc before leaving Kermit"
4587        END IF
4588  !------------------------------------------------------------------------
4589 Krece:CASE "E"    !
4590   !
4591   !  Enter E state on:
4592   !
4593   ! 1. Received E  Packet from Host    (User_break=0)
4594   !    Erm$ (and Rdata$) contains the host error message
4595   ! 2. User Abort - User_break=1
4596   ! Packet$ (rdata$  ? )contains the error message being sent
4597   !
4598   ! Emsg$ must contain data mesage for packet
4599   !
4600        BEEP 
4601        IF User_break THEN      ! User abort
4602          Pkt$="E"   ! Nak unless expected packet arives
4603          Packet$=Emsg$
4604          Spack(Packet$,Pkt$,Npak,Sndpkt$)
4605          OUTPUT @Out_buff;Sndpkt$
4606          IF D_log THEN OUTPUT @D_log;"SPACK: ";Sndpkt$
4607          State$="X"              ! indicate User Abort
4608        ELSE   ! Host Error - E packet  Received
4609          State$="X"
4610        END IF
4611        PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4612        PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4613        PRINT TABXY(1,Crt_lines);
4614       !----------------------------------------------------------------
4615      END SELECT    ! Receive State Switch
4616    UNTIL (State$="X") OR (State$="C")     ! Don't put "E" here !
4617   !========================================================================
4618    IF D_log THEN ASSIGN @D_log TO *
4619    ASSIGN @File TO *
4620   !
4621    IF Com_card=98628 THEN 
4622     ! Do Nothing
4623    ELSE  ! 98626
4624      REPEAT
4625        STATUS @Out_buff,4;Bl     ! Finish sending last packet
4626      UNTIL Bl=0
4627    !
4628      STATUS @In_buff,4;Bl
4629      WHILE Bl
4630        OUTPUT @Out_buff;"
"
4631        IF Bl THEN ENTER @In_buff;Misc$
4632        IF Debug THEN PRINT Misc$
4633        STATUS @In_buff,4;Bl     ! Finish sending last packet
4634      END WHILE
4635   !  CALL Shutdown      ! << this could be screwing things
4636    END IF
4637   !
4638 Krec_exit:  !
4639   !
4640    PRINTER IS CRT
4641    PRINT TABXY(1,16);
4642    SELECT State$
4643    CASE "C"
4644      PRINT TABXY(16,8);"RECEIVE: Completed  "              ! 8
4645    CASE "X"
4646      IF NOT User_break THEN 
4647        PRINT TABXY(16,8);"RECEIVE: Aborted by host "       ! 8
4648      ELSE
4649        PRINT TABXY(16,8);"RECEIVE: Aborted by user "       ! 8
4650     !  PRINT Emsg$
4651      END IF
4652   ! process incomplete file here - save or discard
4653      IF Discard THEN 
4654        DISP "Discard File: ";F_path$&Filename$&F_msi$;"  ?"
4655        OUTPUT KBD;"Yes";
4656        ENTER KBD;Ans$
4657        DISP 
4658        ON ERROR GOTO No_discard
4659        IF POS(UPC$(Ans$),"Y") THEN PURGE F_path$&Filename$&F_msi$
4660 No_discard:DISP ERRM$
4661        OFF ERROR 
4662      END IF
4663    END SELECT
4664    PRINT TABXY(1,Crt_lines);
4665    MASS STORAGE IS Sav_msi$
4666    SUBEXIT
4667 !-----------------------------------------------------------------------
4668 Verify_fname: !   called from State "F"
4669 Vf: !
4670      ! 1. If filename was not specified locally, then use the incomming
4671      !    filename. Make sure name is legal and < 10 chars
4672      ! 2. Check for :MSI. If none specified, then append the
4673      !    local default_msi$. If Ramdisc make sure it exists.
4674      ! 3. Parse filename and create F_path$, F_msi$, Filename$
4675      ! 4. If PROG Filetype then make F_msi$=ram disc
4676      !
4677    IF NOT LEN(Filename$) OR Filename$="," THEN    !use incomming file name.
4678      IF Debug THEN DISP "Using the incomming filename"
4679      Filename$=TRIM$(Rdata$)
4680      Sav_filename$=Filename$
4681      CALL Parse_filename(Filename$,F_msi$,F_path$)
4682      IF NOT LEN(Filename$) THEN Filename$="K_DEFAULT"
4683      IF Filnamcnv THEN Filename$=UPC$(Filename$)
4684    END IF
4685      !
4686      ! Check Filename Length =  10 characters or less
4687      !
4688    WHILE LEN(Filename$)>10
4689      DISP "filename too long - shorten "
4690      OUTPUT KBD;Filename$;"ÿH";
4691      ENTER KBD;Filename$
4692      DISP 
4693    END WHILE
4694     !
4695     !   Check if ramdisc msi and if ramdisc is available. If not
4696     !   Change :MSI to a physical disc.
4697     !
4698    IF Filetype$="PROG" THEN F_msi$=":,0,0"
4699    IF (POS(F_msi$,":,0") OR POS(F_msi$,":MEMORY")) AND (Ramdisc=1) THEN 
4700      Ramfile=1
4701      IF Debug THEN PRINT "using ramdisc"
4702    ELSE
4703      IF POS(F_msi$,":,0") AND (Ramdisc=0) THEN 
4704        BEEP 
4705        DISP "Change MSI - Ramdisc not available"
4706        OUTPUT KBD;F_path$&Filename$&F_msi$;
4707        ENTER KBD;Filename$
4708        CALL Parse_filename(Filename$,F_msi$,F_path$)
4709      END IF
4710    END IF
4711    PRINT TABXY(25,5);" As  ";F_path$&Filename$&F_msi$
4712    RETURN 
4713  !------------------------------------------------------------------------
4714 Create_unique: !    ! Filewarn=1 Don't Purge File - create a unique name
4715    F$=Filename$
4716    Unq_made=0
4717  !
4718  ! Get a catalog of a duplicate filenames upto "_" character
4719  !
4720  !
4721    IF LEN(F$)<9 THEN 
4722      Find$=F$&"_"
4723    ELSE
4724      Find$=F$[1,8]&"_"
4725    END IF
4726    ALLOCATE Cat$(30)[80]
4727    CAT F_msi$ TO Cat$(*);SELECT Find$,COUNT Dupnames,NO HEADER
4728  !---------------------------------------------
4729  ! Find the next unique suffix
4730  ! Find$ = The base filename without sufix
4731  !
4732    IF Dupnames THEN       ! INCR NEXT_UNIQUE UNTIL UNIQUE
4733      Next_unique=47       ! STARTING PLACE IN ASCII TABLE "0"
4734      REPEAT
4735        Next_unique=Next_unique+1
4736        IF (Next_unique>57) AND (Next_unique<65) THEN Next_unique=65
4737        IF (Next_unique>90) AND (Next_unique<97) THEN Next_unique=97
4738        IF Next_unique>126 THEN 
4739          DISP "Can't Create a unique name - all ascii chars used"
4740          PAUSE
4741        END IF
4742      !
4743        Nu_found=1
4744        FOR Df=1 TO Dupnames
4745          IF POS(Cat$(Df),Find$&CHR$(Next_unique)) THEN     ! UNIQUE
4746            Nu_found=0
4747          END IF
4748        NEXT Df
4749      UNTIL Nu_found
4750    ELSE
4751      Next_unique=48    ! IF NO DUPES THEN - DEFAULT TO 48   "_0"
4752    END IF
4753    DEALLOCATE Cat$(*)
4754  !---------------------------------------------
4755    REPEAT                    ! until a unique name is made
4756    !
4757    ! Make sure filename is unique
4758    !
4759      Ftest$=Find$&CHR$(Next_unique)
4760      ASSIGN @Test TO F_path$&Ftest$&F_msi$;RETURN Rc
4761      IF Rc THEN     ! assume filename is unique
4762        Unq_made=1
4763        Next_unique=(Next_unique+1) MOD 10
4764        F$=Ftest$
4765      ELSE
4766        Next_unique=Next_unique+1
4767      END IF
4768    UNTIL Unq_made
4769  !
4770    Filename$=F$
4771    Wmsg$="Changed filename to "&Filename$
4772    PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4773    PRINT TABXY(25,5);" As  ";F_path$&Filename$&F_msi$
4774    RETURN 
4775 !----------------------------------------------
4776 Get_at:  !   Decode File Attribute Packet
4777     !
4778     ! Rdata$ is in form:  ATTRIBUTE(char), LENGTH(unchar), DATA(char)
4779     ! Returns:
4780     !
4781     ! ! or 1    File length (Bytes)     File_length
4782     ! "
4783     ! #         Creation Date           File_date$
4784     ! .         Machine and OS          File_os$
4785     ! /         Format Of Data          File_format$,File_type,File_delim$
4786     !
4787    I=1   ! data pointer
4788    REPEAT
4789      Attrib$=Rdata$[I,I]
4790      Dl=FNUnchar(Rdata$[I+1,I+1])
4791      SELECT Attrib$
4792      CASE "!"  ! Length (Kb)
4793        IF NOT At_filelength THEN 
4794          File_length=VAL(Rdata$[I+2;Dl])
4795          IF Attrib$="!" THEN File_length=(File_length+1)*1000
4796          At_filelength=1
4797        END IF
4798      CASE "1" ! Exact File Length
4799        File_length=VAL(Rdata$[I+2;Dl])
4800        IF Attrib$="!" THEN File_length=(File_length+1)*1000
4801        At_filelength=1
4802      CASE """"       ! Data Type
4803      CASE "#"        ! Creation Date [yy]yymmdd[  hh:mm[ :ss]
4804        File_date$=Rdata$[I+2;Dl]
4805      CASE "."        ! Machine and OS !  H4=hp9000 RMB
4806        File_os$=Rdata$[I+2;Dl]        !  U8=DOS
4807      CASE "/"        ! Format of data
4808        File_format$=Rdata$[I+2;Dl]
4809        SELECT File_format$[1,1]
4810        CASE "A"     ! Var Length Delim Records - HP-UX FORMAT ON
4811          File_delim$=File_format$[2;Dl-1]
4812          File_type=4
4813        CASE "D"     ! Var Len Undelim Records - ASCII File $
4814          File_type=3
4815        CASE "F"     ! Fix Len Undelim Records - BDAT FORMAT OFF
4816          File_type=2
4817        CASE "R"     ! Record Oriented Placement of record
4818        CASE "M"     ! Maximum Rec Length for above record
4819        END SELECT
4820      END SELECT
4821      I=I+Dl+2
4822      IF Debug THEN PRINT "file_attribute ";Attrib$
4823    UNTIL I>LEN(Rdata$)
4824    RETURN 
4825  !-----------------------------------------------------------------------
4826 Kbr_int: !(k receive)
4827    ! Cancels:  ^X (file)  ^Z (Batch) ^E (Protocol) ^C(Quit) <ent> Retry
4828    !
4829   ! To Interrupt File Receive:
4830   !
4831   !  ACK Packet with:   X in data field to abort single file
4832   !                     Z in data field to abort entire batch
4833   !  E   Packet with    Error Msg if Sender doesn't recognize file interruption.
4834   !
4835    User_break=1
4836    K$=KBD$
4837    SELECT K$[1,1]
4838    CASE "",""    ! ?
4839      PRINT TABXY(1,Crt_lines);
4840      PRINT "Cancels:  ^X (file)  ^Z (Batch) ^E (Protocol) ^C(Quit) <Ent> Retry"
4841    CASE "" ! ^X   ! Cancel File
4842      Pktype$="X"
4843      Rdata$="X"    ! discard file
4844      Emsg$="Single File Cancelled by Client"
4845      RETURN 
4846    CASE CHR$(26)  !^Z   ! No Batch Process Yet (wildcard send/rec ?)
4847      Pktype$="X"
4848      Rdata$="Z"
4849      Emsg$="Batch Receive  Cancelled by Client"
4850      RETURN 
4851    CASE ""  ! ^E   ! Goto Error (Abort)  State
4852      State$="E"
4853      Pktype$="E"
4854      Emsg$="File Aborted by Client (E Packet)"
4855      RETURN 
4856    CASE "" ! ^C   ! Quit without Notifying Remote Kermit
4857      State$="X"
4858      Pktype$="X"
4859      Rdata$=""
4860      Emsg$="Transfer Aborted by Client - Host Not Notified"
4861      RETURN 
4862    CASE "ÿ"          ! CTRL-ENTER  resend - no abort
4863      User_break=0
4864      SELECT K$[2,2]
4865      CASE "E"
4866        OUTPUT @Out_buff;Sndpkt$
4867        Retry_count=Retry_count+1
4868        PRINT TABXY(25,11);Retry_count
4869      END SELECT
4870    CASE ELSE
4871      User_break=0
4872    END SELECT
4873    ON KBD,2 GOSUB Kbr_int
4874    RETURN 
4875  !----------------------------------------------------------------------
4876 Rec_err:  !             Error Handling for Kermit Receive
4877    IF Debug THEN DISP ERRM$
4878    SELECT ERRN
4879    CASE 53   ! improper filename - probably a . in the name
4880      Xd=POS(Filename$,".")
4881      IF Xd THEN Filename$[Xd,Xd]="_"
4882      IF LEN(Filename$)>10 THEN Filename$=Filename$[1,10]
4883    CASE 76,52  ! INVALID DRIVE
4884      IF ERRL(Check_ramdisc) THEN 
4885        Init_ramdisc(Kbytes)
4886        IF NOT Kbytes THEN 
4887          DISP "Not enough memory for ramdisc"
4888          WAIT 1
4889          DISP 
4890          ERROR RETURN
4891        ELSE
4892          Ramdisc=1
4893        END IF
4894      ELSE
4895        DISP ERRM$&"  - Change MSI "
4896        OUTPUT KBD;F_msi$;"ÿH";
4897        ENTER KBD;F_msi$
4898        DISP 
4899      END IF
4900    CASE 64       ! Mass Storage Medium Overflow
4901      Emsg$="Err 64: Mass Storage Medium Overflow"
4902      State$="E"
4903      ERROR RETURN
4904    CASE 54       ! Duplicate File Name
4905      IF Filewarn THEN                   ! create a unique filename
4906        GOSUB Create_unique
4907      ELSE       ! filewarn=0   - overwrite file
4908        ASSIGN @File TO *
4909        PURGE Filename$
4910        Wmsg$="Overwriting file "&Filename$
4911      END IF
4912      CLEAR ERROR
4913    CASE 167,168
4914      CALL Com_interrupt         ! Serial Port Erro
4915    CASE 59   ! END OF FILE FOUND  @FILE - Filename$
4916      ASSIGN @File TO *
4917      Spillfile=Spillfile+1
4918      Filename$="SPILLFILE"&VAL$(Spillfile)
4919      F$=F_path$&Filename$&F_msi$
4920      ASSIGN @File TO F$;FORMAT ON,RETURN Rc
4921      IF Rc THEN 
4922        SELECT Filetype$
4923        CASE "ASCII"
4924          CREATE ASCII F$,200        ! 51 Kb
4925          ASSIGN @File TO F$;FORMAT OFF
4926        CASE "HPUX"
4927          CREATE F$,50000
4928          ASSIGN @File TO F$;FORMAT OFF
4929        CASE ELSE
4930          CREATE BDAT F$,200
4931          ASSIGN @File TO F$;FORMAT OFF
4932        END SELECT
4933      END IF
4934      Wmsg$="File Overflow - Spillfile Created"
4935    CASE ELSE
4936      DISP ERRM$&"  Paused in  Rec_err"
4937      PAUSE
4938    END SELECT
4939   !
4940    DISP 
4941    ON ERROR GOSUB Rec_err
4942    PRINT TABXY(25,12);Emsg$&RPT$(" ",55-LEN(Emsg$))
4943    PRINT TABXY(25,13);Wmsg$&RPT$(" ",55-LEN(Wmsg$))
4944    RETURN 
4945  !----------------------------------------------
4946 Rec_intr: !      ! COMM PORT INTERRUPT HANDLER
4947    CALL Com_interrupt
4948    Shutdown
4949    ON INTR Com_port,15 GOSUB Rec_intr
4950    SELECT Com_card
4951    CASE 98628
4952      CONTROL Com_port,13;164      ! MASK  4=UART  32=lost carr 128=break
4953    CASE 98626,98644
4954      ENABLE INTR Com_port;4
4955    END SELECT
4956    ON ERROR GOSUB Rec_err
4957    Startup
4958    RETURN 
4959  !-----------------------------------------------
4960 No_printer:RETURN 
4961 Flush_buff: !
4962    RETURN 
4963  !---------------------------------------------
4964 Rspar:  !  Form Receive Initialization Packet
4965    Packet$=""
4966    Packet$[1]=FNTochar$(Maxp)
4967    Packet$[2]=FNTochar$(Mytmo)
4968    Packet$[3]=FNTochar$(Mypad)
4969    Packet$[4]=FNTochar$(Mypchar)
4970    Packet$[5]=FNTochar$(Myeol)
4971    Packet$[6]=CHR$(Myquote)
4972    Packet$[7]="&"                    ! 8TH BIT PREFIX
4973    Packet$[8]="1"                    ! CHECK TYPE
4974    Packet$[9]=" "                    ! NO REPEAT COUNT PROCESS
4975    IF Rptflag THEN 
4976      Packet$[9,9]=CHR$(Rep_char)
4977    END IF
4978   !
4979    IF Rcap_a THEN 
4980      Capas=IVAL("001000",2)          ! File attributes = (8)
4981      Packet$[10,10]=FNTochar$(Capas)    ! CAPAS MASK
4982    ELSE
4983      Packet$[10,10]=" "
4984    END IF
4985    !
4986    ! Extended Length Packets  (m=desired length - <= 9024)
4987    ! If bit 1 of capas is set:  000010
4988    !
4989    GOTO Skip_rcaplp   ! not implemented
4990    IF Rcap_lp THEN 
4991      Packet$[11,11]=FNTochar$(0)       ! Windo - not used
4992      Packet$[12,12]=FNTochar$(R_maxl1)
4993      Packet$[13,13]=FNTochar$(R_maxl2)
4994    END IF
4995 Skip_rcaplp:   !
4996  !
4997    RETURN 
4998  !================================
4999 Rrpar:  ! Receive Packet Initialization
5000        ! Rdata$[] =DATA STRIPPED FROM INCOMING PACKET
5001    IF Debug THEN DISP "INIT REc len = ";LEN(Rdata$)
5002    FOR S=1 TO LEN(Rdata$)
5003      SELECT S
5004      CASE 1
5005        Rpsiz=FNUnchar(Rdata$[1])       ! remote  packet size
5006      CASE 2
5007        Ptmo=FNUnchar(Rdata$[2])        ! remote packet timeout
5008      CASE 3
5009        Pad=FNUnchar(Rdata$[3])         ! remote    padding
5010      CASE 4
5011        Padchar=FNUnchar(Rdata$[4])     ! padding char to use
5012      CASE 5
5013        Eol=FNUnchar(Rdata$[5])
5014        IF Eol=0 THEN Eol=Myeol         ! eol to use
5015      CASE 6
5016        Quote=NUM(Rdata$[6,6])          ! remote quote char
5017      CASE 7
5018        Qbin=NUM(Rdata$[7,7])
5019        IF Qbin=89 THEN Qbin=38 ! 89=Y , 38=&  ! Y= Yes I do it
5020      CASE 8
5021        R_bchk=NUM(Rdata$[8,8])         ! remote block check type
5022        R_bchk=R_bchk-48                ! 1=49 2=50 3=51
5023        IF R_bchk<1 OR R_bchk>3 THEN 
5024          R_bchk=1
5025        END IF
5026      CASE 9
5027        Rep_char=NUM(Rdata$[9,9])
5028      CASE 10
5029        R_capas=FNUnchar(Rdata$[10,10])
5030        IF BIT(R_capas,1) THEN ! extended length packets
5031          Rcap_lp=1
5032          R_windo=FNUnchar(Rdata$[11,11])
5033          R_maxl1=FNUnchar(Rdata$[12,12])
5034          R_maxl2=FNUnchar(Rdata$[13,13])
5035          R_maxl=R_maxl1*95+R_maxl2
5036        END IF
5037   !
5038        IF BIT(R_capas,3) THEN Rcap_a=1
5039      END SELECT
5040    NEXT S
5041    RETURN 
5042  SUBEND
5043  !======================================================================
5044  SUB Rpack(Pktype$,Rdata$,INTEGER Rseq,Rcvpkt$,Sndpkt$,INTEGER Npak,Retry_count,User_break,Emsg$)
5045 Rpack: !
5046  ! Pktype$    Packet Type  S,A,F,D,Z,B   N,Y
5047  ! Rdata$     Packet Data Area. or User Abort Message
5048  ! Rseq       Incomming Packet Sequence Number
5049  ! Rcvpkt$    Raw Packet Received
5050  ! Sndpkt$    Previous Packet Sent - required for resend on kbd interrupt
5051  ! Npak       Expected packet sequence number
5052  ! Retry_count
5053  ! user_break=1 if user client interrupts file transfer
5054  ! Emsg$      Error Msg created by receive packet, or client interrupt
5055  !
5056    OPTION BASE 1
5057    COM /Crt/ Crt_lines,Crt_width
5058    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
5059    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
5060    COM /Kerm/ INTEGER Maxp,Maxtry,Mypad,Mytmo,Mypchar,Myeol,Myquote
5061    COM /Kerm/ INTEGER Size,Rpsiz,Spsiz,Pad,Capas,Send_at
5062    COM /Kerm/ INTEGER Image,Parflg,Pktdeb
5063    COM /Kerm/ INTEGER Filnamcnv,Blk_chk,Quote,Eol,Smark
5064    COM /Kerm2/ State$,Cchksum$,Eof_mode$,INTEGER Eof_mode,Timer,Ptmo
5065  !
5066    DIM A$[1],K$[256],Rcvchksum$[20],Misc$[80]
5067    INTEGER Chksum,Rc,Plen,Dlen,Cchksum
5068    INTEGER Endl,Chkpos,Chk
5069  !------------------------------------------------------------------------
5070    ON ERROR GOSUB Rp_err
5071    K$="" ! flush packet
5072    ENABLE 
5073    ON KBD,2 GOSUB Kbd_int   ! Kbd Escape
5074 Get_packet: !
5075    IF Timer THEN ON DELAY Ptmo,10 GOTO R_tmo     ! pkt tmo interrupt level 10
5076    Rdata$=""
5077    Rcvpkt$=""
5078   !
5079    REPEAT                       ! Until a Packet Header (mark) is found
5080      IF Com_card=98628 THEN 
5081        STATUS Com_port,5;B_len
5082      ELSE
5083        STATUS @In_buff,4;B_len
5084      END IF
5085      IF B_len THEN ENTER @In_buff USING "#,K";A$
5086      IF LEN(A$) THEN A$=CHR$(BINAND(NUM(A$),127))    ! strip parity
5087    UNTIL A$=CHR$(Smark)
5088    Rcvpkt$[1,1]=A$            ! store packet mark
5089  !
5090  ! MARK FOUND - ENTER THE REST OF THE PACKET
5091  !
5092  ! ## If Comm Interrupt Occurs and buffer is flushed, an end of buffer occurs here
5093  !
5094    I=2
5095    LOOP
5096      ENTER @In_buff USING "#,K";A$
5097      Rcvpkt$[I,I]=A$
5098      IF I=2 THEN 
5099        Plen=FNUnchar(Rcvpkt$[2,2])! Packet Length
5100      END IF
5101      I=I+1
5102    EXIT IF I>Plen+3             ! mark+len+plen+eol = plen+3
5103    END LOOP
5104    OFF DELAY
5105   !
5106   ! Kermit Packet Received ----------------------
5107   !
5108    Beginl=POS(Rcvpkt$,CHR$(Smark))
5109    Rcvpkt$=Rcvpkt$[Beginl]
5110    Endl=POS(Rcvpkt$,"")
5111    IF (Endl=0) THEN Endl=POS(Rcvpkt$,"
")     ! if no CR then use LF
5112    IF NOT Endl THEN 
5113      Endl=LEN(Rcvpkt$)
5114    END IF
5115    Rcvpkt$=Rcvpkt$[Beginl,Endl]
5116  ! Plen=FNUnchar(Rcvpkt$[2,2]) ! Packet Length
5117    Plen=NUM(Rcvpkt$[2,2])-32   ! Packet Length
5118  ! FNUnchar ==> RETURN NUM(C$)-32
5119    Dlen=Plen-3                 ! Data Length
5120    Chkpos=Plen+2               ! Position of checksum char
5121  ! Rseq=FNUnchar(Rcvpkt$[3,3]) ! Rec Sequence Number
5122    Rseq=NUM(Rcvpkt$[3,3])-32   ! Packet Length
5123    Pktype$=Rcvpkt$[4,4]        ! Packet Type
5124   !
5125   ! Check Sequence
5126   ! If Local Kermit was paused, there could be multiple packets
5127   ! buffered with a sequence number < the current Npak.
5128   !
5129   ! Check buffer - if there is a packet, go get it, else ack this packet
5130   ! and force the next packet to be sent.
5131   !
5132    IF (Rseq<Npak MOD 64) THEN   ! loop back and receive next packet
5133   !
5134   !  PRINT TABXY(1,Crt_lines);"Rseq<Npak:  Loop to get another packet "
5135      IF Com_card=98628 THEN 
5136        STATUS Com_port,5;B_len
5137      ELSE
5138        STATUS @In_buff,4;B_len
5139      END IF
5140   !
5141      IF B_len THEN 
5142        GOTO Get_packet
5143      ELSE
5144   !    PRINT TABXY(1,Crt_lines);"Acking packet=Rseq (rseq<npak) to force next packet: rseq=npak"
5145        Spack("","Y",Rseq,Sndpkt$)    ! ack current (Rseq) packet
5146        OUTPUT @Out_buff;Sndpkt$
5147        GOTO Get_packet               ! Go get expected (Npak) packet
5148      END IF
5149    END IF
5150  !
5151    PRINT TABXY(1,Crt_lines);RPT$(" ",80)
5152    IF Rseq>Npak THEN   ! exit rpack with a "Q" pktype$
5153      Pktype$="Q"
5154      PRINT TABXY(1,Crt_lines);"Packet out of sequence - ahead of expected packet ";Rseq,Npak,"subexit"
5155      SUBEXIT
5156    END IF
5157   !-------------------------------------------------------------------
5158   ! A good packet in the required sequence has been received
5159   ! Flush the input buffer
5160   !
5161    IF Com_card=98628 THEN 
5162      STATUS Com_port,5;B_len
5163      WHILE B_len
5164        ENTER @In_buff;Misc$
5165        STATUS Com_port,5;B_len
5166      END WHILE
5167    ELSE
5168      STATUS @In_buff,3;Fp
5169   !  CONTROL @In_buff,5;Fp   ! Set empty pointer to fill pointer
5170    END IF
5171   !
5172   ! Extract Data from Packet into Rdata$
5173   !
5174    IF Dlen THEN                   ! If Packet Has Data
5175      ON ERROR GOTO Nodl
5176      Rdata$[1,Dlen]=Rcvpkt$[5,Plen+1]
5177      GOTO Dldone
5178 Nodl:OFF ERROR 
5179      FOR I=1 TO Dlen
5180        Rdata$[I,I]=Rcvpkt$[4+I]
5181      NEXT I
5182    END IF
5183 Dldone:OFF ERROR 
5184    !
5185    ! Check for Good Packet Checksum
5186    !
5187    Chk=0
5188    FOR I=2 TO Plen+1
5189      Chk=Chk+NUM(Rcvpkt$[I,I])
5190    NEXT I
5191    Cchksum=BINAND(Chk+(BINAND(Chk,192)/64),63)   ! Computed Checksum
5192    Cchksum$=FNTochar$(Cchksum)
5193    Rcvchksum$=Rcvpkt$[Chkpos;1]
5194    IF Rcvchksum$<>Cchksum$ THEN Pktype$="Q"
5195    SUBEXIT
5196  !---------------------------------
5197 R_tmo: !
5198    BEEP 2000,.01
5199    OFF DELAY
5200    OFF TIMEOUT 
5201    Pktype$="T"
5202    DISP 
5203    SUBEXIT
5204  !---------------------------------
5205 Kbd_int: !(rpack)
5206    ! Cancels:  ^X (file)  ^Z (Batch) ^E (Err Quit) ^C(Quit) <ent> Retry
5207   !
5208   ! To Interrupt File Receive:
5209   !
5210   !  ACK Packet with:   X in data field to abort single file
5211   !                     Z in data field to abort entire batch
5212   !  E   Packet with    Error Msg if Sender doesn't recognize file interruption.
5213   !
5214    BEEP 300,.02
5215    User_break=1
5216    K$=KBD$
5217    SELECT K$[1,1]
5218    CASE "",""    ! ^?
5219      PRINT TABXY(1,Crt_lines);
5220      PRINT "Cancels:  ^X (file)  ^Z (Batch) ^E (Protocol) ^C(Quit) <Ent> Retry"
5221    CASE "" ! ^X   ! Cancel File
5222      Pktype$="X"
5223      Rdata$="X"    ! discard file
5224      Emsg$="Single File Cancelled by Client"
5225      SUBEXIT
5226    CASE CHR$(26)  ! ^Z   ! No Batch Process Yet (wildcard send/rec ?)
5227      Pktype$="X"
5228      Rdata$="Z"
5229      Emsg$="Batch Receive  Cancelled by Client"
5230      SUBEXIT
5231    CASE ""  ! ^E   ! Goto Error (Abort)  State
5232      State$="E"
5233      Pktype$="E"
5234      Emsg$="File Aborted by Client (E Packet)"
5235      SUBEXIT
5236    CASE "" ! ^C   ! Quit without Notifying Remote Kermit
5237      State$="X"
5238      Pktype$="X"
5239      Rdata$="^C"   ! Notify sendz not to notify host
5240      Emsg$="Transfer Aborted by Client - Host Not Notified"
5241      SUBEXIT
5242    CASE "ÿ"          ! CTRL-ENTER  resend - no abort
5243      User_break=0
5244      SELECT K$[2,2]
5245      CASE "E"
5246        OUTPUT @Out_buff;Sndpkt$
5247      ! Retry_count=Retry_count+1   ! gets incr if SUBEXIT is used
5248        PRINT TABXY(25,11);Retry_count
5249        SUBEXIT
5250      CASE ELSE
5251      END SELECT
5252    CASE ELSE
5253      User_break=0
5254    END SELECT
5255    RETURN 
5256  !--------------------------------------
5257 Rp_err: !
5258    SELECT ERRN
5259    CASE 59    ! end of buffer found
5260      Pktype$="T"
5261      SUBEXIT
5262    CASE 33    ! Null Char in Packet$
5263      Emsg$="Short Packet"
5264      Pktype$="Q"
5265      SUBEXIT
5266    CASE ELSE
5267      DISP ERRM$
5268      Pktype$="Q"  ! Checksum error
5269      SUBEXIT      ! any error abort packet
5270    END SELECT
5271    RETURN 
5272  !------------------------------------------
5273  SUBEND
5274  !=======================================================================
5275 Init_ramdisc:SUB Init_ramdisc(Kbytes,OPTIONAL Clear$,Sectors)
5276  !
5277  ! This routine cannot check for existance of a RAM Disc before
5278  ! initializing because of nested ON ERROR conflicts. If this routine
5279  ! is called from an ON ERROR routine,then an error in this routine
5280  ! cannot be trapped.
5281  !
5282! Initialize Ram Disc
5283!
5284    DIM Sav_msi$[256]
5285    Cat_msi$=":,0,0"
5286    INTEGER Sector(1:128)
5287    Sav_msi$=SYSTEM$("MSI")
5288    INITIALIZE ":,0,0",0                 ! destroy any existing ram disc
5289    DISP "Creating RAM Volume - please wait"
5290    Avm=VAL(SYSTEM$("AVAILABLE MEMORY"))
5291    Bytes=Avm-100000                      ! SAVE 100 KB
5292    Kbytes=Bytes/1000
5293    Kbytes=MAX(Kbytes,0)
5294    Kbytes=MIN(Kbytes,3000)               ! 3 Mb Max
5295    IF Kbytes>0 THEN 
5296      Size=INT(Kbytes*4)                       ! 4 sectors PER kB
5297      INITIALIZE ":,0,0",Size
5298 !------------------------------------------
5299      IF NPAR>1 THEN 
5300        IF Clear$="CLEAR" THEN 
5301          MASS STORAGE IS ":,0,0"
5302          Get_volinfo(Dir_st,Dir_len,Vol_lbl$)
5303          Cl_sect=Size
5304          IF NPAR>2 THEN Cl_sect=MIN(Sectors,500)
5305          DISP "Clearing";Cl_sect;" Disc Sectors"
5306          FOR Sect=Dir_st+Dir_len-1 TO Cl_sect
5307            Phywrite(Sect,Sector(*))
5308          NEXT Sect
5309        END IF
5310      END IF
5311    END IF
5312    MASS STORAGE IS Sav_msi$
5313    DISP 
5314  SUBEND
5315  !-----------------------------------------------------------------------
5316 Shutdown:SUB Shutdown(OPTIONAL INTEGER Transfer_on)       ! Shutdown Serial Transfers
5317  !
5318    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
5319    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
5320  !
5321    IF Com_card=98628 THEN SUBEXIT
5322  !
5323    STATUS Com_port,10;Uart    !       clear frame errors
5324  !
5325  ! Check if transfer is running
5326  !
5327    STATUS @Out_buff,0;O_stat     ! IS PATH VALID ?
5328    IF O_stat<3 THEN 
5329      IF NPAR THEN Transfer_on=0
5330      SUBEXIT
5331    END IF
5332  !
5333    STATUS @Out_buff,11;O_stat
5334    IF BIT(O_stat,6) THEN 
5335      IF NPAR THEN Transfer_on=1
5336      CONTROL @Out_buff,9;0     ! non-continuous
5337      WAIT FOR EOT @Com_out     ! normal transfer shutoff
5338    END IF
5339  !
5340    STATUS @In_buff,10;I_stat
5341    IF BIT(I_stat,6) THEN 
5342      CONTROL @In_buff,8;0      ! non-continuous
5343      ABORTIO @Com_in           ! shutoff
5344    END IF
5345    STATUS Com_port,10;Uart    ! clear any frame errors
5346  SUBEND
5347  !-----------------------------------------------------------------------
5348  SUB Startup
5349 Startup: !    Shuts Down Transfers if Active
5350          !    Perform ASSIGN for Transfer Buffer and COM Port
5351  !
5352  !
5353    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
5354    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
5355    COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
5356    COM /Frame/ Flow$,Hshake$
5357  !
5358    ON ERROR GOSUB Startup_err
5359    ON TIMEOUT Com_port,.5 GOSUB Startup_err
5360  !
5361  ! CHECK IF TRANSFERS RUNNING
5362  !
5363 Retry_xfer: !
5364    STATUS @In_buff,0;Valid_path
5365    IF Valid_path=3 THEN  ! buffer
5366      STATUS @In_buff,10;I_stat
5367      IF BIT(I_stat,6) THEN 
5368        CALL Shutdown
5369      END IF
5370    END IF
5371  !
5372  !
5373    IF Com_card=98628 THEN 
5374      IF On_off$="OFF" THEN 
5375        ASSIGN @Out_buff TO Com_port;PARITY OFF
5376        ASSIGN @In_buff TO Com_port;PARITY OFF
5377      ELSE
5378        ASSIGN @Out_buff TO Com_port
5379        ASSIGN @In_buff TO Com_port
5380      END IF
5381      SUBEXIT
5382    ELSE
5383      STATUS Com_port,10;Dummy          ! CLEAR ERRORS
5384      IF On_off$="OFF" THEN 
5385        ASSIGN @Com_in TO Com_port;PARITY OFF
5386        ASSIGN @Com_out TO Com_port;PARITY OFF
5387      ELSE
5388        ASSIGN @Com_out TO Com_port
5389        ASSIGN @Com_in TO Com_port
5390      END IF
5391      ASSIGN @In_buff TO BUFFER Input_buffer$
5392      ASSIGN @Out_buff TO BUFFER Output_buffer$
5393    END IF
5394    !
5395    ! START OUTBOUND TRANSFER FIRST
5396    !
5397    OFF ERROR 
5398    STATUS Com_port,10;Uart    ! clear errors - prevent error 167
5399    TRANSFER @Out_buff TO @Com_out;CONT
5400    REPEAT
5401      STATUS @Out_buff,11;Out_status
5402    UNTIL BIT(Out_status,6)=1
5403    !
5404    OUTPUT @Out_buff;" ";    ! kickstart transfer
5405    !
5406    ! Inbound may receive buffer overrun error 167 - io status error
5407    ! due to an abortive interrupt (ie buff overrun) in the interface.
5408    ! An abortive interrupt will shut off a transfer.
5409    !
5410    STATUS Com_port,10;Uart    ! clear errors - prevent error 167
5411    TRANSFER @Com_in TO @In_buff;CONT
5412    REPEAT
5413      STATUS @In_buff,10;Inb_status
5414    UNTIL BIT(Inb_status,6)=1
5415  !
5416  ! CHECK FOR ANY TRANSFER ERROR
5417  !
5418    STATUS @In_buff,10;I_stat
5419    STATUS @Out_buff,11;O_stat
5420  !
5421    IF (BIT(I_stat,4)) OR (BIT(O_sta,4)) THEN 
5422      GOTO Retry_xfer
5423    END IF
5424    SUBEXIT
5425  !=-------------------------------
5426 Startup_err: !
5427    SELECT ERRN
5428    CASE 167,168,0            ! IO Status Error
5429      CALL Com_interrupt
5430      STATUS Com_port,10;Uart  ! clear errors - prevent error 167
5431   !  DISP "UART: ";Uart,"startup"
5432      ON ERROR GOSUB Startup_err
5433      ON TIMEOUT Com_port,.5 GOSUB Startup_err
5434    CASE ELSE
5435      BEEP 
5436      DISP ERRM$
5437      PAUSE
5438    END SELECT
5439    RETURN 
5440  SUBEND
5441  !-----------------------------------------------------------------------
5442  SUB Reset_port
5443 Reset_port: !
5444  !
5445    COM /Port/ @Out_buff,@Com_out,Output_buffer$ BUFFER
5446    COM /Port/ Com_port,@In_buff,@Com_in,Input_buffer$ BUFFER,Com_card
5447    COM /Frame/ Baud,Data_bits,Stop_bits,On_off$,Parity_type$
5448    COM /Frame/ Flow$,Hshake$
5449  !
5450    SELECT Com_card
5451    CASE 98626
5452      STATUS Com_port,10;Uart         ! clear any frame errors
5453      CONTROL Com_port,0;1       ! RESET PORT - DISCONNECT MODEM
5454      CONTROL Com_port,5;1+2          ! force dtr,rts active
5455      CONTROL Com_port,12;128+32+16   ! Disable modem handshake
5456    CASE 98628
5457      CONTROL Com_port,0;1  ! Reset and read config switches
5458      CONTROL Com_port,3;1  ! async protocol after next reset
5459 ! control Com_port,5;0     ! terminate trans and turnaround if half-duplex
5460 ! control Com_port,6;1     ! BREAK
5461      CONTROL Com_port,8;1+2! RTS  DTR  Set Active
5462 ! CONTROL Com_port,12;2    ! 2 = start autodial  1=connect (dtr,rts)
5463      CONTROL Com_port,13;164     ! INT MASK  4=UART  32=lost car 128=break
5464      CONTROL Com_port,14;0 ! Control Blocks Disabled  (queued with data)
5465      CONTROL Com_port,15;0 ! MODEM INT MASK
5466 ! CONTROL Com_port,16;25   ! Connect Timeout (reset=25 sec)
5467 ! CONTROL Com_port,17;10   ! No activity Timeout (reset=10 min )
5468 ! CONTROL Com_port,18;40   ! Lost Carrier Timeout 10xMS (reset=40)
5469 ! CONTROL Com_port,19;10   ! CTS (send)   Timeout (reset=10 sec)
5470 !    CONTROL Com_port,20;9 ! BAUD RATE  9=1200 11=2400 14=9600
5471 !    CONTROL Com_port,21;9 ! REC  RATE  9=1200 11=2400 14=9600
5472 !
5473      SELECT Flow$
5474      CASE "NONE"              ! Protocol (SW) Handshake
5475        CONTROL Com_port,22;0  ! 0:none 1:enq-host 2:enq-term
5476      CASE "XON/XOFF"          ! 3-5: xon/off host/term/both
5477        CONTROL Com_port,22;5
5478      CASE "ENQ/ACK"
5479        CONTROL Com_port,22;2
5480      CASE ELSE
5481        CONTROL Com_port,22;0
5482      END SELECT
5483  !
5484      IF Hshake$="ON" THEN 
5485        CONTROL Com_port,23;3! HDWR HNDSHK:  0=off/non-modem 1:full
5486      ELSE                  !               2=hlf dup mod 3=CTS/DCD
5487        CONTROL Com_port,23;0
5488      END IF
5489      CONTROL Com_port,24;127! Control Char Mask: pass null,eol,proto,del,rub
5490                            ! change uart err to underscore (127-pass all)
5491      CONTROL Com_port,26;17! First Protocol Hndshk  6=ack  (17=dc1/XON)
5492      CONTROL Com_port,27;19! First Protocol Hndshk  5=enq  (19=dc3/XOFF)
5493      CONTROL Com_port,28;1 ! length of inbound EOL  (reset=2)
5494      CONTROL Com_port,29;13! first EOL (13=Cr)
5495      CONTROL Com_port,30;10! second EOL (10=Lf)
5496 ! CONTROL Com_port,31;1    ! prompt$ length (1)
5497 ! CONTROL Com_port,32;17   ! first prompt$ char (17=dc1)
5498 ! CONTROL Com_port,33;0    ! second prompt$ char (0=null)
5499  !
5500  !   CONTROL Com_port,34;3 ! frame length (databits=card dip switch)
5501                            ! 2=7  3=8 (parity must be none,even,odd)
5502  !   CONTROL Com_port,35;0 ! Stop Bits: (0=1) 1=1.5  2=2
5503  !   CONTROL Com_port,36;0 ! Parity 0=none  1=odd 2=even 3="0" 4="1"
5504      CONTROL Com_port,37;0 ! Inter-char time gap (0=none)  <255 char times
5505      CONTROL Com_port,39;4 ! Set BREAK char time (4)  2-255
5506      CALL Set_frame(Baud)
5507    END SELECT
5508  !-------------------------
5509  SUBEND
5510  !========================================================================
5511  SUB Parse_filename(F$,F_msi$,F_path$)
5512 Parse_filename: !
5513  ! F$ is consumed and filename is returned in its place
5514  !
5515    DIM Misc$[256]
5516    INTEGER Sl_pos
5517  !
5518    IF LEN(F_msi$) THEN 
5519      IF NOT POS(F$,":") THEN F$=F$&F_msi$
5520    END IF
5521  !
5522    Filename$=""
5523    F_msi$=""
5524  ! F_path$=""     ! corrupts f_path$ if not passed in F$
5525  !
5526  ! If MSI exists strip it off of F$
5527  !
5528    IF POS(F$,":") THEN              ! MSI SPECIFIED
5529      F_msi$=F$[POS(F$,":")]
5530      F$=F$[1,POS(F$,":")-1]         ! Strip MSI
5531    END IF
5532  !
5533  !  Strip PATH from F$,     keep last slash on pathname
5534  !
5535    IF POS(F$,"/") THEN 
5536      Misc$=REV$(F$)
5537      Sl_pos=POS(Misc$,"/")          ! SLASH POSITION
5538      F$=REV$(Misc$[1,Sl_pos-1])
5539      F_path$=REV$(Misc$[Sl_pos])
5540    END IF
5541  SUBEND
5542 !=========================================================================
5543  SUB Get_volinfo(Dir_st,Dir_len,Vol_lbl$)
5544 Gvi: !
5545 ! Returns the starting sector of the volume directory, its length
5546 !
5547    INTEGER I,Msb,Lsb,X
5548    Dir_st=0
5549    Dir_len=0
5550    Vol_lbl$=""
5551    COM /Sctr/ INTEGER Sctr(0:127)
5552    Phyread(0,Sctr(*))                   ! read LIF Volume Header
5553    Dir_st=(Sctr(4)*2^16)+Sctr(5)
5554    Dir_len=(Sctr(8)*2^16)+Sctr(9)
5555  ! DISP "DIR START: ";Dir_st,"DIR LENGTH :  ";Dir_len
5556    FOR I=1 TO 3
5557      Temp=Sctr(I)
5558      IF Sctr(I)<0 THEN Temp=Sctr(I)+65536
5559      Msb=Temp DIV 256
5560      Lsb=Temp MOD 256
5561      Vol_lbl$=Vol_lbl$&CHR$(Msb)&CHR$(Lsb)
5562    NEXT I
5563 Done:!
5564  SUBEND
5565 !-------------------------------------------------------------------------
5566  SUB Get_fileinfo(Filename$,REAL Fs,Fl,Dir_entry_sec,Dir_entry,OPTIONAL INTEGER T,V,P,R)
5567 Gfi: !
5568  ! Pass-in Parameters:
5569  ! Filename$            File Name Only - no msi
5570  !
5571  ! Return Parameters
5572  !
5573  ! Fs              Start Sector of File
5574  ! Fl              Number of sectors in file
5575  ! Dir_entry_sec   Directory Sector Containing File Entry
5576  ! Dir_entry       Dir Entry Number in that Sector (0-7 per sector)
5577  ! T               File Type Number
5578  ! V               Volume number
5579  ! P,R             Protection Numbers
5580  !----------------------------------------------
5581    INTEGER I,Fword,Msb,Lsb,X
5582    COM /Sctr/ INTEGER Sctr(0:127)
5583    DIM Entryname$[10],Vol_lbl$[6]
5584    Get_volinfo(Ds,Dl,Lbl$)          ! Get  Dir Start, Dir Length, Vol Label
5585    !
5586    IF POS(Filename$,":") THEN CALL Parse_filename(Filename$,F_msi$,F_path$)
5587    FOR Sector=Ds TO Ds+Dl-1         ! Search Directory for File Match
5588      Phyread(Sector,Sctr(*))
5589      FOR Entry=0 TO 7               ! 8 File entries per sector
5590        Entryname$=""
5591        Fword=Entry*16
5592        IF Sctr(Fword+5)=-1 THEN 
5593          Next_open_entry=Entry     ! Gives Next open Dir entry
5594          Next_open_sec=Sector
5595          GOTO Done_find
5596        END IF
5597        IF Sctr(Fword+5)=0 THEN Nexte         !  0 = null entry
5598        FOR I=0 TO 4                 ! 5 words = 10 Char Name
5599          Word_2char(Sctr(Fword+I),Msb,Lsb)
5600          Entryname$=Entryname$&CHR$(Msb)&CHR$(Lsb)
5601        NEXT I
5602        IF TRIM$(Entryname$)=TRIM$(Filename$) THEN 
5603          Dir_entry_sec=Sector                       ! dir entry position
5604          Dir_entry=Entry
5605      !   PRINT Dir_entry_sec,Dir_entry,Fword,Filename$
5606          GOTO Found_it
5607        END IF
5608 Nexte:NEXT Entry
5609    NEXT Sector
5610 Done_find:S=-1
5611    GOTO Done
5612    !
5613 Found_it:  !
5614  ! PRINT USING "8(K,X),/";Sctr(*)
5615    Fs=(Sctr(Fword+6)*2^16)+Sctr(Fword+7)    ! S=Start sector of file
5616    Fl=(Sctr(Fword+8)*2^16)+Sctr(Fword+9)    ! L=Number of sectors
5617 !
5618    IF NPAR>5 THEN T=Sctr(Fword+5)  ! File Type
5619    IF NPAR>8 THEN V=Sctr(Fword+13) ! Volume Number
5620    IF NPAR>9 THEN P=Sctr(Fword+14) ! Protect Code for file
5621    IF NPAR>10 THEN R=Sctr(Fword+15)!
5622 Done:!
5623  SUBEND
5624  !------------------------------------------------------------------------
5625  SUB Word_2char(INTEGER N,Msb,Lsb)
5626  !
5627  ! Extracts 2 Character Bytes from an integer (word)
5628  ! Returns the characters as Msb and Lsb integers
5629  !
5630  !
5631    Temp=N
5632    IF N<0 THEN Temp=N+65536
5633    Msb=Temp DIV 256
5634    Lsb=Temp MOD 256
5635  SUBEND
5636  !----------------------------------------------------------------------
5637 Convert:SUB Convert(Sf$,Type$,INTEGER Rc,OPTIONAL Flen,Df$)
5638  !
5639  ! Sf$:  complete filespec for source file to change
5640  ! Df$:  Filespec or destination msi$ for converted file
5641  ! Convert Sf$ to the Type$ specified and copy result to D_msi$
5642  !
5643    COM /Crt/ Crt_lines,Crt_width
5644    Debug=1
5645    ON ERROR GOSUB Cnvt_err
5646    REAL S,L,Dir_entry_sec
5647    INTEGER T,V,R,P,Asector(0:127)
5648    DIM Filename$[80],Sav_msi$[256],S_msi$[256]
5649  !
5650    Sav_msi$=SYSTEM$("MSI")
5651    Parse_filename(Sf$,S_msi$,S_path$)
5652    Filename$=S_path$&Sf$&S_msi$
5653    IF FNHfs_disc(S_msi$) THEN          ! HFS - must copy to ramdisc
5654      S_path$=""
5655      IF S_msi$=":,0,0" THEN 
5656        ! file already on ramdisc
5657      ELSE
5658        Init_ramdisc(Kbytes)
5659        S_msi$=":,0,0"
5660        DISP "Copying ";Filename$;" TO ";Sf$&S_msi$
5661        COPY Filename$ TO Sf$&S_msi$
5662      END IF
5663    END IF
5664  !
5665    Filename$=S_path$&Sf$&S_msi$
5666    MASS STORAGE IS S_msi$
5667    Pcode=32*256+32          ! protect code for non-ascii files
5668    Get_fileinfo(Sf$,S,L,Dir_entry_sec,Dir_entry,T,V,P,R)
5669    IF Dir_entry_sec=0 THEN 
5670      DISP "Cant find ";Sf$;"  In Disc Directory "
5671      SUBEXIT
5672    END IF
5673  !
5674    Phyread(Dir_entry_sec,Asector(*))
5675    Fword=Dir_entry*16
5676    Cur_type=Asector(Fword+5)          ! File Type
5677   !
5678    SELECT Cur_type
5679    CASE 1
5680      Cur_type$="ASCII"
5681    CASE -5791
5682      Cur_type$="BDAT"
5683    CASE -5808
5684      Cur_type$="PROG"
5685    CASE -5813
5686      Cur_type$="HP-UX"
5687    CASE -5775
5688      Cur_type$="BIN"
5689    CASE -5822
5690      Cur_type$="SYSTM"
5691    CASE ELSE       ! Pascal ?
5692      Cur_type$="FOREIGN"
5693    END SELECT
5694  ! DISP "Current file type is ";Cur_type$
5695    New_type$=Type$
5696 Get_type_num: !
5697    SELECT New_type$
5698    CASE "ASCII"
5699      New_type=1
5700    CASE "BDAT"
5701      New_type=-5791
5702    CASE "PROG"
5703      New_type=-5808
5704    CASE "HP-UX","HPUX"
5705      New_type=-5813
5706    CASE "BIN"
5707      New_type=-5775
5708    CASE "SYSTM","SYSTEM"
5709      New_type=-5822
5710    CASE ELSE
5711      New_type=VAL(New_type$)
5712      DISP "Change Type to ";New_type
5713      OUTPUT KBD;"Y";"ÿH";
5714      ENTER KBD;Ans$
5715      IF UPC$(Ans$[1,1])="Y" THEN 
5716      ELSE
5717        SUBEXIT
5718      END IF
5719    END SELECT
5720   !
5721    DISP "Changing File Type to ";New_type$,New_type
5722    WAIT .5
5723    Asector(Fword+5)=New_type
5724  !
5725    IF New_type$<>"ASCII" THEN Asector(Fword+14)=Pcode
5726    IF New_type$="BDAT" THEN Asector(Fword+15)=128   ! 128=256 Bytes per rec
5727    IF New_type$="PROG" THEN 
5728      GOTO Skip_adj_prog
5729   !
5730   ! Make sure EOF is on a sector boundary (256 byte)
5731   ! Therefore the low-byte should always be 00x
5732   !
5733      Hibyte=Asector(Fword+6)
5734      Lobyte=Asector(Fword+7)
5735      IF Lobyte>0 THEN 
5736        DISP "Adjusting EOF to a sector boundary"
5737        PAUSE
5738        Asector(Fword+6)=Hibyte+1
5739        Asector(Fword+7)=0
5740      END IF
5741 Skip_adj_prog:   !
5742   !
5743   ! Set Record size to 0080x for PROG Files
5744   !
5745      Asector(Fword+15)=128                               ! x0080
5746    END IF
5747 !
5748    IF NPAR>3 THEN   ! File-length Flen was specified
5749      IF New_type$="PROG" THEN 
5750        Asector(Fword+8)=INT(Flen/256)
5751        Asector(Fword+9)=Flen MOD 256
5752      END IF
5753    END IF
5754    Phywrite(Dir_entry_sec,Asector(*))
5755    Rc=1
5756  !
5757    IF New_type$="HP-UX" THEN      ! Reset EOF pointer
5758      ASSIGN @T TO Filename$
5759      STATUS @T,3;Defr
5760      CONTROL @T,7;Defr
5761    END IF
5762  !
5763    IF Napr>4 THEN 
5764      Df$=D_msi$
5765      Parse_filename(Df$,D_msi$,D_path$)
5766      IF NOT LEN(Df$) THEN Df$=Sf$
5767      COPY Filename$ TO D_path$&Df$&D_msi$
5768    END IF
5769    MASS STORAGE IS Sav_msi$
5770    DISP 
5771    SUBEXIT  !-------------------------------------------------------------
5772 Cnvt_err: !
5773    DISP ERRM$
5774    SELECT ERRN
5775    CASE 54          ! duplicate filename
5776      DISP "Purging: ";Sf$&S_msi$
5777      PURGE Sf$&S_msi$
5778      WAIT 1
5779      DISP 
5780    CASE ELSE
5781      DISP ERRM$;"  in Convert"
5782    END SELECT
5783    RETURN 
5784  SUBEND
5785  !========================================================================
5786  DEF FNHfs_disc(Msi$)
5787    ALLOCATE Cat$(0:3)[80] ! 0:MSI  1:LABEL  2:FORMAT  3:SPACE
5788    IF NOT LEN(Msi$) THEN Msi$=SYSTEM$("MSI")
5789    CAT Msi$ TO Cat$(*)
5790    IF POS(Cat$(2),"HFS") THEN 
5791      RETURN 1
5792    ELSE
5793      RETURN 0
5794    END IF
5795  FNEND
5796  !------------------------------------------------------------------------
5797 Disc_space:SUB Disc_space(Msi$,Total,Largest_hole,Hole_sum,Format$)
5798  !
5799  ! Format$  HFS,LIF
5800  ! All amounts in Sectors
5801  !
5802    INTEGER Recsz,Num_files,Cat_size
5803    REAL Flen
5804  !
5805    Cat_size=150
5806    ALLOCATE Cat$(1:Cat_size)[80] ! 1:MSI  2:LABEL  3:FORMAT  4:SPACE
5807    ON ERROR GOSUB Space_err
5808    CAT Msi$ TO Cat$(*);COUNT Num_files ! 7 LINE HEADER
5809    REDIM Cat$(1:Num_files)
5810    Num_files=Num_files-7
5811    ENTER Cat$(4);Total                          ! SECTORS
5812    Format$=TRIM$(Cat$(3)[POS(Cat$(3),":")+1])
5813    Hole_sum=0
5814    Hole=0
5815    Largest_hole=0
5816  !
5817    DEALLOCATE Cat$(*)
5818    IF Num_files>=Cat_size THEN GOSUB Get_count
5819    IF Num_files=0 THEN 
5820      Largest_hole=Total
5821      SUBEXIT
5822    END IF
5823    IF NOT POS(Format$,"HFS") THEN 
5824      ALLOCATE Cat$(1:Num_files)[80]
5825      CAT Msi$ TO Cat$(*);NO HEADER,EXTEND
5826      FOR I=1 TO Num_files-1
5827        Start_sec=VAL(Cat$(I)[40,47])
5828        Flen=VAL(Cat$(I)[20,28])
5829        Recsz=VAL(Cat$(I)[33,39])
5830        IF Recsz=1 THEN Flen=Flen/256
5831        Next_sec=VAL(Cat$(I+1)[40,47])
5832        Del_sec=Next_sec-Start_sec
5833        Hole=Del_sec-Flen
5834        Hole_sum=Hole_sum+Hole
5835        IF Hole>Largest_hole THEN 
5836          Largest_hole=Hole
5837        END IF
5838      NEXT I
5839      Last_contig=Total-Hole_sum
5840      IF Last_contig>Largest_hole THEN Largest_hole=Last_contig
5841    ELSE
5842      Largest_hole=Total
5843    END IF
5844    SUBEXIT !---------------------------------------------------
5845 Get_count:   !
5846    Num_try=100
5847    REPEAT
5848      Num_try=Num_try+25
5849      ALLOCATE Cat$(1:Num_try)[80]
5850      CAT Msi$ TO Cat$(*);NAMES,COUNT Num_files,NO HEADER   ! HEADER NOT INC
5851      DEALLOCATE Cat$(*)
5852    UNTIL Num_files<Num_try
5853    RETURN 
5854   !---------------------------
5855 Space_err: !
5856    SELECT ERRN
5857    CASE 76      ! INCORRECT UNIT CODE
5858      SUBEXIT
5859    CASE ELSE
5860      DISP ERRM$
5861      PAUSE
5862    END SELECT
5863    RETURN 
5864  SUBEND
5865  !------------------------------------------------------------------------
5866  SUB Get_cat_entry(F$,F_msi$,F_path$,Filename$,File_found,Cat_entry$)
5867 Get_cat_entry: !
5868    ON ERROR GOSUB Gce_err
5869    ALLOCATE Cat$(1:50)[80],Misc$[256]
5870    File_found=0
5871    REPEAT
5872      DISP "Checking File Access"
5873    !
5874    ! Warning, CAT;SELECT may  find more than one file
5875    !
5876      CAT F_path$&F_msi$ TO Cat$(*);SELECT F$,COUNT Num_files        !FILE IS ELMENT 8
5877      FOR I=8 TO Num_files
5878        IF POS(Cat$(I),F$) THEN 
5879          Cat_entry$=Cat$(I)
5880          Misc$=TRIM$(Cat_entry$[1,21])
5881          IF Misc$=F$ THEN 
5882            File_found=1
5883            I=Num_files
5884          END IF
5885        END IF
5886      NEXT I
5887      IF NOT File_found THEN 
5888        GOSUB Get_filename
5889      END IF
5890    UNTIL File_found>0
5891    DISP 
5892    SUBEXIT
5893 Get_filename:!
5894    DISP "File not found in catalog - please check name &  path, (blank to abort) "
5895    OUTPUT KBD;F_path$&F$&F_msi$;"ÿH";
5896    ENTER KBD;Filename$
5897    IF NOT LEN(TRIM$(Filename$)) THEN SUBEXIT
5898    F$=Filename$
5899    Parse_filename(F$,F_msi$,F_path$)
5900    Filename$=F_path$&F$&F_msi$
5901    RETURN 
5902 !--------------------------------------
5903 Gce_err: !
5904    SELECT ERRN
5905    CASE 53    ! improper file name
5906      GOSUB Get_filename
5907    CASE ELSE
5908    END SELECT
5909    File_found=0
5910    RETURN 
5911  SUBEND
5912  !-----------------------------------------------------------------------
5913 Prompt:SUB Prompt(Prompt$,Init$,Ans$,Flag)
5914    DISP Prompt$
5915    OUTPUT KBD;Init$;"ÿH";
5916    ENTER KBD;Ans$
5917    DISP 
5918    Ans$=TRIM$(UPC$(Ans$))
5919    A_len=LEN(Ans$)
5920    IF NOT A_len THEN Flag=0
5921    IF A_len=1 AND Ans$="N" THEN Flag=0
5922    IF A_len=1 AND Ans$="Y" THEN Flag=1
5923    IF POS(Ans$,"YES") THEN Flag=1
5924    IF POS(Ans$,"NO") THEN Flag=0
5925  SUBEND
5926  !------------------------------------------------------------------------
5927 More:SUB More(Filename$,Pdev,Cmds$)
5928   !
5929    OPTION BASE 1
5930    DIM Line$[256],Misc$[256],K$[256]
5931    INTEGER Pline,Paging,Rc,File_type,Crt_lines,Print_abort
5932 !-------------------------------------------------------
5933    Sav_prt$=SYSTEM$("PRINTER IS")
5934    PRINTER IS CRT
5935    REPEAT
5936      ASSIGN @File TO Filename$;FORMAT ON,RETURN Rc
5937      IF (NOT LEN(Filename$)) OR (Rc) THEN 
5938        BEEP 150,.1
5939        DISP "Print Which File ?  - Blank to Exit"
5940        OUTPUT KBD;Filename$;
5941        ENTER KBD;Filename$
5942        IF TRIM$(Filename$)="" THEN GOTO Exit_print
5943      END IF
5944    UNTIL NOT Rc
5945    PRINT USING "/,5(K),/";Cmds$;" FILE: ";Filename$;"  To  Device: ";Pdev
5946    ON ERROR GOTO Print_err
5947    STATUS @File,1;File_type
5948    ON END @File GOTO Exit_print
5949    ON KBD,2 GOSUB Kbd_abort
5950    DISP CHR$(129);"Space Bar: Pause/Continue   P: Toggle Paging     Esc: Quit";CHR$(128)
5951    Print_wait=0
5952    STATUS CRT,13;Crt_lines
5953    Crt_lines=Crt_lines-7
5954    Paging=1
5955    One_line=0
5956    !--------------------------------
5957    LOOP
5958      SELECT File_type
5959      CASE 1       !
5960      CASE 2       ! Bdat
5961        ENTER @File;Line$
5962      CASE 3       ! Ascii
5963        ENTER @File;Line$
5964      CASE 4       ! hp-ux
5965        ENTER @File USING "#,K";Line$
5966      END SELECT
5967       !
5968      Pline=Pline+1                       ! paging
5969      IF Debug THEN DISP Pline,Crt_lines
5970      IF Pdev=1 AND Paging=1 THEN 
5971        IF Pline>=Crt_lines THEN 
5972          OUTPUT KBD;" ";                ! simulate a "space bar press"
5973          GOSUB Kbd_abort
5974          Pline=1
5975        END IF
5976      END IF
5977      !
5978      IF Pdev>1 THEN 
5979        OUTPUT Pdev;Line$                    ! to printer
5980        DISP "printer: ",Pdev
5981      END IF
5982      !
5983      IF POS(Line$,"") THEN                 ! avoid FF to screen
5984        Line$[(POS(Line$,""));1]=" "
5985      END IF
5986      PRINT Line$
5987      IF One_line THEN 
5988        OUTPUT KBD;" ";
5989        GOSUB Kbd_abort
5990      END IF
5991       !
5992      WAIT Print_wait
5993    EXIT IF Print_abort=1
5994    END LOOP
5995 Print_err:DISP ERRM$
5996 Exit_print:!
5997    OFF ERROR 
5998    OFF KBD
5999    ASSIGN @File TO *
6000    PRINTER IS VAL(Sav_prt$)
6001    DISP 
6002    SUBEXIT
6003 Kbd_abort:!       Routine to interrupt TYPE/PRINT of file
6004    Misc$=SYSTEM$("KBD LINE")
6005    K$=KBD$
6006    CLEAR LINE        ! clear KBD LINE
6007    One_line=0        ! clear single line mode
6008 Ka_2:!
6009    IF NOT LEN(K$) THEN K$=Misc$
6010    K$=UPC$(K$)
6011    Misc$=KBD$
6012    ON KBD,3 GOTO Exit_abort
6013    SELECT K$[1,1]
6014    CASE " "
6015      LOOP  ! wait here for next space bar
6016      END LOOP
6017    CASE ""                   !   =  Abort
6018      Print_abort=1
6019    CASE "P"                   ! P  =  Toggle Paging Breaks
6020      IF Paging THEN 
6021        Paging=0
6022        DISP "paging off"
6023      ELSE
6024        Paging=1
6025        DISP "paging on "
6026      END IF
6027      K$=" "
6028      WAIT .1         ! dwell to lift finger
6029    CASE "ÿ"
6030      SELECT K$[2,2]
6031      CASE "^"            ! faster
6032        BEEP 300,.01
6033        Print_wait=MAX(0,Print_wait-.1)
6034      CASE "V"            ! slower
6035        BEEP 300,.01
6036        Print_wait=Print_wait+.1
6037      CASE "E"                    ! <ENTER>  One Line Feed
6038        One_line=1
6039      END SELECT
6040      IF Debug THEN DISP Print_wait
6041    END SELECT
6042 Exit_abort:ON KBD,2 GOSUB Kbd_abort
6043    K$=KBD$
6044    IF LEN(K$) THEN 
6045      K$=UPC$(K$)
6046      IF NOT (K$[1,1]=" ") THEN GOTO Ka_2
6047    END IF
6048    RETURN 
6049  SUBEND
6050  !=====================  END OF HPKERMIT
6056  SUB Clear
6057    Shutdown
6058    Startup
6059  SUBEND
6060  !------------------------------------------------------------------------
6061  ! End of PROG File Code -
6062  ! IF BASIC Source Code is appended after this comment block
6063  ! it has been done so that a DOS Text version of the Program
6064  ! could be created. Source Code is included in the "HPBMISC" File
6065  !
6066  ! The PROG File contains the Compiled CSUBS and will perform better
6067  ! Performance is improved 4X by Compiling the following three
6068  ! Subprograms:
6069  !
6070  ! Decode_pack
6071  ! Encode_pack
6072  ! Spack
6073  !
6074  ! LOADSUB Decode_pack FROM "HPBMISC"
6075  ! LOADSUB Encode_pack FROM "HPBMISC"
6076  ! LOADSUB Spack FROM "HPBMISC"
6077  !-------------------------------------------------------------------------
6080  SUB Decode_pack(Rdata$,INTEGER Quote,Qbin,Rep_ch)
6081 Decode_pack: !
6082 Dp: !
6083  !
6084  ! Receive Rdata$ (Kermit Packet)
6085  ! Decode all &,#,~ and stuff results into Rdata$
6086  !
6087    INTEGER B,P,Stuff,Qon,Biton,Reps
6088  !
6089    ALLOCATE File_buff$[100]            ! use file_buff$ as a local here
6090  !------------------------------------------------------------------
6091    P=1
6092    FOR B=1 TO LEN(Rdata$)
6093      Stuff$=Rdata$[B,B]             ! get next  byte
6094      Stuff=NUM(Stuff$)
6095      IF Debug THEN DISP "P= ";P,"B= ";B,Stuff$,File_buff$[1,P]
6096      SELECT Stuff
6097      CASE Quote                          ! Control Quoting #
6098        IF Qon=1 THEN 
6099          IF (NOT Biton) THEN 
6100            File_buff$[P,P]=Stuff$              ! ## = #
6101          ELSE
6102            File_buff$[P,P]=CHR$(Stuff+128)      ! &## = '#
6103            Biton=0
6104          END IF
6105          P=P+1
6106          Qon=0
6107        ELSE
6108          Qon=1
6109        END IF
6110      CASE Qbin                   ! 8 bit prefix  &    (Biton)
6111        IF Qon=1 THEN 
6112          IF Biton=1 THEN 
6113            File_buff$[P,P]=CHR$(Stuff+128)     ! &#& = '&
6114            P=P+1
6115            Biton=0
6116          ELSE
6117            File_buff$[P,P]=Stuff$              ! #& = &
6118            P=P+1
6119          END IF
6120          Qon=0
6121        ELSE
6122          Biton=1
6123        END IF
6124      CASE Rep_ch                 ! Repeat Processing  ~
6125        IF (NOT Qon) AND (NOT Biton) THEN 
6126          BEEP 
6127          DISP "Repeat Process";Rdata$[B-1;4]
6128          B=B+1
6129          Reps=FNUnchar(Rdata$[B,B])           ! number of repeats this char
6130          B=B+1
6131          IF NUM(Rdata$[B,B])=Quote THEN             ! ~#()
6132            Qon=1
6133            B=B+1
6134          END IF
6135           !
6136          IF NUM(Rdata$[B,B])=Qbin THEN              ! ~&()
6137            Biton=1
6138            B=B+1
6139          END IF
6140           !
6141          Ch2rep=NUM(Rdata$[B,B])                 ! Char to Repeat
6142          IF Qon THEN Ch2rep=Ch2rep-64
6143          IF Biton THEN Ch2rep=Ch2rep+128
6144          Ch2rep$=CHR$(Ch2rep)
6145          File_buff$[P;Reps]=RPT$(Ch2rep$,Reps)
6146          P=P+Reps
6147        ELSE        ! #~
6148          IF Biton THEN Stuff=Stuff+128
6149          IF Qon THEN Stuff=Stuff-64
6150          File_buff$[P,P]=CHR$(Stuff)
6151          P=P+1
6152        END IF
6153             !
6154      CASE 32 TO 127               ! printable characters
6155        IF (Qon) AND (Biton) THEN                 ! &#()  Binary File
6156          File_buff$[P,P]=CHR$(FNCtl(Stuff$)+128)
6157          P=P+1
6158        END IF
6159               !
6160        IF (Biton) AND (NOT Qon) THEN             ! &
6161          File_buff$[P,P]=CHR$(NUM(Stuff$)+128)
6162          P=P+1
6163        END IF
6164              !
6165        IF (Qon) AND (NOT Biton) THEN             ! #
6166          File_buff$[P,P]=CHR$(FNCtl(Stuff$))
6167          P=P+1
6168        END IF
6169        IF (NOT Qon) AND (NOT Biton) THEN           ! normal char
6170          File_buff$[P,P]=Stuff$
6171          P=P+1
6172        END IF
6173           !
6174        Qon=0
6175        Biton=0
6176           !
6177      CASE 128 TO 255
6178        PRINT TABXY(25,12);"Invalid Char: Extended Ascii # ";Stuff
6179      END SELECT
6180    NEXT B
6181    Rdata$=File_buff$
6182  SUBEND
6183  !------------------------------------------------------------------------
6190  SUB Encode_pack(File_buff$,Packet$,INTEGER Myquote,Qbin,Rep_ch,Spsiz)
6191 Encode_pack_s: !
6192 Ep: !
6193  !
6194    DIM Stuff$[1],Myquote$[1],Qbin$[1]
6195    INTEGER Pack_full,P,B,Sdata_done,Bl
6196  !
6197    Myquote$=CHR$(Myquote)
6198    Qbin$=CHR$(Qbin)
6199    Bl=LEN(File_buff$)
6200    Pack_full=0
6201    P=1
6202    B=1
6203  !------------------------------------------------------
6204    REPEAT                           ! Until Pack_full=1
6205 Stuff:Stuff$=File_buff$[B,B]
6206      Stuff=NUM(Stuff$)
6207      SELECT Stuff
6208      CASE 0 TO 31,127 TO 255,Myquote,Qbin          ! ,Rep_ch !add quoting
6209        SELECT Stuff
6210        CASE 0 TO 31                               ! # Prefix.  (38=& 35=#)
6211          Packet$[P;2]=Myquote$&CHR$(FNCtl(Stuff$))
6212          P=P+2
6213        CASE Myquote,Qbin
6214          Packet$[P;2]=Myquote$&Stuff$
6215          P=P+2
6216        CASE 127              ! #?
6217          Packet$[P;2]=Myquote$&CHR$(Stuff-64)
6218          P=P+2
6219        CASE 128 TO 159                       ! &# prefixing
6220          Packet$[P;3]=Qbin$&Myquote$&CHR$(Stuff-64)
6221          P=P+3
6222        CASE 128+35,128+38
6223          Packet$[P;3]=Qbin$&Myquote$&CHR$(Stuff)
6224          P=P+3
6225        CASE 160 TO 254                       ! & Prefixing
6226          Packet$[P;2]=Qbin$&CHR$(Stuff-128)
6227          P=P+2
6228        CASE 255              ! &#?
6229          Packet$[P;3]=Qbin$&Myquote$&"?"
6230          P=P+3
6231        END SELECT
6232      CASE ELSE           ! printable -  no quoting is needed
6233        Packet$[P,P]=Stuff$
6234        P=P+1
6235      END SELECT
6236     !
6237      IF P>=Spsiz-4 THEN Pack_full=1
6238   !  IF At_eof AND B=Bl THEN
6239      IF B=Bl THEN 
6240        Pack_full=1
6241      END IF
6242      B=B+1
6243    UNTIL Pack_full
6244     !
6245    File_buff$=File_buff$[B]                  ! truncate
6246    B=1
6247  SUBEND
6248  !------------------------------------------------------------------------
6250 Spack:SUB Spack(Packet$,Pkt$,INTEGER Npak,Sndpkt$)
6251 Sspack: ! Form Send Packet Contents from Packet$ data
6252         ! IN
6253         !  Packet$[],Pkt$,Npak
6254         ! OUT
6255         !  Sndpkt$[]
6256    INTEGER Plen,Cchksum
6257    Sndpkt$=""
6258    Dlen=LEN(Packet$)
6259    Plen=LEN(Packet$)+3
6260    Ckpos=Plen+2
6261    Sndpkt$[1;1]="
"             ! packet mark  ^A
6262    Sndpkt$[2;1]=FNTochar$(Plen)   ! length
6263    Sndpkt$[3;1]=FNTochar$(Npak MOD 64)      ! packet sequence
6264    Sndpkt$[4;1]=Pkt$            ! packet type
6265    Sndpkt$[5;LEN(Packet$)]=Packet$  ! Stuff Data
6266    Chk=0
6267    FOR Ch=2 TO Plen+1
6268      Chk=Chk+NUM(Sndpkt$[Ch,Ch])
6269    NEXT Ch
6270    Cchksum=BINAND(Chk+(BINAND(Chk,192)/64),63)   ! Computed Checksum
6271    Sndpkt$[Ckpos;1]=FNTochar$(Cchksum)
6272   !
6273   ! fLUSH bUFFER hERE ???
6274   !
6275  SUBEND
6276  !=======================================================================