Use -unsafe words with pair methods.

db4
John Benediktsson 2013-03-07 10:47:23 -08:00
parent bddd66f5f3
commit b571a42679
3 changed files with 12 additions and 9 deletions

View File

@ -65,7 +65,7 @@ M: integer (bitfield-quot) ( spec -- quot )
[ swapd shift bitor ] curry ; [ swapd shift bitor ] curry ;
M: pair (bitfield-quot) ( spec -- quot ) M: pair (bitfield-quot) ( spec -- quot )
first2 over word? [ [ swapd execute ] dip ] [ ] ? first2-unsafe over word? [ [ swapd execute ] dip ] [ ] ?
[ shift bitor ] append 2curry ; [ shift bitor ] append 2curry ;
PRIVATE> PRIVATE>

View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.data arrays byte-arrays compiler.units destructors USING: alien alien.data arrays byte-arrays compiler.units
io kernel libc math quotations sequences stack-checker system tr destructors io kernel libc math quotations sequences
vocabs words ; sequences.private stack-checker system tr vocabs words ;
IN: tools.disassembler IN: tools.disassembler
GENERIC: disassemble ( obj -- ) GENERIC: disassemble ( obj -- )
@ -29,11 +29,14 @@ M: byte-array disassemble
2array disassemble 2array disassemble
] with-destructors ; ] with-destructors ;
M: pair disassemble first2 [ (>address) ] bi@ disassemble* [ tabs>spaces print ] each ; M: pair disassemble
first2-unsafe [ (>address) ] bi@ disassemble*
[ tabs>spaces print ] each ;
M: word disassemble word-code 2array disassemble ; M: word disassemble word-code 2array disassemble ;
M: quotation disassemble [ dup infer define-temp ] with-compilation-unit disassemble ; M: quotation disassemble
[ dup infer define-temp ] with-compilation-unit disassemble ;
cpu x86? cpu x86?
"tools.disassembler.udis" "tools.disassembler.udis"

View File

@ -1,7 +1,7 @@
! Copyright (C) 2006, 2010 Slava Pestov. ! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays classes combinators kernel make math USING: accessors arrays classes combinators kernel make math
math.order math.parser sequences strings words ; math.order math.parser sequences sequences.private strings words ;
IN: effects IN: effects
TUPLE: effect TUPLE: effect
@ -53,7 +53,7 @@ M: string effect>string ;
M: object effect>string drop "object" ; M: object effect>string drop "object" ;
M: word effect>string name>> ; M: word effect>string name>> ;
M: integer effect>string number>string ; M: integer effect>string number>string ;
M: pair effect>string first2 [ effect>string ] bi@ ": " glue ; M: pair effect>string first2-unsafe [ effect>string ] bi@ ": " glue ;
: stack-picture ( seq -- string ) : stack-picture ( seq -- string )
[ [ effect>string % CHAR: \s , ] each ] "" make ; [ [ effect>string % CHAR: \s , ] each ] "" make ;
@ -77,7 +77,7 @@ M: effect effect>string ( effect -- string )
GENERIC: effect>type ( obj -- type ) GENERIC: effect>type ( obj -- type )
M: object effect>type drop object ; M: object effect>type drop object ;
M: word effect>type ; M: word effect>type ;
M: pair effect>type second effect>type ; M: pair effect>type second-unsafe effect>type ;
M: classoid effect>type ; M: classoid effect>type ;
: effect-in-types ( effect -- input-types ) : effect-in-types ( effect -- input-types )