1
2
3#include <asm/segment.h>
4#include <linux/utsrelease.h>
5#include <linux/compile.h>
6#include <asm/boot.h>
7#include <asm/e820.h>
8#include <asm/page.h>
9#include <asm/setup.h>
10
11/* Signature words to ensure LILO loaded us right */
12#define SIG1	0xAA55
13#define SIG2	0x5A5A
14
15INITSEG  = DEF_INITSEG		# 0x9000, we move boot here, out of the way
16SYSSEG   = DEF_SYSSEG		# 0x1000, system loaded at 0x10000 (65536).
17SETUPSEG = DEF_SETUPSEG		# 0x9020, this is the current segment
18				# ... and the former contents of CS
19
20DELTA_INITSEG = SETUPSEG - INITSEG	# 0x0020
21
22.code16
23.globl begtext, begdata, begbss, endtext, enddata, endbss
24
25.text
26begtext:
27.data
28begdata:
29.bss
30begbss:
31.text
32
33start:
34	jmp	trampoline
35
36# This is the setup header, and it must start at %cs:2 (old 0x9020:2)
37
38		.ascii	"HdrS"		# header signature
39		.word	0x0206		# header version number (>= 0x0105)
40					# or else old loadlin-1.5 will fail)
41realmode_swtch:	.word	0, 0		# default_switch, SETUPSEG
42start_sys_seg:	.word	SYSSEG
43		.word	kernel_version	# pointing to kernel version string
44					# above section of header is compatible
45					# with loadlin-1.5 (header v1.5). Don't
46					# change it.
47
48type_of_loader:	.byte	0		# = 0, old one (LILO, Loadlin,
49					#      Bootlin, SYSLX, bootsect...)
50					# See Documentation/i386/boot.txt for
51					# assigned ids
52
53# flags, unused bits must be zero (RFU) bit within loadflags
54loadflags:
55LOADED_HIGH	= 1			# If set, the kernel is loaded high
56CAN_USE_HEAP	= 0x80			# If set, the loader also has set
57					# heap_end_ptr to tell how much
58					# space behind setup.S can be used for
59					# heap purposes.
60					# Only the loader knows what is free
61#ifndef __BIG_KERNEL__
62		.byte	0
63#else
64		.byte	LOADED_HIGH
65#endif
66
67setup_move_size: .word  0x8000		# size to move, when setup is not
68					# loaded at 0x90000. We will move setup
69					# to 0x90000 then just before jumping
70					# into the kernel. However, only the
71					# loader knows how much data behind
72					# us also needs to be loaded.
73
74code32_start:				# here loaders can put a different
75					# start address for 32-bit code.
76#ifndef __BIG_KERNEL__
77		.long	0x1000		#   0x1000 = default for zImage
78#else
79		.long	0x100000	# 0x100000 = default for big kernel
80#endif
81
82ramdisk_image:	.long	0		# address of loaded ramdisk image
83					# Here the loader puts the 32-bit
84					# address where it loaded the image.
85					# This only will be read by the kernel.
86
87ramdisk_size:	.long	0		# its size in bytes
88
89bootsect_kludge:
90		.long	0		# obsolete
91
92heap_end_ptr:	.word	modelist+1024	# (Header version 0x0201 or later)
93					# space from here (exclusive) down to
94					# end of setup code can be used by setup
95					# for local heap purposes.
96
97pad1:		.word	0
98cmd_line_ptr:	.long 0			# (Header version 0x0202 or later)
99					# If nonzero, a 32-bit pointer
100					# to the kernel command line.
101					# The command line should be
102					# located between the start of
103					# setup and the end of low
104					# memory (0xa0000), or it may
105					# get overwritten before it
106					# gets read.  If this field is
107					# used, there is no longer
108					# anything magical about the
109					# 0x90000 segment; the setup
110					# can be located anywhere in
111					# low memory 0x10000 or higher.
112
113ramdisk_max:	.long (-__PAGE_OFFSET-(512 << 20)-1) & 0x7fffffff
114					# (Header version 0x0203 or later)
115					# The highest safe address for
116					# the contents of an initrd
117
118kernel_alignment:  .long CONFIG_PHYSICAL_ALIGN 	#physical addr alignment
119						#required for protected mode
120						#kernel
121#ifdef CONFIG_RELOCATABLE
122relocatable_kernel:    .byte 1
123#else
124relocatable_kernel:    .byte 0
125#endif
126pad2:			.byte 0
127pad3:			.word 0
128
129cmdline_size:   .long   COMMAND_LINE_SIZE-1     #length of the command line,
130                                                #added with boot protocol
131                                                #version 2.06
132
133trampoline:	call	start_of_setup
134		.align 16
135					# The offset at this point is 0x240
136		.space	(0xeff-0x240+1) # E820 & EDD space (ending at 0xeff)
137# End of setup header #####################################################
138
139start_of_setup:
140# Bootlin depends on this being done early
141	movw	$0x01500, %ax
142	movb	$0x81, %dl
143	int	$0x13
144
145#ifdef SAFE_RESET_DISK_CONTROLLER
146# Reset the disk controller.
147	movw	$0x0000, %ax
148	movb	$0x80, %dl
149	int	$0x13
150#endif
151
152# Set %ds = %cs, we know that SETUPSEG = %cs at this point
153	movw	%cs, %ax		# aka SETUPSEG
154	movw	%ax, %ds
155# Check signature at end of setup
156	cmpw	$SIG1, setup_sig1
157	jne	bad_sig
158
159	cmpw	$SIG2, setup_sig2
160	jne	bad_sig
161
162	jmp	good_sig1
163
164# Routine to print asciiz string at ds:si
165prtstr:
166	lodsb
167	andb	%al, %al
168	jz	fin
169
170	call	prtchr
171	jmp	prtstr
172
173fin:	ret
174
175# Space printing
176prtsp2:	call	prtspc		# Print double space
177prtspc:	movb	$0x20, %al	# Print single space (note: fall-thru)
178
179# Part of above routine, this one just prints ascii al
180prtchr:	pushw	%ax
181	pushw	%cx
182	movw	$7,%bx
183	movw	$0x01, %cx
184	movb	$0x0e, %ah
185	int	$0x10
186	popw	%cx
187	popw	%ax
188	ret
189
190beep:	movb	$0x07, %al
191	jmp	prtchr
192
193no_sig_mess: .string	"No setup signature found ..."
194
195good_sig1:
196	jmp	good_sig
197
198# We now have to find the rest of the setup code/data
199bad_sig:
200	movw	%cs, %ax			# SETUPSEG
201	subw	$DELTA_INITSEG, %ax		# INITSEG
202	movw	%ax, %ds
203	xorb	%bh, %bh
204	movb	(497), %bl			# get setup sect from bootsect
205	subw	$4, %bx				# LILO loads 4 sectors of setup
206	shlw	$8, %bx				# convert to words (1sect=2^8 words)
207	movw	%bx, %cx
208	shrw	$3, %bx				# convert to segment
209	addw	$SYSSEG, %bx
210	movw	%bx, %cs:start_sys_seg
211# Move rest of setup code/data to here
212	movw	$2048, %di			# four sectors loaded by LILO
213	subw	%si, %si
214	pushw	%cs
215	popw	%es
216	movw	$SYSSEG, %ax
217	movw	%ax, %ds
218	rep
219	movsw
220	movw	%cs, %ax			# aka SETUPSEG
221	movw	%ax, %ds
222	cmpw	$SIG1, setup_sig1
223	jne	no_sig
224
225	cmpw	$SIG2, setup_sig2
226	jne	no_sig
227
228	jmp	good_sig
229
230no_sig:
231	lea	no_sig_mess, %si
232	call	prtstr
233
234no_sig_loop:
235	hlt
236	jmp	no_sig_loop
237
238good_sig:
239	movw	%cs, %ax			# aka SETUPSEG
240	subw	$DELTA_INITSEG, %ax 		# aka INITSEG
241	movw	%ax, %ds
242# Check if an old loader tries to load a big-kernel
243	testb	$LOADED_HIGH, %cs:loadflags	# Do we have a big kernel?
244	jz	loader_ok			# No, no danger for old loaders.
245
246	cmpb	$0, %cs:type_of_loader 		# Do we have a loader that
247						# can deal with us?
248	jnz	loader_ok			# Yes, continue.
249
250	pushw	%cs				# No, we have an old loader,
251	popw	%ds				# die.
252	lea	loader_panic_mess, %si
253	call	prtstr
254
255	jmp	no_sig_loop
256
257loader_panic_mess: .string "Wrong loader, giving up..."
258
259# check minimum cpuid
260# we do this here because it is the last place we can actually
261# show a user visible error message. Later the video modus
262# might be already messed up.
263loader_ok:
264	call verify_cpu
265	testl  %eax,%eax
266	jz	cpu_ok
267	movw	%cs,%ax		# aka SETUPSEG
268	movw	%ax,%ds
269	lea	cpu_panic_mess,%si
270	call	prtstr
2711:	jmp	1b
272
273cpu_panic_mess:
274	.asciz  "PANIC: CPU too old for this kernel."
275
276#include "../kernel/verify_cpu.S"
277
278cpu_ok:
279# Get memory size (extended mem, kB)
280
281	xorl	%eax, %eax
282	movl	%eax, (0x1e0)
283#ifndef STANDARD_MEMORY_BIOS_CALL
284	movb	%al, (E820NR)
285# Try three different memory detection schemes.  First, try
286# e820h, which lets us assemble a memory map, then try e801h,
287# which returns a 32-bit memory size, and finally 88h, which
288# returns 0-64m
289
290# method E820H:
291# the memory map from hell.  e820h returns memory classified into
292# a whole bunch of different types, and allows memory holes and
293# everything.  We scan through this memory map and build a list
294# of the first 32 memory areas, which we return at [E820MAP].
295# This is documented at http://www.acpi.info/, in the ACPI 2.0 specification.
296
297#define SMAP  0x534d4150
298
299meme820:
300	xorl	%ebx, %ebx			# continuation counter
301	movw	$E820MAP, %di			# point into the whitelist
302						# so we can have the bios
303						# directly write into it.
304
305jmpe820:
306	movl	$0x0000e820, %eax		# e820, upper word zeroed
307	movl	$SMAP, %edx			# ascii 'SMAP'
308	movl	$20, %ecx			# size of the e820rec
309	pushw	%ds				# data record.
310	popw	%es
311	int	$0x15				# make the call
312	jc	bail820				# fall to e801 if it fails
313
314	cmpl	$SMAP, %eax			# check the return is `SMAP'
315	jne	bail820				# fall to e801 if it fails
316
317#	cmpl	$1, 16(%di)			# is this usable memory?
318#	jne	again820
319
320	# If this is usable memory, we save it by simply advancing %di by
321	# sizeof(e820rec).
322	#
323good820:
324	movb	(E820NR), %al			# up to 128 entries
325	cmpb	$E820MAX, %al
326	jae	bail820
327
328	incb	(E820NR)
329	movw	%di, %ax
330	addw	$20, %ax
331	movw	%ax, %di
332again820:
333	cmpl	$0, %ebx			# check to see if
334	jne	jmpe820				# %ebx is set to EOF
335bail820:
336
337
338# method E801H:
339# memory size is in 1k chunksizes, to avoid confusing loadlin.
340# we store the 0xe801 memory size in a completely different place,
341# because it will most likely be longer than 16 bits.
342# (use 1e0 because that's what Larry Augustine uses in his
343# alternative new memory detection scheme, and it's sensible
344# to write everything into the same place.)
345
346meme801:
347	stc					# fix to work around buggy
348	xorw	%cx,%cx				# BIOSes which don't clear/set
349	xorw	%dx,%dx				# carry on pass/error of
350						# e801h memory size call
351						# or merely pass cx,dx though
352						# without changing them.
353	movw	$0xe801, %ax
354	int	$0x15
355	jc	mem88
356
357	cmpw	$0x0, %cx			# Kludge to handle BIOSes
358	jne	e801usecxdx			# which report their extended
359	cmpw	$0x0, %dx			# memory in AX/BX rather than
360	jne	e801usecxdx			# CX/DX.  The spec I have read
361	movw	%ax, %cx			# seems to indicate AX/BX
362	movw	%bx, %dx			# are more reasonable anyway...
363
364e801usecxdx:
365	andl	$0xffff, %edx			# clear sign extend
366	shll	$6, %edx			# and go from 64k to 1k chunks
367	movl	%edx, (0x1e0)			# store extended memory size
368	andl	$0xffff, %ecx			# clear sign extend
369 	addl	%ecx, (0x1e0)			# and add lower memory into
370						# total size.
371
372# Ye Olde Traditional Methode.  Returns the memory size (up to 16mb or
373# 64mb, depending on the bios) in ax.
374mem88:
375
376#endif
377	movb	$0x88, %ah
378	int	$0x15
379	movw	%ax, (2)
380
381# Set the keyboard repeat rate to the max
382	movw	$0x0305, %ax
383	xorw	%bx, %bx
384	int	$0x16
385
386# Check for video adapter and its parameters and allow the
387# user to browse video modes.
388	call	video				# NOTE: we need %ds pointing
389						# to bootsector
390
391# Get hd0 data...
392	xorw	%ax, %ax
393	movw	%ax, %ds
394	ldsw	(4 * 0x41), %si
395	movw	%cs, %ax			# aka SETUPSEG
396	subw	$DELTA_INITSEG, %ax		# aka INITSEG
397	pushw	%ax
398	movw	%ax, %es
399	movw	$0x0080, %di
400	movw	$0x10, %cx
401	pushw	%cx
402	cld
403	rep
404 	movsb
405# Get hd1 data...
406	xorw	%ax, %ax
407	movw	%ax, %ds
408	ldsw	(4 * 0x46), %si
409	popw	%cx
410	popw	%es
411	movw	$0x0090, %di
412	rep
413	movsb
414# Check that there IS a hd1 :-)
415	movw	$0x01500, %ax
416	movb	$0x81, %dl
417	int	$0x13
418	jc	no_disk1
419
420	cmpb	$3, %ah
421	je	is_disk1
422
423no_disk1:
424	movw	%cs, %ax			# aka SETUPSEG
425	subw	$DELTA_INITSEG, %ax 		# aka INITSEG
426	movw	%ax, %es
427	movw	$0x0090, %di
428	movw	$0x10, %cx
429	xorw	%ax, %ax
430	cld
431	rep
432	stosb
433is_disk1:
434# check for Micro Channel (MCA) bus
435	movw	%cs, %ax			# aka SETUPSEG
436	subw	$DELTA_INITSEG, %ax		# aka INITSEG
437	movw	%ax, %ds
438	xorw	%ax, %ax
439	movw	%ax, (0xa0)			# set table length to 0
440	movb	$0xc0, %ah
441	stc
442	int	$0x15				# moves feature table to es:bx
443	jc	no_mca
444
445	pushw	%ds
446	movw	%es, %ax
447	movw	%ax, %ds
448	movw	%cs, %ax			# aka SETUPSEG
449	subw	$DELTA_INITSEG, %ax		# aka INITSEG
450	movw	%ax, %es
451	movw	%bx, %si
452	movw	$0xa0, %di
453	movw	(%si), %cx
454	addw	$2, %cx				# table length is a short
455	cmpw	$0x10, %cx
456	jc	sysdesc_ok
457
458	movw	$0x10, %cx			# we keep only first 16 bytes
459sysdesc_ok:
460	rep
461	movsb
462	popw	%ds
463no_mca:
464#ifdef CONFIG_X86_VOYAGER
465	movb	$0xff, 0x40	# flag on config found
466	movb	$0xc0, %al
467	mov	$0xff, %ah
468	int	$0x15		# put voyager config info at es:di
469	jc	no_voyager
470	movw	$0x40, %si	# place voyager info in apm table
471	cld
472	movw	$7, %cx
473voyager_rep:
474	movb	%es:(%di), %al
475	movb	%al,(%si)
476	incw	%di
477	incw	%si
478	decw	%cx
479	jnz	voyager_rep
480no_voyager:
481#endif
482# Check for PS/2 pointing device
483	movw	%cs, %ax			# aka SETUPSEG
484	subw	$DELTA_INITSEG, %ax		# aka INITSEG
485	movw	%ax, %ds
486	movb	$0, (0x1ff)			# default is no pointing device
487	int	$0x11				# int 0x11: equipment list
488	testb	$0x04, %al			# check if mouse installed
489	jz	no_psmouse
490
491	movb	$0xAA, (0x1ff)			# device present
492no_psmouse:
493
494#if defined(CONFIG_X86_SPEEDSTEP_SMI) || defined(CONFIG_X86_SPEEDSTEP_SMI_MODULE)
495	movl	$0x0000E980, %eax		# IST Support
496	movl	$0x47534943, %edx		# Request value
497	int	$0x15
498
499	movl	%eax, (96)
500	movl	%ebx, (100)
501	movl	%ecx, (104)
502	movl	%edx, (108)
503#endif
504
505#if defined(CONFIG_APM) || defined(CONFIG_APM_MODULE)
506# Then check for an APM BIOS...
507						# %ds points to the bootsector
508	movw	$0, 0x40			# version = 0 means no APM BIOS
509	movw	$0x05300, %ax			# APM BIOS installation check
510	xorw	%bx, %bx
511	int	$0x15
512	jc	done_apm_bios			# Nope, no APM BIOS
513
514	cmpw	$0x0504d, %bx			# Check for "PM" signature
515	jne	done_apm_bios			# No signature, no APM BIOS
516
517	andw	$0x02, %cx			# Is 32 bit supported?
518	je	done_apm_bios			# No 32-bit, no (good) APM BIOS
519
520	movw	$0x05304, %ax			# Disconnect first just in case
521	xorw	%bx, %bx
522	int	$0x15				# ignore return code
523	movw	$0x05303, %ax			# 32 bit connect
524	xorl	%ebx, %ebx
525	xorw	%cx, %cx			# paranoia :-)
526	xorw	%dx, %dx			#   ...
527	xorl	%esi, %esi			#   ...
528	xorw	%di, %di			#   ...
529	int	$0x15
530	jc	no_32_apm_bios			# Ack, error.
531
532	movw	%ax,  (66)			# BIOS code segment
533	movl	%ebx, (68)			# BIOS entry point offset
534	movw	%cx,  (72)			# BIOS 16 bit code segment
535	movw	%dx,  (74)			# BIOS data segment
536	movl	%esi, (78)			# BIOS code segment lengths
537	movw	%di,  (82)			# BIOS data segment length
538# Redo the installation check as the 32 bit connect
539# modifies the flags returned on some BIOSs
540	movw	$0x05300, %ax			# APM BIOS installation check
541	xorw	%bx, %bx
542	xorw	%cx, %cx			# paranoia
543	int	$0x15
544	jc	apm_disconnect			# error -> shouldn't happen
545
546	cmpw	$0x0504d, %bx			# check for "PM" signature
547	jne	apm_disconnect			# no sig -> shouldn't happen
548
549	movw	%ax, (64)			# record the APM BIOS version
550	movw	%cx, (76)			# and flags
551	jmp	done_apm_bios
552
553apm_disconnect:					# Tidy up
554	movw	$0x05304, %ax			# Disconnect
555	xorw	%bx, %bx
556	int	$0x15				# ignore return code
557
558	jmp	done_apm_bios
559
560no_32_apm_bios:
561	andw	$0xfffd, (76)			# remove 32 bit support bit
562done_apm_bios:
563#endif
564
565#include "edd.S"
566
567# Now we want to move to protected mode ...
568	cmpw	$0, %cs:realmode_swtch
569	jz	rmodeswtch_normal
570
571	lcall	*%cs:realmode_swtch
572
573	jmp	rmodeswtch_end
574
575rmodeswtch_normal:
576        pushw	%cs
577	call	default_switch
578
579rmodeswtch_end:
580# Now we move the system to its rightful place ... but we check if we have a
581# big-kernel. In that case we *must* not move it ...
582	testb	$LOADED_HIGH, %cs:loadflags
583	jz	do_move0			# .. then we have a normal low
584						# loaded zImage
585						# .. or else we have a high
586						# loaded bzImage
587	jmp	end_move			# ... and we skip moving
588
589do_move0:
590	movw	$0x100, %ax			# start of destination segment
591	movw	%cs, %bp			# aka SETUPSEG
592	subw	$DELTA_INITSEG, %bp		# aka INITSEG
593	movw	%cs:start_sys_seg, %bx		# start of source segment
594	cld
595do_move:
596	movw	%ax, %es			# destination segment
597	incb	%ah				# instead of add ax,#0x100
598	movw	%bx, %ds			# source segment
599	addw	$0x100, %bx
600	subw	%di, %di
601	subw	%si, %si
602	movw 	$0x800, %cx
603	rep
604	movsw
605	cmpw	%bp, %bx			# assume start_sys_seg > 0x200,
606						# so we will perhaps read one
607						# page more than needed, but
608						# never overwrite INITSEG
609						# because destination is a
610						# minimum one page below source
611	jb	do_move
612
613end_move:
614# then we load the segment descriptors
615	movw	%cs, %ax			# aka SETUPSEG
616	movw	%ax, %ds
617
618# Check whether we need to be downward compatible with version <=201
619	cmpl	$0, cmd_line_ptr
620	jne	end_move_self		# loader uses version >=202 features
621	cmpb	$0x20, type_of_loader
622	je	end_move_self		# bootsect loader, we know of it
623
624# Boot loader doesnt support boot protocol version 2.02.
625# If we have our code not at 0x90000, we need to move it there now.
626# We also then need to move the params behind it (commandline)
627# Because we would overwrite the code on the current IP, we move
628# it in two steps, jumping high after the first one.
629	movw	%cs, %ax
630	cmpw	$SETUPSEG, %ax
631	je	end_move_self
632
633	cli					# make sure we really have
634						# interrupts disabled !
635						# because after this the stack
636						# should not be used
637	subw	$DELTA_INITSEG, %ax		# aka INITSEG
638	movw	%ss, %dx
639	cmpw	%ax, %dx
640	jb	move_self_1
641
642	addw	$INITSEG, %dx
643	subw	%ax, %dx			# this will go into %ss after
644						# the move
645move_self_1:
646	movw	%ax, %ds
647	movw	$INITSEG, %ax			# real INITSEG
648	movw	%ax, %es
649	movw	%cs:setup_move_size, %cx
650	std					# we have to move up, so we use
651						# direction down because the
652						# areas may overlap
653	movw	%cx, %di
654	decw	%di
655	movw	%di, %si
656	subw	$move_self_here+0x200, %cx
657	rep
658	movsb
659	ljmp	$SETUPSEG, $move_self_here
660
661move_self_here:
662	movw	$move_self_here+0x200, %cx
663	rep
664	movsb
665	movw	$SETUPSEG, %ax
666	movw	%ax, %ds
667	movw	%dx, %ss
668end_move_self:					# now we are at the right place
669
670#
671# Enable A20.  This is at the very best an annoying procedure.
672# A20 code ported from SYSLINUX 1.52-1.63 by H. Peter Anvin.
673# AMD Elan bug fix by Robert Schwebel.
674#
675
676#if defined(CONFIG_X86_ELAN)
677	movb $0x02, %al			# alternate A20 gate
678	outb %al, $0x92			# this works on SC410/SC520
679a20_elan_wait:
680	call a20_test
681	jz a20_elan_wait
682	jmp a20_done
683#endif
684
685
686A20_TEST_LOOPS		=  32		# Iterations per wait
687A20_ENABLE_LOOPS	= 255		# Total loops to try
688
689
690#ifndef CONFIG_X86_VOYAGER
691a20_try_loop:
692
693	# First, see if we are on a system with no A20 gate.
694a20_none:
695	call	a20_test
696	jnz	a20_done
697
698	# Next, try the BIOS (INT 0x15, AX=0x2401)
699a20_bios:
700	movw	$0x2401, %ax
701	pushfl					# Be paranoid about flags
702	int	$0x15
703	popfl
704
705	call	a20_test
706	jnz	a20_done
707
708	# Try enabling A20 through the keyboard controller
709#endif /* CONFIG_X86_VOYAGER */
710a20_kbc:
711	call	empty_8042
712
713#ifndef CONFIG_X86_VOYAGER
714	call	a20_test			# Just in case the BIOS worked
715	jnz	a20_done			# but had a delayed reaction.
716#endif
717
718	movb	$0xD1, %al			# command write
719	outb	%al, $0x64
720	call	empty_8042
721
722	movb	$0xDF, %al			# A20 on
723	outb	%al, $0x60
724	call	empty_8042
725
726#ifndef CONFIG_X86_VOYAGER
727	# Wait until a20 really *is* enabled; it can take a fair amount of
728	# time on certain systems; Toshiba Tecras are known to have this
729	# problem.
730a20_kbc_wait:
731	xorw	%cx, %cx
732a20_kbc_wait_loop:
733	call	a20_test
734	jnz	a20_done
735	loop	a20_kbc_wait_loop
736
737	# Final attempt: use "configuration port A"
738a20_fast:
739	inb	$0x92, %al			# Configuration Port A
740	orb	$0x02, %al			# "fast A20" version
741	andb	$0xFE, %al			# don't accidentally reset
742	outb	%al, $0x92
743
744	# Wait for configuration port A to take effect
745a20_fast_wait:
746	xorw	%cx, %cx
747a20_fast_wait_loop:
748	call	a20_test
749	jnz	a20_done
750	loop	a20_fast_wait_loop
751
752	# A20 is still not responding.  Try frobbing it again.
753	#
754	decb	(a20_tries)
755	jnz	a20_try_loop
756
757	movw	$a20_err_msg, %si
758	call	prtstr
759
760a20_die:
761	hlt
762	jmp	a20_die
763
764a20_tries:
765	.byte	A20_ENABLE_LOOPS
766
767a20_err_msg:
768	.ascii	"linux: fatal error: A20 gate not responding!"
769	.byte	13, 10, 0
770
771	# If we get here, all is good
772a20_done:
773
774#endif /* CONFIG_X86_VOYAGER */
775# set up gdt and idt and 32bit start address
776	lidt	idt_48				# load idt with 0,0
777	xorl	%eax, %eax			# Compute gdt_base
778	movw	%ds, %ax			# (Convert %ds:gdt to a linear ptr)
779	shll	$4, %eax
780	addl	%eax, code32
781	addl	$gdt, %eax
782	movl	%eax, (gdt_48+2)
783	lgdt	gdt_48				# load gdt with whatever is
784						# appropriate
785
786# make sure any possible coprocessor is properly reset..
787	xorw	%ax, %ax
788	outb	%al, $0xf0
789	call	delay
790
791	outb	%al, $0xf1
792	call	delay
793
794# well, that went ok, I hope. Now we mask all interrupts - the rest
795# is done in init_IRQ().
796	movb	$0xFF, %al			# mask all interrupts for now
797	outb	%al, $0xA1
798	call	delay
799
800	movb	$0xFB, %al			# mask all irq's but irq2 which
801	outb	%al, $0x21			# is cascaded
802
803# Well, that certainly wasn't fun :-(. Hopefully it works, and we don't
804# need no steenking BIOS anyway (except for the initial loading :-).
805# The BIOS-routine wants lots of unnecessary data, and it's less
806# "interesting" anyway. This is how REAL programmers do it.
807#
808# Well, now's the time to actually move into protected mode. To make
809# things as simple as possible, we do no register set-up or anything,
810# we let the gnu-compiled 32-bit programs do that. We just jump to
811# absolute address 0x1000 (or the loader supplied one),
812# in 32-bit protected mode.
813#
814# Note that the short jump isn't strictly needed, although there are
815# reasons why it might be a good idea. It won't hurt in any case.
816	movw	$1, %ax				# protected mode (PE) bit
817	lmsw	%ax				# This is it!
818	jmp	flush_instr
819
820flush_instr:
821	xorw	%bx, %bx			# Flag to indicate a boot
822	xorl	%esi, %esi			# Pointer to real-mode code
823	movw	%cs, %si
824	subw	$DELTA_INITSEG, %si
825	shll	$4, %esi			# Convert to 32-bit pointer
826
827# jump to startup_32 in arch/i386/boot/compressed/head.S
828#
829# NOTE: For high loaded big kernels we need a
830#	jmpi    0x100000,__BOOT_CS
831#
832#	but we yet haven't reloaded the CS register, so the default size
833#	of the target offset still is 16 bit.
834#	However, using an operand prefix (0x66), the CPU will properly
835#	take our 48 bit far pointer. (INTeL 80386 Programmer's Reference
836#	Manual, Mixing 16-bit and 32-bit code, page 16-6)
837
838	.byte 0x66, 0xea			# prefix + jmpi-opcode
839code32:	.long	startup_32			# will be set to %cs+startup_32
840	.word	__BOOT_CS
841.code32
842startup_32:
843	movl $(__BOOT_DS), %eax
844	movl %eax, %ds
845	movl %eax, %es
846	movl %eax, %fs
847	movl %eax, %gs
848	movl %eax, %ss
849
850	xorl %eax, %eax
8511:	incl %eax				# check that A20 really IS enabled
852	movl %eax, 0x00000000			# loop forever if it isn't
853	cmpl %eax, 0x00100000
854	je 1b
855
856	# Jump to the 32bit entry point
857	jmpl *(code32_start - start + (DELTA_INITSEG << 4))(%esi)
858.code16
859
860# Here's a bunch of information about your current kernel..
861kernel_version:	.ascii	UTS_RELEASE
862		.ascii	" ("
863		.ascii	LINUX_COMPILE_BY
864		.ascii	"@"
865		.ascii	LINUX_COMPILE_HOST
866		.ascii	") "
867		.ascii	UTS_VERSION
868		.byte	0
869
870# This is the default real mode switch routine.
871# to be called just before protected mode transition
872default_switch:
873	cli					# no interrupts allowed !
874	movb	$0x80, %al			# disable NMI for bootup
875						# sequence
876	outb	%al, $0x70
877	lret
878
879
880#ifndef CONFIG_X86_VOYAGER
881# This routine tests whether or not A20 is enabled.  If so, it
882# exits with zf = 0.
883#
884# The memory address used, 0x200, is the int $0x80 vector, which
885# should be safe.
886
887A20_TEST_ADDR = 4*0x80
888
889a20_test:
890	pushw	%cx
891	pushw	%ax
892	xorw	%cx, %cx
893	movw	%cx, %fs			# Low memory
894	decw	%cx
895	movw	%cx, %gs			# High memory area
896	movw	$A20_TEST_LOOPS, %cx
897	movw	%fs:(A20_TEST_ADDR), %ax
898	pushw	%ax
899a20_test_wait:
900	incw	%ax
901	movw	%ax, %fs:(A20_TEST_ADDR)
902	call	delay				# Serialize and make delay constant
903	cmpw	%gs:(A20_TEST_ADDR+0x10), %ax
904	loope	a20_test_wait
905
906	popw	%fs:(A20_TEST_ADDR)
907	popw	%ax
908	popw	%cx
909	ret
910
911#endif /* CONFIG_X86_VOYAGER */
912
913# This routine checks that the keyboard command queue is empty
914# (after emptying the output buffers)
915#
916# Some machines have delusions that the keyboard buffer is always full
917# with no keyboard attached...
918#
919# If there is no keyboard controller, we will usually get 0xff
920# to all the reads.  With each IO taking a microsecond and
921# a timeout of 100,000 iterations, this can take about half a
922# second ("delay" == outb to port 0x80). That should be ok,
923# and should also be plenty of time for a real keyboard controller
924# to empty.
925#
926
927empty_8042:
928	pushl	%ecx
929	movl	$100000, %ecx
930
931empty_8042_loop:
932	decl	%ecx
933	jz	empty_8042_end_loop
934
935	call	delay
936
937	inb	$0x64, %al			# 8042 status port
938	testb	$1, %al				# output buffer?
939	jz	no_output
940
941	call	delay
942	inb	$0x60, %al			# read it
943	jmp	empty_8042_loop
944
945no_output:
946	testb	$2, %al				# is input buffer full?
947	jnz	empty_8042_loop			# yes - loop
948empty_8042_end_loop:
949	popl	%ecx
950	ret
951
952# Read the cmos clock. Return the seconds in al
953gettime:
954	pushw	%cx
955	movb	$0x02, %ah
956	int	$0x1a
957	movb	%dh, %al			# %dh contains the seconds
958	andb	$0x0f, %al
959	movb	%dh, %ah
960	movb	$0x04, %cl
961	shrb	%cl, %ah
962	aad
963	popw	%cx
964	ret
965
966# Delay is needed after doing I/O
967delay:
968	outb	%al,$0x80
969	ret
970
971# Descriptor tables
972#
973# NOTE: The intel manual says gdt should be sixteen bytes aligned for
974# efficiency reasons.  However, there are machines which are known not
975# to boot with misaligned GDTs, so alter this at your peril!  If you alter
976# GDT_ENTRY_BOOT_CS (in asm/segment.h) remember to leave at least two
977# empty GDT entries (one for NULL and one reserved).
978#
979# NOTE:	On some CPUs, the GDT must be 8 byte aligned.  This is
980# true for the Voyager Quad CPU card which will not boot without
981# This directive.  16 byte aligment is recommended by intel.
982#
983	.align 16
984gdt:
985	.fill GDT_ENTRY_BOOT_CS,8,0
986
987	.word	0xFFFF				# 4Gb - (0x100000*0x1000 = 4Gb)
988	.word	0				# base address = 0
989	.word	0x9A00				# code read/exec
990	.word	0x00CF				# granularity = 4096, 386
991						#  (+5th nibble of limit)
992
993	.word	0xFFFF				# 4Gb - (0x100000*0x1000 = 4Gb)
994	.word	0				# base address = 0
995	.word	0x9200				# data read/write
996	.word	0x00CF				# granularity = 4096, 386
997						#  (+5th nibble of limit)
998gdt_end:
999	.align	4
1000
1001	.word	0				# alignment byte
1002idt_48:
1003	.word	0				# idt limit = 0
1004	.word	0, 0				# idt base = 0L
1005
1006	.word	0				# alignment byte
1007gdt_48:
1008	.word	gdt_end - gdt - 1		# gdt limit
1009	.word	0, 0				# gdt base (filled in later)
1010
1011# Include video setup & detection code
1012
1013#include "video.S"
1014
1015# Setup signature -- must be last
1016setup_sig1:	.word	SIG1
1017setup_sig2:	.word	SIG2
1018
1019# After this point, there is some free space which is used by the video mode
1020# handling code to store the temporary mode table (not used by the kernel).
1021
1022modelist:
1023
1024.text
1025endtext:
1026.data
1027enddata:
1028.bss
1029endbss:
1030