From 88d5dac02ff3b93f76b1190601cc76526885c033 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 4 Nov 2008 00:54:57 -0600 Subject: [PATCH] Remove obsolete code from unfinished --- unfinished/cpu/x86/syntax/syntax.factor | 16 - unfinished/cpu/x86/syntax/tags.txt | 1 - unfinished/cpu/x86/x86.factor | 470 ------------------------ 3 files changed, 487 deletions(-) delete mode 100644 unfinished/cpu/x86/syntax/syntax.factor delete mode 100644 unfinished/cpu/x86/syntax/tags.txt delete mode 100755 unfinished/cpu/x86/x86.factor diff --git a/unfinished/cpu/x86/syntax/syntax.factor b/unfinished/cpu/x86/syntax/syntax.factor deleted file mode 100644 index 061cf0defe..0000000000 --- a/unfinished/cpu/x86/syntax/syntax.factor +++ /dev/null @@ -1,16 +0,0 @@ -! Copyright (C) 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: kernel words sequences lexer parser fry ; -IN: cpu.x86.syntax - -: define-register ( name num size -- ) - [ "cpu.x86" create dup define-symbol ] - [ dupd "register" set-word-prop ] - [ "register-size" set-word-prop ] - tri* ; - -: define-registers ( names size -- ) - [ dup length ] dip '[ _ define-register ] 2each ; - -: REGISTERS: ( -- ) - scan-word ";" parse-tokens swap define-registers ; parsing diff --git a/unfinished/cpu/x86/syntax/tags.txt b/unfinished/cpu/x86/syntax/tags.txt deleted file mode 100644 index 6bf68304bb..0000000000 --- a/unfinished/cpu/x86/syntax/tags.txt +++ /dev/null @@ -1 +0,0 @@ -unportable diff --git a/unfinished/cpu/x86/x86.factor b/unfinished/cpu/x86/x86.factor deleted file mode 100755 index 97003cae66..0000000000 --- a/unfinished/cpu/x86/x86.factor +++ /dev/null @@ -1,470 +0,0 @@ -! Copyright (C) 2005, 2008 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: arrays compiler.constants compiler.backend -compiler.codegen.fixup io.binary kernel combinators -kernel.private math namespaces make sequences words system -layouts math.order accessors cpu.x86.syntax ; -IN: cpu.x86 - -! A postfix assembler for x86 and AMD64. - -! In 32-bit mode, { 1234 } is absolute indirect addressing. -! In 64-bit mode, { 1234 } is RIP-relative. -! Beware! - -! Register operands -- eg, ECX -REGISTERS: 8 AL CL DL BL ; - -REGISTERS: 16 AX CX DX BX SP BP SI DI ; - -REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI ; - -REGISTERS: 64 -RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ; - -REGISTERS: 128 -XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 -XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ; - -TUPLE: byte value ; - -C: byte - - ; - -! Addressing modes -TUPLE: indirect base index scale displacement ; - -M: indirect extended? base>> extended? ; - -: canonicalize-EBP ( indirect -- indirect ) - #! { EBP } ==> { EBP 0 } - dup base>> { EBP RBP R13 } member? [ - dup displacement>> [ 0 >>displacement ] unless - ] when ; - -: canonicalize-ESP ( indirect -- indirect ) - #! { ESP } ==> { ESP ESP } - dup base>> { ESP RSP R12 } member? [ ESP >>index ] when ; - -: canonicalize ( indirect -- indirect ) - #! Modify the indirect to work around certain addressing mode - #! quirks. - canonicalize-EBP canonicalize-ESP ; - -: ( base index scale displacement -- indirect ) - indirect boa canonicalize ; - -: reg-code ( reg -- n ) "register" word-prop 7 bitand ; - -: indirect-base* ( op -- n ) base>> EBP or reg-code ; - -: indirect-index* ( op -- n ) index>> ESP or reg-code ; - -: indirect-scale* ( op -- n ) scale>> 0 or ; - -GENERIC: sib-present? ( op -- ? ) - -M: indirect sib-present? - [ base>> { ESP RSP } member? ] [ index>> ] [ scale>> ] tri or or ; - -M: register sib-present? drop f ; - -GENERIC: r/m ( operand -- n ) - -M: indirect r/m - dup sib-present? - [ drop ESP reg-code ] [ indirect-base* ] if ; - -M: register r/m reg-code ; - -! Immediate operands -UNION: immediate byte integer ; - -GENERIC: fits-in-byte? ( value -- ? ) - -M: byte fits-in-byte? drop t ; - -M: integer fits-in-byte? -128 127 between? ; - -GENERIC: modifier ( op -- n ) - -M: indirect modifier - dup base>> [ - displacement>> { - { [ dup not ] [ BIN: 00 ] } - { [ dup fits-in-byte? ] [ BIN: 01 ] } - { [ dup immediate? ] [ BIN: 10 ] } - } cond nip - ] [ - drop BIN: 00 - ] if ; - -M: register modifier drop BIN: 11 ; - -GENERIC# n, 1 ( value n -- ) - -M: integer n, >le % ; -M: byte n, >r value>> r> n, ; -: 1, ( n -- ) 1 n, ; inline -: 4, ( n -- ) 4 n, ; inline -: 2, ( n -- ) 2 n, ; inline -: cell, ( n -- ) bootstrap-cell n, ; inline - -: mod-r/m, ( reg# indirect -- ) - [ 3 shift ] [ [ modifier 6 shift ] [ r/m ] bi ] bi* bitor bitor , ; - -: sib, ( indirect -- ) - dup sib-present? [ - [ indirect-base* ] - [ indirect-index* 3 shift ] - [ indirect-scale* 6 shift ] tri bitor bitor , - ] [ - drop - ] if ; - -GENERIC: displacement, ( op -- ) - -M: indirect displacement, - dup displacement>> dup [ - swap base>> - [ dup fits-in-byte? [ , ] [ 4, ] if ] [ 4, ] if - ] [ - 2drop - ] if ; - -M: register displacement, drop ; - -: addressing ( reg# indirect -- ) - [ mod-r/m, ] [ sib, ] [ displacement, ] tri ; - -! Utilities -UNION: operand register indirect ; - -GENERIC: operand-64? ( operand -- ? ) - -M: indirect operand-64? - [ base>> ] [ index>> ] bi [ operand-64? ] either? ; - -M: register-64 operand-64? drop t ; - -M: object operand-64? drop f ; - -: rex.w? ( rex.w reg r/m -- ? ) - { - { [ dup register-128? ] [ drop operand-64? ] } - { [ dup not ] [ drop operand-64? ] } - [ nip operand-64? ] - } cond and ; - -: rex.r ( m op -- n ) - extended? [ BIN: 00000100 bitor ] when ; - -: rex.b ( m op -- n ) - [ extended? [ BIN: 00000001 bitor ] when ] keep - dup indirect? [ - index>> extended? [ BIN: 00000010 bitor ] when - ] [ - drop - ] if ; - -: rex-prefix ( reg r/m rex.w -- ) - #! Compile an AMD64 REX prefix. - 2over rex.w? BIN: 01001000 BIN: 01000000 ? - swap rex.r swap rex.b - dup BIN: 01000000 = [ drop ] [ , ] if ; - -: 16-prefix ( reg r/m -- ) - [ register-16? ] either? [ HEX: 66 , ] when ; - -: prefix ( reg r/m rex.w -- ) 2over 16-prefix rex-prefix ; - -: prefix-1 ( reg rex.w -- ) f swap prefix ; - -: short-operand ( reg rex.w n -- ) - #! Some instructions encode their single operand as part of - #! the opcode. - >r dupd prefix-1 reg-code r> + , ; - -: opcode, ( opcode -- ) dup array? [ % ] [ , ] if ; - -: extended-opcode ( opcode -- opcode' ) OCT: 17 swap 2array ; - -: extended-opcode, ( opcode -- ) extended-opcode opcode, ; - -: opcode-or ( opcode mask -- opcode' ) - swap dup array? - [ unclip-last rot bitor suffix ] [ bitor ] if ; - -: 1-operand ( op reg,rex.w,opcode -- ) - #! The 'reg' is not really a register, but a value for the - #! 'reg' field of the mod-r/m byte. - first3 >r >r over r> prefix-1 r> opcode, swap addressing ; - -: immediate-operand-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode ) - pick integer? [ first3 BIN: 1 opcode-or 3array ] when ; - -: immediate-1 ( imm dst reg,rex.w,opcode -- ) - immediate-operand-size-bit 1-operand 1, ; - -: immediate-4 ( imm dst reg,rex.w,opcode -- ) - immediate-operand-size-bit 1-operand 4, ; - -: immediate-fits-in-size-bit ( imm dst reg,rex.w,opcode -- imm dst reg,rex.w,opcode ) - pick integer? [ first3 BIN: 10 opcode-or 3array ] when ; - -: immediate-1/4 ( imm dst reg,rex.w,opcode -- ) - #! If imm is a byte, compile the opcode and the byte. - #! Otherwise, set the 8-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. - pick fits-in-byte? [ - immediate-fits-in-size-bit immediate-1 - ] [ - immediate-4 - ] if ; - -: (2-operand) ( dst src op -- ) - >r 2dup t rex-prefix r> opcode, - reg-code swap addressing ; - -: direction-bit ( dst src op -- dst' src' op' ) - pick register? [ BIN: 10 opcode-or swapd ] when ; - -: operand-size-bit ( dst src op -- dst' src' op' ) - over register-8? [ BIN: 1 opcode-or ] unless ; - -: 2-operand ( dst src op -- ) - #! Sets the opcode's direction bit. It is set if the - #! destination is a direct register operand. - 2over 16-prefix - direction-bit - operand-size-bit - (2-operand) ; - -PRIVATE> - -: [] ( reg/displacement -- indirect ) - dup integer? [ >r f f f r> ] [ f f f ] if ; - -: [+] ( reg displacement -- indirect ) - dup integer? - [ dup zero? [ drop f ] when >r f f r> ] - [ f f ] if - ; - -! Moving stuff -GENERIC: PUSH ( op -- ) -M: register PUSH f HEX: 50 short-operand ; -M: immediate PUSH HEX: 68 , 4, ; -M: operand PUSH { BIN: 110 f HEX: ff } 1-operand ; - -GENERIC: POP ( op -- ) -M: register POP f HEX: 58 short-operand ; -M: operand POP { BIN: 000 f HEX: 8f } 1-operand ; - -! MOV where the src is immediate. -GENERIC: (MOV-I) ( src dst -- ) -M: register (MOV-I) t HEX: b8 short-operand cell, ; -M: operand (MOV-I) - { BIN: 000 t HEX: c6 } - pick byte? [ immediate-1 ] [ immediate-4 ] if ; - -GENERIC: MOV ( dst src -- ) -M: immediate MOV swap (MOV-I) ; -M: word MOV 0 rot (MOV-I) rc-absolute-cell rel-word ; -M: operand MOV HEX: 88 2-operand ; - -: LEA ( dst src -- ) swap HEX: 8d 2-operand ; - -! Control flow -GENERIC: JMP ( op -- ) -: (JMP) ( -- rel-class ) HEX: e9 , 0 4, rc-relative ; -M: word JMP (JMP) rel-word ; -M: label JMP (JMP) label-fixup ; -M: operand JMP { BIN: 100 t HEX: ff } 1-operand ; - -GENERIC: CALL ( op -- ) -: (CALL) ( -- rel-class ) HEX: e8 , 0 4, rc-relative ; -M: word CALL (CALL) rel-word ; -M: label CALL (CALL) label-fixup ; -M: operand CALL { BIN: 010 t HEX: ff } 1-operand ; - -GENERIC# JUMPcc 1 ( addr opcode -- ) -: (JUMPcc) ( n -- rel-class ) extended-opcode, 0 4, rc-relative ; -M: word JUMPcc (JUMPcc) rel-word ; -M: label JUMPcc (JUMPcc) label-fixup ; - -: JO ( dst -- ) HEX: 80 JUMPcc ; -: JNO ( dst -- ) HEX: 81 JUMPcc ; -: JB ( dst -- ) HEX: 82 JUMPcc ; -: JAE ( dst -- ) HEX: 83 JUMPcc ; -: JE ( dst -- ) HEX: 84 JUMPcc ; ! aka JZ -: JNE ( dst -- ) HEX: 85 JUMPcc ; -: JBE ( dst -- ) HEX: 86 JUMPcc ; -: JA ( dst -- ) HEX: 87 JUMPcc ; -: JS ( dst -- ) HEX: 88 JUMPcc ; -: JNS ( dst -- ) HEX: 89 JUMPcc ; -: JP ( dst -- ) HEX: 8a JUMPcc ; -: JNP ( dst -- ) HEX: 8b JUMPcc ; -: JL ( dst -- ) HEX: 8c JUMPcc ; -: JGE ( dst -- ) HEX: 8d JUMPcc ; -: JLE ( dst -- ) HEX: 8e JUMPcc ; -: JG ( dst -- ) HEX: 8f JUMPcc ; - -: LEAVE ( -- ) HEX: c9 , ; -: NOP ( -- ) HEX: 90 , ; - -: RET ( n -- ) - dup zero? [ drop HEX: c3 , ] [ HEX: C2 , 2, ] if ; - -! Arithmetic - -GENERIC: ADD ( dst src -- ) -M: immediate ADD swap { BIN: 000 t HEX: 80 } immediate-1/4 ; -M: operand ADD OCT: 000 2-operand ; - -GENERIC: OR ( dst src -- ) -M: immediate OR swap { BIN: 001 t HEX: 80 } immediate-1/4 ; -M: operand OR OCT: 010 2-operand ; - -GENERIC: ADC ( dst src -- ) -M: immediate ADC swap { BIN: 010 t HEX: 80 } immediate-1/4 ; -M: operand ADC OCT: 020 2-operand ; - -GENERIC: SBB ( dst src -- ) -M: immediate SBB swap { BIN: 011 t HEX: 80 } immediate-1/4 ; -M: operand SBB OCT: 030 2-operand ; - -GENERIC: AND ( dst src -- ) -M: immediate AND swap { BIN: 100 t HEX: 80 } immediate-1/4 ; -M: operand AND OCT: 040 2-operand ; - -GENERIC: SUB ( dst src -- ) -M: immediate SUB swap { BIN: 101 t HEX: 80 } immediate-1/4 ; -M: operand SUB OCT: 050 2-operand ; - -GENERIC: XOR ( dst src -- ) -M: immediate XOR swap { BIN: 110 t HEX: 80 } immediate-1/4 ; -M: operand XOR OCT: 060 2-operand ; - -GENERIC: CMP ( dst src -- ) -M: immediate CMP swap { BIN: 111 t HEX: 80 } immediate-1/4 ; -M: operand CMP OCT: 070 2-operand ; - -: NOT ( dst -- ) { BIN: 010 t HEX: f7 } 1-operand ; -: NEG ( dst -- ) { BIN: 011 t HEX: f7 } 1-operand ; -: MUL ( dst -- ) { BIN: 100 t HEX: f7 } 1-operand ; -: IMUL ( src -- ) { BIN: 101 t HEX: f7 } 1-operand ; -: DIV ( dst -- ) { BIN: 110 t HEX: f7 } 1-operand ; -: IDIV ( src -- ) { BIN: 111 t HEX: f7 } 1-operand ; - -: CDQ ( -- ) HEX: 99 , ; -: CQO ( -- ) HEX: 48 , CDQ ; - -: ROL ( dst n -- ) swap { BIN: 000 t HEX: c0 } immediate-1 ; -: ROR ( dst n -- ) swap { BIN: 001 t HEX: c0 } immediate-1 ; -: RCL ( dst n -- ) swap { BIN: 010 t HEX: c0 } immediate-1 ; -: RCR ( dst n -- ) swap { BIN: 011 t HEX: c0 } immediate-1 ; -: SHL ( dst n -- ) swap { BIN: 100 t HEX: c0 } immediate-1 ; -: SHR ( dst n -- ) swap { BIN: 101 t HEX: c0 } immediate-1 ; -: SAR ( dst n -- ) swap { BIN: 111 t HEX: c0 } immediate-1 ; - -GENERIC: IMUL2 ( dst src -- ) -M: immediate IMUL2 swap dup reg-code t HEX: 68 3array immediate-1/4 ; -M: operand IMUL2 OCT: 257 extended-opcode (2-operand) ; - -: MOVSX ( dst src -- ) - dup register-32? OCT: 143 OCT: 276 extended-opcode ? - over register-16? [ BIN: 1 opcode-or ] when - swapd - (2-operand) ; - -! Conditional move -: MOVcc ( dst src cc -- ) extended-opcode swapd (2-operand) ; - -: CMOVO ( dst src -- ) HEX: 40 MOVcc ; -: CMOVNO ( dst src -- ) HEX: 41 MOVcc ; -: CMOVB ( dst src -- ) HEX: 42 MOVcc ; -: CMOVAE ( dst src -- ) HEX: 43 MOVcc ; -: CMOVE ( dst src -- ) HEX: 44 MOVcc ; ! aka CMOVZ -: CMOVNE ( dst src -- ) HEX: 45 MOVcc ; -: CMOVBE ( dst src -- ) HEX: 46 MOVcc ; -: CMOVA ( dst src -- ) HEX: 47 MOVcc ; -: CMOVS ( dst src -- ) HEX: 48 MOVcc ; -: CMOVNS ( dst src -- ) HEX: 49 MOVcc ; -: CMOVP ( dst src -- ) HEX: 4a MOVcc ; -: CMOVNP ( dst src -- ) HEX: 4b MOVcc ; -: CMOVL ( dst src -- ) HEX: 4c MOVcc ; -: CMOVGE ( dst src -- ) HEX: 4d MOVcc ; -: CMOVLE ( dst src -- ) HEX: 4e MOVcc ; -: CMOVG ( dst src -- ) HEX: 4f MOVcc ; - -! CPU Identification - -: CPUID ( -- ) HEX: a2 extended-opcode, ; - -! x87 Floating Point Unit - -: FSTPS ( operand -- ) { BIN: 011 f HEX: d9 } 1-operand ; -: FSTPL ( operand -- ) { BIN: 011 f HEX: dd } 1-operand ; - -: FLDS ( operand -- ) { BIN: 000 f HEX: d9 } 1-operand ; -: FLDL ( operand -- ) { BIN: 000 f HEX: dd } 1-operand ; - -! SSE multimedia instructions - - - -: MOVSS ( dest src -- ) HEX: 10 HEX: f3 2-operand-sse ; -: MOVSD ( dest src -- ) HEX: 10 HEX: f2 2-operand-sse ; -: ADDSD ( dest src -- ) HEX: 58 HEX: f2 2-operand-sse ; -: MULSD ( dest src -- ) HEX: 59 HEX: f2 2-operand-sse ; -: SUBSD ( dest src -- ) HEX: 5c HEX: f2 2-operand-sse ; -: DIVSD ( dest src -- ) HEX: 5e HEX: f2 2-operand-sse ; -: SQRTSD ( dest src -- ) HEX: 51 HEX: f2 2-operand-sse ; -: UCOMISD ( dest src -- ) HEX: 2e HEX: 66 2-operand-sse ; -: COMISD ( dest src -- ) HEX: 2f HEX: 66 2-operand-sse ; - -: CVTSS2SD ( dest src -- ) HEX: 5a HEX: f3 2-operand-sse ; -: CVTSD2SS ( dest src -- ) HEX: 5a HEX: f2 2-operand-sse ; - -: CVTSI2SD ( dest src -- ) HEX: 2a HEX: f2 2-operand-int/sse ; -: CVTSD2SI ( dest src -- ) HEX: 2d HEX: f2 2-operand-int/sse ; -: CVTTSD2SI ( dest src -- ) HEX: 2c HEX: f2 2-operand-int/sse ;