mc:
	proc;

	/*
		Direct MP/M Call Test Program (Cont'd)
		--------------------------------------

		Refer to the comment at the beginning of the
	MPMCALLS PLI program.
*/

	/* external MP/M I/O entry points */
	/* (note: each source line begins with tab chars) */

    %replace
	true   by '1'b,
	false  by '0'b;

%include 'mpmdio.dcl';

	dcl
		sysin file,
		oldpriority fixed(7),
		v char(254) var,
		i fixed;

	dcl
		pdadr ptr,
		1 pd based (pdadr),
		  2 link ptr,
		  2 status fixed(7),
		  2 priority fixed(7),
		  2 stkptr ptr,
		  2 name char(8),
		  2 console fixed(7),
		  2 memseg fixed(7),
		  2 b fixed(15),
		  2 thread ptr,
		  2 dmadr ptr,
		  2 slct bit(8);
	/*	  2 dcnt fixed(15),
		  2 searchl fixed(7),
		  2 searcha ptr,
		  2 drvact bit(16),
		  2 registers (20) fixed(7),
		  2 scratch fixed(15);
	*/

	pdadr = rpdadr();   /* get current running pd adr */
	oldpriority = pd.priority;

	dcl
		upper char(27) static initial
		    ('ABCDEFGHIJKLMNOPQRSTUVWXYZ '),
		lower char(27) static initial
		    ('abcdefghijklmnopqrstuvwxyz ');


	/**********************************
	*                                 *
	* Local procedures used during    *
	*  testing.                       *
	*                                 *
	**********************************/

	clresptest:
		proc (stringadr) returns (ptr);
		dcl
		    stringadr ptr,
		    string based (stringadr) char(27);

		put edit ('->STRING proc passed: ',string)
                         (skip,a,a(27));
		return (addr (lower));
		end clresptest;


	/**********************************
	*                                 *
	* Delay Test:                     *
	*                                 *
	**********************************/

	put skip(2) list ('Delay Test:');
	put skip list ('->a dot will be printed each second');
	put list ('for ten seconds ');
	do i = 1 to 10;
	    call delay (60);
	    put edit ('.') (a);
	end;

	/**********************************
	*                                 *
	* Disptach Test:                  *
	*                                 *
	**********************************/

	put skip(2) list ('Dispatch Test:');
	call dsptch();
	put skip list ('->dispatch successful.');

	/**********************************
	*                                 *
	* Console Tests:                  *
	*   ATTCON, DETCON already tested *
	*   SETCON not tested             *
	*   ASNCON tested in send CLI cmd *
	*   GETCON                        *
	*                                 *
	**********************************/

	put skip(2) list ('Console Test:');
	put edit ('->current console is #',getcon())
	         (skip,a,f(2));

	/**********************************
	*                                 *
	* Send CLI Command Test:          *
	*   This example shows how to run *
	*   a program in another memory   *
	*   segment and then get the con- *
	*   sole back to the main program.*
	*   E.G. as in a menu driven      *
	*   application.                  *
	*                                 *
	**********************************/
	dcl
		1 clicmd,
		  2 dslct bit(8),  /* default disk / user code */
		  2 console fixed(7),  /* console number */
		  2 line char(128);
	dcl
		1 apb static,
		  2 console fixed(7),
		  2 name char(8) initial ('cli     '),
		  2 match bit(8) initial ('00'b4);

	put skip(2) list ('Send CLI Command Test:');
	on endfile (sysin)
	    go to clresptst;
	pdadr = rpdadr();   /* get current running pd adr */
	oldpriority = pd.priority;
	clicmd.dslct = pd.slct;
	clicmd.console = pd.console;
	apb.console = pd.console;
	do while (true);
	    put skip list ('  Enter CLI Command: ');
	    get edit (clicmd.line) (a);
	    if ~asncon (addr (apb)) then
	    do;
	        put skip list ('*** Failed to assign Cli the console ***');
	    end;
	    else
	    do;
	        call setpri (197);
	        call sclicd (addr (clicmd));
	        call attcon();
	        call setpri (oldpriority);
	    end;
	end;

	/**********************************
	*                                 *
	* Call Resident System Proc Test: *
	*                                 *
	**********************************/
	dcl
		1 cpb,
		  2 nameadr ptr,
		  2 paramadr ptr;
	dcl
		aparam ptr;
	dcl
		procname char(8) static initial ('STRING  ');
	dcl
		1 stringqcb static,
		  2 link fixed(15),
		  2 name char(8) initial ('STRING  '),
		  2 msglen fixed(15) initial (2),
		  2 nmbmsgs fixed(15) initial (1),
		  2 dqph ptr,
		  2 nqph ptr,
		  2 msgin ptr,
		  2 msgout ptr,
		  2 msgcnt fixed(15),
		  2 buffer ptr;
	dcl
		1 stringuqcb,
		  2 pointer ptr,
		  2 msgadr ptr;
	dcl
		stringprocadr entry (fixed) variable returns(ptr);
	dcl
		rtnstringadr ptr,
		rtnstring based (rtnstringadr) char(27);

	clresptst:
		get edit (v) (a);  /* clear input buffer */

	put skip(2) list ('Call Resident System Process Test:');
	call makque (addr (stringqcb));
	stringuqcb.pointer = addr (stringqcb);
	stringuqcb.msgadr = addr (stringprocadr);
	stringprocadr = clresptest;
	call wrque (addr (stringuqcb));
	cpb.nameadr = addr (procname);
	cpb.paramadr = addr (aparam);
	aparam = addr (upper);

	unspec (rtnstringadr) = clresp (addr (cpb));

	put edit ('->STRING proc returned:',rtnstring)
	         (skip,a,a(27));

	if ~delque (addr (stringqcb)) then
	do;
	    put skip list ('*** Unable to delete stringqcb ***');
	    call term ('0000'b4);
	end;
	put skip list ('->Call clresp test complete.');

	/**********************************
	*                                 *
	* Parse Filename Test:            *
	*                                 *
	**********************************/
	dcl
		done bit(1);
	dcl
		line char(80);
	dcl
		1 pfcb,
		  2 flname ptr,
		  2 fcb ptr;
	dcl
		delimptr ptr,
		delim based (delimptr) char(1);
	dcl
		oldptr ptr,
		old based (oldptr) char(10);
	dcl
		1 afcb,
		  2 name,
		    3 drive fixed(7),
		    3 fname char(8),
		    3 ftype char(3);

	put skip(2) list ('Parse Filename Test:');
	on endfile (sysin)
	    go to gettodtest;
	put skip list ('  Enter string of filenames to be parsed,');
	put list ('separated by commas:');
	do while (true);
	    put skip list ('->');
	    get edit (line) (a);
	    line = substr (line,1,index (line,' ')-1) || ascii (13);
	    pfcb.flname = addr (line);
	    pfcb.fcb = addr (afcb);
	    oldptr = addr (line);
	    done = false;
	    pfcb.flname = parse (addr (pfcb));
	    do while (~done & (unspec (pfcb.flname) ~= 'ffff'b4));
	        oldptr = pfcb.flname;
	        put edit ('  ',ascii (afcb.drive+64),': ',
	                  afcb.fname,' ',afcb.ftype)
	                 (skip,a,a,a,a(8),a,a(3));
	        if unspec (pfcb.flname) = '0000'b4 then
	        do;
	            done = true;
	        end;
	        else
	        do;
	            delimptr = pfcb.flname;
	            if delim = ',' then
	            do;
	                unspec (i) = unspec (pfcb.flname);
	                i = i + 1;
	                unspec (pfcb.flname) = unspec (i);
	            end;
	            pfcb.flname = parse (addr (pfcb));
	        end;
	    end;
	    if ~done then
	    do;
	        put skip list ('  *** Bad Entry ***  ->');
	        put edit (old) (a(10));
	    end;
	end;

	/**********************************
	*                                 *
	* Time and Date Test:             *
	*                                 *
	**********************************/
	dcl
		1 tod,
		  2 date fixed(15),
		  2 time,
		    3 hour bit(8),
		    3 min bit(8),
		    3 sec bit(8);

	gettodtest:
		get edit (v) (a);  /* clear input buffer */

	put skip(2) list ('Time and Date Test:');
	call gettod (addr (tod));
	put edit ('-> ',tod.date,'  ',tod.hour,':',tod.min,':',tod.sec)
	         (skip,a,f(5),a,b4(2),a,b4(2),a,b4(2));


	end mc;
