(* >>>> KERMSETSHW.TEXT ************************************************) (*$I-*) (*$R-*) (*$S+*) (*$V-*) UNIT KERMSETSHW; INTRINSIC CODE 27; INTERFACE USES kermglob, kermacia, kermutil; PROCEDURE show_parms; PROCEDURE set_parms; IMPLEMENTATION PROCEDURE show_dir( list_device : integer ); lists all the files in the directory from the requested diskunit number var space : packed array[1..15] of char; fil_type ,file_count, file_num : integer; PROCEDURE list_names ( start, quit : integer ); var len : integer; begin while (filecount < filenum) and (start < quit) do begin len := ord( filebuf[start-1] ); fil_type := ord( filebuf[start-3] ); if (len > 0) and (len < 16) and (fil_type < 6) then begin unitwrite( list_device, filebuf[start], len ); unitwrite( list_device, space[1], 16-len ); file_count := file_count + 1; end; start := start + 26; end; end; { list_names} begin { show_dir } space := ' '; if (volnum=4) or (volnum=5) or ((volnum>8) and (volnum<13)) then begin unitread( vol_num, filebuf[1], page_size, 2 ); if ioresult <> 0 then begin writeln('not on line'); writeln; exit( show_dir ); end; writeln(p); write(p,'Volume name is : '); unitwrite( list_device, filebuf[8], ord( filebuf[7] ) ); file_num := ord( filebuf[17] ); file_count := 0; writeln(p); writeln(p); list_names(34, pagesize-27); if (filecount < filenum) then begin moveleft( filebuf[pagesize-9], filebuf[1], 10 ); unitread( vol_num, filebuf[11], page_size - 10, 4 ); list_names( 8, pagesize-27); end; writeln(p); writeln(p); end else begin writeln('not a disk volume'); writeln; end; end; { show_dir } PROCEDURE show_p1; (* shows the various settable parameters *) var list_device : integer; begin close( p ); if pr_out and print_enable then begin reset(p, pr_file); list_device := line_printer; end else begin reset(p, cs_file); list_device := consol; end; writeln; if (verb = dirsym) or (verb = pdirsym) then begin show_dir( list_device ); pr_out := false; exit( show_parms ) end; if noun = allsym then begin page(output); writeln(p,'SERIAL PORT SETTINGS'); writeln(p); end; if (noun=allsym) or (noun=baudsym) then writeln(p,' BAUD rate is ', baud ); if (noun=allsym) or (noun=paritysym) then begin case parity of evenpar : write(p,' EVEN'); markpar : write(p,' MARK'); nopar : write(p,' NONE'); oddpar : write(p,' ODD'); spacepar : write(p,' SPACE'); end; { case } writeln(p,' PARITY'); end; { if } if (noun=allsym) or (noun=wordlensym) then writeln(p,' WORD-LENGTH is ', data_bit ,' bits'); if (noun=allsym) or (noun=stopbsym) then begin write(p,' Number of STOPBITs is '); if stopbit = 15 then writeln(p,'1.5') else writeln(p, stopbit ); end; { if } if (noun=allsym) or (noun=localsym) then write_bool(' LOCAL-ECHO is ', halfduplex ); end; { show_p1 } PROCEDURE show_p2; begin if (noun=allsym) then begin writeln(p); writeln(p,'TERMINAL MODE RELATED SETTINGS'); writeln(p); end; if (noun=allsym) or (noun=emulatesym) then writeln(p,' EMULATE is not implemented.' ); if (noun=allsym) or (noun=escsym) then begin write(p,' Terminal ESCAPE key is '); write_ctl( esc_char ); writeln(p); end; if (noun=allsym) or (noun=rejectsym) then write_bool(' REJECT incoming control characters is ', reject_cntrl_char); if (noun=allsym) or (noun=delsym) then begin write(p,' DELKEY (backspace key code send to host = '); write_ctl( bs_to_del ); write(p,' ) is '); if bs_to_del = chr(del) then writeln(p,'ON') else writeln(p,'OFF'); end; if (noun=allsym) or (noun=xonsym) then begin write(p,' XON-CHAR is '); write_ctl( xon_char ); writeln(p,' ( screendump and ibm = on only )'); end; if (noun=allsym) or (noun=xoffsym) then begin write(p,' XOFF-CHAR is '); write_ctl( xoff_char ); writeln(p,' ( screendump only )'); end; if (noun=allsym) or (noun=xoffwaitsym) then writeln(p,' XOFF-WAIT-COUNT is ', xoffwtime ,' ( screendump only )'); if (noun=allsym) or (noun=nofeedsym) then write_bool(' NOFEED (form-feed during screendump) is ', no_ffeed ); if (noun=allsym) or (noun=ibmsym) then write_bool(' IBM vm/cms settings are ', ibm ); if (noun=allsym) then begin if not ( pr_out and print_enable ) then begin writeln; write('>>> PRESS FOR MORE <<<'); readln; end; writeln(p); writeln(p,'FILE TRANSFER RELATED SETTINGS'); writeln(p); end; end; { show_p2 } PROCEDURE show_p3; begin if (noun=allsym) or (noun=debugsym) then write_bool(' DEBUGging is ', debug ); if (noun=allsym) or (noun=filewarnsym) then write_bool(' FILE-WARNING is ', fwarn ); if (noun=allsym) or (noun=textfsym) then write_bool(' TEXTFILE send & receive is ', text_file ); if (noun=allsym) or (noun=prefixsym) then writeln(p, ' PREFIX volume for received files is ', prefix_vol ); if (noun=allsym) or (noun=timeoutsym) then writeln(p, ' TIMEOUT period specified to host is about ',mytime,' sec'); if (noun=allsym) or (noun=maxtrysym) then begin writeln(p,' MAXTRY ( number of retries before breaking off ) is ',maxtry); writeln(p,' ( Initial retries = 5 * maxtry )'); end; if (noun=allsym) or (noun=eolnsym) then begin write(p,' END-OF-LINE character send after each package is '); write_ctl( xeol_char ); writeln(p); end; if (noun=allsym) or (noun=maxpsym) then writeln(p,' MAXPACK: packetsize (20..', def_maxpack, ') I can receive is ', maxpack ); if (noun=allsym) then begin write(p,' Kermit packet starts with '); write_ctl( soh_char ); writeln(p); write(p,' My padding character is '); write_ctl( my_pchar ); writeln(p); writeln(p,' Number of padding char''s I need is ', my_pad ); writeln(p,' My quote char for control char''s is ', my_quote ); end; writeln(p); close( p ); reset( p, cs_file ); end; { show_p3 } PROCEDURE show_parms; begin show_p1; show_p2; show_p3; pr_out := false; end; { show_parms } PROCEDURE set_parms; (* sets the parameters *) begin case noun of debugsym : debug := ( adj = onsym ); emulatesym : ; textfsym : textfile := ( adj = onsym ); prefixsym : prefix_vol := newprefix_vol; rejectsym : reject_cntrl_char := ( adj = onsym ); nofeedsym : no_ffeed := ( adj = onsym ); xonsym : xonchar := newxonchar; xoffsym : xoffchar := newxoffchar; eolnsym : xeol_char := new_xeol_char; escsym : esc_char := new_esc_char; delsym : case adj of onsym : bs_to_del := chr(del); offsym : bs_to_del := backsp; end; filewarnsym: fwarn := (adj = onsym); xoffwaitsym: if newxoffwait < 256 then xoffwtime := newxoffwait; maxtrysym : begin maxtry := newmaxtry; inittry := 5 * maxtry; end; maxpsym : if (new_maxpack <= def_maxpack ) and (new_maxpack >= 20) then maxpack := new_maxpack; timeoutsym : if newtimeout < 32 then begin my_time := newtimeout; xtime := my_time; end; ibmsym : case adj of onsym : begin set_acia_parms(markpar,databit,stopbit,baud); get_acia_parms(parity,databit,stopbit,baud); if parity = mark_par then begin ibm := true; half_duplex := true; end; end; (* onsym *) offsym: begin ibm := false; half_duplex := false; end; (* offsym *) end; (* case adj *) localsym : if not ibm then halfduplex := (adj = onsym); paritysym : if not ibm then case adj of evensym: new_par:= evenpar; marksym: new_par:= markpar; nonesym: new_par:= nopar; oddsym: new_par:= oddpar; spacesym:new_par:= spacepar; end; (* case *) end; (* case noun *) case noun of paritysym : set_acia_parms( new_par,data_bit, stop_bit, baud ); baudsym : set_acia_parms( parity, data_bit, stop_bit, new_baud ); wordlensym : set_acia_parms( parity, new_dbit, stop_bit, baud ); stopbsym : set_acia_parms( parity, data_bit, new_stopbit, baud ); end; { case } get_acia_parms( parity, data_bit, stop_bit, baud ); end; (* set_parms *) begin end. { kermsetshw }