1!
2! This is a 'Master Boot Record' following the MSDOS 'standards'.
3! This BB successfully boots MSDOS, Windows or Linux in CHS or Linear.
4!
5! NB: This needs as86 0.16.0 or later
6
7! Lowest available is $0500, MSDOS appears to use $0600 ... I wonder why?
8ORGADDR=$0500
9use512=0	! Put the end marker at byte 510..512
10markptab=1	! Put an end marker just below the partition table.
11
12diskman=1	! Disk manager partitions, allows 16 partitions but
13		! don't overwrite this with a LILO BB.
14revorder=0	! Use physical order for choosing diskman boot partition
15
16linear=0	! Use the linear addresses not the CHS ones (if available)
17useCHS=1	! Disable CHS if you need space.
18linCHS=0        ! Calculate CHS from linear mbr values.
19
20 if 1&~(useCHS|linear)
21  fail! Errm, you can't boot anything without 'linear' or 'useCHS'
22 endif
23
24partition_start=ORGADDR+0x1BE
25partition_size=0x10
26partition_end=ORGADDR+0x1FE
27
28 if diskman
29  ! Partition table start ...
30  table_start=ORGADDR+0xFC
31  low_partition=table_start+2
32 else
33  table_start=partition_start
34 endif
35
36export linear
37export diskman
38export useCHS
39export linCHS
40
41org ORGADDR
42  cli			! Assume _nothing_!
43  cld
44  mov	bx,#$7C00	! Pointer to start of BB.
45  xor	ax,ax		! Segs all to zero
46  mov	ds,ax
47  mov	es,ax
48  mov	ss,ax
49  mov	sp,bx		! SP Just below BB
50  mov	cx,#$100	! Move 256 words
51  mov	si,bx		! From default BB
52  mov	di,#ORGADDR	! To the correct address.
53  rep
54   movsw
55  jmpi	cont,#0		! Set CS:IP correct.
56cont:
57  sti			! Let the interrupts back in.
58
59 if (linear|useCHS)
60
61! Now check the partition table, must use SI as pointer cause that's what the
62! partition boot blocks expect.
63
64! If we're using diskman and we're short of space check the partitions in
65! physical order. (Order. 4,3,2,1,5,6,7,8,9,10,11,12,13,14,15,16)
66
67 if (diskman&revorder)
68
69  mov	si,#partition_end
70check_next:
71  sub	si,#partition_size
72  cmp	byte [si],#$80			! Flag for activated partition
73  jz	found_active
74  cmp	si,#low_partition
75  jnz	check_next
76
77 else
78
79! Normal active partition check, (Order: 1,2,3,4)
80  mov	si,#partition_start
81check_active:
82  cmp	byte [si],#$80			! Flag for activated partition
83  jz	found_active
84try_next_part:
85  add	si,#partition_size
86  cmp	si,#partition_end
87  jnz	check_active
88
89! Check for Disk manager partitions in the order that Linux numbers them.
90 if diskman&~(revorder)
91  cmp	word ptr diskman_magic,#$AA55
92  jnz	no_diskman
93  mov	si,#partition_start
94check_next:
95  sub	si,#partition_size
96  cmp	byte [si],#$80			! Flag for activated partition
97  jz	found_active
98  cmp	si,#low_partition
99  jnz	check_next
100
101no_diskman:
102 endif
103 endif
104
105bad_boot:
106  mov	si,#no_bootpart		! Message & boot
107  jmp	no_boot
108
109! Active partition found, boot it.
110found_active:
111  mov	di,#6		! Max retries, int doc says 3 ... double it
112  movb	[$7DFE],#0	! Clear magic for dosemu
113retry:
114
115! If the BIOS has LBA extensions use them.
116 if linear
117 if useCHS
118  mov	ah,#$41
119  mov	bx,#$55AA
120  mov	dx,[si]		! dh = Drive head, dl = $80 ie HD drive 0
121  push	si		! Save SI on read.
122  int	$13
123  jc	do_CHS
124  cmp	bx,#$AA55
125  jnz	do_CHS
126 else
127  mov	dx,[si]		! dh = Drive head, dl = $80 ie HD drive 0
128  push	si		! Save SI
129 endif
130  mov	bx,#disk_address
131  mov	ax,[si+8]
132  mov	[bx],ax
133  mov	ax,[si+10]
134  mov	[bx+2],ax
135  mov	si,#disk_packet
136  mov	ah,#$42
137  int	$13
138  pop	si
139  jc	retry_error
140  j	sector_loaded
141disk_packet:
142  .byte	$10
143  .byte	0
144  .word	1
145  .word	$7C00
146  .word	0
147disk_address:
148  .long 0
149  .long 0
150
151 if useCHS
152do_CHS:
153  pop	si
154 endif
155 endif
156
157if useCHS
158if linCHS
159  call  calc_chs
160else
161  mov	dx,[si]		! dh = Drive head, dl = $80 ie HD drive 0
162  mov	cx,[si+2]	! cx = Sector & head encoded for int $13
163  ! bx is correct at $7C00
164endif
165
166  mov	ax,#$0201	! Read 1 sector
167  int   $13		! Disk read.
168  jnc	sector_loaded
169endif
170
171! Error, reset and retry
172retry_error:
173  xor	ax,ax
174  int	$13		! Disk reset
175
176  dec	di
177  jnz	retry		! Try again
178
179  mov	si,#disk_read_error
180  jmp	no_boot		! Sorry it ain't gonna work.
181
182sector_loaded:
183  mov	di,#$7DFE	! End of sector loaded
184  cmp	[di],#$AA55	! Check for magic
185 if diskman
186  jnz	bad_boot	! Can't try again, two places to return to.
187 else
188  jnz	try_next_part	! No? Try next partition.
189 endif
190
191  mov	bp,si		! LILO says some BBs use bp rather than si
192  jmpi	#$7C00,#0	! Go!
193
194 else
195  mov	si,#no_bootpart		! Message & boot
196 endif !(linear|useCHS)
197
198! Fatal errors ...........
199
200no_boot:		! SI now has pointer to error message
201  call	puts
202  mov	si,#press_key
203  call	puts
204
205keyboot:		! Wait for a key then reboot
206  xor	ax,ax
207  int	$16
208  jmpi	$0,$FFFF	! Reboot.
209
210if useCHS
211if linCHS
212calc_chs:
213  push  bx              ! Save load location
214
215  mov   ah,#8
216  int   $13	        ! Drive Geom
217  shr   dx,#8
218  xchg  ax,dx
219  inc   ax              ! AX = No. Heads
220  and   cx,#$3f         ! CX = Sectors
221  mul   cx
222  xchg  ax,bx           ! BX = .
223
224  mov   ax,[si+8]       ! Linear partition address.
225  mov   dx,[si+10]
226
227  div   bx              ! AX = Cyl, DX = head & sect
228
229  shl   ah,#6
230  xchg  ah,al
231  xchg  dx,ax
232  div   cl              ! AH = sect-1, AL = Head
233  or    dl,ah           ! merge for CX arg.
234  mov   cx,dx
235  inc   cx              ! Adjust sector No.
236
237  mov   dx,[si]         ! dh = Orig Drive head, dl = $80 ie HD drive 0
238
239  mov   dh,al           ! Head No.
240
241  ; CX & DX ready for int $13
242
243  pop   bx
244  ret
245endif
246endif
247!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
248!
249puts:
250  lodsb
251  cmp	al,#0
252  jz	.EOS
253  push	bx
254  mov	bx,#7
255  mov	ah,#$E			! Can't use $13 cause that's AT+ only!
256  int	$10
257  pop	bx
258  jmp	puts
259.EOS:
260  ret
261
262!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
263!
264
265press_key:
266  .asciz	"\r\nPress return:"
267press_end:
268
269!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
270!
271
272 if (linear|useCHS)
273disk_read_error:
274  .asciz	"Read error"
275no_bootpart:
276  .asciz	"Bad partition"
277 else
278no_bootpart:
279  .asciz	"Not a bootable disk"
280 endif !(linear|useCHS)
281
282!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
283! Now make sure this isn't too big!
284end_of_code:
285  if *>table_start
286   fail! Partition table overlaps
287  endif
288
289!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
290! The diskman magic number and empty DM partitions.
291 if diskman
292  org table_start
293public diskman_magic
294diskman_magic:
295  .word 0xAA55
296  .blkb 12*partition_size-1
297 endif
298
299!-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
300! Clear the sector to the bottom of the partition table.
301 if markptab
302  if *<partition_start-2
303  org partition_start-2
304  .word 0xAA55
305 endif
306 endif
307
308 if use512
309  org ORGADDR+0x1FE
310  .word 0xAA55
311 endif
312
313!THE END
314