$COMPACT(h550drv -CONST IN CODE- HAS
$        h550drv,
$		 xh550;
$        EXPORTS
$		 host$550$init,
$		 host$550$finish,
$		 host$550$setup,
$		 host$550$output,
$		 host$550$answer,
$		 host$550$hangup,
$		 host$550$utility,
$		 host$550$check)
h550drv:
DO;

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

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

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

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

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

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

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

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

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

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

	RETURN;
END host$550$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,
		port$base							WORD,
		reset$char							BYTE,
		break$char							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 */
		IO$address			WORD,
		interrupt$level		WORD,
		exception$info		STRUCTURE(
			entry$point			POINTER,
			mode				BYTE),
		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 Hostess 550 Terminal 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: h550drv( (Hostess 550 I/O Address(in HEX)),',CR,LF,
	'                (Hostess 550 Encoded Interrupt Level))',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
 */

	/*
	 *	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, @(17,'/work/h550drv.log')); 
	END;

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

	co$conn$t = dq$create(@input$buff, @status );
	CALL check$exception(status,NIL);
			
	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 Hostess 550 I/O 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 */
			IO$address = convert(@input$buff);

			/* Get Hostess 550 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;
			END;
		END;
	END;

load$driver:

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

	dinfo.interrupt$level = interrupt$level;
	local$dinfo.port$base = 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,
							@(11,'H550DRV_JOB'),@status);
	IF status = E$CONTEXT THEN
	DO;
		CALL rq$uncatalog$object(HI$job$t,
									@(11,'H550DRV_JOB'),@status);
		CALL rq$catalog$object(HI$job$t,parent$job$t,
									@(11,'H550DRV_JOB'),@status);
	END;

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

	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 h550drv;