Adding debian version 3.55-2.
[syslinux-debian/hramrach.git] / extlinux.asm
blob6666f79457fb37459a04b8e1affb482e32dc2d35
1 ; -*- fundamental -*- (asm-mode sucks)
2 ; ****************************************************************************
4 ; extlinux.asm
6 ; A program to boot Linux kernels off an ext2/ext3 filesystem.
8 ; Copyright (C) 1994-2007 H. Peter Anvin
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 at vk_seg:0000 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 4000h
80 cache_seg equ 3000h ; 64K area for metadata cache
81 vk_seg equ 2000h ; Virtual kernels
82 xfer_buf_seg equ 1000h ; Bounce buffer for I/O to high mem
83 comboot_seg equ real_mode_seg ; COMBOOT image loading zone
86 ; File structure. This holds the information for each currently open file.
88 struc open_file_t
89 file_left resd 1 ; Number of sectors left (0 = free)
90 file_sector resd 1 ; Next linear sector to read
91 file_in_sec resd 1 ; Sector where inode lives
92 file_in_off resw 1
93 file_mode resw 1
94 endstruc
96 %ifndef DEPEND
97 %if (open_file_t_size & (open_file_t_size-1))
98 %error "open_file_t is not a power of 2"
99 %endif
100 %endif
102 ; ---------------------------------------------------------------------------
103 ; BEGIN CODE
104 ; ---------------------------------------------------------------------------
107 ; Memory below this point is reserved for the BIOS and the MBR
109 section .earlybss
110 trackbufsize equ 8192
111 trackbuf resb trackbufsize ; Track buffer goes here
112 getcbuf resb trackbufsize
113 ; ends at 4800h
115 section .bss
116 SuperBlock resb 1024 ; ext2 superblock
117 SuperInfo resq 16 ; DOS superblock expanded
118 ClustSize resd 1 ; Bytes/cluster ("block")
119 SecPerClust resd 1 ; Sectors/cluster
120 ClustMask resd 1 ; Sectors/cluster - 1
121 PtrsPerBlock1 resd 1 ; Pointers/cluster
122 PtrsPerBlock2 resd 1 ; (Pointers/cluster)^2
123 DriveNumber resb 1 ; BIOS drive number
124 ClustShift resb 1 ; Shift count for sectors/cluster
125 ClustByteShift resb 1 ; Shift count for bytes/cluster
127 alignb open_file_t_size
128 Files resb MAX_OPEN*open_file_t_size
131 ; Constants for the xfer_buf_seg
133 ; The xfer_buf_seg is also used to store message file buffers. We
134 ; need two trackbuffers (text and graphics), plus a work buffer
135 ; for the graphics decompressor.
137 xbs_textbuf equ 0 ; Also hard-coded, do not change
138 xbs_vgabuf equ trackbufsize
139 xbs_vgatmpbuf equ 2*trackbufsize
142 section .text
144 ; Some of the things that have to be saved very early are saved
145 ; "close" to the initial stack pointer offset, in order to
146 ; reduce the code size...
148 StackBuf equ $-44-32 ; Start the stack here (grow down - 4K)
149 PartInfo equ StackBuf ; Saved partition table entry
150 FloppyTable equ PartInfo+16 ; Floppy info table (must follow PartInfo)
151 OrigFDCTabPtr equ StackBuf-8 ; The 2nd high dword on the stack
152 OrigESDI equ StackBuf-4 ; The high dword on the stack
155 ; Primary entry point. Tempting as though it may be, we can't put the
156 ; initial "cli" here; the jmp opcode in the first byte is part of the
157 ; "magic number" (using the term very loosely) for the DOS superblock.
159 bootsec equ $
160 jmp short start ; 2 bytes
161 nop ; 1 byte
163 ; "Superblock" follows -- it's in the boot sector, so it's already
164 ; loaded and ready for us
166 bsOemName db 'EXTLINUX' ; The SYS command sets this, so...
168 ; These are the fields we actually care about. We end up expanding them
169 ; all to dword size early in the code, so generate labels for both
170 ; the expanded and unexpanded versions.
172 %macro superb 1
173 bx %+ %1 equ SuperInfo+($-superblock)*8+4
174 bs %+ %1 equ $
175 zb 1
176 %endmacro
177 %macro superw 1
178 bx %+ %1 equ SuperInfo+($-superblock)*8
179 bs %+ %1 equ $
180 zw 1
181 %endmacro
182 %macro superd 1
183 bx %+ %1 equ $ ; no expansion for dwords
184 bs %+ %1 equ $
185 zd 1
186 %endmacro
187 superblock equ $
188 superw BytesPerSec
189 superb SecPerClust
190 superw ResSectors
191 superb FATs
192 superw RootDirEnts
193 superw Sectors
194 superb Media
195 superw FATsecs
196 superw SecPerTrack
197 superw Heads
198 superinfo_size equ ($-superblock)-1 ; How much to expand
199 superd Hidden
200 superd HugeSectors
202 ; This is as far as FAT12/16 and FAT32 are consistent
204 zb 54 ; FAT12/16 need 26 more bytes,
205 ; FAT32 need 54 more bytes
206 superblock_len equ $-superblock
209 ; Note we don't check the constraints above now; we did that at install
210 ; time (we hope!)
212 start:
213 cli ; No interrupts yet, please
214 cld ; Copy upwards
216 ; Set up the stack
218 xor ax,ax
219 mov ss,ax
220 mov sp,StackBuf ; Just below BSS
221 push es ; Save initial ES:DI -> $PnP pointer
222 push di
223 mov es,ax
225 ; DS:SI may contain a partition table entry. Preserve it for us.
227 mov cx,8 ; Save partition info
228 mov di,PartInfo
229 rep movsw
231 mov ds,ax ; Now we can initialize DS...
234 ; Now sautee the BIOS floppy info block to that it will support decent-
235 ; size transfers; the floppy block is 11 bytes and is stored in the
236 ; INT 1Eh vector (brilliant waste of resources, eh?)
238 ; Of course, if BIOSes had been properly programmed, we wouldn't have
239 ; had to waste precious space with this code.
241 mov bx,fdctab
242 lfs si,[bx] ; FS:SI -> original fdctab
243 push fs ; Save on stack in case we need to bail
244 push si
246 ; Save the old fdctab even if hard disk so the stack layout
247 ; is the same. The instructions above do not change the flags
248 mov [DriveNumber],dl ; Save drive number in DL
249 and dl,dl ; If floppy disk (00-7F), assume no
250 ; partition table
251 js harddisk
253 floppy:
254 mov cl,6 ; 12 bytes (CX == 0)
255 ; es:di -> FloppyTable already
256 ; This should be safe to do now, interrupts are off...
257 mov [bx],di ; FloppyTable
258 mov [bx+2],ax ; Segment 0
259 fs rep movsw ; Faster to move words
260 mov cl,[bsSecPerTrack] ; Patch the sector count
261 mov [di-8],cl
262 ; AX == 0 here
263 int 13h ; Some BIOSes need this
265 jmp short not_harddisk
267 ; The drive number and possibly partition information was passed to us
268 ; by the BIOS or previous boot loader (MBR). Current "best practice" is to
269 ; trust that rather than what the superblock contains.
271 ; Would it be better to zero out bsHidden if we don't have a partition table?
273 ; Note: di points to beyond the end of PartInfo
275 harddisk:
276 test byte [di-16],7Fh ; Sanity check: "active flag" should
277 jnz no_partition ; be 00 or 80
278 mov eax,[di-8] ; Partition offset (dword)
279 mov [bsHidden],eax
280 no_partition:
282 ; Get disk drive parameters (don't trust the superblock.) Don't do this for
283 ; floppy drives -- INT 13:08 on floppy drives will (may?) return info about
284 ; what the *drive* supports, not about the *media*. Fortunately floppy disks
285 ; tend to have a fixed, well-defined geometry which is stored in the superblock.
287 ; DL == drive # still
288 mov ah,08h
289 int 13h
290 jc no_driveparm
291 and ah,ah
292 jnz no_driveparm
293 shr dx,8
294 inc dx ; Contains # of heads - 1
295 mov [bsHeads],dx
296 and cx,3fh
297 mov [bsSecPerTrack],cx
298 no_driveparm:
299 not_harddisk:
301 ; Ready to enable interrupts, captain
306 ; Do we have EBIOS (EDD)?
308 eddcheck:
309 mov bx,55AAh
310 mov ah,41h ; EDD existence query
311 mov dl,[DriveNumber]
312 int 13h
313 jc .noedd
314 cmp bx,0AA55h
315 jne .noedd
316 test cl,1 ; Extended disk access functionality set
317 jz .noedd
319 ; We have EDD support...
321 mov byte [getlinsec.jmp+1],(getlinsec_ebios-(getlinsec.jmp+2))
322 .noedd:
325 ; Load the first sector of LDLINUX.SYS; this used to be all proper
326 ; with parsing the superblock and root directory; it doesn't fit
327 ; together with EBIOS support, unfortunately.
329 mov eax,[FirstSector] ; Sector start
330 mov bx,ldlinux_sys ; Where to load it
331 call getonesec
333 ; Some modicum of integrity checking
334 cmp dword [ldlinux_magic+4],LDLINUX_MAGIC^HEXDATE
335 jne kaboom
337 ; Go for it...
338 jmp ldlinux_ent
341 ; getonesec: get one disk sector
343 getonesec:
344 mov bp,1 ; One sector
345 ; Fall through
348 ; getlinsec: load a sequence of BP floppy sector given by the linear sector
349 ; number in EAX into the buffer at ES:BX. We try to optimize
350 ; by loading up to a whole track at a time, but the user
351 ; is responsible for not crossing a 64K boundary.
352 ; (Yes, BP is weird for a count, but it was available...)
354 ; On return, BX points to the first byte after the transferred
355 ; block.
357 ; This routine assumes CS == DS, and trashes most registers.
359 ; Stylistic note: use "xchg" instead of "mov" when the source is a register
360 ; that is dead from that point; this saves space. However, please keep
361 ; the order to dst,src to keep things sane.
363 getlinsec:
364 add eax,[bsHidden] ; Add partition offset
365 xor edx,edx ; Zero-extend LBA (eventually allow 64 bits)
367 .jmp: jmp strict short getlinsec_cbios
370 ; getlinsec_ebios:
372 ; getlinsec implementation for EBIOS (EDD)
374 getlinsec_ebios:
375 .loop:
376 push bp ; Sectors left
377 .retry2:
378 call maxtrans ; Enforce maximum transfer size
379 movzx edi,bp ; Sectors we are about to read
380 mov cx,retry_count
381 .retry:
383 ; Form DAPA on stack
384 push edx
385 push eax
386 push es
387 push bx
388 push di
389 push word 16
390 mov si,sp
391 pushad
392 mov dl,[DriveNumber]
393 push ds
394 push ss
395 pop ds ; DS <- SS
396 mov ah,42h ; Extended Read
397 int 13h
398 pop ds
399 popad
400 lea sp,[si+16] ; Remove DAPA
401 jc .error
402 pop bp
403 add eax,edi ; Advance sector pointer
404 sub bp,di ; Sectors left
405 shl di,SECTOR_SHIFT ; 512-byte sectors
406 add bx,di ; Advance buffer pointer
407 and bp,bp
408 jnz .loop
412 .error:
413 ; Some systems seem to get "stuck" in an error state when
414 ; using EBIOS. Doesn't happen when using CBIOS, which is
415 ; good, since some other systems get timeout failures
416 ; waiting for the floppy disk to spin up.
418 pushad ; Try resetting the device
419 xor ax,ax
420 mov dl,[DriveNumber]
421 int 13h
422 popad
423 loop .retry ; CX-- and jump if not zero
425 ;shr word [MaxTransfer],1 ; Reduce the transfer size
426 ;jnz .retry2
428 ; Total failure. Try falling back to CBIOS.
429 mov byte [getlinsec.jmp+1],(getlinsec_cbios-(getlinsec.jmp+2))
430 ;mov byte [MaxTransfer],63 ; Max possibe CBIOS transfer
432 pop bp
433 ; ... fall through ...
436 ; getlinsec_cbios:
438 ; getlinsec implementation for legacy CBIOS
440 getlinsec_cbios:
441 .loop:
442 push edx
443 push eax
444 push bp
445 push bx
447 movzx esi,word [bsSecPerTrack]
448 movzx edi,word [bsHeads]
450 ; Dividing by sectors to get (track,sector): we may have
451 ; up to 2^18 tracks, so we need to use 32-bit arithmetric.
453 div esi
454 xor cx,cx
455 xchg cx,dx ; CX <- sector index (0-based)
456 ; EDX <- 0
457 ; eax = track #
458 div edi ; Convert track to head/cyl
460 ; We should test this, but it doesn't fit...
461 ; cmp eax,1023
462 ; ja .error
465 ; Now we have AX = cyl, DX = head, CX = sector (0-based),
466 ; BP = sectors to transfer, SI = bsSecPerTrack,
467 ; ES:BX = data target
470 call maxtrans ; Enforce maximum transfer size
472 ; Must not cross track boundaries, so BP <= SI-CX
473 sub si,cx
474 cmp bp,si
475 jna .bp_ok
476 mov bp,si
477 .bp_ok:
479 shl ah,6 ; Because IBM was STOOPID
480 ; and thought 8 bits were enough
481 ; then thought 10 bits were enough...
482 inc cx ; Sector numbers are 1-based, sigh
483 or cl,ah
484 mov ch,al
485 mov dh,dl
486 mov dl,[DriveNumber]
487 xchg ax,bp ; Sector to transfer count
488 mov ah,02h ; Read sectors
489 mov bp,retry_count
490 .retry:
491 pushad
492 int 13h
493 popad
494 jc .error
495 .resume:
496 movzx ecx,al ; ECX <- sectors transferred
497 shl ax,SECTOR_SHIFT ; Convert sectors in AL to bytes in AX
498 pop bx
499 add bx,ax
500 pop bp
501 pop eax
502 pop edx
503 add eax,ecx
504 sub bp,cx
505 jnz .loop
508 .error:
509 dec bp
510 jnz .retry
512 xchg ax,bp ; Sectors transferred <- 0
513 shr word [MaxTransfer],1
514 jnz .resume
515 ; Fall through to disk_error
518 ; kaboom: write a message and bail out.
520 disk_error:
521 kaboom:
522 xor si,si
523 mov ss,si
524 mov sp,StackBuf-4 ; Reset stack
525 mov ds,si ; Reset data segment
526 pop dword [fdctab] ; Restore FDC table
527 .patch: ; When we have full code, intercept here
528 mov si,bailmsg
530 ; Write error message, this assumes screen page 0
531 .loop: lodsb
532 and al,al
533 jz .done
534 mov ah,0Eh ; Write to screen as TTY
535 mov bx,0007h ; Attribute
536 int 10h
537 jmp short .loop
538 .done:
539 cbw ; AH <- 0
540 .again: int 16h ; Wait for keypress
541 ; NB: replaced by int 18h if
542 ; chosen at install time..
543 int 19h ; And try once more to boot...
544 .norge: jmp short .norge ; If int 19h returned; this is the end
547 ; Truncate BP to MaxTransfer
549 maxtrans:
550 cmp bp,[MaxTransfer]
551 jna .ok
552 mov bp,[MaxTransfer]
553 .ok: ret
556 ; Error message on failure
558 bailmsg: db 'Boot error', 0Dh, 0Ah, 0
560 ; This fails if the boot sector overflows
561 zb 1F8h-($-$$)
563 FirstSector dd 0xDEADBEEF ; Location of sector 1
564 MaxTransfer dw 0x007F ; Max transfer size
566 ; This field will be filled in 0xAA55 by the installer, but we abuse it
567 ; to house a pointer to the INT 16h instruction at
568 ; kaboom.again, which gets patched to INT 18h in RAID mode.
569 bootsignature dw kaboom.again-bootsec
572 ; ===========================================================================
573 ; End of boot sector
574 ; ===========================================================================
575 ; Start of LDLINUX.SYS
576 ; ===========================================================================
578 ldlinux_sys:
580 syslinux_banner db 0Dh, 0Ah
581 db 'EXTLINUX '
582 db version_str, ' ', date, ' ', 0
583 db 0Dh, 0Ah, 1Ah ; EOF if we "type" this in DOS
585 align 8, db 0
586 ldlinux_magic dd LDLINUX_MAGIC
587 dd LDLINUX_MAGIC^HEXDATE
590 ; This area is patched by the installer. It is found by looking for
591 ; LDLINUX_MAGIC, plus 8 bytes.
593 patch_area:
594 LDLDwords dw 0 ; Total dwords starting at ldlinux_sys
595 LDLSectors dw 0 ; Number of sectors - (bootsec+this sec)
596 CheckSum dd 0 ; Checksum starting at ldlinux_sys
597 ; value = LDLINUX_MAGIC - [sum of dwords]
598 CurrentDir dd 2 ; "Current" directory inode number
600 ; Space for up to 64 sectors, the theoretical maximum
601 SectorPtrs times 64 dd 0
603 ldlinux_ent:
605 ; Note that some BIOSes are buggy and run the boot sector at 07C0:0000
606 ; instead of 0000:7C00 and the like. We don't want to add anything
607 ; more to the boot sector, so it is written to not assume a fixed
608 ; value in CS, but we don't want to deal with that anymore from now
609 ; on.
611 jmp 0:.next
612 .next:
615 ; Tell the user we got this far
617 mov si,syslinux_banner
618 call writestr
621 ; Tell the user if we're using EBIOS or CBIOS
623 print_bios:
624 mov si,cbios_name
625 cmp byte [getlinsec.jmp+1],(getlinsec_ebios-(getlinsec.jmp+2))
626 jne .cbios
627 mov si,ebios_name
628 .cbios:
629 mov [BIOSName],si
630 call writestr
632 section .bss
633 %define HAVE_BIOSNAME 1
634 BIOSName resw 1
636 section .text
638 ; Now we read the rest of LDLINUX.SYS. Don't bother loading the first
639 ; sector again, though.
641 load_rest:
642 mov si,SectorPtrs
643 mov bx,7C00h+2*SECTOR_SIZE ; Where we start loading
644 mov cx,[LDLSectors]
646 .get_chunk:
647 jcxz .done
648 xor bp,bp
649 lodsd ; First sector of this chunk
651 mov edx,eax
653 .make_chunk:
654 inc bp
655 dec cx
656 jz .chunk_ready
657 inc edx ; Next linear sector
658 cmp [si],edx ; Does it match
659 jnz .chunk_ready ; If not, this is it
660 add si,4 ; If so, add sector to chunk
661 jmp short .make_chunk
663 .chunk_ready:
664 call getlinsecsr
665 shl bp,SECTOR_SHIFT
666 add bx,bp
667 jmp .get_chunk
669 .done:
672 ; All loaded up, verify that we got what we needed.
673 ; Note: the checksum field is embedded in the checksum region, so
674 ; by the time we get to the end it should all cancel out.
676 verify_checksum:
677 mov si,ldlinux_sys
678 mov cx,[LDLDwords]
679 mov edx,-LDLINUX_MAGIC
680 .checksum:
681 lodsd
682 add edx,eax
683 loop .checksum
685 and edx,edx ; Should be zero
686 jz all_read ; We're cool, go for it!
689 ; Uh-oh, something went bad...
691 mov si,checksumerr_msg
692 call writestr
693 jmp kaboom
696 ; -----------------------------------------------------------------------------
697 ; Subroutines that have to be in the first sector
698 ; -----------------------------------------------------------------------------
702 ; writestr: write a null-terminated string to the console
703 ; This assumes we're on page 0. This is only used for early
704 ; messages, so it should be OK.
706 writestr:
707 .loop: lodsb
708 and al,al
709 jz .return
710 mov ah,0Eh ; Write to screen as TTY
711 mov bx,0007h ; Attribute
712 int 10h
713 jmp short .loop
714 .return: ret
717 ; getlinsecsr: save registers, call getlinsec, restore registers
719 getlinsecsr: pushad
720 call getlinsec
721 popad
725 ; Checksum error message
727 checksumerr_msg db ' Load error - ', 0 ; Boot failed appended
730 ; BIOS type string
732 cbios_name db 'CBIOS', 0
733 ebios_name db 'EBIOS', 0
736 ; Debug routine
738 %ifdef debug
739 safedumpregs:
740 cmp word [Debug_Magic],0D00Dh
741 jnz nc_return
742 jmp dumpregs
743 %endif
745 rl_checkpt equ $ ; Must be <= 8000h
747 rl_checkpt_off equ ($-$$)
748 %ifndef DEPEND
749 %if rl_checkpt_off > 400h
750 %error "Sector 1 overflow"
751 %endif
752 %endif
754 ; ----------------------------------------------------------------------------
755 ; End of code and data that have to be in the first sector
756 ; ----------------------------------------------------------------------------
758 all_read:
760 ; Let the user (and programmer!) know we got this far. This used to be
761 ; in Sector 1, but makes a lot more sense here.
763 mov si,copyright_str
764 call writestr
767 ; Insane hack to expand the DOS superblock to dwords
769 expand_super:
770 xor eax,eax
771 mov si,superblock
772 mov di,SuperInfo
773 mov cx,superinfo_size
774 .loop:
775 lodsw
776 dec si
777 stosd ; Store expanded word
778 xor ah,ah
779 stosd ; Store expanded byte
780 loop .loop
783 ; Load the real (ext2) superblock; 1024 bytes long at offset 1024
785 mov bx,SuperBlock
786 mov eax,1024 >> SECTOR_SHIFT
787 mov bp,ax
788 call getlinsec
791 ; Compute some values...
793 xor edx,edx
794 inc edx
796 ; s_log_block_size = log2(blocksize) - 10
797 mov cl,[SuperBlock+s_log_block_size]
798 add cl,10
799 mov [ClustByteShift],cl
800 mov eax,edx
801 shl eax,cl
802 mov [ClustSize],eax
804 sub cl,SECTOR_SHIFT
805 mov [ClustShift],cl
806 shr eax,SECTOR_SHIFT
807 mov [SecPerClust],eax
808 dec eax
809 mov [ClustMask],eax
811 add cl,SECTOR_SHIFT-2 ; 4 bytes/pointer
812 shl edx,cl
813 mov [PtrsPerBlock1],edx
814 shl edx,cl
815 mov [PtrsPerBlock2],edx
818 ; Common initialization code
820 %include "init.inc"
821 %include "cpuinit.inc"
824 ; Initialize the metadata cache
826 call initcache
829 ; Now, everything is "up and running"... patch kaboom for more
830 ; verbosity and using the full screen system
832 ; E9 = JMP NEAR
833 mov dword [kaboom.patch],0e9h+((kaboom2-(kaboom.patch+3)) << 8)
836 ; Now we're all set to start with our *real* business. First load the
837 ; configuration file (if any) and parse it.
839 ; In previous versions I avoided using 32-bit registers because of a
840 ; rumour some BIOSes clobbered the upper half of 32-bit registers at
841 ; random. I figure, though, that if there are any of those still left
842 ; they probably won't be trying to install Linux on them...
844 ; The code is still ripe with 16-bitisms, though. Not worth the hassle
845 ; to take'm out. In fact, we may want to put them back if we're going
846 ; to boot ELKS at some point.
850 ; Load configuration file
852 load_config:
853 mov si,config_name ; Save config file name
854 mov di,ConfigName
855 call strcpy
857 mov di,ConfigName
858 call open
859 jz no_config_file
862 ; Now we have the config file open. Parse the config file and
863 ; run the user interface.
865 %include "ui.inc"
868 ; getlinsec_ext: same as getlinsec, except load any sector from the zero
869 ; block as all zeros; use to load any data derived
870 ; from an ext2 block pointer, i.e. anything *except the
871 ; superblock.*
873 getonesec_ext:
874 mov bp,1
876 getlinsec_ext:
877 cmp eax,[SecPerClust]
878 jae getlinsec ; Nothing fancy
880 ; If we get here, at least part of what we want is in the
881 ; zero block. Zero one sector at a time and loop.
882 push eax
883 push cx
884 xchg di,bx
885 xor eax,eax
886 mov cx,SECTOR_SIZE >> 2
887 rep stosd
888 xchg di,bx
889 pop cx
890 pop eax
891 inc eax
892 dec bp
893 jnz getlinsec_ext
897 ; allocate_file: Allocate a file structure
899 ; If successful:
900 ; ZF set
901 ; BX = file pointer
902 ; In unsuccessful:
903 ; ZF clear
905 allocate_file:
906 TRACER 'a'
907 push cx
908 mov bx,Files
909 mov cx,MAX_OPEN
910 .check: cmp dword [bx], byte 0
911 je .found
912 add bx,open_file_t_size ; ZF = 0
913 loop .check
914 ; ZF = 0 if we fell out of the loop
915 .found: pop cx
918 ; open_inode:
919 ; Open a file indicated by an inode number in EAX
921 ; NOTE: This file considers finding a zero-length file an
922 ; error. This is so we don't have to deal with that special
923 ; case elsewhere in the program (most loops have the test
924 ; at the end).
926 ; If successful:
927 ; ZF clear
928 ; SI = file pointer
929 ; DX:AX = EAX = file length in bytes
930 ; ThisInode = the first 128 bytes of the inode
931 ; If unsuccessful
932 ; ZF set
934 ; Assumes CS == DS == ES.
936 open_inode.allocate_failure:
937 xor eax,eax
938 pop bx
939 pop di
942 open_inode:
943 push di
944 push bx
945 call allocate_file
946 jnz .allocate_failure
948 push cx
949 push gs
950 ; First, get the appropriate inode group and index
951 dec eax ; There is no inode 0
952 xor edx,edx
953 mov [bx+file_sector],edx
954 div dword [SuperBlock+s_inodes_per_group]
955 ; EAX = inode group; EDX = inode within group
956 push edx
958 ; Now, we need the block group descriptor.
959 ; To get that, we first need the relevant descriptor block.
961 shl eax, ext2_group_desc_lg2size ; Get byte offset in desc table
962 xor edx,edx
963 div dword [ClustSize]
964 ; eax = block #, edx = offset in block
965 add eax,dword [SuperBlock+s_first_data_block]
966 inc eax ; s_first_data_block+1
967 mov cl,[ClustShift]
968 shl eax,cl
969 push edx
970 shr edx,SECTOR_SHIFT
971 add eax,edx
972 pop edx
973 and dx,SECTOR_SIZE-1
974 call getcachesector ; Get the group descriptor
975 add si,dx
976 mov esi,[gs:si+bg_inode_table] ; Get inode table block #
977 pop eax ; Get inode within group
978 movzx edx, word [SuperBlock+s_inode_size]
979 mul edx
980 ; edx:eax = byte offset in inode table
981 div dword [ClustSize]
982 ; eax = block # versus inode table, edx = offset in block
983 add eax,esi
984 shl eax,cl ; Turn into sector
985 push dx
986 shr edx,SECTOR_SHIFT
987 add eax,edx
988 mov [bx+file_in_sec],eax
989 pop dx
990 and dx,SECTOR_SIZE-1
991 mov [bx+file_in_off],dx
993 call getcachesector
994 add si,dx
995 mov cx,EXT2_GOOD_OLD_INODE_SIZE >> 2
996 mov di,ThisInode
997 gs rep movsd
999 mov ax,[ThisInode+i_mode]
1000 mov [bx+file_mode],ax
1001 mov eax,[ThisInode+i_size]
1002 push eax
1003 add eax,SECTOR_SIZE-1
1004 shr eax,SECTOR_SHIFT
1005 mov [bx+file_left],eax
1006 pop eax
1007 mov si,bx
1008 mov edx,eax
1009 shr edx,16 ; 16-bitism, sigh
1010 and eax,eax ; ZF clear unless zero-length file
1011 pop gs
1012 pop cx
1013 pop bx
1014 pop di
1017 section .bss
1018 alignb 4
1019 ThisInode resb EXT2_GOOD_OLD_INODE_SIZE ; The most recently opened inode
1021 section .text
1023 ; close_file:
1024 ; Deallocates a file structure (pointer in SI)
1025 ; Assumes CS == DS.
1027 close_file:
1028 and si,si
1029 jz .closed
1030 mov dword [si],0 ; First dword == file_left
1031 .closed: ret
1034 ; searchdir:
1035 ; Search the root directory for a pre-mangled filename in DS:DI.
1037 ; NOTE: This file considers finding a zero-length file an
1038 ; error. This is so we don't have to deal with that special
1039 ; case elsewhere in the program (most loops have the test
1040 ; at the end).
1042 ; If successful:
1043 ; ZF clear
1044 ; SI = file pointer
1045 ; DX:AX = EAX = file length in bytes
1046 ; If unsuccessful
1047 ; ZF set
1049 ; Assumes CS == DS == ES; *** IS THIS CORRECT ***?
1051 searchdir:
1052 push bx
1053 push cx
1054 push bp
1055 mov byte [SymlinkCtr],MAX_SYMLINKS
1057 mov eax,[CurrentDir]
1058 .begin_path:
1059 .leadingslash:
1060 cmp byte [di],'/' ; Absolute filename?
1061 jne .gotdir
1062 mov eax,EXT2_ROOT_INO
1063 inc di ; Skip slash
1064 jmp .leadingslash
1065 .gotdir:
1067 ; At this point, EAX contains the directory inode,
1068 ; and DS:DI contains a pathname tail.
1069 .open:
1070 push eax ; Save directory inode
1072 call open_inode
1073 jz .done ; If error, done
1075 mov cx,[si+file_mode]
1076 shr cx,S_IFSHIFT ; Get file type
1078 cmp cx,T_IFDIR
1079 je .directory
1081 add sp,4 ; Drop directory inode
1083 cmp cx,T_IFREG
1084 je .file
1085 cmp cx,T_IFLNK
1086 je .symlink
1088 ; Otherwise, something bad...
1089 .err:
1090 call close_file
1091 .err_noclose:
1092 xor eax,eax
1093 xor si,si
1094 cwd ; DX <- 0
1096 .done:
1097 and eax,eax ; Set/clear ZF
1098 pop bp
1099 pop cx
1100 pop bx
1104 ; It's a file.
1106 .file:
1107 cmp byte [di],0 ; End of path?
1108 je .done ; If so, done
1109 jmp .err ; Otherwise, error
1112 ; It's a directory.
1114 .directory:
1115 pop dword [ThisDir] ; Remember what directory we're searching
1117 cmp byte [di],0 ; More path?
1118 je .err ; If not, bad
1120 .skipslash: ; Skip redundant slashes
1121 cmp byte [di],'/'
1122 jne .readdir
1123 inc di
1124 jmp .skipslash
1126 .readdir:
1127 mov bx,trackbuf
1128 push bx
1129 mov cx,[SecPerClust]
1130 call getfssec
1131 pop bx
1132 pushf ; Save EOF flag
1133 push si ; Save filesystem pointer
1134 .getent:
1135 cmp dword [bx+d_inode],0
1136 je .endblock
1138 push di
1139 movzx cx,byte [bx+d_name_len]
1140 lea si,[bx+d_name]
1141 repe cmpsb
1142 je .maybe
1143 .nope:
1144 pop di
1146 add bx,[bx+d_rec_len]
1147 jmp .getent
1149 .endblock:
1150 pop si
1151 popf
1152 jnc .readdir ; There is more
1153 jmp .err ; Otherwise badness...
1155 .maybe:
1156 mov eax,[bx+d_inode]
1158 ; Does this match the end of the requested filename?
1159 cmp byte [di],0
1160 je .finish
1161 cmp byte [di],'/'
1162 jne .nope
1164 ; We found something; now we need to open the file
1165 .finish:
1166 pop bx ; Adjust stack (di)
1167 pop si
1168 call close_file ; Close directory
1169 pop bx ; Adjust stack (flags)
1170 jmp .open
1173 ; It's a symlink. We have to determine if it's a fast symlink
1174 ; (data stored in the inode) or not (data stored as a regular
1175 ; file.) Either which way, we start from the directory
1176 ; which we just visited if relative, or from the root directory
1177 ; if absolute, and append any remaining part of the path.
1179 .symlink:
1180 dec byte [SymlinkCtr]
1181 jz .err ; Too many symlink references
1183 cmp eax,SYMLINK_SECTORS*SECTOR_SIZE
1184 jae .err ; Symlink too long
1186 ; Computation for fast symlink, as defined by ext2/3 spec
1187 xor ecx,ecx
1188 cmp [ThisInode+i_file_acl],ecx
1189 setne cl ; ECX <- i_file_acl ? 1 : 0
1190 cmp [ThisInode+i_blocks],ecx
1191 jne .slow_symlink
1193 ; It's a fast symlink
1194 .fast_symlink:
1195 call close_file ; We've got all we need
1196 mov si,ThisInode+i_block
1198 push di
1199 mov di,SymlinkTmpBuf
1200 mov ecx,eax
1201 rep movsb
1202 pop si
1204 .symlink_finish:
1205 cmp byte [si],0
1206 je .no_slash
1207 mov al,'/'
1208 stosb
1209 .no_slash:
1210 mov bp,SymlinkTmpBufEnd
1211 call strecpy
1212 jc .err_noclose ; Buffer overflow
1214 ; Now copy it to the "real" buffer; we need to have
1215 ; two buffers so we avoid overwriting the tail on the
1216 ; next copy
1217 mov si,SymlinkTmpBuf
1218 mov di,SymlinkBuf
1219 push di
1220 call strcpy
1221 pop di
1222 mov eax,[ThisDir] ; Resume searching previous directory
1223 jmp .begin_path
1225 .slow_symlink:
1226 mov bx,SymlinkTmpBuf
1227 mov cx,SYMLINK_SECTORS
1228 call getfssec
1229 ; The EOF closed the file
1231 mov si,di ; SI = filename tail
1232 mov di,SymlinkTmpBuf
1233 add di,ax ; AX = file length
1234 jmp .symlink_finish
1237 section .bss
1238 alignb 4
1239 SymlinkBuf resb SYMLINK_SECTORS*SECTOR_SIZE+64
1240 SymlinkTmpBuf equ trackbuf
1241 SymlinkTmpBufEnd equ trackbuf+SYMLINK_SECTORS*SECTOR_SIZE+64
1242 ThisDir resd 1
1243 SymlinkCtr resb 1
1245 section .text
1247 ; mangle_name: Mangle a filename pointed to by DS:SI into a buffer pointed
1248 ; to by ES:DI; ends on encountering any whitespace.
1249 ; DI is preserved.
1251 ; This verifies that a filename is < FILENAME_MAX characters,
1252 ; doesn't contain whitespace, zero-pads the output buffer,
1253 ; and removes redundant slashes,
1254 ; so "repe cmpsb" can do a compare, and the
1255 ; path-searching routine gets a bit of an easier job.
1257 ; FIX: we may want to support \-escapes here (and this would
1258 ; be the place.)
1260 mangle_name:
1261 push di
1262 push bx
1263 xor ax,ax
1264 mov cx,FILENAME_MAX-1
1265 mov bx,di
1267 .mn_loop:
1268 lodsb
1269 cmp al,' ' ; If control or space, end
1270 jna .mn_end
1271 cmp al,ah ; Repeated slash?
1272 je .mn_skip
1273 xor ah,ah
1274 cmp al,'/'
1275 jne .mn_ok
1276 mov ah,al
1277 .mn_ok stosb
1278 .mn_skip: loop .mn_loop
1279 .mn_end:
1280 cmp bx,di ; At the beginning of the buffer?
1281 jbe .mn_zero
1282 cmp byte [di-1],'/' ; Terminal slash?
1283 jne .mn_zero
1284 .mn_kill: dec di ; If so, remove it
1285 inc cx
1286 jmp short .mn_end
1287 .mn_zero:
1288 inc cx ; At least one null byte
1289 xor ax,ax ; Zero-fill name
1290 rep stosb
1291 pop bx
1292 pop di
1293 ret ; Done
1296 ; unmangle_name: Does the opposite of mangle_name; converts a DOS-mangled
1297 ; filename to the conventional representation. This is needed
1298 ; for the BOOT_IMAGE= parameter for the kernel.
1299 ; NOTE: A 13-byte buffer is mandatory, even if the string is
1300 ; known to be shorter.
1302 ; DS:SI -> input mangled file name
1303 ; ES:DI -> output buffer
1305 ; On return, DI points to the first byte after the output name,
1306 ; which is set to a null byte.
1308 unmangle_name: call strcpy
1309 dec di ; Point to final null byte
1314 ; kaboom2: once everything is loaded, replace the part of kaboom
1315 ; starting with "kaboom.patch" with this part
1317 kaboom2:
1318 mov si,err_bootfailed
1319 call cwritestr
1320 cmp byte [kaboom.again+1],18h ; INT 18h version?
1321 je .int18
1322 call getchar
1323 call vgaclearmode
1324 int 19h ; And try once more to boot...
1325 .norge: jmp short .norge ; If int 19h returned; this is the end
1326 .int18:
1327 call vgaclearmode
1328 int 18h
1329 .noreg: jmp short .noreg ; Nynorsk
1333 ; linsector: Convert a linear sector index in a file to a linear sector number
1334 ; EAX -> linear sector number
1335 ; DS:SI -> open_file_t
1337 ; Returns next sector number in EAX; CF on EOF (not an error!)
1339 linsector:
1340 push gs
1341 push ebx
1342 push esi
1343 push edi
1344 push ecx
1345 push edx
1346 push ebp
1348 push eax ; Save sector index
1349 mov cl,[ClustShift]
1350 shr eax,cl ; Convert to block number
1351 push eax
1352 mov eax,[si+file_in_sec]
1353 mov bx,si
1354 call getcachesector ; Get inode
1355 add si,[bx+file_in_off] ; Get *our* inode
1356 pop eax
1357 lea ebx,[i_block+4*eax]
1358 cmp eax,EXT2_NDIR_BLOCKS
1359 jb .direct
1360 mov ebx,i_block+4*EXT2_IND_BLOCK
1361 sub eax,EXT2_NDIR_BLOCKS
1362 mov ebp,[PtrsPerBlock1]
1363 cmp eax,ebp
1364 jb .ind1
1365 mov ebx,i_block+4*EXT2_DIND_BLOCK
1366 sub eax,ebp
1367 mov ebp,[PtrsPerBlock2]
1368 cmp eax,ebp
1369 jb .ind2
1370 mov ebx,i_block+4*EXT2_TIND_BLOCK
1371 sub eax,ebp
1373 .ind3:
1374 ; Triple indirect; eax contains the block no
1375 ; with respect to the start of the tind area;
1376 ; ebx contains the pointer to the tind block.
1377 xor edx,edx
1378 div dword [PtrsPerBlock2]
1379 ; EAX = which dind block, EDX = pointer within dind block
1380 push ax
1381 shr eax,SECTOR_SHIFT-2
1382 mov ebp,[gs:si+bx]
1383 shl ebp,cl
1384 add eax,ebp
1385 call getcachesector
1386 pop bx
1387 and bx,(SECTOR_SIZE >> 2)-1
1388 shl bx,2
1389 mov eax,edx ; The ind2 code wants the remainder...
1391 .ind2:
1392 ; Double indirect; eax contains the block no
1393 ; with respect to the start of the dind area;
1394 ; ebx contains the pointer to the dind block.
1395 xor edx,edx
1396 div dword [PtrsPerBlock1]
1397 ; EAX = which ind block, EDX = pointer within ind block
1398 push ax
1399 shr eax,SECTOR_SHIFT-2
1400 mov ebp,[gs:si+bx]
1401 shl ebp,cl
1402 add eax,ebp
1403 call getcachesector
1404 pop bx
1405 and bx,(SECTOR_SIZE >> 2)-1
1406 shl bx,2
1407 mov eax,edx ; The int1 code wants the remainder...
1409 .ind1:
1410 ; Single indirect; eax contains the block no
1411 ; with respect to the start of the ind area;
1412 ; ebx contains the pointer to the ind block.
1413 push ax
1414 shr eax,SECTOR_SHIFT-2
1415 mov ebp,[gs:si+bx]
1416 shl ebp,cl
1417 add eax,ebp
1418 call getcachesector
1419 pop bx
1420 and bx,(SECTOR_SIZE >> 2)-1
1421 shl bx,2
1423 .direct:
1424 mov ebx,[gs:bx+si] ; Get the pointer
1426 pop eax ; Get the sector index again
1427 shl ebx,cl ; Convert block number to sector
1428 and eax,[ClustMask] ; Add offset within block
1429 add eax,ebx
1431 pop ebp
1432 pop edx
1433 pop ecx
1434 pop edi
1435 pop esi
1436 pop ebx
1437 pop gs
1441 ; getfssec: Get multiple sectors from a file
1443 ; Same as above, except SI is a pointer to a open_file_t
1445 ; ES:BX -> Buffer
1446 ; DS:SI -> Pointer to open_file_t
1447 ; CX -> Sector count (0FFFFh = until end of file)
1448 ; Must not exceed the ES segment
1449 ; Returns CF=1 on EOF (not necessarily error)
1450 ; All arguments are advanced to reflect data read.
1452 getfssec:
1453 push ebp
1454 push eax
1455 push edx
1456 push edi
1458 movzx ecx,cx
1459 cmp ecx,[si] ; Number of sectors left
1460 jbe .lenok
1461 mov cx,[si]
1462 .lenok:
1463 .getfragment:
1464 mov eax,[si+file_sector] ; Current start index
1465 mov edi,eax
1466 call linsector
1467 push eax ; Fragment start sector
1468 mov edx,eax
1469 xor ebp,ebp ; Fragment sector count
1470 .getseccnt:
1471 inc bp
1472 dec cx
1473 jz .do_read
1474 xor eax,eax
1475 mov ax,es
1476 shl ax,4
1477 add ax,bx ; Now DI = how far into 64K block we are
1478 not ax ; Bytes left in 64K block
1479 inc eax
1480 shr eax,SECTOR_SHIFT ; Sectors left in 64K block
1481 cmp bp,ax
1482 jnb .do_read ; Unless there is at least 1 more sector room...
1483 inc edi ; Sector index
1484 inc edx ; Linearly next sector
1485 mov eax,edi
1486 call linsector
1487 ; jc .do_read
1488 cmp edx,eax
1489 je .getseccnt
1490 .do_read:
1491 pop eax ; Linear start sector
1492 pushad
1493 call getlinsec_ext
1494 popad
1495 push bp
1496 shl bp,9
1497 add bx,bp ; Adjust buffer pointer
1498 pop bp
1499 add [si+file_sector],ebp ; Next sector index
1500 sub [si],ebp ; Sectors consumed
1501 jcxz .done
1502 jnz .getfragment
1503 ; Fall through
1504 .done:
1505 cmp dword [si],1 ; Did we run out of file?
1506 ; CF set if [SI] < 1, i.e. == 0
1507 pop edi
1508 pop edx
1509 pop eax
1510 pop ebp
1513 ; -----------------------------------------------------------------------------
1514 ; Common modules
1515 ; -----------------------------------------------------------------------------
1517 %include "getc.inc" ; getc et al
1518 %include "conio.inc" ; Console I/O
1519 %include "plaincon.inc" ; writechr
1520 %include "writestr.inc" ; String output
1521 %include "configinit.inc" ; Initialize configuration
1522 %include "parseconfig.inc" ; High-level config file handling
1523 %include "parsecmd.inc" ; Low-level config file handling
1524 %include "bcopy32.inc" ; 32-bit bcopy
1525 %include "loadhigh.inc" ; Load a file into high memory
1526 %include "font.inc" ; VGA font stuff
1527 %include "graphics.inc" ; VGA graphics
1528 %include "highmem.inc" ; High memory sizing
1529 %include "strcpy.inc" ; strcpy()
1530 %include "strecpy.inc" ; strcpy with end pointer check
1531 %include "cache.inc"
1533 ; -----------------------------------------------------------------------------
1534 ; Begin data section
1535 ; -----------------------------------------------------------------------------
1537 section .data
1538 copyright_str db ' Copyright (C) 1994-', year, ' H. Peter Anvin'
1539 db CR, LF, 0
1540 err_bootfailed db CR, LF, 'Boot failed: please change disks and press '
1541 db 'a key to continue.', CR, LF, 0
1542 config_name db 'extlinux.conf',0 ; Unmangled form
1545 ; Command line options we'd like to take a look at
1547 ; mem= and vga= are handled as normal 32-bit integer values
1548 initrd_cmd db 'initrd='
1549 initrd_cmd_len equ 7
1552 ; Config file keyword table
1554 %include "keywords.inc"
1557 ; Extensions to search for (in *forward* order).
1559 align 4, db 0
1560 exten_table: db '.cbt' ; COMBOOT (specific)
1561 db '.img' ; Disk image
1562 db '.bs', 0 ; Boot sector
1563 db '.com' ; COMBOOT (same as DOS)
1564 db '.c32' ; COM32
1565 exten_table_end:
1566 dd 0, 0 ; Need 8 null bytes here
1569 ; Misc initialized (data) variables
1571 %ifdef debug ; This code for debugging only
1572 debug_magic dw 0D00Dh ; Debug code sentinel
1573 %endif
1575 alignb 4, db 0
1576 BufSafe dw trackbufsize/SECTOR_SIZE ; Clusters we can load into trackbuf
1577 BufSafeBytes dw trackbufsize ; = how many bytes?
1578 %ifndef DEPEND
1579 %if ( trackbufsize % SECTOR_SIZE ) != 0
1580 %error trackbufsize must be a multiple of SECTOR_SIZE
1581 %endif
1582 %endif