Magellan Linux

Annotation of /trunk/mkinitrd-magellan/isolinux/bcopy32.inc

Parent Directory Parent Directory | Revision Log Revision Log


Revision 532 - (hide annotations) (download)
Sat Sep 1 22:45:15 2007 UTC (16 years, 8 months ago) by niro
File size: 9964 byte(s)
-import if magellan mkinitrd; it is a fork of redhats mkinitrd-5.0.8 with all magellan patches and features; deprecates magellan-src/mkinitrd

1 niro 532 ;; $Id: bcopy32.inc,v 1.1 2007-09-01 22:44:04 niro Exp $
2     ;; -----------------------------------------------------------------------
3     ;;
4     ;; Copyright 1994-2005 H. Peter Anvin - All Rights Reserved
5     ;;
6     ;; This program is free software; you can redistribute it and/or modify
7     ;; it under the terms of the GNU General Public License as published by
8     ;; the Free Software Foundation, Inc., 53 Temple Place Ste 330,
9     ;; Boston MA 02111-1307, USA; either version 2 of the License, or
10     ;; (at your option) any later version; incorporated herein by reference.
11     ;;
12     ;; -----------------------------------------------------------------------
13    
14     ;;
15     ;; bcopy32.inc
16     ;;
17     ;; 32-bit bcopy routine for real mode
18     ;;
19    
20     ;
21     ; 32-bit bcopy routine for real mode
22     ;
23     ; We enter protected mode, set up a flat 32-bit environment, run rep movsd
24     ; and then exit. IMPORTANT: This code assumes cs == 0.
25     ;
26     ; This code is probably excessively anal-retentive in its handling of
27     ; segments, but this stuff is painful enough as it is without having to rely
28     ; on everything happening "as it ought to."
29     ;
30     ; NOTE: this code is relocated into low memory, just after the .earlybss
31     ; segment, in order to support to "bcopy over self" operation.
32     ;
33    
34     section .bcopy32
35     align 8
36     __bcopy_start:
37    
38     ; This is in the .text segment since it needs to be
39     ; contiguous with the rest of the bcopy stuff
40    
41     bcopy_gdt: dw bcopy_gdt_size-1 ; Null descriptor - contains GDT
42     dd bcopy_gdt ; pointer for LGDT instruction
43     dw 0
44     dd 0000ffffh ; Code segment, use16, readable,
45     dd 00009b00h ; present, dpl 0, cover 64K
46     dd 0000ffffh ; Data segment, use16, read/write,
47     dd 008f9300h ; present, dpl 0, cover all 4G
48     dd 0000ffffh ; Data segment, use16, read/write,
49     dd 00009300h ; present, dpl 0, cover 64K
50     ; The rest are used for COM32 only
51     dd 0000ffffh ; Code segment, use32, readable,
52     dd 00cf9b00h ; present, dpl 0, cover all 4G
53     dd 0000ffffh ; Data segment, use32, read/write,
54     dd 00cf9300h ; present, dpl 0, cover all 4G
55     bcopy_gdt_size: equ $-bcopy_gdt
56    
57     ;
58     ; bcopy:
59     ; 32-bit copy, overlap safe
60     ;
61     ; Inputs:
62     ; ESI - source pointer
63     ; EDI - target pointer
64     ; ECX - byte count
65     ; DF - zero
66     ;
67     ; Outputs:
68     ; ESI - first byte after source
69     ; EDI - first byte after target
70     ; ECX - zero
71     ;
72     bcopy: push eax
73     push esi
74     push edi
75     push ecx
76     pushf ; Saves, among others, the IF flag
77     push ds
78     push es
79    
80     cli
81     call enable_a20
82    
83     o32 lgdt [cs:bcopy_gdt]
84     mov eax,cr0
85     or al,1
86     mov cr0,eax ; Enter protected mode
87     jmp 08h:.in_pm
88    
89     .in_pm: mov ax,10h ; Data segment selector
90     mov es,ax
91     mov ds,ax
92    
93     ; Don't mess with ss, fs, and gs. They are never changed
94     ; and should be able to make it back out of protected mode.
95     ; This works because (and only because) we don't take
96     ; interrupt in protected mode.
97    
98     cmp esi,edi ; If source > destination, we might
99     ja .reverse ; have to copy backwards
100    
101     .forward:
102     mov al,cl ; Save low bits
103     and al,3
104     shr ecx,2 ; Convert to dwords
105     a32 rep movsd ; Do our business
106     ; At this point ecx == 0
107    
108     mov cl,al ; Copy any fractional dword
109     a32 rep movsb
110     jmp .exit
111    
112     .reverse:
113     std ; Reverse copy
114     lea esi,[esi+ecx-1] ; Point to final byte
115     lea edi,[edi+ecx-1]
116     mov eax,ecx
117     and ecx,3
118     shr eax,2
119     a32 rep movsb
120    
121     ; Change ESI/EDI to point to the last dword, instead
122     ; of the last byte.
123     sub esi,3
124     sub edi,3
125     mov ecx,eax
126     a32 rep movsd
127    
128     cld
129    
130     .exit:
131     mov ax,18h ; "Real-mode-like" data segment
132     mov es,ax
133     mov ds,ax
134    
135     mov eax,cr0
136     and al,~1
137     mov cr0,eax ; Disable protected mode
138     jmp 0:.in_rm
139    
140     .in_rm: ; Back in real mode
141     pop es
142     pop ds
143     call disable_a20
144    
145     popf ; Re-enables interrupts
146     pop eax
147     pop edi
148     pop esi
149     add edi,eax
150     add esi,eax
151     pop eax
152     ret
153    
154     ;
155     ; Routines to enable and disable (yuck) A20. These routines are gathered
156     ; from tips from a couple of sources, including the Linux kernel and
157     ; http://www.x86.org/. The need for the delay to be as large as given here
158     ; is indicated by Donnie Barnes of RedHat, the problematic system being an
159     ; IBM ThinkPad 760EL.
160     ;
161     ; We typically toggle A20 twice for every 64K transferred.
162     ;
163     %define io_delay call _io_delay
164     %define IO_DELAY_PORT 80h ; Invalid port (we hope!)
165     %define disable_wait 32 ; How long to wait for a disable
166    
167     ; Note the skip of 2 here
168     %define A20_DUNNO 0 ; A20 type unknown
169     %define A20_NONE 2 ; A20 always on?
170     %define A20_BIOS 4 ; A20 BIOS enable
171     %define A20_KBC 6 ; A20 through KBC
172     %define A20_FAST 8 ; A20 through port 92h
173    
174     slow_out: out dx, al ; Fall through
175    
176     _io_delay: out IO_DELAY_PORT,al
177     out IO_DELAY_PORT,al
178     ret
179    
180     enable_a20:
181     pushad
182     mov byte [cs:A20Tries],255 ; Times to try to make this work
183    
184     try_enable_a20:
185     ;
186     ; Flush the caches
187     ;
188     %if DO_WBINVD
189     call try_wbinvd
190     %endif
191    
192     ;
193     ; If the A20 type is known, jump straight to type
194     ;
195     mov bp,[cs:A20Type]
196     jmp word [cs:bp+A20List]
197    
198     ;
199     ; First, see if we are on a system with no A20 gate
200     ;
201     a20_dunno:
202     a20_none:
203     mov byte [cs:A20Type], A20_NONE
204     call a20_test
205     jnz a20_done
206    
207     ;
208     ; Next, try the BIOS (INT 15h AX=2401h)
209     ;
210     a20_bios:
211     mov byte [cs:A20Type], A20_BIOS
212     mov ax,2401h
213     pushf ; Some BIOSes muck with IF
214     int 15h
215     popf
216    
217     call a20_test
218     jnz a20_done
219    
220     ;
221     ; Enable the keyboard controller A20 gate
222     ;
223     a20_kbc:
224     mov dl, 1 ; Allow early exit
225     call empty_8042
226     jnz a20_done ; A20 live, no need to use KBC
227    
228     mov byte [cs:A20Type], A20_KBC ; Starting KBC command sequence
229    
230     mov al,0D1h ; Command write
231     out 064h, al
232     call empty_8042_uncond
233    
234     mov al,0DFh ; A20 on
235     out 060h, al
236     call empty_8042_uncond
237    
238     ; Verify that A20 actually is enabled. Do that by
239     ; observing a word in low memory and the same word in
240     ; the HMA until they are no longer coherent. Note that
241     ; we don't do the same check in the disable case, because
242     ; we don't want to *require* A20 masking (SYSLINUX should
243     ; work fine without it, if the BIOS does.)
244     .kbc_wait: push cx
245     xor cx,cx
246     .kbc_wait_loop:
247     call a20_test
248     jnz a20_done_pop
249     loop .kbc_wait_loop
250    
251     pop cx
252     ;
253     ; Running out of options here. Final attempt: enable the "fast A20 gate"
254     ;
255     a20_fast:
256     mov byte [cs:A20Type], A20_FAST ; Haven't used the KBC yet
257     in al, 092h
258     or al,02h
259     and al,~01h ; Don't accidentally reset the machine!
260     out 092h, al
261    
262     .fast_wait: push cx
263     xor cx,cx
264     .fast_wait_loop:
265     call a20_test
266     jnz a20_done_pop
267     loop .fast_wait_loop
268    
269     pop cx
270    
271     ;
272     ; Oh bugger. A20 is not responding. Try frobbing it again; eventually give up
273     ; and report failure to the user.
274     ;
275    
276    
277     dec byte [cs:A20Tries]
278     jnz try_enable_a20
279    
280     mov si, err_a20
281     jmp abort_load
282     ;
283     ; A20 unmasked, proceed...
284     ;
285     a20_done_pop: pop cx
286     a20_done: popad
287     ret
288    
289     ;
290     ; This routine tests if A20 is enabled (ZF = 0). This routine
291     ; must not destroy any register contents.
292     ;
293     a20_test:
294     push es
295     push cx
296     push ax
297     mov cx,0FFFFh ; HMA = segment 0FFFFh
298     mov es,cx
299     mov cx,32 ; Loop count
300     mov ax,[cs:A20Test]
301     .a20_wait: inc ax
302     mov [cs:A20Test],ax
303     io_delay ; Serialize, and fix delay
304     cmp ax,[es:A20Test+10h]
305     loopz .a20_wait
306     .a20_done: pop ax
307     pop cx
308     pop es
309     ret
310    
311     disable_a20:
312     pushad
313     ;
314     ; Flush the caches
315     ;
316     %if DO_WBINVD
317     call try_wbinvd
318     %endif
319    
320     mov bp,[cs:A20Type]
321     jmp word [cs:bp+A20DList]
322    
323     a20d_bios:
324     mov ax,2400h
325     pushf ; Some BIOSes muck with IF
326     int 15h
327     popf
328     jmp short a20d_snooze
329    
330     ;
331     ; Disable the "fast A20 gate"
332     ;
333     a20d_fast:
334     in al, 092h
335     and al,~03h
336     out 092h, al
337     jmp short a20d_snooze
338    
339     ;
340     ; Disable the keyboard controller A20 gate
341     ;
342     a20d_kbc:
343     call empty_8042_uncond
344     mov al,0D1h
345     out 064h, al ; Command write
346     call empty_8042_uncond
347     mov al,0DDh ; A20 off
348     out 060h, al
349     call empty_8042_uncond
350     ; Wait a bit for it to take effect
351     a20d_snooze:
352     push cx
353     mov cx, disable_wait
354     .delayloop: call a20_test
355     jz .disabled
356     loop .delayloop
357     .disabled: pop cx
358     a20d_dunno:
359     a20d_none:
360     popad
361     ret
362    
363     ;
364     ; Routine to empty the 8042 KBC controller. If dl != 0
365     ; then we will test A20 in the loop and exit if A20 is
366     ; suddenly enabled.
367     ;
368     empty_8042_uncond:
369     xor dl,dl
370     empty_8042:
371     call a20_test
372     jz .a20_on
373     and dl,dl
374     jnz .done
375     .a20_on: io_delay
376     in al, 064h ; Status port
377     test al,1
378     jz .no_output
379     io_delay
380     in al, 060h ; Read input
381     jmp short empty_8042
382     .no_output:
383     test al,2
384     jnz empty_8042
385     io_delay
386     .done: ret
387    
388     ;
389     ; Execute a WBINVD instruction if possible on this CPU
390     ;
391     %if DO_WBINVD
392     try_wbinvd:
393     wbinvd
394     ret
395     %endif
396    
397     ;
398     ; bcopy_over_self:
399     ;
400     ; This routine is used to shuffle memory around, followed by
401     ; invoking an entry point somewhere in low memory. This routine
402     ; can clobber any memory above 7C00h, we therefore have to move
403     ; necessary code into the trackbuf area before doing the copy,
404     ; and do adjustments to anything except BSS area references.
405     ;
406     ; NOTE: Since PXELINUX relocates itself, put all these
407     ; references in the ".earlybss" segment.
408     ;
409     ; After performing the copy, this routine resets the stack and
410     ; jumps to the specified entrypoint.
411     ;
412     ; IMPORTANT: This routine does not canonicalize the stack or the
413     ; SS register. That is the responsibility of the caller.
414     ;
415     ; Inputs:
416     ; DS:BX -> Pointer to list of (dst, src, len) pairs
417     ; AX -> Number of list entries
418     ; [CS:EntryPoint] -> CS:IP to jump to
419     ; On stack - initial state (fd, ad, ds, es, fs, gs)
420     ;
421     shuffle_and_boot:
422     and ax,ax
423     jz .done
424     .loop:
425     mov edi,[bx]
426     mov esi,[bx+4]
427     mov ecx,[bx+8]
428     call bcopy
429     add bx,12
430     dec ax
431     jnz .loop
432    
433     .done:
434     pop gs
435     pop fs
436     pop es
437     pop ds
438     popad
439     popfd
440     jmp far [cs:EntryPoint]
441    
442     align 2
443     A20List dw a20_dunno, a20_none, a20_bios, a20_kbc, a20_fast
444     A20DList dw a20d_dunno, a20d_none, a20d_bios, a20d_kbc, a20d_fast
445     a20_adjust_cnt equ ($-A20List)/2
446    
447     A20Type dw A20_NONE ; A20 type
448    
449     ; Total size of .bcopy32 section
450     alignb 4, db 0 ; Even number of dwords
451     __bcopy_size equ $-__bcopy_start
452    
453     section .earlybss
454     alignb 2
455     EntryPoint resd 1 ; CS:IP for shuffle_and_boot
456     SavedSSSP resd 1 ; Saved real mode SS:SP
457     A20Test resw 1 ; Counter for testing status of A20
458     A20Tries resb 1 ; Times until giving up on A20