Initial forays into protected mode :3

files/asm32.fth

@@ -26,6 +26,7 @@ constant oper-size
 5 constant optype-[r32]
 6 constant optype-[addr]
 7 constant optype-cr
+8 constant optype-sr
 
 ( stores the data width selected by the user with byte/word/dword )
 variable instr-wide
@@ -84,7 +85,8 @@ exception end-exception not-enough-opers
 : v>ud all-dnums @ invert if 0 then ;
 : .# ( imm. -- ) 0 optype-imm oper, ;
 : # ( imm -- ) v>ud .# ;
-: [#] ( imm -- ) v>ud 0 optype-[addr] oper, ;
+: [.#] ( imm -- ) 0 optype-[addr] oper, ;
+: [#] ( imm. -- ) v>ud [.#] ;
 : reg: ( r t -- r t ) create 2, does> 2@ 0. 2swap oper, ;
 : regs: ( r t n -- ) 0 ?do 2dup reg: >r 1+ r> loop 2drop ;
 : disp: ( r t -- r t ) create 2, does> >r v>d r> 2@ oper, ;
@@ -102,6 +104,7 @@ exception end-exception not-enough-opers
 4 optype-[r32] 4 disps: [esp+#] [ebp+#] [esi+#] [edi+#]
 0 optype-cr reg: cr0 
 2 optype-cr 3 regs: cr2 cr3 cr4
+0 optype-sr 6 regs: es cs ss ds fs gs
 
 : reg-op? ( nth -- t|f ) type@ optype-r8 optype-r32 1+ within ;
 : mem-op? ( nth -- t|f ) type@ optype-[r16] optype-[addr] 1+ within ;
@@ -298,11 +301,22 @@ exception end-exception bad-operands
 0 operand lodsd  data32 $AD db ;
 0 operand cli  $FA db ;
 0 operand sti  $FB db ;
+0 operand retf $CB db ;
 1 operand lgdt  0 mem-op? or-bad-operands
   0 mod-r/m-size  $0F db $01 db 0 2 oper-reg ;
 1 operand jmp   must-wide  0 mod-r/m-size  $FF db 0 4 oper-reg ;
 1 operand push  must-wide  0 $50 reg-offset ;
 1 operand pop   must-wide  0 $58 reg-offset ;
+2 operand jmpf
+  0 type@ optype-imm = or-bad-operands
+  1 type@ optype-imm = or-bad-operands
+  EA db
+  32bit @ if
+    1 disp@ dd
+  else
+    1 disp@ d>s dw
+  then
+  0 disp@ d>s dw ;
 
 2 operand mov
   1 type@ optype-imm = if
@@ -321,13 +335,23 @@ exception end-exception bad-operands
   else
     0 type@ optype-r32 = 1 type@ optype-cr = and if
       $0F db $20 db 0 1 spec@ oper-reg
-    else
-      0 type@ optype-cr = 1 type@ optype-r32 = and if
-        $0F db $22 db 1 0 spec@ oper-reg
-      else
-        $88 op-wideflag op-dir-modrm
-      then
-    then
+    exit then
+
+    0 type@ optype-cr = 1 type@ optype-r32 = and if
+      $0F db $22 db 1 0 spec@ oper-reg
+    exit then
+
+    1 type@ optype-sr = if
+      must-wide 0 mod-r/m-size
+      $8C db 0 1 spec@ oper-reg
+    exit then
+
+    0 type@ optype-sr = if
+      must-wide 1 mod-r/m-size
+      $8E db 1 0 spec@ oper-reg
+    exit then
+
+    $88 op-wideflag op-dir-modrm
   then ;
 
 : aluop

files/asmtest.fth

@@ -87,6 +87,7 @@ t{ mov byte 4 [ebp+#] $69 # #-> C6 45 04 69 }t
 t{ mov byte 123 [esi+#] $69 # #-> C6 86 23 01 00 00 69 }t
 t{ mov word [esi] $2137 # #-> 66 C7 06 37 21 }t
 t{ mov dword [esi] $deadbeef. .# #-> C7 06 EF BE AD DE }t
+t{ mov byte $abcde. [.#] 10 # #-> C6 05 DE BC 0A 00 10 }t
 
 32bit off
 t{ mov al cl #-> 88 C8 }t
@@ -157,6 +158,19 @@ t{ mov edi cr4 #-> 0F 20 E7 }t
 t{ mov cr2 esi #-> 0F 22 D6 }t
 t{ mov edi cr4 #-> 0F 20 E7 }t
 
+32bit off
+t{ mov si cs #-> 8C CE }t
+t{ mov edi ds #-> 66 8C DF }t
+( how-wide is too dumb for these, let's skip it )
+( t{ mov [bx] ss #-> 8C 17 }t         )
+( t{ mov [ecx] es #-> 67 8C 01 }t     )
+
+32bit on
+t{ mov si cs #-> 66 8C CE }t
+t{ mov edi ds #-> 8C DF }t
+( t{ mov [bx] ss #-> 67 8C 17 }t      )
+( t{ mov [ecx] es #-> 8C 01 }t        )
+
 32bit off
 t{ in al dx #-> EC }t
 t{ in ax dx #-> ED }t
@@ -187,5 +201,11 @@ t{ out $69 # al #-> E6 69 }t
 t{ out $69 # ax #-> 66 E7 69 }t
 t{ out $69 # eax #-> E7 69 }t
 
+32bit off
+t{ jmpf $1234 # $5678 # #-> EA 78 56 34 12 }t
+
+32bit on
+t{ jmpf $08 # $deadbeef. .# #-> EA EF BE AD DE 08 00 }t
+
 ' c, is db
 previous

files/go32.fth

@@ -0,0 +1,113 @@
+( switch to protected mode )
+( see also: Intel SDM Volume 3A,                )
+( Section 10.9.1. "Switching to Protected Mode" )
+s" asm32.fth" require Assembler
+
+ds@ 0= #-12 and >in +! alter-0-only
+
+( this address happens to be safe so :p         )
+$A20 constant victim
+victim $10 + constant farvictim
+
+( returns true if A20 is unlocked. possible false negative if the two )
+( memory locations happen to have the same value by chance )
+: (a20?) ( -- t|f )
+  0 fs!         victim farc@
+  $ffff fs!  farvictim farc@ <> ;
+
+: frob-victim ( -- )
+  0 fs!  victim farc@  55 xor  victim farc! ;
+: a20? ( -- t|f )
+  (a20?) if true else
+    frob-victim (a20?) frob-victim
+  then ;
+
+( I'll bother implementing actual unlocking when I find a machine )
+( that needs it ;3 )
+exception end-exception a20-locked
+: a20 ( -- ) a20? invert ['] a20-locked and throw ;
+
+:code cli  cli ;code
+:code sti  sti ;code
+
+( port I/O )
+:code pc@
+  mov dx bx
+  in al dx
+  mov ah 0 #
+  mov bx ax
+;code
+
+:code pc!
+  mov dx bx
+  pop ax
+  out dx al
+  pop bx
+;code
+
+( NMIs )
+: nmi-on  $70 pc@ $7f and $70 pc!  $71 pc@ drop ;
+: nmi-off $70 pc@ $80 or  $70 pc!  $71 pc@ drop ;
+
+( GDT )
+: entries 8 u* ;
+create gdt 3 entries allot
+
+variable access
+$80 constant PRESENT
+$10 constant ~SPECIAL ( this bit is 0 in some shit like TSS )
+$08 constant EXECUTABLE
+$02 constant R/W
+
+variable flags
+$80 constant GRANULARITY
+$40 constant 32BIT
+
+: entry ( selector "name" -- )
+  dup constant $FFF8 and
+  gdt + pos !
+  $FFFF pos, ( limit low )
+  0 pos,     ( base low )
+  access @ 8 lshift pos, ( low 8 bits is base )
+  flags @ $F or     pos, ( high 8 bits is base; low 4 is limit ) ;
+
+GRANULARITY 32BIT or flags !
+PRESENT ~SPECIAL or R/W or EXECUTABLE or access !
+8 entry 32bit-cs
+
+PRESENT ~SPECIAL or R/W or access !
+10 entry 32bit-ds
+
+( GDTR )
+gdt pos !
+3 entries 1- pos, ( size )
+gdt pos, 0 pos, ( address )
+
+:code lgdt
+  lgdt gdt [#]
+;code
+
+( one-time setup )
+lgdt
+a20
+
+( pmode transition )
+:code pmode-entry
+  32bit on
+  mov eax 32bit-ds #
+  mov ds eax
+  mov es eax
+  mov ss eax
+  mov byte $B8000. [.#] 2 #
+  EB db FE db
+  32bit off
+;code
+
+:code (go32)
+  mov eax cr0
+  or al 1 #
+  mov cr0 eax
+  jmpf 32bit-cs # ' pmode-entry #
+;code
+
+: go32 ( -- ) cli nmi-off (go32) ;