More fixes to the extlinux installer; change back to writable types
[profile/ivi/syslinux.git] / extlinux.asm
1 ; -*- fundamental -*- (asm-mode sucks)
2 ; $Id$
3 ; ****************************************************************************
4 ;
5 ;  extlinux.asm
6 ;
7 ;  A program to boot Linux kernels off an ext2/ext3 filesystem.
8 ;
9 ;   Copyright (C) 1994-2004  H. Peter Anvin
10 ;
11 ;  This program is free software; you can redistribute it and/or modify
12 ;  it under the terms of the GNU General Public License as published by
13 ;  the Free Software Foundation, Inc., 53 Temple Place Ste 330,
14 ;  Boston MA 02111-1307, USA; either version 2 of the License, or
15 ;  (at your option) any later version; incorporated herein by reference.
16
17 ; ****************************************************************************
18
19 %define IS_EXTLINUX 1
20 %include "macros.inc"
21 %include "config.inc"
22 %include "kernel.inc"
23 %include "bios.inc"
24 %include "tracers.inc"
25
26 %include "ext2_fs.inc"
27
28 ;
29 ; Some semi-configurable constants... change on your own risk.
30 ;
31 my_id           equ extlinux_id
32 FILENAME_MAX_LG2 equ 8                  ; log2(Max filename size Including final null)
33 FILENAME_MAX    equ (1 << FILENAME_MAX) ; Max mangled filename size
34 NULLFILE        equ ' '                 ; First char space == null filename
35 retry_count     equ 6                   ; How patient are we with the disk?
36 %assign HIGHMEM_SLOP 0                  ; Avoid this much memory near the top
37 LDLINUX_MAGIC   equ 0x3eb202fe          ; A random number to identify ourselves with
38
39 MAX_OPEN_LG2    equ 6                   ; log2(Max number of open files)
40 MAX_OPEN        equ (1 << MAX_OPEN_LG2)
41
42 SECTOR_SHIFT    equ 9
43 SECTOR_SIZE     equ (1 << SECTOR_SHIFT)
44
45 ;
46 ; This is what we need to do when idle
47 ;
48 %macro  RESET_IDLE 0
49         ; Nothing
50 %endmacro
51 %macro  DO_IDLE 0
52         ; Nothing
53 %endmacro
54
55 ;
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.
60 ;
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                 alignb 4
66 vk_append:      resb max_cmd_len+1      ; Command line
67                 alignb 4
68 vk_end:         equ $                   ; Should be <= vk_size
69                 endstruc
70
71 ;
72 ; Segment assignments in the bottom 640K
73 ; Stick to the low 512K in case we're using something like M-systems flash
74 ; which load a driver into low RAM (evil!!)
75 ;
76 ; 0000h - main code/data segment (and BIOS segment)
77 ;
78 real_mode_seg   equ 4000h
79 cache_seg       equ 3000h               ; 64K area for metadata cache
80 vk_seg          equ 2000h               ; Virtual kernels
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
83
84 ;
85 ; File structure.  This holds the information for each currently open file.
86 ;
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                 resw 1
93                 endstruc
94
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
100
101 ; ---------------------------------------------------------------------------
102 ;   BEGIN CODE
103 ; ---------------------------------------------------------------------------
104
105 ;
106 ; Memory below this point is reserved for the BIOS and the MBR
107 ;
108 BSS_START       equ 1000h
109                 section .bss start=BSS_START
110 trackbufsize    equ 8192
111 trackbuf        resb trackbufsize       ; Track buffer goes here
112 getcbuf         resb trackbufsize
113                 ; ends at 5000h
114
115 SuperBlock      resb 1024               ; ext2 superblock
116 SuperInfo       resd 16                 ; DOS superblock expanded
117 ClustSize       resd 1                  ; Bytes/cluster ("block")
118 SecPerClust     resd 1                  ; Sectors/cluster
119 ClustMask       resd 1                  ; Sectors/cluster - 1
120 PtrsPerBlock1   resd 1                  ; Pointers/cluster
121 PtrsPerBlock2   resd 1                  ; (Pointers/cluster)^2
122 PtrsPerBlock3   resd 1                  ; (Pointers/cluster)^3
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
126
127                 alignb open_file_t_size
128 Files           resb MAX_OPEN*open_file_t_size
129
130 ;
131 ; Constants for the xfer_buf_seg
132 ;
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.
136 ;
137 xbs_textbuf     equ 0                   ; Also hard-coded, do not change
138 xbs_vgabuf      equ trackbufsize
139 xbs_vgatmpbuf   equ 2*trackbufsize
140
141
142                 section .text
143                 org 7C00h
144 ;
145 ; Some of the things that have to be saved very early are saved
146 ; "close" to the initial stack pointer offset, in order to
147 ; reduce the code size...
148 ;
149 StackBuf        equ $-44-32             ; Start the stack here (grow down - 4K)
150 PartInfo        equ StackBuf            ; Saved partition table entry
151 FloppyTable     equ PartInfo+16         ; Floppy info table (must follow PartInfo)
152 OrigFDCTabPtr   equ StackBuf-4          ; The high dword on the stack
153
154 ;
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.
158 ;
159 bootsec         equ $
160                 jmp short start         ; 2 bytes
161                 nop                     ; 1 byte
162 ;
163 ; "Superblock" follows -- it's in the boot sector, so it's already
164 ; loaded and ready for us
165 ;
166 bsOemName       db 'EXTLINUX'           ; The SYS command sets this, so...
167 ;
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.
171 ;
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
201                 ;
202                 ; This is as far as FAT12/16 and FAT32 are consistent
203                 ;
204                 zb 54                   ; FAT12/16 need 26 more bytes,
205                                         ; FAT32 need 54 more bytes
206 superblock_len  equ $-superblock
207
208 ;
209 ; Note we don't check the constraints above now; we did that at install
210 ; time (we hope!)
211 ;
212 start:
213                 cli                     ; No interrupts yet, please
214                 cld                     ; Copy upwards
215 ;
216 ; Set up the stack
217 ;
218                 xor ax,ax
219                 mov ss,ax
220                 mov sp,StackBuf         ; Just below BSS
221                 mov es,ax
222 ;
223 ; DS:SI may contain a partition table entry.  Preserve it for us.
224 ;
225                 mov cx,8                ; Save partition info
226                 mov di,sp
227                 rep movsw
228
229                 mov ds,ax               ; Now we can initialize DS...
230
231 ;
232 ; Now sautee the BIOS floppy info block to that it will support decent-
233 ; size transfers; the floppy block is 11 bytes and is stored in the
234 ; INT 1Eh vector (brilliant waste of resources, eh?)
235 ;
236 ; Of course, if BIOSes had been properly programmed, we wouldn't have
237 ; had to waste precious space with this code.
238 ;
239                 mov bx,fdctab
240                 lfs si,[bx]             ; FS:SI -> original fdctab
241                 push fs                 ; Save on stack in case we need to bail
242                 push si
243
244                 ; Save the old fdctab even if hard disk so the stack layout
245                 ; is the same.  The instructions above do not change the flags
246                 mov [DriveNumber],dl    ; Save drive number in DL
247                 and dl,dl               ; If floppy disk (00-7F), assume no
248                                         ; partition table
249                 js harddisk
250
251 floppy:
252                 mov cl,6                ; 12 bytes (CX == 0)
253                 ; es:di -> FloppyTable already
254                 ; This should be safe to do now, interrupts are off...
255                 mov [bx],di             ; FloppyTable
256                 mov [bx+2],ax           ; Segment 0
257                 fs rep movsw            ; Faster to move words
258                 mov cl,[bsSecPerTrack]  ; Patch the sector count
259                 mov [di-8],cl
260                 ; AX == 0 here
261                 int 13h                 ; Some BIOSes need this
262
263                 jmp short not_harddisk
264 ;
265 ; The drive number and possibly partition information was passed to us
266 ; by the BIOS or previous boot loader (MBR).  Current "best practice" is to
267 ; trust that rather than what the superblock contains.
268 ;
269 ; Would it be better to zero out bsHidden if we don't have a partition table?
270 ;
271 ; Note: di points to beyond the end of PartInfo
272 ;
273 harddisk:
274                 test byte [di-16],7Fh   ; Sanity check: "active flag" should
275                 jnz no_partition        ; be 00 or 80
276                 mov eax,[di-8]          ; Partition offset (dword)
277                 mov [bsHidden],eax
278 no_partition:
279 ;
280 ; Get disk drive parameters (don't trust the superblock.)  Don't do this for
281 ; floppy drives -- INT 13:08 on floppy drives will (may?) return info about
282 ; what the *drive* supports, not about the *media*.  Fortunately floppy disks
283 ; tend to have a fixed, well-defined geometry which is stored in the superblock.
284 ;
285                 ; DL == drive # still
286                 mov ah,08h
287                 int 13h
288                 jc no_driveparm
289                 and ah,ah
290                 jnz no_driveparm
291                 shr dx,8
292                 inc dx                  ; Contains # of heads - 1
293                 mov [bsHeads],dx
294                 and cx,3fh
295                 mov [bsSecPerTrack],cx
296 no_driveparm:
297 not_harddisk:
298 ;
299 ; Ready to enable interrupts, captain
300 ;
301                 sti
302
303
304 ;
305 ; Do we have EBIOS (EDD)?
306 ;
307 eddcheck:
308                 mov bx,55AAh
309                 mov ah,41h              ; EDD existence query
310                 mov dl,[DriveNumber]
311                 int 13h
312                 jc .noedd
313                 cmp bx,0AA55h
314                 jne .noedd
315                 test cl,1               ; Extended disk access functionality set
316                 jz .noedd
317                 ;
318                 ; We have EDD support...
319                 ;
320                 mov byte [getlinsec+1],getlinsec_ebios-(getlinsec+2)
321 .noedd:
322
323 ;
324 ; Load the first sector of LDLINUX.SYS; this used to be all proper
325 ; with parsing the superblock and root directory; it doesn't fit
326 ; together with EBIOS support, unfortunately.
327 ;
328                 mov eax,[FirstSector]   ; Sector start
329                 mov bx,ldlinux_sys      ; Where to load it
330                 call getonesec
331                 
332                 ; Some modicum of integrity checking
333                 cmp dword [ldlinux_magic],LDLINUX_MAGIC
334                 jne kaboom
335                 cmp dword [ldlinux_magic+4],HEXDATE
336                 jne kaboom
337
338                 ; Go for it...
339                 jmp ldlinux_ent
340
341 ;
342 ; kaboom: write a message and bail out.
343 ;
344 kaboom:
345                 xor si,si
346                 mov ss,si               
347                 mov sp,StackBuf-4       ; Reset stack
348                 mov ds,si               ; Reset data segment
349                 pop dword [fdctab]      ; Restore FDC table
350 .patch:         mov si,bailmsg
351                 call writestr           ; Returns with AL = 0
352                 cbw                     ; AH <- 0
353                 int 16h                 ; Wait for keypress
354                 int 19h                 ; And try once more to boot...
355 .norge:         jmp short .norge        ; If int 19h returned; this is the end
356
357 ;
358 ;
359 ; writestr: write a null-terminated string to the console
360 ;           This assumes we're on page 0.  This is only used for early
361 ;           messages, so it should be OK.
362 ;
363 writestr:
364 .loop:          lodsb
365                 and al,al
366                 jz .return
367                 mov ah,0Eh              ; Write to screen as TTY
368                 mov bx,0007h            ; Attribute
369                 int 10h
370                 jmp short .loop
371 .return:        ret
372
373 ;
374 ; xint13: wrapper for int 13h which will retry 6 times and then die,
375 ;         AND save all registers except BP
376 ;
377 xint13:
378 .again:
379                 mov bp,retry_count
380 .loop:          pushad
381                 int 13h
382                 popad
383                 jnc writestr.return
384                 dec bp
385                 jnz .loop
386 .disk_error:
387                 jmp strict near kaboom  ; Patched
388
389
390 ;
391 ; getonesec: get one disk sector
392 ;
393 getonesec:
394                 mov bp,1                ; One sector
395                 ; Fall through
396
397 ;
398 ; getlinsec: load a sequence of BP floppy sector given by the linear sector
399 ;            number in EAX into the buffer at ES:BX.  We try to optimize
400 ;            by loading up to a whole track at a time, but the user
401 ;            is responsible for not crossing a 64K boundary.
402 ;            (Yes, BP is weird for a count, but it was available...)
403 ;
404 ;            On return, BX points to the first byte after the transferred
405 ;            block.
406 ;
407 ;            This routine assumes CS == DS, and trashes most registers.
408 ;
409 ; Stylistic note: use "xchg" instead of "mov" when the source is a register
410 ; that is dead from that point; this saves space.  However, please keep
411 ; the order to dst,src to keep things sane.
412 ;
413 getlinsec:
414                 jmp strict short getlinsec_cbios        ; This is patched
415
416 ;
417 ; getlinsec_ebios:
418 ;
419 ; getlinsec implementation for EBIOS (EDD)
420 ;
421 getlinsec_ebios:
422                 mov si,dapa                     ; Load up the DAPA
423                 mov [si+4],bx
424                 mov [si+6],es
425                 mov [si+8],eax
426 .loop:
427                 push bp                         ; Sectors left
428                 call maxtrans                   ; Enforce maximum transfer size
429 .bp_ok:
430                 mov [si+2],bp
431                 mov dl,[DriveNumber]
432                 mov ah,42h                      ; Extended Read
433                 call xint13
434                 pop bp
435                 movzx eax,word [si+2]           ; Sectors we read
436                 add [si+8],eax                  ; Advance sector pointer
437                 sub bp,ax                       ; Sectors left
438                 shl ax,9                        ; 512-byte sectors
439                 add [si+4],ax                   ; Advance buffer pointer
440                 and bp,bp
441                 jnz .loop
442                 mov eax,[si+8]                  ; Next sector
443                 mov bx,[si+4]                   ; Buffer pointer
444                 ret
445
446 ;
447 ; getlinsec_cbios:
448 ;
449 ; getlinsec implementation for legacy CBIOS
450 ;
451 getlinsec_cbios:
452 .loop:
453                 push eax
454                 push bp
455                 push bx
456
457                 movzx esi,word [bsSecPerTrack]
458                 movzx edi,word [bsHeads]
459                 ;
460                 ; Dividing by sectors to get (track,sector): we may have
461                 ; up to 2^18 tracks, so we need to use 32-bit arithmetric.
462                 ;
463                 xor edx,edx             ; Zero-extend LBA to 64 bits
464                 div esi
465                 xor cx,cx
466                 xchg cx,dx              ; CX <- sector index (0-based)
467                                         ; EDX <- 0
468                 ; eax = track #
469                 div edi                 ; Convert track to head/cyl
470                 ;
471                 ; Now we have AX = cyl, DX = head, CX = sector (0-based),
472                 ; BP = sectors to transfer, SI = bsSecPerTrack,
473                 ; ES:BX = data target
474                 ;
475
476                 call maxtrans                   ; Enforce maximum transfer size
477
478                 ; Must not cross track boundaries, so BP <= SI-CX
479                 sub si,cx
480                 cmp bp,si
481                 jna .bp_ok
482                 mov bp,si
483 .bp_ok: 
484
485                 shl ah,6                ; Because IBM was STOOPID
486                                         ; and thought 8 bits were enough
487                                         ; then thought 10 bits were enough...
488                 inc cx                  ; Sector numbers are 1-based, sigh
489                 or cl,ah
490                 mov ch,al
491                 mov dh,dl
492                 mov dl,[DriveNumber]
493                 xchg ax,bp              ; Sector to transfer count
494                 mov ah,02h              ; Read sectors
495                 call xint13
496                 movzx ecx,al
497                 shl ax,9                ; Convert sectors in AL to bytes in AX
498                 pop bx
499                 add bx,ax
500                 pop bp
501                 pop eax
502                 add eax,ecx
503                 sub bp,cx
504                 jnz .loop
505                 ret
506
507 ;
508 ; Truncate BP to MaxTransfer
509 ;
510 maxtrans:
511                 cmp bp,[MaxTransfer]
512                 jna .ok
513                 mov bp,[MaxTransfer]
514 .ok:            ret
515
516 ;
517 ; Error message on failure
518 ;
519 bailmsg:        db 'Boot failed', 0Dh, 0Ah, 0
520
521 ;
522 ; EBIOS disk address packet
523 ;
524                 align 4, db 0
525 dapa:
526                 dw 16                           ; Packet size
527 .count:         dw 0                            ; Block count
528 .off:           dw 0                            ; Offset of buffer
529 .seg:           dw 0                            ; Segment of buffer
530 .lba:           dd 0                            ; LBA (LSW)
531                 dd 0                            ; LBA (MSW)
532
533
534 %if 1
535 bs_checkpt_off  equ ($-$$)
536 %ifndef DEPEND
537 %if bs_checkpt_off > 1F8h
538 %error "Boot sector overflow"
539 %endif
540 %endif
541
542                 zb 1F8h-($-$$)
543 %endif
544 FirstSector     dd 0xDEADBEEF                   ; Location of sector 1
545 MaxTransfer     dw 0x007F                       ; Max transfer size
546 bootsignature   dw 0AA55h
547
548 ;
549 ; ===========================================================================
550 ;  End of boot sector
551 ; ===========================================================================
552 ;  Start of LDLINUX.SYS
553 ; ===========================================================================
554
555 ldlinux_sys:
556
557 syslinux_banner db 0Dh, 0Ah
558                 db 'EXTLINUX '
559                 db version_str, ' ', date, ' ', 0
560                 db 0Dh, 0Ah, 1Ah        ; EOF if we "type" this in DOS
561
562                 align 8, db 0
563 ldlinux_magic   dd LDLINUX_MAGIC
564                 dd HEXDATE
565
566 ;
567 ; This area is patched by the installer.  It is found by looking for
568 ; LDLINUX_MAGIC, plus 8 bytes.
569 ;
570 patch_area:
571 LDLDwords       dw 0            ; Total dwords starting at ldlinux_sys
572 LDLSectors      dw 0            ; Number of sectors - (bootsec+this sec)
573 CheckSum        dd 0            ; Checksum starting at ldlinux_sys
574                                 ; value = LDLINUX_MAGIC - [sum of dwords]
575 CurrentDir      dd 2            ; "Current" directory inode number
576
577 ; Space for up to 64 sectors, the theoretical maximum
578 SectorPtrs      times 64 dd 0
579
580 ldlinux_ent:
581
582 ; Note that some BIOSes are buggy and run the boot sector at 07C0:0000
583 ; instead of 0000:7C00 and the like.  We don't want to add anything
584 ; more to the boot sector, so it is written to not assume a fixed
585 ; value in CS, but we don't want to deal with that anymore from now
586 ; on.
587 ;
588                 jmp 0:.next
589 .next:
590
591 ;
592 ; Tell the user we got this far
593 ;
594                 mov si,syslinux_banner
595                 call writestr
596
597 ;
598 ; Patch disk error handling
599 ;
600                 mov word [xint13.disk_error+1],do_disk_error-(xint13.disk_error+3)
601
602 ;
603 ; Now we read the rest of LDLINUX.SYS.  Don't bother loading the first
604 ; sector again, though.
605 ;
606 load_rest:
607                 mov si,SectorPtrs
608                 mov bx,7C00h+2*SECTOR_SIZE      ; Where we start loading
609                 mov cx,[LDLSectors]
610
611 .get_chunk:
612                 jcxz .done
613                 xor bp,bp
614                 lodsd                           ; First sector of this chunk
615
616                 mov edx,eax
617
618 .make_chunk:
619                 inc bp
620                 dec cx
621                 jz .chunk_ready
622                 inc edx                         ; Next linear sector
623                 cmp [esi],edx                   ; Does it match
624                 jnz .chunk_ready                ; If not, this is it
625                 add esi,4                       ; If so, add sector to chunk
626                 jmp short .make_chunk
627
628 .chunk_ready:
629                 call getlinsecsr
630                 shl bp,SECTOR_SHIFT
631                 add bx,bp
632                 jmp .get_chunk
633
634 .done:
635
636 ;
637 ; All loaded up, verify that we got what we needed.
638 ; Note: the checksum field is embedded in the checksum region, so
639 ; by the time we get to the end it should all cancel out.
640 ;
641 verify_checksum:
642                 mov si,ldlinux_sys
643                 mov cx,[LDLDwords]
644                 mov edx,-LDLINUX_MAGIC
645 .checksum:
646                 lodsd
647                 add edx,eax
648                 loop .checksum
649
650                 and edx,edx                     ; Should be zero
651                 jz all_read                     ; We're cool, go for it!
652
653 ;
654 ; Uh-oh, something went bad...
655 ;
656                 mov si,checksumerr_msg
657                 call writestr
658                 jmp kaboom
659
660 ;
661 ; -----------------------------------------------------------------------------
662 ; Subroutines that have to be in the first sector
663 ; -----------------------------------------------------------------------------
664
665 ;
666 ; getlinsecsr: save registers, call getlinsec, restore registers
667 ;
668 getlinsecsr:    pushad
669                 call getlinsec
670                 popad
671                 ret
672
673 ;
674 ; This routine captures disk errors, and tries to decide if it is
675 ; time to reduce the transfer size.
676 ;
677 do_disk_error:
678                 cmp ah,42h
679                 je .ebios
680                 shr al,1                ; Try reducing the transfer size
681                 mov [MaxTransfer],al    
682                 jz kaboom               ; If we can't, we're dead...
683                 jmp xint13              ; Try again
684 .ebios:
685                 push ax
686                 mov ax,[si+2]
687                 shr ax,1
688                 mov [MaxTransfer],ax
689                 mov [si+2],ax
690                 pop ax
691                 jmp xint13
692
693 ;
694 ; Checksum error message
695 ;
696 checksumerr_msg db 'Load error - ', 0   ; Boot failed appended
697
698 ;
699 ; Debug routine
700 ;
701 %ifdef debug
702 safedumpregs:
703                 cmp word [Debug_Magic],0D00Dh
704                 jnz nc_return
705                 jmp dumpregs
706 %endif
707
708 rl_checkpt      equ $                           ; Must be <= 8000h
709
710 rl_checkpt_off  equ ($-$$)
711 %if 0 ; ndef DEPEND
712 %if rl_checkpt_off > 400h
713 %error "Sector 1 overflow"
714 %endif
715 %endif
716
717 ; ----------------------------------------------------------------------------
718 ;  End of code and data that have to be in the first sector
719 ; ----------------------------------------------------------------------------
720
721 all_read:
722 ;
723 ; Let the user (and programmer!) know we got this far.  This used to be
724 ; in Sector 1, but makes a lot more sense here.
725 ;
726                 mov si,copyright_str
727                 call writestr
728
729 ;
730 ; Insane hack to expand the DOS superblock to dwords
731 ;
732 expand_super:
733                 xor eax,eax
734                 mov si,superblock
735                 mov di,SuperInfo
736                 mov cx,superinfo_size
737 .loop:
738                 lodsw
739                 dec si
740                 stosd                           ; Store expanded word
741                 xor ah,ah
742                 stosd                           ; Store expanded byte
743                 loop .loop
744
745 ;
746 ; Load the real (ext2) superblock; 1024 bytes long at offset 1024
747 ;
748                 mov bx,SuperBlock
749                 mov eax,1024 >> SECTOR_SHIFT
750                 mov cx,ax
751                 call getlinsec
752
753 ;
754 ; Compute some values...
755 ;
756                 xor edx,edx
757                 inc edx
758
759                 ; s_log_block_size = log2(blocksize) - 10
760                 mov cl,[SuperBlock+s_log_block_size]
761                 add cl,10
762                 mov [ClustByteShift],cl
763                 mov eax,edx
764                 shl eax,cl
765                 mov [ClustSize],eax
766
767                 sub cl,2                        ; 4 bytes/pointer
768                 shl edx,cl
769                 mov [PtrsPerBlock1],edx
770                 shl edx,cl
771                 mov [PtrsPerBlock2],edx
772                 shl edx,cl
773                 mov [PtrsPerBlock3],eax
774
775                 sub cl,SECTOR_SHIFT-2
776                 mov [ClustShift],cl
777                 shr eax,SECTOR_SHIFT
778                 mov [SecPerClust],eax
779                 dec eax
780                 mov [ClustMask],eax
781
782 ;
783 ; Common initialization code
784 ;
785 %include "init.inc"
786 %include "cpuinit.inc"
787
788 ;
789 ; Initialize the metadata cache
790 ;
791                 call initcache
792
793 ;
794 ; Now, everything is "up and running"... patch kaboom for more
795 ; verbosity and using the full screen system
796 ;
797                 ; E9 = JMP NEAR
798                 mov dword [kaboom.patch],0e9h+((kaboom2-(kaboom.patch+3)) << 8)
799
800 ;
801 ; Now we're all set to start with our *real* business.  First load the
802 ; configuration file (if any) and parse it.
803 ;
804 ; In previous versions I avoided using 32-bit registers because of a
805 ; rumour some BIOSes clobbered the upper half of 32-bit registers at
806 ; random.  I figure, though, that if there are any of those still left
807 ; they probably won't be trying to install Linux on them...
808 ;
809 ; The code is still ripe with 16-bitisms, though.  Not worth the hassle
810 ; to take'm out.  In fact, we may want to put them back if we're going
811 ; to boot ELKS at some point.
812 ;
813
814 ;
815 ; Load configuration file
816 ;
817 load_config:
818                 mov di,ConfigName
819                 call open
820                 jz no_config_file
821
822 ;
823 ; Now we have the config file open.  Parse the config file and
824 ; run the user interface.
825 ;
826 %include "ui.inc"
827
828 ;
829 ; Linux kernel loading code is common.
830 ;
831 %include "runkernel.inc"
832
833 ;
834 ; COMBOOT-loading code
835 ;
836 %include "comboot.inc"
837 %include "com32.inc"
838 %include "cmdline.inc"
839
840 ;
841 ; Boot sector loading code
842 ;
843 %include "bootsect.inc"
844
845 ;
846 ; abort_check: let the user abort with <ESC> or <Ctrl-C>
847 ;
848 abort_check:
849                 call pollchar
850                 jz ac_ret1
851                 pusha
852                 call getchar
853                 cmp al,27                       ; <ESC>
854                 je ac_kill
855                 cmp al,3                        ; <Ctrl-C>
856                 jne ac_ret2
857 ac_kill:        mov si,aborted_msg
858
859 ;
860 ; abort_load: Called by various routines which wants to print a fatal
861 ;             error message and return to the command prompt.  Since this
862 ;             may happen at just about any stage of the boot process, assume
863 ;             our state is messed up, and just reset the segment registers
864 ;             and the stack forcibly.
865 ;
866 ;             SI    = offset (in _text) of error message to print
867 ;
868 abort_load:
869                 mov ax,cs                       ; Restore CS = DS = ES
870                 mov ds,ax
871                 mov es,ax
872                 cli
873                 mov sp,StackBuf-2*3             ; Reset stack
874                 mov ss,ax                       ; Just in case...
875                 sti
876                 call cwritestr                  ; Expects SI -> error msg
877 al_ok:          jmp enter_command               ; Return to command prompt
878 ;
879 ; End of abort_check
880 ;
881 ac_ret2:        popa
882 ac_ret1:        ret
883
884 ;
885 ; allocate_file: Allocate a file structure
886 ;
887 ;               If successful:
888 ;                 ZF set
889 ;                 BX = file pointer
890 ;               In unsuccessful:
891 ;                 ZF clear
892 ;
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
904                 ret
905 ;
906 ; open_inode:
907 ;            Open a file indicated by an inode number in EAX
908 ;
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).
913 ;
914 ;            If successful:
915 ;               ZF clear
916 ;               SI          = file pointer
917 ;               DX:AX = EAX = file length in bytes
918 ;            If unsuccessful
919 ;               ZF set
920 ;
921 open_inode.allocate_failure:
922                 xor eax,eax
923                 ret
924
925 open_inode:
926                 call allocate_file
927                 jnz .allocate_failure
928
929                 push gs
930                 ; First, get the appropriate inode group and index
931                 dec eax                         ; There is no inode 0
932                 xor edx,edx
933                 mov [bx+file_sector],edx
934                 div dword [SuperBlock+s_inodes_per_group]
935                 ; EAX = inode group; EDX = inode within group
936                 push edx
937
938                 ; Now, we need the block group descriptor.
939                 ; To get that, we first need the relevant descriptor block.
940                                 
941                 shl eax, ext2_group_desc_lg2size ; Get byte offset in desc table
942                 xor edx,edx
943                 div dword [ClustSize]
944                 ; eax = block #, edx = offset in block
945                 add eax,dword [SuperBlock+s_first_data_block]
946                 inc eax                         ; s_first_data_block+1
947                 mov cl,[ClustShift]
948                 shl eax,cl
949                 call getcachesector             ; Get the group descriptor
950                 add si,dx
951                 mov esi,[gs:si+bg_inode_table]  ; Get inode table block #
952                 pop eax                         ; Get inode within group
953                 movzx edx, word [SuperBlock+s_inode_size]
954                 mul edx
955                 ; edx:eax = byte offset in inode table
956                 div dword [ClustSize]
957                 ; eax = block # versus inode table, edx = offset in block
958                 add eax,esi
959                 shl eax,cl                      ; Turn into sector
960                 push dx
961                 shr edx,SECTOR_SHIFT
962                 add eax,edx
963                 mov [bx+file_in_sec],eax
964                 pop dx
965                 and dx,SECTOR_SIZE-1
966                 mov [bx+file_in_off],dx
967
968                 call getcachesector
969                 add si,dx
970                 mov eax,[gs:si+i_size]
971                 push eax
972                 add eax,SECTOR_SIZE-1
973                 shr eax,SECTOR_SHIFT
974                 mov [bx+file_left],eax
975                 pop eax
976                 mov si,bx
977                 mov edx,eax
978                 shr edx,16                      ; 16-bitism, sigh
979                 and eax,eax                     ; ZF clear unless zero-length file
980                 pop gs
981                 ret
982
983 ;
984 ; close:
985 ;            Deallocates a file structure (pointer in SI)
986 ;            Assumes CS == DS.
987 ;
988 close:
989                 mov dword [si],0                ; First dword == file_left
990                 ret
991
992 ;
993 ; searchdir:
994 ;            Search the root directory for a pre-mangled filename in DS:DI.
995 ;
996 ;            NOTE: This file considers finding a zero-length file an
997 ;            error.  This is so we don't have to deal with that special
998 ;            case elsewhere in the program (most loops have the test
999 ;            at the end).
1000 ;
1001 ;            If successful:
1002 ;               ZF clear
1003 ;               SI          = file pointer
1004 ;               DX:AX = EAX = file length in bytes
1005 ;            If unsuccessful
1006 ;               ZF set
1007 ;
1008 ;            Assumes CS == DS == ES; *** IS THIS CORRECT ***?
1009 ;
1010 searchdir:
1011                 mov eax,[CurrentDir]
1012 .leadingslash:
1013                 cmp byte [di],'/'       ; Absolute filename?
1014                 jne .searchloop
1015                 mov eax,EXT2_ROOT_INO
1016                 inc di                  ; Skip slash
1017
1018 .searchloop:
1019                 ; At this point, EAX contains the directory inode,
1020                 ; and DS:DI contains a pathname tail.
1021                 call open_inode
1022
1023 .readdir:
1024                 mov bx,trackbuf
1025                 push bx
1026                 mov cx,[SecPerClust]
1027                 call getfssec
1028                 pop bx
1029                 pushf                   ; Save EOF flag
1030 .getent:
1031                 cmp dword [bx+d_inode],0
1032                 je .endblock
1033                 
1034                 push di
1035                 push si
1036                 mov cx,[bx+d_name_len]
1037                 lea si,[bx+d_name]
1038                 repe cmpsb
1039                 pop si
1040                 je .maybe
1041 .nope:
1042                 pop di
1043
1044                 add bx,[bx+d_rec_len]
1045                 jmp .getent
1046
1047 .endblock:
1048                 popf
1049                 jnc .readdir            ; There is more
1050 .failure:
1051                 xor eax,eax
1052                 ret
1053 .maybe:
1054                 mov eax,[si+d_inode]
1055                 
1056                 cmp byte [di],0
1057                 je .finish              ; It's a real file; done
1058                 cmp byte [di],'/'
1059                 jne .nope               ; False alarm
1060                 
1061                 ; It's a match, but it's a directory.
1062                 ; Repeat operation.
1063                 call close
1064                 pop si                  ; Adjust stack (di)
1065                 pop si                  ; Adjust stack (flags)
1066                 inc di                  ; Skip slash
1067                 jmp .searchloop
1068                 
1069
1070 .finish:        ; We found it; now we need to open the file
1071                 call close              ; Close directory
1072                 pop si                  ; Adjust stack (di)
1073                 pop si                  ; Adjust stack (flags)
1074                 call open_inode
1075                 ret
1076
1077 ;
1078 ; mangle_name: Mangle a filename pointed to by DS:SI into a buffer pointed
1079 ;              to by ES:DI; ends on encountering any whitespace.
1080 ;
1081 ;              This verifies that a filename is < FILENAME_MAX characters,
1082 ;              doesn't contain whitespace, zero-pads the output buffer,
1083 ;              and removes redundant slashes,
1084 ;              so "repe cmpsb" can do a compare, and the
1085 ;              path-searching routine gets a bit of an easier job.
1086 ;
1087 ;              FIX: we may want to support \-escapes here (and this would
1088 ;              be the place.)
1089 ;              
1090 mangle_name:
1091                 push bx
1092                 xor ax,ax
1093                 mov cx,FILENAME_MAX-1
1094                 mov bx,di
1095
1096 .mn_loop:
1097                 lodsb
1098                 cmp al,' '                      ; If control or space, end
1099                 jna .mn_end
1100                 cmp al,ah                       ; Repeated slash?
1101                 je .mn_skip
1102                 xor ah,ah
1103                 cmp al,'/'
1104                 jne .mn_ok
1105                 mov ah,al
1106 .mn_ok          stosb
1107 .mn_skip:       loop .mn_loop
1108 .mn_end:
1109                 cmp bx,di                       ; At the beginning of the buffer?
1110                 jbe .mn_zero
1111                 cmp byte [di-1],'/'             ; Terminal slash?
1112                 jne .mn_zero
1113 .mn_kill:       dec di                          ; If so, remove it
1114                 inc cx
1115                 jmp short .mn_end
1116 .mn_zero:
1117                 inc cx                          ; At least one null byte
1118                 xor ax,ax                       ; Zero-fill name
1119                 rep stosb
1120                 pop bx
1121                 ret                             ; Done
1122
1123 ;
1124 ; unmangle_name: Does the opposite of mangle_name; converts a DOS-mangled
1125 ;                filename to the conventional representation.  This is needed
1126 ;                for the BOOT_IMAGE= parameter for the kernel.
1127 ;                NOTE: A 13-byte buffer is mandatory, even if the string is
1128 ;                known to be shorter.
1129 ;
1130 ;                DS:SI -> input mangled file name
1131 ;                ES:DI -> output buffer
1132 ;
1133 ;                On return, DI points to the first byte after the output name,
1134 ;                which is set to a null byte.
1135 ;
1136 unmangle_name:  call strcpy
1137                 dec di                          ; Point to final null byte
1138                 ret
1139
1140 ;
1141 ; writechr:     Write a single character in AL to the console without
1142 ;               mangling any registers; handle video pages correctly.
1143 ;
1144 writechr:
1145                 call write_serial       ; write to serial port if needed
1146                 pushfd
1147                 pushad
1148                 mov ah,0Eh
1149                 mov bl,07h              ; attribute
1150                 mov bh,[cs:BIOS_page]   ; current page
1151                 int 10h
1152                 popad
1153                 popfd
1154                 ret
1155
1156 ;
1157 ;
1158 ; kaboom2: once everything is loaded, replace the part of kaboom
1159 ;          starting with "kaboom.patch" with this part
1160
1161 kaboom2:
1162                 mov si,err_bootfailed
1163                 call cwritestr
1164                 call getchar
1165                 call vgaclearmode
1166                 int 19h                 ; And try once more to boot...
1167 .norge:         jmp short .norge        ; If int 19h returned; this is the end
1168
1169
1170 ;
1171 ; linsector:    Convert a linear sector index in a file to a linear sector number
1172 ;       EAX     -> linear sector number
1173 ;       DS:SI   -> open_file_t
1174 ;
1175 ;               Returns next sector number in EAX; CF on EOF (not an error!)
1176 ;
1177 linsector:
1178                 push gs
1179                 push ebx
1180                 push esi
1181                 push edi
1182                 push ecx
1183                 push edx
1184                 push ebp
1185
1186                 push eax
1187                 mov cl,[ClustShift]
1188                 shr eax,cl              ; Convert to block number
1189                 push eax
1190                 mov eax,[si+file_in_sec]
1191                 mov bx,si
1192                 call getcachesector     ; Get inode
1193                 add si,[bx+file_in_off] ; Get *our* inode
1194                 pop eax
1195                 lea ebx,[i_block+4*eax]
1196                 cmp eax,EXT2_NDIR_BLOCKS
1197                 jb .direct
1198                 mov ebx,[gs:si+i_block+4*EXT2_IND_BLOCK]
1199                 sub eax,EXT2_NDIR_BLOCKS
1200                 mov ebp,[PtrsPerBlock1]
1201                 jb .ind1
1202                 mov ebx,[gs:si+i_block+4*EXT2_DIND_BLOCK]
1203                 sub eax,ebp
1204                 mov ebp,[PtrsPerBlock2]
1205                 cmp eax,ebp
1206                 jb .ind2
1207                 mov ebx,[gs:si+i_block+4*EXT2_TIND_BLOCK]
1208                 sub eax,ebp
1209
1210 .ind3:
1211                 ; Triple indirect; eax contains the block no
1212                 ; with respect to the start of the tind area;
1213                 ; ebx contains the pointer to the tind block.
1214                 xor edx,edx
1215                 div dword [PtrsPerBlock3]
1216                 ; EAX = which dind block, EDX = block no in dind block
1217
1218                 shl ebx,cl              ; Sector # for tind block
1219                 push ax
1220                 shr eax,SECTOR_SHIFT-2  ; Sector within tind block
1221                 add eax,ebx
1222                 call getcachesector
1223                 pop bx
1224                 shl bx,2                ; Convert to byte offset
1225                 and bx,SECTOR_SIZE-1
1226
1227                 mov ebx,[gs:bx+si]      ; Get the pointer
1228                 mov eax,edx             ; The int2 code wants the remainder...
1229 .ind2:
1230                 ; Double indirect; eax contains the block no
1231                 ; with respect to the start of the dind area;
1232                 ; ebx contains the pointer to the dind block.
1233                 xor edx,edx
1234                 div dword [PtrsPerBlock2]
1235                 ; EAX = which dind block, EDX = block no in dind block
1236
1237                 shl ebx,cl              ; Sector # for tind block
1238                 push ax
1239                 shr eax,SECTOR_SHIFT-2  ; Sector within tind block
1240                 add eax,ebx
1241                 call getcachesector
1242                 pop bx
1243                 shl bx,2                ; Convert to byte offset
1244                 and bx,SECTOR_SIZE-1
1245
1246                 mov ebx,[gs:bx+si]      ; Get the pointer
1247                 mov eax,edx             ; The ind1 code wants the remainder...
1248 .ind1:
1249                 ; Single indirect; eax contains the block no
1250                 ; with respect to the start of the ind area;
1251                 ; ebx contains the pointer to the ind block.
1252                 xor edx,edx
1253                 div dword [PtrsPerBlock1]
1254                 ; EAX = which dind block, EDX = block no in dind block
1255
1256                 shl ebx,cl              ; Sector # for tind block
1257                 push ax
1258                 shr eax,SECTOR_SHIFT-2  ; Sector within tind block
1259                 add eax,ebx
1260                 call getcachesector
1261                 pop bx
1262                 shl bx,2                ; Convert to byte offset
1263                 and bx,SECTOR_SIZE-1
1264
1265 .direct:
1266                 mov ebx,[gs:bx+si]      ; Get the pointer
1267
1268                 pop eax                 ; Get the sector index again
1269                 shl ebx,cl              ; Convert block number to sector
1270                 and eax,[ClustMask]     ; Add offset within block
1271                 add eax,ebx
1272
1273                 pop ebp
1274                 pop edx
1275                 pop ecx
1276                 pop edi
1277                 pop esi
1278                 pop ebx
1279                 pop gs
1280                 ret
1281
1282 ;
1283 ; getfssec: Get multiple sectors from a file
1284 ;
1285 ;       Same as above, except SI is a pointer to a open_file_t
1286 ;
1287 ;       ES:BX   -> Buffer
1288 ;       DS:SI   -> Pointer to open_file_t
1289 ;       CX      -> Sector count (0FFFFh = until end of file)
1290 ;                  Must not exceed the ES segment
1291 ;       Returns CF=1 on EOF (not necessarily error)
1292 ;       All arguments are advanced to reflect data read.
1293 ;
1294 getfssec:
1295                 push ebp
1296                 push eax
1297                 push ebx
1298                 push edx
1299 .getfragment:
1300                 mov eax,[si]                    ; Current start index
1301                 mov ebx,eax
1302                 call linsector
1303                 push eax                        ; Fragment start sector
1304                 mov edx,eax
1305                 xor ebp,ebp                     ; Fragment sector count
1306 .getseccnt:
1307                 inc bp
1308                 dec cx
1309                 jz .do_read
1310                 xor eax,eax
1311                 mov ax,es
1312                 shl ax,4
1313                 add ax,bx                       ; Now DI = how far into 64K block we are
1314                 not ax                          ; Bytes left in 64K block
1315                 inc eax
1316                 shr eax,SECTOR_SHIFT            ; Sectors left in 64K block
1317                 cmp bp,ax
1318                 jnb .do_read                    ; Unless there is at least 1 more sector room...
1319                 inc ebx                         ; Sector index
1320                 inc edx                         ; Linearly next sector
1321                 mov eax,ebx
1322                 call linsector
1323                 jc .do_read
1324                 cmp edx,eax
1325                 je .getseccnt
1326 .do_read:
1327                 pop eax                         ; Linear start sector
1328                 call getlinsecsr
1329                 lea eax,[eax+ebp-1]             ; This is the last sector actually read
1330                 shl bp,9
1331                 add bx,bp                       ; Adjust buffer pointer
1332                 call linsector
1333                 jc .eof
1334                 mov edx,eax
1335                 and cx,cx
1336                 jnz .getfragment
1337 .done:
1338                 pop edx
1339                 pop ebx
1340                 pop eax
1341                 pop ebp
1342                 ret
1343 .eof:
1344                 xor edx,edx
1345                 stc
1346                 jmp .done
1347
1348
1349
1350 ; -----------------------------------------------------------------------------
1351 ;  Common modules
1352 ; -----------------------------------------------------------------------------
1353
1354 %include "getc.inc"             ; getc et al
1355 %include "conio.inc"            ; Console I/O
1356 %include "writestr.inc"         ; String output
1357 %include "parseconfig.inc"      ; High-level config file handling
1358 %include "parsecmd.inc"         ; Low-level config file handling
1359 %include "bcopy32.inc"          ; 32-bit bcopy
1360 %include "loadhigh.inc"         ; Load a file into high memory
1361 %include "font.inc"             ; VGA font stuff
1362 %include "graphics.inc"         ; VGA graphics
1363 %include "highmem.inc"          ; High memory sizing
1364 %include "strcpy.inc"           ; strcpy()
1365 %include "cache.inc"
1366
1367 ; -----------------------------------------------------------------------------
1368 ;  Begin data section
1369 ; -----------------------------------------------------------------------------
1370
1371                 section .data
1372 copyright_str   db ' Copyright (C) 1994-', year, ' H. Peter Anvin'
1373                 db CR, LF, 0
1374 boot_prompt     db 'boot: ', 0
1375 wipe_char       db BS, ' ', BS, 0
1376 err_notfound    db 'Could not find kernel image: ',0
1377 err_notkernel   db CR, LF, 'Invalid or corrupt kernel image.', CR, LF, 0
1378 err_noram       db 'It appears your computer has less than '
1379                 asciidec dosram_k
1380                 db 'K of low ("DOS")'
1381                 db CR, LF
1382                 db 'RAM.  Linux needs at least this amount to boot.  If you get'
1383                 db CR, LF
1384                 db 'this message in error, hold down the Ctrl key while'
1385                 db CR, LF
1386                 db 'booting, and I will take your word for it.', CR, LF, 0
1387 err_badcfg      db 'Unknown keyword in syslinux.cfg.', CR, LF, 0
1388 err_noparm      db 'Missing parameter in syslinux.cfg.', CR, LF, 0
1389 err_noinitrd    db CR, LF, 'Could not find ramdisk image: ', 0
1390 err_nohighmem   db 'Not enough memory to load specified kernel.', CR, LF, 0
1391 err_highload    db CR, LF, 'Kernel transfer failure.', CR, LF, 0
1392 err_oldkernel   db 'Cannot load a ramdisk with an old kernel image.'
1393                 db CR, LF, 0
1394 err_notdos      db ': attempted DOS system call', CR, LF, 0
1395 err_comlarge    db 'COMBOOT image too large.', CR, LF, 0
1396 err_bssimage    db 'BSS images not supported.', CR, LF, 0
1397 err_a20         db CR, LF, 'A20 gate not responding!', CR, LF, 0
1398 err_bootfailed  db CR, LF, 'Boot failed: please change disks and press '
1399                 db 'a key to continue.', CR, LF, 0
1400 ready_msg       db 'Ready.', CR, LF, 0
1401 crlfloading_msg db CR, LF
1402 loading_msg     db 'Loading ', 0
1403 dotdot_msg      db '.'
1404 dot_msg         db '.', 0
1405 aborted_msg     db ' aborted.'                  ; Fall through to crlf_msg!
1406 crlf_msg        db CR, LF
1407 null_msg        db 0
1408 crff_msg        db CR, FF, 0
1409 ConfigName      db 'extlinux.cfg',0             ; Unmangled form
1410
1411 ;
1412 ; Command line options we'd like to take a look at
1413 ;
1414 ; mem= and vga= are handled as normal 32-bit integer values
1415 initrd_cmd      db 'initrd='
1416 initrd_cmd_len  equ 7
1417
1418 ;
1419 ; Config file keyword table
1420 ;
1421 %include "keywords.inc"
1422
1423 ;
1424 ; Extensions to search for (in *forward* order).
1425 ;
1426                 align 4, db 0
1427 exten_table:    db '.cbt'               ; COMBOOT (specific)
1428                 db '.img'               ; Disk image
1429                 db '.bs', 0             ; Boot sector
1430                 db '.com'               ; COMBOOT (same as DOS)
1431                 db '.c32'               ; COM32
1432 exten_table_end:
1433                 dd 0, 0                 ; Need 8 null bytes here
1434
1435 ;
1436 ; Misc initialized (data) variables
1437 ;
1438 %ifdef debug                            ; This code for debugging only
1439 debug_magic     dw 0D00Dh               ; Debug code sentinel
1440 %endif
1441
1442                 alignb 4, db 0
1443 BufSafe         dw trackbufsize/SECTOR_SIZE     ; Clusters we can load into trackbuf
1444 BufSafeSec      dw trackbufsize/SECTOR_SIZE     ; = how many sectors?
1445 BufSafeBytes    dw trackbufsize         ; = how many bytes?
1446 EndOfGetCBuf    dw getcbuf+trackbufsize ; = getcbuf+BufSafeBytes
1447 %ifndef DEPEND
1448 %if ( trackbufsize % SECTOR_SIZE ) != 0
1449 %error trackbufsize must be a multiple of SECTOR_SIZE
1450 %endif
1451 %endif
1452                 align 4, db 0           ; Pad out any unfinished dword
1453 ldlinux_end     equ $