(*
**	SYSID.PAS
**
**	Version 4.4
**
**	Usage:	[d:][path]SYSID
**
**	A system description for DOS-based PC/XT/AT- and PS/2-class machines.
**	SYSID generates 16 screens of information about the host system and runs
**	under DOS versions 3.0 and later.
**
**	My primary sources of ideas in SYSID were Ray Duncan's "Advanced MS-DOS"
**	and Terry Dettman's "DOS Programmer's Reference."  The ideas of Prakash
**	Chandra, Terje Mathisen, Bob Smith, and others appear in various places.
**
**	Some of the techniques SYSID uses are not documented or officially
**	supported by either IBM or Microsoft.  Where possible I have followed the
**	undocumented routine with a comment describing my source for the
**	technique.
**
**	SYSID was developed on an IBM PC with Turbo Pascal 5.0, Turbo Assembler
**	1.0, and DOS 3.30.  The source code has been split into two files:
**
**		SYSID.PAS	- this file
**		SYSID.ASM	- assembly language procedures
**
**	Known bugs:
**		1)	Page 2:  The CPU test for interrupts of multi-prefix string
**			instructions is reliable only on machines whose clock speeds are
**			less than about 15 MHz.  The 8086 and 8088 are the only CPU's that
**			don't handle such interrupts correctly, however, and they aren't
**			(to my knowledge) ever run at anything like 15 MHz.  (This 15 MHz
**			limit assumes that the timer tick interrupt occurs at the standard
**			rate of 18.2 Hz.  SYSID could check that, too, I suppose.)
**		2)	Page 5:  The description of foreground color will not mention the
**			blinking attribute, even if it was enabled before you invoked
**			SYSID.
**		3)	Page 10:  SYSID used to report incorrectly the statuses of some of
**			the executable files which use the "multiplex interrupt" (INT
**			2FH).  I have commented these status checks out of the source
**			code, determined to do battle with them another day.  Can anyone
**			supply the correct INT 2FH functions for these files?  Or are some
**			of them red herrings that simply check INT 2FH to see if *other*
**			files have been loaded (e.g. APPEND/ASSIGN)?
**		4)	The error beep sometimes fails to sound when you press PgDn while
**			on the last page (or PgUp while on the first page).  I have no
**			idea why.
**
**	Both the source and object code of SYSID are hereby released into the
**	public domain.  Neither version carries any warranty, expressed or
**	implied, of merchantability or fitness for a particular purpose.
**
**	Comments, suggestions, and questions may be addressed to:
**		BIXMail: sjgrant
**		CompuServe: 71101,706
**
**	Steve Grant
**	Long Beach, CA
**	January 13, 1989
*)

(*$A-*)
(*$B-*)
(*$D-*)
(*$F-*)
(*$I-*)
(*$M 16384, 0, 655360*)
(*$N-*)
(*$O-*)
(*$R-*)
(*$S-*)
(*$V-*)

program SYSID;

uses
	crt,
	dos,
	graph;

const
	BIOSdseg = $0040;
	pgmax = 16;
	pchar = [' '..'~'];
	secsiz = 512;
	tick1 = 1193180;

type
	cpu_info_t = record
		cpu_type : byte;
		MSW : word;
		GDT : array[1..6] of byte;
		IDT : array[1..6] of byte;
		intflag : boolean;
		ndp_type : byte;
		ndp_cw : word
	end;

var
	attrsave : byte;
	country : array[0..33] of byte;
	currdrv : byte;
	devofs : word;
	devseg : word;
	dirsep : set of char;
	DOScofs : word;
	DOScseg : word;
	DOSmem : longint;
	equip : word;
	graphdriver : integer;
	i : word;
	intvec : array[$00..$FF] of pointer;
	lastdrv : byte;
	osmajor : byte;
	osminor : byte;
	pg : 1..pgmax;
	regs : registers;
	switchar : char;
	tlength : byte;
	twidth : byte;
	vidpg : byte;
	x1 : byte;
	x2 : byte;
	xbool1 : boolean;
	xbool2 : boolean;
	xchar1 : char;
	xchar2 : char;
	xword : word;

(*$L SYSID*)

procedure caption1(a : string);

begin
	textcolor(lightgray);
	write(a);
	textcolor(lightgreen)
end;

procedure caption2(a : string);

const
	capterm = ': ';

var
	i : byte;
	xbool : boolean;

begin
	i := length(a);
	while (i > 0) and (a[i] = ' ') do
		dec(i);
	insert(capterm, a, i + 1);
	caption1(a)
end;

function nocarry : boolean;

begin
	nocarry := regs.flags and fcarry = $0000
end;

function hex(a : word; b : byte) : string;

const
	digit : array[$0..$F] of char = '0123456789ABCDEF';

var
	i : byte;
	xstring : string;

begin
	xstring := '';
	for i := 1 to b do begin
		insert(digit[a and $000F], xstring, 1);
		a := a shr 4
	end;
	hex := xstring
end;

procedure unknown(a : string; b : word; c : byte);

begin
	writeln('(unknown', ' ', a, ' ', hex(b, c), ')')
end;

procedure caption3(a : string);

begin
	caption2('  ' + a)
end;

procedure yesorno(a : boolean);

begin
	if a then
		writeln('yes')
	else
		writeln('no')
end;

procedure dontknow;

begin
	writeln('(unknown)')
end;

procedure segofs(a, b : word);

begin
	write(hex(a, 4), ':', hex(b, 4))
end;

function showchar(a : char) : char;

begin
	if a in pchar then
		showchar := a
	else
		showchar := '.'
end;

procedure pause1;

var
	xbyte : byte;
	xchar : char;

begin
	xbyte := textattr;
	textcolor(green);
	write('(continued)');
	repeat
		xchar := readkey
	until not keypressed;
	textattr := xbyte
end;

procedure pause2;

var
	xbyte : byte;
	xchar : char;

begin
	if wherey + hi(windmin) > hi(windmax) then begin
		xbyte := textattr;
		textcolor(green);
		write('(continued)');
		repeat
			xchar := readkey
		until not keypressed;
		clrscr;
		writeln('(continued)');
		textattr := xbyte
	end
end;

function bin4(a : byte) : string;

const
	digit : array[0..1] of char = '01';

var
	xstring : string;
	i : byte;

begin
	xstring := '';
	for i := 3 downto 0 do begin
		insert(digit[a mod 2], xstring, 1);
		a := a shr 1
	end;
	bin4 := xstring
end;

procedure offoron(a : string; b : boolean);

begin
	caption3(a);
	if b then
		writeln('on')
	else
		writeln('off')
end;

procedure zeropad(a : word);

begin
	if a < 10 then
		write('0');
	write(a)
end;

procedure showvers;

var
	xchar : char;

begin
	xchar := chr(country[9]);
	if osmajor > 0 then begin
		write(osmajor, xchar);
		zeropad(osminor);
		writeln
	end else
		writeln('1', xchar, 'x')
end;

function cbw(a, b : byte) : word;

begin
	cbw := b shl 8 + a
end;

function bin16(a : word) : string;

function bin8(a : byte) : string;

begin
	bin8 := bin4(a shr 4) + '_' + bin4(a and $0F)
end;

begin (* procedure bin16 *)
	bin16 := bin8(hi(a)) + '_' + bin8(lo(a))
end;

procedure drvname(a : byte);

begin
	write(chr(ord('A') + a), ': ')
end;

procedure media(a : byte);

procedure diskette(a, b : byte);

begin
	writeln('diskette (', a, '-sided, ', b, ' sectors)')
end;

begin (* procedure media *)
	caption3('Media');
	case a of
		$FF : diskette(2, 8);
		$FE : diskette(1, 8);
		$FD : diskette(2, 9);
		$FC : diskette(1, 9);
		$F9 : diskette(2, 15);
		$F8 : writeln('fixed disk')
		else
			unknown('media', a, 2)
	end
end;

procedure init;

const
	qversion = 'Version 4.4';

var
	xint : integer;

procedure rjustify(a : string);

begin
	gotoxy(1 + lo(windmax) - length(a), wherey);
	write(a)
end;

procedure border;

const
	ch = 'Í';

var
	i : byte;

begin
	for i := 1 to twidth - 1 do
		write(ch)
end;

begin (* procedure init *)
	attrsave := textattr;
	with regs do begin
		AH := $0F;
		intr($10, regs);
		twidth := AH;
		vidpg := BH
	end;
	detectgraph(graphdriver, xint);
	if (graphdriver = EGA) or (graphdriver = MCGA)
		or (graphdriver = VGA) then
		with regs do begin
			AX := $1130;
			BH := $00;
			intr($10, regs);
			tlength := DL + 1
		end
	else
		tlength := 25;
	with regs do begin
		intr($11, regs);
		equip := AX;
		intr($12, regs);
		DOSmem := longint(AX) shl 10;
		AH := $19;
		MSDOS(regs);
		currdrv := AL
	end;
	with regs do begin
		AH := $34;
		MSDOS(regs);
		DOScseg := ES;
		DOScofs := BX
	end;
	for i := $00 to $FF do
		getintvec(i, intvec[i]);
	intvec[$00] := saveint00;
	intvec[$02] := saveint02;
	intvec[$1B] := saveint1B;
	intvec[$23] := saveint23;
	intvec[$24] := saveint24;
	intvec[$34] := saveint34;
	intvec[$35] := saveint35;
	intvec[$36] := saveint36;
	intvec[$37] := saveint37;
	intvec[$38] := saveint38;
	intvec[$39] := saveint39;
	intvec[$3A] := saveint3A;
	intvec[$3B] := saveint3B;
	intvec[$3C] := saveint3C;
	intvec[$3D] := saveint3D;
	intvec[$3E] := saveint3E;
	intvec[$3F] := saveint3F;
	intvec[$75] := saveint75;
	with regs do begin
		AX := $3700;
		MSDOS(regs);
		switchar := chr(DL)
	end;
	dirsep := ['\'];
	if switchar <> '/' then
		dirsep := dirsep + ['/'];
	with regs do begin
		AH := $52;
		MSDOS(regs);
		devseg := ES;
		devofs := BX
	end;
	lastdrv := mem[devseg : devofs + $0021];
	textbackground(black);
	window(1, 1, twidth, tlength);
	clrscr;
	textcolor(green);
	write('SYSID');
	textcolor(lightgray);
	write(' - System description for IBM PC''s and compatibles');
	rjustify(qversion);
	writeln;
	border;
	gotoxy(1, tlength - 1);
	border;
	writeln;
	write('Page ');
	x1 := wherex;
	write(pgmax, ' of ', pgmax);
	textcolor(green);
	rjustify('PgDn PgUp Home End Esc');
	x2 := wherex;
	pg := 1
end;

procedure CPUID(var a : cpu_info_t);

external;

function diskread(drive : byte; starting_sector, number_of_sectors : word
	; var buffer) : word;

external;

procedure page_01;

const
	BIOScseg = $C000;
	BIOSext = $AA55;
	PCROMseg = $F000;

var
	xbool : boolean;
	xbyte : byte;
	xchar : char;
	xlong : longint;
	xword1 : word;
	xword2 : word;

function BIOSscan(a, b, c : word; var d : word) : boolean;

const
	max = 3;
	notice : array[1..max] of string = ('(C)', 'COPR.', 'COPYRIGHT');

var
	i : 1..max;
	len : byte;
	target : string;
	xbool : boolean;
	xlong : longint;
	xword : word;

function scan(a : string; b, c, d : word; var e : word) : boolean;

var
	i : longint;
	j : byte;
	len : byte;
	xbool1 : boolean;
	xbool2 : boolean;

begin
	i := c;
	len := length(a);
	xbool1 := false;
	repeat
		if i <= longint(d) - len + 1 then begin
			j := 0;
			xbool2 := false;
			repeat
				if j < len then
					if upcase(chr(mem[b : i + j])) = a[j + 1] then
						inc(j)
					else begin
						xbool2 := true;
						inc(i)
					end
				else begin
					xbool2 := true;
					xbool1 := true;
					e := i;
					scan := true
				end
			until xbool2
		end else begin
			xbool1 := true;
			scan := false
		end
	until xbool1
end;

begin (* function BIOSscan *)
	xlong := c;
	xbool := false;
	for i := 1 to max do begin
		target := notice[i];
		len := length(target);
		if xbool then
			xlong := longint(xword) - 2 + len;
		if (xlong >= b) and (xlong <= c) and (scan(target, a, b, xlong, xword))
			then
			xbool := true
	end;
	if xbool then begin
		while (xword > b) and (chr(mem[a : xword - 1]) in pchar) do
			dec(xword);
		d := xword
	end;
	BIOSscan := xbool
end;

procedure showBIOS(a, b : word);

var
	xbool : boolean;
	xchar : char;

begin
	xbool := false;
	repeat
		xchar := chr(mem[a : b]);
		if xchar in pchar then begin
			write(xchar);
			if b < $FFFF then
				inc(b)
			else
				xbool := true
		end else
			xbool := true
	until xbool;
	writeln
end;

begin (* procedure page_01 *)
	caption2('Machine type');
	with regs do begin
		AH := $C0;
		intr($15, regs);
		if nocarry then begin
			xword1 := memw[ES : BX + 2];
			if (xword1 = $00FC) or (xword1 = $01FC) then
				writeln('PC-AT 3x9')
			else if (xword1 = $00FB) or (xword1 = $01FB) then
				writeln('PC-XT/2')
			else if xword1 = $02FC then
				writeln('PC-XT/286')
			else if xword1 = $00F9 then
				writeln('PC-Convertible')
			else if xword1 = $00FA then
				writeln('PS/2 Model 30')
			else if xword1 = $04FC then
				writeln('PS/2 Model 50')
			else if xword1 = $05FC then
				writeln('PS/2 Model 60')
			else if (xword1 = $04F8) or (xword1 = $09F8) then
				writeln('PS/2 Model 70')
			else if (xword1 = $00F8) or (xword1 = $01F8) then
				writeln('PS/2 Model 80')
			else if xword1 = $06FC then
				writeln('7552 Gearbox')
			else
				unknown('machine - model/type word', xword1, 4);
			caption3('BIOS revision level');
			writeln(mem[ES : BX + 4]);
			xbyte := mem[ES : BX + 5];
			caption3('DMA channel 3 used');
			yesorno(xbyte and $80 = $80);
			caption3('Slave 8259 present');
			yesorno(xbyte and $40 = $40);
			caption3('Real-time clock');
			yesorno(xbyte and $20 = $20);
			caption3('Keyboard intercept available');
			yesorno(xbyte and $10 = $10);
			caption3('Wait for external event available');
			yesorno(xbyte and $08 = $08);
			caption3('Extended BIOS data area segment');
			if xbyte and $04 = $04 then begin
				AH := $C1;
				intr($15, regs);
				if nocarry then
					writeln(hex(ES, 4))
				else
					dontknow
			end else
				writeln('(none)');
			caption3('Micro Channel');
			yesorno(xbyte and $02 = $02)
		end else begin
			xbyte := mem[$FFFF : $000E];
			case xbyte of
				$FF : writeln('PC');
				$FE : writeln('PC-XT');
				$FD : writeln('PCjr');
				$FC : writeln('PC-AT')
				else
					unknown('machine - model byte', xbyte, 2)
			end
		end
	end;
(*	Byte 12:12 p. 174  *)
	caption2('BIOS source');
	if BIOSscan(PCROMseg, $E000, $FFFF, xword1) then
		showBIOS(PCROMseg, xword1)
	else
		dontknow;
	caption2('BIOS date');
	i := $0005;
	xbool := false;
	xchar := chr(mem[$FFFF : i]);
	while (i < $0010) and (xchar in pchar) do begin
		xbool := true;
		write(xchar);
		inc(i);
		xchar := chr(mem[$FFFF : i])
	end;
	if xbool then
		writeln
	else
		dontknow;
	caption2('BIOS extensions');
	xword1 := BIOScseg;
	xbool := false;
	for i := 0 to 23 do begin
		if (memw[xword1 : 0] = BIOSext) then begin
			if not xbool then begin
				writeln;
				window(3, wherey + hi(windmin), twidth, tlength - 2);
				caption1('Segment   Copyright notice');
				writeln;
				xbool := true
			end;
			pause2;
			write(hex(xword1, 4), '      ');
			if BIOSscan(xword1, $0000, $1FFF, xword2) then
				showBIOS(xword1, xword2)
			else
				dontknow
		end;
		inc(xword1, $0200)
	end;
	if not xbool then
		writeln('(none)')
end;

procedure page_02;

var
	cpu_info : cpu_info_t;

procedure showNDP(a : string; b : word);

begin
	writeln(a);
	caption2('  Infinity');
	case b and $1000 of
		$0000 : writeln('projective');
		$1000 : writeln('affine')
	end;
	caption2('  Rounding');
	case b and $0C00 of
		$0000 : writeln('to nearest or even');
		$0400 : writeln('down');
		$0800 : writeln('up');
		$0C00 : writeln('chop')
	end;
	caption2('  Precision');
	case b and $0300 of
		$0000 : writeln('24 bits');
		$0100 : writeln('(reserved)');
		$0200 : writeln('53 bits');
		$0300 : writeln('64 bits')
	end
end;

begin (* procedure page_02 *)
	caption2('CPU');
	CPUID(cpu_info);
	with cpu_info do begin
		case cpu_type of
			$00 : writeln('8088');
			$01 : writeln('8086');
			$02 : writeln('V20');
			$03 : writeln('V30');
			$04 : writeln('80188');
			$05 : writeln('80186');
			$06 : writeln('80286');
			$07 : writeln('80386')
			else
				unknown('CPU', cpu_type, 2)
		end;
		case cpu_type of
			$06..$07 : begin
				caption3('Machine State Word');
				writeln(hex(MSW, 4));
				caption3('Global Descriptor Table   ');
				for i := 1 to 6 do
					write(hex(GDT[i], 2), ' ');
				writeln;
				caption3('Interrupt Descriptor Table');
				for i := 1 to 6 do
					write(hex(IDT[i], 2), ' ');
				writeln
			end
		end;
		caption3('Interrupts acknowledged immediately after segment register'
			+ ' change');
		yesorno(intflag);
		caption2('Coprocessor');
		case ndp_type of
			$00 : writeln('none');
			$01 : showNDP('8087', ndp_cw);
			$02 : showNDP('80287', ndp_cw);
			$03 : showNDP('80387', ndp_cw)
			else
				unknown('coprocessor', ndp_type, 4)
		end
	end;
	caption2('Coprocessor enabled');
	yesorno(equip and $0002 = $0002)
end;

procedure page_03;

const
	EMMint = $67;
	qEMMdrvr = 'EMMXXXX0';

var
	EMMarray : array[$000..$3FF] of word;
	xlong : longint;
	xword1 : word;
	xword2 : word;
	xstring : string;

procedure EMMerr(a : byte);

begin
	case a of
		$80 : writeln('internal error in EMM software');
		$81 : writeln('malfunction in expanded memory hardware');
		$82 : writeln('memory manager busy');
		$83 : writeln('invalid handle');
		$84 : writeln('undefined function');
		$85 : writeln('no more handles available');
		$86 : writeln('error in save or restore of mapping context');
		$87 : writeln('not enough physical pages available');
		$88 : writeln('not enough free pages available');
		$89 : writeln('no pages requested');
		$8A : writeln('logical page outside range assigned to handle');
		$8B : writeln('invalid physical page number');
		$8C : writeln('page map hardware state save area full');
		$8D : writeln('mapping context already in save area');
		$8E : writeln('mapping context not in save area');
		$8F : writeln('undefined subfunction parameter')
		else
			unknown('expanded memory error', a, 2)
	end
end;

begin (* procedure page_03 *)
	caption2('Total conventional memory (bytes)');
	writeln(DOSmem : 6);
	caption2('Free conventional memory (bytes) ');
	writeln(DOSmem - longint(prefixseg) shl 4 : 6);
	caption2('Extended memory (bytes)        ');
	with regs do begin
		AH := $88;
		intr($15, regs);
		if nocarry then
			writeln(longint(AX) shl 10 : 8)
		else
			writeln('     N/A')
	end;
	caption2('Expanded memory');
	if longint(intvec[EMMint]) <> $00000000 then begin
		writeln;
		caption3('Interrupt vector');
		xlong := longint(intvec[EMMint]);
		xword1 := xlong shr 16;
		xword2 := xlong and $0000FFFF;
		segofs(xword1, xword2);
		writeln;
		caption3('Driver');
		xstring := '';
		for i := $000A to $0011 do
			xstring := xstring + showchar(chr(mem[xword1 : i]));
		write(xstring);
		if xstring = qEMMdrvr then begin
			writeln;
			caption3('Manager status');
			with regs do begin
				AH := $40;
				intr(EMMint, regs);
				if AH = $00 then
					writeln('OK')
				else
					EMMerr(AH);
				caption3('Page frame segment');
				AH := $41;
				intr(EMMint, regs);
				if AH = $00 then
					writeln(hex(BX, 4))
				else
					EMMerr(AH);
				caption3('Total EMS memory (16K pages)');
				AH := $42;
				intr(EMMint, regs);
				if AH = $00 then
					writeln(DX : 3)
				else
					EMMerr(AH);
				caption3('Free EMS memory (16K pages) ');
				if AH = $00 then
					writeln(BX : 3)
				else
					EMMerr(AH);
				caption3('EMM version');
				AH := $46;
				intr(EMMint, regs);
				if AH = $00 then
					writeln(AL shr 4, '.', AL and $0F)
				else
					EMMerr(AH);
				caption1('  Handle   16K pages');
				writeln;
				AH := $4D;
				ES := seg(EMMarray);
				DI := ofs(EMMarray);
				intr(EMMint, regs);
				if AH = $00 then
					if BX > $0000 then begin
						window(3, wherey + hi(windmin), twidth, tlength - 2);
						for i := 1 to BX do begin
							pause2;
							writeln(hex(EMMarray[2 * i - 2], 4), '     '
								, EMMarray[2 * i - 1] : 3)
						end
					end else
						writeln('  (no active handles)')
				else
					EMMerr(AH)
			end
		end else
			dontknow
	end else
		writeln('(none)')
end;

procedure page_04;

var
	xbool : boolean;
	xbyte : byte;
	xword1 : word;
	xword2 : word;
	xword3 : word;
	xword4 : word;

procedure showMCB(MCB, ownerPID, parent, size : word);

var
	i : word;
	xbool : boolean;
	xchar : char;
	xlong1 : longint;
	xlong2 : longint;
	xlong3 : longint;
	xstring : string;
	xword : word;

begin
	xlong1 := longint(size) shl 4;
	xword := memw[ownerPID : $002C];
	if ownerPID = $0008 then
		xstring := 'IBMDOS.COM'
	else if ownerPID = parent then
		xstring := 'COMMAND.COM'
(*	BIX ms.dos/secrets #1496  *)
(*	Software Tools #145, p. 56  *)
	else if (ownerPID = $0000) or (ownerPID = prefixseg) then
		xstring := '(free)'
	else begin
		i := 0;
		while memw[xword : i] > $0000 do
			inc(i);
		inc(i, 4);
		xstring := '';
		xbool := false;
		repeat
			xchar := chr(mem[xword : i]);
			if xchar in pchar then begin
				if xchar in dirsep then
					xstring := ''
				else
					xstring := xstring + xchar;
				inc(i)
			end else begin
				xbool := true;
				if xchar > #0 then
					xstring := ''
			end
		until xbool;
	end;
	write(hex(MCB, 4), '   ', hex(ownerPID, 4), '   ', hex(parent, 4), '  '
		, '   ', xlong1 : 6, '   ');
	if xword = MCB + 1 then
		write(' þ ')
	else
		write('   ');
	write('   ', xstring);
	if MCB + 1 = ownerPID then begin
		for i := length(xstring) + 1 to 12 do
			write(' ');
		write('  ');
		xlong2 := longint(ownerPID) shl 4;
		for i := $00 to $FF do begin
			xlong3 := longint(intvec[i]) and $FFFF0000 shr 12
				+ longint(intvec[i]) and $0000FFFF;
			if (xlong2 <= xlong3) and (xlong3 <= xlong2 + xlong1) then begin
				if wherex > twidth - 3 then begin
					writeln;
					pause2;
					write('                                                  '
						, '  ');
				end;
				write(' ', hex(i, 2))
			end
		end
	end;
	writeln
end;

begin (* procedure page_04 *)
	caption1('MCB    PSP    Parent     Size   Env   Owner'
		+ '          Interrupts');
	window(1, 4, twidth, tlength - 2);
	xword1 := memw[devseg : devofs - $0002];
	xbool := false;
	repeat
		xbyte := mem[xword1 : $0000];
		xword2 := memw[xword1 : $0001];
		xword3 := memw[xword2 : $0016];
		pause2;
		case xbyte of
			$4D : begin
				xword4 := memw[xword1 : $0003];
				showMCB(xword1, xword2, xword3, xword4);
				inc(xword1, 1 + xword4)
			end;
			$5A : begin
				xword4 := DOSmem shr 4 - xword1 - 1;
				showMCB(xword1, xword2, xword3, xword4);
				xbool := true
			end else begin
				unknown('MCB status', xbyte, 2);
				xbool := true
			end
		end
	until xbool
(*	PC Magazine 6:14 p.425  *)
end;

procedure page_05;

var
	i : byte;
	xbyte : byte;
	xint1 : integer;
	xint2 : integer;
	xword : word;

procedure showdisp(a : string; b : byte);

begin
	caption2(a);
	case b of
		$00 : writeln('(none)');
		$01 : writeln('MDA + 5151');
		$02 : writeln('CGA + 5153/5154');
		$03 : writeln('(reserved)');
		$04 : writeln('EGA + 5153/5154');
		$05 : writeln('EGA 5151');
		$06 : writeln('PGA + 5175');
		$07 : writeln('VGA + analog monochrome');
		$08 : writeln('VGA + analog color');
		$09 : writeln('(reserved)');
		$0A : writeln('MCGA + digital color');
		$0B : writeln('MCGA + digital monochrome');
		$0C : writeln('MCGA + analog color');
		$0D..$FE : writeln('(reserved)');
		$FF : dontknow
	end
end;

procedure showcolor(a : byte);

begin
	case(a) of
		black			: write('black');
		blue			: write('blue');
		green			: write('green');
		cyan			: write('cyan');
		red				: write('red');
		magenta			: write('magenta');
		brown			: write('brown');
		lightgray		: write('light gray');
		darkgray		: write('dark gray');
		lightblue		: write('light blue');
		lightgreen		: write('light green');
		lightcyan		: write('light cyan');
		lightred		: write('light red');
		lightmagenta	: write('light magenta');
		yellow			: write('yellow');
		white			: write('white')
		else
			unknown('color', a, 2)
	end
end;

begin (* procedure page_05 *)
	with regs do begin
		AX := $1A00;
		intr($10, regs);
		if AL = $1A then begin
			showdisp('Active video subsystem  ', BL);
			showdisp('Inactive video subsystem', BH)
		end
	end;
	caption2('Initial video mode');
	case equip and $0030 of
		$0000 : writeln('No display');
		$0010 : writeln('40 x 25 color');
		$0020 : writeln('80 x 25 color');
		$0030 : writeln('80 x 25 monochrome')
	end;
	caption2('Current video mode');
	xbyte := lo(lastmode);
	write(xbyte, ' ');
	case xbyte of
		$00 : writeln('(40 x 25 b/w text)');
		$01 : writeln('(40 x 25 color text)');
		$02 : writeln('(80 x 25 b/w text)');
		$03 : writeln('(80 x 25 color text)');
		$04 : writeln('(320 x 200 4 colors)');
		$05 : writeln('(320 x 200 4 colors, no color burst)');
		$06 : writeln('(640 x 200 2 colors)');
		$07 : writeln('(MDA text)');
		$08 : writeln('(160 x 200 16 colors)');
		$09 : writeln('(320 x 200 16 colors)');
		$0A : writeln('(640 x 200 4 colors)');
		$0D : writeln('(320 x 200 16 colors)');
		$0E : writeln('(640 x 200 16 colors)');
		$0F : writeln('(640 x 350 monochrome)');
		$10 : writeln('(640 x 350 16 colors)');
		$11 : writeln('(640 x 480 2 colors)');
		$12 : writeln('(640 x 480 16 colors)');
		$13 : writeln('(640 x 480 256 colors)')
		else
			unknown('video mode', xbyte, 2)
	end;
	caption2('Current display page');
	writeln(vidpg);
	caption2('Graphics modes');
	getmoderange(graphdriver, xint1, xint2);
	if graphresult = grok then
		writeln(xint2 + 1 - xint1)
	else
		writeln(0);
	caption2('Video buffer (offset)');
	writeln(hex(memw[BIOSdseg : $004E], 4));
	caption2('Video buffer size (bytes)');
	writeln(memw[BIOSdseg : $004C]);
	caption2('Active display port');
	xword := memw[BIOSdseg : $0063];
	write('$', hex(xword, 3), ' ');
	if xword = $03B4 then
		writeln('(monochrome)')
	else if xword = $03D4 then
		writeln('(color)')
	else
		dontknow;
	caption2('CRT mode register');
	writeln('$', hex(mem[BIOSdseg : $0065], 2));
	caption2('Current palette');
	writeln('$', hex(mem[BIOSdseg : $0066], 2));
	caption2('Colors');
	caption1('ú');
	for i := black to white do begin
		textcolor(i);
		write('Û')
	end;
	caption1('ú');
	writeln;
	caption2('Current colors');
	if (attrsave and $80) = $80 then
		write('blinking ');
	showcolor(attrsave and $0F);
	write(' on ');
	showcolor(attrsave and $70 shr 4);
	writeln;
	caption2('Text rows');
	writeln(tlength);
	caption2('Text columns');
	writeln(twidth);
	if graphdriver in [EGA, MCGA, VGA] then begin
		caption2('Scan lines/character');
		with regs do begin
			AX := $1130;
			BH := $00;
			intr($10, regs);
			writeln(CX)
		end
	end;
	caption2('Cursor scan lines');
	with regs do begin
		AH := $03;
		BH := vidpg;
		intr($10, regs);
		writeln(CH, '-', CL)
	end
end;

procedure page_06;

var
	i : byte;
	VGAbuf : array[$00..$10] of byte;
	xbyte : byte;
	xword1 : word;
	xword2 : word;
	xword3 : word;
	xword4 : word;

procedure captfont;

begin
	caption1('Font           Address');
	writeln;
	write('INT 1FH        ');
	segofs(longint(intvec[$1F]) shr 16, longint(intvec[$1F]) and $0000FFFF);
	writeln
end;

procedure showfont(a : byte);

begin
	with regs do begin
		case a of
			$00 : write('INT 1FH     ');
			$01 : write('INT 43H     ');
			$02 : write('ROM 8x14    ');
			$03 : write('ROM 8x8 (lo)');
			$04 : write('ROM 8x8 (hi)');
			$05 : write('ROM 9x14    ');
			$06 : write('ROM 8x16    ');
			$07 : write('ROM 9x16    ')
		end;
		write('   ');
		AX := $1130;
		BH := a;
		intr($10, regs);
		segofs(ES, BP);
		writeln
	end
end;

procedure int101210;

begin
	with regs do begin
		AH := $12;
		BL := $10;
		intr($10, regs);
		caption2('Display type');
		case BH of
			$00 : writeln('color');
			$01 : writeln('monochrome')
			else
				unknown('display', BH, 2)
		end;
		caption2('Memory');
		case BL of
			$00 : writeln('64K');
			$01 : writeln('128K');
			$02 : writeln('192K');
			$03 : writeln('256K')
			else
				unknown('size', BL, 2)
		end;
		caption2('Feature bits');
		writeln(bin4(CH and $0F));
		caption2('DIP switches');
		writeln(bin4(CL and $0F))
	end
end;

begin (* procedure page_06 *)
	caption2('Display adapter');
	case graphdriver of
		CGA : begin
			writeln('CGA');
			captfont
		end;
		MCGA : begin
			writeln('MCGA');
			captfont;
			showfont($01);
			showfont($03);
			showfont($04);
			showfont($06)
		end;
		EGA..EGAmono : begin
			writeln('EGA');
			captfont;
			showfont($01);
			showfont($02);
			showfont($03);
			showfont($04);
			showfont($05);
			int101210;
			xbyte := mem[BIOSdseg : $0087];
			caption2('Mode change preserves screen buffer');
			yesorno(xbyte and $80 = $80);
			caption2('EGA active');
			yesorno(xbyte and $08 = $00);
			caption2('Wait for display enable');
			yesorno(xbyte and $04 = $04);
			caption2('CGA cursor emulation');
			yesorno(xbyte and $01 = $00);
(*	PC Magazine 6:12 p.326  *)
			caption2('Save area                    ');
			xword1 := memw[BIOSdseg : $00AA];
			xword2 := memw[BIOSdseg : $00A8];
			segofs(xword1, xword2);
			writeln;
(*	PC Tech Journal 3:4 p.65  *)
			caption2('Video parameter table        ');
			segofs(memw[xword1 : xword2 +  2], memw[xword1 : xword2]);
			writeln;
			caption2('Dynamic save area            ');
			xword3 := memw[xword1 : xword2 +  6];
			xword4 := memw[xword1 : xword2 +  4];
			if (xword3 > $0000) or (xword4 > $0000) then begin
				segofs(xword3, xword4);
				writeln
			end else
				writeln('(none)');
			caption2('Auxiliary character generator');
			xword3 := memw[xword1 : xword2 + 10];
			xword4 := memw[xword1 : xword2 +  8];
			if (xword3 > $0000) or (xword4 > $0000) then begin
				segofs(xword3, xword4);
				writeln
			end else
				writeln('(none)');
			caption2('Graphics mode auxiliary table');
			xword3 := memw[xword1 : xword2 + 14];
			xword4 := memw[xword1 : xword2 + 12];
			if (xword3 > $0000) or (xword4 > $0000) then
				segofs(xword3, xword4)
			else
				write('(none)')
(*	PC Tech Journal 3:4 p.67  *)
		end;
		hercmono : begin
			writeln('Hercules or MDA');
			captfont
		end;
		IBM8514 : begin
			writeln('IBM 8514');
			captfont
		end;
		ATT400 : begin
			writeln('AT&T 400');
			captfont
		end;
		VGA : begin
			writeln('VGA');
			captfont;
			showfont($01);
			showfont($02);
			showfont($03);
			showfont($04);
			showfont($05);
			showfont($06);
			showfont($07);
			int101210;
			with regs do begin
				AX := $1009;
				ES := seg(VGAbuf);
				DX := ofs(VGAbuf);
				intr($10, regs)
			end;
			caption2('Palette registers');
			for i := $00 to $0F do
				write(hex(VGAbuf[i], 2), ' ');
			writeln;
			caption2('Border color');
			writeln(hex(VGAbuf[$10], 2));
			caption2('Color page');
			with regs do begin
				AX := $101A;
				intr($10, regs);
				writeln('$', hex(BH, 2));
				caption2('Paging mode');
				case BL of
					$00 : writeln('4 pages of 64 registers');
					$01 : writeln('16 pages of 16 registers')
					else
						unknown('mode', BL, 2)
				end
			end
		end;
		PC3270 : begin
			writeln('3270 PC');
			captfont
		end else
			unknown('adapter', graphdriver, 4)
	end
end;

procedure page_07;

const
	mouseint = $33;

var
	xbyte : byte;
	xword1 : word;
	xword2 : word;

begin
	caption2('Keyboard');
	writeln;
	caption3('BIOS support for enhanced keyboard');
	with regs do begin
		AH := $02;
		intr($16, regs);
		xbyte := AL;
		AX := $1200 + xbyte xor $FF;
		intr($16, regs);
		if AL = xbyte then begin
			writeln('yes');
			caption3('Enhanced keyboard present');
			yesorno(mem[BIOSdseg : $0096] and $10 = $10)
		end else
			writeln('no');
(*	PC Magazine 6:15 p.378  *)
		AH := $02;
		intr($16, regs);
		offoron('Insert     ', AL and $80 = $80);
		offoron('Caps Lock  ', AL and $40 = $40);
		offoron('Num Lock   ', AL and $20 = $20);
		offoron('Scroll Lock', AL and $10 = $10)
	end;
	caption3('Buffer start');
	xword1 := memw[BIOSdseg : $0080];
	segofs(BIOSdseg, xword1);
	writeln;
	caption3('Buffer end  ');
	xword2 := memw[BIOSdseg : $0082];
	segofs(BIOSdseg, xword2);
	writeln;
	caption3('Buffer size (keystrokes)');
	writeln((xword2 - xword1) shr 1 - 1);
	caption2('Internal modem/serial printer');
	yesorno(equip and $2000 = $2000);
	caption2('Game port');
	yesorno(equip and $1000 = $1000);
	caption2('Mouse');
	with regs do begin
		AX := $0000;
		intr(mouseint, regs);
		if AX = $FFFF then begin
			writeln('yes');
			caption3('Buttons');
			writeln(BX);
			caption3('Save state buffer size (bytes)');
			AX := $0015;
			intr(mouseint, regs);
			writeln(BX);
			caption3('Mickeys/pixel (horizontal)');
			AX := $001B;
			intr(mouseint, regs);
			writeln(BX : 5);
			caption3('Mickeys/pixel (vertical)  ');
			writeln(CX : 5);
			caption3('Double speed threshold');
			writeln(DX);
			caption3('Current display page');
			AX := $001E;
			intr(mouseint, regs);
			writeln(BX);
			caption3('Language');
			AX := $0023;
			intr(mouseint, regs);
			if AX < $FFFF then
				if BX = $0000 then
					writeln('English')
				else if BX = $0001 then
					writeln('French')
				else if BX = $0002 then
					writeln('Dutch')
				else if BX = $0003 then
					writeln('German')
				else if BX = $0004 then
					writeln('Swedish')
				else if BX = $0005 then
					writeln('Finnish')
				else if BX = $0006 then
					writeln('Spanish')
				else if BX = $0007 then
					writeln('Portuguese')
				else if BX = $0008 then
					writeln('Italian')
				else
					unknown('language', BX, 4)
			else
				writeln('N/A');
			caption3('Driver version');
			AX := $0024;
			intr(mouseint, regs);
			if AX < $FFFF then begin
				write(BH, '.');
				zeropad(BL);
				writeln;
				caption3('Type');
				case CH of
					$01 : writeln('bus');
					$02 : writeln('serial');
					$03 : writeln('InPort');
					$04 : writeln('PS/2');
					$05 : writeln('HP')
					else
						unknown('mouse', CH, 2)
				end;
				caption3('Interrupt');
				case CL of
					$00 : writeln('PS/2');
					$02..$05, $07 : writeln('IRQ', CL)
					else
						unknown('interrupt', CL, 2)
				end
			end else
				dontknow
		end else
			writeln('no')
	end
end;

procedure page_08;

const
	tick2 = 115200;

var
	i : byte;
	xbyte1 : byte;
	xbyte2 : byte;
	xword : word;

begin
	window(1, 3, 30, tlength - 2);
	caption2('Printers');
	xbyte1 := equip and $C000 shr 14;
	writeln(xbyte1);
	if xbyte1 > 0 then begin
		caption3('Device');
		writeln;
		caption3('Base port');
		writeln;
		caption3('Timeout');
		writeln;
		caption3('Busy');
		writeln;
		caption3('ACK');
		writeln;
		caption3('Paper out');
		writeln;
		caption3('Selected');
		writeln;
		caption3('I/O error');
		writeln;
		caption3('Timed out');
		for i := 1 to xbyte1 do begin
			window(9 + 6 * i, 4, 15 + 6 * i, tlength - 2);
			writeln('LPT', i);
			writeln('$', hex(memw[BIOSdseg : 2 * i + 6], 3));
			writeln(mem[BIOSdseg : $0077 + i]);
			with regs do begin
				AH := $02;
				DX := 0;
				intr($17, regs);
				yesorno(AH and $80 = $00);
				yesorno(AH and $40 = $40);
				yesorno(AH and $20 = $20);
				yesorno(AH and $10 = $10);
				yesorno(AH and $08 = $08);
				yesorno(AH and $01 = $01)
			end
		end
	end;
	window(twidth - 42, 3, twidth, tlength - 2);
	caption2('Serial ports');
	xbyte1 := equip and $0E00 shr 9;
	writeln(xbyte1);
	if xbyte1 > 0 then begin
		if xbyte1 > 4 then
			xbyte1 := 4;
		caption3('Device');
		writeln;
		caption3('Base port');
		writeln;
		caption3('Timeout');
		writeln;
		caption3('Baud rate');
		writeln;
		caption3('Data bits');
		writeln;
		caption3('Parity');
		writeln;
		caption3('Stop bits');
		writeln;
		caption3('Break');
		writeln;
		caption3('RLSD');
		writeln;
		caption3('RI');
		writeln;
		caption3('DSR');
		writeln;
		caption3('CTS');
		writeln;
		caption3('dRLSD');
		writeln;
		caption3('-dRI');
		writeln;
		caption3('dDSR');
		writeln;
		caption3('dCTS');
		for i := 1 to xbyte1 do begin
			window(twidth - 35 + 7 * i, 4, twidth - 28 + 7 * i, tlength - 2);
			writeln('COM', i);
			xword := memw[BIOSdseg : 2 * i - 2];
			writeln('$', hex(xword, 3));
			writeln(mem[BIOSdseg : $007B + i]);
			xbyte2 := port[xword + 3];
			port[xword + 3] := xbyte2 or $80;
			writeln(tick2 / cbw(port[xword], port[xword + 1]) : 0 : 0);
			port[xword + 3] := xbyte2;
			case xbyte2 and $03 of
				$00 : writeln('5');
				$01 : writeln('6');
				$02 : writeln('7');
				$03 : writeln('8')
			end;
			case xbyte2 and $38 of
				$00, $10, $20, $30 : writeln('none');
				$08 : writeln('odd');
				$18 : writeln('even');
				$28 : writeln('mark');
				$38 : writeln('space')
			end;
			case xbyte2 and $07 of
				$00..$03 : writeln('1');
				$04 : writeln('1.5');
				$05..$07 : writeln('2')
			end;
			yesorno(xbyte2 and $40 = $40);
			with regs do begin
				AH := $03;
				DX := i - 1;
				intr($14, regs);
				yesorno(AL and $80 = $80);
				yesorno(AL and $40 = $40);
				yesorno(AL and $20 = $20);
				yesorno(AL and $10 = $10);
				yesorno(AL and $08 = $08);
				yesorno(AL and $04 = $04);
				yesorno(AL and $02 = $02);
				yesorno(AL and $01 = $01)
			end
		end
	end
end;

procedure page_09;

const
	filesmax = 256;

var
	ccode : word;
	f : array[1..filesmax] of file;
	i : 0..filesmax;
	j : 1..filesmax;
	xbool : boolean;
	xbyte : byte;
	xchar : char;
	xstring1 : string;
	xstring2 : string;
	xword1 : word;
	xword2 : word;
	xword3 : word;
	xword4 : word;
	xword5 : word;

procedure showecho(a : word);

var
	xbyte : byte;

begin
	xbyte := mem[DOScseg : a];
	case xbyte of
		$00 : writeln('off');
		$FF : writeln('on')
		else
			unknown('status', xbyte, 2)
	end
end;

procedure showbufs(a : word);

const
	bufsmax = 99;

var
	i : 0..bufsmax + 1;
	xbool : boolean;
	xword1 : word;
	xword2 : word;
	xword3 : word;

begin
	i := 0;
	xword1 := memw[DOScseg : a];
	xword2 := memw[DOScseg : a + 2];
	xbool := false;
	repeat
		if i <= bufsmax then begin
			if xword1 < $FFFF then begin
				inc(i);
				xword3 := xword1;
				xword1 := memw[xword2 : xword3];
				xword2 := memw[xword2 : xword3 + 2]
			end else begin
				xbool := true;
				writeln(i)
			end
		end else begin
			xbool := true;
			dontknow
		end
	until xbool
end;
(*	BIX ms.dos/secrets #2  *)

begin (* procedure page_09 *)
	window(1, 3, twidth div 2, tlength - 2);
	with regs do begin
		AX := $3800;
		DS := seg(country);
		DX := ofs(country);
		MSDOS(regs);
		ccode := BX
	end;
	caption2('DOS version');
	showvers;
	caption2('System date');
	getdate(xword1, xword2, xword3, xword4);
	if xword4 = 0 then
		write('Sunday')
	else if xword4 = 1 then
		write('Monday')
	else if xword4 = 2 then
		write('Tuesday')
	else if xword4 = 3 then
		write('Wednesday')
	else if xword4 = 4 then
		write('Thursday')
	else if xword4 = 5 then
		write('Friday')
	else if xword4 = 6 then
		write('Saturday')
	else
		write('(', hex(xword4, 4), ')');
	write(', ');
	xword5 := cbw(country[0], country[1]);
	xchar := chr(country[11]);
	if xword5 = $0000 then
		writeln(xword2, xchar, xword3, xchar, xword1)
	else if xword5 = $0001 then
		writeln(xword3, xchar, xword2, xchar, xword1)
	else if xword5 = $0002 then
		writeln(xword1, xchar, xword2, xchar, xword3)
	else
		writeln(xword2, xchar, xword3, xchar, xword1);
	caption2('System time');
	gettime(xword1, xword2, xword3, xword4);
	zeropad(xword1);
	write(chr(country[13]));
	zeropad(xword2);
	write(chr(country[13]));
	zeropad(xword3);
	write(chr(country[9]));
	zeropad(xword4);
	writeln;
	caption2('Command load paragraph');
	writeln(hex(prefixseg, 4));
	getcbreak(xbool);
	offoron('Ctrl-C check', xbool);
	getverify(xbool);
	offoron('Disk verify', xbool);
	caption2('Switch prefix character');
	writeln(switchar);
	caption2('\DEV\ prefix for devices');
	with regs do begin
		AX := $3702;
		MSDOS(regs);
		if DL = $00 then
			writeln('required')
		else
			writeln('optional')
	end;
	caption2('Reset boot');
	xword1 := memw[BIOSdseg : $72];
	if xword1 = $0000 then
		writeln('cold')
	else if (xword1 = $1234) or (xword1 = $1200) then
		writeln('bypass memory test')
	else if xword1 = $4321 then
		writeln('preserve memory')
	else if xword1 = $5678 then
		writeln('system suspended')
	else if xword1 = $9ABC then
		writeln('manufacturing test mode')
	else if xword1 = $ABCD then
		writeln('system POST loop mode')
	else
		unknown('flag', xword1, 4);
(*	Byte 12:12 p.178  *)
	with regs do begin
		caption2('DOS critical flag');
		AX := $5D06;
		MSDOS(regs);
		segofs(DS, SI);
		writeln
	end;
	caption2('DOS busy flag    ');
	segofs(DOScseg, DOScofs);
	writeln;
	caption2('Printer echo');
	case osmajor of
		3 : case osminor div 10 of
			0 : dontknow;
			1..3 : showecho($02AC)
			else
				dontknow
		end else
			dontknow
	end;
(*	BIX ms.dos/secrets #501  *)
	caption2('PrtSc status');
	xbyte := mem[BIOSdseg : $0100];
	case xbyte of
		$00 : writeln('ready');
		$01 : writeln('busy');
		$FF : writeln('error on last PrtSc')
		else
			unknown('status', xbyte, 2)
	end;
	caption2('Memory allocation');
	with regs do begin
		AX := $5800;
		MSDOS(regs);
		if AX = $0000 then
			writeln('first fit')
		else if AX = $0001 then
			writeln('best fit')
		else
			writeln('last fit')
	end;
	caption2('DOS buffers');
	case osmajor of
		3 : case osminor div 10 of
			0 : showbufs($013F);
			1..3 : showbufs($0038)
			else
				dontknow
		end
		else
			dontknow
	end;
	caption2('File handle table ');
	xword1 := memw[prefixseg : $0036];
	xword2 := memw[prefixseg : $0034];
	segofs(xword1, xword2);
	writeln;
	caption2('File handle table length');
	writeln(mem[prefixseg : $0032] : 3);
	caption2('File handles used       ');
	i := 0;
	while mem[xword1 : xword2] < $FF do begin
		inc(i);
		inc(xword2)
	end;
	writeln(i : 3);
	caption1('File handles free');
	i := 0;
	xbool := false;
	xstring1 := getenv('comspec');
	repeat
		if i < filesmax then begin
			assign(f[i + 1], xstring1);
			reset(f[i + 1]);
			if ioresult = 0 then
				inc(i)
			else begin
				xbool := true;
				caption2('       ');
				writeln(i : 3)
			end
		end else begin
			xbool := true;
			caption2('');
			dontknow
		end
	until xbool;
	for j := 1 to i do
		close(f[j]);
	window(1 + twidth div 2, 3, twidth, tlength - 2);
	caption2('Global code page');
	with regs do begin
		AX := $6601;
		MSDOS(regs);
		if AL = $01 then begin
			writeln;
			caption3('Active ');
			writeln(BX : 5);
			caption3('Default');
			writeln(DX : 5)
		end else
			writeln('N/A')
	end;
	caption2('Country code');
	writeln(ccode);
	caption2('Thousands separator character');
	writeln(chr(country[7]));
	caption2('Decimal separator character');
	writeln(chr(country[9]));
	caption2('Data-list separator character');
	writeln(chr(country[22]));
	caption2('Date format');
	xword1 := cbw(country[0], country[1]);
	xchar := chr(country[11]);
	if xword1 = $0000 then
		writeln('USA (mm', xchar, 'dd', xchar, 'yy)')
	else if xword1 = $0001 then
		writeln('Europe (dd', xchar, 'mm', xchar, 'yy)')
	else if xword1 = $0002 then
		writeln('Japan (yy', xchar, 'mm', xchar, 'dd)')
	else
		unknown('format', xword1, 4);
	caption3('Separator character');
	writeln(xchar);
	caption2('Time format');
	if (country[17] and $01) = $00 then
		write('12')
	else
		write('24');
	writeln('-hour');
	caption3('Separator character');
	writeln(chr(country[13]));
	caption2('Currency format');
	xstring1 := 'xxxx';
	insert(chr(country[7]), xstring1, 2);
	xstring1 := xstring1 + chr(country[9]);
	for i := 1 to country[16] do
		xstring1 := xstring1 + 'y';
	xstring2 := '';
	i := 2;
	xchar := chr(country[i]);
	while (i <= 6) and (xchar > #0) do begin
		xstring2 := xstring2 + xchar;
		inc(i);
		xchar := chr(country[i])
	end;
	case country[15] and $03 of
		$00 : xstring1 := xstring2 + xstring1;
		$01 : xstring1 := xstring1 + xstring2;
		$02 : xstring1 := xstring2 + ' ' + xstring1;
		$03 : xstring1 := xstring1 + ' ' + xstring2;
		$04 : begin
			delete(xstring1, 6, 1);
			insert(xstring2, xstring1, 6)
		end
	end;
	writeln(xstring1);
	caption2('Case map call address');
	segofs(cbw(country[20], country[21]), cbw(country[18], country[19]));
	writeln
end;

procedure page_10;

var
	i : 1..63;
	xbool1 : boolean;
	xbool2 : boolean;
	xbool3 : boolean;
	xchar : char;

procedure muxint(a : string; b : byte);

begin
	caption3(a);
	with regs do begin
		AX := b shl 8;
		intr($2F, regs);
		case AL of
			$00 : writeln('no; OK to load');
			$01 : writeln('no; not OK to load');
			$FF : writeln('yes')
			else
				unknown('status', AL, 2)
		end
	end
end;

begin (* procedure page_10 *)
	caption2('Multiplex interrupt ($2F)');
	writeln;
	muxint('PRINT          ', $01);
	muxint('ASSIGN         ', $06);
(*
**	Byte 12:12 p. 176C, Duncan, and many others, all of whom mistakenly give
**	AH = $02
*)
(*
	muxint('DRIVER.SYS     ', $08);
*)
	muxint('SHARE          ', $10);
(*
	muxint('FASTOPEN       ', $12);
*)
	muxint('NLSFUNC        ', $14);
	muxint('GRAFTABL       ', $B0);
(*
	muxint('DISPLAY.SYS    ', $B0);
*)
	muxint('APPEND         ', $B7);
(*
	muxint('KEYB           ', $B8);
*)
	muxint('NETBIOS append ', $87);
	muxint('NETBIOS network', $88);
(*	Byte 12:12 p. 180.  PC Tech Journal 3:11 p.104 gives AH = $BB  *)
	with regs do begin
		AX := $0100;
		intr($2F, regs);
		if AL = $FF then begin
			caption2('PRINT queue');
			AX := $0104;
			intr($2F, regs);
			xbool1 := true;
			xbool2 := false;
			repeat
				xchar := char(mem[DS : SI]);
				if xchar > #0 then begin
					if xbool1 then begin
						xbool1 := false;
						writeln;
						window(3, wherey + hi(windmin), twidth, tlength - 2)
					end;
					pause2;
					write(xchar);
					i := 1;
					xbool3 := false;
					repeat
						xchar := char(mem[DS : SI + i]);
						if xchar > #0 then begin
							write(xchar);
							inc(i)
						end else begin
							writeln;
							xbool3 := true
						end
					until xbool3;
					inc(SI, 64)
				end else
					xbool2 := true
			until xbool2;
			if xbool1 then
				writeln('(empty)');
			AX := $0105;
			intr($2F, regs)
		end
	end
end;

procedure page_11;

begin
	caption2('Environment');
	window(3, 4, twidth, tlength - 2);
	for i := 1 to envcount do begin
		pause2;
		writeln(envstr(i))
	end
end;

procedure page_12;

const
	headermin = 0;
	headermax = 17;

var
	header : array[headermin..headermax] of byte;
	i : headermin..headermax;
	xword1 : word;
	xword2 : word;

begin
	caption1('Device      Units    Header       Attributes'
		+ '             Strategy     Interrupt');
	xword1 := devseg;
	xword2 := devofs + $0022;
	window(1, 4, twidth, tlength - 2);
	while xword2 < $FFFF do begin
		pause2;
		for i := 0 to 17 do
			header[i] := mem[xword1 : xword2 + i];
		if header[5] and $80 = $00 then
			write('            ', header[10] : 5)
		else begin
			for i := 10 to 17 do
				write(showchar(chr(header[i])));
			write('         ')
		end;
		write('    ');
		segofs(xword1, xword2);
		write('    ', bin16(cbw(header[4], header[5])), '    ');
		segofs(xword1, cbw(header[6], header[7]));
		write('    ');
		segofs(xword1, cbw(header[8], header[9]));
		writeln;
		xword1 := cbw(header[2], header[3]);
		xword2 := cbw(header[0], header[1])
	end
end;

procedure page_13;

var
	i : $00..$2B;
	xbyte : byte;
	xchar : char;
	xFCB : array[$00..$2B] of byte;
	xlong : longint;
	xstring : string;
	xword1 : word;
	xword2 : word;

begin
	caption2('LASTDRIVE');
	drvname(lastdrv - 1);
	writeln;
	caption2('Logical drives');
	with regs do begin
		for xchar := 'A' to 'Z' do begin
			AH := $0E;
			DL := ord(xchar) - ord('A');
			MSDOS(regs);
			AH := $19;
			MSDOS(regs);
			if AL = DL then
				drvname(AL)
		end;
		writeln;
		AH := $0E;
		DL := currdrv;
		MSDOS(regs)
	end;
	caption2('Diskette drives');
	if equip and $0001 = $0001 then
		writeln(1 + equip and $00C0 shr 6)
	else
		writeln(0);
	xword1 := longint(intvec[$1E]) shr 16;
	xword2 := longint(intvec[$1E]) and $0000FFFF;
	caption3('Sectors/track');
	writeln(mem[xword1 : xword2 + 4]);
	caption3('Bytes/sector');
	writeln(mem[xword1 : xword2 + 3] shl 8);
	caption3('On time (ms)');
	writeln(125 * mem[xword1 : xword2 + 10]);
	caption3('Off time (s)');
	writeln(longint(mem[xword1 : xword2 + 2]) shl 16 / tick1 : 0 : 1);
	caption3('Head settle time (ms)');
	writeln(mem[xword1 : xword2 + 9]);
	caption1('  Single drive is now ');
	xbyte := mem[BIOSdseg : $0104];
	if xbyte <= ord('Z') - ord('A') then begin
		drvname(xbyte);
		writeln
	end else if xbyte = $FF then
		writeln('N/A')
	else
		unknown('status', xbyte, 2);
(*	Byte 12:12 p.178  *)
	caption2('Current drive and path');
	getdir(0, xstring);
	writeln(xstring);
	caption3('Volume label');
	for i := $00 to $2B do
		xFCB[i] := $00;
	xFCB[$00] := $FF;					(* extended FCB *)
	xFCB[$06] := $08;					(* volume ID attribute *)
	for i := $08 to $12 do
		xFCB[i] := ord('?');
	with regs do begin
		AH := $11;
		DS := seg(xFCB);
		DX := ofs(xFCB);
		MSDOS(regs);
		case AL of
			$00 : begin
				AH := $2F;
				MSDOS(regs);
				i := $08;
				xchar := char(mem[ES : BX + i]);
				while (i <= $12) and (xchar > #0) do begin
					write(showchar(xchar));
					inc(i);
					xchar := char(mem[ES : BX + i])
				end;
				writeln
			end;
			$FF : writeln('(none)')
			else
				unknown('status', AL, 2)
		end
	end;
	with regs do begin
		AH := $1B;
		MSDOS(regs);
		media(mem[DS : BX]);
		caption3('Clusters');
		writeln(DX);
		caption3('Sectors/cluster');
		writeln(AL);
		caption3('Bytes/sector');
		writeln(CX)
	end;
	caption3('Total space (bytes)');
	xlong := disksize(0);
	if xlong <> -1 then
		writeln(xlong : 8)
	else
		writeln('(invalid drive)');
	caption3('Free space (bytes) ');
	xlong := diskfree(0);
	if xlong <> -1 then
		writeln(xlong : 8)
	else
		writeln('(invalid drive)')
end;

procedure page_14;

var
	i : byte;
	xbool : boolean;
	xbyte1 : byte;
	xbyte2 : byte;

begin
	caption2('BIOS disk parameters');
	xbool := true;
	for i := $00 to $FF do
		with regs do begin
			AH := $08;
			DL := i;
			intr($13, regs);
			if nocarry and ((BL > $00) or (i >= $80)) then
				begin
				if xbool then begin
					xbool := false;
					writeln;
					caption3('Unit');
					writeln;
					caption3('Type');
					writeln;
					caption3('Drives');
					writeln;
					caption3('Heads');
					writeln;
					caption3('Cylinders');
					writeln;
					caption3('Sectors/track');
					writeln;
					caption3('Specify bytes');
					writeln;
					caption3('Off time (s)');
					writeln;
					caption3('Bytes/sector');
					writeln;
					caption3('Sectors/track');
					writeln;
					caption3('Gap length');
					writeln;
					caption3('Data length');
					writeln;
					caption3('Gap length for format');
					writeln;
					caption3('Fill byte for format');
					writeln;
					caption3('Head settle time (ms)');
					writeln;
					caption3('On time (ms)');
					writeln;
					xbyte1 := 27;
				end;
				if xbyte1 + 10 > twidth then begin
					pause1;
					xbyte1 := 27;
					window(xbyte1, 4, twidth, tlength - 2);
					clrscr
				end;
				window(xbyte1, 4, xbyte1 + 11, tlength - 2);
				writeln(i);
				if i < $80 then
					case BL of
						$01 : writeln('360KB 5¬"');
						$02 : writeln('1.2MB 5¬"');
						$03 : writeln('720KB 3«"');
						$04 : writeln('1.44MB 3«"')
						else
							writeln('(', hex(BL, 2), ')')
					end
				else
					writeln('fixed disk');
				writeln(DL);
				writeln(DH + 1);
				writeln(cbw(CH, CL shr 6) + 1);
				writeln(CL and $3F);
				if i < $80 then begin
					writeln('$', hex(mem[ES : DI], 2), ' $'
						, hex(mem[ES : DI + $0001], 2));
					writeln(longint(mem[ES : DI + $0002]) shl 16 / tick1 : 0
						: 1);
					xbyte2 := mem[ES : DI + $0003];
					case xbyte2 of
						$00 : writeln('128');
						$01 : writeln('256');
						$02 : writeln('512');
						$03 : writeln('1024')
						else
							writeln('(', hex(xbyte2, 4), ')')
					end;
					writeln(mem[ES : DI + $0004]);
					writeln(mem[ES : DI + $0005]);
					writeln(mem[ES : DI + $0006]);
					writeln(mem[ES : DI + $0007]);
					writeln('$', hex(mem[ES : DI + $0008], 2));
					writeln(mem[ES : DI + $0009]);
					writeln(125 * mem[ES : DI + $000A])
				end;
				inc(xbyte1, 13)
			end
		end;
	if xbool then
		writeln('(no disks)')
end;

procedure page_15;

var
	i : byte;
	j : 0..3;
	k : byte;
	part : array[0..secsiz + 3] of byte;
	xbool1 : boolean;
	xbool2 : boolean;
	xbool3 : boolean;
	xbool4 : boolean;
	xbyte : byte;
	xlong : longint;
	xword : word;

begin
	caption2('Partition table data');
	i := $80;
	xbool1 := false;
	xbool2 := false;
	repeat
		with regs do begin
			AX := $0A01;
			CX := $0001;
			DX := i;
			ES := seg(part);
			BX := ofs(part);
			intr($13, regs);
			if nocarry then begin
				xbool1 := true;
				xbool2 := true
			end else if i < $FF then
				inc(i)
			else
				xbool1 := true
		end
	until xbool1;
	if xbool2 then begin
		writeln;
		caption3('Unit');
		writeln;
		caption3('Partition');
		writeln;
		caption3('Bootable');
		writeln;
		caption3('Starting head');
		writeln;
		caption3('Starting sector');
		writeln;
		caption3('Starting cylinder');
		writeln;
		caption3('System ID');
		writeln;
		caption3('Ending head');
		writeln;
		caption3('Ending sector');
		writeln;
		caption3('Ending cylinder');
		writeln;
		caption3('First partition sector');
		writeln;
		caption3('Sectors in partition');
		writeln;
		xbool3 := false;
		repeat
			window(9, 4, twidth, tlength - 2);
			writeln(i);
			window(27, 5, twidth, tlength - 2);
			clrscr;
			for j := 0 to 3 do begin
				window(27 + 12 * j, 5, 38 + 12 * j, tlength - 2);
				writeln(j + 1);
				xword := $01BE + j shl 4;
				xbyte := part[xword];
				case xbyte of
					$00 : writeln('no');
					$80 : writeln('yes')
					else
						writeln('(', hex(xbyte, 2), ')')
				end;
				xbyte := part[xword + 4];
				if xbyte > $00 then begin
					writeln(part[xword + 1]);
					writeln(part[xword + 2]);
					writeln(part[xword + 3]);
					case xbyte of
						$01 : writeln('DOS-12');
						$04 : writeln('DOS-16');
						$05 : writeln('Ext DOS-16')
						else
							writeln('(', hex(xbyte, 2), ')')
					end;
					writeln(part[xword + 5]);
					xbyte := part[xword + 6];
					writeln(xbyte and $3F);
					writeln(cbw(part[xword + 7], xbyte shr 6));
					xlong := 0;
					for k := 11 downto 8 do
						xlong := xlong shl 8 + part[xword + k];
					writeln(xlong);
					xlong := 0;
					for k := 15 downto 12 do
						xlong := xlong shl 8 + part[xword + k];
					writeln(xlong)
				end else for k := 1 to 9 do
					writeln('-')
			end;
			xbool4 := false;
			repeat
				if i < $FF then begin
					inc(i);
					with regs do begin
						AX := $0A01;
						CX := $0001;
						DX := i;
						ES := seg(part);
						BX := ofs(part);
						intr($13, regs);
						if nocarry then begin
							xbool4 := true;
							pause1
						end
					end
				end else begin
					xbool3 := true;
					xbool4 := true
				end
			until xbool4
		until xbool3
	end else
		writeln('(no fixed disks)')
end;

procedure page_16;

var
	bootrec : array[0..secsiz - 1] of byte;
	i : 1..26;
	j : word;
	xbool : boolean;
	xbyte : byte;
	xchar : char;
	xword1 : word;
	xword2 : word;
	xword3 : word;
	xword4 : word;
	xword5 : word;

begin
	window(1, 3, twidth div 2, tlength - 2);
	caption1('Boot record of ');
	drvname(currdrv);
	writeln;
	xword1 := diskread(currdrv, 0, 1, bootrec);
	if xword1 = $0000 then begin
		media(bootrec[$15]);
		caption3('Sectors/cluster');
		writeln(bootrec[$0D]);
		caption3('Bytes/sector');
		writeln(cbw(bootrec[$0B], bootrec[$0C]));
		caption3('Reserved sectors');
		writeln(cbw(bootrec[$0E], bootrec[$0F]));
		caption3('FAT''s');
		writeln(bootrec[$10]);
		caption3('Sectors/FAT');
		writeln(cbw(bootrec[$16], bootrec[$17]));
		caption3('Root directory entries');
		writeln(cbw(bootrec[$11], bootrec[$12]));
		writeln;
		caption3('Heads');
		writeln(cbw(bootrec[$1A], bootrec[$1B]));
		caption3('Total sectors');
		writeln(cbw(bootrec[$13], bootrec[$14]));
		caption3('Sectors/track');
		writeln(cbw(bootrec[$18], bootrec[$17]));
		caption3('Hidden sectors');
		writeln(cbw(bootrec[$1C], bootrec[$1D]));
		caption3('OEM name and version');
		for i := $03 to $0A do
			write(showchar(chr(bootrec[i])));
		writeln
	end else begin
		writeln('  Can''t read boot record');
		write('  ');
		xbyte := hi(xword1);
		case xbyte of
			$80 : writeln('Attachment failed to respond');
			$40 : writeln('Seek operation failed');
			$20 : writeln('Controller failed');
			$10 : writeln('Data error (bad CRC)');
			$08 : writeln('DMA failure');
			$04 : writeln('Sector not found');
			$03 : writeln('Write-protect fault');
			$02 : writeln('Bad address mark');
			$01 : writeln('Bad command');
			$00 : writeln
			else
				unknown('error', xbyte, 2)
		end;
		write('  ');
		xbyte := lo(xword1);
		case xbyte of
			$00 : writeln('Write-protect error');
			$01 : writeln('Unknown unit');
			$02 : writeln('Drive not ready');
			$03 : writeln('Unknown command');
			$04 : writeln('Data error (bad CRC)');
			$05 : writeln('Bad request structure length');
			$06 : writeln('Seek error');
			$07 : writeln('Unknown media type');
			$08 : writeln('Sector not found');
			$09 : writeln('Printer out of paper');
			$0A : writeln('Write fault');
			$0B : writeln('Read fault');
			$0C : writeln('General failure')
			else
				unknown('error', xbyte, 2)
		end
	end;
	window(1 + twidth div 2, 3, twidth, tlength - 2);
	i := 1;
	xbool := false;
	xword1 := memw[devseg : devofs + $0018];
	xword2 := memw[devseg : devofs + $0016];
	repeat
		caption1('DOS disk parameter block for ');
		drvname(i - 1);
		writeln;
		xword3 := memw[xword1 : xword2 + $0047];
		xword4 := memw[xword1 : xword2 + $0045];
		media(mem[xword3 : xword4 + $0016]);
		caption3('Sectors/cluster');
		writeln(mem[xword3 : xword4 + $0004] + 1);
		caption3('Bytes/sector');
		writeln(memw[xword3 : xword4 + $0002]);
		caption3('Reserved sectors');
		writeln(memw[xword3 : xword4 + $0006]);
		caption3('FAT''s');
		writeln(mem[xword3 : xword4 + $0008]);
		caption3('Sectors/FAT');
		writeln(mem[xword3 : xword4 + $000F]);
		caption3('Root directory entries');
		writeln(memw[xword3 : xword4 + $0009]);
		writeln;
		caption3('DPB valid');
		yesorno(mem[xword3 : xword4 + $0017] < $FF);
		caption3('Current directory');
		j := xword2;
		xchar := chr(mem[xword1 : j]);
		while xchar > #0 do begin
			write(xchar);
			inc(j);
			xchar := chr(mem[xword1 : j])
		end;
		writeln;
		caption3('Device header');
		segofs(memw[xword3 : xword4 + $0014], memw[xword3 : xword4 + $0012]);
		writeln;
		caption3('Unit within driver');
		writeln(mem[xword3 : xword4 + $0001]);
		caption3('Clusters');
		writeln(memw[xword3 : xword4 + $000D] - 1);
		caption3('Cluster to sector shift');
		writeln(mem[xword3 : xword4 + $0005]);
		caption3('Root directory sector');
		writeln(memw[xword3 : xword4 + $0010]);
		caption3('First data sector');
		writeln(memw[xword3 : xword4 + $000B]);
		caption3('Next DPB');
		xword5 := memw[xword3 : xword4 + $0018];
		segofs(memw[xword3 : xword4 + $001A], xword5);
		writeln;
		if (i < lastdrv) and (xword5 < $FFFF) then begin
			write('  ');
			pause1;
			clrscr;
			inc(i);
			inc(xword2, $51)
		end else
			xbool := true
	until xbool
end;

(*
**	end subprograms
*)

begin
	xword := dosversion;
	osmajor := lo(xword);
	osminor := hi(xword);
	if osmajor >= 3 then begin
		init;
		xbool1 := false;
		repeat
			gotoxy(x1, tlength);
			textcolor(lightgray);
			write(pg : 2);
			window(1, 3, twidth, tlength - 2);
			clrscr;
			case pg of
				1 : page_01;
				2 : page_02;
				3 : page_03;
				4 : page_04;
				5 : page_05;
				6 : page_06;
				7 : page_07;
				8 : page_08;
				9 : page_09;
				10 : page_10;
				11 : page_11;
				12 : page_12;
				13 : page_13;
				14 : page_14;
				15 : page_15;
                16 : page_16
			end;
			window(1, 1, twidth, tlength);
			gotoxy(x2, tlength);
			xbool2 := false;
			repeat
				repeat
				until keypressed;
				xchar1 := readkey;
				if keypressed then
					xchar2 := readkey
				else
					xchar2 := #0;
				if (xchar1 = #27) and (xchar2 = #0) then begin
					xbool2 := true;
					xbool1 := true
				end else if (xchar1 = #0) and (xchar2 = #71) and (pg > 1) then
					begin
					xbool2 := true;
					pg := 1
				end else if (xchar1 = #0) and (xchar2 = #73) and (pg > 1) then
					begin
					xbool2 := true;
					dec(pg)
				end else if (xchar1 = #0) and (xchar2 = #79) and (pg < pgmax)
					then begin
					xbool2 := true;
					pg := pgmax
				end else if (xchar1 = #0) and (xchar2 = #81) and (pg < pgmax)
					then begin
					xbool2 := true;
					inc(pg)
				end else begin
					sound(220);
					delay(100);
					nosound
				end
			until xbool2
		until xbool1;
		textattr := attrsave;
		clrscr
	end else begin
		writeln;
		writeln('SYSID requires DOS version 3.0 or later');
		write('Your DOS version is ');
		showvers
	end
end.