• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1/* -----------------------------------------------------------------------
2 *
3 *   Copyright 2007-2009 H. Peter Anvin - All Rights Reserved
4 *   Copyright 2009-2010 Intel Corporation; author: H. Peter Anvin
5 *
6 *   Permission is hereby granted, free of charge, to any person
7 *   obtaining a copy of this software and associated documentation
8 *   files (the "Software"), to deal in the Software without
9 *   restriction, including without limitation the rights to use,
10 *   copy, modify, merge, publish, distribute, sublicense, and/or
11 *   sell copies of the Software, and to permit persons to whom
12 *   the Software is furnished to do so, subject to the following
13 *   conditions:
14 *
15 *   The above copyright notice and this permission notice shall
16 *   be included in all copies or substantial portions of the Software.
17 *
18 *   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
19 *   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
20 *   OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
21 *   NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
22 *   HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
23 *   WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
24 *   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
25 *   OTHER DEALINGS IN THE SOFTWARE.
26 *
27 * ----------------------------------------------------------------------- */
28
29#include "adjust.h"
30
31	.code16
32	.text
33
34	.globl	bootsec
35stack		= 0x7c00
36
37/* Partition table header here */
38phdr		= stack		/* Above the stack, overwritten by bootsect */
39/* Partition table sector here */
40/* To handle > 32K we need to play segment tricks... */
41psec		= _phdr + 512
42
43/* Where we put DS:SI */
44dssi_out	= _start + 0x1be
45
46BIOS_kbdflags	= 0x417
47BIOS_page	= 0x462
48
49	/* gas/ld has issues with doing this as absolute addresses... */
50	.section ".bootsec", "a", @nobits
51	.globl	bootsec
52bootsec:
53	.space	512
54
55	.text
56	.globl	_start
57_start:
58	.byte	0x33, 0xc0	/* xorw	%ax, %ax */
59	cli
60	movw	%ax, %ds
61	movw	%ax, %ss
62	movw	$stack, %sp
63	movw	%sp, %si
64	pushw	%es		/* 4(%bp) es:di -> $PnP header */
65	pushw	%di		/* 2(%bp) */
66	movw	%ax, %es
67	sti
68	cld
69
70	/* Copy down to 0:0x600 */
71	movw	$_start, %di
72	movw	$(512/2), %cx
73	rep; movsw
74
75	ljmpw	$0, $next
76next:
77
78	ADJUST_DRIVE
79	pushw	%dx		/* 0(%bp) = %dl -> drive number */
80	movw	%sp, %bp	/* %bp -> frame pointer: LEAVE UNCHANGED */
81
82	/* prepare to read sector size */
83	sub	$0x1c, %sp	/* -28(%bp) == %sp */
84	pushw	$0x1e		/* -30(%bp) == %sp */
85	movw	$0x200, -6(%bp)	/* -6(%bp) sector size */
86
87	/* Check to see if we have EBIOS */
88	pushw	%dx		/* drive number */
89	movb	$0x41, %ah	/* %al == 0 already */
90	movw	$0x55aa, %bx
91	xorw	%cx, %cx
92	xorb	%dh, %dh
93	stc
94	int	$0x13
95	popw	%dx		/* restore drive */
96	movb	$0x08, %ah	/* get CHS geometry */
97	jc	1f
98	cmpw	$0xaa55, %bx
99	jne	1f
100	shrw	%cx		/* Bit 0 = fixed disk subset */
101	jnc	1f
102
103	/* We have EBIOS; patch in the following code at
104	   read_sector_cbios: movb $0x42, %ah ;  jmp read_common */
105	movl	$0xeb42b4+((read_common-read_sector_cbios-4) << 24), \
106		(read_sector_cbios)
107
108	/*
109	 * read sector size.
110	 * Should not fail but if it does I assume that at least
111	 * previous 512 value is not overridden
112	 */
113	movb	$0x48, %ah
114	movw	%sp, %si
115
1161:
117	/* Get (C)HS geometry */
118	int	$0x13
119
120	/* here we computer CHS values or just do some dummy computation for EBIOS */
121	andw	$0x3f, %cx	/* Sector count */
122	pushw	%cx		/* -32(%bp) Save sectors on the stack */
123	movzbw	%dh, %ax	/* dh = max head */
124	incw	%ax		/* From 0-based max to count */
125	mulw	%cx		/* Heads*sectors -> sectors per cylinder */
126
127	/* Save sectors/cylinder on the stack */
128	pushw	%dx		/* -34(%bp) High word */
129	pushw	%ax		/* -36(%bp) Low word */
130
131	/* Load partition table header */
132	xorl	%eax,%eax
133	cltd
134	incw	%ax		/* %edx:%eax = 1 */
135	call	read_sector_phdr
136
137	/* Number of partition sectors */
138	/* We assume the partition table is 32K or less */
139	movw	(80+6)(%bp),%cx		/* NumberOfPartitionEntries */
140	movw	(84+6)(%bp),%ax		/* SizeOfPartitionEntry */
141	pushw	%ax
142	pushw	%cx
143	mulw	%cx
144	divw	-6(%bp)	/* %dx == 0 here */
145	xchgw	%ax,%cx
146	incw	%cx
147
148	/* Starting LBA of partition array */
149	movl	(72+6)(%bp),%eax
150	movl	(76+6)(%bp),%edx
151
152	pushw	%bx
153get_ptab:
154	call	read_sector
155	loopw	get_ptab
156
157	/* Find the boot partition */
158	xorw	%si,%si			/* Nothing found yet */
159	popw	%di			/* Partition table in memory */
160	popw	%cx			/* NumberOfPartitionEntries */
161	popw	%ax			/* SizeOfPartitionEntry */
162
163find_part:
164	/* If the PartitionTypeGUID is all zero, it's an empty slot */
165	movl	  (%di),%edx
166	orl	 4(%di),%edx
167	orl	 8(%di),%edx
168	orl	12(%di),%edx
169	jz	not_this
170	testb	$0x04,48(%di)
171	jz	not_this
172	andw	%si,%si
173	jnz	found_multiple
174	movw	%di,%si
175not_this:
176	addw	%ax,%di
177	loopw	find_part
178
179	andw	%si,%si
180	jnz	found_part
181
182missing_os:
183	call	error
184	.ascii	"Missing OS\r\n"
185
186found_multiple:
187	call	error
188	.ascii	"Multiple active partitions\r\n"
189
190found_part:
191	xchgw	%ax,%cx		/* Set up %cx for rep movsb further down */
192
193	movw	$dssi_out,%di
194	pushw	%di
195
196	/* 80 00 00 00 ee 00 00 00
197	   - bootable partition, type EFI (EE), no CHS information */
198	xorl	%eax,%eax
199	movb	$0x80,%al
200	stosl
201	movb	$0xed,%al
202	stosl
203	movl	32(%si),%eax
204	movl	36(%si),%edx
205	call	saturate_stosl		/* Partition start */
206
207	movl	40(%si),%eax
208	movl	44(%si),%edx
209	subl	32(%si),%eax
210	sbbl	36(%si),%edx
211	call	inc64
212	call	saturate_stosl		/* Partition length */
213
214	movzwl	%cx,%eax		/* Length of GPT entry */
215	stosl
216
217	rep; movsb			/* GPT entry follows MBR entry */
218	popw	%si
219
220/*
221 * boot: invoke the actual bootstrap. %ds:%si points to the
222 * partition information in memory.  The top word on the stack
223 * is phdr == 0x7c00 == the address of the boot sector.
224 */
225boot:
226	movl	(32+20)(%si),%eax
227	movl	(36+20)(%si),%edx
228	call	read_sector_phdr
229	cmpw	$0xaa55, (0x7c00+0x1fe)
230	jne	missing_os	/* Not a valid boot sector */
231	movw	%bp, %sp	/* driveno == bootsec-6 */
232	popw	%dx		/* dl -> drive number */
233	popw	%di		/* es:di -> $PnP vector */
234	popw	%es
235	movl	$0x54504721,%eax /* !GPT magic number */
236	cli
237	jmpw	*%sp		/* %sp == bootsec */
238
239/*
240 * Store the value in %eax to %di iff %edx == 0, otherwise store -1.
241 * Returns the value that was actually written in %eax.
242 */
243saturate_stosl:
244	andl	%edx,%edx
245	jz 1f
246	orl	$-1,%eax
2471:	stosl
248	ret
249
250read_sector_phdr:
251	movw	$phdr, %bx
252
253	/* fall through and read sector */
254
255/*
256 * read_sector: read a single sector pointed to by %edx:%eax to
257 * %es:%bx.  CF is set on error.  All registers saved.
258 * %edx:%eax and %es:%bx are incremented to read next sector
259 */
260read_sector:
261	pushal
262	pushl	%edx	/* MSW of LBA */
263	pushl	%eax	/* LSW of LBA */
264	pushw	%es	/* Buffer segment */
265	pushw	%bx	/* Buffer offset */
266	pushw	$1	/* Sector count */
267	pushw	$16	/* Size of packet */
268	movw	%sp, %si
269
270	/* This chunk is skipped if we have ebios */
271	/* Do not clobber %es:%bx or %edx:%eax before this chunk! */
272read_sector_cbios:
273	divl	-36(%bp)	/* secpercyl */
274	shlb	$6, %ah
275	movb	%ah, %cl
276	movb	%al, %ch
277	xchgw	%dx, %ax
278	divb	-32(%bp)	/* sectors */
279	movb	%al, %dh
280	orb	%ah, %cl
281	incw	%cx	/* Sectors are 1-based */
282	movw	$0x0201, %ax
283
284read_common:
285	movb	(%bp), %dl /* driveno */
286	int	$0x13
287	leaw	16(%si), %sp	/* Drop DAPA */
288	popal
289	jc	disk_error
290	addb	-5(%bp), %bh		/* bx += sector size: point to the next buffer */
291
292	/* fall through and increment sector number */
293
294/*
295 * Increment %edx:%eax
296 */
297inc64:
298	addl	$1,%eax
299	adcl	$0,%edx
300	ret
301
302disk_error:
303	call	error
304	.ascii	"Disk error\r\n"
305
306/*
307 * Print error messages.  This is invoked with "call", with the
308 * error message at the return address.
309 */
310error:
311	popw	%si
3122:
313	lodsb
314	movb	$0x0e, %ah
315	movb	(BIOS_page), %bh
316	movb	$0x07, %bl
317	int	$0x10		/* May destroy %bp */
318	cmpb	$10, %al	/* Newline? */
319	jne	2b
320
321	int	$0x18		/* Boot failure */
322die:
323	hlt
324	jmp	die
325