[sanboot] Prevent leaking a stack reference for "keep-san" AoE
[gpxe.git] / contrib / baremetal / startmpcc.S
blob07486ce5c9203e55bce2670749f51b9fc39e88ce
1 /* #defines because ljmp wants a number, probably gas bug */
2 /*      .equ    KERN_CODE_SEG,_pmcs-_gdt        */
3 #define KERN_CODE_SEG   0x08
4         .equ    KERN_DATA_SEG,_pmds-_gdt
5 /*      .equ    REAL_CODE_SEG,_rmcs-_gdt        */
6 #define REAL_CODE_SEG   0x18
7         .equ    REAL_DATA_SEG,_rmds-_gdt
8         .equ    CR0_PE,1
10 #ifdef  GAS291
11 #define DATA32 data32;
12 #define ADDR32 addr32;
13 #define LJMPI(x)        ljmp    x
14 #else
15 #define DATA32 data32
16 #define ADDR32 addr32
17 /* newer GAS295 require #define LJMPI(x)        ljmp    *x */
18 #define LJMPI(x)        ljmp    x
19 #endif
21 #define PIC1_VBS  0x08      /* PIC1 interrupts start at vector 64  */
22 #define PIC2_VBS  0x70      /* PIC1 interrupts start at vector 112  */
25  * NOTE: if you write a subroutine that is called from C code (gcc/egcs),
26  * then you only have to take care of %ebx, %esi, %edi and %ebp.  These
27  * registers must not be altered under any circumstance.  All other registers
28  * may be clobbered without any negative side effects.  If you don't follow
29  * this rule then you'll run into strange effects that only occur on some
30  * gcc versions (because the register allocator may use different registers).
31  *
32  * All the data32 prefixes for the ljmp instructions are necessary, because
33  * the assembler emits code with a relocation address of 0.  This means that
34  * all destinations are initially negative, which the assembler doesn't grok,
35  * because for some reason negative numbers don't fit into 16 bits. The addr32
36  * prefixes are there for the same reasons, because otherwise the memory
37  * references are only 16 bit wide.  Theoretically they are all superfluous.
38  * One last note about prefixes: the data32 prefixes on all call _real_to_prot
39  * instructions could be removed if the _real_to_prot function is changed to
40  * deal correctly with 16 bit return addresses.  I tried it, but failed.
41  */
43 /**************************************************************************
44 START - Where all the fun begins....
45 **************************************************************************/
46 /* this must be the first thing in the file because we enter from the top */
47         .global _start
48         .code32
49 _start:
50         cli
51         
52         /* load new IDT and GDT */
53         lgdt    gdtarg
54         lidt    Idt_Reg
55         /* flush prefetch queue, and reload %cs:%eip */
56         ljmp    $KERN_CODE_SEG,$1f
58         
59         /* reload other segment registers */
60         movl    $KERN_DATA_SEG,%eax
61         movl    %eax,%ds
62         movl    %eax,%es
63         movl    %eax,%ss
64         movl    $stktop,%esp
66         /* program the PITs in order to stop them */
67         mov     $0x30,%al
68         out     %al,$0x43
69         out     %al,$0x40
70         mov     $0x70,%al
71         out     %al,$0x43
72         out     %al,$0x41
73         mov     $0xf0,%al
74         out     %al,$0x43
75         out     %al,$0x42       
77         call    main
78         /* fall through */
80         .globl  exit
81 exit:
83         ljmp $KERN_CODE_SEG,$2b
85 /**************************************************************************
86 MEMSIZE - Determine size of extended memory
87 **************************************************************************/
88         .globl  memsize
89 memsize:
90 #if 0
91         pushl   %ebx
92         pushl   %esi
93         pushl   %edi
94         call    _prot_to_real
95         .code16
96         movw    $0xe801,%ax
97         stc
98         int     $0x15
99         jc      1f
100         andl    $0xffff,%eax
101         andl    $0xffff,%ebx
102         shll    $6,%ebx
103         addl    %ebx,%eax
104         jmp     2f
106         movw    $0x8800,%ax
107         int     $0x15
108         andl    $0xffff,%eax
110         movl    %eax,%esi
111         DATA32 call     _real_to_prot
112         .code32
113         movl    %esi,%eax
114         popl    %edi
115         popl    %esi
116         popl    %ebx
117 #else
118         mov     $32768,%eax
119 #endif
120         ret
122 /**************************************************************************
123 XSTART - Transfer control to the kernel just loaded
124 **************************************************************************/
125         .code16
127         .globl _int08_handler
128 _int08_handler:
129         movb    $0x20, %al
130         outb    %al, $0x20
131         iret
133         .globl _int10_handler
134 _int10_handler:
135         cmp     $0x3, %ah
136         jnz     _int10_04
137         mov     $0x0, %dx
138         mov     $0x0, %cx
139         iret
140 _int10_04:
141         cmp     $0x4, %ah
142         jnz     _int10_05
143         mov     $0x0, %ah
144         iret
145 _int10_05:
146         cmp     $0x5, %ah
147         jnz     _int10_08
148         mov     $0x0, %al
149         iret
150 _int10_08:
151         cmp     $0x8, %ah
152         jnz     _int10_0D
153         mov     $0x20, %al
154         mov     $0x7,  %ah
155         iret
156 _int10_0D:
157         cmp     $0xD, %ah
158         jnz     _int10_0F
159         mov     $0x0, %al
160         iret
161 _int10_0F:
162         cmp     $0xF, %ah
163         jnz     _int10_XX
164         mov     $0xb, %al
165         mov     $80, %ah
166         mov     $0, %bh
167 _int10_XX:
168         iret
169         
170         .globl _int11_handler
171 _int11_handler:
172         mov     $0x22, %ax
173         iret
174         
175         .globl _int12_handler
176 _int12_handler:
177         mov     $640, %ax
178         iret
179         
180         .globl _int13_handler
181 _int13_handler:
182         clc
183         mov     $0, %ah
184         iret
186         .globl _int14_handler
187 _int14_handler:
188         iret
190         .globl _int15_handler
191 _int15_handler:
192         cmp     $0xe801,%ax
193         jz      _int15_008
194         cmp     $0x0, %ah
195         jz      _int15_000
196         cmp     $0x1, %ah
197         jz      _int15_000
198         cmp     $0x2, %ah
199         jz      _int15_000
200         cmp     $0x3, %ah
201         jz      _int15_000
202         cmp     $0xf, %ah
203         jz      _int15_000
204         cmp     $0x21, %ah
205         jz      _int15_000
206         cmp     $0x40, %ah
207         jz      _int15_000
208         cmp     $0x41, %ah
209         jz      _int15_000
210         cmp     $0x42, %ah
211         jz      _int15_000
212         cmp     $0x43, %ah
213         jz      _int15_000
214         cmp     $0x44, %ah
215         jz      _int15_000
216         cmp     $0x80, %ah
217         jz      _int15_001
218         cmp     $0x81, %ah
219         jz      _int15_001
220         cmp     $0x82, %ah
221         jz      _int15_002
222         cmp     $0x83, %ah
223         jz      _int15_003
224         cmp     $0x84, %ah
225         jz      _int15_000
226         cmp     $0x85, %ah
227         jz      _int15_004
228         cmp     $0x86, %ah
229         jz      _int15_003
230         cmp     $0x87, %ah
231         jz      _int15_005
232         cmp     $0x88, %ah
233         jz      _int15_006
234         cmp     $0x89, %ah
235         jz      _int15_005
236         cmp     $0x90, %ah
237         jz      _int15_007
238         cmp     $0xc0, %ah
239         jz      _int15_000
240         cmp     $0xc1, %ah
241         jz      _int15_000
242         cmp     $0xc2, %ah
243         jz      _int15_000
244         cmp     $0xc3, %ah
245         jz      _int15_000
246         cmp     $0xc4, %ah
247         jz      _int15_000
248         iret
250 _int15_000:
251         mov     $0x86, %ah
252         stc
253         iret
255 _int15_001:
256         mov     $0, %bx
257         mov     $0, %cx
258         iret
260 _int15_002:
261         mov     $0, %bx
262         iret
264 _int15_003:
265         clc
266         iret
268 _int15_004:
269         mov     $0, %al
270         iret
272 _int15_005:
273         mov     $0, %ah
274         clc
275         cmp     $0, %ah
276         iret
278 _int15_006:
279         mov     $0xf000, %ax
280         iret
282 _int15_007:
283         stc
284         iret
286 _int15_008:
287         clc
288         mov     $1024, %dx      /* dx -> extended memory size (in 64K chuncks) */
289         mov     $640, %cx       /* cx -> conventional memory size (in 1 Kbytes chuncks) */
290         iret
292         .globl _int16_handler
293 _int16_handler:
294         cmp     $0x0, %ah
295         jnz     _int16_01
296         mov     $0x20, %al
297         mov     $0x39, %ah
298         iret
299 _int16_01:
300         cmp     $0x1, %ah
301         jnz     _int16_02
302         iret
303 _int16_02:
304         cmp     $0x2, %ah
305         jnz     _int16_05
306         mov     $0, %al
307         iret
308 _int16_05:
309         cmp     $0x5, %ah
310         jnz     _int16_10
311         mov     $0, %al
312         iret
313 _int16_10:
314         cmp     $0x10, %ah
315         jnz     _int16_11
316         mov     $0x20, %al
317         mov     $0x39, %ah
318         iret
319 _int16_11:
320         cmp     $0x11, %ah
321         jnz     _int16_12
322         iret
323 _int16_12:
324         cmp     $0x12, %ah
325         jnz     _int16_XX
326         mov $0, %ax
327         iret
328 _int16_XX:
329         iret
331         .globl _int17_handler
332 _int17_handler:
333         mov $0xd0, %ah
334         iret
336         .globl _int19_handler
337 _int19_handler:
338         hlt
339         iret
341         .globl _int1A_handler
342 _int1A_handler:
343         stc
344         iret
346         .code32
347         .globl  xstart
348 xstart:
349         /* reprogram the PICs so that interrupt are masked */
350         movb    $0x11,%al       /* ICW1 [ICW4 NEEDED, EDGE TRIGGERED]*/
351         outb    %al,$0x20
352         movb    $PIC1_VBS, %al
353         outb    %al,$0x21
354         movb    $0x4,%al
355         outb    %al,$0x21
356         movb    $0x1,%al
357         outb    %al,$0x21
358         movb    $0xff,%al
359         outb    %al,$0x21
360         
361         movb    $0x11,%al       /* ICW1 [ICW4 NEEDED, EDGE TRIGGERED]*/
362         outb    %al,$0xa0
363         movb    $PIC2_VBS, %al
364         outb    %al,$0xa1
365         movb    $0x2,%al
366         outb    %al,$0xa1
367         movb    $0x1,%al
368         outb    %al,$0xa1
369         movb    $0xff,%al
370         outb    %al,$0xa1
372         pushl   %ebp
373         movl    %esp,%ebp
374         pushl   %ebx
375         pushl   %esi
376         pushl   %edi
377         movl    8(%ebp),%eax
378         movl    %eax,_execaddr
379         movl    12(%ebp),%ebx
380         movl    16(%ebp),%ecx   /* bootp record (32bit pointer) */
381         addl    $28,%ecx        /* ip, udp header */
382         shll    $12,%ecx
383         shrw    $12,%cx
384         call    _prot_to_real
385         .code16
386 /* MP: add int10 handler */
387         push    %eax
388         push    %ebx
389         push    %es
390         mov     $0,%ax
391         mov     %ax,%es
392         mov     %cs,%ax
393         shl     $16,%eax
395         ADDR32 mov      $(_int08_handler-_start),%ax
396         mov     $0x20,%ebx
397         mov     %eax,%es:(%bx)
399         ADDR32 mov      $(_int10_handler-_start),%ax
400         mov     $0x40,%ebx
401         mov     %eax,%es:(%bx)
403         ADDR32 mov      $(_int11_handler-_start),%ax
404         mov     $0x44,%ebx
405         mov     %eax,%es:(%bx)
407         ADDR32 mov      $(_int12_handler-_start),%ax
408         mov     $0x48,%ebx
409         mov     %eax,%es:(%bx)
411         ADDR32 mov      $(_int13_handler-_start),%ax
412         mov     $0x4c,%ebx
413         mov     %eax,%es:(%bx)
415         ADDR32 mov      $(_int14_handler-_start),%ax
416         mov     $0x50,%ebx
417         mov     %eax,%es:(%bx)
419         ADDR32 mov      $(_int15_handler-_start),%ax
420         mov     $0x54,%ebx
421         mov     %eax,%es:(%bx)
423         ADDR32 mov      $(_int16_handler-_start),%ax
424         mov     $0x58,%ebx
425         mov     %eax,%es:(%bx)
427         ADDR32 mov      $(_int17_handler-_start),%ax
428         mov     $0x5c,%ebx
429         mov     %eax,%es:(%bx)
431         ADDR32 mov      $(_int19_handler-_start),%ax
432         mov     $0x64,%ebx
433         mov     %eax,%es:(%bx)
435         ADDR32 mov      $(_int1A_handler-_start),%ax
436         mov     $0x68,%ebx
437         mov     %eax,%es:(%bx)
439         pop     %es
440         pop     %ebx
441         pop     %eax
442 /* */
443         pushl   %ecx            /* bootp record */
444         pushl   %ebx            /* file header */
445         movl    $((RELOC<<12)+(1f-RELOC)),%eax
446         pushl   %eax
447         ADDR32  LJMPI(_execaddr-_start)
449         addw    $8,%sp          /* XXX or is this 10 in case of a 16bit "ret" */
450         DATA32 call     _real_to_prot
451         .code32
452         popl    %edi
453         popl    %esi
454         popl    %ebx
455         popl    %ebp
456         ret
458 _execaddr:
459         .long   0
461 #ifdef  IMAGE_MULTIBOOT
462 /**************************************************************************
463 XEND - Restart Etherboot from the beginning (from protected mode)
464 **************************************************************************/
466         .globl  xend
467 xend:
468         cs
469         lidt    idtarg_realmode-_start+RELOC
470         cs
471         lgdt    gdtarg-_start+RELOC
472 #ifdef  GAS291
473         ljmp    $REAL_CODE_SEG,$1f-RELOC        /* jump to a 16 bit segment */
474 #else
475         ljmp    $REAL_CODE_SEG,$1f-_start       /* jump to a 16 bit segment */
476 #endif  /* GAS291 */
478         .code16
479         movw    $REAL_DATA_SEG,%ax
480         movw    %ax,%ds
481         movw    %ax,%ss
482         movw    %ax,%es
484         /* clear the PE bit of CR0 */
485         movl    %cr0,%eax
486         andl    $0!CR0_PE,%eax
487         movl    %eax,%cr0
489         /* make intersegment jmp to flush the processor pipeline
490          * and reload %cs:%eip (to clear upper 16 bits of %eip).
491          */
492         DATA32 ljmp     $(RELOC)>>4,$2f-_start
494         /* we are in real mode now
495          * set up the real mode segment registers : %ds, %ss, %es
496          */
497         movw    %cs,%ax
498         movw    %ax,%ds
499         movw    %ax,%es
500         movw    %ax,%ss
501         xorl    %esp,%esp
502         ADDR32 movw     initsp-RELOC,%sp
504         movw    $0,%ax
505         movw    %ax,%fs
506         movw    %ax,%gs
508         sti
509         jmp     _start
511         .code32
512 #endif  /* IMAGE_MULTIBOOT */
514 .global get_cs
515 get_cs:
516         xorl    %eax,%eax
517         movw    %cs,%ax
518         ret
520 .global get_ds
521 get_ds:
522         xorl    %eax,%eax
523         movw    %ds,%ax
524         ret
526 .global getsp
527 getsp:
528         movl    %esp,%eax       /* GET STACK POINTER */
529         subl    $4, %eax        /* ACCOUNT FOR RETURN ADDRESS ON */
530         ret
532 .global get_gdtbase
533 get_gdtbase:
534         sub     $8,%esp                 /* ALLOCATE ROOM ON THE STACK */
535         sgdt    (%esp,1)                /*STORE IGDT REGISTER ON STACK */
536         mov     2(%esp),%eax            /* READ GDT BASE ADDRESS */
537         mov     $KERN_DATA_SEG,%dx      /* ASSUME UNIVERSAL DS. */
538         add     $8,%esp                 /* RESTORE STACK */
539         ret                             /* DONE */
541 .global get_gdtsize
542 get_gdtsize:
543         sub     $8,%esp /* ALLOCATE ROOM ON THE STACK */
544         sgdt    (%esp,1)        /*STORE IGDT REGISTER ON STACK */
545         xor     %eax,%eax
546         mov     2(%esp),%eax    /* READ GDT BASE ADDRESS */
547         mov     (%ESP),%ax
548         shr     $3,%ax
549         add     $8,%esp /* RESTORE STACK */
550         ret                     /* DONE */
552 .global get_idtbase
553 get_idtbase:
554         sub     $8,%esp
555         sidt   (%esp,1)         /* STORE IIDT REGISTER ON STACK */
556         mov     2(%esp),%eax
557         mov     $KERN_DATA_SEG,%dx
558         add     $8,%esp
559         ret
561 .global get_lw
562 get_lw:
563         xor     %edx,%edx
564         mov     8(%esp),%eax
565         mov     4(%esp),%dx
566         ret
567          
568 /**************************************************************************
569 SETJMP - Save stack context for non-local goto
570 **************************************************************************/
571         .globl  setjmp
572 setjmp:
573         mov     4(%esp),%ecx
574         mov     0(%esp),%edx
575         mov     %edx,0(%ecx)
576         mov     %ebx,4(%ecx)
577         mov     %esp,8(%ecx)
578         mov     %ebp,12(%ecx)
579         mov     %esi,16(%ecx)
580         mov     %edi,20(%ecx)
581         mov     %eax,24(%ecx)
582         mov     $0,%eax
583         ret
585 /**************************************************************************
586 LONGJMP - Non-local jump to a saved stack context
587 **************************************************************************/
588         .globl  longjmp
589 longjmp:
590         mov     4(%esp),%edx
591         mov     8(%esp),%eax
592         mov     0(%edx),%ecx
593         mov     4(%edx),%ebx
594         mov     8(%edx),%esp
595         mov     12(%edx),%ebp
596         mov     16(%edx),%esi
597         mov     20(%edx),%edi
598         cmp     $0,%eax
599         jne     1f
600         mov     $1,%eax
601 1:      mov     %ecx,0(%esp)
602         ret
604 /**************************************************************************
605 _REAL_TO_PROT - Go from REAL mode to Protected Mode
606 **************************************************************************/
607         .globl  _real_to_prot
608 _real_to_prot:
609         .code16
610         cli
611         cs
612         ADDR32 lgdt     gdtarg-_start
613         movl    %cr0,%eax
614         orl     $CR0_PE,%eax
615         movl    %eax,%cr0               /* turn on protected mode */
617         /* flush prefetch queue, and reload %cs:%eip */
618         DATA32 ljmp     $KERN_CODE_SEG,$1f
620         .code32
621         /* reload other segment registers */
622         movl    $KERN_DATA_SEG,%eax
623         movl    %eax,%ds
624         movl    %eax,%es
625         movl    %eax,%ss
626         addl    $RELOC,%esp             /* Fix up stack pointer */
627         xorl    %eax,%eax
628         movl    %eax,%fs
629         movl    %eax,%gs
630         popl    %eax                    /* Fix up return address */
631         addl    $RELOC,%eax
632         pushl   %eax
633         ret
635 /**************************************************************************
636 _PROT_TO_REAL - Go from Protected Mode to REAL Mode
637 **************************************************************************/
638         .globl  _prot_to_real
639 _prot_to_real:
640         .code32
641         popl    %eax
642         subl    $RELOC,%eax             /* Adjust return address */
643         pushl   %eax
644         subl    $RELOC,%esp             /* Adjust stack pointer */
645 #ifdef  GAS291
646         ljmp    $REAL_CODE_SEG,$1f-RELOC        /* jump to a 16 bit segment */
647 #else
648         ljmp    $REAL_CODE_SEG,$1f-_start       /* jump to a 16 bit segment */
649 #endif  /* GAS291 */
651         .code16
652         movw    $REAL_DATA_SEG,%ax
653         movw    %ax,%ds
654         movw    %ax,%ss
655         movw    %ax,%es
656         movw    %ax,%fs
657         movw    %ax,%gs
658         cli
660         /* clear the PE bit of CR0 */
661         movl    %cr0,%eax
662         andl    $0!CR0_PE,%eax
663         movl    %eax,%cr0
665         /* make intersegment jmp to flush the processor pipeline
666          * and reload %cs:%eip (to clear upper 16 bits of %eip).
667          */
668         DATA32 ljmp     $(RELOC)>>4,$2f-_start
670         /* we are in real mode now
671          * set up the real mode segment registers : %ds, $ss, %es
672          */
673         movw    %cs,%ax
674         movw    %ax,%ds
675         movw    %ax,%es
676         movw    %ax,%ss
677 #if 0
678         sti
679 #endif
680         DATA32 ret      /* There is a 32 bit return address on the stack */
681         .code32
683 /**************************************************************************
684 GLOBAL DESCRIPTOR TABLE
685 **************************************************************************/
686         .align  4
687 Idt_Reg:
688         .word 0x3ff
689         .long 0
691         .align  4
692 _gdt:
693 gdtarg:
694 Gdt_Table:
695         .word   0x27                    /* limit */
696         .long   _gdt                    /* addr */
697         .word   0
698 _pmcs:
699         /* 32 bit protected mode code segment */
700         .word   0xffff,0
701         .byte   0,0x9f,0xcf,0
703 _pmds:
704         /* 32 bit protected mode data segment */
705         .word   0xffff,0
706         .byte   0,0x93,0xcf,0
708 _rmcs:
709         /* 16 bit real mode code segment */
710         .word   0xffff,(RELOC&0xffff)
711         .byte   (RELOC>>16),0x9b,0x00,(RELOC>>24)
713 _rmds:
714         /* 16 bit real mode data segment */
715         .word   0xffff,(RELOC&0xffff)
716         .byte   (RELOC>>16),0x93,0x00,(RELOC>>24)
718         .align  4
719 RUN_GDT:                        /* POINTER TO GDT IN RAM */
720          .byte   0x7f,0         /* [BSP_GDT_NUM*8]-1 */
721          .long   Gdt_Table
723         .align  4
725         .section ".rodata"
726 err_not386:
727         .ascii  "Etherboot/32 requires 386+"
728         .byte   0x0d, 0x0a
729 err_not386_end:
731 days:   .long   0
732 irq_num: .long
734         .data
735         .align  4
736         .org 2048
737 .global stktop
738 stktop:
739         .long
741 .section ".armando"
742 /*                 1:::::::::2:::::::::3:::::::3 */
743 /*        12345678901234567890123456789012345678 */
744 /*       v----+----v----+----v----+----v----+--- */
746 .global EtherbootString
747 EtherbootString:
748 .ascii  "EtherBoot MPCC  "      /* fw identifier */
750 .byte   0, 0            /* mandatory hole */
752 .long   _start          /* entry point */
753 .word   0
754 .byte   'E'             /* type */
755 .byte   0               /* selector */
756 .word   0               /* CRC */