From 42b6d013f8faea0f89f21945e136e5e7ab9df83a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 8 Jan 2005 21:43:18 +0000 Subject: [PATCH] missing files --- library/compiler/x86/assembler.factor | 274 ++++++++++++++++++++++++++ library/compiler/x86/generator.factor | 122 ++++++++++++ 2 files changed, 396 insertions(+) create mode 100644 library/compiler/x86/assembler.factor create mode 100644 library/compiler/x86/generator.factor diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor new file mode 100644 index 0000000000..1984809768 --- /dev/null +++ b/library/compiler/x86/assembler.factor @@ -0,0 +1,274 @@ +! :folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2005 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +USE: compiler +IN: assembler +USE: words +USE: kernel +USE: parser +USE: generic +USE: lists +USE: math +USE: errors + +! A postfix assembler. +! +! x86 is a convoluted mess, so this code will be hard to +! understand unless you already know the instruction set. +! +! Syntax is: destination source opcode. For example, to add +! 3 to EAX: +! +! EAX 3 ADD +! +! The general format of an x86 instruction is: +! +! - 1-4 bytes: prefix. not supported. +! - 1-2 bytes: opcode. if the first byte is 0x0f, then opcode is +! 2 bytes. +! - 1 byte (optional): mod-r/m byte, specifying operands +! - 1/4 bytes (optional): displacement +! - 1 byte (optional): scale/index/displacement byte. not +! supported. +! - 1/4 bytes (optional): immediate operand +! +! mod-r/m has three bit fields: +! - 0-2: r/m +! - 3-5: reg +! - 6-7: mod +! +! If the direction bit (bin mask 10) in the opcode is set, then +! the source is reg, the destination is r/m. Otherwise, it is +! the opposite. x86 does this because reg can only encode a +! direct register operand, while r/m can encode other addressing +! modes in conjunction with the mod field. +! +! The mod field has this encoding: +! - BIN: 00 indirect +! - BIN: 01 1-byte displacement is present after mod-r/m field +! - BIN: 10 4-byte displacement is present after mod-r/m field +! - BIN: 11 direct register operand +! +! To encode displacement only (eg, [ 1234 ] EAX MOV), the +! r/m field stores the code for the EBP register, mod is 00, and +! a 4-byte displacement field is given. Usually if mod is 00, no +! displacement field is present. + +: byte? -128 127 between? ; + +GENERIC: modifier ( op -- mod ) +GENERIC: register ( op -- reg ) +GENERIC: displacement ( op -- ) + +( Register operands -- eg, ECX ) +: REGISTER: + CREATE dup define-symbol + scan-word "register" set-word-property ; parsing + +REGISTER: EAX 0 +REGISTER: ECX 1 +REGISTER: EDX 2 +REGISTER: EBX 3 +REGISTER: ESP 4 +REGISTER: EBP 5 +REGISTER: ESI 6 +REGISTER: EDI 7 + +PREDICATE: word register "register" word-property ; + +M: register modifier drop BIN: 11 ; +M: register register "register" word-property ; +M: register displacement drop ; + +( Indirect register operands -- eg, [ ECX ] ) +PREDICATE: list indirect + dup length 1 = [ car register? ] [ drop f ] ifte ; + +M: indirect modifier drop BIN: 00 ; +M: indirect register + car register dup BIN: 101 = [ + "x86 does not support [ EBP ]. Use [ EBP 0 ] instead." + throw + ] when ; +M: indirect displacement drop ; + +( Displaced indirect register operands -- eg, [ EAX 4 ] ) +PREDICATE: list displaced + dup length 2 = [ + 2unlist integer? swap register? and + ] [ + drop f + ] ifte ; + +M: displaced modifier cdr car byte? BIN: 01 BIN: 10 ? ; +M: displaced register car register ; +M: displaced displacement + cdr car dup byte? [ compile-byte ] [ compile-cell ] ifte ; + +( Displacement-only operands -- eg, [ 1234 ] ) +PREDICATE: list disp-only + dup length 1 = [ car integer? ] [ drop f ] ifte ; + +M: disp-only modifier drop BIN: 00 ; +M: disp-only register + #! x86 encodes displacement-only as [ EBP ]. + drop BIN: 101 ; +M: disp-only displacement + car compile-cell ; + +( Utilities ) +UNION: operand register indirect displaced disp-only ; + +: 1-operand-short ( reg n -- ) + #! Some instructions encode their single operand as part of + #! the opcode. + swap register + compile-byte ; + +: 1-operand ( op reg -- ) + >r dup modifier 6 shift over register bitor r> 3 shift bitor + compile-byte displacement ; + +: immediate-8/32 ( dst imm code reg -- ) + #! If imm is a byte, compile the opcode and the byte. + #! Otherwise, set the 32-bit operand flag in the opcode, and + #! compile the cell. The 'reg' is not really a register, but + #! a value for the 'reg' field of the mod-r/m byte. + >r over byte? [ + BIN: 10 bitor compile-byte swap r> 1-operand + compile-byte + ] [ + compile-byte swap r> 1-operand + compile-cell + ] ifte ; + +: immediate-8 ( dst imm code reg -- ) + #! The 'reg' is not really a register, but a value for the + #! 'reg' field of the mod-r/m byte. + >r compile-byte swap r> 1-operand compile-byte ; + +: 2-operand ( dst src op -- ) + #! Sets the opcode's direction bit. It is set if the + #! destination is a direct register operand. + pick register? [ BIN: 10 bitor swapd ] when + compile-byte register 1-operand ; + +: fixup ( -- addr ) + #! After compiling a jump, this returns the address where + #! the branch target can be written. + compiled-offset 4 - ; + +: relative ( addr -- addr ) + #! Relative to after next 32-bit immediate. + compiled-offset - 4 - ; + +: patch ( addr where -- ) + #! Encode a relative offset to addr from where at where. + #! Add 4 because addr is relative to *after* insn. + dup >r 4 + - r> set-compiled-cell ; + +( Moving stuff ) +GENERIC: PUSH ( op -- ) +M: register PUSH HEX: 50 1-operand-short ; +M: integer PUSH HEX: 68 compile-byte compile-cell ; +M: operand PUSH HEX: ff compile-byte BIN: 110 1-operand ; + +GENERIC: POP ( op -- ) +M: register POP HEX: 58 1-operand-short ; +M: operand POP HEX: 8f compile-byte BIN: 000 1-operand ; + +! MOV where the src is immediate. +GENERIC: (MOV-I) ( src dst -- ) +M: register (MOV-I) HEX: b8 1-operand-short compile-cell ; +M: operand (MOV-I) + HEX: c7 compile-byte 0 1-operand compile-cell ; + +GENERIC: MOV ( dst src -- ) +M: integer MOV swap (MOV-I) ; +M: operand MOV HEX: 89 2-operand ; + +( Control flow ) +GENERIC: JMP ( op -- ) +M: integer JMP HEX: e9 compile-byte relative compile-cell ; +M: operand JMP HEX: ff compile-byte BIN: 100 1-operand ; + +GENERIC: CALL ( op -- ) +M: integer CALL HEX: e8 compile-byte relative compile-cell ; +M: operand CALL HEX: ff compile-byte BIN: 010 1-operand ; + +: JUMPcc ( addr opcode -- ) + HEX: 0f compile-byte compile-byte relative compile-cell ; + +: JO HEX: 80 JUMPcc ; +: JNO HEX: 81 JUMPcc ; +: JB HEX: 82 JUMPcc ; +: JAE HEX: 83 JUMPcc ; +: JE HEX: 84 JUMPcc ; +: JNE HEX: 85 JUMPcc ; +: JBE HEX: 86 JUMPcc ; +: JA HEX: 87 JUMPcc ; +: JS HEX: 88 JUMPcc ; +: JNS HEX: 89 JUMPcc ; +: JP HEX: 8a JUMPcc ; +: JNP HEX: 8b JUMPcc ; +: JL HEX: 8c JUMPcc ; +: JGE HEX: 8d JUMPcc ; +: JLE HEX: 8e JUMPcc ; +: JG HEX: 8f JUMPcc ; + +: RET ( -- ) HEX: c3 compile-byte ; + +( Arithmetic ) + +GENERIC: ADD ( dst src -- ) +M: integer ADD HEX: 81 BIN: 000 immediate-8/32 ; +M: operand ADD HEX: 01 2-operand ; + +GENERIC: SUB ( dst src -- ) +M: integer SUB HEX: 81 BIN: 101 immediate-8/32 ; +M: operand SUB HEX: 29 2-operand ; + +: IMUL ( dst src -- ) + HEX: 0f compile-byte HEX: af 2-operand ; + +: IDIV ( src -- ) + #! IDIV is weird on x86. Only the divisor is given as an + #! explicit operand. The quotient is stored in EAX, the + #! remainder in EDX. + HEX: f7 compile-byte BIN: 111 1-operand ; + +: CDQ HEX: 99 compile-byte ; + +: SHL ( dst src -- ) HEX: c1 BIN: 100 immediate-8 ; + +: SHR ( dst src -- ) HEX: c1 BIN: 101 immediate-8 ; + +GENERIC: CMP ( dst src -- ) +M: integer CMP HEX: 81 BIN: 111 immediate-8/32 ; +M: operand CMP HEX: 39 2-operand ; + +: LEA ( dst src -- ) + HEX: 8d compile-byte swap register 1-operand ; diff --git a/library/compiler/x86/generator.factor b/library/compiler/x86/generator.factor new file mode 100644 index 0000000000..a3a03f5249 --- /dev/null +++ b/library/compiler/x86/generator.factor @@ -0,0 +1,122 @@ +! :folding=indent:collapseFolds=1: + +! $Id$ +! +! Copyright (C) 2004, 2005 Slava Pestov. +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions are met: +! +! 1. Redistributions of source code must retain the above copyright notice, +! this list of conditions and the following disclaimer. +! +! 2. Redistributions in binary form must reproduce the above copyright notice, +! this list of conditions and the following disclaimer in the documentation +! and/or other materials provided with the distribution. +! +! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, +! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; +! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, +! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR +! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +IN: compiler +USE: alien +USE: assembler +USE: inference +USE: kernel +USE: kernel-internals +USE: lists +USE: math +USE: namespaces +USE: words + +\ slot [ + PEEK-DS + ( EAX [ EAX 3 ] MOV ) + 2unlist type-tag >r cell * r> - EAX swap 2list EAX swap MOV + [ ECX ] EAX MOV +] "generator" set-word-property + +: compile-call-label ( label -- ) + 0 CALL fixup compiled-offset defer-xt ; + +: compile-jump-label ( label -- ) + 0 JMP fixup compiled-offset defer-xt ; + +: compile-call ( word -- ) + dup dup postpone-word compile-call-label t rel-word ; + +#call [ + compile-call +] "generator" set-word-property + +#jump [ + dup dup postpone-word + compile-jump-label + t rel-word +] "generator" set-word-property + +#call-label [ + compile-call-label +] "generator" set-word-property + +#jump-label [ + compile-jump-label +] "generator" set-word-property + +#jump-t [ + POP-DS + ! condition is now in EAX + EAX f address CMP + ! jump w/ address added later + 0 JNE fixup compiled-offset defer-xt +] "generator" set-word-property + +#return-to [ + 0 PUSH fixup 0 defer-xt rel-address +] "generator" set-word-property + +#return [ drop RET ] "generator" set-word-property + +#dispatch [ + #! Compile a piece of code that jumps to an offset in a + #! jump table indexed by the fixnum at the top of the stack. + #! The jump table must immediately follow this macro. + drop + POP-DS + EAX 1 SHR + EAX HEX: ffff ADD fixup rel-address + [ EAX ] JMP + compile-aligned + compiled-offset swap set-compiled-cell ( fixup -- ) +] "generator" set-word-property + +#target [ + #! Jump table entries are absolute addresses. + compiled-offset 0 compile-cell 0 defer-xt rel-address +] "generator" set-word-property + +#c-call [ + uncons load-dll 2dup dlsym CALL t rel-dlsym +] "generator" set-word-property + +#unbox [ + dup f dlsym CALL f t rel-dlsym + EAX PUSH +] "generator" set-word-property + +#box [ + EAX PUSH + dup f dlsym CALL f t rel-dlsym + ESP 4 ADD +] "generator" set-word-property + +#cleanup [ + dup 0 = [ drop ] [ ESP swap ADD ] ifte +] "generator" set-word-property