diotst: proc options(main); /* external CP/M I/O entry points */ /* (note: each source line begins with tab chars) */ %include 'diomod.dcl'; dcl c char(1), v char(254) var, i fixed; /********************************** * * * Fixed Location Tests: * * MEMPTR, MEMSIZ, MEMWDS, * * DFCB0, DFCB1, DBUFF * * * **********************************/ dcl memptrv ptr, memsizv fixed, (dfcb0v, dfcb1v, dbuffv) ptr, command char(127) var based (dbuffv), 1 fcb0 based(dfcb0v), 2 drive fixed(7), 2 name char(8), 2 type char(3), 2 extnt fixed(7), 2 space (19) bit(8), 2 cr fixed(7), memory (0:0) based(memptrv) bit(8); memptrv = memptr(); memsizv = memsiz(); dfcb0v = dfcb0(); dfcb1v = dfcb1(); dbuffv = dbuff(); put edit ('Command Tail: ',command) (a); put edit ('First Default File:', fcb0.name,'.',fcb0.type) (skip,4a); put edit ('dfcb0 ',unspec(dfcb0v), 'dfcb1 ',unspec(dfcb1v), 'dbuff ',unspec(dbuffv), 'memptr',unspec(memptrv), 'memsiz',unspec(memsizv), 'memwds',memwds()) (5(skip,a(7),b4),skip,a(7),f(6)); put skip list('Clearing Memory'); /* sample loop to clear mem */ do i = 0 repeat(i+1) while (i^=memsizv-1); memory (i) = '00'b4; end; /********************************** * * * REBOOT Test * * * **********************************/ put skip list ('Reboot? (Y/N)'); get list (c); if translate(c,'Y','y') = 'Y' then call reboot(); /********************************** * * * RDCON, WRCON Test * * * **********************************/ put list('Type Input, End with "$" '); v = '^m^j'; do while (substr(v,length(v)) ^= '$'); v = v || rdcon(); end; put skip list('You Typed:'); do i = 1 to length(v); call wrcon(substr(v,i,1)); end; /********************************** * * * RDRDR and WRPUN Test * * * **********************************/ put skip list('Reader to Punch Test?(Y/N)'); get list (c); if translate(c,'Y','y') = 'Y' then do; put skip list('Copying RDR to PUN until ctl-z'); c = ' '; do while (c ^= '^z'); c = rdrdr(); if c ^= '^z' then call wrpun(c); end; end; /********************************** * * * WRLST Test * * * **********************************/ put list('List Output Test?(Y/N)'); get list(c); if translate(c,'Y','y') = 'Y' then do i = 1 to length(v); call wrlst(substr(v,i,1)); end; /********************************** * * * Direct I/O, CONOUT, CONINP * * * **********************************/ put list ('Direct I/O, Type Line, End with Line Feed'); c = ' '; do while (c ^= '^j'); call conout(c); c = coninp(); end; /********************************** * * * Direct I/O, Console Status * * RDSTAT * * * **********************************/ put skip list('Status Test, Type Character'); do while (^rdstat()); end; /* clear the character */ c = coninp(); /********************************** * * * GETIO, SETIO IObyte * * * **********************************/ dcl iobyte bit(8); iobyte = getio(); put edit ('IObyte is ',iobyte, ', New Value: ') (skip,a,b4,a); get edit (iobyte) (b4(2)); call setio(iobyte); /********************************** * * * Buffered Write, WRSTR Test * * * **********************************/ put list('Buffered Output Test:'); /* "v" was previously filled by RDCON */ call wrstr(addr(v)); /********************************** * * * Buffered Read RDBUF Test * * * **********************************/ dcl 1 inbuff static, 2 maxsize bit(8) init('80'b4), 2 inchars char(127) var; put skip list('Line Input, Type Line, End With Return'); put skip; call rdbuf(addr(inbuff)); put skip list('You Typed: ',inchars); /********************************** * * * Console BREAK Test * * * **********************************/ put skip list('Console Break Test, Type Character'); do while(^break()); end; c = rdcon(); /********************************** * * * Version Number VERS Test * * * **********************************/ dcl version bit(16); version = vers(); if substr(version,1,8) = '00'b4 then put skip list('CP/M'); else put skip list('MP/M'); put edit(' Version ',substr(version,9,4), '.',substr(version,13,4)) (a,b4,a,b4); /********************************** * * * Disk System RESET Test * * * **********************************/ put skip list('Resetting Disk System'); call reset(); /********************************** * * * Disk SELECT Test * * * **********************************/ put skip list('Select Disk # '); get list(i); call select(i); /********************************** * * * Note: The OPEN, CLOSE, SEAR, * * SEARN, DELETE, RDSEQ, * * WRSEQ, MAKE, and RENAME * * functions are tested in the * * DIOCOPY program * * * **********************************/ /********************************** * * * LOGVEC and CURDSK * * * **********************************/ put skip list ('Login Vector', logvec(),'Current Disk', curdsk()); /********************************** * * * See DIOCOPY for SETDMA Function * * * **********************************/ /********************************** * * * Allocate Vector ALLVEC Test * * * **********************************/ dcl alloc (0:30) bit(8) based (allvec()), allvecp ptr; allvecp = allvec(); put edit('Alloc Vector at ', unspec(allvecp),':', (alloc(i) do i=0 to 30)) (skip,a,b4,a,254(skip,4(b,x(1)))); /********************************** * * * Note: the following functions * * apply to version 2.0 or newer. * * * **********************************/ /********************************** * * * WPDISK Test * * * **********************************/ put skip list('Write Protect Disk?(Y/N)'); get list(c); if translate(c,'Y','y') = 'Y' then call wpdisk(); /********************************** * * * ROVEC Test * * * **********************************/ put skip list('Read/Only Vector is',rovec()); /********************************** * * * Disk Parameter Block Decoding * * Using GETDPB * * * **********************************/ dcl dpbp ptr, 1 dpb based (dpbp), 2 spt fixed(15), 2 bsh fixed(7), 2 blm bit(8), 2 exm bit(8), 2 dsm bit(16), 2 drm bit(16), 2 al0 bit(8), 2 al1 bit(8), 2 cks bit(16), 2 off fixed(7); dpbp = getdpb(); put edit('Disk Parameter Block:', 'spt',spt,'bsh',bsh,'blm',blm, 'exm',exm,'dsm',dsm,'drm',drm, 'al0',al0,'al1',al1,'cks',cks, 'off',off) (skip,a,2(skip,a(4),f(6)), 4(skip,a(4),b4), skip,2(a(4),b,x(1)), skip,a(4),b4, skip,a(4),f(6)); /********************************** * * * Test Get/Set user Code * * GETUSR, SETUSR * * * **********************************/ put skip list ('User is',getusr(),', New User:'); get list(i); call setusr(i); /********************************** * * * FILSIZ, SETREC, * * RDRAN, WRRAN, WRRANZ are * * tested in DIORAND * * * **********************************/ /********************************** * * * Test Drive Reset RESDRV * * (version 2.2 or newer) * * * **********************************/ dcl drvect bit(16); put list('Drive Reset Vector:'); get list(drvect); call resdrv(drvect); /********************************** * * * * **********************************/ end diotst;