mpmtst: proc options(main); dcl mc entry; /* Direct MP/M Call Test Program ----------------------------- The purpose of the MPMCALLS and MPMCALLC PLI programs is to demonstrate direct MP/M calls from PLI. The following instructions outline the steps to assemble, compile, link and execute this test program. 1.) Compile the PLI programs as follows: >pli mpmcalls $pl >pli mpmcallc $pl 2.) Assemble the mpmdio.asm module: >rmac mpmdio 3.) Link the mpmcalls and mpmdio modules: >link mpmcalls,mpmcallc,mpmdio 4.) Gensys your MP/M system as follows: Top .... = ff Number of con.. = 1 Add system call ... ? n Bank switched mem... ? n :0 :a0 :ff 5.) Execute the mpmcalls program: 0A>mpmcalls */ /* 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 vers entry returns (bit(16)); dcl sysin file, version bit(16), 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); */ dcl 1 localpd static, 2 link ptr, 2 status fixed(7), 2 priority fixed(7), 2 stkptr ptr, 2 name char(8) initial ('LocalPD '), 2 console fixed(7), 2 memseg fixed(7), 2 b fixed(15), 2 thread ptr, 2 dmadr ptr, 2 slct fixed(7), 2 dcnt fixed(15), 2 searchl fixed(7), 2 searcha ptr, 2 drvact bit(16), 2 registers (20) fixed(7), 2 scratch fixed(15); dcl localstk (0:255) entry (fixed) variable; dcl sysdatpgadr ptr, 1 sysdatpg based (sysdatpgadr), 2 memtop bit(8), 2 nmbcns fixed(7), 2 brkptrst fixed (7), 2 syscallstks bit(8), 2 bankswitched bit(8); /* 2 z80cpu bit(8), 2 bankedbdos bit(8), 2 basebankedbdos ptr; */ dcl upper char(27) static initial ('ABCDEFGHIJKLMNOPQRSTUVWXYZ '), lower char(27) static initial ('abcdefghijklmnopqrstuvwxyz '); /********************************** * * * Local procedures used during * * testing. * * * **********************************/ flagtest: proc; dcl boolean bit(1); call attcon(); boolean = flgwt (30); put skip list ('-> flagtest wait on #30 complete.'); call detcon(); boolean = flgset (31); call term ('ffff'b4); end flagtest; queuetest: proc; dcl 1 qcbB static, 2 link fixed(15), 2 name char(8) initial ('QueueB '), 2 msglen fixed(15) initial (10), 2 nmbmsgs fixed(15) initial (2), 2 dqph ptr, 2 nqph ptr, 2 msgin ptr, 2 msgout ptr, 2 msgcnt fixed(15), 2 buffer (2), 3 lnk ptr, 3 char(10); dcl 1 uqcbA static, 2 pointer ptr, 2 msgadr ptr, 2 name char(8) initial ('QueueA '); dcl 1 uqcbB, 2 pointer ptr, 2 msgadr ptr; dcl msgA char(10), msgB char(10); uqcbA.msgadr = addr (msgA); uqcbB.pointer = addr (qcbB); uqcbB.msgadr = addr (msgB); call makque (addr (qcbB)); do while (~opnque (addr (uqcbA))); call delay (1); /* until qcbA created */ end; do while (true); call rdque (addr (uqcbA)); msgB = translate (msgA,upper,lower); call wrque (addr (uqcbB)); end; end queuetest; /************************************************** *************************************************** ******** ******** ******** M a i n P r o g r a m ******** ******** ******** *************************************************** **************************************************/ /********************************** * * * Verify Operation Under MP/M * * Without Banked Memory. * * * **********************************/ version = vers(); if substr (version,1,8) = '00'b4 then do; put skip list ('Tests cannot run under CP/M.'); call term('0000'b4); end; sysdatpgadr = sysdat (); if sysdatpg.bankswitched = 'FF'b4 then do; put skip list ('Tests cannot run under MP/M'); put list ('with bank switched memory.'); call term('0000'b4); end; if sysdatpg.syscallstks = 'FF'b4 then do; put skip list ('Tests cannot run under MP/M'); put list ('with system call user stacks.'); call term('0000'b4); end; pdadr = rpdadr(); /* get current running pd adr */ oldpriority = pd.priority; /********************************** * * * Memory Management Tests: * * AMEMRQ, RMEMRQ, MEMFR * * * **********************************/ dcl 1 memdscr, 2 base fixed (7), /* base page */ 2 size fixed (7), /* # of pages */ 2 attrib fixed (7), /* attributes */ 2 bank fixed (7); /* bank byte */ on endfile (sysin) go to rmemrqtst; put skip list ('Memory Management Tests:'); do while (true); put skip(2) list (' Absolute Request'); put skip list (' Base (xx in hex) = '); i = pd.memseg; /* save old memseg index */ get edit (unspec (memdscr.base)) (b4(2)); if amemrq (addr (memdscr)) then do; put skip list (' Absolute Request satisfied.'); put edit (' Base = ',unspec (memdscr.base),'H') (skip,a,b4,a); put edit (' Size = ',unspec (memdscr.size),'H') (skip,a,b4,a); put edit (' Attr = ',unspec (memdscr.attrib),'H') (skip,a,b4,a); put edit (' Bank = ',unspec (memdscr.bank),'H') (skip,a,b4,a); call memfr (addr (memdscr)); pd.memseg = i; /* restore former memseg index */ end; else do; put skip list (' Absolute Request failed.'); end; end; rmemrqtst: get edit (v) (a); /* clear input buffer */ on endfile (sysin) go to polltst; do while (true); put skip(2) list (' Relocatable Request'); put skip list (' Size (xxh) = '); i = pd.memseg; /* save old memseg index */ get edit (unspec (memdscr.size)) (b4(2)); if rmemrq (addr (memdscr)) then do; put skip list (' Relocatable Request satisfied.'); put edit (' Base = ',unspec (memdscr.base),'H') (skip,a,b4,a); put edit (' Size = ',unspec (memdscr.size),'H') (skip,a,b4,a); put edit (' Attr = ',unspec (memdscr.attrib),'H') (skip,a,b4,a); put edit (' Bank = ',unspec (memdscr.bank),'H') (skip,a,b4,a); call memfr (addr (memdscr)); pd.memseg = i; /* restore former memseg index */ end; else do; put skip list (' Relocatable Request failed.'); end; end; /********************************** * * * Poll Tests: * * The poll call cannot be tested * * unless the poll device table * * in the XIOS is known. * * * **********************************/ polltst: get edit (v) (a); /* clear input buffer */ /* The following code is "commented out" call poll (devicenumber); put edit ('Device ',devicenumber,'is ready.') (skip,a,f,a); End of "commented out" code */ put skip(2) list ('Poll call not tested.'); /********************************** * * * Flag Tests: * * FLGWT, FLGSET * * * * Note: this test assumes that * * flags 30 & 31 are unused. * * * **********************************/ dcl flagover bit(1), flagunder bit(1); unspec (localpd.link) = '0000'b4; localpd.priority = 100; localpd.stkptr = addr (localstk(255)); localpd.console = pd.console; localpd.memseg = pd.memseg; localstk(255) = flagtest; call crproc (addr (localpd)); put skip(2) list ('Flag Tests:'); call setpri (101); call detcon(); flagover = ~flgset (30); call attcon(); call setpri (oldpriority); flagunder = ~flgwt (31); if flagover then put skip list ('-> flag over-run.'); if flagunder then put skip list ('-> flag under-run.'); put skip list ('-> flag tests successful.'); /********************************** * * * Queue Management Tests: * * MAKQUE,OPNQUE,DELQUE * * RDQUE,CRDQUE,WRQUE,CWRQUE * * * **********************************/ dcl 1 qcbA static, 2 link fixed(15), 2 name char(8) initial ('QueueA '), 2 msglen fixed(15) initial (10), 2 nmbmsgs fixed(15) initial (2), 2 dqph ptr, 2 nqph ptr, 2 msgin ptr, 2 msgout ptr, 2 msgcnt fixed(15), 2 buffer (2), 3 lnk ptr, 3 char(10); dcl 1 uqcbA, 2 pointer ptr, 2 msgadr ptr; dcl 1 uqcbB static, 2 pointer ptr, 2 msgadr ptr, 2 name char(8) initial ('QueueB '); dcl msgA char(10), msgB char(10); put skip(2) list ('Queue Tests:'); on endfile (sysin) go to abtsprtest; uqcbA.pointer = addr (qcbA); uqcbA.msgadr = addr (msgA); uqcbB.msgadr = addr (msgB); call makque (addr (qcbA)); put skip(2) list (' Testing Conditional Write Queue'); do i = 1 to 10 while (cwrque (addr (uqcbA))); put edit (' Message #',i) (skip,a,f(2)); end; put skip list (' Queue is full.'); put skip(2) list (' Testing Conditional Read Queue'); do i = 1 to 10 while (crdque (addr (uqcbA))); put edit (' Message #',i) (skip,a,f(2)); end; put skip list (' Queue is empty.'); unspec (localpd.link) = '0000'b4; localpd.priority = 100; localpd.stkptr = addr (localstk(255)); localpd.console = pd.console; localpd.memseg = pd.memseg; localstk(255) = queuetest; call crproc (addr (localpd)); do while (~opnque (addr (uqcbB))); call delay (1); /* until qcbB created */ end; put skip list (' Enter char(10) message:'); do while (true); put skip list ('->'); get edit (msgA) (a); call wrque (addr (uqcbA)); call rdque (addr (uqcbB)); put edit ('<-',msgB) (skip,a,a(10)); end; /********************************** * * * Abort Specified Process Test: * * * **********************************/ dcl 1 abtpb static, 2 pda bit(16) initial ('0000'b4), 2 termcode bit(16) initial ('ffff'b4), 2 name char(8) initial ('LocalPD '), 2 console fixed(7); abtsprtest: get edit (v) (a); /* clear input buffer */ put skip(2) list ('Abort Specified Process Test:'); put skip list (' Aborting LocalPD.'); abtpb.console = pd.console; if abtspr (addr (abtpb)) then do; put skip list ('->Abort successful'); end; else do; put skip list ('->Abort Failed'); go to error; end; if ~delque (addr (qcbA)) then do; put skip list ('*** Unable to delete QueueA ***'); call term('0000'b4); end; if ~delque (uqcbB.pointer) then do; put skip list ('*** Unable to delete QueueB ***'); call term('0000'b4); end; /********************************** *********************************** **** **** **** Call pli procedure **** **** "mc" for other tests **** **** **** *********************************** **********************************/ call mc(); /********************************** * * * Termination Test: * * * **********************************/ put skip(2) list ('Termination Test:'); call term ('0000'b4); /********************************** * * * Unrecoverable Error: * * * **********************************/ error: put skip list ('*** Unrecoverable Error ***'); call disabl(); do while (true); end; end mpmtst;