精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>嵌入式开发>>操作系统设计与实现>>最差与最好:两个boot sector 范例

主题:最差与最好:两个boot sector 范例
发信人: wenbobo()
整理人: wenbobo(2003-01-09 10:08:30), 站内信件
糟糕的代码,来自osd项目,这是wenbobo见过的最糟糕的臃肿的汇编代码,呵呵,不知道作者怎么想的
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; First-stage bootloader for FAT12 (DOS/Win) floppy
; Chris Giese <[email protected]>, http://www.execpc.com/~geezer
;
; This code is public domain (no copyright).
; You can do whatever you want with it.
;
; This code updated, fixed, and released on Nov 26, 2002
;
; BUILD:
;    nasm -f bin -o fat12.bin fat12.asm
;
; DOS INSTALL (do NOT use RAWRITE):
;    partcopy fat12.bin  0   3 -f0
;    partcopy fat12.bin 24 1DC -f0 24
;
; UNIX INSTALL:
;    dd bs=1 if=fat12.bin skip=0  count=3   of=/dev/fd0
;    dd bs=1 if=fat12.bin skip=36 count=476 of=/dev/fd0 seek=36
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; SS_NAME must be in FAT format: all caps, 11 chars total, 8-char
; filename, 3-char extension, both padded on the right with spaces
%define    SS_NAME    "LOAD    BIN"        ; 2nd stage file name
SS_ADR    EQU    10000h            ; where to load 2nd stage
SS_ORG    EQU    100h            ; 2nd stage ORG value

; "No user-serviceable parts beyond this point" :)
; Actually, you can modify it if you want.

; first-stage address                offset    linear
%define     FS_ORG    100h            ; 100h    7C00h

; 512-byte stack. Put this ABOVE the code in memory, so this code
; can also be built as a .COM file (for testing purposes only!)
ADR_STACK    equ    (FS_ORG + 400h)        ; 500h    8000h

; one-sector directory buffer. I assume FAT sectors are no larger than 4K
ADR_DIRBUF    equ    ADR_STACK        ; 500h    8000h

; two-sector FAT buffer -- two sectors because FAT12
; entries are 12 bits and may straddle a sector boundary
ADR_FATBUF    equ    (ADR_DIRBUF + 1000h)    ; 1500h    9000h

; start of unused memory:              3500h    B000h

; use byte-offset addressing from BP for smaller code
%define    VAR(x)    ((x) - start) + bp

; bootsector loaded at physical address 07C00h, but address 100h
; will work if we load IP and segment registers properly.
; This is also the ORG address of a DOS .COM file
    ORG FS_ORG
start:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; VARIABLES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; (1 byte) drive we booted from; 0=A, 80h=C
boot_drive        EQU (start - 1)

; (2 bytes) number of 16-byte paragraphs per sector
para_per_sector        EQU (boot_drive - 2)

; (2 bytes) number of 32-byte FAT directory entries per sector
dir_ents_per_sector    EQU (para_per_sector - 2)

; (2 bytes) sector where the actual disk data starts
; This is relative to partition start, so we need only 16 bits
data_start        EQU (dir_ents_per_sector - 2)

; (2 bytes) number of 16-byte paragraphs per cluster
para_per_cluster    EQU (data_start - 2)

    jmp short skip_bpb
    nop

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; MINIMAL BIOS PARAMETER BLOCK (BPB)
;
; 'Minimal' means just enough of a BPB so DOS/Windows:
; - recognizes this disk as a FAT12 floppy,
; - doesn't complain when you try to access the disk,
; - doesn't insist on a full format if you say "FORMAT /Q A:"
;
; Installation will use the BPB already present on your floppy disk.
; The values shown here work only with 1.44 meg disks (CHS=80:2:18)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

oem_id:            ; offset 03h (03) - not used by this code
    db "GEEZER", 0, 0
bytes_per_sector:    ; offset 0Bh (11)
    dw 512
sectors_per_cluster:    ; offset 0Dh (13)
    db 1
fat_start:
num_reserved_sectors:    ; offset 0Eh (14)
    dw 1
num_fats:        ; offset 10h (16)
    db 2
num_root_dir_ents:    ; offset 11h (17)
    dw 224
total_sectors:        ; offset 13h (19) - not used by this code
    dw 18 * 2 * 80
media_id:        ; offset 15h (21) - not used by this code
    db 0F0h
sectors_per_fat:    ; offset 16h (22)
    dw 9
sectors_per_track:    ; offset 18h (24)
    dw 18
heads:            ; offset 1Ah (26)
    dw 2
hidden_sectors:        ; offset 1Ch (28)
    dd 0
total_sectors_large:    ; offset 20h (32) - not used by this code
    dd 0

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; CODE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

skip_bpb:
; put CPU into a known state
%ifdef DOS
    mov dl,0    ; A: drive
%else
    jmp ((7C00h - FS_ORG) / 16):fix_cs
fix_cs:
    mov ax,cs
    mov ds,ax
    mov es,ax
    mov ss,ax
    mov sp,ADR_STACK
%endif
    mov bp,start
    mov [VAR(boot_drive)],dl
    cld

; calculate some values that we need:
; 16-byte paragraphs per sector
    mov ax,[VAR(bytes_per_sector)]
    mov cl,4
    shr ax,cl
    mov [VAR(para_per_sector)],ax

; 16-byte paragraphics per cluster
    xor dh,dh
    mov dl,[VAR(sectors_per_cluster)]
    mul dx
    mov [VAR(para_per_cluster)],ax

; 32-byte FAT directory entries per sector
    mov ax,[VAR(bytes_per_sector)]
    mov bx,32 ; bytes/dirent
    xor dx,dx
    div bx
    mov [VAR(dir_ents_per_sector)],ax

; number of sectors used for root directory (store in CX)
    mov ax,[VAR(num_root_dir_ents)]
    mul bx
    div word [VAR(bytes_per_sector)]
    mov cx,ax

; first sector of root directory
    xor ah,ah
    mov al,[VAR(num_fats)]
    mul word [VAR(sectors_per_fat)]
    add ax,[VAR(num_reserved_sectors)]

; first sector of disk data area:
    mov si,ax
    add si,cx
    mov [VAR(data_start)],si

; scan root directory for file. We don't bother to check for deleted
; entries or 'virgin' entries (first byte = 0) that mark end of directory
    mov bx,ADR_DIRBUF
next_sect:
    push cx
        mov cx,1
        call read_sectors_chs
    pop cx
    jc disk_error
    mov si,bx
    push cx
        mov cx,[VAR(dir_ents_per_sector)]
next_ent:
        mov di,ss_name
        push si
        push cx
            mov cx,11 ; 8.3 FAT filename
            rep cmpsb
        pop cx
        pop si
        je found_it
        add si,32    ; bytes/dirent
        loop next_ent
    pop cx
    add ax,byte 1    ; next sector
    adc dx,byte 0
    loop next_sect
    mov al,'F'    ; file not found; display blinking 'F'

; 'hide' the next 2-byte instruction by converting it to CMP AX,NNNN
; I learned this trick from Microsoft's Color Computer BASIC :)
    db 3Dh
disk_error:
    mov al,'R'    ; disk read error; display blinking 'R'
error:
    mov ah,9Fh    ; blinking blue-on-white attribute
    mov bx,0B800h    ; xxx - 0B800h assumes color emulation...
    mov es,bx    ; ...should still be able to hear the beep
    mov [es:0],ax

    mov ax,0E07h    ; *** BEEEP ***
    int 10h
exit:
%ifdef DOS
    mov ax,4C01h
    int 21h
%else
    mov ah,0    ; await key pressed
    int 16h

    int 19h        ; re-start the boot process
%endif

found_it:
; leave the old CX value on the stack to save a byte or two
; Get conventional memory size (Kbytes) in AX
        int 12h

; subtract load address
%ifdef DOS
        mov dx,ds
        add dx,((SS_ADR - 7C00h) / 16)
        mov cl,6
        shr dx,cl
        sub ax,dx
%else
        sub ax,(SS_ADR / 1024)
%endif

; convert from K to bytes
        mov dx,1024
        mul dx

; 32-bit file size (4 bytes) is at [si + 28]
; If second stage file is too big...
        sub ax,[si + 28]
        sbb dx,[si + 30]

; ...display a blinking 'M'
        mov al,'M'
        jc error

; get starting cluster of file
        mov si,[si + 26]

; set load address DI:BX
        xor bx,bx
%ifdef DOS
        mov di,ds
        add di,(SS_ADR / 16)
%else
        mov di,(SS_ADR / 16)
%endif
        xor ch,ch
        mov cl,[VAR(sectors_per_cluster)]
next_cluster:
; convert 16-bit cluster value (in SI) to 32-bit LBA sector value (in DX:AX)
; and get next cluster in SI
        call walk_fat
        jc disk_error

; xxx - this will always load an entire cluster (e.g. 64 sectors),
; even if the file is shorter than this
        mov es,di
        call read_sectors_chs
        jc disk_error
        add di,[VAR(para_per_cluster)]

; 0FF6h: reserved    0FF7h: bad cluster
; 0FF8h-0FFEh: reserved    0FFFh: end of cluster chain
        cmp si,0FF6h
        jb next_cluster

; turn off floppy motor
        mov dx,3F2h
        mov al,0
        out dx,al

; jump to second stage loaded at SS_ADR and ORGed to address SS_ORG
%ifdef DOS
; build or copy a PSP for the second stage? nah, too much work...
        mov ax,ds
        add ax,((SS_ADR - SS_ORG) / 16)
%else
        mov ax,((SS_ADR - SS_ORG) / 16)
%endif
        mov ds,ax
        mov es,ax

; we leave SS:SP as they were
; Here is the actual far 'jump' to the second stage (RETF, actually)
        push ax
        mov bx,SS_ORG
        push bx
        retf

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; name:            read_sectors_chs
; action:        reads one or more disk sectors using INT 13h AH=02h
; in:            DX:AX=LBA number of sector to read (relative to
;            start of partition), CX=sector count, ES:BX -> buffer
; out (disk error):    CY=1
; out (success):    CY=0
; modifies:        (nothing)
; minimum CPU:        8088
; notes:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

read_sectors_chs:
    push es
    push di
    push dx
    push cx
    push ax

; DX:AX==LBA sector number
; add partition start (= number of hidden sectors)
        add ax,[VAR(hidden_sectors + 0)]
        adc dx,[VAR(hidden_sectors + 2)]
        inc cx
        jmp short rsc_3
rsc_1:
        push dx
        push cx
        push ax

; DX:AX=LBA sector number
; divide by number of sectors per track to get sector number
; Use 32:16 DIV instead of 64:32 DIV for 8088 compatability
; Use two-step 32:16 divide to avoid overflow
            mov cx,ax
            mov ax,dx
            xor dx,dx
            div word [VAR(sectors_per_track)]
            xchg cx,ax
            div word [VAR(sectors_per_track)]
            xchg cx,dx

; DX:AX=quotient, CX=remainder=sector (S) - 1
; divide quotient by number of heads
            mov di,ax
            mov ax,dx
            xor dx,dx
            div word [VAR(heads)]
            xchg di,ax
            div word [VAR(heads)]
            xchg di,dx

; DX:AX=quotient=cylinder (C), DI=remainder=head (H)
; error if cylinder >=1024
            or dx,dx    ; DX != 0; so cyl >= 65536
            stc
            jne rsc_2
            cmp ah,4    ; AH >= 4; so cyl >= 1024
            cmc
            jb rsc_2

; move variables into registers for INT 13h AH=02h
            mov dx,di
            mov dh,dl    ; DH=head
            inc cx        ; CL5:0=sector
            mov ch,al    ; CH=cylinder 7:0
            shl cl,1
            shl cl,1
            shr ah,1
            rcr cl,1
            shr ah,1
            rcr cl,1    ; CL7:6=cylinder 9:8
            mov dl,[VAR(boot_drive)] ; DL=drive

; we call INT 13h AH=02h once for each sector. Multi-sector reads
; may fail if we cross a track or 64K boundary
            mov ax,0201h    ; AH=02h, AL=num_sectors
            int 13h
            jnc rsc_2
; reset drive
            xor ax,ax
            int 13h
            jc rsc_2
; try read again
            mov ax,0201h
            int 13h
rsc_2:
        pop ax
        pop cx
        pop dx
        jc rsc_4

; increment segment part of address and LBA sector number, and loop
        mov di,es
        add di,[VAR(para_per_sector)]
        mov es,di
        inc ax
        jne rsc_3
        inc dx
rsc_3:
        loop rsc_1
rsc_4:
    pop ax
    pop cx
    pop dx
    pop di
    pop es
    ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; name:            walk_fat
; action:        converts cluster number to sector number and
;            finds next cluster in chain
; in:            SI = cluster
; out (disk error):    CY=1
; out (success):    CY=0, SI = next cluster, DX:AX = sector number
; modifies:        AX, DX, SI
; minimum CPU:        8088
; notes:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

walk_fat:
    push es
    push di
    push cx
    push bx

; cluster 2 is the first data cluster
        lea ax,[si - 2]

; convert from clusters to sectors
        mov dh,0
        mov dl,[VAR(sectors_per_cluster)]
        mul dx
        add ax,[VAR(data_start)]
        adc dx,byte 0

; DX:AX is return value: save it
        push dx
        push ax

; prepare to load FAT
%ifdef DOS
            mov ax,ds
            add ax,(ADR_FATBUF / 16)
%else
            mov ax,(ADR_FATBUF / 16)
%endif
            mov es,ax
            xor bx,bx

; FAT12 entries are 12 bits, bytes are 8 bits. Ratio is 3 / 2,
; so multiply cluster by 3 now, and divide by 2 later.
            xor dx,dx
            mov ax,si
            shl ax,1
            rcl dx,1
            add ax,si
            adc dx,byte 0

; DX:AX b0    =use high or low 12 bits of 16-bit value read from FAT
; DX:AX b9:1    =byte offset into FAT sector (9 bits assumes 512-byte sectors)
; DX:AX b?:10    =which sector of FAT to load
            mov di,ax
            shr dx,1
            rcr ax,1
            div word [VAR(bytes_per_sector)]

; remainder is byte offset into FAT sector: put it in SI
            mov si,dx

; quotient in AX is FAT sector: add FAT starting sector
            add ax,[VAR(fat_start)]

; check the FAT buffer to see if this sector is already loaded
; (simple disk cache; speeds things up a little --
; actually, it speeds things up a lot)
            cmp ax,[curr_sector]
            je wf_1
            mov [curr_sector],ax

; read the target FAT sector. FAT12 entries may straddle a sector
; boundary, so read 2 sectors.
            xor dx,dx
            mov cx,2
            call read_sectors_chs
            jc wf_4
wf_1:
; get 16 bits from FAT
            mov ax,[es:bx + si]

; look at CX:0 to see if we want the high 12 bits or the low 12 bits
            shr di,1
            jc wf_2
            and ax,0FFFh    ; CY=1: use low 12 bits
            jmp short wf_3
wf_2:
            mov cl,4
            shr ax,cl    ; CY=0: use high 12 bits
wf_3:
            mov si,ax

; clear CY bit to signal success
            xor dx,dx
wf_4:
        pop ax
        pop dx
    pop bx
    pop cx
    pop di
    pop es
    ret

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; DATA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; which sector is in the FAT buffer
; this is relative to partition start, so we need only 16 bits
curr_sector:
    dw -1
ss_name:
    db SS_NAME

; pad with NOPs to offset 510
    times (510 + $$ - $) nop

; 2-byte magic bootsector signature
    db 55h, 0AAh





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




















优秀的范例,FreeDos的代码,十几年来变动不大:
;
; File:
;                            boot.asm
; Description:
;                           DOS-C boot
;
;                       Copyright (c) 1997;
;                           Svante Frey
;                       All Rights Reserved
;
; This file is part of DOS-C.
;
; DOS-C is free software; you can redistribute it and/or
; modify it under the terms of the GNU General Public License
; as published by the Free Software Foundation; either version
; 2, or (at your option) any later version.
;
; DOS-C is distributed in the hope that it will be useful, but
; WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
; the GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public
; License along with DOS-C; see the file COPYING.  If not,
; write to the Free Software Foundation, 675 Mass Ave,
; Cambridge, MA 02139, USA.
;
;
;    +--------+
;    |        |
;    |        |
;    |--------| 4000:0000
;    |        |
;    |  FAT   |
;    |        |
;    |--------| 2000:0000
;    |BOOT SEC|
;    |RELOCATE|
;    |--------| 1FE0:0000
;    |        |
;    |        |
;    |        |
;    |        |
;    |--------|
;    |BOOT SEC|
;    |ORIGIN  | 07C0:0000
;    |--------|
;    |        |
;    |        |
;    |        |
;    |--------|
;    |KERNEL  |
;    |LOADED  |
;    |--------| 0060:0000
;    |        |
;    +--------+


;%define ISFAT12         1
;%define ISFAT16         1
;%define CALCPARAMS      1
;%define MULTI_SEC_READ  1


segment    .text

%define BASE            0x7c00

                org     BASE

Entry:          jmp     short real_start
        nop

;       bp is initialized to 7c00h
%define bsOemName       bp+0x03      ; OEM label
%define bsBytesPerSec   bp+0x0b      ; bytes/sector
%define bsSecPerClust   bp+0x0d      ; sectors/allocation unit
%define bsResSectors    bp+0x0e      ; # reserved sectors
%define bsFATs          bp+0x10      ; # of fats
%define bsRootDirEnts   bp+0x11      ; # of root dir entries
%define bsSectors       bp+0x13      ; # sectors total in image
%define bsMedia         bp+0x15      ; media descrip: fd=2side9sec, etc...
%define sectPerFat      bp+0x16      ; # sectors in a fat
%define sectPerTrack    bp+0x18      ; # sectors/track
%define nHeads          bp+0x1a      ; # heads
%define nHidden         bp+0x1c      ; # hidden sectors
%define nSectorHuge     bp+0x20      ; # sectors if > 65536
%define drive           bp+0x24      ; drive number
%define extBoot         bp+0x26      ; extended boot signature
%define volid           bp+0x27
%define vollabel        bp+0x2b
%define filesys         bp+0x36

%define LOADSEG         0x0060

%define FATBUF          0x2000          ; offset of temporary buffer for FAT
                                        ; chain

;       Some extra variables

;%define StoreSI         bp+3h          ;temp store

;       To save space, functions that are just called once are
;       implemented as macros instead. Four bytes are saved by
;       avoiding the call / ret instructions.


;       GETDRIVEPARMS:  Calculate start of some disk areas.
;

%macro        GETDRIVEPARMS    0
                mov     si, word [nHidden]
                mov     di, word [nHidden+2]
                add     si, word [bsResSectors]
                adc     di, byte 0              ; DI:SI = first FAT sector

                mov     word [fat_start], si
                mov     word [fat_start+2], di

                mov     al, [bsFATs]
                xor     ah, ah
                mul     word [sectPerFat]       ; DX:AX = total number of FAT sectors

                add     si, ax
                adc     di, dx                  ; DI:SI = first root directory sector
                mov     word [root_dir_start], si
                mov     word [root_dir_start+2], di

                ; Calculate how many sectors the root directory occupies.
                mov     bx, [bsBytesPerSec]
                mov     cl, 5                   ; divide BX by 32
                shr     bx, cl                  ; BX = directory entries per sector

                mov     ax, [bsRootDirEnts]
                xor     dx, dx
                div     bx

                mov     word [RootDirSecs], ax  ; AX = sectors per root directory

                add     si, ax
                adc     di, byte 0              ; DI:SI = first data sector

                mov     [data_start], si
                mov     [data_start+2], di
%endmacro

;-----------------------------------------------------------------------

        times    0x3E-$+$$ db 0

%define tempbuf         bp+0x3E
                dw      LOADSEG

%ifdef CALCPARAMS
%define RootDirSecs     bp+0x27         ; # of sectors root dir uses

%define fat_start       bp+0x29         ; first FAT sector

%define root_dir_start  bp+0x2D         ; first root directory sector

%define data_start      bp+0x31         ; first data sector

%else
%define RootDirSecs     bp+0x40         ; # of sectors root dir uses
                dw      0

%define fat_start       bp+0x42         ; first FAT sector
                dd      0

%define root_dir_start  bp+0x46         ; first root directory sector
                dd      0

%define data_start      bp+0x4A         ; first data sector
                dd      0
%endif

;-----------------------------------------------------------------------
;   ENTRY
;-----------------------------------------------------------------------

real_start:    cli
        cld
        xor    ax, ax
        mov     ss, ax          ; initialize stack
        mov    ds, ax
        mov     bp, 0x7c00
        lea     sp, [bp-0x20]
        sti
        cmp     byte [drive], 0xff ; BIOS bug ??
        jne    dont_use_dl
                mov     [drive], dl    ; BIOS passes drive number in DL
                            ; a reset should not be needed here
dont_use_dl:    
;        int     0x13            ; reset drive

;        int    0x12        ; get memory available in AX
;        mov    ax, 0x01e0
;        mov    cl, 6        ; move boot sector to higher memory
;        shl    ax, cl
;        sub    ax, 0x07e0

        mov    ax, 0x1FE0
        mov    es, ax
        mov    si, bp
        mov    di, bp
        mov    cx, 0x0100
        rep    movsw
                jmp     word 0x1FE0:cont

cont:           mov     ds, ax
        mov    ss, ax

                call    print
                db      "FreeDOS",0

%ifdef CALCPARAMS
                GETDRIVEPARMS
%endif


;       FINDFILE: Searches for the file in the root directory.
;
;       Returns:
;                               AX = first cluster of file

                ; First, read the whole root directory
                ; into the temporary buffer.

                mov     ax, word [root_dir_start]
                mov     dx, word [root_dir_start+2]
                mov     di, word [RootDirSecs]
                xor     bx, bx
                mov     word [tempbuf], LOADSEG
                mov     es, [tempbuf]
                call    readDisk
                jc      jmp_boot_error

                xor     di, di

        ; Search for KERNEL.SYS file name, and find start cluster.

next_entry:     mov     cx, 11
                mov     si, filename
                push    di
                repe    cmpsb
                pop     di
                mov     ax, [es:di+0x1A]; get cluster number from directory entry
                je      ffDone

                add     di, byte 0x20   ; go to next directory entry
                cmp     byte [es:di], 0    ; if the first byte of the name is 0,
                jnz     next_entry    ; there is no more files in the directory

                jc      boot_error    ; fail if not found
ffDone:
                push    ax              ; store first cluster number

                call    print
                db      " FAT",0



;       GETFATCHAIN:
;
;       Reads the FAT chain and stores it in a temporary buffer in the first
;       64 kb.  The FAT chain is stored an array of 16-bit cluster numbers,
;       ending with 0.
;
;       The file must fit in conventional memory, so it can't be larger than
;       640 kb. The sector size must be at least 512 bytes, so the FAT chain
;       can't be larger than around 3 kb.
;
;       Call with:      AX = first cluster in chain

                ; Load the complete FAT into memory. The FAT can't be larger
                ; than 128 kb, so it should fit in the temporary buffer.

                mov     es, [tempbuf]
                xor     bx, bx
                mov     di, [sectPerFat]
                mov     ax, word [fat_start]
                mov     dx, word [fat_start+2]
                call    readDisk
                pop     ax                      ; restore first cluster number
jmp_boot_error: jc      boot_error

                ; Set ES:DI to the temporary storage for the FAT chain.
                push    ds
                push    es
                pop     ds
                pop     es
                mov     di, FATBUF

next_clust:     stosw                           ; store cluster number
                mov     si, ax                  ; SI = cluster number

%ifdef ISFAT12
                ; This is a FAT-12 disk.

fat_12:         add     si, si          ; multiply cluster number by 3...
                add     si, ax
                shr     si, 1           ; ...and divide by 2
                lodsw

                ; If the cluster number was even, the cluster value is now in
                ; bits 0-11 of AX. If the cluster number was odd, the cluster
                ; value is in bits 4-15, and must be shifted right 4 bits. If
                ; the number was odd, CF was set in the last shift instruction.

                jnc     fat_even
                mov     cl, 4
                shr     ax, cl          ; shift the cluster number

fat_even:       and     ah, 0x0f        ; mask off the highest 4 bits
                cmp     ax, 0x0ff8      ; check for EOF
                jb      next_clust      ; continue if not EOF

%endif
%ifdef ISFAT16
                ; This is a FAT-16 disk. The maximal size of a 16-bit FAT
                ; is 128 kb, so it may not fit within a single 64 kb segment.

fat_16:         mov     dx, [tempbuf]
                add     si, si          ; multiply cluster number by two
                jnc     first_half      ; if overflow...
                add     dh, 0x10        ; ...add 64 kb to segment value

first_half:     mov     ds, dx          ; DS:SI = pointer to next cluster
                lodsw                   ; AX = next cluster

                cmp     ax, 0xfff8      ; >= FFF8 = 16-bit EOF
                jb      next_clust      ; continue if not EOF
%endif

finished:       ; Mark end of FAT chain with 0, so we have a single
                ; EOF marker for both FAT-12 and FAT-16 systems.

                xor     ax, ax
                stosw

                push    cs
                pop     ds

                call    print
                db      " Kernel",0            ; "KERNEL"
                

;       loadFile: Loads the file into memory, one cluster at a time.

                mov     es, [tempbuf]   ; set ES:BX to load address
                xor     bx, bx

                mov     si, FATBUF      ; set DS:SI to the FAT chain

cluster_next:   lodsw                           ; AX = next cluster to read
                or      ax, ax                  ; if EOF...
                je      boot_success            ; ...boot was successful

                dec     ax                      ; cluster numbers start with 2
                dec     ax

                mov     di, word [bsSecPerClust]
                and     di, 0xff                ; DI = sectors per cluster
                mul     di
                add     ax, [data_start]
                adc     dx, [data_start+2]      ; DX:AX = first sector to read
                call    readDisk
                jnc     cluster_next


boot_error:     call    print
                db      13,10,"BOOT err!",0

        xor    ah,ah
        int    0x16            ; wait for a key
        int    0x19            ; reboot the machine

boot_success:   call    print
                db      " GO! ",0
                mov     bl, [drive]
        jmp    word LOADSEG:0


; prints text after call to this function.

print_1char:        
                xor   bx, bx                   ; video page 0
                mov   ah, 0x0E                 ; else print it
                int   0x10                     ; via TTY mode
print:          pop   si                       ; this is the first character
print1:         lodsb                          ; get token
                push  si                       ; stack up potential return address
                cmp   al, 0                    ; end of string?
                jne   print_1char              ; until done
                ret                            ; and jump to it


;       readDisk:       Reads a number of sectors into memory.
;
;       Call with:      DX:AX = 32-bit DOS sector number
;                       DI = number of sectors to read
;                       ES:BX = destination buffer
;                       ES must be 64k aligned (1000h, 2000h etc).
;
;       Returns:        CF set on error
;                       ES:BX points one byte after the last byte read.

readDisk:       push    si
read_next:      push    dx
                push    ax

;******************** LBA_READ *******************************

                        ; check for LBA support
        push     bx
                                        
          mov     ah,041h        ;
            mov     bx,055aah    ;
                mov     dl, [drive]
        test    dl,dl            ; don't use LBA addressing on A:
        jz    read_normal_BIOS    ; might be a (buggy)
                        ; CDROM-BOOT floppy emulation

                int     0x13
                jc    read_normal_BIOS

                sub    bx,0aa55h
                jne    read_normal_BIOS
                
                shr     cx,1            ; CX must have 1 bit set
                jnc    read_normal_BIOS
                  
                        ; OK, drive seems to support LBA addressing

        lea    si,[LBA_DISK_PARAMETER_BLOCK]
                            
                        ; setup LBA disk block                                
        mov    [si+12],bx
        mov    [si+14],bx
    
        pop    bx
        
        pop    ax
        pop    dx
        push    dx
        push    ax
        mov    [si+ 8],ax
        mov    [si+10],dx
            mov    [si+4],bx
        mov    [si+6],es


        mov    ah,042h
                jmp short    do_int13_read

LBA_DISK_PARAMETER_BLOCK:
        db 10h        ; constant size of block
        db  0
        dw  1        ; 1 sector read
                            ; and overflow into code !!!
                            


read_normal_BIOS:      
                pop     bx

        pop    ax
        pop    dx
        push    dx
        push    ax
;******************** END OF LBA_READ ************************


                ;
                ; translate sector number to BIOS parameters
                ;

                ;
                ; abs = sector                          offset in track
                ;     + head * sectPerTrack             offset in cylinder
                ;     + track * sectPerTrack * nHeads   offset in platter
                ;
                xchg    ax, cx
                mov     al, [sectPerTrack]
                mul     byte [nHeads]
                xchg    ax, cx
                ; cx = nHeads * sectPerTrack <= 255*63
; dx:ax = abs
div cx
; ax = track, dx = sector + head * sectPertrack
xchg ax, dx
; dx = track, ax = sector + head * sectPertrack
div byte [sectPerTrack]
; dx = track, al = head, ah = sector
mov cx, dx
; cx = track, al = head, ah = sector

; the following manipulations are necessary in order to
; properly place parameters into registers.
; ch = cylinder number low 8 bits
; cl = 7-6: cylinder high two bits
; 5-0: sector
mov dh, al ; save head into dh for bios
xchg ch, cl ; set cyl no low 8 bits
ror cl, 1 ; move track high bits into
ror cl, 1 ; bits 7-6 (assumes top = 0)
mov al, byte [sectPerTrack]
sub al, ah ; al has # of sectors left
inc ah ; sector offset from 1
or cl, ah ; merge sector into cylinder

%ifdef MULTI_SEC_READ
; Calculate how many sectors can be transfered in this read
; due to dma boundary conditions.
push dx

mov si, di ; temp register save
; this computes remaining bytes because of modulo 65536
; nature of dma boundary condition
mov ax, bx ; get offset pointer
neg ax ; and convert to bytes
jz ax_min_1 ; started at seg:0, skip ahead

xor dx, dx ; convert to sectors
div word [bsBytesPerSec]

cmp ax, di ; check remainder vs. asked
jb ax_min_1 ; less, skip ahead
mov si, ax ; transfer only what we can

ax_min_1: pop dx

; Check that request sectors do not exceed track boundary
mov si, [sectPerTrack]
inc si
mov ax, cx ; get the sector/cyl byte
and ax, 0x3f ; and mask out sector
sub si, ax ; si has how many we can read
mov ax, di
cmp si, di ; see if asked <= available
jge ax_min_2
mov ax, si ; get what can be xfered

ax_min_2: push ax
mov ah, 2
mov dl, [drive]
int 0x13
pop ax
%else
mov ax, 0x0201
do_int13_read:
mov dl, [drive]
int 0x13
%endif

read_finished:
jnc read_ok ; jump if no error
xor ah, ah ; else, reset floppy
int 0x13
pop ax
pop dx ; and...
read_next_chained:
jmp short read_next ; read the same sector again

read_ok:
%ifdef MULTI_SEC_READ
mul word [bsBytesPerSec] ; add number of bytes read to BX
add bx, ax
%else
add bx, word [bsBytesPerSec]
%endif
jnc no_incr_es ; if overflow...

mov ax, es
add ah, 0x10 ; ...add 1000h to ES
mov es, ax

no_incr_es: pop ax
pop dx ; DX:AX = last sector number

%ifdef MULTI_SEC_READ
add ax, si
adc dx, byte 0 ; DX:AX = next sector to read
sub di,si ; if there is anything left to read,
jg read_next ; continue
%else
add ax, byte 1
adc dx, byte 0 ; DX:AX = next sector to read
dec di ; if there is anything left to read,
jnz read_next_chained ; continue
%endif

clc
pop si
ret

filename db "KERNEL SYS"

times 0x01fe-$+$$ db 0

sign dw 0xAA55



----
掬水月在手
弄花香满身

[关闭][返回]