I wrote or thought I wrote the code to switch to protected mode but as soon as
it does mov cr0, eax with eax having bit 0 set, computer resets. Isn't it possible to switch to P-mode without reset? or am I missing something Thanks!
.386p
DATA SEGMENT USE16 'DATA' AT 0000h ; segment starts at 0000h.
ORG 0000h ; start of first 32 Int Vectors.
ORG 0100h ; start of NUL descriptor.
; Global Descriptor Table. Length of DES0+1+2 = 17h.
DES0 db 8 dup (?) ; NUL descriptor.
DES1 db 8 dup (?) ; data descriptor.
DES2 db 8 dup (?) ; code descriptor.
IDT db 6 dup (?) ; IDT.
GDT db 6 dup (?) ; GDT.
DATA ENDS
STACK SEGMENT PARA STACK 'STACK'
db 32 dup ('$')
STACK ENDS
CODE SEGMENT PARA PUBLIC USE16 'CODE'
ASSUME CS:CODE, DS:DATA, SS:STACK
Main PROC FAR
mov ax, DATA ; initialize segment registers
mov ds, ax
ASSUME DS:DATA
mov ax, STACK
mov ss, ax
ASSUME SS:STACK
nop
; Initialize data descriptor.
; 1111 1111 1111 1111 (limit L15-L0).
; 0000 0000 0000 0000 (base B15-B0).
; 0000 0000 1001 1110 (base B23-B16, Access Rights).
; 1000 1111 0000 0000 (G D 0 AVL LimitL16-19 base B24-B31).
mov si, OFFSET DATA:DES1 ; (SI) = ofs ptr, data descriptor.
mov ds:[si+0], BYTE PTR 0ffh
mov ds:[si+1], BYTE PTR 0ffh
mov ds:[si+2], BYTE PTR 00h
mov ds:[si+3], BYTE PTR 00h
mov ds:[si+4], BYTE PTR 00h
mov ds:[si+5], BYTE PTR 9eh
mov ds:[si+6], BYTE PTR 8fh
mov ds:[si+7], BYTE PTR 00h
; Initialize code descriptor.
; 1111 1111 1111 1111 (limit L15-L0).
; 0000 0000 0000 0000 (base B15-B0).
; 0000 0000 1001 0010 (base B23-B16, Access Rights).
; 1000 1111 0000 0000 (G D 0 AVL LimitL16-19 base B24-B31).
mov si, OFFSET DATA:DES2 ; (SI) = ofs ptr, code descriptor.
mov ds:[si+0], BYTE PTR 0ffh
mov ds:[si+1], BYTE PTR 0ffh
mov ds:[si+2], BYTE PTR 00h
mov ds:[si+3], BYTE PTR 00h
mov ds:[si+4], BYTE PTR 00h
mov ds:[si+5], BYTE PTR 92h
mov ds:[si+6], BYTE PTR 8fh
mov ds:[si+7], BYTE PTR 00h
; Initialize Interrupt Descriptor Table.
mov si, OFFSET DATA:IDT ; (SI) = ofs ptr, IDT.
; Size of IDT 16-bit. limit is 0ffh.
mov ds:[si+0], BYTE PTR 000h
mov ds:[si+1], BYTE PTR 0ffh
; Base of IDT 32-bit. base is 0.
mov ds:[si+2], BYTE PTR 00h
mov ds:[si+3], BYTE PTR 00h
mov ds:[si+4], BYTE PTR 00h
mov ds:[si+5], BYTE PTR 00h
mov si, OFFSET DATA:GDT ; (SI) = ofs ptr, GDT.
; Size of GDT 16-bit. limit is 017h.
mov ds:[si+0], BYTE PTR 00h
mov ds:[si+1], BYTE PTR 17h
; Base of GDT 32-bit. base is 0.
mov ds:[si+2], BYTE PTR 00h
mov ds:[si+3], BYTE PTR 00h
mov ds:[si+4], BYTE PTR 00h
mov ds:[si+5], BYTE PTR 00h
lidt FWORD PTR IDT ; load IDT Register (4bytes).
lgdt FWORD PTR GDT ; load GDT Register (4bytes).
nop
mov eax, cr0 ; (EAX) = CR0 register.
or al, 1 ; set PE bit (enable protected mode).
mov cr0, eax ; switch to protected mode.
jmp Main_Start1 ; intrasegment jump to flush internal instruction queue.
Main_Start1:
; Load Global Descriptor Table to segment registers.
; To be loaded into selector/segment register. Selector format is:
; SSSS SSSS SSSS STRR where:
; S = selector number/descriptor number.
; T = TI bit. 1 = LDT, 0 = LDT.
; RPL = Requested Privilege Level.
; 0000 0000 0001 0000. Selector 2, GDT, RPL = 00. Load selector
; pattern into segment registers.
mov ax, 10h
mov ds, ax
mov es, ax
mov ss, ax
mov gs, ax
mov fs, ax
Main_End:
mov ah, 04ch ; (AH) = terminate process fcn code.
int 21h
ret
Main ENDP
CODE ENDS
END Main
Disabling interrupts is STRONGLY advised before switching (in fact I'd do it as the first instruction - before you even set up the stack); and don't enable them again until you're safely in pmode with all of the tables and registers set up.
Also, it looks like you're trying use pmode as 16-bit - which could work assuming you've set up the gdt correctly (I haven't checked your values) - is that what you really intend? Plus, Int 21 is generally provided by dos - is this available in the environment you're running in? -- and I'm not sure how that function will handle being in pmode.
... and setting base of IDT and GDT both to 0 possibly isn't that good an idea either. The bases of these two important tables should be different, because they contain different stuff. And 0 isn't a good base anyway.
calling int 21h, ah=4CH in protected mode will work if you run under a DPMI host, which is not the case here. You will have to carefully switch back to real-mode by directly writing to CR0 again.
There is no Interrupt Descriptor Table, and no interrupt handlers. You seem to be confusing the IDT with the value that is loaded into the IDTR register. Your code still had the reset problem after I replaced the Interrupt 21h call with a dynamic halt (jmp Main_End) and did a CLI before going to PM, so there are probably other things wrong. Also, at the start you are setting SS but not SP, and the value the loader placed in SP is probably not workable, or at least not with a 32-byte stack.
i know it is not a fully prepared protected mode, and I am not trying to work on a protected mode.
Whole purpose of this project is going to be: just switch to p-mode and back to real mode without disturbing at least one selector so that after going back to the real-mode I have an access to extended memory.
Sounds like you want unreal mode (accessing the whole 4gb address range without using segments).
Quote from: sinsi on March 02, 2007, 04:12:14 AM
Sounds like you want unreal mode (accessing the whole 4gb address range without using segments).
yeah exactly i meant big real mode, in fact i modified my code to something like this and still it freezes or resets. Here i made only GDT and cleared flag before going to P mode and immediately coming back to big real.
Can someone modify so that it switches to P and back to big real?
Also is there a way put attachment, i wanna attach whole code instead of pasting. Thanks!
TITLE Main - Main Driver
.386p
DATA SEGMENT PARA PUBLIC USE16 'DATA'
StrErrA20 db 'Error: A20 gate can not be enabled.', 0ah, 0dh, 024h
RstPtrStr db 'RSD PTR '
SuccessStr db 'Found the search string.', 0ah, 0dh, 024h
FailStr db 'Did not find the string.', 0ah, 0dh, 024h
TempStr db 64 dup (?)
StrStart db 'Entering p-mode...', 0ah, 0dh, 024h
DATA ENDS
STACK SEGMENT PARA STACK 'STACK'
db 1024 dup ('$')
STACK ENDS
CODE SEGMENT PARA PUBLIC USE16 'CODE'
include meta.inc
EXTRN CheckA20:NEAR
EXTRN EnableA20:NEAR
EXTRN DisableA20:NEAR
EXTRN PrintHex16:NEAR
EXTRN RealToBigReal:NEAR
ASSUME CS:CODE, DS:DATA, SS:STACK
Main PROC NEAR
mov ax, DATA ; initialize segment registers
mov ds, ax
ASSUME DS:DATA
mov ax, STACK
mov ss, ax
ASSUME SS:STACK
; Switch to protected mode.
mov dx, OFFSET DATA:StrStart
mov ah, 09h
int 21h
cli
call EnableA20 ; enable A20 gate.
call RealToBigReal ; switch to big real mode.
sti
call DisableA20
mov ah, 04ch ; (AH) = terminate process fcn code.
int 21h
ret
Main ENDP
CODE ENDS
END Main
; pmode.asm
TITLE Protected Mode Support.
.386p
include meta.inc
DATA SEGMENT PARA PUBLIC USE16 'DATA'
align 8
TempGdt label qword
; Data segment descriptor.
; 0000 0000 1001 0011 1000 1111 0000 0000
DESC < 0, 0, 0, 0, 0, 0 > ; null descriptor.
DESC < -1, 0, 0, 93h, 8fh, 0 > ; 386 data seg desc.
GdtSiz equ $-TempGdt
TempGdtPtr label fword
DESCPTR < GdtSiz-1, OFFSET DATA:TempGdt>
DATA ENDS
CODE SEGMENT PARA PUBLIC USE16 'CODE'
PUBLIC CheckA20
PUBLIC EnableA20
PUBLIC DisableA20
PUBLIC RealToBigReal
; enable A20 gate.
ASSUME CS:CODE, DS:DATA
EnableA20 PROC NEAR
push dx
push ax
mov dx, 092h
in al, dx
DELAY_NOP 10
or al, 0010b
out dx, al
pop ax
pop dx
ret
EnableA20 ENDP
ASSUME CS:CODE, DS:DATA
DisableA20 PROC NEAR
push dx
push ax
mov dx, 92h
in al, dx
DELAY_NOP 10
and al, (NOT 0010b)
out dx, al
pop ax
pop dx
ret
DisableA20 ENDP
; Switch to protected mode and then immediately switch back to
; big real mode.
; Clear interrupt before calling this function.
RealToBigReal PROC NEAR
push eax
lgdt FWORD PTR TempGdtPtr
; Real to Protected Mode.
mov eax, cr0
or eax, 01h
mov cr0, eax
DELAY_NOP 10 ; flush instruction pipeline.
; Set DS to descriptor.
; SSSS SSSS SSSS STPP
; 0000 0000 0001 0000
; Since big real mode, zero the selectors. Descriptor cache
; will still remain intact.
; Descriptor cache = <base address:limit:access>
; Model: i.e.
; --------------------------------------------------
; | REG | DESCRIPTOR CACHE (program invisible) |
; --------------------------------------------------
; | cx | base address | limit | access |
; --------------------------------------------------
mov ax, 00h
mov ds, ax
mov es, ax
; P-mode to big real.
mov eax, cr0
and eax, 0fffffffeh
mov cr0, eax
IRP X, <'d','o','n','e', 0ah, 0dh>
PrintChar X
ENDM
pop eax
ret
RealToBigReal ENDP
CODE ENDS
END
; print.asm
TITLE Print - Support Printing Various Types to STDOUT.
;*** Print - Support Printing Various Types to STDOUT.
;
;1. Functional Description.
; This module contains routines that print the binary
; data to STDOUT. In order to represent the binary data in
; to STDOUT the conversion to its ASCII equivalent is implemented.
;
;
.386
DATA SEGMENT PARA PUBLIC USE16 'DATA'
DATA ENDS
CODE SEGMENT PARA PUBLIC USE16 'CODE'
include meta.inc
PUBLIC PrintHex32
PUBLIC PrintHex16
PUBLIC PrintHex8
PUBLIC PrintHex4
PUBLIC PrintSpace
PUBLIC PrintNewLine
;*** PrintHex4 - Output 4-bit Value to STDOUT.
;
; FUNCTIONAL DESCRIPTION.
; This routine prints a 4-bit value as a single hex digit on STDOUT.
; WARNINGS.
; none.
;
; ENTRY
; DS - seg ptr, DATA seg.
; AL - bit 0-3 : 4-bit value to be printed.
;
; EXIT
; none.
;
; USES
; flags.
ASSUME CS:CODE, DS:DATA, SS:NOTHING, ES:NOTHING
PrintHex4 PROC NEAR
push dx
push ax
and al, 0fh ; (AL) = retain only 4 MSBs.
add al, 30h ; (AL) = ASCII equivalent if AL is numeric.
cmp al, '9' ; ASCII equivalent is a numeric value?
jbe @f ; if so, skip.
add al, 27h ; if above than '9' hex, then letter value.
@@:
mov dl, al
mov ah, 02h ; (AH) = print char DOS function code.
int 21h ; call function.
pop ax
pop dx
ret
PrintHex4 ENDP
;*** PrintHex8 - Output 8-bit Value to STDOUT.
;
; FUNCTIONAL DESCRIPTION.
; This routine prints a 8-bit value as a double hex digit on STDOUT.
;
;
; WARNINGS.
; none.
;
; ENTRY
; DS - seg ptr, DATA seg.
; AL - 8-bit value to be printed.
;
; EXIT
; none.
;
; USES
; flags.
ASSUME CS:CODE, DS:DATA, SS:NOTHING, ES:NOTHING
PrintHex8 PROC NEAR
push dx
push ax
push ax
and al, 0f0h ; retain only upper 4 bits.
shr al, 4 ; bring upper 4 bits in place of lower 4 bits.
call PrintHex4 ; print it.
pop ax ; (AX) = 4 LSBs.
and al, 0fh ; retain only 4 LSBs.
call PrintHex4 ; print 4 LSBs.
pop ax
pop dx
ret
PrintHex8 ENDP
;*** PrintHex16 - Output 16-bit Value to STDOUT.
;
; FUNCTIONAL DESCRIPTION.
; This routine prints a 16-bit value as a four hex digit on STDOUT.
;
; MODIFICATION HISTORY.
; G. Gankhuyag 07/02/16. #1.0, original
;
; WARNINGS.
; none.
;
; ENTRY
; DS - seg ptr, DATA seg.
; AX - 16-bit value to be printed.
;
; EXIT
; none.
;
; USES
; flags.
ASSUME CS:CODE, DS:DATA, SS:NOTHING, ES:NOTHING
PrintHex16 PROC NEAR
push ax
push ax
and ax, 0ff00h ; retain 8 MSBs.
shr ax, 8 ; put 8 MSBs in place of LSBs.
call PrintHex8 ; print AL.
pop ax ; (AX) = original 8 LSBs.
and ax, 00ffh ; retain only 8 MSBs.
call PrintHex8 ; print AL.
pop ax
ret
PrintHex16 ENDP
;*** PrintHex32 - Output 32-bit Value to STDOUT.
;
; FUNCTIONAL DESCRIPTION.
; This routine prints a 32-bit value as a eight hex digit on STDOUT.
;
; MODIFICATION HISTORY.
; G. Gankhuyag 07/02/16. #1.0, original
;
; WARNINGS.
; none.
;
; ENTRY
; DS - seg ptr, DATA seg.
; EAX - 32-bit value to be printed.
;
; EXIT
; none.
;
; USES
; flags.
ASSUME CS:CODE, DS:DATA, SS:NOTHING, ES:NOTHING
PrintHex32 PROC NEAR
push eax
push eax
and eax, 0ffff0000h ; retain 16 MSBs.
shr eax, 16 ; put 16 MSBs in place of LSBs.
call PrintHex16 ; print AX.
pop eax ; (AX) = original 16 LSBs.
and eax, 0000ffffh ; retain only 16 LSBs.
call PrintHex16 ; print AX.
pop eax
ret
PrintHex32 ENDP
;*** PrintSpace - Print Space Character to STDOUT.
;
; FUNCTIONAL DESCRIPTION.
; This routine prints space character to STDOUT. When there is a
; need to print space character many times, using this function saves
; lines of code and improve readibility since it takes several lines
; of code to print single space character.
;
; MODIFICATION HISTORY.
; G. Gankhuyag 07/02/16. #1.0, original
;
; WARNINGS.
; none.
;
; ENTRY
; DS - seg ptr, DATA seg.
;
; EXIT
; none.
;
; USES
; flags.
ASSUME CS:CODE, DS:DATA, SS:NOTHING, ES:NOTHING
PrintSpace PROC NEAR
push ax
push dx
mov dl, ASCII_SPACE ; (DL) = space char.
mov ah, 02h ; (AH) = print function code.
int 21h ; print it.
pop dx
pop ax
ret
PrintSpace ENDP
;*** PrintNewLine - Print New Line Character to STDOUT.
;
; FUNCTIONAL DESCRIPTION.
; This routine prints new line character to STDOUT. When there is a need
; to print new line character many times, using this function saves
; lines of code and improve readibility since it takes several lines
; of code to print single new line character.
;
; MODIFICATION HISTORY.
; G. Gankhuyag 07/02/16. #1.0, original
;
; WARNINGS.
; none.
;
; ENTRY
; DS - seg ptr, DATA seg.
;
; EXIT
; none.
;
; USES
; flags.
ASSUME CS:CODE, DS:DATA, SS:NOTHING, ES:NOTHING
PrintNewLine PROC NEAR
push ax
push dx
mov dl, ASCII_CR ; (DL) = carriage return.
mov ah, 02h ; (AH) = print function code.
int 21h ; print it.
mov dl, ASCII_LF ; (DL) = new line.
mov ah, 02h ; (AH) = print function code.
int 21h ; print it.
pop dx
pop ax
ret
PrintNewLine ENDP
CODE ENDS
END
;macros.inc
.386p
PrintChar MACRO char
push ax
push dx
mov dl, char
mov ah, 02h
int 21h
pop dx
pop ax
ENDM
DELAY_NOP MACRO times
REPEAT times
nop
endm
ENDM
; META. INC
include pmode.inc
include macros.inc
include const.inc
; PMODE.INC
; BYTE 0 BYTE 1 BYTE 2 BYTE 3
; limit 7:0 limit 15:8 base 7:0 base 15:8
; BYTE 4 BYTE 5 BYTE 6 BYTE 7
; base 23:16 access rights G,D,O,AV base 31:24
; limit 19:16
DESC STRUC
DescLimit dw ?
DescBaseLow dw ?
DescBaseMid db ?
DescAccess db ?
DescFlags db ?
DescBaseTop db ?
DESC ENDS
DESCPTR STRUC
PtrLimit dw ? ; limit for descriptor table.
PtrBase dd ? ; base 2 words.
DESCPTR ENDS
; build.bat
set AFLAGS=/c /Cp /Zm /Fl
set OBJD=obj
set MAP=nul
set LINK=c:\masm611\bin\link.exe
set LIBS=
set LFLAGS=/MAP /SEGMENTS:512
set ASM=c:\masm611\bin\ML
set f0=main
set f1=pmode
set f2=print
%ASM% %AFLAGS% %f0%.asm
%ASM% %AFLAGS% %f1%.asm
%ASM% %AFLAGS% %f2%.asm
%LINK% %LFLAGS% %f0%.obj+%f1%.obj+%f2%.obj, %f0%.exe,,,,
Here is some code I downloaded from...somewhere...can't remember. It's by Herman Dullink (in the attached zip)
ETA: here's some more that I have used myself (after I modified it - this is not my code, I don't know whose it is...)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Enable "unreal" mode
; This code is public domain (no copyright).
; You can do whatever you want with it.
;
; Unreal mode is identical with real mode with one exception: 32-bit
; addresses are allowed (they do not cause INT 0Dh, as they do in real mode)
;
;
; This code will fail if run in virtual 8086 mode (Windows DOS box
; or EMM386 loaded). Oh yeah, a 32-bit CPU is required (386+)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; we're in real mode
BITS 16
; ...
push ds
push es
xor eax,eax ; point gdt_ptr to gdt
mov ax,ds
shl eax,4
add eax,gdt ; EAX=linear address of gdt
mov [gdt_ptr + 2],eax
cli ; interrupts off
lgdt [gdt_ptr]
mov eax,cr0
or al,1
mov cr0,eax ; partial switch to 32-bit pmode
mov bx,DATA_SEL ; selector to segment w/ 4G limit
mov ds,bx
mov es,bx ; set seg limits in descriptor caches
dec al
mov cr0,eax ; back to (un)real mode
pop es ; segment regs back to old values,
pop ds ; but now 32-bit addresses are OK
; ...
gdt: dw 0 ; limit 15:0
dw 0 ; base 15:0
db 0 ; base 23:16
db 0 ; access byte (descriptor type)
db 0 ; limit 19:16, flags
db 0 ; base 31:24
DATA_SEL equ $-gdt
dw 0FFFFh
dw 0
db 0
db 92h ; present, ring 0, data, expand-up, writable
db 0CFh ; page-granular, 32-bit
db 0
gdt_end:
gdt_ptr:
dw gdt_end - gdt - 1 ; GDT limit
dd 0 ; linear adr of GDT (set above)
[attachment deleted by admin]
ok i found the solution ot this problem
now i have another problem.
The CPU switches the Protected mode. But it resets if I load any value into segment register.
Are you loading the value from PM or RM? If from PM, then the value must be a valid selector.
Well i began new project that switches to pmode, but it is also resetting. I had a previous similar project that successfully switched to pmode mode. But I couldn't find out what is causing the latest one to reset and raking my brain to find the cause.
People advised me that the switching to pmode is quite tricky and mentioned about triple fault that causes CPU.
Can anyone give some advice.
Here is step I go into pmode
disable INTs, NMI
set up GDB
set up GDT base and limit value /load GDTR
turn PE on.
I have n't setup IDT, LDT but interrupt is disabled at any time CPU in pmode so it should be ok.
Right after turning the PE on it resets and I know it resets there without debugging, because i am sending a character
to serial port right before and after setting the PE bit and I observe one character at the terminal emulator.