Use $(CC) in gcc_ok macro, not plain gcc
[syslinux.git] / ldlinux.asm
blob0f063154d862e55db125f56e0dd683d3a01076db
1 ; -*- fundamental -*- (asm-mode sucks)
2 ; ****************************************************************************
4 ; ldlinux.asm
6 ; A program to boot Linux kernels off an MS-DOS formatted floppy disk. This
7 ; functionality is good to have for installation floppies, where it may
8 ; be hard to find a functional Linux system to run LILO off.
10 ; This program allows manipulation of the disk to take place entirely
11 ; from MS-LOSS, and can be especially useful in conjunction with the
12 ; umsdos filesystem.
14 ; Copyright 1994-2008 H. Peter Anvin - All Rights Reserved
16 ; This program is free software; you can redistribute it and/or modify
17 ; it under the terms of the GNU General Public License as published by
18 ; the Free Software Foundation, Inc., 53 Temple Place Ste 330,
19 ; Boston MA 02111-1307, USA; either version 2 of the License, or
20 ; (at your option) any later version; incorporated herein by reference.
22 ; ****************************************************************************
24 %ifndef IS_MDSLINUX
25 %define IS_SYSLINUX 1
26 %endif
27 %include "head.inc"
30 ; Some semi-configurable constants... change on your own risk.
32 my_id equ syslinux_id
33 FILENAME_MAX_LG2 equ 6 ; log2(Max filename size Including final null)
34 FILENAME_MAX equ (1<<FILENAME_MAX_LG2) ; Max mangled filename size
35 NULLFILE equ 0 ; First char space == null filename
36 NULLOFFSET equ 0 ; Position in which to look
37 retry_count equ 16 ; How patient are we with the disk?
38 %assign HIGHMEM_SLOP 0 ; Avoid this much memory near the top
39 LDLINUX_MAGIC equ 0x3eb202fe ; A random number to identify ourselves with
41 MAX_OPEN_LG2 equ 6 ; log2(Max number of open files)
42 MAX_OPEN equ (1 << MAX_OPEN_LG2)
44 SECTOR_SHIFT equ 9
45 SECTOR_SIZE equ (1 << SECTOR_SHIFT)
48 ; This is what we need to do when idle
50 %macro RESET_IDLE 0
51 ; Nothing
52 %endmacro
53 %macro DO_IDLE 0
54 ; Nothing
55 %endmacro
58 ; The following structure is used for "virtual kernels"; i.e. LILO-style
59 ; option labels. The options we permit here are `kernel' and `append
60 ; Since there is no room in the bottom 64K for all of these, we
61 ; stick them in high memory and copy them down before we need them.
63 struc vkernel
64 vk_vname: resb FILENAME_MAX ; Virtual name **MUST BE FIRST!**
65 vk_rname: resb FILENAME_MAX ; Real name
66 vk_appendlen: resw 1
67 vk_type: resb 1 ; Type of file
68 alignb 4
69 vk_append: resb max_cmd_len+1 ; Command line
70 alignb 4
71 vk_end: equ $ ; Should be <= vk_size
72 endstruc
75 ; Segment assignments in the bottom 640K
76 ; Stick to the low 512K in case we're using something like M-systems flash
77 ; which load a driver into low RAM (evil!!)
79 ; 0000h - main code/data segment (and BIOS segment)
81 real_mode_seg equ 3000h
82 cache_seg equ 2000h ; 64K area for metadata cache
83 xfer_buf_seg equ 1000h ; Bounce buffer for I/O to high mem
84 comboot_seg equ real_mode_seg ; COMBOOT image loading zone
87 ; File structure. This holds the information for each currently open file.
89 struc open_file_t
90 file_sector resd 1 ; Sector pointer (0 = structure free)
91 file_left resd 1 ; Number of sectors left
92 endstruc
94 %ifndef DEPEND
95 %if (open_file_t_size & (open_file_t_size-1))
96 %error "open_file_t is not a power of 2"
97 %endif
98 %endif
100 ; ---------------------------------------------------------------------------
101 ; BEGIN CODE
102 ; ---------------------------------------------------------------------------
105 ; Memory below this point is reserved for the BIOS and the MBR
107 section .earlybss
108 trackbufsize equ 8192
109 trackbuf resb trackbufsize ; Track buffer goes here
110 ; ends at 2800h
112 section .bss
113 alignb 8
115 ; Expanded superblock
116 SuperInfo equ $
117 resq 16 ; The first 16 bytes expanded 8 times
118 FAT resd 1 ; Location of (first) FAT
119 RootDirArea resd 1 ; Location of root directory area
120 RootDir resd 1 ; Location of root directory proper
121 DataArea resd 1 ; Location of data area
122 RootDirSize resd 1 ; Root dir size in sectors
123 TotalSectors resd 1 ; Total number of sectors
124 ClustSize resd 1 ; Bytes/cluster
125 ClustMask resd 1 ; Sectors/cluster - 1
126 CopySuper resb 1 ; Distinguish .bs versus .bss
127 DriveNumber resb 1 ; BIOS drive number
128 ClustShift resb 1 ; Shift count for sectors/cluster
129 ClustByteShift resb 1 ; Shift count for bytes/cluster
131 alignb open_file_t_size
132 Files resb MAX_OPEN*open_file_t_size
134 section .text
136 ; Some of the things that have to be saved very early are saved
137 ; "close" to the initial stack pointer offset, in order to
138 ; reduce the code size...
140 StackBuf equ $-44-32 ; Start the stack here (grow down - 4K)
141 PartInfo equ StackBuf ; Saved partition table entry
142 FloppyTable equ PartInfo+16 ; Floppy info table (must follow PartInfo)
143 OrigFDCTabPtr equ StackBuf-8 ; The 2nd high dword on the stack
144 OrigESDI equ StackBuf-4 ; The high dword on the stack
147 ; Primary entry point. Tempting as though it may be, we can't put the
148 ; initial "cli" here; the jmp opcode in the first byte is part of the
149 ; "magic number" (using the term very loosely) for the DOS superblock.
151 bootsec equ $
152 jmp short start ; 2 bytes
153 nop ; 1 byte
155 ; "Superblock" follows -- it's in the boot sector, so it's already
156 ; loaded and ready for us
158 bsOemName db 'SYSLINUX' ; The SYS command sets this, so...
160 ; These are the fields we actually care about. We end up expanding them
161 ; all to dword size early in the code, so generate labels for both
162 ; the expanded and unexpanded versions.
164 %macro superb 1
165 bx %+ %1 equ SuperInfo+($-superblock)*8+4
166 bs %+ %1 equ $
167 zb 1
168 %endmacro
169 %macro superw 1
170 bx %+ %1 equ SuperInfo+($-superblock)*8
171 bs %+ %1 equ $
172 zw 1
173 %endmacro
174 %macro superd 1
175 bx %+ %1 equ $ ; no expansion for dwords
176 bs %+ %1 equ $
177 zd 1
178 %endmacro
179 superblock equ $
180 superw BytesPerSec
181 superb SecPerClust
182 superw ResSectors
183 superb FATs
184 superw RootDirEnts
185 superw Sectors
186 superb Media
187 superw FATsecs
188 superw SecPerTrack
189 superw Heads
190 superinfo_size equ ($-superblock)-1 ; How much to expand
191 superd Hidden
192 superd HugeSectors
194 ; This is as far as FAT12/16 and FAT32 are consistent
196 zb 54 ; FAT12/16 need 26 more bytes,
197 ; FAT32 need 54 more bytes
198 superblock_len equ $-superblock
200 SecPerClust equ bxSecPerClust
202 ; Note we don't check the constraints above now; we did that at install
203 ; time (we hope!)
205 start:
206 cli ; No interrupts yet, please
207 cld ; Copy upwards
209 ; Set up the stack
211 xor ax,ax
212 mov ss,ax
213 mov sp,StackBuf ; Just below BSS
214 push es ; Save initial ES:DI -> $PnP pointer
215 push di
216 mov es,ax
218 ; DS:SI may contain a partition table entry. Preserve it for us.
220 mov cx,8 ; Save partition info
221 mov di,PartInfo
222 rep movsw
224 mov ds,ax ; Now we can initialize DS...
227 ; Now sautee the BIOS floppy info block to that it will support decent-
228 ; size transfers; the floppy block is 11 bytes and is stored in the
229 ; INT 1Eh vector (brilliant waste of resources, eh?)
231 ; Of course, if BIOSes had been properly programmed, we wouldn't have
232 ; had to waste precious space with this code.
234 mov bx,fdctab
235 lfs si,[bx] ; FS:SI -> original fdctab
236 push fs ; Save on stack in case we need to bail
237 push si
239 ; Save the old fdctab even if hard disk so the stack layout
240 ; is the same. The instructions above do not change the flags
241 mov [DriveNumber],dl ; Save drive number in DL
242 and dl,dl ; If floppy disk (00-7F), assume no
243 ; partition table
244 js harddisk
246 floppy:
247 mov cl,6 ; 12 bytes (CX == 0)
248 ; es:di -> FloppyTable already
249 ; This should be safe to do now, interrupts are off...
250 mov [bx],di ; FloppyTable
251 mov [bx+2],ax ; Segment 0
252 fs rep movsw ; Faster to move words
253 mov cl,[bsSecPerTrack] ; Patch the sector count
254 mov [di-8],cl
255 ; AX == 0 here
256 int 13h ; Some BIOSes need this
258 jmp short not_harddisk
260 ; The drive number and possibly partition information was passed to us
261 ; by the BIOS or previous boot loader (MBR). Current "best practice" is to
262 ; trust that rather than what the superblock contains.
264 ; Would it be better to zero out bsHidden if we don't have a partition table?
266 ; Note: di points to beyond the end of PartInfo
268 harddisk:
269 test byte [di-16],7Fh ; Sanity check: "active flag" should
270 jnz no_partition ; be 00 or 80
271 mov eax,[di-8] ; Partition offset (dword)
272 mov [bsHidden],eax
273 no_partition:
275 ; Get disk drive parameters (don't trust the superblock.) Don't do this for
276 ; floppy drives -- INT 13:08 on floppy drives will (may?) return info about
277 ; what the *drive* supports, not about the *media*. Fortunately floppy disks
278 ; tend to have a fixed, well-defined geometry which is stored in the superblock.
280 ; DL == drive # still
281 mov ah,08h
282 int 13h
283 jc no_driveparm
284 and ah,ah
285 jnz no_driveparm
286 shr dx,8
287 inc dx ; Contains # of heads - 1
288 mov [bsHeads],dx
289 and cx,3fh
290 mov [bsSecPerTrack],cx
291 no_driveparm:
292 not_harddisk:
294 ; Ready to enable interrupts, captain
299 ; Do we have EBIOS (EDD)?
301 eddcheck:
302 mov bx,55AAh
303 mov ah,41h ; EDD existence query
304 mov dl,[DriveNumber]
305 int 13h
306 jc .noedd
307 cmp bx,0AA55h
308 jne .noedd
309 test cl,1 ; Extended disk access functionality set
310 jz .noedd
312 ; We have EDD support...
314 mov byte [getlinsec.jmp+1],(getlinsec_ebios-(getlinsec.jmp+2))
315 .noedd:
318 ; Load the first sector of LDLINUX.SYS; this used to be all proper
319 ; with parsing the superblock and root directory; it doesn't fit
320 ; together with EBIOS support, unfortunately.
322 mov eax,[FirstSector] ; Sector start
323 mov bx,ldlinux_sys ; Where to load it
324 call getonesec
326 ; Some modicum of integrity checking
327 cmp dword [ldlinux_magic+4],LDLINUX_MAGIC^HEXDATE
328 jne kaboom
330 ; Go for it...
331 jmp ldlinux_ent
334 ; getonesec: get one disk sector
336 getonesec:
337 mov bp,1 ; One sector
338 ; Fall through
341 ; getlinsec: load a sequence of BP floppy sector given by the linear sector
342 ; number in EAX into the buffer at ES:BX. We try to optimize
343 ; by loading up to a whole track at a time, but the user
344 ; is responsible for not crossing a 64K boundary.
345 ; (Yes, BP is weird for a count, but it was available...)
347 ; On return, BX points to the first byte after the transferred
348 ; block.
350 ; This routine assumes CS == DS, and trashes most registers.
352 ; Stylistic note: use "xchg" instead of "mov" when the source is a register
353 ; that is dead from that point; this saves space. However, please keep
354 ; the order to dst,src to keep things sane.
356 getlinsec:
357 add eax,[bsHidden] ; Add partition offset
358 xor edx,edx ; Zero-extend LBA (eventually allow 64 bits)
360 .jmp: jmp strict short getlinsec_cbios
363 ; getlinsec_ebios:
365 ; getlinsec implementation for EBIOS (EDD)
367 getlinsec_ebios:
368 .loop:
369 push bp ; Sectors left
370 .retry2:
371 call maxtrans ; Enforce maximum transfer size
372 movzx edi,bp ; Sectors we are about to read
373 mov cx,retry_count
374 .retry:
376 ; Form DAPA on stack
377 push edx
378 push eax
379 push es
380 push bx
381 push di
382 push word 16
383 mov si,sp
384 pushad
385 mov dl,[DriveNumber]
386 push ds
387 push ss
388 pop ds ; DS <- SS
389 mov ah,42h ; Extended Read
390 int 13h
391 pop ds
392 popad
393 lea sp,[si+16] ; Remove DAPA
394 jc .error
395 pop bp
396 add eax,edi ; Advance sector pointer
397 sub bp,di ; Sectors left
398 shl di,SECTOR_SHIFT ; 512-byte sectors
399 add bx,di ; Advance buffer pointer
400 and bp,bp
401 jnz .loop
405 .error:
406 ; Some systems seem to get "stuck" in an error state when
407 ; using EBIOS. Doesn't happen when using CBIOS, which is
408 ; good, since some other systems get timeout failures
409 ; waiting for the floppy disk to spin up.
411 pushad ; Try resetting the device
412 xor ax,ax
413 mov dl,[DriveNumber]
414 int 13h
415 popad
416 loop .retry ; CX-- and jump if not zero
418 ;shr word [MaxTransfer],1 ; Reduce the transfer size
419 ;jnz .retry2
421 ; Total failure. Try falling back to CBIOS.
422 mov byte [getlinsec.jmp+1],(getlinsec_cbios-(getlinsec.jmp+2))
423 ;mov byte [MaxTransfer],63 ; Max possibe CBIOS transfer
425 pop bp
426 ; ... fall through ...
429 ; getlinsec_cbios:
431 ; getlinsec implementation for legacy CBIOS
433 getlinsec_cbios:
434 .loop:
435 push edx
436 push eax
437 push bp
438 push bx
440 movzx esi,word [bsSecPerTrack]
441 movzx edi,word [bsHeads]
443 ; Dividing by sectors to get (track,sector): we may have
444 ; up to 2^18 tracks, so we need to use 32-bit arithmetric.
446 div esi
447 xor cx,cx
448 xchg cx,dx ; CX <- sector index (0-based)
449 ; EDX <- 0
450 ; eax = track #
451 div edi ; Convert track to head/cyl
453 ; We should test this, but it doesn't fit...
454 ; cmp eax,1023
455 ; ja .error
458 ; Now we have AX = cyl, DX = head, CX = sector (0-based),
459 ; BP = sectors to transfer, SI = bsSecPerTrack,
460 ; ES:BX = data target
463 call maxtrans ; Enforce maximum transfer size
465 ; Must not cross track boundaries, so BP <= SI-CX
466 sub si,cx
467 cmp bp,si
468 jna .bp_ok
469 mov bp,si
470 .bp_ok:
472 shl ah,6 ; Because IBM was STOOPID
473 ; and thought 8 bits were enough
474 ; then thought 10 bits were enough...
475 inc cx ; Sector numbers are 1-based, sigh
476 or cl,ah
477 mov ch,al
478 mov dh,dl
479 mov dl,[DriveNumber]
480 xchg ax,bp ; Sector to transfer count
481 mov ah,02h ; Read sectors
482 mov bp,retry_count
483 .retry:
484 pushad
485 int 13h
486 popad
487 jc .error
488 .resume:
489 movzx ecx,al ; ECX <- sectors transferred
490 shl ax,SECTOR_SHIFT ; Convert sectors in AL to bytes in AX
491 pop bx
492 add bx,ax
493 pop bp
494 pop eax
495 pop edx
496 add eax,ecx
497 sub bp,cx
498 jnz .loop
501 .error:
502 dec bp
503 jnz .retry
505 xchg ax,bp ; Sectors transferred <- 0
506 shr word [MaxTransfer],1
507 jnz .resume
508 ; Fall through to disk_error
511 ; kaboom: write a message and bail out.
513 disk_error:
514 kaboom:
515 xor si,si
516 mov ss,si
517 mov sp,StackBuf-4 ; Reset stack
518 mov ds,si ; Reset data segment
519 pop dword [fdctab] ; Restore FDC table
520 .patch: ; When we have full code, intercept here
521 mov si,bailmsg
523 ; Write error message, this assumes screen page 0
524 .loop: lodsb
525 and al,al
526 jz .done
527 mov ah,0Eh ; Write to screen as TTY
528 mov bx,0007h ; Attribute
529 int 10h
530 jmp short .loop
531 .done:
532 cbw ; AH <- 0
533 .again: int 16h ; Wait for keypress
534 ; NB: replaced by int 18h if
535 ; chosen at install time..
536 int 19h ; And try once more to boot...
537 .norge: jmp short .norge ; If int 19h returned; this is the end
540 ; Truncate BP to MaxTransfer
542 maxtrans:
543 cmp bp,[MaxTransfer]
544 jna .ok
545 mov bp,[MaxTransfer]
546 .ok: ret
549 ; Error message on failure
551 bailmsg: db 'Boot error', 0Dh, 0Ah, 0
553 ; This fails if the boot sector overflows
554 zb 1F8h-($-$$)
556 FirstSector dd 0xDEADBEEF ; Location of sector 1
557 MaxTransfer dw 0x007F ; Max transfer size
559 ; This field will be filled in 0xAA55 by the installer, but we abuse it
560 ; to house a pointer to the INT 16h instruction at
561 ; kaboom.again, which gets patched to INT 18h in RAID mode.
562 bootsignature dw kaboom.again-bootsec
565 ; ===========================================================================
566 ; End of boot sector
567 ; ===========================================================================
568 ; Start of LDLINUX.SYS
569 ; ===========================================================================
571 ldlinux_sys:
573 syslinux_banner db 0Dh, 0Ah
574 %if IS_MDSLINUX
575 db 'MDSLINUX '
576 %else
577 db 'SYSLINUX '
578 %endif
579 db version_str, ' ', date, ' ', 0
580 db 0Dh, 0Ah, 1Ah ; EOF if we "type" this in DOS
582 align 8, db 0
583 ldlinux_magic dd LDLINUX_MAGIC
584 dd LDLINUX_MAGIC^HEXDATE
587 ; This area is patched by the installer. It is found by looking for
588 ; LDLINUX_MAGIC, plus 8 bytes.
590 patch_area:
591 LDLDwords dw 0 ; Total dwords starting at ldlinux_sys
592 LDLSectors dw 0 ; Number of sectors - (bootsec+this sec)
593 CheckSum dd 0 ; Checksum starting at ldlinux_sys
594 ; value = LDLINUX_MAGIC - [sum of dwords]
596 ; Space for up to 64 sectors, the theoretical maximum
597 SectorPtrs times 64 dd 0
599 ldlinux_ent:
601 ; Note that some BIOSes are buggy and run the boot sector at 07C0:0000
602 ; instead of 0000:7C00 and the like. We don't want to add anything
603 ; more to the boot sector, so it is written to not assume a fixed
604 ; value in CS, but we don't want to deal with that anymore from now
605 ; on.
607 jmp 0:.next
608 .next:
611 ; Tell the user we got this far
613 mov si,syslinux_banner
614 call writestr
617 ; Tell the user if we're using EBIOS or CBIOS
619 print_bios:
620 mov si,cbios_name
621 cmp byte [getlinsec.jmp+1],(getlinsec_ebios-(getlinsec.jmp+2))
622 jne .cbios
623 mov si,ebios_name
624 .cbios:
625 mov [BIOSName],si
626 call writestr
628 section .bss
629 %define HAVE_BIOSNAME 1
630 BIOSName resw 1
632 section .text
634 ; Now we read the rest of LDLINUX.SYS. Don't bother loading the first
635 ; sector again, though.
637 load_rest:
638 mov si,SectorPtrs
639 mov bx,7C00h+2*SECTOR_SIZE ; Where we start loading
640 mov cx,[LDLSectors]
642 .get_chunk:
643 jcxz .done
644 xor bp,bp
645 lodsd ; First sector of this chunk
647 mov edx,eax
649 .make_chunk:
650 inc bp
651 dec cx
652 jz .chunk_ready
653 inc edx ; Next linear sector
654 cmp [si],edx ; Does it match
655 jnz .chunk_ready ; If not, this is it
656 add si,4 ; If so, add sector to chunk
657 jmp short .make_chunk
659 .chunk_ready:
660 call getlinsecsr
661 shl bp,SECTOR_SHIFT
662 add bx,bp
663 jmp .get_chunk
665 .done:
668 ; All loaded up, verify that we got what we needed.
669 ; Note: the checksum field is embedded in the checksum region, so
670 ; by the time we get to the end it should all cancel out.
672 verify_checksum:
673 mov si,ldlinux_sys
674 mov cx,[LDLDwords]
675 mov edx,-LDLINUX_MAGIC
676 .checksum:
677 lodsd
678 add edx,eax
679 loop .checksum
681 and edx,edx ; Should be zero
682 jz all_read ; We're cool, go for it!
685 ; Uh-oh, something went bad...
687 mov si,checksumerr_msg
688 call writestr
689 jmp kaboom
692 ; -----------------------------------------------------------------------------
693 ; Subroutines that have to be in the first sector
694 ; -----------------------------------------------------------------------------
698 ; writestr: write a null-terminated string to the console
699 ; This assumes we're on page 0. This is only used for early
700 ; messages, so it should be OK.
702 writestr:
703 .loop: lodsb
704 and al,al
705 jz .return
706 mov ah,0Eh ; Write to screen as TTY
707 mov bx,0007h ; Attribute
708 int 10h
709 jmp short .loop
710 .return: ret
713 ; getlinsecsr: save registers, call getlinsec, restore registers
715 getlinsecsr: pushad
716 call getlinsec
717 popad
721 ; Checksum error message
723 checksumerr_msg db ' Load error - ', 0 ; Boot failed appended
726 ; BIOS type string
728 cbios_name db 'CBIOS', 0
729 ebios_name db 'EBIOS', 0
732 ; Debug routine
734 %ifdef debug
735 safedumpregs:
736 cmp word [Debug_Magic],0D00Dh
737 jnz nc_return
738 jmp dumpregs
739 %endif
741 rl_checkpt equ $ ; Must be <= 8000h
743 rl_checkpt_off equ ($-$$)
744 %ifndef DEPEND
745 %if rl_checkpt_off > 400h
746 %error "Sector 1 overflow"
747 %endif
748 %endif
750 ; ----------------------------------------------------------------------------
751 ; End of code and data that have to be in the first sector
752 ; ----------------------------------------------------------------------------
754 all_read:
756 ; Let the user (and programmer!) know we got this far. This used to be
757 ; in Sector 1, but makes a lot more sense here.
759 mov si,copyright_str
760 call writestr
764 ; Insane hack to expand the superblock to dwords
766 expand_super:
767 xor eax,eax
768 mov si,superblock
769 mov di,SuperInfo
770 mov cx,superinfo_size
771 .loop:
772 lodsw
773 dec si
774 stosd ; Store expanded word
775 xor ah,ah
776 stosd ; Store expanded byte
777 loop .loop
780 ; Compute some information about this filesystem.
783 ; First, generate the map of regions
784 genfatinfo:
785 mov edx,[bxSectors]
786 and dx,dx
787 jnz .have_secs
788 mov edx,[bsHugeSectors]
789 .have_secs:
790 mov [TotalSectors],edx
792 mov eax,[bxResSectors]
793 mov [FAT],eax ; Beginning of FAT
794 mov edx,[bxFATsecs]
795 and dx,dx
796 jnz .have_fatsecs
797 mov edx,[bootsec+36] ; FAT32 BPB_FATsz32
798 .have_fatsecs:
799 imul edx,[bxFATs]
800 add eax,edx
801 mov [RootDirArea],eax ; Beginning of root directory
802 mov [RootDir],eax ; For FAT12/16 == root dir location
804 mov edx,[bxRootDirEnts]
805 add dx,SECTOR_SIZE/32-1
806 shr dx,SECTOR_SHIFT-5
807 mov [RootDirSize],edx
808 add eax,edx
809 mov [DataArea],eax ; Beginning of data area
811 ; Next, generate a cluster size shift count and mask
812 mov eax,[bxSecPerClust]
813 bsr cx,ax
814 mov [ClustShift],cl
815 push cx
816 add cl,SECTOR_SHIFT
817 mov [ClustByteShift],cl
818 pop cx
819 dec ax
820 mov [ClustMask],eax
821 inc ax
822 shl eax,SECTOR_SHIFT
823 mov [ClustSize],eax
826 ; FAT12, FAT16 or FAT28^H^H32? This computation is fscking ridiculous.
828 getfattype:
829 mov eax,[TotalSectors]
830 sub eax,[DataArea]
831 shr eax,cl ; cl == ClustShift
832 mov cl,nextcluster_fat12-(nextcluster+2)
833 cmp eax,4085 ; FAT12 limit
834 jb .setsize
835 mov cl,nextcluster_fat16-(nextcluster+2)
836 cmp eax,65525 ; FAT16 limit
837 jb .setsize
839 ; FAT32, root directory is a cluster chain
841 mov cl,[ClustShift]
842 mov eax,[bootsec+44] ; Root directory cluster
843 sub eax,2
844 shl eax,cl
845 add eax,[DataArea]
846 mov [RootDir],eax
847 mov cl,nextcluster_fat28-(nextcluster+2)
848 .setsize:
849 mov byte [nextcluster+1],cl
852 ; Common initialization code
854 %include "cpuinit.inc"
855 %include "init.inc"
858 ; Initialize the metadata cache
860 call initcache
863 ; Now, everything is "up and running"... patch kaboom for more
864 ; verbosity and using the full screen system
866 ; E9 = JMP NEAR
867 mov dword [kaboom.patch],0e9h+((kaboom2-(kaboom.patch+3)) << 8)
870 ; Now we're all set to start with our *real* business. First load the
871 ; configuration file (if any) and parse it.
873 ; In previous versions I avoided using 32-bit registers because of a
874 ; rumour some BIOSes clobbered the upper half of 32-bit registers at
875 ; random. I figure, though, that if there are any of those still left
876 ; they probably won't be trying to install Linux on them...
878 ; The code is still ripe with 16-bitisms, though. Not worth the hassle
879 ; to take'm out. In fact, we may want to put them back if we're going
880 ; to boot ELKS at some point.
884 ; Load configuration file
886 mov si,config_name ; Save configuration file name
887 mov di,ConfigName
888 call strcpy
890 mov di,syslinux_cfg1
891 call open
892 jnz .config_open
893 mov di,syslinux_cfg2
894 call open
895 jnz .config_open
896 mov di,syslinux_cfg3
897 call open
898 jz no_config_file
899 .config_open:
900 mov eax,[PrevDir] ; Make the directory with syslinux.cfg ...
901 mov [CurrentDir],eax ; ... the current directory
904 ; Now we have the config file open. Parse the config file and
905 ; run the user interface.
907 %include "ui.inc"
910 ; allocate_file: Allocate a file structure
912 ; If successful:
913 ; ZF set
914 ; BX = file pointer
915 ; In unsuccessful:
916 ; ZF clear
918 allocate_file:
919 TRACER 'a'
920 push cx
921 mov bx,Files
922 mov cx,MAX_OPEN
923 .check: cmp dword [bx], byte 0
924 je .found
925 add bx,open_file_t_size ; ZF = 0
926 loop .check
927 ; ZF = 0 if we fell out of the loop
928 .found: pop cx
932 ; search_dos_dir:
933 ; Search a specific directory for a pre-mangled filename in
934 ; MangledBuf, in the directory starting in sector EAX.
936 ; NOTE: This file considers finding a zero-length file an
937 ; error. This is so we don't have to deal with that special
938 ; case elsewhere in the program (most loops have the test
939 ; at the end).
941 ; Assumes DS == ES == CS.
943 ; If successful:
944 ; ZF clear
945 ; SI = file pointer
946 ; EAX = file length (MAY BE ZERO!)
947 ; DL = file attributes
948 ; If unsuccessful
949 ; ZF set
952 search_dos_dir:
953 push bx
954 call allocate_file
955 jnz .alloc_failure
957 push cx
958 push gs
959 push es
960 push ds
961 pop es ; ES = DS
963 .scansector:
964 ; EAX <- directory sector to scan
965 call getcachesector
966 ; GS:SI now points to this sector
968 mov cx,SECTOR_SIZE/32 ; 32 == directory entry size
969 .scanentry:
970 cmp byte [gs:si],0
971 jz .failure ; Hit directory high water mark
972 test byte [gs:si+11],8 ; Ignore volume labels and
973 ; VFAT long filename entries
974 jnz .nomatch
975 push cx
976 push si
977 push di
978 mov di,MangledBuf
979 mov cx,11
980 gs repe cmpsb
981 pop di
982 pop si
983 pop cx
984 jz .found
985 .nomatch:
986 add si,32
987 loop .scanentry
989 call nextsector
990 jnc .scansector ; CF is set if we're at end
992 ; If we get here, we failed
993 .failure:
994 pop es
995 pop gs
996 pop cx
997 .alloc_failure:
998 pop bx
999 xor eax,eax ; ZF <- 1
1001 .found:
1002 mov eax,[gs:si+28] ; File size
1003 add eax,SECTOR_SIZE-1
1004 shr eax,SECTOR_SHIFT
1005 mov [bx+4],eax ; Sector count
1007 mov cl,[ClustShift]
1008 mov dx,[gs:si+20] ; High cluster word
1009 shl edx,16
1010 mov dx,[gs:si+26] ; Low cluster word
1011 sub edx,2
1012 shl edx,cl
1013 add edx,[DataArea]
1014 mov [bx],edx ; Starting sector
1016 mov eax,[gs:si+28] ; File length again
1017 mov dl,[gs:si+11] ; File attribute
1018 mov si,bx ; File pointer...
1019 and si,si ; ZF <- 0
1021 pop es
1022 pop gs
1023 pop cx
1024 pop bx
1028 ; close_file:
1029 ; Deallocates a file structure (pointer in SI)
1030 ; Assumes CS == DS.
1032 close_file:
1033 and si,si
1034 jz .closed
1035 mov dword [si],0 ; First dword == file_left
1036 .closed: ret
1039 ; searchdir:
1041 ; Open a file
1043 ; On entry:
1044 ; DS:DI = filename
1045 ; If successful:
1046 ; ZF clear
1047 ; SI = file pointer
1048 ; DX:AX or EAX = file length in bytes
1049 ; If unsuccessful
1050 ; ZF set
1052 ; Assumes CS == DS == ES, and trashes BX and CX.
1054 searchdir:
1055 mov eax,[CurrentDir]
1056 cmp byte [di],'/' ; Root directory?
1057 jne .notroot
1058 mov eax,[RootDir]
1059 inc di
1060 .notroot:
1062 .pathwalk:
1063 push eax ; <A> Current directory sector
1064 mov si,di
1065 .findend:
1066 lodsb
1067 cmp al,' '
1068 jbe .endpath
1069 cmp al,'/'
1070 jne .findend
1071 .endpath:
1072 xchg si,di
1073 pop eax ; <A> Current directory sector
1075 mov [PrevDir],eax ; Remember last directory searched
1077 push di
1078 call mangle_dos_name ; MangledBuf <- component
1079 call search_dos_dir
1080 pop di
1081 jz .notfound ; Pathname component missing
1083 cmp byte [di-1],'/' ; Do we expect a directory
1084 je .isdir
1086 ; Otherwise, it should be a file
1087 .isfile:
1088 test dl,18h ; Subdirectory|Volume Label
1089 jnz .badfile ; If not a file, it's a bad thing
1091 ; SI and EAX are already set
1092 mov edx,eax
1093 shr edx,16 ; Old 16-bit remnant...
1094 and eax,eax ; EAX != 0
1095 jz .badfile
1096 ret ; Done!
1098 ; If we expected a directory, it better be one...
1099 .isdir:
1100 test dl,10h ; Subdirectory
1101 jz .badfile
1103 xor eax,eax
1104 xchg eax,[si+file_sector] ; Get sector number and free file structure
1105 jmp .pathwalk ; Walk the next bit of the path
1107 .badfile:
1108 xor eax,eax
1109 mov [si],eax ; Free file structure
1111 .notfound:
1112 xor eax,eax
1113 xor dx,dx
1116 section .bss
1117 alignb 4
1118 CurrentDir resd 1 ; Current directory
1119 PrevDir resd 1 ; Last scanned directory
1121 section .text
1125 ; kaboom2: once everything is loaded, replace the part of kaboom
1126 ; starting with "kaboom.patch" with this part
1128 kaboom2:
1129 mov si,err_bootfailed
1130 call cwritestr
1131 cmp byte [kaboom.again+1],18h ; INT 18h version?
1132 je .int18
1133 call getchar
1134 call vgaclearmode
1135 int 19h ; And try once more to boot...
1136 .norge: jmp short .norge ; If int 19h returned; this is the end
1137 .int18:
1138 call vgaclearmode
1139 int 18h
1140 .noreg: jmp short .noreg ; Nynorsk
1143 ; mangle_name: Mangle a filename pointed to by DS:SI into a buffer pointed
1144 ; to by ES:DI; ends on encountering any whitespace.
1145 ; DI is preserved.
1147 ; This verifies that a filename is < FILENAME_MAX characters,
1148 ; doesn't contain whitespace, zero-pads the output buffer,
1149 ; and removes trailing dots and redundant slashes, plus changes
1150 ; backslashes to forward slashes,
1151 ; so "repe cmpsb" can do a compare, and the path-searching routine
1152 ; gets a bit of an easier job.
1155 mangle_name:
1156 push di
1157 push bx
1158 xor ax,ax
1159 mov cx,FILENAME_MAX-1
1160 mov bx,di
1162 .mn_loop:
1163 lodsb
1164 cmp al,' ' ; If control or space, end
1165 jna .mn_end
1166 cmp al,'\' ; Backslash?
1167 jne .mn_not_bs
1168 mov al,'/' ; Change to forward slash
1169 .mn_not_bs:
1170 cmp al,ah ; Repeated slash?
1171 je .mn_skip
1172 xor ah,ah
1173 cmp al,'/'
1174 jne .mn_ok
1175 mov ah,al
1176 .mn_ok stosb
1177 .mn_skip: loop .mn_loop
1178 .mn_end:
1179 cmp bx,di ; At the beginning of the buffer?
1180 jbe .mn_zero
1181 cmp byte [es:di-1],'.' ; Terminal dot?
1182 je .mn_kill
1183 cmp byte [es:di-1],'/' ; Terminal slash?
1184 jne .mn_zero
1185 .mn_kill: dec di ; If so, remove it
1186 inc cx
1187 jmp short .mn_end
1188 .mn_zero:
1189 inc cx ; At least one null byte
1190 xor ax,ax ; Zero-fill name
1191 rep stosb
1192 pop bx
1193 pop di
1194 ret ; Done
1197 ; unmangle_name: Does the opposite of mangle_name; converts a DOS-mangled
1198 ; filename to the conventional representation. This is needed
1199 ; for the BOOT_IMAGE= parameter for the kernel.
1200 ; NOTE: A 13-byte buffer is mandatory, even if the string is
1201 ; known to be shorter.
1203 ; DS:SI -> input mangled file name
1204 ; ES:DI -> output buffer
1206 ; On return, DI points to the first byte after the output name,
1207 ; which is set to a null byte.
1209 unmangle_name: call strcpy
1210 dec di ; Point to final null byte
1214 ; mangle_dos_name:
1215 ; Mangle a DOS filename component pointed to by DS:SI
1216 ; into [MangledBuf]; ends on encountering any whitespace or slash.
1217 ; Assumes CS == DS == ES.
1220 mangle_dos_name:
1221 pusha
1222 mov di,MangledBuf
1224 mov cx,11 ; # of bytes to write
1225 .loop:
1226 lodsb
1227 cmp al,' ' ; If control or space, end
1228 jna .end
1229 cmp al,'/' ; Slash, too
1230 je .end
1231 cmp al,'.' ; Period -> space-fill
1232 je .is_period
1233 cmp al,'a'
1234 jb .not_lower
1235 cmp al,'z'
1236 ja .not_uslower
1237 sub al,020h
1238 jmp short .not_lower
1239 .is_period: mov al,' ' ; We need to space-fill
1240 .period_loop: cmp cx,3 ; If <= 3 characters left
1241 jbe .loop ; Just ignore it
1242 stosb ; Otherwise, write a period
1243 loop .period_loop ; Dec CX and (always) jump
1244 .not_uslower: cmp al,ucase_low
1245 jb .not_lower
1246 cmp al,ucase_high
1247 ja .not_lower
1248 mov bx,ucase_tab-ucase_low
1249 xlatb
1250 .not_lower: stosb
1251 loop .loop ; Don't continue if too long
1252 .end:
1253 mov al,' ' ; Space-fill name
1254 rep stosb ; Doesn't do anything if CX=0
1255 popa
1256 ret ; Done
1258 section .bss
1259 MangledBuf resb 11
1261 section .text
1263 ; Case tables for extended characters; this is technically code page 865,
1264 ; but code page 437 users will probably not miss not being able to use the
1265 ; cent sign in kernel images too much :-)
1267 ; The table only covers the range 129 to 164; the rest we can deal with.
1269 section .data
1271 ucase_low equ 129
1272 ucase_high equ 164
1273 ucase_tab db 154, 144, 'A', 142, 'A', 143, 128, 'EEEIII'
1274 db 142, 143, 144, 146, 146, 'O', 153, 'OUUY', 153, 154
1275 db 157, 156, 157, 158, 159, 'AIOU', 165
1277 section .text
1279 ; getfssec_edx: Get multiple sectors from a file
1281 ; This routine makes sure the subtransfers do not cross a 64K boundary,
1282 ; and will correct the situation if it does, UNLESS *sectors* cross
1283 ; 64K boundaries.
1285 ; ES:BX -> Buffer
1286 ; EDX -> Current sector number
1287 ; CX -> Sector count (0FFFFh = until end of file)
1288 ; Must not exceed the ES segment
1289 ; Returns EDX=0, CF=1 on EOF (not necessarily error)
1290 ; All arguments are advanced to reflect data read.
1292 getfssec_edx:
1293 push ebp
1294 push eax
1295 .getfragment:
1296 xor ebp,ebp ; Fragment sector count
1297 push edx ; Starting sector pointer
1298 .getseccnt:
1299 inc bp
1300 dec cx
1301 jz .do_read
1302 xor eax,eax
1303 mov ax,es
1304 shl ax,4
1305 add ax,bx ; Now AX = how far into 64K block we are
1306 not ax ; Bytes left in 64K block
1307 inc eax
1308 shr eax,SECTOR_SHIFT ; Sectors left in 64K block
1309 cmp bp,ax
1310 jnb .do_read ; Unless there is at least 1 more sector room...
1311 mov eax,edx ; Current sector
1312 inc edx ; Predict it's the linearly next sector
1313 call nextsector
1314 jc .do_read
1315 cmp edx,eax ; Did it match?
1316 jz .getseccnt
1317 .do_read:
1318 pop eax ; Starting sector pointer
1319 call getlinsecsr
1320 lea eax,[eax+ebp-1] ; This is the last sector actually read
1321 shl bp,9
1322 add bx,bp ; Adjust buffer pointer
1323 call nextsector
1324 jc .eof
1325 mov edx,eax
1326 and cx,cx
1327 jnz .getfragment
1328 .done:
1329 pop eax
1330 pop ebp
1332 .eof:
1333 xor edx,edx
1335 jmp .done
1338 ; getfssec: Get multiple sectors from a file
1340 ; Same as above, except SI is a pointer to a open_file_t
1342 ; ES:BX -> Buffer
1343 ; DS:SI -> Pointer to open_file_t
1344 ; CX -> Sector count (0FFFFh = until end of file)
1345 ; Must not exceed the ES segment
1346 ; Returns CF=1 on EOF (not necessarily error)
1347 ; All arguments are advanced to reflect data read.
1349 getfssec:
1350 push edx
1351 movzx edx,cx
1352 cmp edx,[si+4]
1353 jbe .sizeok
1354 mov edx,[si+4]
1355 mov cx,dx
1356 .sizeok:
1357 sub [si+4],edx
1358 mov edx,[si]
1359 call getfssec_edx
1360 mov [si],edx
1361 pop edx
1365 ; nextcluster: Advance a cluster pointer in EDI to the next cluster
1366 ; pointed at in the FAT tables. CF=0 on return if end of file.
1368 nextcluster:
1369 jmp strict short nextcluster_fat28 ; This gets patched
1371 nextcluster_fat12:
1372 push eax
1373 push edx
1374 push bx
1375 push cx
1376 push si
1377 mov edx,edi
1378 shr edi,1
1379 pushf ; Save the shifted-out LSB (=CF)
1380 add edx,edi
1381 mov eax,edx
1382 shr eax,9
1383 call getfatsector
1384 mov bx,dx
1385 and bx,1FFh
1386 mov cl,[gs:si+bx]
1387 inc edx
1388 mov eax,edx
1389 shr eax,9
1390 call getfatsector
1391 mov bx,dx
1392 and bx,1FFh
1393 mov ch,[gs:si+bx]
1394 popf
1395 jnc .even
1396 shr cx,4
1397 .even: and cx,0FFFh
1398 movzx edi,cx
1399 cmp di,0FF0h
1400 pop si
1401 pop cx
1402 pop bx
1403 pop edx
1404 pop eax
1408 ; FAT16 decoding routine.
1410 nextcluster_fat16:
1411 push eax
1412 push si
1413 push bx
1414 mov eax,edi
1415 shr eax,SECTOR_SHIFT-1
1416 call getfatsector
1417 mov bx,di
1418 add bx,bx
1419 and bx,1FEh
1420 movzx edi,word [gs:si+bx]
1421 cmp di,0FFF0h
1422 pop bx
1423 pop si
1424 pop eax
1427 ; FAT28 ("FAT32") decoding routine.
1429 nextcluster_fat28:
1430 push eax
1431 push si
1432 push bx
1433 mov eax,edi
1434 shr eax,SECTOR_SHIFT-2
1435 call getfatsector
1436 mov bx,di
1437 add bx,bx
1438 add bx,bx
1439 and bx,1FCh
1440 mov edi,dword [gs:si+bx]
1441 and edi,0FFFFFFFh ; 28 bits only
1442 cmp edi,0FFFFFF0h
1443 pop bx
1444 pop si
1445 pop eax
1449 ; nextsector: Given a sector in EAX on input, return the next sector
1450 ; of the same filesystem object, which may be the root
1451 ; directory or a cluster chain. Returns EOF.
1453 ; Assumes CS == DS.
1455 nextsector:
1456 push edi
1457 push edx
1458 mov edx,[DataArea]
1459 mov edi,eax
1460 sub edi,edx
1461 jae .isdata
1463 ; Root directory
1464 inc eax
1465 cmp eax,edx
1467 jmp .done
1469 .isdata:
1470 not edi
1471 test edi,[ClustMask]
1472 jz .endcluster
1474 ; It's not the final sector in a cluster
1475 inc eax
1476 jmp .done
1478 .endcluster:
1479 push gs ; nextcluster trashes gs
1480 push cx
1481 not edi
1482 mov cl,[ClustShift]
1483 shr edi,cl
1484 add edi,2
1486 ; Now EDI contains the cluster number
1487 call nextcluster
1489 jc .exit ; There isn't anything else...
1491 ; New cluster number now in EDI
1492 sub edi,2
1493 shl edi,cl ; CF <- 0, unless something is very wrong
1494 lea eax,[edi+edx]
1495 .exit:
1496 pop cx
1497 pop gs
1498 .done:
1499 pop edx
1500 pop edi
1504 ; getfatsector: Check for a particular sector (in EAX) in the FAT cache,
1505 ; and return a pointer in GS:SI, loading it if needed.
1507 ; Assumes CS == DS.
1509 getfatsector:
1510 add eax,[FAT] ; FAT starting address
1511 jmp getcachesector
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 "cache.inc" ; Metadata disk cache
1531 %include "adv.inc" ; Auxillary Data Vector
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 syslinux_cfg1 db '/boot' ; /boot/syslinux/syslinux.cfg
1543 syslinux_cfg2 db '/syslinux' ; /syslinux/syslinux.cfg
1544 syslinux_cfg3 db '/' ; /syslinux.cfg
1545 config_name db 'syslinux.cfg', 0 ; syslinux.cfg
1548 ; Command line options we'd like to take a look at
1550 ; mem= and vga= are handled as normal 32-bit integer values
1551 initrd_cmd db 'initrd='
1552 initrd_cmd_len equ 7
1555 ; Config file keyword table
1557 %include "keywords.inc"
1560 ; Extensions to search for (in *forward* order).
1562 exten_table: db '.cbt' ; COMBOOT (specific)
1563 db '.bss' ; Boot Sector (add superblock)
1564 db '.bs', 0 ; Boot Sector
1565 db '.com' ; COMBOOT (same as DOS)
1566 db '.c32' ; COM32
1567 exten_table_end:
1568 dd 0, 0 ; Need 8 null bytes here
1571 ; Misc initialized (data) variables
1573 %ifdef debug ; This code for debugging only
1574 debug_magic dw 0D00Dh ; Debug code sentinel
1575 %endif
1577 alignb 4, db 0
1578 BufSafe dw trackbufsize/SECTOR_SIZE ; Clusters we can load into trackbuf
1579 BufSafeBytes dw trackbufsize ; = how many bytes?
1580 %ifndef DEPEND
1581 %if ( trackbufsize % SECTOR_SIZE ) != 0
1582 %error trackbufsize must be a multiple of SECTOR_SIZE
1583 %endif
1584 %endif