module Pentium is import RTL from StdOperators import [ + - := bit < > <= >= | = ? and or xor com shrl shl sx zx ] storage '?' is cells of 32 bits -- enable subscript hack in rewrite.nw -- omit storage 'r' is 8 cells of 32 bits called "registers" 'm' is cells of 8 bits called "memory" aggregate using RTL.AGGL module Reg is locations [ EAX ECX EDX EBX ESP EBP ESI EDI ] is $r[[0..7]] -- EAX is $r[0], etc... [ AX CX DX BX SP BP SI DI ] is $r[[0..7]] @ loc [0..15] [ AL CL DL BL ] is [EAX ECX EDX EBX] @ loc [8 bits at 0] [ AH CH DH BH ] is [EAX ECX EDX EBX] @ loc [8 bits at 8] val byte is [. AL, CL, DL, BL, AH, CH, DH, BH .] val word is [. AX, CX, DX, BX, SP, BP, SI, DI .] val dword is [. EAX, ECX, EDX, EBX, ESP, EBP, ESI, EDI .] storage 'c' is 2 cells of 32 bits called "control registers" locations [ EFLAGS EIP ] is $c[[0..1]] locations [ CF PF AF ZF SF OF ] is EFLAGS @ loc [1 bit at [0 2 4 6 7 11]] -- carry parity auxiliary-carry zero sign overflow end operand ss : #2 bits operand [ base index r16 r32 r8 sr16] : #3 bits operand i8 : #8 bits operand i16 : #16 bits operand i32 : #32 bits operand d8 : #8 bits operand [a d32] : #32 bits operand [r reg] : #3 bits operand Mem : #32 bits operand addr : { b : #8 loc, w : #16 loc, d : #32 loc } operand i : #99 bits -- grim cheat -- omit fun regb n is Reg.byte sub n -- returns an 8-bit location fun regw n is Reg.word sub n -- returns a 16-bit location fun regd n is Reg.dword sub n -- returns a 32-bit location val [>> <<] is \(n, k).[shrl shl] (32, n, k) infixl 8 [>> <<] fun R n is {b is regb n, w is regw n, d is regd n} fun M address is { b is $m[address] : #8 loc , w is $m[address] : #16 loc , d is $m[address] : #32 loc } fun I immed is { b is zx immed : #8 bits , w is zx immed : #16 bits , d is zx immed : #32 bits } default attribute of Indir (r) is regd r Disp8 (d8, r) is sx d8 + regd r Disp32 (d32, r) is d32 + regd r Index ( base, index, ss) is regd base + regd index << ss Index8 (d8, base, index, ss) is regd base + sx d8 + regd index << ss Index32 (d32, base, index, ss) is regd base + d32 + regd index << ss ShortIndex (d8, index, ss) is sx d8 + regd index << ss Abs32 (a) is a E (Mem) is M Mem Reg (r) is R r val [OF CF AF SF ZF PF] is [Reg.OF Reg.CF Reg.AF Reg.SF Reg.ZF Reg.PF] rtlop parity : #n bits -> #1 bits -- (number of bits set) mod 2 fun set_flags {result, o, a, c} is SF := bit (result < 0) | ZF := bit (result = 0) | PF := bit (parity (result@bits[0..7]) = 0) | OF := o | AF := a | CF := c fun llr (left, op, right) (size as (sl, sr)) is sl left := op((sl left), sr right) fun [b w d] {b, w, d} is [b w d] -- b, w, d select correct size from record val [b w d] is [(b,b) (w,w) (d,d)] -- b, w, d renamed to pairs nonfix [< >] val [lt gt] is [< >] -- save these for later fun < (l, operator) is { l is l, operator is operator } fun > ({l, operator}, r) is { l is l, operator is operator, r is r } fun <== (dst, {l, operator, r}) is { dst is dst, l is l, operator is operator, r is r} infixn ~10 < infixn ~11 > infixn ~12 <== fun bin {dst, l, operator, r} (sdl, sr) is sdl dst := operator (sdl l, sr r) fun logical_flags n is set_flags {result is n, o is 0, c is 0, a is ?} fun bin' {dst, l, operator, r} (sdl, sr) is let val result is operator (sdl l, sr r) in {result is result, effect is sdl dst := result} end fun logical main arg size is let val {result, effect} is main arg size in effect | logical_flags result end fun llr' l op r (sl, sr) extra is sl l := op(sl l, sr r) | extra (op(sl l, sr r)) fun logical' l op r size is llr' l op r size logical_flags val idsize is (\x.x, \x.x) fun unary (op, v) (size, _) is size v := op (size v) local infixl 3 and in default attribute of ANDiAL (i8) is Reg.AL := Reg.AL and i8 ANDiAX (i16) is Reg.AX := Reg.AX and i16 ANDiEAX (i32) is Reg.EAX := Reg.EAX and i32 ANDi ^[b w d] (addr, i) is llr (addr, (and), I i) [b w d] ANDio^[w d]^b (addr, i) is llr (addr, (and), I (sx i)) [ w d] ANDmr^[b ow od] (addr, reg) is llr (addr, (and), R reg) [b w d] ANDrm^[b ow od] (addr, reg) is llr (R reg, (and), addr) [b w d] ANDiAL (i8) is Reg.AL := Reg.AL and i8 ANDiAX (i16) is Reg.AX := Reg.AX and i16 ANDiEAX (i32) is Reg.EAX := Reg.EAX and i32 ANDi^[b w d](addr, i) is bin (addr <== addr <(and)> I i) [b w d] ANDio^[ w d]^b (addr, i) is bin (addr <== addr <(and)> I (sx i)) [ w d] ANDmr^[b ow od] (addr, reg) is bin (addr <== addr <(and)> R reg) [b w d] ANDrm^[b ow od] (addr, reg) is bin (R reg <== R reg <(and)> addr) [b w d] end default attribute of [AND OR XOR]^iAL (i8) is Reg.AL := [and or xor] (Reg.AL, i8) [AND OR XOR]^iAX (i16) is Reg.AX := [and or xor] (Reg.AX, i16) [AND OR XOR]^iEAX (i32) is Reg.EAX := [and or xor] (Reg.EAX, i32) [AND OR XOR]^i^[b w d](addr, i) is bin (addr <== addr <[and or xor]> I i) [b w d] [AND OR XOR]^i^[ow od]^b (addr, i) is bin (addr <== addr <[and or xor]> I (sx i)) [ w d] [AND OR XOR]^mr^[b ow od] (addr, reg) is bin (addr <== addr <[and or xor]> R reg) [b w d] [AND OR XOR]^rm^[b ow od] (addr, reg) is bin (R reg <== R reg <[and or xor]> addr) [b w d] [AND OR XOR]^iAL (i8) is logical bin' (Reg.AL <== Reg.AL <[and or xor]> i8) (\x.x,\x.x) [AND OR XOR]^iAX (i16) is logical bin' (Reg.AX <== Reg.AX <[and or xor]> i16) (\x.x,\x.x) [AND OR XOR]^iEAX (i32) is logical bin' (Reg.EAX <== Reg.EAX <[and or xor]> i32) (\x.x,\x.x) [AND OR XOR]^i^[b w d](addr, i) is logical bin' (addr <== addr <[and or xor]> I i) [b w d] [AND OR XOR]^i^[ow od]^b (addr, i) is logical bin' (addr <== addr <[and or xor]> I (sx i)) [ w d] [AND OR XOR]^mr^[b ow od] (addr, reg) is logical bin' (addr <== addr <[and or xor]> R reg) [b w d] [AND OR XOR]^rm^[b ow od] (addr, reg) is logical bin' (R reg <== R reg <[and or xor]> addr) [b w d] [AND OR XOR]^iAL (i8) is logical' Reg.AL [and or xor] i8 idsize [AND OR XOR]^iAX (i16) is logical' Reg.AX [and or xor] i16 idsize [AND OR XOR]^iEAX (i32) is logical' Reg.EAX [and or xor] i32 idsize [AND OR XOR]^i^[b w d](addr, i) is logical' addr [and or xor] (I i) [b w d] [AND OR XOR]^i^[ow od]^b (addr, i) is logical' addr [and or xor] (I (sx i)) [w d] [AND OR XOR]^mr^[b ow od] (addr, reg) is logical' addr [and or xor] (R reg) [b w d] [AND OR XOR]^rm^[b ow od] (addr, reg) is logical' (R reg) [and or xor] addr [b w d] NOT^[b ow od] (addr) is unary (com, addr) [b w d] LEAod (reg, Mem) is regd reg := Mem LEAow (reg, Mem) is regw reg := Mem @bits[16 bits at 0] end