PCI detection code doesn't corrupt memory anymore (2nd try)
[syslinux.git] / extlinux.asm
blob8b2eff5b4514852395fa9f2c1cc118553822d5ab
1 ; -*- fundamental -*- (asm-mode sucks)
2 ; ****************************************************************************
4 ; extlinux.asm
6 ; A program to boot Linux kernels off an ext2/ext3 filesystem.
8 ; Copyright 1994-2008 H. Peter Anvin - All Rights Reserved
10 ; This program is free software; you can redistribute it and/or modify
11 ; it under the terms of the GNU General Public License as published by
12 ; the Free Software Foundation, Inc., 53 Temple Place Ste 330,
13 ; Boston MA 02111-1307, USA; either version 2 of the License, or
14 ; (at your option) any later version; incorporated herein by reference.
16 ; ****************************************************************************
18 %define IS_EXTLINUX 1
19 %include "head.inc"
20 %include "ext2_fs.inc"
23 ; Some semi-configurable constants... change on your own risk.
25 my_id equ extlinux_id
26 ; NASM 0.98.38 croaks if these are equ's rather than macros...
27 FILENAME_MAX_LG2 equ 8 ; log2(Max filename size Including final null)
28 FILENAME_MAX equ (1 << FILENAME_MAX_LG2) ; Max mangled filename size
29 NULLFILE equ 0 ; Null character == empty filename
30 NULLOFFSET equ 0 ; Position in which to look
31 retry_count equ 16 ; How patient are we with the disk?
32 %assign HIGHMEM_SLOP 0 ; Avoid this much memory near the top
33 LDLINUX_MAGIC equ 0x3eb202fe ; A random number to identify ourselves with
35 MAX_OPEN_LG2 equ 6 ; log2(Max number of open files)
36 MAX_OPEN equ (1 << MAX_OPEN_LG2)
38 SECTOR_SHIFT equ 9
39 SECTOR_SIZE equ (1 << SECTOR_SHIFT)
41 MAX_SYMLINKS equ 64 ; Maximum number of symlinks per lookup
42 SYMLINK_SECTORS equ 2 ; Max number of sectors in a symlink
43 ; (should be >= FILENAME_MAX)
46 ; This is what we need to do when idle
48 %macro RESET_IDLE 0
49 ; Nothing
50 %endmacro
51 %macro DO_IDLE 0
52 ; Nothing
53 %endmacro
56 ; The following structure is used for "virtual kernels"; i.e. LILO-style
57 ; option labels. The options we permit here are `kernel' and `append
58 ; Since there is no room in the bottom 64K for all of these, we
59 ; stick them in high memory and copy them down before we need them.
61 struc vkernel
62 vk_vname: resb FILENAME_MAX ; Virtual name **MUST BE FIRST!**
63 vk_rname: resb FILENAME_MAX ; Real name
64 vk_appendlen: resw 1
65 vk_type: resb 1 ; Type of file
66 alignb 4
67 vk_append: resb max_cmd_len+1 ; Command line
68 alignb 4
69 vk_end: equ $ ; Should be <= vk_size
70 endstruc
73 ; Segment assignments in the bottom 640K
74 ; Stick to the low 512K in case we're using something like M-systems flash
75 ; which load a driver into low RAM (evil!!)
77 ; 0000h - main code/data segment (and BIOS segment)
79 real_mode_seg equ 3000h
80 cache_seg equ 2000h ; 64K area for metadata cache
81 xfer_buf_seg equ 1000h ; Bounce buffer for I/O to high mem
82 comboot_seg equ real_mode_seg ; COMBOOT image loading zone
85 ; File structure. This holds the information for each currently open file.
87 struc open_file_t
88 file_left resd 1 ; Number of sectors left (0 = free)
89 file_sector resd 1 ; Next linear sector to read
90 file_in_sec resd 1 ; Sector where inode lives
91 file_in_off resw 1
92 file_mode resw 1
93 endstruc
95 %ifndef DEPEND
96 %if (open_file_t_size & (open_file_t_size-1))
97 %error "open_file_t is not a power of 2"
98 %endif
99 %endif
101 ; ---------------------------------------------------------------------------
102 ; BEGIN CODE
103 ; ---------------------------------------------------------------------------
106 ; Memory below this point is reserved for the BIOS and the MBR
108 section .earlybss
109 trackbufsize equ 8192
110 trackbuf resb trackbufsize ; Track buffer goes here
111 ; ends at 2800h
113 section .bss
114 SuperBlock resb 1024 ; ext2 superblock
115 SuperInfo resq 16 ; DOS superblock expanded
116 ClustSize resd 1 ; Bytes/cluster ("block")
117 SecPerClust resd 1 ; Sectors/cluster
118 ClustMask resd 1 ; Sectors/cluster - 1
119 PtrsPerBlock1 resd 1 ; Pointers/cluster
120 PtrsPerBlock2 resd 1 ; (Pointers/cluster)^2
121 DriveNumber resb 1 ; BIOS drive number
122 ClustShift resb 1 ; Shift count for sectors/cluster
123 ClustByteShift resb 1 ; Shift count for bytes/cluster
125 alignb open_file_t_size
126 Files resb MAX_OPEN*open_file_t_size
128 section .text
130 ; Some of the things that have to be saved very early are saved
131 ; "close" to the initial stack pointer offset, in order to
132 ; reduce the code size...
134 StackBuf equ $-44-32 ; Start the stack here (grow down - 4K)
135 PartInfo equ StackBuf ; Saved partition table entry
136 FloppyTable equ PartInfo+16 ; Floppy info table (must follow PartInfo)
137 OrigFDCTabPtr equ StackBuf-8 ; The 2nd high dword on the stack
138 OrigESDI equ StackBuf-4 ; The high dword on the stack
141 ; Primary entry point. Tempting as though it may be, we can't put the
142 ; initial "cli" here; the jmp opcode in the first byte is part of the
143 ; "magic number" (using the term very loosely) for the DOS superblock.
145 bootsec equ $
146 jmp short start ; 2 bytes
147 nop ; 1 byte
149 ; "Superblock" follows -- it's in the boot sector, so it's already
150 ; loaded and ready for us
152 bsOemName db 'EXTLINUX' ; The SYS command sets this, so...
154 ; These are the fields we actually care about. We end up expanding them
155 ; all to dword size early in the code, so generate labels for both
156 ; the expanded and unexpanded versions.
158 %macro superb 1
159 bx %+ %1 equ SuperInfo+($-superblock)*8+4
160 bs %+ %1 equ $
161 zb 1
162 %endmacro
163 %macro superw 1
164 bx %+ %1 equ SuperInfo+($-superblock)*8
165 bs %+ %1 equ $
166 zw 1
167 %endmacro
168 %macro superd 1
169 bx %+ %1 equ $ ; no expansion for dwords
170 bs %+ %1 equ $
171 zd 1
172 %endmacro
173 superblock equ $
174 superw BytesPerSec
175 superb SecPerClust
176 superw ResSectors
177 superb FATs
178 superw RootDirEnts
179 superw Sectors
180 superb Media
181 superw FATsecs
182 superw SecPerTrack
183 superw Heads
184 superinfo_size equ ($-superblock)-1 ; How much to expand
185 superd Hidden
186 superd HugeSectors
188 ; This is as far as FAT12/16 and FAT32 are consistent
190 zb 54 ; FAT12/16 need 26 more bytes,
191 ; FAT32 need 54 more bytes
192 superblock_len equ $-superblock
195 ; Note we don't check the constraints above now; we did that at install
196 ; time (we hope!)
198 start:
199 cli ; No interrupts yet, please
200 cld ; Copy upwards
202 ; Set up the stack
204 xor ax,ax
205 mov ss,ax
206 mov sp,StackBuf ; Just below BSS
207 push es ; Save initial ES:DI -> $PnP pointer
208 push di
209 mov es,ax
211 ; DS:SI may contain a partition table entry. Preserve it for us.
213 mov cx,8 ; Save partition info
214 mov di,PartInfo
215 rep movsw
217 mov ds,ax ; Now we can initialize DS...
220 ; Now sautee the BIOS floppy info block to that it will support decent-
221 ; size transfers; the floppy block is 11 bytes and is stored in the
222 ; INT 1Eh vector (brilliant waste of resources, eh?)
224 ; Of course, if BIOSes had been properly programmed, we wouldn't have
225 ; had to waste precious space with this code.
227 mov bx,fdctab
228 lfs si,[bx] ; FS:SI -> original fdctab
229 push fs ; Save on stack in case we need to bail
230 push si
232 ; Save the old fdctab even if hard disk so the stack layout
233 ; is the same. The instructions above do not change the flags
234 mov [DriveNumber],dl ; Save drive number in DL
235 and dl,dl ; If floppy disk (00-7F), assume no
236 ; partition table
237 js harddisk
239 floppy:
240 mov cl,6 ; 12 bytes (CX == 0)
241 ; es:di -> FloppyTable already
242 ; This should be safe to do now, interrupts are off...
243 mov [bx],di ; FloppyTable
244 mov [bx+2],ax ; Segment 0
245 fs rep movsw ; Faster to move words
246 mov cl,[bsSecPerTrack] ; Patch the sector count
247 mov [di-8],cl
248 ; AX == 0 here
249 int 13h ; Some BIOSes need this
251 jmp short not_harddisk
253 ; The drive number and possibly partition information was passed to us
254 ; by the BIOS or previous boot loader (MBR). Current "best practice" is to
255 ; trust that rather than what the superblock contains.
257 ; Would it be better to zero out bsHidden if we don't have a partition table?
259 ; Note: di points to beyond the end of PartInfo
261 harddisk:
262 test byte [di-16],7Fh ; Sanity check: "active flag" should
263 jnz no_partition ; be 00 or 80
264 mov eax,[di-8] ; Partition offset (dword)
265 mov [bsHidden],eax
266 no_partition:
268 ; Get disk drive parameters (don't trust the superblock.) Don't do this for
269 ; floppy drives -- INT 13:08 on floppy drives will (may?) return info about
270 ; what the *drive* supports, not about the *media*. Fortunately floppy disks
271 ; tend to have a fixed, well-defined geometry which is stored in the superblock.
273 ; DL == drive # still
274 mov ah,08h
275 int 13h
276 jc no_driveparm
277 and ah,ah
278 jnz no_driveparm
279 shr dx,8
280 inc dx ; Contains # of heads - 1
281 mov [bsHeads],dx
282 and cx,3fh
283 mov [bsSecPerTrack],cx
284 no_driveparm:
285 not_harddisk:
287 ; Ready to enable interrupts, captain
292 ; Do we have EBIOS (EDD)?
294 eddcheck:
295 mov bx,55AAh
296 mov ah,41h ; EDD existence query
297 mov dl,[DriveNumber]
298 int 13h
299 jc .noedd
300 cmp bx,0AA55h
301 jne .noedd
302 test cl,1 ; Extended disk access functionality set
303 jz .noedd
305 ; We have EDD support...
307 mov byte [getlinsec.jmp+1],(getlinsec_ebios-(getlinsec.jmp+2))
308 .noedd:
311 ; Load the first sector of LDLINUX.SYS; this used to be all proper
312 ; with parsing the superblock and root directory; it doesn't fit
313 ; together with EBIOS support, unfortunately.
315 mov eax,[FirstSector] ; Sector start
316 mov bx,ldlinux_sys ; Where to load it
317 call getonesec
319 ; Some modicum of integrity checking
320 cmp dword [ldlinux_magic+4],LDLINUX_MAGIC^HEXDATE
321 jne kaboom
323 ; Go for it...
324 jmp ldlinux_ent
327 ; getonesec: get one disk sector
329 getonesec:
330 mov bp,1 ; One sector
331 ; Fall through
334 ; getlinsec: load a sequence of BP floppy sector given by the linear sector
335 ; number in EAX into the buffer at ES:BX. We try to optimize
336 ; by loading up to a whole track at a time, but the user
337 ; is responsible for not crossing a 64K boundary.
338 ; (Yes, BP is weird for a count, but it was available...)
340 ; On return, BX points to the first byte after the transferred
341 ; block.
343 ; This routine assumes CS == DS, and trashes most registers.
345 ; Stylistic note: use "xchg" instead of "mov" when the source is a register
346 ; that is dead from that point; this saves space. However, please keep
347 ; the order to dst,src to keep things sane.
349 getlinsec:
350 add eax,[bsHidden] ; Add partition offset
351 xor edx,edx ; Zero-extend LBA (eventually allow 64 bits)
353 .jmp: jmp strict short getlinsec_cbios
356 ; getlinsec_ebios:
358 ; getlinsec implementation for EBIOS (EDD)
360 getlinsec_ebios:
361 .loop:
362 push bp ; Sectors left
363 .retry2:
364 call maxtrans ; Enforce maximum transfer size
365 movzx edi,bp ; Sectors we are about to read
366 mov cx,retry_count
367 .retry:
369 ; Form DAPA on stack
370 push edx
371 push eax
372 push es
373 push bx
374 push di
375 push word 16
376 mov si,sp
377 pushad
378 mov dl,[DriveNumber]
379 push ds
380 push ss
381 pop ds ; DS <- SS
382 mov ah,42h ; Extended Read
383 int 13h
384 pop ds
385 popad
386 lea sp,[si+16] ; Remove DAPA
387 jc .error
388 pop bp
389 add eax,edi ; Advance sector pointer
390 sub bp,di ; Sectors left
391 shl di,SECTOR_SHIFT ; 512-byte sectors
392 add bx,di ; Advance buffer pointer
393 and bp,bp
394 jnz .loop
398 .error:
399 ; Some systems seem to get "stuck" in an error state when
400 ; using EBIOS. Doesn't happen when using CBIOS, which is
401 ; good, since some other systems get timeout failures
402 ; waiting for the floppy disk to spin up.
404 pushad ; Try resetting the device
405 xor ax,ax
406 mov dl,[DriveNumber]
407 int 13h
408 popad
409 loop .retry ; CX-- and jump if not zero
411 ;shr word [MaxTransfer],1 ; Reduce the transfer size
412 ;jnz .retry2
414 ; Total failure. Try falling back to CBIOS.
415 mov byte [getlinsec.jmp+1],(getlinsec_cbios-(getlinsec.jmp+2))
416 ;mov byte [MaxTransfer],63 ; Max possibe CBIOS transfer
418 pop bp
419 ; ... fall through ...
422 ; getlinsec_cbios:
424 ; getlinsec implementation for legacy CBIOS
426 getlinsec_cbios:
427 .loop:
428 push edx
429 push eax
430 push bp
431 push bx
433 movzx esi,word [bsSecPerTrack]
434 movzx edi,word [bsHeads]
436 ; Dividing by sectors to get (track,sector): we may have
437 ; up to 2^18 tracks, so we need to use 32-bit arithmetric.
439 div esi
440 xor cx,cx
441 xchg cx,dx ; CX <- sector index (0-based)
442 ; EDX <- 0
443 ; eax = track #
444 div edi ; Convert track to head/cyl
446 ; We should test this, but it doesn't fit...
447 ; cmp eax,1023
448 ; ja .error
451 ; Now we have AX = cyl, DX = head, CX = sector (0-based),
452 ; BP = sectors to transfer, SI = bsSecPerTrack,
453 ; ES:BX = data target
456 call maxtrans ; Enforce maximum transfer size
458 ; Must not cross track boundaries, so BP <= SI-CX
459 sub si,cx
460 cmp bp,si
461 jna .bp_ok
462 mov bp,si
463 .bp_ok:
465 shl ah,6 ; Because IBM was STOOPID
466 ; and thought 8 bits were enough
467 ; then thought 10 bits were enough...
468 inc cx ; Sector numbers are 1-based, sigh
469 or cl,ah
470 mov ch,al
471 mov dh,dl
472 mov dl,[DriveNumber]
473 xchg ax,bp ; Sector to transfer count
474 mov ah,02h ; Read sectors
475 mov bp,retry_count
476 .retry:
477 pushad
478 int 13h
479 popad
480 jc .error
481 .resume:
482 movzx ecx,al ; ECX <- sectors transferred
483 shl ax,SECTOR_SHIFT ; Convert sectors in AL to bytes in AX
484 pop bx
485 add bx,ax
486 pop bp
487 pop eax
488 pop edx
489 add eax,ecx
490 sub bp,cx
491 jnz .loop
494 .error:
495 dec bp
496 jnz .retry
498 xchg ax,bp ; Sectors transferred <- 0
499 shr word [MaxTransfer],1
500 jnz .resume
501 ; Fall through to disk_error
504 ; kaboom: write a message and bail out.
506 disk_error:
507 kaboom:
508 xor si,si
509 mov ss,si
510 mov sp,StackBuf-4 ; Reset stack
511 mov ds,si ; Reset data segment
512 pop dword [fdctab] ; Restore FDC table
513 .patch: ; When we have full code, intercept here
514 mov si,bailmsg
516 ; Write error message, this assumes screen page 0
517 .loop: lodsb
518 and al,al
519 jz .done
520 mov ah,0Eh ; Write to screen as TTY
521 mov bx,0007h ; Attribute
522 int 10h
523 jmp short .loop
524 .done:
525 cbw ; AH <- 0
526 .again: int 16h ; Wait for keypress
527 ; NB: replaced by int 18h if
528 ; chosen at install time..
529 int 19h ; And try once more to boot...
530 .norge: jmp short .norge ; If int 19h returned; this is the end
533 ; Truncate BP to MaxTransfer
535 maxtrans:
536 cmp bp,[MaxTransfer]
537 jna .ok
538 mov bp,[MaxTransfer]
539 .ok: ret
542 ; Error message on failure
544 bailmsg: db 'Boot error', 0Dh, 0Ah, 0
546 ; This fails if the boot sector overflows
547 zb 1F8h-($-$$)
549 FirstSector dd 0xDEADBEEF ; Location of sector 1
550 MaxTransfer dw 0x007F ; Max transfer size
552 ; This field will be filled in 0xAA55 by the installer, but we abuse it
553 ; to house a pointer to the INT 16h instruction at
554 ; kaboom.again, which gets patched to INT 18h in RAID mode.
555 bootsignature dw kaboom.again-bootsec
558 ; ===========================================================================
559 ; End of boot sector
560 ; ===========================================================================
561 ; Start of LDLINUX.SYS
562 ; ===========================================================================
564 ldlinux_sys:
566 syslinux_banner db 0Dh, 0Ah
567 db 'EXTLINUX '
568 db version_str, ' ', date, ' ', 0
569 db 0Dh, 0Ah, 1Ah ; EOF if we "type" this in DOS
571 align 8, db 0
572 ldlinux_magic dd LDLINUX_MAGIC
573 dd LDLINUX_MAGIC^HEXDATE
576 ; This area is patched by the installer. It is found by looking for
577 ; LDLINUX_MAGIC, plus 8 bytes.
579 patch_area:
580 LDLDwords dw 0 ; Total dwords starting at ldlinux_sys,
581 ; not including ADVs
582 LDLSectors dw 0 ; Number of sectors, not including
583 ; bootsec & this sec, but including the two ADVs
584 CheckSum dd 0 ; Checksum starting at ldlinux_sys
585 ; value = LDLINUX_MAGIC - [sum of dwords]
586 CurrentDir dd 2 ; "Current" directory inode number
588 ; Space for up to 64 sectors, the theoretical maximum
589 SectorPtrs times 64 dd 0
591 ldlinux_ent:
593 ; Note that some BIOSes are buggy and run the boot sector at 07C0:0000
594 ; instead of 0000:7C00 and the like. We don't want to add anything
595 ; more to the boot sector, so it is written to not assume a fixed
596 ; value in CS, but we don't want to deal with that anymore from now
597 ; on.
599 jmp 0:.next
600 .next:
603 ; Tell the user we got this far
605 mov si,syslinux_banner
606 call writestr
609 ; Tell the user if we're using EBIOS or CBIOS
611 print_bios:
612 mov si,cbios_name
613 cmp byte [getlinsec.jmp+1],(getlinsec_ebios-(getlinsec.jmp+2))
614 jne .cbios
615 mov si,ebios_name
616 .cbios:
617 mov [BIOSName],si
618 call writestr
620 section .bss
621 %define HAVE_BIOSNAME 1
622 BIOSName resw 1
624 section .text
626 ; Now we read the rest of LDLINUX.SYS. Don't bother loading the first
627 ; sector again, though.
629 load_rest:
630 mov si,SectorPtrs
631 mov bx,7C00h+2*SECTOR_SIZE ; Where we start loading
632 mov cx,[LDLSectors]
634 .get_chunk:
635 jcxz .done
636 xor bp,bp
637 lodsd ; First sector of this chunk
639 mov edx,eax
641 .make_chunk:
642 inc bp
643 dec cx
644 jz .chunk_ready
645 inc edx ; Next linear sector
646 cmp [si],edx ; Does it match
647 jnz .chunk_ready ; If not, this is it
648 add si,4 ; If so, add sector to chunk
649 jmp short .make_chunk
651 .chunk_ready:
652 call getlinsecsr
653 shl bp,SECTOR_SHIFT
654 add bx,bp
655 jmp .get_chunk
657 .done:
660 ; All loaded up, verify that we got what we needed.
661 ; Note: the checksum field is embedded in the checksum region, so
662 ; by the time we get to the end it should all cancel out.
664 verify_checksum:
665 mov si,ldlinux_sys
666 mov cx,[LDLDwords]
667 mov edx,-LDLINUX_MAGIC
668 .checksum:
669 lodsd
670 add edx,eax
671 loop .checksum
673 and edx,edx ; Should be zero
674 jz all_read ; We're cool, go for it!
677 ; Uh-oh, something went bad...
679 mov si,checksumerr_msg
680 call writestr
681 jmp kaboom
684 ; -----------------------------------------------------------------------------
685 ; Subroutines that have to be in the first sector
686 ; -----------------------------------------------------------------------------
690 ; writestr: write a null-terminated string to the console
691 ; This assumes we're on page 0. This is only used for early
692 ; messages, so it should be OK.
694 writestr:
695 .loop: lodsb
696 and al,al
697 jz .return
698 mov ah,0Eh ; Write to screen as TTY
699 mov bx,0007h ; Attribute
700 int 10h
701 jmp short .loop
702 .return: ret
705 ; getlinsecsr: save registers, call getlinsec, restore registers
707 getlinsecsr: pushad
708 call getlinsec
709 popad
713 ; Checksum error message
715 checksumerr_msg db ' Load error - ', 0 ; Boot failed appended
718 ; BIOS type string
720 cbios_name db 'CBIOS', 0
721 ebios_name db 'EBIOS', 0
724 ; Debug routine
726 %ifdef debug
727 safedumpregs:
728 cmp word [Debug_Magic],0D00Dh
729 jnz nc_return
730 jmp dumpregs
731 %endif
733 rl_checkpt equ $ ; Must be <= 8000h
735 rl_checkpt_off equ ($-$$)
736 %ifndef DEPEND
737 %if rl_checkpt_off > 400h
738 %error "Sector 1 overflow"
739 %endif
740 %endif
742 ; ----------------------------------------------------------------------------
743 ; End of code and data that have to be in the first sector
744 ; ----------------------------------------------------------------------------
746 all_read:
748 ; Let the user (and programmer!) know we got this far. This used to be
749 ; in Sector 1, but makes a lot more sense here.
751 mov si,copyright_str
752 call writestr
755 ; Insane hack to expand the DOS superblock to dwords
757 expand_super:
758 xor eax,eax
759 mov si,superblock
760 mov di,SuperInfo
761 mov cx,superinfo_size
762 .loop:
763 lodsw
764 dec si
765 stosd ; Store expanded word
766 xor ah,ah
767 stosd ; Store expanded byte
768 loop .loop
771 ; Load the real (ext2) superblock; 1024 bytes long at offset 1024
773 mov bx,SuperBlock
774 mov eax,1024 >> SECTOR_SHIFT
775 mov bp,ax
776 call getlinsec
779 ; Compute some values...
781 xor edx,edx
782 inc edx
784 ; s_log_block_size = log2(blocksize) - 10
785 mov cl,[SuperBlock+s_log_block_size]
786 add cl,10
787 mov [ClustByteShift],cl
788 mov eax,edx
789 shl eax,cl
790 mov [ClustSize],eax
792 sub cl,SECTOR_SHIFT
793 mov [ClustShift],cl
794 shr eax,SECTOR_SHIFT
795 mov [SecPerClust],eax
796 dec eax
797 mov [ClustMask],eax
799 add cl,SECTOR_SHIFT-2 ; 4 bytes/pointer
800 shl edx,cl
801 mov [PtrsPerBlock1],edx
802 shl edx,cl
803 mov [PtrsPerBlock2],edx
806 ; Common initialization code
808 %include "init.inc"
809 %include "cpuinit.inc"
812 ; Initialize the metadata cache
814 call initcache
817 ; Now, everything is "up and running"... patch kaboom for more
818 ; verbosity and using the full screen system
820 ; E9 = JMP NEAR
821 mov dword [kaboom.patch],0e9h+((kaboom2-(kaboom.patch+3)) << 8)
824 ; Now we're all set to start with our *real* business. First load the
825 ; configuration file (if any) and parse it.
827 ; In previous versions I avoided using 32-bit registers because of a
828 ; rumour some BIOSes clobbered the upper half of 32-bit registers at
829 ; random. I figure, though, that if there are any of those still left
830 ; they probably won't be trying to install Linux on them...
832 ; The code is still ripe with 16-bitisms, though. Not worth the hassle
833 ; to take'm out. In fact, we may want to put them back if we're going
834 ; to boot ELKS at some point.
838 ; Load configuration file
840 load_config:
841 mov si,config_name ; Save config file name
842 mov di,ConfigName
843 call strcpy
845 mov di,ConfigName
846 call open
847 jz no_config_file
850 ; Now we have the config file open. Parse the config file and
851 ; run the user interface.
853 %include "ui.inc"
856 ; getlinsec_ext: same as getlinsec, except load any sector from the zero
857 ; block as all zeros; use to load any data derived
858 ; from an ext2 block pointer, i.e. anything *except the
859 ; superblock.*
861 getonesec_ext:
862 mov bp,1
864 getlinsec_ext:
865 cmp eax,[SecPerClust]
866 jae getlinsec ; Nothing fancy
868 ; If we get here, at least part of what we want is in the
869 ; zero block. Zero one sector at a time and loop.
870 push eax
871 push cx
872 xchg di,bx
873 xor eax,eax
874 mov cx,SECTOR_SIZE >> 2
875 rep stosd
876 xchg di,bx
877 pop cx
878 pop eax
879 inc eax
880 dec bp
881 jnz getlinsec_ext
885 ; allocate_file: Allocate a file structure
887 ; If successful:
888 ; ZF set
889 ; BX = file pointer
890 ; In unsuccessful:
891 ; ZF clear
893 allocate_file:
894 TRACER 'a'
895 push cx
896 mov bx,Files
897 mov cx,MAX_OPEN
898 .check: cmp dword [bx], byte 0
899 je .found
900 add bx,open_file_t_size ; ZF = 0
901 loop .check
902 ; ZF = 0 if we fell out of the loop
903 .found: pop cx
906 ; open_inode:
907 ; Open a file indicated by an inode number in EAX
909 ; NOTE: This file considers finding a zero-length file an
910 ; error. This is so we don't have to deal with that special
911 ; case elsewhere in the program (most loops have the test
912 ; at the end).
914 ; If successful:
915 ; ZF clear
916 ; SI = file pointer
917 ; DX:AX = EAX = file length in bytes
918 ; ThisInode = the first 128 bytes of the inode
919 ; If unsuccessful
920 ; ZF set
922 ; Assumes CS == DS == ES.
924 open_inode.allocate_failure:
925 xor eax,eax
926 pop bx
927 pop di
930 open_inode:
931 push di
932 push bx
933 call allocate_file
934 jnz .allocate_failure
936 push cx
937 push gs
938 ; First, get the appropriate inode group and index
939 dec eax ; There is no inode 0
940 xor edx,edx
941 mov [bx+file_sector],edx
942 div dword [SuperBlock+s_inodes_per_group]
943 ; EAX = inode group; EDX = inode within group
944 push edx
946 ; Now, we need the block group descriptor.
947 ; To get that, we first need the relevant descriptor block.
949 shl eax, ext2_group_desc_lg2size ; Get byte offset in desc table
950 xor edx,edx
951 div dword [ClustSize]
952 ; eax = block #, edx = offset in block
953 add eax,dword [SuperBlock+s_first_data_block]
954 inc eax ; s_first_data_block+1
955 mov cl,[ClustShift]
956 shl eax,cl
957 push edx
958 shr edx,SECTOR_SHIFT
959 add eax,edx
960 pop edx
961 and dx,SECTOR_SIZE-1
962 call getcachesector ; Get the group descriptor
963 add si,dx
964 mov esi,[gs:si+bg_inode_table] ; Get inode table block #
965 pop eax ; Get inode within group
966 movzx edx, word [SuperBlock+s_inode_size]
967 mul edx
968 ; edx:eax = byte offset in inode table
969 div dword [ClustSize]
970 ; eax = block # versus inode table, edx = offset in block
971 add eax,esi
972 shl eax,cl ; Turn into sector
973 push dx
974 shr edx,SECTOR_SHIFT
975 add eax,edx
976 mov [bx+file_in_sec],eax
977 pop dx
978 and dx,SECTOR_SIZE-1
979 mov [bx+file_in_off],dx
981 call getcachesector
982 add si,dx
983 mov cx,EXT2_GOOD_OLD_INODE_SIZE >> 2
984 mov di,ThisInode
985 gs rep movsd
987 mov ax,[ThisInode+i_mode]
988 mov [bx+file_mode],ax
989 mov eax,[ThisInode+i_size]
990 push eax
991 add eax,SECTOR_SIZE-1
992 shr eax,SECTOR_SHIFT
993 mov [bx+file_left],eax
994 pop eax
995 mov si,bx
996 mov edx,eax
997 shr edx,16 ; 16-bitism, sigh
998 and eax,eax ; ZF clear unless zero-length file
999 pop gs
1000 pop cx
1001 pop bx
1002 pop di
1005 section .bss
1006 alignb 4
1007 ThisInode resb EXT2_GOOD_OLD_INODE_SIZE ; The most recently opened inode
1009 section .text
1011 ; close_file:
1012 ; Deallocates a file structure (pointer in SI)
1013 ; Assumes CS == DS.
1015 close_file:
1016 and si,si
1017 jz .closed
1018 mov dword [si],0 ; First dword == file_left
1019 .closed: ret
1022 ; searchdir:
1023 ; Search the root directory for a pre-mangled filename in DS:DI.
1025 ; NOTE: This file considers finding a zero-length file an
1026 ; error. This is so we don't have to deal with that special
1027 ; case elsewhere in the program (most loops have the test
1028 ; at the end).
1030 ; If successful:
1031 ; ZF clear
1032 ; SI = file pointer
1033 ; DX:AX = EAX = file length in bytes
1034 ; If unsuccessful
1035 ; ZF set
1037 ; Assumes CS == DS == ES; *** IS THIS CORRECT ***?
1039 searchdir:
1040 push bx
1041 push cx
1042 push bp
1043 mov byte [SymlinkCtr],MAX_SYMLINKS
1045 mov eax,[CurrentDir]
1046 .begin_path:
1047 .leadingslash:
1048 cmp byte [di],'/' ; Absolute filename?
1049 jne .gotdir
1050 mov eax,EXT2_ROOT_INO
1051 inc di ; Skip slash
1052 jmp .leadingslash
1053 .gotdir:
1055 ; At this point, EAX contains the directory inode,
1056 ; and DS:DI contains a pathname tail.
1057 .open:
1058 push eax ; Save directory inode
1060 call open_inode
1061 jz .missing ; If error, done
1063 mov cx,[si+file_mode]
1064 shr cx,S_IFSHIFT ; Get file type
1066 cmp cx,T_IFDIR
1067 je .directory
1069 add sp,4 ; Drop directory inode
1071 cmp cx,T_IFREG
1072 je .file
1073 cmp cx,T_IFLNK
1074 je .symlink
1076 ; Otherwise, something bad...
1077 .err:
1078 call close_file
1079 .err_noclose:
1080 xor eax,eax
1081 xor si,si
1082 cwd ; DX <- 0
1084 .done:
1085 and eax,eax ; Set/clear ZF
1086 pop bp
1087 pop cx
1088 pop bx
1091 .missing:
1092 add sp,4 ; Drop directory inode
1093 jmp .done
1096 ; It's a file.
1098 .file:
1099 cmp byte [di],0 ; End of path?
1100 je .done ; If so, done
1101 jmp .err ; Otherwise, error
1104 ; It's a directory.
1106 .directory:
1107 pop dword [ThisDir] ; Remember what directory we're searching
1109 cmp byte [di],0 ; More path?
1110 je .err ; If not, bad
1112 .skipslash: ; Skip redundant slashes
1113 cmp byte [di],'/'
1114 jne .readdir
1115 inc di
1116 jmp .skipslash
1118 .readdir:
1119 mov bx,trackbuf
1120 push bx
1121 mov cx,[SecPerClust]
1122 call getfssec
1123 pop bx
1124 pushf ; Save EOF flag
1125 push si ; Save filesystem pointer
1126 .getent:
1127 cmp dword [bx+d_inode],0
1128 je .endblock
1130 push di
1131 movzx cx,byte [bx+d_name_len]
1132 lea si,[bx+d_name]
1133 repe cmpsb
1134 je .maybe
1135 .nope:
1136 pop di
1138 add bx,[bx+d_rec_len]
1139 jmp .getent
1141 .endblock:
1142 pop si
1143 popf
1144 jnc .readdir ; There is more
1145 jmp .err ; Otherwise badness...
1147 .maybe:
1148 mov eax,[bx+d_inode]
1150 ; Does this match the end of the requested filename?
1151 cmp byte [di],0
1152 je .finish
1153 cmp byte [di],'/'
1154 jne .nope
1156 ; We found something; now we need to open the file
1157 .finish:
1158 pop bx ; Adjust stack (di)
1159 pop si
1160 call close_file ; Close directory
1161 pop bx ; Adjust stack (flags)
1162 jmp .open
1165 ; It's a symlink. We have to determine if it's a fast symlink
1166 ; (data stored in the inode) or not (data stored as a regular
1167 ; file.) Either which way, we start from the directory
1168 ; which we just visited if relative, or from the root directory
1169 ; if absolute, and append any remaining part of the path.
1171 .symlink:
1172 dec byte [SymlinkCtr]
1173 jz .err ; Too many symlink references
1175 cmp eax,SYMLINK_SECTORS*SECTOR_SIZE
1176 jae .err ; Symlink too long
1178 ; Computation for fast symlink, as defined by ext2/3 spec
1179 xor ecx,ecx
1180 cmp [ThisInode+i_file_acl],ecx
1181 setne cl ; ECX <- i_file_acl ? 1 : 0
1182 cmp [ThisInode+i_blocks],ecx
1183 jne .slow_symlink
1185 ; It's a fast symlink
1186 .fast_symlink:
1187 call close_file ; We've got all we need
1188 mov si,ThisInode+i_block
1190 push di
1191 mov di,SymlinkTmpBuf
1192 mov ecx,eax
1193 rep movsb
1194 pop si
1196 .symlink_finish:
1197 cmp byte [si],0
1198 je .no_slash
1199 mov al,'/'
1200 stosb
1201 .no_slash:
1202 mov bp,SymlinkTmpBufEnd
1203 call strecpy
1204 jc .err_noclose ; Buffer overflow
1206 ; Now copy it to the "real" buffer; we need to have
1207 ; two buffers so we avoid overwriting the tail on the
1208 ; next copy
1209 mov si,SymlinkTmpBuf
1210 mov di,SymlinkBuf
1211 push di
1212 call strcpy
1213 pop di
1214 mov eax,[ThisDir] ; Resume searching previous directory
1215 jmp .begin_path
1217 .slow_symlink:
1218 mov bx,SymlinkTmpBuf
1219 mov cx,SYMLINK_SECTORS
1220 call getfssec
1221 ; The EOF closed the file
1223 mov si,di ; SI = filename tail
1224 mov di,SymlinkTmpBuf
1225 add di,ax ; AX = file length
1226 jmp .symlink_finish
1229 section .bss
1230 alignb 4
1231 SymlinkBuf resb SYMLINK_SECTORS*SECTOR_SIZE+64
1232 SymlinkTmpBuf equ trackbuf
1233 SymlinkTmpBufEnd equ trackbuf+SYMLINK_SECTORS*SECTOR_SIZE+64
1234 ThisDir resd 1
1235 SymlinkCtr resb 1
1237 section .text
1239 ; mangle_name: Mangle a filename pointed to by DS:SI into a buffer pointed
1240 ; to by ES:DI; ends on encountering any whitespace.
1241 ; DI is preserved.
1243 ; This verifies that a filename is < FILENAME_MAX characters,
1244 ; doesn't contain whitespace, zero-pads the output buffer,
1245 ; and removes redundant slashes,
1246 ; so "repe cmpsb" can do a compare, and the
1247 ; path-searching routine gets a bit of an easier job.
1249 ; FIX: we may want to support \-escapes here (and this would
1250 ; be the place.)
1252 mangle_name:
1253 push di
1254 push bx
1255 xor ax,ax
1256 mov cx,FILENAME_MAX-1
1257 mov bx,di
1259 .mn_loop:
1260 lodsb
1261 cmp al,' ' ; If control or space, end
1262 jna .mn_end
1263 cmp al,ah ; Repeated slash?
1264 je .mn_skip
1265 xor ah,ah
1266 cmp al,'/'
1267 jne .mn_ok
1268 mov ah,al
1269 .mn_ok stosb
1270 .mn_skip: loop .mn_loop
1271 .mn_end:
1272 cmp bx,di ; At the beginning of the buffer?
1273 jbe .mn_zero
1274 cmp byte [di-1],'/' ; Terminal slash?
1275 jne .mn_zero
1276 .mn_kill: dec di ; If so, remove it
1277 inc cx
1278 jmp short .mn_end
1279 .mn_zero:
1280 inc cx ; At least one null byte
1281 xor ax,ax ; Zero-fill name
1282 rep stosb
1283 pop bx
1284 pop di
1285 ret ; Done
1288 ; unmangle_name: Does the opposite of mangle_name; converts a DOS-mangled
1289 ; filename to the conventional representation. This is needed
1290 ; for the BOOT_IMAGE= parameter for the kernel.
1292 ; DS:SI -> input mangled file name
1293 ; ES:DI -> output buffer
1295 ; On return, DI points to the first byte after the output name,
1296 ; which is set to a null byte.
1298 unmangle_name: call strcpy
1299 dec di ; Point to final null byte
1304 ; kaboom2: once everything is loaded, replace the part of kaboom
1305 ; starting with "kaboom.patch" with this part
1307 kaboom2:
1308 mov si,err_bootfailed
1309 call cwritestr
1310 cmp byte [kaboom.again+1],18h ; INT 18h version?
1311 je .int18
1312 call getchar
1313 call vgaclearmode
1314 int 19h ; And try once more to boot...
1315 .norge: jmp short .norge ; If int 19h returned; this is the end
1316 .int18:
1317 call vgaclearmode
1318 int 18h
1319 .noreg: jmp short .noreg ; Nynorsk
1323 ; linsector: Convert a linear sector index in a file to a linear sector number
1324 ; EAX -> linear sector number
1325 ; DS:SI -> open_file_t
1327 ; Returns next sector number in EAX; CF on EOF (not an error!)
1329 linsector:
1330 push gs
1331 push ebx
1332 push esi
1333 push edi
1334 push ecx
1335 push edx
1336 push ebp
1338 push eax ; Save sector index
1339 mov cl,[ClustShift]
1340 shr eax,cl ; Convert to block number
1341 push eax
1342 mov eax,[si+file_in_sec]
1343 mov bx,si
1344 call getcachesector ; Get inode
1345 add si,[bx+file_in_off] ; Get *our* inode
1346 pop eax
1347 lea ebx,[i_block+4*eax]
1348 cmp eax,EXT2_NDIR_BLOCKS
1349 jb .direct
1350 mov ebx,i_block+4*EXT2_IND_BLOCK
1351 sub eax,EXT2_NDIR_BLOCKS
1352 mov ebp,[PtrsPerBlock1]
1353 cmp eax,ebp
1354 jb .ind1
1355 mov ebx,i_block+4*EXT2_DIND_BLOCK
1356 sub eax,ebp
1357 mov ebp,[PtrsPerBlock2]
1358 cmp eax,ebp
1359 jb .ind2
1360 mov ebx,i_block+4*EXT2_TIND_BLOCK
1361 sub eax,ebp
1363 .ind3:
1364 ; Triple indirect; eax contains the block no
1365 ; with respect to the start of the tind area;
1366 ; ebx contains the pointer to the tind block.
1367 xor edx,edx
1368 div dword [PtrsPerBlock2]
1369 ; EAX = which dind block, EDX = pointer within dind block
1370 push ax
1371 shr eax,SECTOR_SHIFT-2
1372 mov ebp,[gs:si+bx]
1373 shl ebp,cl
1374 add eax,ebp
1375 call getcachesector
1376 pop bx
1377 and bx,(SECTOR_SIZE >> 2)-1
1378 shl bx,2
1379 mov eax,edx ; The ind2 code wants the remainder...
1381 .ind2:
1382 ; Double indirect; eax contains the block no
1383 ; with respect to the start of the dind area;
1384 ; ebx contains the pointer to the dind block.
1385 xor edx,edx
1386 div dword [PtrsPerBlock1]
1387 ; EAX = which ind block, EDX = pointer within ind block
1388 push ax
1389 shr eax,SECTOR_SHIFT-2
1390 mov ebp,[gs:si+bx]
1391 shl ebp,cl
1392 add eax,ebp
1393 call getcachesector
1394 pop bx
1395 and bx,(SECTOR_SIZE >> 2)-1
1396 shl bx,2
1397 mov eax,edx ; The int1 code wants the remainder...
1399 .ind1:
1400 ; Single indirect; eax contains the block no
1401 ; with respect to the start of the ind area;
1402 ; ebx contains the pointer to the ind block.
1403 push ax
1404 shr eax,SECTOR_SHIFT-2
1405 mov ebp,[gs:si+bx]
1406 shl ebp,cl
1407 add eax,ebp
1408 call getcachesector
1409 pop bx
1410 and bx,(SECTOR_SIZE >> 2)-1
1411 shl bx,2
1413 .direct:
1414 mov ebx,[gs:bx+si] ; Get the pointer
1416 pop eax ; Get the sector index again
1417 shl ebx,cl ; Convert block number to sector
1418 and eax,[ClustMask] ; Add offset within block
1419 add eax,ebx
1421 pop ebp
1422 pop edx
1423 pop ecx
1424 pop edi
1425 pop esi
1426 pop ebx
1427 pop gs
1431 ; getfssec: Get multiple sectors from a file
1433 ; Same as above, except SI is a pointer to a open_file_t
1435 ; ES:BX -> Buffer
1436 ; DS:SI -> Pointer to open_file_t
1437 ; CX -> Sector count (0FFFFh = until end of file)
1438 ; Must not exceed the ES segment
1439 ; Returns CF=1 on EOF (not necessarily error)
1440 ; All arguments are advanced to reflect data read.
1442 getfssec:
1443 push ebp
1444 push eax
1445 push edx
1446 push edi
1448 movzx ecx,cx
1449 cmp ecx,[si] ; Number of sectors left
1450 jbe .lenok
1451 mov cx,[si]
1452 .lenok:
1453 .getfragment:
1454 mov eax,[si+file_sector] ; Current start index
1455 mov edi,eax
1456 call linsector
1457 push eax ; Fragment start sector
1458 mov edx,eax
1459 xor ebp,ebp ; Fragment sector count
1460 .getseccnt:
1461 inc bp
1462 dec cx
1463 jz .do_read
1464 xor eax,eax
1465 mov ax,es
1466 shl ax,4
1467 add ax,bx ; Now DI = how far into 64K block we are
1468 not ax ; Bytes left in 64K block
1469 inc eax
1470 shr eax,SECTOR_SHIFT ; Sectors left in 64K block
1471 cmp bp,ax
1472 jnb .do_read ; Unless there is at least 1 more sector room...
1473 inc edi ; Sector index
1474 inc edx ; Linearly next sector
1475 mov eax,edi
1476 call linsector
1477 ; jc .do_read
1478 cmp edx,eax
1479 je .getseccnt
1480 .do_read:
1481 pop eax ; Linear start sector
1482 pushad
1483 call getlinsec_ext
1484 popad
1485 push bp
1486 shl bp,9
1487 add bx,bp ; Adjust buffer pointer
1488 pop bp
1489 add [si+file_sector],ebp ; Next sector index
1490 sub [si],ebp ; Sectors consumed
1491 jcxz .done
1492 jnz .getfragment
1493 ; Fall through
1494 .done:
1495 cmp dword [si],1 ; Did we run out of file?
1496 ; CF set if [SI] < 1, i.e. == 0
1497 pop edi
1498 pop edx
1499 pop eax
1500 pop ebp
1503 ; -----------------------------------------------------------------------------
1504 ; Common modules
1505 ; -----------------------------------------------------------------------------
1507 %include "getc.inc" ; getc et al
1508 %include "conio.inc" ; Console I/O
1509 %include "plaincon.inc" ; writechr
1510 %include "writestr.inc" ; String output
1511 %include "configinit.inc" ; Initialize configuration
1512 %include "parseconfig.inc" ; High-level config file handling
1513 %include "parsecmd.inc" ; Low-level config file handling
1514 %include "bcopy32.inc" ; 32-bit bcopy
1515 %include "loadhigh.inc" ; Load a file into high memory
1516 %include "font.inc" ; VGA font stuff
1517 %include "graphics.inc" ; VGA graphics
1518 %include "highmem.inc" ; High memory sizing
1519 %include "strcpy.inc" ; strcpy()
1520 %include "strecpy.inc" ; strcpy with end pointer check
1521 %include "cache.inc" ; Metadata disk cache
1522 %include "adv.inc" ; Auxillary Data Vector
1524 ; -----------------------------------------------------------------------------
1525 ; Begin data section
1526 ; -----------------------------------------------------------------------------
1528 section .data
1529 copyright_str db ' Copyright (C) 1994-', year, ' H. Peter Anvin'
1530 db CR, LF, 0
1531 err_bootfailed db CR, LF, 'Boot failed: please change disks and press '
1532 db 'a key to continue.', CR, LF, 0
1533 config_name db 'extlinux.conf',0 ; Unmangled form
1536 ; Command line options we'd like to take a look at
1538 ; mem= and vga= are handled as normal 32-bit integer values
1539 initrd_cmd db 'initrd='
1540 initrd_cmd_len equ 7
1543 ; Config file keyword table
1545 %include "keywords.inc"
1548 ; Extensions to search for (in *forward* order).
1550 align 4, db 0
1551 exten_table: db '.cbt' ; COMBOOT (specific)
1552 db '.img' ; Disk image
1553 db '.bs', 0 ; Boot sector
1554 db '.com' ; COMBOOT (same as DOS)
1555 db '.c32' ; COM32
1556 exten_table_end:
1557 dd 0, 0 ; Need 8 null bytes here
1560 ; Misc initialized (data) variables
1562 %ifdef debug ; This code for debugging only
1563 debug_magic dw 0D00Dh ; Debug code sentinel
1564 %endif
1566 alignb 4, db 0
1567 BufSafe dw trackbufsize/SECTOR_SIZE ; Clusters we can load into trackbuf
1568 BufSafeBytes dw trackbufsize ; = how many bytes?
1569 %ifndef DEPEND
1570 %if ( trackbufsize % SECTOR_SIZE ) != 0
1571 %error trackbufsize must be a multiple of SECTOR_SIZE
1572 %endif
1573 %endif