📄 format.asm
字号:
; XXXX01XXB DOS partly in
; XXXX10XXB DOS all in
; XX00XXXXB COMMAND not in
; XX01XXXXB COMMAND partly in
; XX10XXXXB COMMAND all in
USERDIRS DB DIRSTRLEN+3 DUP(?) ; Storage for users current directory
bios a_FileStructure <>
BiosAttributes EQU attr_hidden + attr_system + attr_read_only
dos a_FileStructure <>
DosAttributes EQU attr_hidden + attr_system + attr_read_only
command a_FileStructure <>
CommandAttributes EQU 0
CommandFile DB "X:\COMMAND.COM",0
VOLFCB DB -1,0,0,0,0,0,8
DB 0
VOLNAM DB " "
DB 8
DB 26 DUP(?)
TRANSRC DB "A:CON",0,0 ; Device so we don't hit the drive
TRANDST DB "A:\",0,0,0,0,0,0,0,0,0,0
BEGSEG DW ?
SWITCHMAP DW ?
SWITCHCOPY DW ?
FAT DW ?
DW ?
CLUSSIZ DW ?
SECSIZ DW ?
SYSTRKS DW ?
SECTORS DW ?
INBUFF DB 80,0
DB 80 DUP(?)
ptr_msgHardDiskWarning dw msgHardDiskWarning
dw offset driveLetter
ptr_msgInsertDisk dw msgInsertDisk
dw offset driveLetter
ptr_msgReInsertDisk dw msgReInsertDisk
dw offset driveLetter
ptr_msgInsertDosDisk dw offset msgInsertDosDisk
dw offset systemDriveLetter
ptr_msgFormatNotSupported dw offset msgFormatNotSupported
dw offset driveLetter
drive db 0
driveLetter db "x"
systemDriveLetter db "x"
data ends
;For FORPROC and FORMES modules
public secsiz,clussiz,inbuff
PUBLIC crlf,std_printf
;For OEM module
public switchmap,drive,driveLetter,fatSpace
public fBigFat, PrintString,currentHead,currentCylinder
extrn CheckSwitches:near,LastChanceToSaveIt:near
extrn WriteBootSector:near,OemDone:near
extrn AccessDisk:near
data segment
extrn switchlist:byte
extrn fdsksiz:word
extrn BiosFile:byte,DosFile:byte
data ends
;For FORPROC module
EXTRN FormatAnother?:near,Yes?:near,REPORT:NEAR,USER_STRING:NEAR
data segment
extrn badsiz:dword,syssiz:dword,biosiz:dword
data ends
DOSVER_LOW EQU 0300H+20
DOSVER_HIGH EQU 0300H+20
START:
PUSH AX ;Save DRIVE validity info
MOV AH,GET_VERSION
INT 21H
CMP AX,EXPECTED_VERSION
JE OKDOS
; XCHG AH,AL ;Turn it around to AH.AL
; CMP AX,DOSVER_LOW
; JB GotBadDos
; CMP AX,DOSVER_HIGH
; JBE OKDOS
GOTBADDOS:
MOV DX,OFFSET msgBadDosVersion
mov ax, seg data
mov ds, ax
mov ah,std_con_string_output
int 21h
push es
xor ax,ax
push ax
foo proc far
ret ; Must use this method, version may be < 2.00
foo endp
OKDOS:
mov ax, seg data
mov es, ax
assume es:data
POP AX
CMP AL,0FFH ;See if invalid drive specified
JNZ DRVGD ;If not proceed
BogusDrive:
mov ax, seg data
mov ds, ax
lea dx, msgBadDrive
call PrintString
JMP FEXIT ;Exit
DRVGD:
MOV AH,GET_DEFAULT_DRIVE ;Must get the default drive
INT 21H ;Default now in AL
ADD AL,"A"
MOV [BiosFile],AL
MOV [DosFile],AL
MOV [CommandFile],AL
MOV SI,DRNUM ;So we can get our parameters
LODSB ;Fetch drive designation
OR AL,AL ;See if specified
JNZ DRVSPEC ;If specfied proceed
mov ax, seg data
mov ds, ax
lea dx, msgNeedDrive
call PrintString
jmp fexit
DRVSPEC:
DEC AL ;Drive designator now correct
MOV BYTE PTR DS:[DRNUM],AL ;And updated
MOV DRIVE,AL ;Save copy
add al, 'A'
mov driveLetter, al
; Get all the switch information from the command line
MOV [BEGSEG],DS ;Save start segment
XOR BX,BX ;Store switch information in BX
MOV SI,81H ;Point to the command line buffer
NXTSWT:
CALL SCANOFF
LODSB
CMP AL,"/"
JZ GETPARM
CMP AL,13
JNZ NxtS1
JMP SavSwt
NxtS1:
MOV AH,AL
LODSB ; AX := getchar()
CMP AL,":" ; IF (AX != drive_spec)
JNZ INVALID ; THEN error
CMP BYTE PTR DBLFLG,0 ; IF (previous drive_spec)
JNZ INVALID ; THEN error
INC BYTE PTR DBLFLG ; Yes -- set the flag
OR AH,020h
SUB AH,'a'
CMP AH,Drive
JZ SHORT NXTSWT
JMP BogusDrive
GETPARM:
LODSB
; Convert any lower case input into upper case
CMP AL,41H
JB GETCHR ; Switch is a digit, so don't try to
; convert it.
AND AL,0DFH
GETCHR:
MOV CL,SWITCHLIST ; CL := Number of Legal switches
OR CL,CL ; IF (Num_Legal_Switches == 0)
JZ INVALID ; THEN error
MOV CH,0 ; FOR (i=0; i <= Max_switches; i++)
MOV DI,1+OFFSET SWITCHLIST ; IF (switch == SWITCHLIST[i])
REPNE SCASB ; THEN set zero flag
; END for
JNZ INVALID ; IF (zero_flag != TRUE ) THEN error
MOV AX,1
SHL AX,CL
OR BX,AX ;Set the appropriate bit in SWITCHMAP
MOV CX,AX ; Current_Switch := Switch processed
Test AX,NUM_SWITCHES ; IF (Switch_processed does not require
; numeric value)
JZ NXTSWT ; THEN parse next switch
LODSB ; ELSE then parse :nn and save approp
cmp al,':' ; IF (getchar() != ':')
jne INVALID
LODSB ; curr_num := MakeNum (getchar())
SaveReg <bx,cx>
call MakeNum
RestoreReg <cx,bx>
jc INVALID ; IF error, THEN exit
SaveReg <ds,dx>
Call SaveNum ; SaveNum (curr_num)
Restorereg <dx,ds> ; END else;
JMP SHORT NXTSWT ;See if there are anymore
INVALID:
mov ax, seg data
mov ds, ax
lea dx, msgInvalidParameter
call PrintString
JMP FEXIT
MEMERR:
mov ax, seg data
mov ds, ax
lea dx, msgOutOfMemory
call PrintString
JMP FEXIT
SAVSWT:
mov ax, seg data
mov ds, ax
assume ds:data
MOV SWITCHMAP,BX
; Set memory requirements
mov es, begseg
mov bx, seg _end
sub bx, begseg
mov ah, setblock
int 21H
; trap ^C
mov ax, (Set_Interrupt_Vector shl 8) or 23H
mov dx, offset ControlC_Handler
push ds
push cs
pop ds
int 21H
pop ds
AroundControlC_Handler:
MOV BL,Drive ; x = IOCTL (getdrive, Drive+1);
INC BL
MOV AX,(IOCTL SHL 8) OR 9
INT 21H
JC NotNet
TEST DX,1200H ; if (x & 0x1200)(redirected or shared)
JZ NotNet
lea dx, msgNetDrive ; Cann't format over net
call PrintString
JMP FEXIT
NotNet:
TEST DX,8000h ; if local use
jnz re_assign
MOV BL,Drive
ADD BYTE PTR [TRANSRC],BL ; Make string "D:\"
MOV SI,OFFSET TRANSRC
push ds
pop es
MOV DI,OFFSET TRANDST
MOV AH,xNameTrans
INT 21H
MOV BL,BYTE PTR [TRANSRC]
CMP BL,BYTE PTR [TRANDST] ; Did drive letter change?
JZ NO_ASSIGN ; No
RE_ASSIGN:
lea dx, msgAssignedDrive
call PrintString
JMP FEXIT
NO_ASSIGN:
CALL Phase1Initialisation
jnc FatAllocated
lea dx, msgFormatFailure ; IF (error_allocating_FAT)
call PrintString ; ISSUE error and abort
jmp Fexit
FatAllocated:
TEST SWITCHMAP,SWITCH_S
JZ INITCALL
MOV BX,0FFFFH
MOV AH,ALLOC
INT 21H
OR BX,BX
JZ MEMERRJ ;No memory
MOV [MSIZE],BX
MOV AH,ALLOC
INT 21H
JNC MEM_OK
MEMERRJ:
JMP MEMERR ;No memory
MEM_OK:
MOV [MSTART],AX
RDFRST:
mov bios.fileSizeInParagraphs,0 ;mjb001 initialize file size
mov dos.fileSizeInParagraphs,0 ;mjb001 ...
mov command.fileSizeInParagraphs,0 ;mjb001 ...
CALL READDOS ;Read BIOS and DOS
JNC INITCALL ;OK -- read next file
NEEDSYS:
CALL SYSPRM ;Prompt for system disk
JMP RDFRST ;Try again
INITCALL:
CALL Phase2Initialisation
; Barry S - No reason to jump on carry!!!
; JNC SWITCHCHK
; lea dx, msgFormatFailure
; call PrintString
; JMP FEXIT
SWITCHCHK:
MOV DX,SWITCHMAP
MOV SWITCHCOPY,DX
SYSLOOP:
MOV WORD PTR BADSIZ,0 ;Must intialize for each iteration
MOV WORD PTR BADSIZ+2,0
MOV WORD PTR SYSSIZ,0
MOV WORD PTR SYSSIZ+2,0
MOV BYTE PTR DBLFLG,0
mov ExitStatus, ExitOK
MOV DX,SWITCHCOPY
MOV SWITCHMAP,DX ;Restore original Switches
; DiskFormat will handle call for new disk
; CALL DSKPRM ;Prompt for new disk
CALL DISKFORMAT ;Format the disk
JNC GETTRK
FRMTPROB:
lea dx, msgFormatFailure
call PrintString
mov ExitStatus, ExitFatal
CALL MORE ;See if more disks to format
JMP SHORT SYSLOOP
;Mark any bad sectors in the FATs
;And keep track of how many bytes there are in bad sectors
GETTRK:
CALL BADSECTOR ;Do bad track fix-up
JC FRMTPROB ;Had an error in Formatting - can't recover
CMP AX,0 ;Are we finished?
JNZ TRKFND ;No - check error conditions
JMP DRTFAT ;Yes
TRKFND:
CMP BX,STARTSECTOR ;Are any sectors in the system area bad?
JAE CLRTEST ; MZ 2.26 unsigned compare
lea dx, msgDiskUnusable
call PrintString
JMP FRMTPROB ;Bad disk -- try again
CLRTEST:
MOV SECTORS,AX ;Save the number of sectors on the track
TEST SWITCHMAP,SWITCH_S ;If system requested calculate size
JZ BAD100
CMP BYTE PTR DBLFLG,0 ;Have we already calculated System space?
JNZ CMPTRKS ;Yes -- all ready for the compare
INC BYTE PTR DBLFLG ;No -- set the flag
CALL GETBIOSIZE ; Get the size of the BIOS
MOV DX,WORD PTR SYSSIZ+2
MOV AX,WORD PTR SYSSIZ
MOV WORD PTR BIOSIZ+2,DX
MOV WORD PTR BIOSIZ,AX
CALL GETDOSSIZE
CALL GETCMDSIZE
MOV DX,WORD PTR BIOSIZ+2
MOV AX,WORD PTR BIOSIZ
DIV deviceParameters.DP_BPB.BPB_BytesPerSector
ADD AX,STARTSECTOR
MOV SYSTRKS,AX ;Space FAT,Dir,and system files require
CMPTRKS:
CMP BX,SYSTRKS
JA BAD100 ; MZ 2.26 unsigned compare
mov ExitStatus, ExitFatal
lea dx, msgNotSystemDisk
call PrintString
AND SWITCHMAP,NOT SWITCH_S ;Turn off system transfer switch
MOV WORD PTR SYSSIZ+2,0 ;No system to transfer
MOV WORD PTR SYSSIZ,0 ;No system to transfer
BAD100:
; BX is the first bad sector #, SECTORS is the number of bad sectors
; starting at BX. This needs to be converted to clusters. The start sector
; number may need to be rounded down to a cluster boundry, the end sector
; may need to be rounded up to a cluster boundry. Know BX >= STARTSECTOR
SUB BX,STARTSECTOR ; BX is now DATA area relative
MOV CX,BX
ADD CX,SECTORS
DEC CX ; CX is now the last bad sector #
MOV AX,BX
XOR DX,DX
xor bx,bx
mov bl, deviceParameters.DP_BPB.BPB_SectorsPerCluster
DIV bx
MOV BX,AX ; BX is rounded down and converted to
; a cluster #. Where cluster 0 =
; first cluster of data. First bad
; Sector is in cluster BX.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -