xref: /haiku/src/system/boot/platform/bios_ia32/shell.S (revision 4f2fd49bdc6078128b1391191e4edac647044c3d)
1/*
2 * Copyright 2004-2005, Axel Dörfler, axeld@pinc-software.de. All rights reserved.
3 * Distributed under the terms of the MIT License.
4 */
5
6
7/**	This file contains the boot floppy and BFS boot block entry points for
8 *	the stage 2 boot loader.
9 *	The floppy entry point is at offset 0. It's loaded at 0x07c0:0x000. It
10 *	will load the rest of the loader to 0x1000:0x0200 and execute it.
11 *	The BFS boot block will load the whole stage 2 loader to 0x1000:0x0000
12 *	and will then jump to 0x1000:0x0200 as its entry point.
13 *	This code will then switch to protected mode and will directly call
14 *	the entry function of the embedded ELF part of the loader.
15 */
16
17#define GLOBAL(x) .globl x ; x
18
19// this saves us some trouble with relocation (I didn't manage GAS to
20// create 32 bit references to labels)
21#define FAILURE_STRING 0x1d0
22#define DOT_STRING 0x1fc
23
24#define DRIVE_RETRIES 3
25	// when the drive reading fails for some reason, it will
26	// retry this many times until it will report a failure
27
28.text
29.code16
30
31/** This is the entry point when we were written directly to a floppy disk */
32
33	jmp		floppy_start
34
35sNumSectors:
36	// this location will contain the length of the boot loader as
37	// written by the "makeflop" command in 512 byte blocks
38	// 0x180 is the allowed maximum, as the zipped TAR with the
39	// kernel and the boot module might start at offset 192 kB
40	.word BOOT_ARCHIVE_IMAGE_OFFSET*2
41
42floppy_start:
43	cli
44	cld
45
46	// set up the stack to 0x0000:0x9000
47	xor		%ax, %ax
48	mov		%ax, %ss
49	mov		$0x9000, %sp
50
51	push	$0x07c0
52	pop		%ds
53	push	$0x1000
54	pop		%es
55
56	// load the rest of the boot loader to 0x1000:0x0200
57	.code32					// we need to create a 32-bit relocation entry for the linker...
58	.byte	0x67
59	movw	sNumSectors - 0x10000, %di
60		// the loader symbols are located at offset 0x10000
61	.code16
62	xor		%dh, %dh		// head 0, don't change BIOS boot device
63	mov		$0x2, %cx		// sector 2
64	mov		$0x200, %bx		// to 0x1000:0x0200
65	call	load_sectors
66
67	// ToDo: this seems to be problematic, at least under Bochs (reboot will fail)
68#if 0
69	or		%dl, %dl		// if it's a floppy, turn off its motor
70	jnz		start_loader
71	call	disable_floppy_motor
72#endif
73
74start_loader:
75	// indicate that we were booted from CD/floppy/whatever
76	.code32
77	.byte	0x67
78	movb	$1, gBootedFromImage - 0x7c00
79		// %ds is 0x7c0 right now, but the symbol were loaded
80		// to offset 0x10000
81	.code16
82
83	// set our environment and jump to the standard BFS boot block entry point
84	xor		%dx, %dx		// boot device ID and partition offset to 0
85	xor		%eax, %eax
86	ljmp	$0x1000, $0x0200
87
88
89/**	Loads %di sectors from floppy disk, starting at head %dh, sector %cx.
90 *	The data is loaded to %es:%bx. On exit, %es:%bx will point immediately
91 *	behind the loaded data, so that you can continue to read in data.
92 *	%ax, %cx, %dx, %bp, %di and %si will be clobbered.
93 */
94
95load_sectors:
96	// first, get information about the drive as we intend to read whole tracks
97	push	%bx
98	push	%cx
99	push	%dx
100	push	%di
101	push	%es
102
103	movb	$8, %ah			// get drive parameters - changes a lot of registers
104	int		$0x13
105
106	pop		%es
107	pop		%di
108		// ToDo: store the number of heads somewhere (it's in %dh)
109	pop		%dx
110	and		$63, %cx		// mask out max. sector number (bit 0-5)
111	mov		%cx, %si		// and remember it
112	pop		%cx
113	pop		%bx
114
115load_track:
116	mov		%di, %ax		// limit the sector count to track boundaries
117	add		%cl, %al
118	dec		%ax
119	cmp		%si, %ax
120	jbe		matches_track_boundary
121	mov		%si, %ax
122matches_track_boundary:
123	inc		%ax				// take the current sector offset into account
124	sub		%cl, %al
125
126	// make sure we don't cross a 64kB address boundary or else the read will fail
127	// (this small piece of knowledge took me some time to accept :))
128	shl		$9, %ax
129	mov		%ax, %bp
130	add		%bx, %bp
131	jnc		respects_boundary
132	xor		%ax, %ax		// only read up to the 64kB boundary
133	sub		%bx, %ax
134respects_boundary:
135	shr		$9, %ax
136	mov		DRIVE_RETRIES, %bp
137
138try_to_read:
139	pusha
140	movb	$2, %ah			// load sectors from drive
141	int		$0x13
142	jnc		read_succeeded
143
144	xor		%ax, %ax
145	int		$0x13			// reset drive
146	popa
147
148	dec		%bp
149	jz		load_failed		// if already retried often enough, bail out
150	jmp		try_to_read
151
152read_succeeded:
153	mov		$DOT_STRING, %si
154	call	print_string
155	popa
156
157	xor		%ah, %ah
158	add		%ax, %cx		// next sector start
159	sub		%ax, %di		// update sectors left to be read
160
161	shl		$9, %ax			// get byte offset
162	add		%ax, %bx		// update target address
163	jnz		check_sector_start
164
165	mov		%es, %ax		// overflow to the next 64kB, %bx is already zero
166	add		$0x1000, %ax
167	mov		%ax, %es
168
169check_sector_start:
170	mov		%si, %ax		// compare the sectors, not the cylinders
171	cmp		%al, %cl
172	jbe		continue_reading
173
174	sub		%si, %cx
175	inc		%dh				// next head
176	cmp		$1, %dh
177		// ToDo: check max. number of heads!
178	jbe		check_sector_start
179
180	xor		%dh, %dh		// next cylinder
181	inc		%ch
182	jmp		check_sector_start
183
184continue_reading:
185	or		%di, %di
186	jnz		load_track
187	ret
188
189load_failed:
190	mov		$FAILURE_STRING, %si
191	call	print_string
192
193	xor		%ax, %ax
194	int		$0x16			// wait for key
195	int		$0x19			// and reboot
196
197disable_floppy_motor:
198	xor		%al, %al
199	mov		$0x3f2, %dx
200	out		%al, %dx
201	ret
202
203print_string:
204	movb	$0x0e, %ah
205	xor		%bx, %bx
206print_char:
207	lodsb
208	orb		%al, %al		// are there still characters left?
209	jz		no_more_chars
210	int		$0x10
211	jmp		print_char
212no_more_chars:
213	ret
214
215floppy_end:
216	.org	FAILURE_STRING
217	.string " Loading failed! Press key to reboot.\r\n"
218	.org	DOT_STRING
219	.string	"."
220
221	.org	0x01fe
222	.word	0xaa55
223		// this bumps the "start" label to offset 0x0200 as
224		// expected by the BFS boot loader, and also marks
225		// this block as valid boot block for the BIOS
226
227
228//--------------------------------------------------------------
229
230/**	This is the entry point of the stage2 bootloader when it has
231 *	been loaded from the stage1 loader from a BFS disk.
232 */
233
234bfs_start:
235	cld						// set the data, and extra segment to our code start
236	pushw	$0x1000
237	pop		%ds
238	push	%ds
239	pop		%es
240
241	.code32					// save knowledge from the BFS boot block for later use
242	.byte	0x67
243	movb	%dl, gBootDriveID - 0x10000
244	.byte	0x67
245	.byte	0x66
246	movl	%eax, gBootPartitionOffset - 0x10000
247	.code16
248
249	xor		%ax, %ax		// set up stack at 0x0000:0x9000
250	mov		%ax, %ss
251	mov		$0x9000, %sp
252
253	cli						// no interrupts please
254	call	enable_a20		// enable a20 gate
255
256	.code32					// This forces a 32 bit relocation entry
257	.byte	0x66			// that allows linking with others
258	.byte	0x67
259	lgdt	gdt_descriptor - 0x10000
260		// load global descriptor table; we're still in real mode segment
261		// 0x1000 so we have to manually correct the address
262
263	.code16
264	movl	%cr0, %eax		// set the PE bit of cr0 to switch to protected mode
265	orb		$0x1, %al
266	movl	%eax, %cr0
267
268	.code32
269	.byte	0x66
270	ljmp	$0x8, $_protected_code_segment
271_protected_code_segment:
272	mov		$0x10, %ax		// load descriptor 2 in the data and stack segment selectors
273	mov		%ax, %ds
274	mov		%ax, %es
275	mov		%ax, %fs
276	mov		%ax, %gs
277	mov		%ax, %ss
278
279	mov		$0x10000, %ebp	// setup new stack
280	mov		%ebp, %esp
281
282	call	_start
283
284//--------------------------------------------------------------
285
286/** Enables the a20 gate. It will first try to enable it through
287 *	the BIOS, and, if that fails, will use the old style AT mechanism
288 *	using the keyboard port.
289 *	ToDo: it no longer does this! Now, it just uses the "fast A20"
290 *		mechanism using port 0x92. This does work on all systems
291 *		I have access to.
292 */
293
294enable_a20:
295	inb		$0x92, %al
296	testb	$0x02, %al
297	jnz		_a20_out
298	orb		$0x02, %al
299	andb	$0xfe, %al
300	outb	%al, $0x92
301_a20_out:
302	ret
303
304// ToDo: the code below didn't seem to work properly on all machines
305/*	movw	$0x2402, %ax		// first, query the a20 status
306	int		$0x15
307	jc		_a20_old_method		// if that fails, use the old AT method
308	test	$0x1, %al
309	jnz		_a20_done			// Is a20 gate already enabled?
310	movw	$0x2401, %ax
311	int		$0x15
312	jnc		_a20_done
313_a20_old_method:
314	call	_a20_loop1			// empty the keyboard buffer
315	jnz		_a20_done
316	movb	$0xd1, %al
317	outb	%al, $0x64
318	call	_a20_loop1			// empty the keyboard buffer
319	jnz		_a20_done
320	movb	$0xdf, %al
321	outb	%al, $0x60
322_a20_loop1:
323	movl	$0x20000, %ecx
324_a20_loop2:
325	inb		$0x64, %al
326	test	$0x2, %al
327	loopne	_a20_loop2
328_a20_done:
329	ret
330*/
331
332//--------------------------------------------------------------
333
334.org 896
335	// since we don't need the above space when the boot loader is
336	// running, it is used as a real mode scratch buffer (as our
337	// boot loader spans over the whole real mode 0x1000 segment)
338
339/* global data table */
340
341gdt:
342	// null descriptor
343	.long	0
344	.long	0
345
346	// kernel code segment
347	.long	0x0000ffff		// base: 0, limit: 4 GB
348	.long	0x00cf9e00		// type: 32 bit, exec-only conforming, privilege 0
349	// kernel data and stack segment
350	.long	0x0000ffff		// base: 0, limit: 4 GB
351	.long	0x00cf9200		// type: 32 bit, data read/write, privilege 0
352
353	// real mode 16 bit code segment
354	.long	0x0000ffff		// base: 0x10000, limit: 64 kB
355	.long	0x00009e01
356	// real mode 16 bit data and stack segment
357	.long	0x0000ffff		// base: 0x10000, limit: 64 kB
358	.long	0x00009201
359	// real mode 16 bit stack segment
360	.long	0x0000ffff		// base: 0, limit: 64 kB
361	.long	0x00009200
362
363gdt_descriptor:
364	.word	0x2f			// 6 entries in the GDT (8 bytes each)
365	.long	gdt
366
367GLOBAL(gBootedFromImage):
368	.byte	0
369
370GLOBAL(gBootDriveID):
371	.byte	0
372
373GLOBAL(gBootPartitionOffset):
374	.long	0
375
376.org 1024
377