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