PCjs Machines

Home of the original IBM PC emulator for browsers.

Logo

PCx86 CPU Tests

CPUID.ASM

; Posted in comp.sys.ibm.pc by Michael A. Shiels 8/16/89
; From https://groups.google.com/forum/#!searchin/comp.sys.ibm.pc/single-step$20interrupt/comp.sys.ibm.pc/irWPIdzmCHQ/SyqEtq9mqCEJ

	title	CPUID - Determine CPU & NDP Type
	page	58,122
	name	CPUID

;
; CPUID uniquely identifies each NEC & Intel CPU & NDP.
;
; Notes on program structure:
;
;    This program uses four segments, two classes, and one group.
;    It demonstrates a useful technique for programmers who generate
;    .COM programs.  In particular, it shows how to use segment
;    classes to re-order segments, and how to eliminate the linker's
;    warning message about the absence of a stack segment.
;
;    The correspondence between segments and classes is as follows:
;
;	Segment		Class
;	-------		-----
;	STACK		prog
;	DATA		data
;	MDATA		data
;	CODE		prog
;
;    The segments apprear in the above order in the program source
;    to avoid forward references in the CODE segment to labels in
;    the DATA/MDATA segments.  However, because the STACK segment
;    appears first in the file, it and all segments in the same
;    class are made contiguous by the linker.  Thus they precede
;    the DATA/MDATA segments in the resulting .COM file because
;    the latter are in a different class.  In this manner, although
;    DATA and MDATA precede CODE in the source file, their order
;    is swapped in the .COM file.  That way there is no need for
;    an initial skip over the data areas to get to the CODE
;    segment.  As a side benefit, declaring a STACK segment (as
;    the first segment in the source) also eliminates the linker's
;    warning about that segment missing.  Finally, all segments
;    are declared to be in the same group so the linker can properly
;    resolve offsets.
;
;    Note that if you re-assemble the code for any reason, it is
;    important to use an assembler later than the IBM version 1.0.
;    That version has a number of bugs including an annoying habit
;    of alphabetizing segment names in the .OBJ file.  If you use
;    IBM MASM 2.0, be sure to specify /S to order the segments
;    properly.
;
;    If the program reports results at variance with your knowledge
;    of the system, please contact the author.
;
; Environments tested in:
;
;		   CPU Speed
;    System	    in MHz	CPU		NDP
;    ------	   ---------	---		---
;    IBM PC AT		6	Intel 80286	Intel 80287
;    IBM PC AT		9	Intel 80286	Intel 80287
;    IBM PC AT		6	Intel 80286	none
;    IBM PC AT		8.5	Intel 80286	none
;    IBM PC		4.77	Intel 8088	Intel 8087-3
;    IBM PC		4.77	Intel 8088*	Intel 8087-3
;    IBM PC XT		4.77	Intel 8088	none
;    IBM PC XT		4.77	Intel 8088	Intel 8087-3
;    IBM PC Portable	4.77	NEC V20		none
;    COMPAQ		4.77	Intel 8088	none
;    COMPAQ		4.77	NEC V20		none
;    AT&T PC 6300	8	Intel 8086	Intel 8087-2
;    AT&T PC 6300	8	NEC V30		Intel 8087-2
;    Tandy 2000		8	Intel 80186	none
;
;    * = faulty CPU
;
; Program structure:
;
;	Group PGROUP:
;	Stack	segment	STACK, byte-aligned, stack,  class 'prog'
;	Program segment CODE,  byte-aligned, public, class 'prog'
;	Data	segment DATA,  byte-aligned, public, class 'data'
;	Data	segment MDATA, byte-aligned, public, class 'data'
;
; Assembly requirements:
;
;	Use MASM 1.25 or later.
;	With IBM's MASM 2.0 only, use /S to avoid alphabetizing the segment names.
;	Use /r option to generate real NDP code.
;
;	MASM CPUID/r;			to convert .ASM to .OBJ
;	LINK CPUID;			to convert .OBJ to .EXE
;	EXE2BIN CPUID CPUID.COM		to convert .EXE to .COM
;	ERASE CPUID.EXE			to avoid executing .EXE
;
;	Note that the linker doesn't warn about a missing stack segment.
;
; Author:
;
; Original code by:
;
;	Bob Smith    May 1985
;	Qualitas, Inc.
;	8314 Thoreau Dr.
;	Bethesda, MD   20817
;
; Arthur Zachai suggested the technique to distinguish within the
; 808x and 8018x families by exploiting the difference in the
; length of their pre-fetch instruction queues.
;
; Published in PC Tech Journal - April 1986 - Vol 4 No 4
;
	subttl	Structures, Records, Equates, & Macros
	page

ARG_STR struct
ARG_BP	dw	?	; caller's BP
ARG_OFF	dw	?	; caller's offset
ARG_SEG dw	?	;	   segment
ARG_FLG dw	?	;	   flags
ARG_STR	ends

; Record to define bits in the CPU's & NDP's flags' registers

CPUFLAGS record RO:1,NT:1,IOPL:2,OF:1,_DF:1,_IF:1,TF:1,SF:1,ZF:1,R1:1,AF:1,R2:1,PF:1,R3:1,CF:1

NDPFLAGS record R4:3,IC:1,RC:2,PC:2,IEM:1,R5:1,PM:1,UM:1,OM:1,ZM:1,DM:1,IM:1

;	FLG_PIQL	Pre-fetch instruction queue length, 0 => 4-byte, 1 => 6-byte
;	FLG_08		Intel 808x
;	FLG_NEC		NEC V20 or V30
;	FLG_18		Intel 8018x
;	FLG_28		Intel 8028x
;	FLG_87		Intel 8087
;	FLG_287		Intel 80287
;
;	FLG_CERR	Faulty CPU
;	FLG_NERR	Faulty NDP switch setting

FLG	record	RSVD:9,FLG_NERR:1,FLG_CERR:1,FLG_NDP:2,FLG_CPU:3

; CPU-related flags

FLG_PIQL	equ	001b shl FLG_CPU
FLG_08		equ	000b shl FLG_CPU
FLG_NEC		equ	010b shl FLG_CPU
FLG_18		equ	100b shl FLG_CPU
FLG_28		equ	110b shl FLG_CPU

FLG_8088	equ	FLG_08
FLG_8086	equ	FLG_08 or FLG_PIQL
FLG_V20		equ	FLG_NEC
FLG_v30		equ	FLG_NEC or FLG_PIQL
FLG_80188	equ	FLG_18
FLG_80186	equ	FLG_18 or FLG_PIQL
FLG_80286	equ	FLG_28 or FLG_PIQL

; NDP-related flags

;			00b shl FLG_NDP	Not Present
FLG_87		equ	01b shl FLG_NDP
FLG_287		equ	10b shl FLG_NDP
BEL		equ	07h
LF		equ	0ah
CR		equ	0dh
EOS		equ	'$'

POPFF	macro
	local	L1,L2
	jmp	short L2		; skip over IRET
L1:
	iret				; pop the CP & IP pushed below along
					; with the flags, our original purpose
L2:
	push	cs			; prepare for IRET by pushing CS
	call	L1			; push IP, jump to IRET
	endm				; POPFF macro

TAB	macro	TYP
	push	bx			; save for a moment
	and	bx,mask FLG_&TYP	; isolate flags
	mov	cl,FLG_&TYP		; shift amount
	shr	bx,cl			; shift to low-order
	shl	bx,1			; times two to index table of words
	mov	dx,TYP&MSG_TAB[bx]	; ds:dx => descriptive message
	pop	bx			; restore
	mov	ah,09h			; function code to display string
	int	21h			; request dos service
	endm				; TAB macro

	page

INT_VEC	segment at 0			; start INT_VEC segment
		dd	?		; pointer to INT 00h
INT01_OFF	dw	?		; pointer to INT 01h
INT01_SEG	dw	?
INT_VEC	ends				; end INT_VEC segment

PGROUP	group	STACK,CODE,DATA,MDATA

; The following segment both positions class 'prog' segments lower in
; memory than others so the first byte of the resulting .COM file is
; in the CODE segment, as well as satisfies the LINKer's need to have
; a stack segment.

STACK	segment	byte stack 'prog'	; start STACK segment
STACK	ends				; end STACK segment

I11_REC	record	I11_PRN:2,I11_RSV1:2,I11_COM:3,I11_RSV2:1,I11_DISK:2,I11_VID:2,I11_RSV3:2,I11_NDP:1,I11_IPL:1

DATA	segment	byte public 'data'	; start DATA segment

	assume	ds:PGROUP

OLDINT01_VEC	label	dword		; save area for original INT 01h handler
OLDINT01_OFF	dw	?
OLDINT01_SEG	dw	?

NDP_CW	label	word			; save area for NDP control word
		db	?
NDP_CW_HI	db	0		; high byte of control word
NDP_ENV		dw	7 dup(?)	; save area for NDP environment

DATA	ends
	subttl	Message Data Area
	page

MDATA	segment	byte public 'data'	; start MDATA segment

	assume	ds:PGROUP

MSG_START	db	'CPUID -- Version 1.0'
		db	CR,LF,CR,LF,EOS
MSG_8088	db	'CPU is an Intel 8088.'
		db	CR,LF,EOS
MSG_8086	db	'CPU is an Intel 8086.'
		db	CR,LF,EOS
MSG_V20		db	'CPU is an NEC V20.'
		db	CR,LF,EOS
MSG_V30		db	'CPU is an NEC V30.'
		db	CR,LF,EOS
MSG_80188	db	'CPU is an Intel 80188.'
		db	CR,LF,EOS
MSG_80186	db	'CPU is an Intel 80186.'
		db	CR,LF,EOS
MSG_UNK		db	'CPU is a maverick -- 80288??.'
		db	CR,LF,EOS
MSG_80286	db	'CPU is an Intel 80286.'
		db	CR,LF,EOS

CPUMSG_TAB	dw	PGROUP:MSG_8088		; 000 = Intel 8088
		dw	PGROUP:MSG_8086		; 001 = Intel 8086
		dw	PGROUP:MSG_V20		; 010 = NEC V20
		dw	PGROUP:MSG_V30		; 011 = NEC V30
		dw	PGROUP:MSG_80188	; 100 = Intel 80188
		dw	PGROUP:MSG_80186	; 101 = Intel 80186
		dw	PGROUP:MSG_UNK		; 110 = ?
		dw	PGROUP:MSG_80286	; 111 = Intel 80286

NDPMSG_TAB	dw	PGROUP:MSG_NDPX		; 00 = No NDP
		dw	PGROUP:MSG_8087		; 01 = Intel 8087
		dw	PGROUP:MSG_80287	; 10 = Intel 80287

MSG_NDPX	db	'NDP is not present.'
		db	CR,LF,EOS
MSG_8087	db	'NDP is an Intel 8087.'
		db	CR,LF,EOS
MSG_80287	db	'NDP is an Intel 80287.'
		db	CR,LF,EOS

CERRMSG_TAB	dw	PGROUP:MSG_CPUOK	; 0 = CPU healthy
		dw	PGROUP:MSG_CPUBAD	; 1 = CPU faulty

MSG_CPUOK	db	'CPU appears to be healthy.'
		db	CR,LF,EOS
MSG_CPUBAD	db	BEL,'*** CPU incorrectly allows interrupts '
		db	'after a change to SS ***',CR,LF
		db	'It should be replaced with a more recent '
		db	'version as it could crash the',CR,LF
		db	'system at seemingly random times.',CR,LF,EOS

NERRMSG_TAB	dw	PGROUP:MSG_NDPSWOK	; 0 = NDP switch set correctly
		dw	PGROUP:MSG_NDPSWERR	; 1 = NDP switch set incorrectly

MSG_NDPSWOK	db	EOS			; no message
MSG_NDPSWERR	db	'*** Although there is an NDP installed '
		db	'on this sytem, the corresponding',CR,LF
		db	'system board switch is not properly set.  '
		db	'To correct this, flip switch 2 of',CR,LF
		db	'switch block 1 on the system board.',CR,LF,EOS

MDATA	ends				; end MDATA segment

	subttl	Main Routine
	page

CODE	segment	byte public 'prog'	; start CODE segment

	assume	  cs:PGROUP,ds:PGROUP,es:PGROUP

	org    100h			; skip over PSP

INITIAL	proc	near
	mov	dx,offset ds:MSG_START	; starting message
	mov	ah,09h			; function code to display string
	int	21h			; request DOS service

	call	CPU_ID			; check the CPU's identity

	TAB	CPU			; display CPU results
	TAB	NDP			; display NDP results
	TAB	CERR			; display CPU ERR results
	TAB	NERR			; display NDP ERR results

	ret				; return to DOS
INITIAL endp				; end INITIAL procedure

	subttl	CPU_ID Procedure
	page

CPU_ID	proc	near			; start CPU_ID procedure

	assume	cs:PGROUP,ds:PGROUP,es:PGROUP

; This procedure determines the type of CPU and NDP (if any) in use.
;
; The possibilities include:
;
;	Intel 8086
;	Intel 8088
;	NEC V20
;	NEC V30
;	Intel 80186
;	Intel 80188
;	Intel 80286
;	Intel 8087
;	Intel 80287
;
; Also checked is whether or not the CPU allows interrupts after
; changing the SS register segment.  If the CPU does, it is faulty
; and should be replaced.
;
; Further, if an NDP is installed, non-AT machines should have a
; system board switch set.  Such a discrepancy is reported.
;
; On exit, BX contains flag settings (as defined in FLG record) which
; the caller can check.  For example, to test for an Intel 80286, use
;
;	and	bx,mask FLAG_CPU
;	cmp	bx,FLG_80286
;	je	ITSA286

	irp	XX,<ax,cx,di,ds,es>	; save registers
	push	XX
	endm

; test for 80286 -- this CPU executes PUSH SP by first storing SP on
; stack, then decrementing it.  earlier CPU's decrement, THEN store.

	mov	bx,FLG_28		; assume it's a 286
	push	sp			; only 286 pushes pre-push SP
	pop	ax			; get it back
	cmp	ax,sp			; check for same
	je	CHECK_PIQL		; they are, so it's a 286

; test for 80186/80188 -- 18xx and 286 CPU's mask shift/rotate
; operations mod 32; earlier CPUs use all 8 bits of CL.

	mov	bx,FLG_18		; assume it's an 8018x
	mov	cl,32+1			; 18x masks shift counts mod 32
					; note we can't use just 32 in CL
	mov	al,0ffh			; start with all bits set

	shl	al,cl			; shift one position if 18x
	jnz	CHECK_PIQL		; some bits still on,
					; so its a 18x, check PIQL
; test for V20

	mov	bx,FLG_NEC		; assume it's an NEC V-series CPU
	call	CHECK_NEC		; see if it's an NEC chip
	jcxz	CHECK_PIQL		; good guess, check PIQL

	mov	bx,FLG_08		; it's an 808x

	subttl	Check Length of Pre-Fetch Instruction Queue
	page

; Check the length of the pre-fetch instruction queue (PIQ).
;
; xxxx6 CPUs have a PIQ length of 6 bytes,
; xxxx8 CPUs have a PIQ length of 4 bytes
;
; Self-modifying code is used to distinguish the two PIQ lengths.

CHECK_PIQL:
	call	PIQL_SUB		; handle via subroutine
	jcxz	CHECK_ERR		; if CX is 0, INC was not executed,
					; hence PIQ length is 4
	or	bx,FLG_PIQL		; PIQ length is 6

	subttl	Check for Allowing Interrupts After POP SS
	page

; Test for faulty chip (allows interrupts after change to SS register)

CHECK_ERR:
	xor	ax,ax			; prepare to address
					; interrupt vector segment
	mov	ds,ax			; DS points to segment 0

	assume	ds:INT_VEC		; tell the assembler

	cli				; nobody move while we swap

	mov	ax,offset cs:INT01	; point to our own handler
	xchg	ax,INT01_OFF		; get and swap offset
	mov	OLDINT01_OFF,ax		; save to restore later

	mov	ax,cs			; our handler's segment
	xchg	ax,INT01_SEG		; get and swap segment
	mov	OLDINT01_SEG,ax		; save to restore later

; note we continue with interrupts disabled to avoid
; an external interrupt occuring during this test

	mov	cx,1			; initialize a register
	push	ss			; save ss to store back into itself
	pushf				; move flags
	pop	ax			; ... into ax
	or	ax,mask TF		; set trap flag
	push	ax			; place onto stack
	POPFF				; ... and then into effect
					; some CPUs affect the trap flag
					; immediately, some
					; wait one instruction
	nop				; allow interrupt to take effect

POST_NOP:
	pop	ss			; change the stack segment register
					; (to itself)
	dec	cx			; normal cpu's execute this instruction
					; before recognizing the single-step
					; interrupt
	hlt				; we never get here

INT01:

; Note: IF=TF=0
; If we're stopped at or before POST_NOP, continue on

	push	bp			; prepare to address the stack
	mov	bp,sp			; hello, Mr. stack

	cmp	[bp].ARG_STR.ARG_OFF,offset cs:POST_NOP	; check offset
	pop	bp			; restore
	ja	INTO1_DONE		; we're done

	iret				; return to caller

INTO1_DONE:

; restore old INT 01h handler

	les	ax,OLDINT01_VEC		; ES:AX ==> old INT 01h handler
	assume	es:nothing		; tell the assembler
	mov	INT01_OFF,ax		; restore offset
	mov	INT01_SEG,es		; ... and segment
	sti				; allow interrupts again (IF=1)

	add	sp,3*2			; strip IP, CS, and flags from stack

	push	cs			; setup DS for code below
	pop	ds
	assume	ds:PGROUP		; tell the assembler

	jcxz	CHECK_NDP		; if cx is 0, the dec cx was executed,
					; and the cpu is ok
	or	bx,mask FLG_CERR	; it's a faulty chip

	subttl	Check For Numeric Data Processor
	page

; Test for a Numeric Data Processor -- Intel 8087 or 80287.  The
; technique used is passive -- it leaves the NDP in the same state in
; which it is found.

CHECK_NDP:
	cli				; protect FNSTENV
	fnstenv NDP_ENV			; if NDP present, save
					; current environment,
					; otherwise, this instruction
					; is ignored
	mov	cx,50/7			; cycle this many times
	loop	$			; wait for result to be stored
	sti				; allow interrupts
	fninit				; initialize processor to known state
	jmp	short $+2		; wait for initialization

	fnstcw	NDP_CW			; save control word
	jmp	short $+2		; wait for result to be stored
	jmp	short $+2
	cmp	NDP_CW_HI,03h		; check for NDP initial control word
	jne	CPUID_EXIT		; no NDP installed
	int	11h			; get equipment flags into ax
	test	ax,mask I11_NDP		; check NDP-installed bit
	jnz	CHECK_NDP1		; it's correctly set
	or	bx,mask FLG_NERR	; mark as in error

CHECK_NDP1:
	and	NDP_CW,not mask IEM	; enable interrupts
					; (IEM=0, 8087 only)
	fldcw	NDP_CW			; reload control word
	fdisi				; disable interrupts (IEM=1) on 8087,
					; ignored by 80287
	fstcw	NDP_CW			; save control word
	fldenv	NDP_ENV			; restore original NDP environment
					; no need to wait
					; for environment to be loaded
	test	NDP_CW,mask IEM		; check interrupt enable mask
					; (8087 only)
	jnz	CPUID_8087		; it changed, hence NDP is an 8087
	or	bx,FLG_287		; NDP is an 80287
	jmp	short CPUID_EXIT	; exit with falgs in BX

CPUID_8087:
	or	bx,FLG_87		; NDP is an 8087

CPUID_EXIT:
	irp    XX,<es,ds,di,cx,ax>	; restore registers
	pop    XX
	endm

	assume	ds:nothing,es:nothing
	ret				; return to caller
CPU_ID	endp				; end CPU_ID procedure

	subttl	Check For NEC V20/V30
	page

CHECK_NEC proc	near

; The NEC V20/V30 are very compatible with the Intel 8086/8088.
; The only point of "incompatibility" is that they do not contain
; a bug found in the Intel CPU's.  Specifically, the NEC CPU's
; correctly restart an interrupted multi-prefix string instruction
; at the start of the instruction.  The Intel CPU's incorrectly
; restart in the middle of the instruction.  This routine tests
; for that situation by executing such an instruction for a
; sufficiently long period of time for a timer interrupt to occur.
; If at the end of the instruction, CX is zero, it must be an NEC
; CPU; if not, it's an Intel CPU.
;
; Note that we're counting on the timer interrupt to do its thing
; every 18.2 times per second.
;
; Here's a worst case analysis: An Intel 8088/8086 executes 65535
; iterations of LODSB ES[SI] in 2+9+13*65535 = 851,966 clock ticks.
; If the Intel 8088/8086 is running at 10 MHz, each clock tick is
; 100 nanoseconds, hence the entire operation takes 85 milliseconds.
; If the timer is running at normal speed, it interrupts the CPU every
; 55ms and so should interrupt the repeated string instruction at least
; once.

	mov	cx,0ffffh		; move a lot of data
	sti				; ensure timer enabled

; execute multi-prefix instruction.  note that the value of ES as
; well as the direction flag setting is irrelevant.

	push	ax			; save registers
	push	si
	rep	lods byte ptr es:[si]
	pop	si			; restore
	pop	ax

; on exit: if cx is zero, it's an NEC CPU, otherwise it's an Intel CPU

	ret				; return to caller
CHECK_NEC endp

	subttl	Pre-Fetch Instruction Queue Subroutine
	page

PIQL_SUB proc	near

; This subroutine discerns the length of the CPU's pre-fetch
; instruction queue (PIQ).
;
; The technique used is to first ensure that the PIQ is full, then
; change an instruction which should be in a 6-byte PIQ but not in a
; 4-byte PIQ.  Then, if the original instruction is executed, the PIQ
; is 6-bytes long; if the new instruction is executed, PIQ length is 4.
;
; We ensure the PIQ is full be executing an instruction which takes
; long enough so that the Bus Interface Unit (BIU) can fill the PIQ
; while the instruction is executing.
;
; Specifically, for all byt the last STOSB, we're simple marking time
; waiting for the BIU to fill the PIQ.  The last STOSB actually changes
; the instruction.  By that time, the orignial instruction should be in
; a six-byte PIQ byt not a four-byte PIQ.

	assume	cs:PGROUP,es:PGROUP
@REP	equ	3			; repeat the store this many times
	std				; store backwards
	mov	di,offset es:LAB_INC+@REP-1 ; change the instructions
					; at ES:DI
					; and preceding
	mov	al,ds:LAB_STI		; change to a sti
	mov	cx,@REP			; give the BIU time
					; to pre-fetch instructions
	cli				; ensure interrupts are disabled,
					; otherwise a timer tick
					; could change the PIQ filling
	rep	stosb			; change the instruction
					; during execution of this instruction
					; the BIU is refilling the PIQ.  The
					; current instruction is no longer
					; in the PIQ.
					; Note at end, CX is 0.
; The PIQ begins filling here

	cld				; restore direction flag
	nop				; PIQ fillers
	nop
	nop

; The following instruction is beyond a four-byte-PIQ CPU's reach,
; but within that of a six-byte-PIQ CPU.

LAB_INC	label	byte
	inc	cx			; executed only if PIQ length is 6

LAB_STI	label	byte
	rept	@REP-1
	sti				; restore interrupts
	endm

	ret				; return to caller

	assume	ds:nothing,es:nothing
PIQL_SUB endp				; end PIQL_SUB procedure

CODE	ends				; end code segment

	end	INITIAL			; end CPU_ID module

ID.ASM

bits 16
cpu 8086

CPU_86 equ 0
CPU_NEC equ 1
CPU_186 equ 2
CPU_286 equ 3
CPU_386 equ 4

section code start=0 vstart=0x100

start:
    mov dx, .tcpu
    call print
    call getcpu
    cbw
    push ax
    xchg si, ax
    shl si, 1
    mov dx, [si+.tt]
    call print
    pop ax
    cmp al, CPU_286
    jnb .getmsw
    int 0x20
    cpu 286
.getmsw:
    push ax
    mov dx, .tmsw
    call print
    smsw ax
    call hex2
    mov dx, .tibase
    call print
    sub sp, 6
    mov bp, sp
    sidt [bp]
    pop cx
    pop dx
    pop ax
    call hex2
    xchg ax, dx
    call hex2
    mov dx, .tilimit
    call print
    xchg ax, cx
    call hex2
    pop ax
    cmp al, CPU_386
    jnb .getcr
    int 0x20
    cpu 386
.getcr:
    push ax
    mov dx, .tcr0
    call print
    mov eax, cr0
    push eax
    call hex3
    mov dx, .tccr0
    call print
    xor eax, eax
    mov cr0, eax
    jmp $+2 ; just in case...
    mov eax, cr0
    pop ecx
    mov cr0, ecx
    jmp $+2
    call hex3
    
    pop ax
    
    int 0x20
    cpu 8086
    
section data follows=code vfollows=code

.tcpu:      db "CPU: $"
.tt:        dw .t86,.tnec,.t186,.t286,.t386
.t86:       db "8088/8086$"
.tnec:      db "V20/V30$"
.t186:      db "188/186$"
.t286:      db "286$"
.t386:      db "386+$"
.tmsw:      db 13,10,"MSW: 0x$"
.tibase:    db 13,10,"IDTR: base 0x$"
.tilimit:   db " limit 0x$"
.tcr0:      db 13,10,"CR0: 0x$"
.tccr0:     db 13,10,"Cleared CR0: 0x$"

section code

print:
    mov ah, 0x09
    int 0x21
    ret

getcpu:
    sub sp, 6
    push sp
    pop bp
    cmp sp, bp
    je ._286
    mov ax, -1
    mov cl, 0x21
    shr ax, cl
    or al, al
    mov al, CPU_186
    jnz .done
    mov ax, 0x101
    aad 0x10
    cmp al, 0x11
    mov al, CPU_NEC
    jne .done
    mov al, CPU_86
.done:
    add sp, 6
    ret
._286:
    cpu 286
    sidt [bp]
    pop ax
    pop ax
    pop ax
    or ah, ah
    mov al, CPU_286
    jnz .done2
    mov al, CPU_386
.done2:
    ret
    cpu 8086

hex2:
    cpu 286
    pusha
    mov bx, ax
    mov cx, 4
.hexloop:
    rol bx, 4
    mov ax, bx
    and al, 0x0f
    cmp al, 0x0a
    sbb al, 0x69
    das
    xchg ax, dx
    mov ah, 0x02
    int 0x21
    loop .hexloop
    popa
    ret
    cpu 8086
    
hex3:
    cpu 386
    rol eax, 16
    call hex2
    rol eax, 16
    jmp hex2
    cpu 8086

TEST386.ASM

One early use of the pc.js utility was running a set of 80386 CPU Tests as a custom ROM image inside an 80386 Test Machine, and then comparing the results to output from real hardware.

The test program (test386.asm) was carefully designed to be built as a binary (test386.com) that could either be run as a DOS program or loaded as a ROM image. To run the tests as a ROM image using pc.js:

cd pcjs/tools/pc
pc.js test386
;
;   test386.asm
;   Copyright © 2012-2018 Jeff Parsons <Jeff@pcjs.org>
;
;   This file is part of PCjs, a computer emulation software project at <https://www.pcjs.org>.
;
;   Overview
;   --------
;   This file is designed to run both as a test ROM and as a DOS .COM file (hence the "org 0x100"),
;   which is why it has a ".com" extension instead of the more typical ".rom" extension.
;
;   When used as a ROM, it should be installed at physical address 983296 (0xf0100) and aliased at
;   physical address 4294902016 (0xffff0100).  The jump at jmpStart should align with the CPU reset
;   address (%0xfffffff0), which will transfer control to 0xf000:0x0100.  From that point on,
;   all memory accesses should remain within the first 1Mb.
;
;   The code which attempts to update myGDT and addrGDT will have no effect when installed as a ROM,
;   which is fine, because those data structures are predefined with appropriate ROM-based addresses.
;
;   See the machine configuration file "/tools/pc/test386.json5" for a test machine that can load
;   this file as a ROM image.
;
;   REAL32 Notes
;   ------------
;   REAL32 is NOT enabled by default, because based on what I've seen in VirtualBox (and notes at
;   http://geezer.osdevbrasil.net/johnfine/segments.htm), if CS is loaded with a 32-bit code segment
;   while in protected-mode and we then return to real-mode, even if we immediately perform a FAR jump
;   with a real-mode CS, the base of CS will be updated, but all the other segment attributes, like
;   the 32-bit EXT_BIG attribute, remain unchanged.  As a result, the processor will crash as soon as
;   it starts executing 16-bit real-mode code, because it's being misinterpreted as 32-bit code, and
;   there doesn't appear to be anything you can do about it from real-mode.
;
;   The work-around: you MUST load CS with a 16-bit code segment BEFORE returning to real-mode.
;
;   "Unreal mode" works by setting OTHER segment registers, like DS and ES, to 32-bit segments before
;   returning to real-mode -- just not CS.  SS probably shouldn't be set to a 32-bit segment either,
;   because that causes implicit pushes to use ESP instead of SP, even in real-mode.
;
;   The code below ensures that, before returning to real-mode, all of CS, DS, ES, and SS contain
;   16-bit protected-mode selectors; note, however, that my 16-bit protected-mode data descriptor uses
;   a full 20-bit limit, so DS, ES, and SS will still have a limit of 1Mb instead of the usual 64Kb,
;   even after returning to real-mode.  I use the larger limit because it's convenient to have access
;   to the first 1Mb in protected-mode, with or without a 32-bit data segment, and the larger data
;   segment limit shouldn't affect any 16-bit real-mode operations.
;
	cpu	386
	org	0x100
	section .text

	%include "dos.inc"
	%include "misc.inc"
	%include "x86.inc"

	bits	16

PAGING equ 1

;
;   If we built our data structures in RAM, we might use the first page of RAM (0x0000-0x0fff) like so:
;
;	0x0000-0x03ff	Real-mode IDT (256*4)
;	0x0400-0x0bff	Prot-mode IDT (256*8)
;	0x0c00-0x0cff	RAM_GDT (for 32 GDT selectors)
;	0x0d00-0x0d07	RAM_IDTR
;	0x0d08-0x0d0f	RAM_GDTR
;	0x0d10-0x0d13	RAM_RETF (Real-mode return address)
;	0x0d14-0x0fff	reserved
;
;   And in the second page (0x1000-0x1fff), we might build a page directory, followed by a single page table
;   that allows us to map up to 4Mb (although we'd likely only create PTEs for the first 1Mb).
;
;   However, the code to do that is currently disabled (see %ifdef RAM_GDT), because it's just as easy to define
;   the structures we need inside the .COM image and statically initialize them to the values assumed for ROM
;   operation.  For RAM operation, we tweak the structures as needed; the tweaks have no effect when loaded in ROM.
;
;RAM_GDT	equ	0x0c00
;RAM_IDTR	equ	0x0d00
;RAM_GDTR	equ	0x0d08
;RAM_RETF	equ	0x0d10
;

CSEG_REAL	equ	0xf000
CSEG_PROT16	equ	0x0008
CSEG_PROT32	equ	0x0010
DSEG_PROT16	equ	0x0018
DSEG_PROT32	equ	0x0020
SSEG_PROT32	equ	0x0028

;
;   We set our exception handlers at fixed addresses to simplify interrupt gate descriptor initialization.
;
OFF_INTDIVERR	equ	0xe000

;
;   The "defGate" macro defines an interrupt gate, given a selector (%1) and an offset (%2)
;
%macro	defGate	2
	dw	(%2 & 0xffff)
	dw	%1
	dw	ACC_TYPE_GATE386_INT | ACC_PRESENT
	dw	(%2 >> 16) & 0xffff
%endmacro

;
;   The "defDesc" macro defines a descriptor, given a name (%1), base (%2), limit (%3), type (%4), and ext (%5)
;
%assign	selDesc	0

%macro	defDesc	1-5 0,0,0,0
	%assign %1 selDesc
	dw	(%3 & 0x0000ffff)
	dw	(%2 & 0x0000ffff)
    %if selDesc = 0
	dw	((%2 & 0x00ff0000) >> 16) | %4 | (0 << 13)
    %else
	dw	((%2 & 0x00ff0000) >> 16) | %4 | (0 << 13) | ACC_PRESENT
    %endif
	dw	((%3 & 0x000f0000) >> 16) | %5 | ((%2 & 0xff000000) >> 16)
	%assign selDesc selDesc+8
%endmacro

;
;   The "setDesc" macro creates a descriptor, given a name (%1), base (%2), limit (%3), type (%4), and ext (%5)
;
%macro	setDesc 1-5 0,0,0,0
	%assign %1 selDesc
	set	ebx,%2
	set	ecx,%3
	set	dx,%4
	set	ax,%5
	call	storeDesc
	%assign selDesc selDesc+8
%endmacro

start:	nop
;
;   If we didn't CALL or PUSH anything on the stack AND we turned interrupts off, the top of our image would be
;   safe, but if we're running in RAM, we do issue a few DOS calls before switching into protected-mode and onto
;   a new stack, so we need to set SP to a safer location inside the .COM image.
;
	mov	sp,tempStack
;
;   Quick tests of unsigned 32-bit multiplication and division
;
	mov	eax,0x80000001
	imul	eax

	mov	eax,0x44332211
	mov	ebx,eax
	mov	ecx,0x88776655
	mul	ecx
	div	ecx
	cmp	eax,ebx
	jne	near error		; apparently we have to tell NASM v0.98.40 "near" for all long forward references

	xor	dx,dx
	mov	ds,dx			; DS -> 0x0000
;
;   Quick test of moving a segment register to a 32-bit register
;
	mov	eax,ds
	test	eax,eax
	jnz	near error

	jmp	initGDT
	times	32768 nop		; lots of NOPs to test generation of 16-bit conditional jumps
tempStack:
;
;   storeDesc(EBX=base, ECX=limit, DX=type, AX=ext, DI=address of descriptor)
;
storeDesc:
	cld
	push	ax
	mov	ax,cx
	stosw				; store the low 16 bits of limit from ECX
	mov	ax,bx
	stosw				; store the low 16 bits of base from EBX
	mov	ax,dx
	shr	ebx,16
	mov	al,bl
	or	ax,ACC_PRESENT
	stosw
	pop	ax
	shr	ecx,16
	and	cl,0xf
	or	al,cl
	mov	ah,bh
	stosw
	ret

addrGDT:dw	myGDTEnd - myGDT - 1	; 16-bit limit of myGDT
	dw	myGDT, 0x000f		; 32-bit base address of myGDT

myGDT:	defDesc	NULL			; the first descriptor in any descriptor table is always a dud (it corresponds to the null selector)
	defDesc	CSEG_PROT16,0x000f0000,0x0000ffff,ACC_TYPE_CODE_READABLE,EXT_NONE
	defDesc	CSEG_PROT32,0x000f0000,0x0000ffff,ACC_TYPE_CODE_READABLE,EXT_BIG
	defDesc	DSEG_PROT16,0x00000000,0x000fffff,ACC_TYPE_DATA_WRITABLE,EXT_NONE
	defDesc	DSEG_PROT32,0x00000000,0x000fffff,ACC_TYPE_DATA_WRITABLE,EXT_BIG
	defDesc	SSEG_PROT32,0x00010000,0x000effff,ACC_TYPE_DATA_WRITABLE,EXT_BIG
myGDTEnd:

addrIDT:dw	myIDTEnd - myIDT - 1	; 16-bit limit of myIDT
	dw	myIDT, 0x000f		; 32-bit base address of myIDT

myIDT:	defGate	CSEG_PROT32,OFF_INTDIVERR
myIDTEnd:

addrIDTReal:
	dw	0x3FF			; 16-bit limit of real-mode IDT
	dd	0x00000000		; 32-bit base address of real-mode IDT

initGDT:
    %ifdef RAM_GDT
	set	edi,RAM_GDT
	mov	[RAM_GDTR+2],edi
	setDesc	NULL
	xor	eax,eax
	mov	ax,cs
	shl	eax,4
	setDesc	CSEG_PROT16,eax,0x0000ffff,ACC_TYPE_CODE_READABLE,EXT_NONE
	setDesc	CSEG_PROT32,eax,0x0000ffff,ACC_TYPE_CODE_READABLE,EXT_BIG
	setDesc	DSEG_PROT16,0x00000000,0x000fffff,ACC_TYPE_DATA_WRITABLE,EXT_NONE
	setDesc	DSEG_PROT32,0x00000000,0x000fffff,ACC_TYPE_DATA_WRITABLE,EXT_BIG
	setDesc	SSEG_PROT32,0x00010000,0x000effff,ACC_TYPE_DATA_WRITABLE,EXT_BIG
	sub	edi,RAM_GDT
	dec	edi
	mov	[RAM_GDTR],di
	mov	word [RAM_RETF],toReal
	mov	word [RAM_RETF+2],cs
    %else
;
;   This code fixes the GDT and all our far jumps if we're running in RAM
;
    	xor	eax,eax
	mov	ax,cs
	shl	eax,4				; EAX == base address of the current CS
	mov	edx,eax				; save it in EDX
	mov	[cs:myGDT+CSEG_PROT16+2],ax	; update the base portions of the descriptor for CSEG_PROT16 and CSEG_PROT32
	mov	[cs:myGDT+CSEG_PROT32+2],ax
	shr	eax,16
	mov	[cs:myGDT+CSEG_PROT16+4],al
	mov	[cs:myGDT+CSEG_PROT32+4],al
	mov	[cs:myGDT+CSEG_PROT16+7],ah
	mov	[cs:myGDT+CSEG_PROT32+7],ah
	mov	eax,edx				; recover the base address of the current CS
	add	eax,myGDT			; EAX == physical address of myGDT
	mov	[cs:addrGDT+2],eax		; update the 32-bit base address of myGDT in addrGDT
	mov	eax,edx				; recover the base address of the current CS again
	add	eax,myIDT			; EAX == physical address of myIDT
	mov	[cs:addrIDT+2],eax		; update the 32-bit base address of myIDT in addrIDT
	mov	ax,cs
      %ifdef REAL32
	mov	[cs:jmpReal+5],ax		; update the segment of the FAR jump that returns us to real-mode
      %else
	mov	[cs:jmpReal+3],ax
      %endif
	mov	[cs:jmpStart+3],ax		; ditto for the FAR jump that returns us to the start of the image
    %endif
;
;   Now we want to build a page directory and a page table, but we need two pages of
;   4K-aligned physical memory.  We can use a hard-coded address (segment 0x100, corresponding
;   to physical address 0x1000) if we're running in ROM; otherwise, we ask DOS for some memory.
;
    	cmp	ax,CSEG_REAL
    	mov	ax,0x100			; default to the 2nd physical page in low memory
    	je	initPages

    	mov	bx,0x1000			; 4K paragraphs == 64K bytes
    	mov	ah,DOS_SETBLOCK			; resize the current block so we can allocate a new block
    	int	INT_DOS
    	jnc	allocPages

exitErrDOSMem:
    	mov	dx,errDOSMem

exitErrDOS:
	mov	ah,DOS_STD_CON_STRING_OUTPUT
	int	INT_DOS
	int	INT_DOSEXIT

errDOSMem:
	db     "Insufficient memory",CR,LF,'$'

allocPages:
	mov	bx,0x2000			; 8K paragraphs == 128K bytes
	mov	ah,DOS_ALLOC
	int	INT_DOS
	jc	errDOSMem
;
;   AX == segment of 64K memory block
;
initPages:
    	movzx	eax,ax
    	shl	eax,4
    	add	eax,0xfff
    	and	eax,~0xfff
	mov	esi,eax				; ESI == first physical 4K-aligned page within the given segment
    	shr	eax,4
    	mov	es,ax
    	xor	edi,edi
;
;   Build a page directory at ES:EDI with only 1 valid PDE (the first one),
;   because we're not going to access any memory outside the first 1Mb (of the first 4Mb).
;
	cld
	mov	eax,esi
	add	eax,0x1000			; EAX == page frame address (of the next page)
	or	eax,PTE_USER | PTE_READWRITE | PTE_PRESENT
	stosd
    	mov	ecx,1024-1			; ECX == number of (remaining) PDEs to write
    	sub	eax,eax
	rep	stosd
;
;   Build a page table at EDI with 256 (out of 1024) valid PTEs, mapping the first 1Mb of the
;   first 4Mb as linear == physical.
;
	mov	eax,PTE_USER | PTE_READWRITE | PTE_PRESENT
    	mov	ecx,256				; ECX == number of PTEs to write
initPT:	stosd
	add	eax,0x1000
	loop	initPT
    	mov	ecx,1024-256			; ECX == number of (remaining) PTEs to write
    	sub	eax,eax
    	rep	stosd

goProt:
	cli					; make sure interrupts are off now, since we've not initialized the IDT yet
	o32 lidt [cs:addrIDT]
	o32 lgdt [cs:addrGDT]
	mov	cr3,esi
	mov	eax,cr0
    %if PAGING
	or	eax,CR0_MSW_PE | CR0_PG
    %else
	or	eax,CR0_MSW_PE
    %endif
	mov	cr0,eax
	jmp	CSEG_PROT32:toProt32

toProt32:
	bits	32

	mov	ax,DSEG_PROT16
	mov	ds,ax
	mov	es,ax
;
;   Of the 128Kb of scratch memory we allocated, we may have lost as much as 4Kb-1 rounding
;   up to the first physical 4Kb page; the next 8Kb (0x2000) was used for a page directory and a
;   single page table, leaving us with a minimum of 116Kb to play with, starting at ESI+0x2000.
;
;   We'll set the top of our stack to ESI+0xe000.  This guarantees an ESP greater than 0xffff,
;   and so for the next few tests, with a 16-bit data segment in SS, we expect all pushes/pops
;   will occur at SP rather than ESP.
;
	add	esi,0x2000			; ESI -> bottom of scratch memory
	mov	ss,ax
	lea	esp,[esi+0xe000]		; set ESP to bottom of scratch + 56K
	lea	ebp,[esp-4]
	and	ebp,0xffff			; EBP now mirrors SP instead of ESP
	mov	edx,[ebp]			; save dword about to be trashed by pushes
	mov	eax,0x11223344
	push	eax
	cmp	[ebp],eax			; did the push use SP instead of ESP?
	jne	near error			; no, error
	pop	eax
	push	ax
	cmp	[ebp+2],ax
	jne	near error
	pop	ax
	mov	[ebp],edx			; restore dword trashed by the above pushes
	mov	ax,DSEG_PROT32
	mov	ss,ax
	lea	esp,[esi+0xe000]		; SS:ESP should now be a valid 32-bit pointer
	lea	ebp,[esp-4]
	mov	edx,[ebp]
	mov	eax,0x11223344
	push	eax
	cmp	[ebp],eax			; did the push use ESP instead of SP?
	jne	near error			; no, error
	pop	eax
	push	ax
	cmp	[ebp+2],ax
	jne	near error
	pop	ax
;
;   Test moving a segment register to a 32-bit memory location
;
	mov	edx,[0x0000]			; save the DWORD at 0x0000:0x0000 in EDX
	or	eax,-1
	mov	[0x0000],eax
	mov	[0x0000],ds
	mov	ax,ds
	cmp	eax,[0x0000]
	jne	near error
	mov	eax,ds
	xor	eax,0xffff0000
	cmp	eax,[0x0000]
	jne	near error
	mov	[0x0000],edx			; restore the DWORD at 0x0000:0x0000 from EDX
;
;   Test moving a byte to a 32-bit register with sign-extension
;
	movsx	eax,byte [cs:signedByte]
	cmp	eax,0xffffff80
	jne	near error
;
;   Test moving a word to a 32-bit register with sign-extension
;
	movsx	eax,word [cs:signedWord]
	cmp	eax,0xffff8080
	jne	near error
;
;   Test moving a byte to a 32-bit register with zero-extension
;
	movzx	eax,byte [cs:signedByte]
	cmp	eax,0x00000080
	jne	near error
;
;   Test moving a word to a 32-bit register with zero-extension
;
	movzx	eax,word [cs:signedWord]
	cmp	eax,0x00008080
	jne	near error
;
;   More assorted zero and sign-extension tests
;
    	mov	esp,0x40000
    	mov	edx,[esp]			; save word at scratch address 0x40000
    	add	esp,4
    	push	byte -128			; NASM will not use opcode 0x6A ("PUSH imm8") unless we specify "byte"
    	pop	ebx				; verify EBX == 0xFFFFFF80
    	cmp	ebx,0xFFFFFF80
    	jne	near error
    	and	ebx,0xff			; verify EBX == 0x00000080
    	cmp	ebx,0x00000080
    	jne	near error
    	movsx	bx,bl				; verify EBX == 0x0000FF80
    	cmp	ebx,0x0000FF80
    	jne	near error
    	movsx	ebx,bx				; verify EBX == 0xFFFFFF80
    	cmp	ebx,0xFFFFFF80
    	jne	near error
    	movzx	bx,bl				; verify EBX == 0xFFFF0080
    	cmp	ebx,0xFFFF0080
    	jne	near error
    	movzx	ebx,bl				; verify EBX == 0x00000080
    	cmp	ebx,0x00000080
    	jne	near error
    	not	ebx				; verify EBX == 0xFFFFFF7F
    	cmp	ebx,0xFFFFFF7F
    	jne	near error
    	movsx	bx,bl				; verify EBX == 0xFFFF007F
    	cmp	ebx,0xFFFF007F
    	jne	near error
    	movsx	ebx,bl				; verify EBX == 0x0000007F
    	cmp	ebx,0x0000007F
    	jne	near error
    	not	ebx				; verify EBX == 0xFFFFFF80
    	cmp	ebx,0xFFFFFF80
    	jne	near error
    	movzx	ebx,bx				; verify EBX == 0x0000FF80
    	cmp	ebx,0x0000FF80
    	jne	near error
    	movzx	bx,bl				; verify EBX == 0x00000080
    	cmp	ebx,0x00000080
    	jne	near error
    	movsx	bx,bl
    	neg	bx
    	neg	bx
    	cmp	ebx,0x0000FF80
    	jne	near error
    	movsx	ebx,bx
    	neg	ebx
    	neg	ebx
    	cmp	ebx,0xFFFFFF80
    	jne	near error
;
;   Test assorted 32-bit addressing modes
;
    	mov	ax,SSEG_PROT32			; we want SS != DS for the next tests
    	mov	ss,ax

    	mov	eax,0x11223344
    	mov	[0x40000],eax			; store a known word at the scratch address

    	mov	ecx,0x40000			; now access that scratch address using various addressing modes
    	cmp	[ecx],eax
    	jne	near error

    	add	ecx,64
    	cmp	[ecx-64],eax
    	jne	near error
    	sub	ecx,64

    	shr	ecx,1
    	cmp	[ecx+0x20000],eax
    	jne	near error

    	cmp	[ecx+ecx],eax
    	jne	near error

    	shr	ecx,1
    	cmp	[ecx+ecx*2+0x10000],eax
    	jne	near error

    	cmp	[ecx*4],eax
    	jne	near error

    	mov	ebp,ecx
    	cmp	[ebp+ecx*2+0x10000],eax
    	je	near error			; since SS != DS, this better be a mismatch

	mov	[0x40000],edx			; restore word at scratch address 0x40000
;
;   Now run a series of unverified opcode tests (verification will happen later, by comparing the output of the tests)
;
	cld
	mov	esi,tableOps			; ESI -> tableOps entry
testOps:
	movzx	ecx,byte [cs:esi]		; ECX == length of instruction sequence
	test	ecx,ecx				; (must use JZ since there's no long version of JECXZ)
	jz	near testDone			; zero means we've reached the end of the table
	movzx	ebx,byte [cs:esi+1]		; EBX == TYPE
	shl	ebx,6				; EBX == TYPE * 64
	movzx	edx,byte [cs:esi+2]		; EDX == SIZE
	shl	edx,4				; EDX == SIZE * 16
	lea	ebx,[cs:typeValues+ebx+edx]	; EBX -> values for type
	add	esi,3				; ESI -> instruction mnemonic
.skip:	cs lodsb
	test	al,al
	jnz	.skip

	push	ecx
	mov	ecx,[cs:ebx]			; ECX == count of values for dst
	mov	eax,[cs:ebx+4]			; EAX -> values for dst
	mov	ebp,[cs:ebx+8]			; EBP == count of values for src
	mov	edi,[cs:ebx+12]			; EDI -> values for src
	xchg	ebx,eax				; EBX -> values for dst
	sub	eax,eax				; set all ARITH flags to known values prior to tests
testDst:
	push	ebp
	push	edi
	pushfd
testSrc:
	mov	eax,[cs:ebx]			; EAX == dst
	mov	edx,[cs:edi]			; EDX == src
	popfd
	call	printOp
	call	printEAX
	call	printEDX
	call	printPS
	call	esi				; execute the instruction sequence
	call	printEAX
	call	printEDX
	call	printPS
	call	printEOL
	pushfd
	add	edi,4				; EDI -> next src
	dec	ebp				; decrement src count
	jnz	testSrc

	popfd
	pop	edi				; ESI -> restored values for src
	pop	ebp				; EBP == restored count of values for src
	lea	ebx,[ebx+4]			; EBX -> next dst (without modifying flags)
	loop	testDst

	pop	ecx
	add	esi,ecx				; ESI -> next tableOps entry
	jmp	testOps

testDone:
	jmp	doneProt

;
;   printOp(ESI -> instruction sequence)
;
;   Rewinds ESI to the start of the mnemonic preceding the instruction sequence and prints the mnemonic
;
;   Uses: None
;
printOp:
	pushfd
	pushad
.findSize:
	dec	esi
	mov	al,[cs:esi-1]
	cmp	al,32
	jae	.findSize
	call	printStr
	movzx	eax,al
	mov	al,[cs:achSize+eax]
	call	printChar
	mov	al,' '
	call	printChar
	popad
	popfd
	ret

;
;   printEAX()
;
;   Uses: None
;
printEAX:
	pushfd
	pushad
	mov	esi,strEAX
	call	printStr
	mov	cl,8
	call	printVal
	popad
	popfd
	ret

;
;   printEDX()
;
;   Uses: None
;
printEDX:
	pushfd
	pushad
	mov	esi,strEDX
	call	printStr
	mov	cl,8
	mov	eax,edx
	call	printVal
	popad
	popfd
	ret

;
;   printPS(ESI -> instruction sequence)
;
;   Uses: None
;
printPS:
	pushfd
	pushad
	pushfd
	pop	edx
.findType:
	dec	esi
	mov	al,[cs:esi-1]
	cmp	al,32
	jae	.findType
	movzx	eax,byte [cs:esi-2]
	and	edx,[cs:typeMasks+eax*4]
	mov	esi,strPS
	call	printStr
	mov	cl,4
	mov	eax,edx
	call	printVal
	popad
	popfd
	ret

;
;   printEOL()
;
;   Uses: None
;
printEOL:
	push	eax
;	mov	al,0x0d
;	call	printChar
	mov	al,0x0a
	call	printChar
	pop	eax
	ret

;
;   printChar(AL)
;
;   Uses: None
;
printChar:
	pushfd
	push	edx
	push	eax
	mov	dx,0x2FD			; EDX == COM2 LSR (Line Status Register)
.loop:	in	al,dx				;
	test	al,0x20				; THR (Transmitter Holding Register) empty?
	jz	.loop				; no
	pop	eax
	mov	dx,0x2F8			; EDX -> COM2 THR (Transmitter Holding Register)
	out	dx,al
	pop	edx
	popfd
	ret

;
;   printStr(ESI -> zero-terminated string)
;
;   Uses: ESI, Flags
;
printStr:
	push	eax
.loop:	cs lodsb
	test	al,al
	jz	.done
	call	printChar
	jmp	.loop
.done:	pop	eax
	ret

;
;   printVal(EAX == value, CL == number of hex digits)
;
;   Uses: EAX, ECX, Flags
;
printVal:
	shl	cl,2				; CL == number of bits (4 times the number of hex digits)
	jz	.done
.loop:	sub	cl,4
	push	eax
	shr	eax,cl
	and	al,0x0f
	add	al,'0'
	cmp	al,'9'
	jbe	.digit
	add	al,'A'-'0'-10
.digit:	call	printChar
	pop	eax
	test	cl,cl
	jnz	.loop
.done:	mov	al,' '
	call	printChar
	ret

TYPE_ARITH	equ	0
TYPE_ARITH1	equ	1
TYPE_LOGIC	equ	2
TYPE_MULTIPLY	equ	3
TYPE_DIVIDE	equ	4

SIZE_BYTE	equ	0
SIZE_SHORT	equ	1
SIZE_LONG	equ	2

%macro	defOp	6
    %ifidni %3,al
	%assign size SIZE_BYTE
    %elifidni %3,dl
	%assign size SIZE_BYTE
    %elifidni %3,ax
	%assign size SIZE_SHORT
    %elifidni %3,dx
	%assign size SIZE_SHORT
    %else
	%assign size SIZE_LONG
    %endif
	db	%%end-%%beg,%6,size
%%name:
	db	%1,0
%%beg:
    %ifidni %4,none
	%2	%3
    %elifidni %5,none
	%2	%3,%4
    %else
	%2	%3,%4,%5
    %endif
	ret
%%end:
%endmacro

strEAX:	db	"EAX=",0
strEDX:	db	"EDX=",0
strPS:	db	"PS=",0
strDE:	db	"#DE ",0			; when this is displayed, it indicates a Divide Error exception
achSize	db	"BWD"

ALLOPS equ 1

tableOps:
	defOp	"ADD",add,al,dl,none,TYPE_ARITH
	defOp	"ADD",add,ax,dx,none,TYPE_ARITH
	defOp	"ADD",add,eax,edx,none,TYPE_ARITH
	defOp	"OR",or,al,dl,none,TYPE_LOGIC
	defOp	"OR",or,ax,dx,none,TYPE_LOGIC
	defOp	"OR",or,eax,edx,none,TYPE_LOGIC
	defOp	"ADC",adc,al,dl,none,TYPE_ARITH
	defOp	"ADC",adc,ax,dx,none,TYPE_ARITH
	defOp	"ADC",adc,eax,edx,none,TYPE_ARITH
	defOp	"SBB",sbb,al,dl,none,TYPE_ARITH
	defOp	"SBB",sbb,ax,dx,none,TYPE_ARITH
	defOp	"SBB",sbb,eax,edx,none,TYPE_ARITH
	defOp	"AND",and,al,dl,none,TYPE_LOGIC
	defOp	"AND",and,ax,dx,none,TYPE_LOGIC
	defOp	"AND",and,eax,edx,none,TYPE_LOGIC
	defOp	"SUB",sub,al,dl,none,TYPE_ARITH
	defOp	"SUB",sub,ax,dx,none,TYPE_ARITH
	defOp	"SUB",sub,eax,edx,none,TYPE_ARITH
	defOp	"XOR",xor,al,dl,none,TYPE_LOGIC
	defOp	"XOR",xor,ax,dx,none,TYPE_LOGIC
	defOp	"XOR",xor,eax,edx,none,TYPE_LOGIC
	defOp	"CMP",cmp,al,dl,none,TYPE_ARITH
	defOp	"CMP",cmp,ax,dx,none,TYPE_ARITH
	defOp	"CMP",cmp,eax,edx,none,TYPE_ARITH
	defOp	"INC",inc,al,none,none,TYPE_ARITH1
	defOp	"INC",inc,ax,none,none,TYPE_ARITH1
	defOp	"INC",inc,eax,none,none,TYPE_ARITH1
	defOp	"DEC",dec,al,none,none,TYPE_ARITH1
	defOp	"DEC",dec,ax,none,none,TYPE_ARITH1
	defOp	"DEC",dec,eax,none,none,TYPE_ARITH1
	defOp	"MULA",mul,dl,none,none,TYPE_MULTIPLY
	defOp	"MULA",mul,dx,none,none,TYPE_MULTIPLY
	defOp	"MULA",mul,edx,none,none,TYPE_MULTIPLY
	defOp	"IMULA",imul,dl,none,none,TYPE_MULTIPLY
	defOp	"IMULA",imul,dx,none,none,TYPE_MULTIPLY
	defOp	"IMULA",imul,edx,none,none,TYPE_MULTIPLY
	defOp	"IMUL",imul,ax,dx,none,TYPE_MULTIPLY
	defOp	"IMUL",imul,eax,edx,none,TYPE_MULTIPLY
	defOp	"IMUL8",imul,ax,dx,0x77,TYPE_MULTIPLY
	defOp	"IMUL8",imul,ax,dx,-0x77,TYPE_MULTIPLY
	defOp	"IMUL8",imul,eax,edx,0x77,TYPE_MULTIPLY
	defOp	"IMUL8",imul,eax,edx,-0x77,TYPE_MULTIPLY
	defOp	"IMUL16",imul,ax,0x777,none,TYPE_MULTIPLY
	defOp	"IMUL32",imul,eax,0x777777,none,TYPE_MULTIPLY
	defOp	"DIVDL",div,dl,none,none,TYPE_DIVIDE
	defOp	"DIVDX",div,dx,none,none,TYPE_DIVIDE
	defOp	"DIVEDX",div,edx,none,none,TYPE_DIVIDE
	defOp	"DIVAL",div,al,none,none,TYPE_DIVIDE
	defOp	"DIVAX",div,ax,none,none,TYPE_DIVIDE
	defOp	"DIVEAX",div,eax,none,none,TYPE_DIVIDE
	defOp	"IDIVDL",idiv,dl,none,none,TYPE_DIVIDE
	defOp	"IDIVDX",idiv,dx,none,none,TYPE_DIVIDE
	defOp	"IDIVEDX",idiv,edx,none,none,TYPE_DIVIDE
	defOp	"IDIVAL",idiv,al,none,none,TYPE_DIVIDE
	defOp	"IDIVAX",idiv,ax,none,none,TYPE_DIVIDE
	defOp	"IDIVEAX",idiv,eax,none,none,TYPE_DIVIDE
	db	0

	align	4

typeMasks:
	dd	PS_ARITH
	dd	PS_ARITH
	dd	PS_LOGIC
	dd	PS_MULTIPLY
	dd	PS_DIVIDE

arithValues:
.bvals:	dd	0x00,0x01,0x02,0x7E,0x7F,0x80,0x81,0xFE,0xFF
	ARITH_BYTES equ ($-.bvals)/4

.wvals:	dd	0x0000,0x0001,0x0002,0x7FFE,0x7FFF,0x8000,0x8001,0xFFFE,0xFFFF
	ARITH_WORDS equ ($-.wvals)/4

.dvals:	dd	0x00000000,0x00000001,0x00000002,0x7FFFFFFE,0x7FFFFFFF,0x80000000,0x80000001,0xFFFFFFFE,0xFFFFFFFF
	ARITH_DWORDS equ ($-.dvals)/4

muldivValues:
.bvals:	dd	0x00,0x01,0x02,0x3F,0x40,0x41,0x7E,0x7F,0x80,0x81,0xFE,0xFF
	MULDIV_BYTES equ ($-.bvals)/4

.wvals:	dd	0x0000,0x0001,0x0002,0x3FFF,0x4000,0x4001,0x7FFE,0x7FFF,0x8000,0x8001,0xFFFE,0xFFFF
	MULDIV_WORDS equ ($-.wvals)/4

.dvals:	dd	0x00000000,0x00000001,0x00000002,0x3FFFFFFF,0x40000000,0x40000001,0x7FFFFFFE,0x7FFFFFFF,0x80000000,0x80000001,0xFFFFFFFE,0xFFFFFFFF
	MULDIV_DWORDS equ ($-.dvals)/4

typeValues:
	;
	; Values for TYPE_ARITH
	;
	dd	ARITH_BYTES,arithValues,ARITH_BYTES,arithValues
	dd	ARITH_BYTES+ARITH_WORDS,arithValues,ARITH_BYTES+ARITH_WORDS,arithValues
	dd	ARITH_BYTES+ARITH_WORDS+ARITH_DWORDS,arithValues,ARITH_BYTES+ARITH_WORDS+ARITH_DWORDS,arithValues
	dd	0,0,0,0
	;
	; Values for TYPE_ARITH1
	;
	dd	ARITH_BYTES,arithValues,1,arithValues
	dd	ARITH_BYTES+ARITH_WORDS,arithValues,1,arithValues
	dd	ARITH_BYTES+ARITH_WORDS+ARITH_DWORDS,arithValues,1,arithValues
	dd	0,0,0,0
	;
	; Values for TYPE_LOGIC (using ARITH values for now)
	;
	dd	ARITH_BYTES,arithValues,ARITH_BYTES,arithValues
	dd	ARITH_BYTES+ARITH_WORDS,arithValues,ARITH_BYTES+ARITH_WORDS,arithValues
	dd	ARITH_BYTES+ARITH_WORDS+ARITH_DWORDS,arithValues,ARITH_BYTES+ARITH_WORDS+ARITH_DWORDS,arithValues
	dd	0,0,0,0
	;
	; Values for TYPE_MULTIPLY (a superset of ARITH values)
	;
	dd	MULDIV_BYTES,muldivValues,MULDIV_BYTES,muldivValues
	dd	MULDIV_BYTES+MULDIV_WORDS,muldivValues,MULDIV_BYTES+MULDIV_WORDS,muldivValues
	dd	MULDIV_BYTES+MULDIV_WORDS+MULDIV_DWORDS,muldivValues,MULDIV_BYTES+MULDIV_WORDS+MULDIV_DWORDS,muldivValues
	dd	0,0,0,0
	;
	; Values for TYPE_DIVIDE
	;
	dd	MULDIV_BYTES,muldivValues,MULDIV_BYTES,muldivValues
	dd	MULDIV_BYTES+MULDIV_WORDS,muldivValues,MULDIV_BYTES+MULDIV_WORDS,muldivValues
	dd	MULDIV_BYTES+MULDIV_WORDS+MULDIV_DWORDS,muldivValues,MULDIV_BYTES+MULDIV_WORDS+MULDIV_DWORDS,muldivValues
	dd	0,0,0,0

error:	jmp	error

	times	OFF_INTDIVERR-0x100-($-$$) nop

intDivErr:
	push	esi
	mov	esi,strDE
	call	printStr
	pop	esi
;
;   It's rather annoying that the 80386 treats #DE as a fault rather than a trap, leaving CS:EIP pointing to the
;   faulting instruction instead of the RET we conveniently placed after it.  So, instead of trying to calculate where
;   that RET is, we simply set EIP on the stack to point to our own RET.
;
	mov	dword [esp],intDivRet
	iretd
intDivRet:
	ret

doneProt:
	mov	ax,DSEG_PROT16
	mov	ss,ax
	sub	esp,esp

    %ifndef REAL32
;
;   Return to real-mode, after first resetting the IDTR and loading CS with a 16-bit code segment
;
	o32 lidt [cs:addrIDTReal]
	jmp	CSEG_PROT16:toProt16
toProt16:
	bits	16
    %endif

goReal:
	mov	eax,cr0
	and	eax,~(CR0_MSW_PE | CR0_PG) & 0xffffffff
	mov	cr0,eax
jmpReal:
	jmp	CSEG_REAL:toReal

toReal:
	mov	ax,cs				; revert to the usual .COM register conventions
	mov	ds,ax
	mov	es,ax
	mov	ss,ax
	mov	sp,0xfffe

	cmp	ax,CSEG_REAL			; is CS equal to 0xf000?
spin:	je	spin ; near jmpStart		; yes, so loop around, because we have nowhere else to go
	int	INT_DOSEXIT			; no, so assume we're running under DOS and exit

;
;   Fill the remaining space with NOPs until we get to target offset 0xFFF0.
;   Note that we subtract 0x100 from the target offset because we're ORG'ed at 0x100.
;
	times	0xfff0-0x100-($-$$) nop

;
;   Unfortunately, when PC-DOS 2.0 loads our .COM file, the last 4 bytes are not valid, in part because DOS must
;   zero the last 2 bytes so that a near RET will return to the PSP's INT 0x20 and gracefully terminate the program.
;   Newer versions of DOS simply refuse to load the file (the safest thing to do), claiming insufficient memory.
;
;   To avoid these loading issues, I now omit the last 4 bytes from image, and it will still work as a ROM image as
;   long as jmpStart is at offset 0xFFF0.
;

jmpStart:
	jmp	CSEG_REAL:start			; 0000FFF0
signedWord:
	db	0x80				; 0000FFF5  80
signedByte:
	db	0x80				; 0000FFF6  80
signature:
	db	'PCJS',0			; 0000FFF7  "PCJS",0
;	db	0x00				; 0000FFFC  00
;	db	0x00				; 0000FFFD  00
;	db	0xFC				; 0000FFFE  FC (Model ID byte)
;	db	0x00				; 0000FFFF  00 (normally a checksum byte)

[PCjs Machine "ibm5170"]

Waiting for machine "ibm5170" to load....

Directory of PCx86 CPU Tests

 Volume in drive A is CPUTESTS
 Directory of A:\

CPUID    ASM     19038   3-08-20  12:38a
ID       ASM      2299   3-08-20  12:38a
ID       COM       347   3-08-20  12:38a
TEST386  COM     65276   3-08-20  12:38a
        4 file(s)      86960 bytes
                       72192 bytes free