1/*
2 * Copyright (c) 1998 Robert Nordier
3 * All rights reserved.
4 *
5 * Redistribution and use in source and binary forms are freely
6 * permitted provided that the above copyright notice and this
7 * paragraph and the following disclaimer are duplicated in all
8 * such forms.
9 *
10 * This software is provided "AS IS" and without any express or
11 * implied warranties, including, without limitation, the implied
12 * warranties of merchantability and fitness for a particular
13 * purpose.
14 *
15 * $FreeBSD$
16 */
17
18#include <bootargs.h>
19
20/*
21 * Memory layout.
22 */
23		.set MEM_BTX,0x1000		# Start of BTX memory
24		.set MEM_ESP0,0x1800		# Supervisor stack
25		.set MEM_BUF,0x1800		# Scratch buffer
26		.set MEM_ESPR,0x5e00		# Real mode stack
27		.set MEM_IDT,0x5e00		# IDT
28		.set MEM_TSS,0x5f98		# TSS
29		.set MEM_MAP,0x6000		# I/O bit map
30		.set MEM_TSS_END,0x7fff		# End of TSS
31		.set MEM_ORG,0x9000		# BTX code
32		.set MEM_USR,0xa000		# Start of user memory
33/*
34 * Paging control.
35 */
36		.set PAG_SIZ,0x1000		# Page size
37		.set PAG_CNT,0x1000		# Pages to map
38/*
39 * Fields in %eflags.
40 */
41		.set PSL_RESERVED_DEFAULT,0x00000002
42		.set PSL_T,0x00000100		# Trap flag
43		.set PSL_I,0x00000200		# Interrupt enable flag
44		.set PSL_VM,0x00020000		# Virtual 8086 mode flag
45		.set PSL_AC,0x00040000		# Alignment check flag
46/*
47 * Segment selectors.
48 */
49		.set SEL_SCODE,0x8		# Supervisor code
50		.set SEL_SDATA,0x10		# Supervisor data
51		.set SEL_RCODE,0x18		# Real mode code
52		.set SEL_RDATA,0x20		# Real mode data
53		.set SEL_UCODE,0x28|3		# User code
54		.set SEL_UDATA,0x30|3		# User data
55		.set SEL_TSS,0x38		# TSS
56/*
57 * Task state segment fields.
58 */
59		.set TSS_ESP0,0x4		# PL 0 ESP
60		.set TSS_SS0,0x8		# PL 0 SS
61		.set TSS_MAP,0x66		# I/O bit map base
62/*
63 * System calls.
64 */
65		.set SYS_EXIT,0x0		# Exit
66		.set SYS_EXEC,0x1		# Exec
67/*
68 * Fields in V86 interface structure.
69 */
70		.set V86_CTL,0x0		# Control flags
71		.set V86_ADDR,0x4		# Int number/address
72		.set V86_ES,0x8			# V86 ES
73		.set V86_DS,0xc			# V86 DS
74		.set V86_FS,0x10		# V86 FS
75		.set V86_GS,0x14		# V86 GS
76/*
77 * V86 control flags.
78 */
79		.set V86F_ADDR,0x10000		# Segment:offset address
80		.set V86F_CALLF,0x20000		# Emulate far call
81		.set V86F_FLAGS,0x40000		# Return flags
82/*
83 * Dump format control bytes.
84 */
85		.set DMP_X16,0x1		# Word
86		.set DMP_X32,0x2		# Long
87		.set DMP_MEM,0x4		# Memory
88		.set DMP_EOL,0x8		# End of line
89/*
90 * Screen defaults and assumptions.
91 */
92		.set SCR_MAT,0xe1		# Mode/attribute
93		.set SCR_COL,0x50		# Columns per row
94		.set SCR_ROW,0x19		# Rows per screen
95/*
96 * BIOS Data Area locations.
97 */
98		.set BDA_MEM,0x501		# Free memory
99		.set BDA_POS,0x53e		# Cursor position
100/*
101 * Derivations, for brevity.
102 */
103		.set _ESP0H,MEM_ESP0>>0x8	# Byte 1 of ESP0
104		.set _TSSIO,MEM_MAP-MEM_TSS	# TSS I/O base
105		.set _TSSLM,MEM_TSS_END-MEM_TSS	# TSS limit
106		.set _IDTLM,MEM_TSS-MEM_IDT-1	# IDT limit
107/*
108 * Code segment.
109 */
110		.globl start
111		.code16
112start:						# Start of code
113/*
114 * BTX header.
115 */
116btx_hdr:	.byte 0xeb			# Machine ID
117		.byte 0xe			# Header size
118		.ascii "BTX"			# Magic
119		.byte 0x1			# Major version
120		.byte 0x2			# Minor version
121		.byte BTX_FLAGS			# Flags
122		.word PAG_CNT-MEM_ORG>>0xc	# Paging control
123		.word break-start		# Text size
124		.long 0x0			# Entry address
125/*
126 * Initialization routine.
127 */
128init:		cli				# Disable interrupts
129		xor %ax,%ax			# Zero/segment
130		mov %ax,%ss			# Set up
131		mov $MEM_ESP0,%sp		#  stack
132		mov %ax,%es			# Address
133		mov %ax,%ds			#  data
134		pushl $0x2			# Clear
135		popfl				#  flags
136/*
137 * Initialize memory.
138 */
139		mov $MEM_IDT,%di		# Memory to initialize
140		mov $(MEM_ORG-MEM_IDT)/2,%cx	# Words to zero
141		rep				# Zero-fill
142		stosw				#  memory
143/*
144 * Update real mode IDT for reflecting hardware interrupts.
145 */
146		mov $intr20,%bx			# Address first handler
147		mov $0x10,%cx			# Number of handlers
148		mov $0x20*4,%di			# First real mode IDT entry
149init.0:		mov %bx,(%di)			# Store IP
150		inc %di				# Address next
151		inc %di				#  entry
152		stosw				# Store CS
153		add $4,%bx			# Next handler
154		loop init.0			# Next IRQ
155/*
156 * Create IDT.
157 */
158		mov $MEM_IDT,%di
159		mov $idtctl,%si			# Control string
160init.1: 	lodsb				# Get entry
161		cbw				#  count
162		xchg %ax,%cx			#  as word
163		jcxz init.4			# If done
164		lodsb				# Get segment
165		xchg %ax,%dx	 		#  P:DPL:type
166		lodsw				# Get control
167		xchg %ax,%bx			#  set
168		lodsw				# Get handler offset
169		mov $SEL_SCODE,%dh		# Segment selector
170init.2: 	shr %bx				# Handle this int?
171		jnc init.3			# No
172		mov %ax,(%di)			# Set handler offset
173		mov %dh,0x2(%di)		#  and selector
174		mov %dl,0x5(%di)		# Set P:DPL:type
175		add $0x4,%ax			# Next handler
176init.3: 	lea 0x8(%di),%di		# Next entry
177		loop init.2			# Till set done
178		jmp init.1			# Continue
179/*
180 * Initialize TSS.
181 */
182init.4: 	movb $_ESP0H,TSS_ESP0+1(%di)	# Set ESP0
183		movb $SEL_SDATA,TSS_SS0(%di)	# Set SS0
184		movb $_TSSIO,TSS_MAP(%di)	# Set I/O bit map base
185/*
186 * Bring up the system.
187 */
188		mov $0x2820,%bx			# Set protected mode
189		callw setpic			#  IRQ offsets
190		lidt idtdesc	 		# Set IDT
191		lgdt gdtdesc	 		# Set GDT
192		mov %cr0,%eax			# Switch to protected
193		inc %ax				#  mode
194		mov %eax,%cr0			#
195		ljmp $SEL_SCODE,$init.8		# To 32-bit code
196		.code32
197init.8: 	xorl %ecx,%ecx			# Zero
198		movb $SEL_SDATA,%cl		# To 32-bit
199		movw %cx,%ss			#  stack
200/*
201 * Launch user task.
202 */
203		movb $SEL_TSS,%cl		# Set task
204		ltr %cx				#  register
205		movl $MEM_USR,%edx		# User base address
206		movzwl %ss:BDA_MEM,%eax 	# Get free memory
207		andl $0x7,%eax
208		incl %eax
209		shll $0x11,%eax			# To bytes
210		subl $ARGSPACE,%eax		# Less arg space
211		subl %edx,%eax			# Less base
212		movb $SEL_UDATA,%cl		# User data selector
213		pushl %ecx			# Set SS
214		pushl %eax			# Set ESP
215		push $0x202			# Set flags (IF set)
216		push $SEL_UCODE			# Set CS
217		pushl btx_hdr+0xc		# Set EIP
218		pushl %ecx			# Set GS
219		pushl %ecx			# Set FS
220		pushl %ecx			# Set DS
221		pushl %ecx			# Set ES
222		pushl %edx			# Set EAX
223		movb $0x7,%cl			# Set remaining
224init.9:		push $0x0			#  general
225		loop init.9			#  registers
226#ifdef BTX_SERIAL
227		call sio_init			# setup the serial console
228#endif
229		popa				#  and initialize
230		popl %es			# Initialize
231		popl %ds			#  user
232		popl %fs			#  segment
233		popl %gs			#  registers
234		iret				# To user mode
235/*
236 * Exit routine.
237 */
238exit:		cli				# Disable interrupts
239		movl $MEM_ESP0,%esp		# Clear stack
240/*
241 * Turn off paging.
242 */
243		movl %cr0,%eax			# Get CR0
244		andl $~0x80000000,%eax		# Disable
245		movl %eax,%cr0			#  paging
246		xorl %ecx,%ecx			# Zero
247		movl %ecx,%cr3			# Flush TLB
248/*
249 * Restore the GDT in case we caught a kernel trap.
250 */
251		lgdt %cs:gdtdesc		# Set GDT
252/*
253 * To 16 bits.
254 */
255		ljmpw $SEL_RCODE,$exit.1	# Reload CS
256		.code16
257exit.1: 	mov $SEL_RDATA,%cl		# 16-bit selector
258		mov %cx,%ss			# Reload SS
259		mov %cx,%ds			# Load
260		mov %cx,%es			#  remaining
261		mov %cx,%fs			#  segment
262		mov %cx,%gs			#  registers
263/*
264 * To real-address mode.
265 */
266		dec %ax				# Switch to
267		mov %eax,%cr0			#  real mode
268		ljmp $0x0,$exit.2		# Reload CS
269exit.2: 	xor %ax,%ax			# Real mode segment
270		mov %ax,%ss			# Reload SS
271		mov %ax,%ds			# Address data
272		mov $0x1008,%bx			# Set real mode
273		callw setpic			#  IRQ offsets
274		lidt ivtdesc	 		# Set IVT
275/*
276 * Reboot or await reset.
277 */
278		sti				# Enable interrupts
279		testb $0x1,btx_hdr+0x7		# Reboot?
280exit.3:		jz exit.3			# No
281		movb $0xa0,%al
282		outb %al,$0x35
283		movb $0x00,%al
284		outb %al,$0xf0			# reboot the machine
285exit.4:		jmp exit.4
286/*
287 * Set IRQ offsets by reprogramming 8259A PICs.
288 */
289setpic: 	in $0x02,%al			# Save master
290		push %ax			#  IMR
291		in $0x0a,%al			# Save slave
292		push %ax			#  IMR
293		movb $0x11,%al			# ICW1 to
294		outb %al,$0x00			#  master,
295		outb %al,$0x08			#  slave
296		movb %bl,%al			# ICW2 to
297		outb %al,$0x02			#  master
298		movb %bh,%al			# ICW2 to
299		outb %al,$0x0a			#  slave
300		movb $0x80,%al			# ICW3 to
301		outb %al,$0x02			#  master
302		movb $0x7,%al			# ICW3 to
303		outb %al,$0x0a			#  slave
304		movb $0x1d,%al			# ICW4 to
305		outb %al,$0x02			#  master,
306		movb $0x9,%al			# ICW4 to
307		outb %al,$0x0a			#  slave
308		pop %ax				# Restore slave
309		outb %al,$0x0a			#  IMR
310		pop %ax				# Restore master
311		outb %al,$0x02			#  IMR
312		retw				# To caller
313		.code32
314/*
315 * Exception jump table.
316 */
317intx00: 	push $0x0			# Int 0x0: #DE
318		jmp ex_noc			# Divide error
319		push $0x1			# Int 0x1: #DB
320		jmp ex_noc			# Debug
321		push $0x3			# Int 0x3: #BP
322		jmp ex_noc			# Breakpoint
323		push $0x4			# Int 0x4: #OF
324		jmp ex_noc			# Overflow
325		push $0x5			# Int 0x5: #BR
326		jmp ex_noc			# BOUND range exceeded
327		push $0x6			# Int 0x6: #UD
328		jmp ex_noc			# Invalid opcode
329		push $0x7			# Int 0x7: #NM
330		jmp ex_noc			# Device not available
331		push $0x8			# Int 0x8: #DF
332		jmp except			# Double fault
333		push $0xa			# Int 0xa: #TS
334		jmp except			# Invalid TSS
335		push $0xb			# Int 0xb: #NP
336		jmp except			# Segment not present
337		push $0xc			# Int 0xc: #SS
338		jmp except			# Stack segment fault
339		push $0xd			# Int 0xd: #GP
340		jmp except			# General protection
341		push $0xe			# Int 0xe: #PF
342		jmp except			# Page fault
343intx10: 	push $0x10			# Int 0x10: #MF
344		jmp ex_noc			# Floating-point error
345/*
346 * Save a zero error code.
347 */
348ex_noc: 	pushl (%esp,1)			# Duplicate int no
349		movb $0x0,0x4(%esp,1)		# Fake error code
350/*
351 * Handle exception.
352 */
353except: 	cld				# String ops inc
354		pushl %ds			# Save
355		pushl %es			#  most
356		pusha				#  registers
357		pushl %gs			# Set GS
358		pushl %fs			# Set FS
359		pushl %ds			# Set DS
360		pushl %es			# Set ES
361		cmpw $SEL_SCODE,0x44(%esp,1)	# Supervisor mode?
362		jne except.1			# No
363		pushl %ss			# Set SS
364		jmp except.2			# Join common code
365except.1:	pushl 0x50(%esp,1)		# Set SS
366except.2:	pushl 0x50(%esp,1)		# Set ESP
367		push $SEL_SDATA			# Set up
368		popl %ds			#  to
369		pushl %ds			#  address
370		popl %es			#  data
371		movl %esp,%ebx			# Stack frame
372		movl $dmpfmt,%esi		# Dump format string
373		movl $MEM_BUF,%edi		# Buffer
374		pushl %eax
375		pushl %edx
376wait.1:		inb  $0x60,%al
377		testb $0x04,%al
378		jz   wait.1
379		movb $0xe0,%al
380		outb %al,$0x62
381wait.2:		inb  $0x60,%al
382		testb $0x01,%al
383		jz   wait.2
384		xorl %edx,%edx
385		inb  $0x62,%al
386		movb %al,%dl
387		inb  $0x62,%al
388		movb %al,%dh
389		inb  $0x62,%al
390		inb  $0x62,%al
391		inb  $0x62,%al
392		movl %edx,%eax
393		shlw $1,%ax
394		movl $BDA_POS,%edx
395		movw %ax,(%edx)
396		popl  %edx
397		popl  %eax
398		pushl %edi			# Dump to
399		call dump			#  buffer
400		popl %esi			#  and
401		call putstr			#  display
402		leal 0x18(%esp,1),%esp		# Discard frame
403		popa				# Restore
404		popl %es			#  registers
405		popl %ds			#  saved
406		cmpb $0x3,(%esp,1)		# Breakpoint?
407		je except.3			# Yes
408		cmpb $0x1,(%esp,1)		# Debug?
409		jne except.2a			# No
410		testl $PSL_T,0x10(%esp,1)	# Trap flag set?
411		jnz except.3			# Yes
412except.2a:	jmp exit			# Exit
413except.3:	leal 0x8(%esp,1),%esp		# Discard err, int no
414		iret				# From interrupt
415
416/*
417 * Reboot the machine by setting the reboot flag and exiting
418 */
419reboot:		orb $0x1,btx_hdr+0x7		# Set the reboot flag
420		jmp exit			# Terminate BTX and reboot
421
422/*
423 * Protected Mode Hardware interrupt jump table.
424 */
425intx20: 	push $0x8			# Int 0x20: IRQ0
426		jmp int_hw			# V86 int 0x8
427		push $0x9			# Int 0x21: IRQ1
428		jmp int_hw			# V86 int 0x9
429		push $0xa			# Int 0x22: IRQ2
430		jmp int_hw			# V86 int 0xa
431		push $0xb			# Int 0x23: IRQ3
432		jmp int_hw			# V86 int 0xb
433		push $0xc			# Int 0x24: IRQ4
434		jmp int_hw			# V86 int 0xc
435		push $0xd			# Int 0x25: IRQ5
436		jmp int_hw			# V86 int 0xd
437		push $0xe			# Int 0x26: IRQ6
438		jmp int_hw			# V86 int 0xe
439		push $0xf			# Int 0x27: IRQ7
440		jmp int_hw			# V86 int 0xf
441		push $0x10			# Int 0x28: IRQ8
442		jmp int_hw			# V86 int 0x10
443		push $0x11			# Int 0x29: IRQ9
444		jmp int_hw			# V86 int 0x11
445		push $0x12			# Int 0x2a: IRQ10
446		jmp int_hw			# V86 int 0x12
447		push $0x13			# Int 0x2b: IRQ11
448		jmp int_hw			# V86 int 0x13
449		push $0x14			# Int 0x2c: IRQ12
450		jmp int_hw			# V86 int 0x14
451		push $0x15			# Int 0x2d: IRQ13
452		jmp int_hw			# V86 int 0x15
453		push $0x16			# Int 0x2e: IRQ14
454		jmp int_hw			# V86 int 0x16
455		push $0x17			# Int 0x2f: IRQ15
456		jmp int_hw			# V86 int 0x17
457
458/*
459 * Invoke real mode interrupt/function call from user mode with arguments.
460 */
461intx31: 	pushl $-1			# Dummy int no for btx_v86
462/*
463 * Invoke real mode interrupt/function call from protected mode.
464 *
465 * We place a trampoline on the user stack that will return to rret_tramp
466 * which will reenter protected mode and then finally return to the user
467 * client.
468 *
469 * Kernel frame %esi points to:		Real mode stack frame at MEM_ESPR:
470 *
471 * -0x00 user %ss			-0x04 kernel %esp (with full frame)
472 * -0x04 user %esp			-0x08 btx_v86 pointer
473 * -0x08 user %eflags			-0x0c flags (only used if interrupt)
474 * -0x0c user %cs			-0x10 real mode CS:IP return trampoline
475 * -0x10 user %eip			-0x12 real mode flags
476 * -0x14 int no				-0x16 real mode CS:IP (target)
477 * -0x18 %eax
478 * -0x1c %ecx
479 * -0x20 %edx
480 * -0x24 %ebx
481 * -0x28 %esp
482 * -0x2c %ebp
483 * -0x30 %esi
484 * -0x34 %edi
485 * -0x38 %gs
486 * -0x3c %fs
487 * -0x40 %ds
488 * -0x44 %es
489 * -0x48 zero %eax (hardware int only)
490 * -0x4c zero %ecx (hardware int only)
491 * -0x50 zero %edx (hardware int only)
492 * -0x54 zero %ebx (hardware int only)
493 * -0x58 zero %esp (hardware int only)
494 * -0x5c zero %ebp (hardware int only)
495 * -0x60 zero %esi (hardware int only)
496 * -0x64 zero %edi (hardware int only)
497 * -0x68 zero %gs (hardware int only)
498 * -0x6c zero %fs (hardware int only)
499 * -0x70 zero %ds (hardware int only)
500 * -0x74 zero %es (hardware int only)
501 */
502int_hw: 	cld				# String ops inc
503		pusha				# Save gp regs
504		pushl %gs			# Save
505		pushl %fs			#  seg
506		pushl %ds			#  regs
507		pushl %es
508		push $SEL_SDATA			# Set up
509		popl %ds			#  to
510		pushl %ds			#  address
511		popl %es			#  data
512		leal 0x44(%esp,1),%esi		# Base of frame
513		movl %esp,MEM_ESPR-0x04		# Save kernel stack pointer
514		movl -0x14(%esi),%eax		# Get Int no
515		cmpl $-1,%eax			# Hardware interrupt?
516		jne intusr.1			# Yes
517/*
518 * v86 calls save the btx_v86 pointer on the real mode stack and read
519 * the address and flags from the btx_v86 structure.  For interrupt
520 * handler invocations (VM86 INTx requests), disable interrupts,
521 * tracing, and alignment checking while the handler runs.
522 */
523		movl $MEM_USR,%ebx		# User base
524		movl %ebx,%edx			#  address
525		addl -0x4(%esi),%ebx		# User ESP
526		movl (%ebx),%ebp		# btx_v86 pointer
527		addl %ebp,%edx			# Flatten btx_v86 ptr
528		movl %edx,MEM_ESPR-0x08		# Save btx_v86 ptr
529		movl V86_ADDR(%edx),%eax	# Get int no/address
530		movl V86_CTL(%edx),%edx		# Get control flags
531		movl -0x08(%esi),%ebx		# Save user flags in %ebx
532		testl $V86F_ADDR,%edx		# Segment:offset?
533		jnz intusr.4			# Yes
534		andl $~(PSL_I|PSL_T|PSL_AC),%ebx # Disable interrupts, tracing,
535						#  and alignment checking for
536						#  interrupt handler
537		jmp intusr.3			# Skip hardware interrupt
538/*
539 * Hardware interrupts store a NULL btx_v86 pointer and use the
540 * address (interrupt number) from the stack with empty flags.  Also,
541 * push a dummy frame of zeros onto the stack for all the general
542 * purpose and segment registers and clear %eflags.  This gives the
543 * hardware interrupt handler a clean slate.
544 */
545intusr.1:	xorl %edx,%edx			# Control flags
546		movl %edx,MEM_ESPR-0x08		# NULL btx_v86 ptr
547		movl $12,%ecx			# Frame is 12 dwords
548intusr.2:	pushl $0x0			# Fill frame
549		loop intusr.2			#  with zeros
550		movl $PSL_RESERVED_DEFAULT,%ebx # Set clean %eflags
551/*
552 * Look up real mode IDT entry for hardware interrupts and VM86 INTx
553 * requests.
554 */
555intusr.3:	shll $0x2,%eax			# Scale
556		movl (%eax),%eax		# Load int vector
557		jmp intusr.5			# Skip CALLF test
558/*
559 * Panic if V86F_CALLF isn't set with V86F_ADDR.
560 */
561intusr.4:	testl $V86F_CALLF,%edx		# Far call?
562		jnz intusr.5			# Ok
563		movl %edx,0x30(%esp,1)		# Place VM86 flags in int no
564		movl $badvm86,%esi		# Display bad
565		call putstr			#  VM86 call
566		popl %es			# Restore
567		popl %ds			#  seg
568		popl %fs			#  regs
569		popl %gs
570		popal				# Restore gp regs
571		jmp ex_noc			# Panic
572/*
573 * %eax now holds the segment:offset of the function.
574 * %ebx now holds the %eflags to pass to real mode.
575 * %edx now holds the V86F_* flags.
576 */
577intusr.5:	movw %bx,MEM_ESPR-0x12		# Pass user flags to real mode
578						#  target
579/*
580 * If this is a v86 call, copy the seg regs out of the btx_v86 structure.
581 */
582		movl MEM_ESPR-0x08,%ecx		# Get btx_v86 ptr
583		jecxz intusr.6			# Skip for hardware ints
584		leal -0x44(%esi),%edi		# %edi => kernel stack seg regs
585		pushl %esi			# Save
586		leal V86_ES(%ecx),%esi		# %esi => btx_v86 seg regs
587		movl $4,%ecx			# Copy seg regs
588		rep				#  from btx_v86
589		movsl				#  to kernel stack
590		popl %esi			# Restore
591intusr.6:	movl -0x08(%esi),%ebx		# Copy user flags to real
592		movl %ebx,MEM_ESPR-0x0c		#  mode return trampoline
593		movl $rret_tramp,%ebx		# Set return trampoline
594		movl %ebx,MEM_ESPR-0x10		#  CS:IP
595		movl %eax,MEM_ESPR-0x16		# Real mode target CS:IP
596		ljmpw $SEL_RCODE,$intusr.7	# Change to 16-bit segment
597		.code16
598intusr.7:	movl %cr0,%eax			# Leave
599		dec %al				#  protected
600		movl %eax,%cr0			#  mode
601		ljmpw $0x0,$intusr.8
602intusr.8:	xorw %ax,%ax			# Reset %ds
603		movw %ax,%ds			#  and
604		movw %ax,%ss			#  %ss
605		lidt ivtdesc	 		# Set IVT
606		popl %es			# Restore
607		popl %ds			#  seg
608		popl %fs			#  regs
609		popl %gs
610		popal				# Restore gp regs
611		movw $MEM_ESPR-0x16,%sp		# Switch to real mode stack
612		iret				# Call target routine
613/*
614 * For the return to real mode we setup a stack frame like this on the real
615 * mode stack.  Note that callf calls won't pop off the flags, but we just
616 * ignore that by repositioning %sp to be just above the btx_v86 pointer
617 * so it is aligned.  The stack is relative to MEM_ESPR.
618 *
619 * -0x04	kernel %esp
620 * -0x08	btx_v86
621 * -0x0c	%eax
622 * -0x10	%ecx
623 * -0x14	%edx
624 * -0x18	%ebx
625 * -0x1c	%esp
626 * -0x20	%ebp
627 * -0x24	%esi
628 * -0x28	%edi
629 * -0x2c	%gs
630 * -0x30	%fs
631 * -0x34	%ds
632 * -0x38	%es
633 * -0x3c	%eflags
634 */
635rret_tramp:	movw $MEM_ESPR-0x08,%sp		# Reset stack pointer
636		pushal				# Save gp regs
637		pushl %gs			# Save
638		pushl %fs			#  seg
639		pushl %ds			#  regs
640		pushl %es
641		pushfl				# Save %eflags
642		cli				# Disable interrupts
643		std				# String ops dec
644		xorw %ax,%ax			# Reset seg
645		movw %ax,%ds			#  regs
646		movw %ax,%es			#  (%ss is already 0)
647		lidt idtdesc	 		# Set IDT
648		lgdt gdtdesc	 		# Set GDT
649		mov %cr0,%eax			# Switch to protected
650		inc %ax				#  mode
651		mov %eax,%cr0			#
652		ljmp $SEL_SCODE,$rret_tramp.1	# To 32-bit code
653		.code32
654rret_tramp.1:	xorl %ecx,%ecx			# Zero
655		movb $SEL_SDATA,%cl		# Setup
656		movw %cx,%ss			#  32-bit
657		movw %cx,%ds			#  seg
658		movw %cx,%es			#  regs
659		movl MEM_ESPR-0x04,%esp		# Switch to kernel stack
660		leal 0x44(%esp,1),%esi		# Base of frame
661		andb $~0x2,tss_desc+0x5		# Clear TSS busy
662		movb $SEL_TSS,%cl		# Set task
663		ltr %cx				#  register
664/*
665 * Now we are back in protected mode.  The kernel stack frame set up
666 * before entering real mode is still intact. For hardware interrupts,
667 * leave the frame unchanged.
668 */
669		cmpl $0,MEM_ESPR-0x08		# Leave saved regs unchanged
670		jz rret_tramp.3			#  for hardware ints
671/*
672 * For V86 calls, copy the registers off of the real mode stack onto
673 * the kernel stack as we want their updated values.  Also, initialize
674 * the segment registers on the kernel stack.
675 *
676 * Note that the %esp in the kernel stack after this is garbage, but popa
677 * ignores it, so we don't have to fix it up.
678 */
679		leal -0x18(%esi),%edi		# Kernel stack GP regs
680		pushl %esi			# Save
681		movl $MEM_ESPR-0x0c,%esi	# Real mode stack GP regs
682		movl $8,%ecx			# Copy GP regs from
683		rep				#  real mode stack
684		movsl				#  to kernel stack
685		movl $SEL_UDATA,%eax		# Selector for data seg regs
686		movl $4,%ecx			# Initialize %ds,
687		rep				#  %es, %fs, and
688		stosl				#  %gs
689/*
690 * For V86 calls, copy the saved seg regs on the real mode stack back
691 * over to the btx_v86 structure.  Also, conditionally update the
692 * saved eflags on the kernel stack based on the flags from the user.
693 */
694		movl MEM_ESPR-0x08,%ecx		# Get btx_v86 ptr
695		leal V86_GS(%ecx),%edi		# %edi => btx_v86 seg regs
696		leal MEM_ESPR-0x2c,%esi		# %esi => real mode seg regs
697		xchgl %ecx,%edx			# Save btx_v86 ptr
698		movl $4,%ecx			# Copy seg regs
699		rep				#  from real mode stack
700		movsl				#  to btx_v86
701		popl %esi			# Restore
702		movl V86_CTL(%edx),%edx		# Read V86 control flags
703		testl $V86F_FLAGS,%edx		# User wants flags?
704		jz rret_tramp.3			# No
705		movl MEM_ESPR-0x3c,%eax		# Read real mode flags
706		movw %ax,-0x08(%esi)		# Update user flags (low 16)
707/*
708 * Return to the user task
709 */
710rret_tramp.3:	popl %es			# Restore
711		popl %ds			#  seg
712		popl %fs			#  regs
713		popl %gs
714		popal				# Restore gp regs
715		addl $4,%esp			# Discard int no
716		iret				# Return to user mode
717
718/*
719 * System Call.
720 */
721intx30: 	cmpl $SYS_EXEC,%eax		# Exec system call?
722		jne intx30.1			# No
723		pushl %ss			# Set up
724		popl %es			#  all
725		pushl %es			#  segment
726		popl %ds			#  registers
727		pushl %ds			#  for the
728		popl %fs			#  program
729		pushl %fs			#  we're
730		popl %gs			#  invoking
731		movl $MEM_USR,%eax		# User base address
732		addl 0xc(%esp,1),%eax		# Change to user
733		leal 0x4(%eax),%esp		#  stack
734		popl %eax			# Call
735		call *%eax			#  program
736intx30.1:	orb $0x1,%ss:btx_hdr+0x7	# Flag reboot
737		jmp exit			# Exit
738/*
739 * Dump structure [EBX] to [EDI], using format string [ESI].
740 */
741dump.0: 	stosb				# Save char
742dump:		lodsb				# Load char
743		testb %al,%al			# End of string?
744		jz dump.10			# Yes
745		testb $0x80,%al 		# Control?
746		jz dump.0			# No
747		movb %al,%ch			# Save control
748		movb $'=',%al			# Append
749		stosb				#  '='
750		lodsb				# Get offset
751		pushl %esi			# Save
752		movsbl %al,%esi 		# To
753		addl %ebx,%esi			#  pointer
754		testb $DMP_X16,%ch		# Dump word?
755		jz dump.1			# No
756		lodsw				# Get and
757		call hex16			#  dump it
758dump.1: 	testb $DMP_X32,%ch		# Dump long?
759		jz dump.2			# No
760		lodsl				# Get and
761		call hex32			#  dump it
762dump.2: 	testb $DMP_MEM,%ch		# Dump memory?
763		jz dump.8			# No
764		pushl %ds			# Save
765		testl $PSL_VM,0x50(%ebx)	# V86 mode?
766		jnz dump.3			# Yes
767		verr 0x4(%esi)	 		# Readable selector?
768		jnz dump.3			# No
769		ldsl (%esi),%esi		# Load pointer
770		jmp dump.4			# Join common code
771dump.3: 	lodsl				# Set offset
772		xchgl %eax,%edx 		# Save
773		lodsl				# Get segment
774		shll $0x4,%eax			#  * 0x10
775		addl %edx,%eax			#  + offset
776		xchgl %eax,%esi 		# Set pointer
777dump.4: 	movb $2,%dl			# Num lines
778dump.4a:	movb $0x10,%cl			# Bytes to dump
779dump.5: 	lodsb				# Get byte and
780		call hex8			#  dump it
781		decb %cl			# Keep count
782		jz dump.6a			# If done
783		movb $'-',%al			# Separator
784		cmpb $0x8,%cl			# Half way?
785		je dump.6			# Yes
786		movb $' ',%al			# Use space
787dump.6: 	stosb				# Save separator
788		jmp dump.5			# Continue
789dump.6a:	decb %dl			# Keep count
790		jz dump.7			# If done
791		movb $0xa,%al			# Line feed
792		stosb				# Save one
793		movb $7,%cl			# Leading
794		movb $' ',%al			#  spaces
795dump.6b:	stosb				# Dump
796		decb %cl			#  spaces
797		jnz dump.6b
798		jmp dump.4a			# Next line
799dump.7: 	popl %ds			# Restore
800dump.8: 	popl %esi			# Restore
801		movb $0xa,%al			# Line feed
802		testb $DMP_EOL,%ch		# End of line?
803		jnz dump.9			# Yes
804		movb $' ',%al			# Use spaces
805		stosb				# Save one
806dump.9: 	jmp dump.0			# Continue
807dump.10:	stosb				# Terminate string
808		ret				# To caller
809/*
810 * Convert EAX, AX, or AL to hex, saving the result to [EDI].
811 */
812hex32:		pushl %eax			# Save
813		shrl $0x10,%eax 		# Do upper
814		call hex16			#  16
815		popl %eax			# Restore
816hex16:		call hex16.1			# Do upper 8
817hex16.1:	xchgb %ah,%al			# Save/restore
818hex8:		pushl %eax			# Save
819		shrb $0x4,%al			# Do upper
820		call hex8.1			#  4
821		popl %eax			# Restore
822hex8.1: 	andb $0xf,%al			# Get lower 4
823		cmpb $0xa,%al			# Convert
824		sbbb $0x69,%al			#  to hex
825		das				#  digit
826		orb $0x20,%al			# To lower case
827		stosb				# Save char
828		ret				# (Recursive)
829/*
830 * Output zero-terminated string [ESI] to the console.
831 */
832putstr.0:	call putchr			# Output char
833putstr: 	lodsb				# Load char
834		testb %al,%al			# End of string?
835		jnz putstr.0			# No
836		ret				# To caller
837#ifdef BTX_SERIAL
838		.set SIO_PRT,SIOPRT		# Base port
839		.set SIO_FMT,SIOFMT		# 8N1
840		.set SIO_DIV,(115200/SIOSPD)	# 115200 / SPD
841
842/*
843 * int sio_init(void)
844 */
845sio_init:	movw $SIO_PRT+0x3,%dx		# Data format reg
846		movb $SIO_FMT|0x80,%al		# Set format
847		outb %al,(%dx)			#  and DLAB
848		pushl %edx			# Save
849		subb $0x3,%dl			# Divisor latch reg
850		movw $SIO_DIV,%ax		# Set
851		outw %ax,(%dx)			#  BPS
852		popl %edx			# Restore
853		movb $SIO_FMT,%al		# Clear
854		outb %al,(%dx)			#  DLAB
855		incl %edx			# Modem control reg
856		movb $0x3,%al			# Set RTS,
857		outb %al,(%dx)			#  DTR
858		incl %edx			# Line status reg
859		call sio_getc.1 		# Get character
860
861/*
862 * int sio_flush(void)
863 */
864sio_flush:	xorl %eax,%eax			# Return value
865		xorl %ecx,%ecx			# Timeout
866		movb $0x80,%ch			#  counter
867sio_flush.1:	call sio_ischar 		# Check for character
868		jz sio_flush.2			# Till none
869		loop sio_flush.1		#  or counter is zero
870		movb $1, %al			# Exhausted all tries
871sio_flush.2:	ret				# To caller
872
873/*
874 * void sio_putc(int c)
875 */
876sio_putc:	movw $SIO_PRT+0x5,%dx		# Line status reg
877		xor %ecx,%ecx			# Timeout
878		movb $0x40,%ch			#  counter
879sio_putc.1:	inb (%dx),%al			# Transmitter
880		testb $0x20,%al 		#  buffer empty?
881		loopz sio_putc.1		# No
882		jz sio_putc.2			# If timeout
883		movb 0x4(%esp,1),%al		# Get character
884		subb $0x5,%dl			# Transmitter hold reg
885		outb %al,(%dx)			# Write character
886sio_putc.2:	ret $0x4			# To caller
887
888/*
889 * int sio_getc(void)
890 */
891sio_getc:	call sio_ischar 		# Character available?
892		jz sio_getc			# No
893sio_getc.1:	subb $0x5,%dl			# Receiver buffer reg
894		inb (%dx),%al			# Read character
895		ret				# To caller
896
897/*
898 * int sio_ischar(void)
899 */
900sio_ischar:	movw $SIO_PRT+0x5,%dx		# Line status register
901		xorl %eax,%eax			# Zero
902		inb (%dx),%al			# Received data
903		andb $0x1,%al			#  ready?
904		ret				# To caller
905
906/*
907 * Output character AL to the serial console.
908 */
909putchr: 	pusha				# Save
910		cmpb $10, %al			# is it a newline?
911		jne putchr.1			#  no?, then leave
912		push $13			# output a carriage
913		call sio_putc			#  return first
914		movb $10, %al			# restore %al
915putchr.1:	pushl %eax			# Push the character
916						#  onto the stack
917		call sio_putc			# Output the character
918		popa				# Restore
919		ret				# To caller
920#else
921/*
922 * Output character AL to the console.
923 */
924putchr: 	pusha				# Save
925		xorl %ecx,%ecx			# Zero for loops
926		movb $SCR_MAT,%ah		# Mode/attribute
927		movl $BDA_POS,%ebx		# BDA pointer
928		movw (%ebx),%dx 		# Cursor position
929		movl $0xa0000,%edi
930putchr.1:	cmpb $0xa,%al			# New line?
931		je putchr.2			# Yes
932		movw %dx,%cx
933		movb %al,(%edi,%ecx,1)		# Write char
934		addl $0x2000,%ecx
935		movb %ah,(%edi,%ecx,1)		# Write attr
936		addw $0x02,%dx
937		jmp putchr.3
938putchr.2:	movw %dx,%ax
939		movb $SCR_COL*2,%dl
940		div %dl
941		incb %al
942		mul %dl
943		movw %ax,%dx
944putchr.3:	cmpw $SCR_ROW*SCR_COL*2,%dx
945		jb putchr.4			# No
946		leal 2*SCR_COL(%edi),%esi	# New top line
947		movw $(SCR_ROW-1)*SCR_COL/2,%cx # Words to move
948		rep				# Scroll
949		movsl				#  screen
950		movb $0x20,%al			# Space
951		xorb %ah,%ah
952		movb $SCR_COL,%cl		# Columns to clear
953		rep				# Clear
954		stosw				#  line
955		movw $(SCR_ROW-1)*SCR_COL*2,%dx
956putchr.4:	movw %dx,(%ebx) 		# Update position
957		popa				# Restore
958		ret				# To caller
959#endif
960
961		.code16
962/*
963 * Real Mode Hardware interrupt jump table.
964 */
965intr20: 	push $0x8			# Int 0x20: IRQ0
966		jmp int_hwr			# V86 int 0x8
967		push $0x9			# Int 0x21: IRQ1
968		jmp int_hwr			# V86 int 0x9
969		push $0xa			# Int 0x22: IRQ2
970		jmp int_hwr			# V86 int 0xa
971		push $0xb			# Int 0x23: IRQ3
972		jmp int_hwr			# V86 int 0xb
973		push $0xc			# Int 0x24: IRQ4
974		jmp int_hwr			# V86 int 0xc
975		push $0xd			# Int 0x25: IRQ5
976		jmp int_hwr			# V86 int 0xd
977		push $0xe			# Int 0x26: IRQ6
978		jmp int_hwr			# V86 int 0xe
979		push $0xf			# Int 0x27: IRQ7
980		jmp int_hwr			# V86 int 0xf
981		push $0x10			# Int 0x28: IRQ8
982		jmp int_hwr			# V86 int 0x10
983		push $0x11			# Int 0x29: IRQ9
984		jmp int_hwr			# V86 int 0x11
985		push $0x12			# Int 0x2a: IRQ10
986		jmp int_hwr			# V86 int 0x12
987		push $0x13			# Int 0x2b: IRQ11
988		jmp int_hwr			# V86 int 0x13
989		push $0x14			# Int 0x2c: IRQ12
990		jmp int_hwr			# V86 int 0x14
991		push $0x15			# Int 0x2d: IRQ13
992		jmp int_hwr			# V86 int 0x15
993		push $0x16			# Int 0x2e: IRQ14
994		jmp int_hwr			# V86 int 0x16
995		push $0x17			# Int 0x2f: IRQ15
996		jmp int_hwr			# V86 int 0x17
997/*
998 * Reflect hardware interrupts in real mode.
999 */
1000int_hwr: 	push %ax			# Save
1001		push %ds			# Save
1002		push %bp			# Save
1003		mov %sp,%bp			# Address stack frame
1004		xchg %bx,6(%bp)			# Swap BX, int no
1005		xor %ax,%ax			# Set %ds:%bx to
1006		shl $2,%bx			#  point to
1007		mov %ax,%ds			#  IDT entry
1008		mov (%bx),%ax			# Load IP
1009		mov 2(%bx),%bx			# Load CS
1010		xchg %ax,4(%bp)			# Swap saved %ax,%bx with
1011		xchg %bx,6(%bp)			#  CS:IP of handler
1012		pop %bp				# Restore
1013		pop %ds				# Restore
1014		lret				# Jump to handler
1015
1016		.p2align 4
1017/*
1018 * Global descriptor table.
1019 */
1020gdt:		.word 0x0,0x0,0x0,0x0		# Null entry
1021		.word 0xffff,0x0,0x9a00,0xcf	# SEL_SCODE
1022		.word 0xffff,0x0,0x9200,0xcf	# SEL_SDATA
1023		.word 0xffff,0x0,0x9a00,0x0	# SEL_RCODE
1024		.word 0xffff,0x0,0x9200,0x0	# SEL_RDATA
1025		.word 0xffff,MEM_USR,0xfa00,0xcf# SEL_UCODE
1026		.word 0xffff,MEM_USR,0xf200,0xcf# SEL_UDATA
1027tss_desc:	.word _TSSLM,MEM_TSS,0x8900,0x0 # SEL_TSS
1028gdt.1:
1029/*
1030 * Pseudo-descriptors.
1031 */
1032gdtdesc:	.word gdt.1-gdt-1,gdt,0x0	# GDT
1033idtdesc:	.word _IDTLM,MEM_IDT,0x0	# IDT
1034ivtdesc:	.word 0x400-0x0-1,0x0,0x0	# IVT
1035/*
1036 * IDT construction control string.
1037 */
1038idtctl: 	.byte 0x10,  0x8e		# Int 0x0-0xf
1039		.word 0x7dfb,intx00		#  (exceptions)
1040		.byte 0x10,  0x8e		# Int 0x10
1041		.word 0x1,   intx10		#  (exception)
1042		.byte 0x10,  0x8e		# Int 0x20-0x2f
1043		.word 0xffff,intx20		#  (hardware)
1044		.byte 0x1,   0xee		# int 0x30
1045		.word 0x1,   intx30		#  (system call)
1046		.byte 0x2,   0xee		# Int 0x31-0x32
1047		.word 0x1,   intx31		#  (V86, null)
1048		.byte 0x0			# End of string
1049/*
1050 * Dump format string.
1051 */
1052dmpfmt: 	.byte '\n'			# "\n"
1053		.ascii "int"			# "int="
1054		.byte 0x80|DMP_X32,	   0x40 # "00000000  "
1055		.ascii "err"			# "err="
1056		.byte 0x80|DMP_X32,	   0x44 # "00000000  "
1057		.ascii "efl"			# "efl="
1058		.byte 0x80|DMP_X32,	   0x50 # "00000000  "
1059		.ascii "eip"			# "eip="
1060		.byte 0x80|DMP_X32|DMP_EOL,0x48 # "00000000\n"
1061		.ascii "eax"			# "eax="
1062		.byte 0x80|DMP_X32,	   0x34 # "00000000  "
1063		.ascii "ebx"			# "ebx="
1064		.byte 0x80|DMP_X32,	   0x28 # "00000000  "
1065		.ascii "ecx"			# "ecx="
1066		.byte 0x80|DMP_X32,	   0x30 # "00000000  "
1067		.ascii "edx"			# "edx="
1068		.byte 0x80|DMP_X32|DMP_EOL,0x2c # "00000000\n"
1069		.ascii "esi"			# "esi="
1070		.byte 0x80|DMP_X32,	   0x1c # "00000000  "
1071		.ascii "edi"			# "edi="
1072		.byte 0x80|DMP_X32,	   0x18 # "00000000  "
1073		.ascii "ebp"			# "ebp="
1074		.byte 0x80|DMP_X32,	   0x20 # "00000000  "
1075		.ascii "esp"			# "esp="
1076		.byte 0x80|DMP_X32|DMP_EOL,0x0	# "00000000\n"
1077		.ascii "cs"			# "cs="
1078		.byte 0x80|DMP_X16,	   0x4c # "0000  "
1079		.ascii "ds"			# "ds="
1080		.byte 0x80|DMP_X16,	   0xc	# "0000  "
1081		.ascii "es"			# "es="
1082		.byte 0x80|DMP_X16,	   0x8	# "0000  "
1083		.ascii "  "			# "  "
1084		.ascii "fs"			# "fs="
1085		.byte 0x80|DMP_X16,	   0x10 # "0000  "
1086		.ascii "gs"			# "gs="
1087		.byte 0x80|DMP_X16,	   0x14 # "0000  "
1088		.ascii "ss"			# "ss="
1089		.byte 0x80|DMP_X16|DMP_EOL,0x4	# "0000\n"
1090		.ascii "cs:eip" 		# "cs:eip="
1091		.byte 0x80|DMP_MEM|DMP_EOL,0x48 # "00 00 ... 00 00\n"
1092		.ascii "ss:esp" 		# "ss:esp="
1093		.byte 0x80|DMP_MEM|DMP_EOL,0x0	# "00 00 ... 00 00\n"
1094		.asciz "BTX halted\n"		# End
1095/*
1096 * Bad VM86 call panic
1097 */
1098badvm86:	.asciz "Invalid VM86 Request\n"
1099
1100/*
1101 * End of BTX memory.
1102 */
1103		.p2align 4
1104break:
1105