$COMPACT(tccdrv -CONST IN CODE- HAS
$        tccdrv,
$		 x188ch,
$		 x188in,
$		 x188mo,
$		 x188su,
$		 x188ut;
$        EXPORTS
$		 i188$init,
$		 i188$finish,
$		 i188$setup,
$		 i188$output,
$		 i188$answer,
$		 i188$hangup,
$		 i188$utility,
$		 i188$check)
tccdrv:
DO;

$include(/rmx386/inc/rmxplm.ext)
$include(/rmx386/inc/error.lit)
$include(/rmx386/inc/common.lit)
$include(/rmx386/inc/io.lit)
$include(lddinfo.lit)

i188$init: PROCEDURE(cdata$p) EXTERNAL;
	DECLARE
		cdata$p				POINTER;
END i188$init;

i188$finish: PROCEDURE(cdata$p) EXTERNAL;
	DECLARE
		cdata$p				POINTER;
END i188$finish;

i188$setup: PROCEDURE(udata$p) EXTERNAL;
	DECLARE
		udata$p				POINTER;
END i188$setup;

i188$answer: PROCEDURE(udata$p) EXTERNAL;
	DECLARE
		udata$p				POINTER;
END i188$answer;

i188$hangup: PROCEDURE(udata$p) EXTERNAL;
	DECLARE
		udata$p				POINTER;
END i188$hangup;

i188$utility: PROCEDURE(udata$p) EXTERNAL;
	DECLARE
		udata$p				POINTER;
END i188$utility;

i188$check: PROCEDURE(cdata$p) EXTERNAL;
	DECLARE
		cdata$p				POINTER;
END i188$check;

DECLARE
	dinfo_548(1)					BYTE EXTERNAL DATA,
	num_duibs						BYTE EXTERNAL DATA,
	duibtable(1)					BYTE EXTERNAL DATA;

i188$output: PROCEDURE(udata$p,output$char) REENTRANT PUBLIC;
	DECLARE
		udata$p				POINTER,
		output$char			BYTE;

	RETURN;
END i188$output;

DECLARE
	duib$p						POINTER,
	duib	BASED	duib$p (1)	DUIB$STRUCT,
	dinfo$p						POINTER,
	dinfo	BASED	dinfo$p		LOADABLE$TERM$DINFO,
	local$dinfo	BASED	dinfo$p	STRUCTURE(
		term$dinfo							LOADABLE$TERM$DINFO,
		num$boards							BYTE,
		memory$base$address					DWORD,
		io$port$address						WORD,
		override$flag						BYTE),
	uinfo$p						POINTER,
	uinfo	BASED	uinfo$p		STRUCTURE(
		conn$flags							WORD,
		term$flags							WORD,
		in$baud$rate						DWORD,
		out$baud$rate						DWORD,
		scroll$count						WORD);

DECLARE
		co$conn$t			TOKEN,
		root$t				TOKEN,
		HI$job$$t			TOKEN,
		parent$job$t		TOKEN,
		input$buff(128)		BYTE,
		status				WORD,
		bytes$read			WORD,
		del					BYTE, /* Delimeter returned by get$argument */
		base$address		DWORD,
		IO$address			WORD,
		interrupt$level		WORD,
		board$MB$page		BYTE,
		exception$info		STRUCTURE(
			entry$point			POINTER,
			mode				BYTE),
		reg$76H				BYTE,
		REG_76H				LITERALLY	'76H',
		NO$BUFFERS			LITERALLY	'0',
		RT_PREN				LITERALLY	'29H',
		ROOT_JOB			LITERALLY	'3',
		PARENT_JOB			LITERALLY	'1',
		NO$EXCEPTIONS		LITERALLY	'00',
		sign$on$msg(*)		BYTE	DATA(CR,LF,
		'                iRMX III Loadable TCC Driver Front End',CR,LF,LF),
		badparm$msg(*)		BYTE DATA(CR,LF,
			'Invalid Command Tail',CR,LF), /* Unknown parameter msg */
		missing$parm$msg(*)		BYTE DATA(CR,LF,
			'Missing input parameter',CR,LF), /* missing input parm msg */
		usage$msg(*)		BYTE DATA(CR,LF,
	'USAGE: tccdrv( (TCC Base Address(in HEX)),',CR,LF,
	'               (TCC I/O Address(in HEX)),',CR,LF,
	'               (TCC Encoded Interrupt Level),',CR,LF,
	'               <Actual Board Megabyte Page(0-F) (iSBC 386SX Only)>)',
					CR,LF);

$subtitle('CONVERT')
convert: PROCEDURE(char$p) DWORD REENTRANT;

	DECLARE
		char$p						POINTER,
		char	BASED	char$p	(1)	BYTE,
		char$value					BYTE,
		value						DWORD,
		i							BYTE;

	value = 0;
	DO i = 1 to char(0);
		IF (char(i) < 30H) OR (char(i) > 46H) OR
			((char(i) > 39H) AND (char(i) < 41H)) THEN
				RETURN 0;
		IF char(i) > 39H THEN
			char$value = char(i) - 37H;
		ELSE
			char$value = char(i) - 30H;
		value = (value * 16) + char$value;
	END;
	RETURN value;

END convert;

$subtitle('append$string')
append$string: PROCEDURE(str1$p, str2$p) REENTRANT;

	DECLARE
		str1$p						POINTER,
		str2$p						POINTER,
		str1	BASED	str1$p(1)	BYTE,
		str2	BASED	str2$p(1)	BYTE,
		i							BYTE,
		j							BYTE;

	j = str1(0);
	DO i = 1 to str2(0);
		str1(j+i) = str2(i);
	END;
	str1(0) = str1(0) + str2(0);

END append$string;

$subtitle('Check Exception')
check$exception: PROCEDURE(exception, info$p) REENTRANT;

	DECLARE
			exception				WORD,
			info$p					POINTER,
			info	BASED	info$p	STRUCTURE(
				count				BYTE,
				char(1)				BYTE),
			exc$buf					STRUCTURE(
				count				BYTE,
				char(80)			BYTE),
			dummy					WORD;

	IF exception <> E$OK THEN
	DO;
		CALL dq$decode$exception(exception, @exc$buf, @dummy);
		CALL dq$write(co$conn$t, @(CR,LF), 2, @dummy);
		CALL dq$write(co$conn$t, @exc$buf.char, exc$buf.count, @dummy);
		CALL dq$write(co$conn$t, @(': '), 2, @dummy);
		IF info$p <> NIL THEN
			CALL dq$write(co$conn$t, @info.char, info.count, @dummy);
		CALL dq$write(co$conn$t, @(CR,LF), 2, @dummy);

		CALL dq$detach(co$conn$t,@status);

		CALL rq$delete$job (SELECTOR$OF(NIL), @status);

		CALL rq$suspend$task(SELECTOR$OF(NIL),@status);	/* if all else fails */
	END;

END check$exception;


/*
 *		MAIN PROGRAM
 */

	board$MB$page = 0FFH;

	/*
	 *	Turn off exceptions
	 */

	exception$info.mode = NO$EXCEPTIONS;
	CALL rq$set$exception$handler( @exception$info, @status);

	/*
	 * Get the arguments.  The first one should be the name
	 * of this program.
	 */

	del = dq$get$argument(@input$buff, @status );

	/*
	 * Create a log file for the program 
	 */
	IF status = E$OK THEN
	DO;
		/* log file name = <prog name>.log */

		CALL append$string (@input$buff, @(4,'.log')); 
	END;
	ELSE
	DO;
		input$buff(0) = 0;
		CALL append$string (@input$buff, @(16,'/work/tccdrv.log')); 
	END;

	/*
	 * Create a connection to the log file
	 */

	co$conn$t = dq$create(@input$buff, @status );

	CALL dq$open( co$conn$t, WRITE$ONLY, NO$BUFFERS, @status );

	CALL dq$write(co$conn$t,@sign$on$msg,LENGTH(sign$on$msg),@status);
	CALL check$exception(status,NIL);

	/*
	 * If the delimeter is a CR or LF then there are no parameters.
	 * This is an error so print out the usage message.
	 */

	IF (del = CR) OR (del = LF) THEN
	DO;
		CALL dq$write(co$conn$t,@usage$msg,LENGTH(usage$msg),@status);
		GOTO exit;
	END;
	ELSE
	DO; /* Get TCC Base Address */
		del = dq$get$argument(@input$buff,@status);
		CALL check$exception(status,NIL);
		IF (del = CR) OR (del = LF) OR (input$buff(0) = 0) THEN
		DO;
            CALL dq$write(co$conn$t,@missing$parm$msg,
							LENGTH(missing$parm$msg),@status);
			CALL dq$write(co$conn$t,@usage$msg,LENGTH(usage$msg),@status);
			GOTO exit;
		END;
		ELSE
		DO;	/* Convert ASCII input number to HEX */
			base$address = convert(@input$buff);

			/* Get TCC I/O Address */
			del = dq$get$argument(@input$buff,@status);
			CALL check$exception(status,NIL);
			IF (del = CR) OR (del = LF) OR (input$buff(0) = 0) THEN
			DO;
    	        CALL dq$write(co$conn$t,@missing$parm$msg,
								LENGTH(missing$parm$msg),@status);
				CALL dq$write(co$conn$t,@usage$msg,
								LENGTH(usage$msg),@status);
				GOTO exit;
			END;
			ELSE
			DO;	/* Convert ASCII input number to HEX */
				IO$address = convert(@input$buff);

				/* Get TCC Interrupt Level */
				del = dq$get$argument(@input$buff,@status);
				CALL check$exception(status,NIL);
				IF (del = CR) OR (del = LF) OR (input$buff(0) = 0) THEN
				DO;
	    	        CALL dq$write(co$conn$t,@missing$parm$msg,
									LENGTH(missing$parm$msg),@status);
					CALL dq$write(co$conn$t,@usage$msg,
									LENGTH(usage$msg),@status);
					GOTO exit;
				END;
				ELSE
				DO;	/* Convert ASCII input number to HEX */
					interrupt$level = convert(@input$buff);

					IF del = RT_PREN THEN
						GOTO load$driver;

					/* Get Actual Board Address */
					del = dq$get$argument(@input$buff,@status);
					CALL check$exception(status,NIL);
					IF (del = CR) OR (del = LF) OR (input$buff(0) = 0) THEN
					DO;
	    	    	    CALL dq$write(co$conn$t,@missing$parm$msg,
										LENGTH(missing$parm$msg),@status);
						CALL dq$write(co$conn$t,@usage$msg,
										LENGTH(usage$msg),@status);
						GOTO exit;
					END;
					ELSE
					DO;	/* Convert ASCII input number to HEX */
						board$MB$page = convert(@input$buff);
					END;
				END;
			END;
		END;
	END;

load$driver:

	dinfo$p = BUILD$PTR(
				rqe$create$descriptor(
					rqe$get$address(@dinfo_548,@status),
					SIZE(local$dinfo),
					@status),0);
	CALL check$exception(status,@input$buff);

	dinfo.interrupt$level = interrupt$level;
	local$dinfo.memory$base$address = base$address;
	local$dinfo.io$port$address = IO$address;

	duib$p = @duibtable;

	CALL rq$install$duibs(num_duibs,
						  duib$p,
						  NIL,
						  @status);
	CALL check$exception(status,NIL);

	root$t = rq$get$task$tokens(ROOT_JOB,@status);
	CALL check$exception(status,NIL);

	HI$job$t = rq$lookup$object(root$t,@(8,'R?HI$JOB'),0,@status);
	CALL check$exception(status,NIL);

	parent$job$t = rq$get$task$tokens(PARENT_JOB,@status);
	CALL check$exception(status,NIL);

	CALL rq$catalog$object(HI$job$t,parent$job$t,
							@(10,'TCCDRV_JOB'),@status);
	IF status = E$CONTEXT THEN
	DO;
		CALL rq$uncatalog$object(HI$job$t,
									@(10,'TCCDRV_JOB'),@status);
		CALL rq$catalog$object(HI$job$t,parent$job$t,
									@(10,'TCCDRV_JOB'),@status);
	END;

	CALL dq$detach(co$conn$t,@status);	/* detach the log file */

	/*
	 *	Special for iSBC 386SX
	 *
	 *	Set the 1 MB page window in the iSBX 386SX to point to the
	 *	Megabyte page in which the TCC board dual port memory is located
	 */

	IF board$MB$page <> 0FFH THEN
	DO;
		reg$76H = INPUT(REG_76H);
		board$MB$page = board$MB$page AND 0FH;
		reg$76H = (reg$76H AND 0F0H) OR board$MB$page;
		OUTPUT(REG_76H) = reg$76H;
	END;

	CALL rq$suspend$task(SELECTOR$OF(NIL),@status);

exit:

	/*
	 * Clean up.  Detach :CO:.
	 */

	CALL dq$detach(co$conn$t,@status);

	CALL rq$delete$job (SELECTOR$OF(NIL), @status);

	CALL rq$suspend$task(SELECTOR$OF(NIL),@status);	/* if all else fails */

END tccdrv;