$compact
$optimize(3)

cmds:
do;

declare true literally '0FFH';
declare false literally '00H';
$INCLUDE(:INC:LTKSEL.LIT)
$INCLUDE(:INC:NEXCEP.LIT)
$INCLUDE(:INC:IEXCEP.LIT)

declare null literally '000H';
declare lf literally '0AH';
declare cr literally '0DH';
declare crlf literally 'cr,lf,null';
declare space literally '20H';
declare dollar literally '24H';
declare soh literally '1';

declare num_cmds literally '19';
declare num_para literally '17';
declare num_opt  literally '8';
declare num_remote literally '10';
declare num_dup  literally '2';
declare num_baud literally '7';
declare num_log  literally '2';
declare cmd_list (num_cmds) structure
	(symbol(12) byte) data
	('BYE         ',
	 'CONNECT     ',
	 'DEFINE      ',
	 'EXIT        ',
	 'FINISH      ',
	 'GET         ',
	 'HELP        ',
	 'LOCAL       ',
	 'LOG         ',
	 'QUIT        ',
	 'RECIEVE     ',
	 'REMOTE      ',
	 'SEND        ',
	 'SERVER      ',
	 'SET         ',
	 'SHOW        ',
	 'STATISTICS  ',
	 'TAKE        ',
	 'TRANSMIT    ');
declare para_list (num_para) structure
	(symbol(12) byte) data
	('BAUD_RATE   ',
	 'BLOCK_CHECK ',
	 'DEBUGGING   ',
	 'DELAY       ',
	 'DUPLEX      ',
	 'ESCAPE      ',
	 'FILE        ',
	 'FLOW_CONTROL',
	 'HANDSHAKE   ',
	 'IBM         ',
	 'INCOMPLETE  ',
	 'LINE        ',
	 'PARITY      ',
	 'PORT        ',
	 'RECIEVE     ',
	 'RETRY       ',
	 'SEND        ');
declare opt_list (num_opt) structure
	(symbol(12) byte) DATA
	('END_OF_LINE ',
	 'PACKET_LENGT',
	 'PADCHAR     ',
	 'PADDING     ',
	 'PAUSE       ',
	 'QUOTE       ',
	 'START_OF_PAC',
	 'TIMEOUT     ');
declare remote_list (num_remote) structure
	(symbol(12) byte) DATA
	('CWD         ',
	 'DELETE      ',
	 'DIRECTORY   ',
	 'DISK        ',
	 'HELP        ',
	 'HOST        ',
	 'KERMIT      ',
	 'RUN         ',
	 'PROGRAM     ',
	 'TYPE        ');
declare dup_list(num_dup) structure
	(symbol(12) byte) DATA
	('FULL        ',
	 'HALF        ');
declare baud_list(num_baud) structure
	(symbol(12) byte) DATA
	('0           ',
	 '300         ',
	 '1200        ',
	 '2400        ',
	 '4800        ',
	 '9600        ',
	 '19200       ');
declare log_list (num_log) structure
	(symbol(12) byte) data
	('TRANSACTIONS',
	 'SESSION     ');

declare buflen literally '122';
declare buffer(buflen) byte EXTERNAL;
declare cmdstr(buflen) byte EXTERNAL;
declare status word EXTERNAL;
declare baud_rate word EXTERNAL;
declare duplex byte external;
declare parity byte EXTERNAL;
declare delim byte external;


declare cmd byte external;
declare in$conn token EXTERNAL;
declare out$conn token EXTERNAL;
declare ci$conn token EXTERNAL;
declare co$conn token EXTERNAL;

declare filename structure
	(len byte,
	 name(80) byte) EXTERNAL;
declare file$conn token EXTERNAL;

declare debug byte EXTERNAL;
declare qopen byte EXTERNAL;

/* here are the subroutines */

$INCLUDE(:INC:UFLINF.EXT)
$INCLUDE(:INC:UATACH.EXT)
$INCLUDE(:INC:UOPEN.EXT)
$INCLUDE(:INC:UCLOSE.EXT)
$INCLUDE(:INC:UWRITE.EXT)
$INCLUDE(:INC:UDCEX.EXT)
$INCLUDE(:INC:UCREAT.EXT)
$INCLUDE(:INC:UDCTIM.EXT)
$INCLUDE(:INC:UDETAC.EXT)
$INCLUDE(:INC:ISSPEC.EXT)
$INCLUDE(:INC:USPECL.EXT)
$INCLUDE(:INC:USWBF.EXT)
$INCLUDE(:INC:UREAD.EXT)
$INCLUDE(:INC:UEXIT.EXT)
$INCLUDE(:INC:UGTARG.EXT)


check$error: PROCEDURE (fatal) byte EXTERNAL;
	declare fatal byte;
end check$error;

nout:	procedure(n) EXTERNAL;
	declare n word;
end nout;

nin:	procedure(string) address EXTERNAL;
	declare string address;
end nin;

co: procedure(c) EXTERNAL;
	declare c byte;
end co;

do$co: procedure EXTERNAL;
end do$co;

newline: procedure EXTERNAL;
end newline;

prints:	procedure(msg) EXTERNAL;
	declare msg pointer;
end prints;

print:	procedure(msg) EXTERNAL;
	declare msg pointer;
end print;

file$close: procedure EXTERNAL;
end file$close;

query: procedure byte EXTERNAL;
end query;

print$char: procedure (char);
	declare char byte;
	filename.name(filename.len)=char;
	filename.len=filename.len+1;
end print$char;

print$str: procedure (ptr);
	declare ptr pointer;
	call movb(ptr,@filename.name(filename.len),12);
	filename.len=filename.len+12;
end print$str;

do$print$str: procedure;
	filename.name(filename.len)=cr;
	filename.name(filename.len+1)=lf;
	filename.len=filename.len+2;
	call prints(@filename);
	filename.len=0;
end do$print$str;

bye$cmd: procedure EXTERNAL;
end bye$cmd;

conn$cmd: procedure EXTERNAL;
end conn$cmd;

def$cmd: procedure EXTERNAL;
end def$cmd;

exit$cmd: procedure (code) EXTERNAL;
	declare code byte;
end exit$cmd;

fin$cmd: procedure EXTERNAL;
end fin$cmd;

get$cmd: procedure EXTERNAL;
end get$cmd;

help$cmd: procedure;
	if delim<>cr then do;
		delim=DQ$GET$ARGUMENT(@cmdstr,@status);
		if check$error(0) then return;
		cmd=decode$cmd(@cmdstr,@cmd_list,num_cmds);
		if cmd=true then call ambiguous;
		else do;
		  do case cmd;
			call unknown(@(5,'Help '));
			call bye$help;
			call conn$help;
			call def$help;
			call exit$help;
			call fin$help;
			call get$help;
			call help$help;
			call loc$help;
			call log$help;
			call quit$help;
			call recv$help;
			call rem$help;
			call send$help;
			call serv$help;
			call set$help;
			call show$help;
			call stat$help;
			call take$help;
			call tran$help;
		  end;
		  if cmd <> 0 then return;
		end;
	end;
	call help$help;
end help$cmd;

loc$cmd: procedure EXTERNAL;
end loc$cmd;

log$cmd: procedure EXTERNAL;
end log$cmd;

recv$cmd: procedure EXTERNAL;
end recv$cmd;

rem$cmd: procedure EXTERNAL;
end rem$cmd;

send$cmd: procedure EXTERNAL;
end send$cmd;

serv$cmd: procedure EXTERNAL;
end serv$cmd;

set$cmd: procedure EXTERNAL;
end set$cmd;

show$cmd: procedure EXTERNAL;
end show$cmd;

stat$cmd: procedure EXTERNAL;
end stat$cmd;

take$cmd: procedure EXTERNAL;
end take$cmd;

tran$cmd: procedure EXTERNAL;
end tran$cmd;

help$log$trans: procedure;
	call undocumented;
end help$log$trans;

help$log$session: procedure;
	call undocumented;
end help$log$session;

undocumented: procedure;
	call print(@('Help documentation not yet available',crlf));
end undocumented;

ambiguous: procedure PUBLIC;
	call print(@('ambiguous command',crlf));
end ambiguous;

unsupported: procedure PUBLIC;
	call print(@('not presently supported',crlf));
end unsupported;

unknown: procedure(cmd$ptr) PUBLIC;
	declare cmd$ptr pointer;
	declare cmd based cmd$ptr structure
		(len byte,
		 symbol(12) byte);
	call print(@('unknown ',null));
	if cmd.len>0 then call prints(cmd$ptr);
	call print(@('command, check spelling',crlf));
end unknown;

decode$cmd: procedure (cmd$ptr,list$ptr,num) byte PUBLIC;
	declare cmd$ptr pointer;
	declare list$ptr pointer;
	declare num byte;
	declare list based list$ptr (1) structure
		(symbol(12) byte);
	declare cmd based cmd$ptr structure
		(len byte,
		 symbol(12) byte);
	declare (i,j,ix) byte;
	if debug then call prints(cmd$ptr);
	ix=0;
	if cmd.len>12 then cmd.len=12;
	else if cmd.len=0 then return ix;
	do i=1 to num;
	  do j=1 to cmd.len;
	    if cmd.symbol(j-1) <> list(i-1).symbol(j-1) then goto nexti;
	  end;
	  if ix<>0 then ix=true;
	  else ix=i;
nexti: end;
	if debug then call nout(ix);
	return ix;
end decodecmd;

do$cmd: procedure PUBLIC;
	do case cmd;
		call unknown(@(0));
		call bye$cmd;
		call conn$cmd;
		call def$cmd;
		call exit$cmd(0);
		call fin$cmd;
		call get$cmd;
		call help$cmd;
		call loc$cmd;
		call log$cmd;
		call exit$cmd(0);
		call recv$cmd;
		call rem$cmd;
		call send$cmd;
		call serv$cmd;
		call set$cmd;
		call show$cmd;
		call stat$cmd;
		call take$cmd;
		call tran$cmd;
	end;
end do$cmd;

do$para: procedure PUBLIC;
	do case cmd;
		call unknown(@(10,'parameter '));
		call baud$para;
		call block$para;
		call debug$para;
		call delay$para;
		call dup$para;
		call esc$para;
		call file$para;
		call flow$para;
		call hand$para;
		call ibm$para;
		call inco$para;
		call port$para;
		call par$para;
		call port$para;
		call recv$para;
		call retry$para;
		call send$para;
	end;
end do$para;

get$in$cmd: procedure PUBLIC;
	cmd=decode$cmd(@cmdstr,@cmd_list,num_cmds);
	if cmd=true then call ambiguous;
	else call do$cmd;
end get$in$cmd;

get$baud: procedure PUBLIC;
	  cmd=decode$cmd(@cmdstr,@baud_list,num_baud);
	  if cmd=true then call ambiguous;
	  else do case cmd;
		call unknown(@(10,'baud rate '));
		baud_rate=0;
		baud_rate=300;
		baud_rate=1200;
		baud_rate=2400;
		baud_rate=4800;
		baud_rate=9600;
		baud_rate=19200;
	  end;
end get$baud;

get$para: procedure PUBLIC;
	cmd=decode$cmd(@cmdstr,@para_list,num_para);
	if cmd=true then call ambiguous;
	else call do$para;
end get$para;

output$baud: procedure PUBLIC;
		if cmd=1 then call print(@('system default',null));
		else do;
		  call co(baud_list(cmd-1).symbol(0));
		  call co(baud_list(cmd-1).symbol(1));
		  call co(baud_list(cmd-1).symbol(2));
		  call co(baud_list(cmd-1).symbol(3));
		  if cmd=7 then call co(baud_list(cmd-1).symbol(4));
		end;
end output$baud;

get$duplex: procedure PUBLIC;
	  cmd=decode$cmd(@cmdstr,@dup_list,num_dup);
	  if cmd=true then call ambiguous;
	  else do case cmd;
		call unknown(@(7,'duplex '));
		duplex=0;
		duplex=1;
	  end;
end get$duplex;

baud$para: procedure EXTERNAL;
end baud$para;

block$para: procedure EXTERNAL;
end block$para;

debug$para: procedure EXTERNAL;
end debug$para;

delay$para: procedure EXTERNAL;
end delay$para;

dup$para: procedure EXTERNAL;
end dup$para;

esc$para: procedure EXTERNAL;
end esc$para;

file$para: procedure EXTERNAL;
end file$para;

flow$para: procedure EXTERNAL;
end flow$para;

hand$para: procedure EXTERNAL;
end hand$para;

ibm$para: procedure EXTERNAL;
end ibm$para;

inco$para: procedure EXTERNAL;
end inco$para;

par$para: procedure EXTERNAL;
end par$para;

port$para: procedure EXTERNAL;
end port$para;

recv$para: procedure EXTERNAL;
end recv$para;

retry$para: procedure EXTERNAL;
end retry$para;

send$para: procedure EXTERNAL;
end send$para;

bye$help: procedure;
	call print(@('SYNTAX: Bye',crlf));
	call print(@(lf,'Sends a message to remote kermit to exit from',
			' server mode,',crlf));
	call print(@('  and logout of remote system',crlf));
	call print(@('  also exits from local program',crlf));
end bye$help;

conn$help: procedure;
	call print(@('SYNTAX: Connect [device]',crlf));
	call print(@(lf,'Makes a virtual terminal connection',
			' via specified device',crlf));
	call print(@('  if device not specified uses the one set up',
			' by SET LINE command',crlf));
	call print(@(' to break the connection type ^] C',crlf));
	call print(@(lf,'SPECIAL NOTE: Because ^C is special for RMX,',crlf));
	call print(@(' to send a control-C via the connection type ^] ^Y',crlf));
end conn$help;

def$help: procedure;
	call print(@('SYNTAX: Define macroname [set-parameters]',crlf));
	call undocumented;
end def$help;

exit$help: procedure;
	call print(@('SYNTAX: Exit',crlf));
	call print(@(lf,'exits from program',crlf));
end exit$help;

fin$help: procedure;
	call print(@('SYNTAX: Finish',crlf));
	call print(@(lf,'Sends a message to remote kermit to exit from',
			' server mode,',crlf));
	call print(@('  and remote KERMIT but not logout of system',crlf));
end fin$help;

get$help: procedure;
	call print(@('SYNTAX: Get filespec1 [filespec2]',crlf));
	call print(@(lf,'filespec1 is remote filespec and may',
			' have wildcards',crlf));
	call print(@('filespec2 is local name to store file in,',
			' no wildcard support',crlf));
end get$help;

help$help: procedure;
	declare i byte;
	call print(@('Help is available on the following commands:',crlf));
	call newline;
	filename.len=0;
	do i=0 to num_cmds-1;
		call print$str(@cmd_list(i));
		if (i mod 5)=4 then call do$print$str;
	end;
	if (num_cmds mod 5)<>0 then call do$print$str;
	call newline;
	call print(@('Abreviations are allowed as long as',
				' they are unique',crlf));
end help$help;

loc$help: procedure;
	if delim<>cr then do;
		call undocumented;
	end;
	call print(@('SYNTAX: LOCal command',crlf));
end loc$help;

log$help: procedure;
	if delim<>cr then do;
		delim=DQ$GET$ARGUMENT(@cmdstr,@status);
		if check$error(0) then return;
		cmd=decode$cmd(@cmdstr,@cmd_list,num_cmds);
		if cmd=true then call ambiguous;
		else do;
		  do case cmd;
			call unknown(@(4,'Log '));
			call help$log$trans;
			call help$log$session;
		  end;
		  if cmd <> 0 then return;
		end;
	end;
	call print(@('SYNTAX: LOG [option] [filespec]',crlf));
	call print(@('  legal options are:',null));
	filename.len=0;
	call print$str(@log_list(0));
	call print$char(' ');
	call print$str(@log_list(1));
	call do$print$str;
	call print(@(lf,'logs the specified option to the specified',
			' log file',crlf));
	call print(@('  if filespec is omitted, defaults to KERMIT.LOG',
			' in the default directory',crlf));
end log$help;

quit$help: procedure;
	call print(@('SYNTAX: Quit',crlf));
	call print(@(lf,'exits from program',crlf));
end quit$help;

recv$help: procedure;
	call print(@('SYNTAX: RECieve [filespec]',crlf));
	call print(@(lf,'if filespec is missing or more than one',
			' file is recieved,',crlf));
	call print(@(' will use filespec from other computer.',crlf));
	call print(@('No filename tranformation is available yet',crlf));
end recv$help;

rem$help: procedure;
	if delim<>cr then do;
		call undocumented;
	end;
	call print(@('SYNTAX: REMote command',crlf));
end rem$help;

send$help: procedure;
	call print(@('SYNTAX: SENd filespec1 [filespec2]',crlf));
	call print(@(lf,'filespec1 may have wildcard parameters',crlf));
	call print(@('filespec2 is not preently used.',crlf));
end send$help;

serv$help: procedure;
	call print(@('SYNTAX: SERver',crlf));
	call undocumented;
end serv$help;

set$help: procedure;
	declare i byte;
	if delim<>cr then do;
		call undocumented;
	end;
	call print(@('SYNTAX: SET parameter [option] [value]',crlf));
	call print(@(lf,'Help is available on the following parameters:',crlf));
	call newline;
	filename.len=0;
	do i=0 to num_para-1;
		call print$str(@para_list(i));
		call print$char(' ');
		if (i mod 5)=4 then call do$print$str;
	end;
	if (num_para mod 5)<>0 then call do$print$str;
	call newline;
end set$help;

show$help: procedure;
	declare i byte;
	call print(@('SYNTAX: SHow [parameter]',crlf));
	call print(@(lf,'If parameter is omitted,',
			' all parameters are shown',crlf));
	call print(@('The following are legal parameters:',crlf));
	call newline;
	filename.len=0;
	do i=0 to num_para-1;
		call print$str(@para_list(i));
		call print$char(' ');
		if (i mod 5)=4 then call do$print$str;
	end;
	if (num_para mod 5)<>0 then call do$print$str;
	call newline;
end show$help;

stat$help: procedure;
	call print(@('SYNTAX: STatistics',crlf));
	call print(@(lf,'Gives statistics on the most recent transfer',crlf));
end stat$help;

take$help: procedure;
	call print(@('SYNTAX: TAke filespec',crlf));
	call print(@(lf,'Reads KERMIT commands from the specified file',crlf));
	call print(@('  all commands except another TAKE command',
				' are allowed',crlf));
end take$help;

tran$help: procedure;
	call print(@('SYNTAX: TRansmit filespec',crlf));
	call print(@(lf,'Sends a file without KERMIT protocall',crlf));
end tran$help;

end cmds;