From 0ca1d013f888bf079c021d6879f20e16b83e2198 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 20:56:23 -0500 Subject: [PATCH 01/10] Add new RC_ABSOLUTE_PPC_2 relocation type --- basis/compiler/constants/constants.factor | 11 ++++++----- vm/code_block.cpp | 3 +++ vm/code_block.hpp | 5 ++++- 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index cc6397bd65..e30cc10ee2 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -30,11 +30,12 @@ CONSTANT: rc-absolute-cell 0 CONSTANT: rc-absolute 1 CONSTANT: rc-relative 2 CONSTANT: rc-absolute-ppc-2/2 3 -CONSTANT: rc-relative-ppc-2 4 -CONSTANT: rc-relative-ppc-3 5 -CONSTANT: rc-relative-arm-3 6 -CONSTANT: rc-indirect-arm 7 -CONSTANT: rc-indirect-arm-pc 8 +CONSTANT: rc-absolute-ppc-2 4 +CONSTANT: rc-relative-ppc-2 5 +CONSTANT: rc-relative-ppc-3 6 +CONSTANT: rc-relative-arm-3 7 +CONSTANT: rc-indirect-arm 8 +CONSTANT: rc-indirect-arm-pc 9 ! Relocation types CONSTANT: rt-primitive 0 diff --git a/vm/code_block.cpp b/vm/code_block.cpp index bb3481904e..cd87da3801 100755 --- a/vm/code_block.cpp +++ b/vm/code_block.cpp @@ -84,6 +84,9 @@ void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value) case RC_ABSOLUTE_PPC_2_2: store_address_2_2((cell *)offset,absolute_value); break; + case RC_ABSOLUTE_PPC_2: + store_address_masked((cell *)offset,absolute_value,REL_ABSOLUTE_PPC_2_MASK,0); + break; case RC_RELATIVE_PPC_2: store_address_masked((cell *)offset,relative_value,REL_RELATIVE_PPC_2_MASK,0); break; diff --git a/vm/code_block.hpp b/vm/code_block.hpp index 9ca1a419b6..85ae373845 100644 --- a/vm/code_block.hpp +++ b/vm/code_block.hpp @@ -31,8 +31,10 @@ enum relocation_class { RC_ABSOLUTE, /* relative address in a 32-bit location */ RC_RELATIVE, - /* relative address in a PowerPC LIS/ORI sequence */ + /* absolute address in a PowerPC LIS/ORI sequence */ RC_ABSOLUTE_PPC_2_2, + /* absolute address in a PowerPC LWZ instruction */ + RC_ABSOLUTE_PPC_2, /* relative address in a PowerPC LWZ/STW/BC instruction */ RC_RELATIVE_PPC_2, /* relative address in a PowerPC B/BL instruction */ @@ -45,6 +47,7 @@ enum relocation_class { RC_INDIRECT_ARM_PC }; +#define REL_ABSOLUTE_PPC_2_MASK 0xffff #define REL_RELATIVE_PPC_2_MASK 0xfffc #define REL_RELATIVE_PPC_3_MASK 0x3fffffc #define REL_INDIRECT_ARM_MASK 0xfff From 9e34307f58fa60737efae99db0f40d2757d68c85 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 20:56:36 -0500 Subject: [PATCH 02/10] cpu.ppc.assembler: update for code_format=1 --- .../cpu/ppc/assembler/assembler-tests.factor | 220 +++++++++--------- .../cpu/ppc/assembler/backend/backend.factor | 4 +- 2 files changed, 112 insertions(+), 112 deletions(-) diff --git a/basis/cpu/ppc/assembler/assembler-tests.factor b/basis/cpu/ppc/assembler/assembler-tests.factor index 09db4cb050..14327d08b8 100644 --- a/basis/cpu/ppc/assembler/assembler-tests.factor +++ b/basis/cpu/ppc/assembler/assembler-tests.factor @@ -3,114 +3,114 @@ USING: cpu.ppc.assembler tools.test arrays kernel namespaces make vocabs sequences ; : test-assembler ( expected quot -- ) - [ 1array ] [ [ { } make ] curry ] bi* unit-test ; + [ 1array ] [ [ B{ } make ] curry ] bi* unit-test ; -{ HEX: 38220003 } [ 1 2 3 ADDI ] test-assembler -{ HEX: 3c220003 } [ 1 2 3 ADDIS ] test-assembler -{ HEX: 30220003 } [ 1 2 3 ADDIC ] test-assembler -{ HEX: 34220003 } [ 1 2 3 ADDIC. ] test-assembler -{ HEX: 38400001 } [ 1 2 LI ] test-assembler -{ HEX: 3c400001 } [ 1 2 LIS ] test-assembler -{ HEX: 3822fffd } [ 1 2 3 SUBI ] test-assembler -{ HEX: 1c220003 } [ 1 2 3 MULI ] test-assembler -{ HEX: 7c221a14 } [ 1 2 3 ADD ] test-assembler -{ HEX: 7c221a15 } [ 1 2 3 ADD. ] test-assembler -{ HEX: 7c221e14 } [ 1 2 3 ADDO ] test-assembler -{ HEX: 7c221e15 } [ 1 2 3 ADDO. ] test-assembler -{ HEX: 7c221814 } [ 1 2 3 ADDC ] test-assembler -{ HEX: 7c221815 } [ 1 2 3 ADDC. ] test-assembler -{ HEX: 7c221e14 } [ 1 2 3 ADDO ] test-assembler -{ HEX: 7c221c15 } [ 1 2 3 ADDCO. ] test-assembler -{ HEX: 7c221914 } [ 1 2 3 ADDE ] test-assembler -{ HEX: 7c411838 } [ 1 2 3 AND ] test-assembler -{ HEX: 7c411839 } [ 1 2 3 AND. ] test-assembler -{ HEX: 7c221bd6 } [ 1 2 3 DIVW ] test-assembler -{ HEX: 7c221b96 } [ 1 2 3 DIVWU ] test-assembler -{ HEX: 7c411a38 } [ 1 2 3 EQV ] test-assembler -{ HEX: 7c411bb8 } [ 1 2 3 NAND ] test-assembler -{ HEX: 7c4118f8 } [ 1 2 3 NOR ] test-assembler -{ HEX: 7c4110f8 } [ 1 2 NOT ] test-assembler -{ HEX: 60410003 } [ 1 2 3 ORI ] test-assembler -{ HEX: 64410003 } [ 1 2 3 ORIS ] test-assembler -{ HEX: 7c411b78 } [ 1 2 3 OR ] test-assembler -{ HEX: 7c411378 } [ 1 2 MR ] test-assembler -{ HEX: 7c221896 } [ 1 2 3 MULHW ] test-assembler -{ HEX: 1c220003 } [ 1 2 3 MULLI ] test-assembler -{ HEX: 7c221816 } [ 1 2 3 MULHWU ] test-assembler -{ HEX: 7c2219d6 } [ 1 2 3 MULLW ] test-assembler -{ HEX: 7c411830 } [ 1 2 3 SLW ] test-assembler -{ HEX: 7c411e30 } [ 1 2 3 SRAW ] test-assembler -{ HEX: 7c411c30 } [ 1 2 3 SRW ] test-assembler -{ HEX: 7c411e70 } [ 1 2 3 SRAWI ] test-assembler -{ HEX: 7c221850 } [ 1 2 3 SUBF ] test-assembler -{ HEX: 7c221810 } [ 1 2 3 SUBFC ] test-assembler -{ HEX: 7c221910 } [ 1 2 3 SUBFE ] test-assembler -{ HEX: 7c410774 } [ 1 2 EXTSB ] test-assembler -{ HEX: 68410003 } [ 1 2 3 XORI ] test-assembler -{ HEX: 7c411a78 } [ 1 2 3 XOR ] test-assembler -{ HEX: 7c2200d0 } [ 1 2 NEG ] test-assembler -{ HEX: 2c220003 } [ 1 2 3 CMPI ] test-assembler -{ HEX: 28220003 } [ 1 2 3 CMPLI ] test-assembler -{ HEX: 7c411800 } [ 1 2 3 CMP ] test-assembler -{ HEX: 5422190a } [ 1 2 3 4 5 RLWINM ] test-assembler -{ HEX: 54221838 } [ 1 2 3 SLWI ] test-assembler -{ HEX: 5422e8fe } [ 1 2 3 SRWI ] test-assembler -{ HEX: 88220003 } [ 1 2 3 LBZ ] test-assembler -{ HEX: 8c220003 } [ 1 2 3 LBZU ] test-assembler -{ HEX: a8220003 } [ 1 2 3 LHA ] test-assembler -{ HEX: ac220003 } [ 1 2 3 LHAU ] test-assembler -{ HEX: a0220003 } [ 1 2 3 LHZ ] test-assembler -{ HEX: a4220003 } [ 1 2 3 LHZU ] test-assembler -{ HEX: 80220003 } [ 1 2 3 LWZ ] test-assembler -{ HEX: 84220003 } [ 1 2 3 LWZU ] test-assembler -{ HEX: 7c4118ae } [ 1 2 3 LBZX ] test-assembler -{ HEX: 7c4118ee } [ 1 2 3 LBZUX ] test-assembler -{ HEX: 7c411aae } [ 1 2 3 LHAX ] test-assembler -{ HEX: 7c411aee } [ 1 2 3 LHAUX ] test-assembler -{ HEX: 7c411a2e } [ 1 2 3 LHZX ] test-assembler -{ HEX: 7c411a6e } [ 1 2 3 LHZUX ] test-assembler -{ HEX: 7c41182e } [ 1 2 3 LWZX ] test-assembler -{ HEX: 7c41186e } [ 1 2 3 LWZUX ] test-assembler -{ HEX: 48000001 } [ 1 B ] test-assembler -{ HEX: 48000001 } [ 1 BL ] test-assembler -{ HEX: 41800004 } [ 1 BLT ] test-assembler -{ HEX: 41810004 } [ 1 BGT ] test-assembler -{ HEX: 40810004 } [ 1 BLE ] test-assembler -{ HEX: 40800004 } [ 1 BGE ] test-assembler -{ HEX: 41800004 } [ 1 BLT ] test-assembler -{ HEX: 40820004 } [ 1 BNE ] test-assembler -{ HEX: 41820004 } [ 1 BEQ ] test-assembler -{ HEX: 41830004 } [ 1 BO ] test-assembler -{ HEX: 40830004 } [ 1 BNO ] test-assembler -{ HEX: 4c200020 } [ 1 BCLR ] test-assembler -{ HEX: 4e800020 } [ BLR ] test-assembler -{ HEX: 4e800021 } [ BLRL ] test-assembler -{ HEX: 4c200420 } [ 1 BCCTR ] test-assembler -{ HEX: 4e800420 } [ BCTR ] test-assembler -{ HEX: 7c6102a6 } [ 3 MFXER ] test-assembler -{ HEX: 7c6802a6 } [ 3 MFLR ] test-assembler -{ HEX: 7c6902a6 } [ 3 MFCTR ] test-assembler -{ HEX: 7c6103a6 } [ 3 MTXER ] test-assembler -{ HEX: 7c6803a6 } [ 3 MTLR ] test-assembler -{ HEX: 7c6903a6 } [ 3 MTCTR ] test-assembler -{ HEX: 7c6102a6 } [ 3 MFXER ] test-assembler -{ HEX: 7c6802a6 } [ 3 MFLR ] test-assembler -{ HEX: c0220003 } [ 1 2 3 LFS ] test-assembler -{ HEX: c4220003 } [ 1 2 3 LFSU ] test-assembler -{ HEX: c8220003 } [ 1 2 3 LFD ] test-assembler -{ HEX: cc220003 } [ 1 2 3 LFDU ] test-assembler -{ HEX: d0220003 } [ 1 2 3 STFS ] test-assembler -{ HEX: d4220003 } [ 1 2 3 STFSU ] test-assembler -{ HEX: d8220003 } [ 1 2 3 STFD ] test-assembler -{ HEX: dc220003 } [ 1 2 3 STFDU ] test-assembler -{ HEX: fc201048 } [ 1 2 FMR ] test-assembler -{ HEX: fc20101e } [ 1 2 FCTIWZ ] test-assembler -{ HEX: fc22182a } [ 1 2 3 FADD ] test-assembler -{ HEX: fc22182b } [ 1 2 3 FADD. ] test-assembler -{ HEX: fc221828 } [ 1 2 3 FSUB ] test-assembler -{ HEX: fc2200f2 } [ 1 2 3 FMUL ] test-assembler -{ HEX: fc221824 } [ 1 2 3 FDIV ] test-assembler -{ HEX: fc20102c } [ 1 2 FSQRT ] test-assembler -{ HEX: fc411800 } [ 1 2 3 FCMPU ] test-assembler -{ HEX: fc411840 } [ 1 2 3 FCMPO ] test-assembler -{ HEX: 3c601234 HEX: 60635678 } [ HEX: 12345678 3 LOAD ] test-assembler +B{ HEX: 38 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDI ] test-assembler +B{ HEX: 3c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIS ] test-assembler +B{ HEX: 30 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIC ] test-assembler +B{ HEX: 34 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 ADDIC. ] test-assembler +B{ HEX: 38 HEX: 40 HEX: 00 HEX: 01 } [ 1 2 LI ] test-assembler +B{ HEX: 3c HEX: 40 HEX: 00 HEX: 01 } [ 1 2 LIS ] test-assembler +B{ HEX: 38 HEX: 22 HEX: ff HEX: fd } [ 1 2 3 SUBI ] test-assembler +B{ HEX: 1c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 MULI ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 1a HEX: 14 } [ 1 2 3 ADD ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 1a HEX: 15 } [ 1 2 3 ADD. ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 1e HEX: 14 } [ 1 2 3 ADDO ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 1e HEX: 15 } [ 1 2 3 ADDO. ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 18 HEX: 14 } [ 1 2 3 ADDC ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 18 HEX: 15 } [ 1 2 3 ADDC. ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 1e HEX: 14 } [ 1 2 3 ADDO ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 1c HEX: 15 } [ 1 2 3 ADDCO. ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 19 HEX: 14 } [ 1 2 3 ADDE ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: 38 } [ 1 2 3 AND ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: 39 } [ 1 2 3 AND. ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 1b HEX: d6 } [ 1 2 3 DIVW ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 1b HEX: 96 } [ 1 2 3 DIVWU ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1a HEX: 38 } [ 1 2 3 EQV ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1b HEX: b8 } [ 1 2 3 NAND ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: f8 } [ 1 2 3 NOR ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 10 HEX: f8 } [ 1 2 NOT ] test-assembler +B{ HEX: 60 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 ORI ] test-assembler +B{ HEX: 64 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 ORIS ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1b HEX: 78 } [ 1 2 3 OR ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 13 HEX: 78 } [ 1 2 MR ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 18 HEX: 96 } [ 1 2 3 MULHW ] test-assembler +B{ HEX: 1c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 MULLI ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 18 HEX: 16 } [ 1 2 3 MULHWU ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 19 HEX: d6 } [ 1 2 3 MULLW ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: 30 } [ 1 2 3 SLW ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1e HEX: 30 } [ 1 2 3 SRAW ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1c HEX: 30 } [ 1 2 3 SRW ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1e HEX: 70 } [ 1 2 3 SRAWI ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 18 HEX: 50 } [ 1 2 3 SUBF ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 18 HEX: 10 } [ 1 2 3 SUBFC ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 19 HEX: 10 } [ 1 2 3 SUBFE ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 07 HEX: 74 } [ 1 2 EXTSB ] test-assembler +B{ HEX: 68 HEX: 41 HEX: 00 HEX: 03 } [ 1 2 3 XORI ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1a HEX: 78 } [ 1 2 3 XOR ] test-assembler +B{ HEX: 7c HEX: 22 HEX: 00 HEX: d0 } [ 1 2 NEG ] test-assembler +B{ HEX: 2c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 CMPI ] test-assembler +B{ HEX: 28 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 CMPLI ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: 00 } [ 1 2 3 CMP ] test-assembler +B{ HEX: 54 HEX: 22 HEX: 19 HEX: 0a } [ 1 2 3 4 5 RLWINM ] test-assembler +B{ HEX: 54 HEX: 22 HEX: 18 HEX: 38 } [ 1 2 3 SLWI ] test-assembler +B{ HEX: 54 HEX: 22 HEX: e8 HEX: fe } [ 1 2 3 SRWI ] test-assembler +B{ HEX: 88 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LBZ ] test-assembler +B{ HEX: 8c HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LBZU ] test-assembler +B{ HEX: a8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHA ] test-assembler +B{ HEX: ac HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHAU ] test-assembler +B{ HEX: a0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHZ ] test-assembler +B{ HEX: a4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LHZU ] test-assembler +B{ HEX: 80 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LWZ ] test-assembler +B{ HEX: 84 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LWZU ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: ae } [ 1 2 3 LBZX ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: ee } [ 1 2 3 LBZUX ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1a HEX: ae } [ 1 2 3 LHAX ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1a HEX: ee } [ 1 2 3 LHAUX ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1a HEX: 2e } [ 1 2 3 LHZX ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 1a HEX: 6e } [ 1 2 3 LHZUX ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: 2e } [ 1 2 3 LWZX ] test-assembler +B{ HEX: 7c HEX: 41 HEX: 18 HEX: 6e } [ 1 2 3 LWZUX ] test-assembler +B{ HEX: 48 HEX: 00 HEX: 00 HEX: 01 } [ 1 B ] test-assembler +B{ HEX: 48 HEX: 00 HEX: 00 HEX: 01 } [ 1 BL ] test-assembler +B{ HEX: 41 HEX: 80 HEX: 00 HEX: 04 } [ 1 BLT ] test-assembler +B{ HEX: 41 HEX: 81 HEX: 00 HEX: 04 } [ 1 BGT ] test-assembler +B{ HEX: 40 HEX: 81 HEX: 00 HEX: 04 } [ 1 BLE ] test-assembler +B{ HEX: 40 HEX: 80 HEX: 00 HEX: 04 } [ 1 BGE ] test-assembler +B{ HEX: 41 HEX: 80 HEX: 00 HEX: 04 } [ 1 BLT ] test-assembler +B{ HEX: 40 HEX: 82 HEX: 00 HEX: 04 } [ 1 BNE ] test-assembler +B{ HEX: 41 HEX: 82 HEX: 00 HEX: 04 } [ 1 BEQ ] test-assembler +B{ HEX: 41 HEX: 83 HEX: 00 HEX: 04 } [ 1 BO ] test-assembler +B{ HEX: 40 HEX: 83 HEX: 00 HEX: 04 } [ 1 BNO ] test-assembler +B{ HEX: 4c HEX: 20 HEX: 00 HEX: 20 } [ 1 BCLR ] test-assembler +B{ HEX: 4e HEX: 80 HEX: 00 HEX: 20 } [ BLR ] test-assembler +B{ HEX: 4e HEX: 80 HEX: 00 HEX: 21 } [ BLRL ] test-assembler +B{ HEX: 4c HEX: 20 HEX: 04 HEX: 20 } [ 1 BCCTR ] test-assembler +B{ HEX: 4e HEX: 80 HEX: 04 HEX: 20 } [ BCTR ] test-assembler +B{ HEX: 7c HEX: 61 HEX: 02 HEX: a6 } [ 3 MFXER ] test-assembler +B{ HEX: 7c HEX: 68 HEX: 02 HEX: a6 } [ 3 MFLR ] test-assembler +B{ HEX: 7c HEX: 69 HEX: 02 HEX: a6 } [ 3 MFCTR ] test-assembler +B{ HEX: 7c HEX: 61 HEX: 03 HEX: a6 } [ 3 MTXER ] test-assembler +B{ HEX: 7c HEX: 68 HEX: 03 HEX: a6 } [ 3 MTLR ] test-assembler +B{ HEX: 7c HEX: 69 HEX: 03 HEX: a6 } [ 3 MTCTR ] test-assembler +B{ HEX: 7c HEX: 61 HEX: 02 HEX: a6 } [ 3 MFXER ] test-assembler +B{ HEX: 7c HEX: 68 HEX: 02 HEX: a6 } [ 3 MFLR ] test-assembler +B{ HEX: c0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFS ] test-assembler +B{ HEX: c4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFSU ] test-assembler +B{ HEX: c8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFD ] test-assembler +B{ HEX: cc HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 LFDU ] test-assembler +B{ HEX: d0 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFS ] test-assembler +B{ HEX: d4 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFSU ] test-assembler +B{ HEX: d8 HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFD ] test-assembler +B{ HEX: dc HEX: 22 HEX: 00 HEX: 03 } [ 1 2 3 STFDU ] test-assembler +B{ HEX: fc HEX: 20 HEX: 10 HEX: 48 } [ 1 2 FMR ] test-assembler +B{ HEX: fc HEX: 20 HEX: 10 HEX: 1e } [ 1 2 FCTIWZ ] test-assembler +B{ HEX: fc HEX: 22 HEX: 18 HEX: 2a } [ 1 2 3 FADD ] test-assembler +B{ HEX: fc HEX: 22 HEX: 18 HEX: 2b } [ 1 2 3 FADD. ] test-assembler +B{ HEX: fc HEX: 22 HEX: 18 HEX: 28 } [ 1 2 3 FSUB ] test-assembler +B{ HEX: fc HEX: 22 HEX: 00 HEX: f2 } [ 1 2 3 FMUL ] test-assembler +B{ HEX: fc HEX: 22 HEX: 18 HEX: 24 } [ 1 2 3 FDIV ] test-assembler +B{ HEX: fc HEX: 20 HEX: 10 HEX: 2c } [ 1 2 FSQRT ] test-assembler +B{ HEX: fc HEX: 41 HEX: 18 HEX: 00 } [ 1 2 3 FCMPU ] test-assembler +B{ HEX: fc HEX: 41 HEX: 18 HEX: 40 } [ 1 2 3 FCMPO ] test-assembler +B{ HEX: 3c HEX: 60 HEX: 12 HEX: 34 HEX: 60 HEX: 63 HEX: 56 HEX: 78 } [ HEX: 12345678 3 LOAD ] test-assembler diff --git a/basis/cpu/ppc/assembler/backend/backend.factor b/basis/cpu/ppc/assembler/backend/backend.factor index befbe112bd..946aca6990 100644 --- a/basis/cpu/ppc/assembler/backend/backend.factor +++ b/basis/cpu/ppc/assembler/backend/backend.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: compiler.codegen.fixup cpu.architecture compiler.constants kernel namespaces make sequences words math math.bitwise io.binary parser lexer ; IN: cpu.ppc.assembler.backend -: insn ( operand opcode -- ) { 26 0 } bitfield , ; +: insn ( operand opcode -- ) { 26 0 } bitfield 4 >be % ; : a-insn ( d a b c xo rc opcode -- ) [ { 0 1 6 11 16 21 } bitfield ] dip insn ; From 18454e4e6ed5fddd9623f71b75eb49044275baaf Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 5 May 2009 20:56:44 -0500 Subject: [PATCH 03/10] cpu.x86.bootstrap: remove obsolete comment --- basis/cpu/x86/bootstrap.factor | 3 --- 1 file changed, 3 deletions(-) diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 4fe5e5cd33..fcd8ed0eee 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -152,9 +152,6 @@ big-endian off ! ! ! Polymorphic inline caches -! temp0 contains the object being dispatched on -! temp1 contains its class - ! Load a value from a stack position [ temp1 ds-reg HEX: ffffffff [+] MOV rc-absolute rt-untagged jit-rel From ff0cef1627f7b53b2ec9f4d1e115aa9ad5483d58 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 5 May 2009 22:58:38 -0500 Subject: [PATCH 04/10] throw more errors on tiff if formats are unsupported --- basis/images/tiff/tiff.factor | 69 ++++++++++++++++++++++------------- 1 file changed, 44 insertions(+), 25 deletions(-) diff --git a/basis/images/tiff/tiff.factor b/basis/images/tiff/tiff.factor index 6bf1ea2ff1..27dc25de73 100755 --- a/basis/images/tiff/tiff.factor +++ b/basis/images/tiff/tiff.factor @@ -5,7 +5,7 @@ compression.lzw constructors endian fry grouping images io io.binary io.encodings.ascii io.encodings.binary io.encodings.string io.encodings.utf8 io.files kernel math math.bitwise math.order math.parser pack prettyprint sequences -strings math.vectors specialized-arrays.float ; +strings math.vectors specialized-arrays.float locals ; IN: images.tiff TUPLE: tiff-image < image ; @@ -184,7 +184,7 @@ samples-per-pixel new-subfile-type subfile-type orientation software date-time photoshop exif-ifd sub-ifd inter-color-profile xmp iptc fill-order document-name page-number page-name x-position y-position host-computer copyright artist -min-sample-value max-sample-value make model cell-width cell-length +min-sample-value max-sample-value tiff-make tiff-model cell-width cell-length gray-response-unit gray-response-curve color-map threshholding image-description free-offsets free-byte-counts tile-width tile-length matteing data-type image-depth tile-depth @@ -243,10 +243,13 @@ ERROR: bad-tiff-magic bytes ; ERROR: no-tag class ; -: find-tag ( idf class -- tag ) - swap processed-tags>> ?at [ no-tag ] unless ; +: find-tag* ( ifd class -- tag/class ? ) + swap processed-tags>> ?at ; -: tag? ( idf class -- tag ) +: find-tag ( ifd class -- tag ) + find-tag* [ no-tag ] unless ; + +: tag? ( ifd class -- tag ) swap processed-tags>> key? ; : read-strips ( ifd -- ifd ) @@ -339,8 +342,8 @@ ERROR: bad-small-ifd-type n ; { 266 [ fill-order ] } { 269 [ ascii decode document-name ] } { 270 [ ascii decode image-description ] } - { 271 [ ascii decode make ] } - { 272 [ ascii decode model ] } + { 271 [ ascii decode tiff-make ] } + { 272 [ ascii decode tiff-model ] } { 273 [ strip-offsets ] } { 274 [ orientation ] } { 277 [ samples-per-pixel ] } @@ -350,7 +353,7 @@ ERROR: bad-small-ifd-type n ; { 281 [ max-sample-value ] } { 282 [ first x-resolution ] } { 283 [ first y-resolution ] } - { 284 [ planar-configuration ] } + { 284 [ lookup-planar-configuration planar-configuration ] } { 285 [ page-name ] } { 286 [ x-position ] } { 287 [ y-position ] } @@ -437,8 +440,8 @@ ERROR: unhandled-compression compression ; [ samples-per-pixel find-tag ] tri [ * ] keep '[ - _ group [ _ group [ rest ] [ first ] bi - [ v+ ] accumulate swap suffix concat ] map + _ group + [ _ group unclip [ v+ ] accumulate swap suffix concat ] map concat >byte-array ] change-bitmap ; @@ -521,23 +524,39 @@ ERROR: unknown-component-order ifd ; ] with-tiff-endianness ] with-file-reader ; -: process-tif-ifds ( parsed-tiff -- parsed-tiff ) - dup ifds>> [ - read-strips - uncompress-strips - strips>bitmap - fix-bitmap-endianness - strips-predictor - dup extra-samples tag? [ handle-alpha-data ] when - drop - ] each ; +: process-chunky-ifd ( ifd -- ) + read-strips + uncompress-strips + strips>bitmap + fix-bitmap-endianness + strips-predictor + dup extra-samples tag? [ handle-alpha-data ] when + drop ; + +: process-planar-ifd ( ifd -- ) + "planar ifd not supported" throw ; + +: dispatch-planar-configuration ( ifd planar-configuration -- ) + { + { planar-configuration-chunky [ process-chunky-ifd ] } + { planar-configuration-planar [ process-planar-ifd ] } + } case ; + +: process-ifd ( ifd -- ) + dup planar-configuration find-tag* [ + dispatch-planar-configuration + ] [ + drop "no planar configuration" throw + ] if ; + +: process-tif-ifds ( parsed-tiff -- ) + ifds>> [ process-ifd ] each ; : load-tiff ( path -- parsed-tiff ) - [ load-tiff-ifds ] [ - binary [ - [ process-tif-ifds ] with-tiff-endianness - ] with-file-reader - ] bi ; + [ load-tiff-ifds dup ] keep + binary [ + [ process-tif-ifds ] with-tiff-endianness + ] with-file-reader ; ! tiff files can store several images -- we just take the first for now M: tiff-image load-image* ( path tiff-image -- image ) From d39e5ffe934f7f37d59fb0d8720c7fc8af9deab0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 5 May 2009 23:25:26 -0500 Subject: [PATCH 05/10] _finally_ cleaned up miller-rabin. it's passable now --- basis/math/miller-rabin/miller-rabin.factor | 33 ++++++++++----------- 1 file changed, 15 insertions(+), 18 deletions(-) diff --git a/basis/math/miller-rabin/miller-rabin.factor b/basis/math/miller-rabin/miller-rabin.factor index 8c237d0dc3..62d8ee4432 100755 --- a/basis/math/miller-rabin/miller-rabin.factor +++ b/basis/math/miller-rabin/miller-rabin.factor @@ -6,31 +6,28 @@ IN: math.miller-rabin odd ( n -- int ) dup even? [ 1+ ] when ; foldable +: >odd ( n -- int ) dup even? [ 1 + ] when ; foldable TUPLE: positive-even-expected n ; :: (miller-rabin) ( n trials -- ? ) - [let | r [ n 1- factor-2s drop ] - s [ n 1- factor-2s nip ] - prime?! [ t ] - a! [ 0 ] - count! [ 0 ] | - trials [ - n 1- [1,b] random a! - a s n ^mod 1 = [ - 0 count! - r [ - 2^ s * a swap n ^mod n - -1 = - [ count 1+ count! r + ] when - ] each - count zero? [ f prime?! trials + ] when - ] unless drop - ] each prime? ] ; + n 1 - :> n-1 + n-1 factor-2s :> s :> r + 0 :> a! + trials [ + drop + n-1 [1,b] random a! + a s n ^mod 1 = [ + f + ] [ + r [ 2^ s * a swap n ^mod n - -1 = ] any? + ] if + ] any? ; + PRIVATE> -: next-odd ( m -- n ) dup even? [ 1+ ] [ 2 + ] if ; +: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; : miller-rabin* ( n numtrials -- ? ) over { From c2fe62f7d6e5bf3f9683a6084244bd89db3afba9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 5 May 2009 23:32:23 -0500 Subject: [PATCH 06/10] remove 1-, 1+, use iota somewhere --- basis/math/bits/bits.factor | 2 +- basis/math/bitwise/bitwise.factor | 12 ++++++------ basis/math/blas/vectors/vectors.factor | 2 +- basis/math/functions/functions.factor | 10 +++++----- basis/math/intervals/intervals.factor | 6 +++--- basis/math/polynomials/polynomials.factor | 4 ++-- basis/math/ranges/ranges.factor | 2 +- basis/math/statistics/statistics.factor | 6 +++--- 8 files changed, 22 insertions(+), 22 deletions(-) diff --git a/basis/math/bits/bits.factor b/basis/math/bits/bits.factor index 8920955df3..72b83a991f 100644 --- a/basis/math/bits/bits.factor +++ b/basis/math/bits/bits.factor @@ -7,7 +7,7 @@ TUPLE: bits { number read-only } { length read-only } ; C: bits : make-bits ( number -- bits ) - dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1+ ] if ; inline + dup zero? [ drop T{ bits f 0 0 } ] [ dup abs log2 1 + ] if ; inline M: bits length length>> ; diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index 3148567bc0..73d111f91e 100755 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -13,10 +13,10 @@ IN: math.bitwise : unmask? ( x n -- ? ) unmask 0 > ; inline : mask ( x n -- ? ) bitand ; inline : mask? ( x n -- ? ) mask 0 > ; inline -: wrap ( m n -- m' ) 1- bitand ; inline +: wrap ( m n -- m' ) 1 - bitand ; inline : bits ( m n -- m' ) 2^ wrap ; inline : mask-bit ( m n -- m' ) 2^ mask ; inline -: on-bits ( n -- m ) 2^ 1- ; inline +: on-bits ( n -- m ) 2^ 1 - ; inline : toggle-bit ( m n -- m' ) 2^ bitxor ; inline : shift-mod ( n s w -- n ) @@ -64,8 +64,8 @@ DEFER: byte-bit-count << \ byte-bit-count -256 [ - 8 0 [ [ 1+ ] when ] reduce +256 iota [ + 8 0 [ [ 1 + ] when ] reduce ] B{ } map-as '[ HEX: ff bitand _ nth-unsafe ] (( byte -- table )) define-declared @@ -97,12 +97,12 @@ PRIVATE> ! Signed byte array to integer conversion : signed-le> ( bytes -- x ) - [ le> ] [ length 8 * 1- on-bits ] bi + [ le> ] [ length 8 * 1 - on-bits ] bi 2dup > [ bitnot bitor ] [ drop ] if ; : signed-be> ( bytes -- x ) signed-le> ; : >signed ( x n -- y ) - 2dup neg 1+ shift 1 = [ 2^ - ] [ drop ] if ; + 2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ; diff --git a/basis/math/blas/vectors/vectors.factor b/basis/math/blas/vectors/vectors.factor index d7c6ebc927..3017a12b18 100755 --- a/basis/math/blas/vectors/vectors.factor +++ b/basis/math/blas/vectors/vectors.factor @@ -164,7 +164,7 @@ M: VECTOR element-type M: VECTOR Vswap (prepare-swap) [ XSWAP ] 2dip ; M: VECTOR Viamax - (prepare-nrm2) IXAMAX 1- ; + (prepare-nrm2) IXAMAX 1 - ; M: VECTOR (blas-vector-like) drop ; diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 41cb52a396..0a5e89ccd6 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -18,7 +18,7 @@ M: real sqrt : factor-2s ( n -- r s ) #! factor an integer into 2^r * s dup 0 = [ 1 ] [ - 0 swap [ dup even? ] [ [ 1+ ] [ 2/ ] bi* ] while + 0 swap [ dup even? ] [ [ 1 + ] [ 2/ ] bi* ] while ] if ; inline > first 1 max dup most-positive-fixnum > [ drop full-interval interval-log2 ] - [ 1+ >integer log2 0 swap [a,b] ] + [ 1 + >integer log2 0 swap [a,b] ] if ] } case ; @@ -407,7 +407,7 @@ SYMBOL: incomparable : integral-closure ( i1 -- i2 ) dup special-interval? [ - [ from>> first2 [ 1+ ] unless ] - [ to>> first2 [ 1- ] unless ] + [ from>> first2 [ 1 + ] unless ] + [ to>> first2 [ 1 - ] unless ] bi [a,b] ] unless ; diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index ec09b366a1..f65c4ecaaf 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -29,7 +29,7 @@ PRIVATE> : n*p ( n p -- n*p ) n*v ; : pextend-conv ( p q -- p q ) - 2dup [ length ] bi@ + 1- 2pad-tail [ >vector ] bi@ ; + 2dup [ length ] bi@ + 1 - 2pad-tail [ >vector ] bi@ ; : p* ( p q -- r ) 2unempty pextend-conv dup length @@ -44,7 +44,7 @@ PRIVATE> 2ptrim 2dup [ length ] bi@ - dup 1 < [ drop 1 ] when - [ over length + 0 pad-head pextend ] keep 1+ ; + [ over length + 0 pad-head pextend ] keep 1 + ; : /-last ( seq seq -- a ) #! divide the last two numbers in the sequences diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor index 068f599b6f..883be006dc 100644 --- a/basis/math/ranges/ranges.factor +++ b/basis/math/ranges/ranges.factor @@ -10,7 +10,7 @@ TUPLE: range { step read-only } ; : ( a b step -- range ) - [ over - ] dip [ /i 1+ 0 max ] keep range boa ; inline + [ over - ] dip [ /i 1 + 0 max ] keep range boa ; inline M: range length ( seq -- n ) length>> ; diff --git a/basis/math/statistics/statistics.factor b/basis/math/statistics/statistics.factor index 589876184f..4cd8c5b888 100644 --- a/basis/math/statistics/statistics.factor +++ b/basis/math/statistics/statistics.factor @@ -15,7 +15,7 @@ IN: math.statistics : median ( seq -- n ) natural-sort dup length even? [ - [ midpoint@ dup 1- 2array ] keep nths mean + [ midpoint@ dup 1 - 2array ] keep nths mean ] [ [ midpoint@ ] keep nth ] if ; @@ -33,7 +33,7 @@ IN: math.statistics drop 0 ] [ [ [ mean ] keep [ - sq ] with sigma ] keep - length 1- / + length 1 - / ] if ; : std ( seq -- x ) @@ -47,7 +47,7 @@ IN: math.statistics 0 [ [ [ pick ] dip swap - ] bi@ * + ] 2reduce 2nip ; : (r) ( mean(x) mean(y) {x} {y} sx sy -- r ) - * recip [ [ ((r)) ] keep length 1- / ] dip * ; + * recip [ [ ((r)) ] keep length 1 - / ] dip * ; : [r] ( {{x,y}...} -- mean(x) mean(y) {x} {y} sx sy ) first2 [ [ [ mean ] bi@ ] 2keep ] 2keep [ std ] bi@ ; From 92732f4c65e59aaf8b0c788d2884dba23954d20a Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 6 May 2009 00:54:14 -0500 Subject: [PATCH 07/10] fix miller-rabin, it's correct but a little ugly still. bed time --- .../miller-rabin/miller-rabin-tests.factor | 12 ++++- basis/math/miller-rabin/miller-rabin.factor | 52 +++++++++++++++---- 2 files changed, 52 insertions(+), 12 deletions(-) diff --git a/basis/math/miller-rabin/miller-rabin-tests.factor b/basis/math/miller-rabin/miller-rabin-tests.factor index 5f1b9835e4..676c4bf20d 100644 --- a/basis/math/miller-rabin/miller-rabin-tests.factor +++ b/basis/math/miller-rabin/miller-rabin-tests.factor @@ -1,4 +1,4 @@ -USING: math.miller-rabin tools.test ; +USING: math.miller-rabin tools.test kernel sequences ; IN: math.miller-rabin.tests [ f ] [ 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 miller-rabin ] unit-test @@ -8,4 +8,12 @@ IN: math.miller-rabin.tests [ t ] [ 37 miller-rabin ] unit-test [ 101 ] [ 100 next-prime ] unit-test [ t ] [ 2135623355842621559 miller-rabin ] unit-test -[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test \ No newline at end of file +[ 100000000000031 ] [ 100000000000000 next-prime ] unit-test + +[ 863 ] [ 862 next-safe-prime ] unit-test +[ f ] [ 862 safe-prime? ] unit-test +[ t ] [ 7 safe-prime? ] unit-test +[ f ] [ 31 safe-prime? ] unit-test +[ t ] [ 863 safe-prime? ] unit-test + +[ f ] [ 1000 [ drop 15 miller-rabin ] any? ] unit-test diff --git a/basis/math/miller-rabin/miller-rabin.factor b/basis/math/miller-rabin/miller-rabin.factor index 62d8ee4432..93d7f4c582 100755 --- a/basis/math/miller-rabin/miller-rabin.factor +++ b/basis/math/miller-rabin/miller-rabin.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: combinators kernel locals math math.functions math.ranges -random sequences sets ; +random sequences sets combinators.short-circuit ; IN: math.miller-rabin n-1 n-1 factor-2s :> s :> r 0 :> a! - + t :> prime?! trials [ - drop - n-1 [1,b] random a! + n 1 - [1,b] random a! a s n ^mod 1 = [ - f - ] [ - r [ 2^ s * a swap n ^mod n - -1 = ] any? - ] if - ] any? ; - + r iota [ + 2^ s * a swap n ^mod n - -1 = + ] any? not [ f prime?! trials + ] when + ] unless drop + ] each prime? ; + PRIVATE> : next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; @@ -71,3 +70,36 @@ ERROR: too-few-primes ; dup 5 < [ too-few-primes ] when 2dup [ random-prime ] curry replicate dup all-unique? [ 2nip ] [ drop unique-primes ] if ; + +! Safe primes are of the form p = 2q + 1, p,q are prime +! See http://en.wikipedia.org/wiki/Safe_prime + +safe-prime-form ( q -- p ) 2 * 1 + ; + +: safe-prime-candidate? ( n -- ? ) + >safe-prime-form + 1 + 6 divisor? ; + +: next-safe-prime-candidate ( n -- candidate ) + 1 - 2/ + next-prime dup safe-prime-candidate? + [ next-safe-prime-candidate ] unless ; + +PRIVATE> + +: safe-prime? ( q -- ? ) + { + [ 1 - 2 / dup integer? [ miller-rabin ] [ drop f ] if ] + [ miller-rabin ] + } 1&& ; + +: next-safe-prime ( n -- q ) + next-safe-prime-candidate + dup >safe-prime-form + dup miller-rabin + [ nip ] [ drop next-safe-prime ] if ; + +: random-safe-prime ( numbits -- p ) + random-bits next-safe-prime ; From e1889c398155f380ac5eba02cdf90d033480948e Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 10:38:39 -0500 Subject: [PATCH 08/10] specialized-arrays: fix unit tests for bool type change --- basis/specialized-arrays/specialized-arrays-tests.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/specialized-arrays/specialized-arrays-tests.factor b/basis/specialized-arrays/specialized-arrays-tests.factor index 73e719b806..f64542fa00 100644 --- a/basis/specialized-arrays/specialized-arrays-tests.factor +++ b/basis/specialized-arrays/specialized-arrays-tests.factor @@ -2,7 +2,7 @@ IN: specialized-arrays.tests USING: tools.test specialized-arrays sequences specialized-arrays.int specialized-arrays.bool specialized-arrays.ushort alien.c-types accessors kernel -specialized-arrays.direct.int arrays ; +specialized-arrays.direct.int specialized-arrays.char arrays ; [ t ] [ { 1 2 3 } >int-array int-array? ] unit-test @@ -10,7 +10,7 @@ specialized-arrays.direct.int arrays ; [ 2 ] [ int-array{ 1 2 3 } second ] unit-test -[ t ] [ { t f t } >bool-array underlying>> { 1 0 1 } >int-array underlying>> = ] unit-test +[ t ] [ { t f t } >bool-array underlying>> { 1 0 1 } >char-array underlying>> = ] unit-test [ ushort-array{ 1234 } ] [ little-endian? B{ 210 4 } B{ 4 210 } ? byte-array>ushort-array From 9b5933d97cdb6f6adf023acba84a2c43819efd9f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 6 May 2009 11:03:04 -0500 Subject: [PATCH 09/10] Move modules to unmaintained since it has a few issues --- {extra => unmaintained}/modules/remote-loading/authors.txt | 0 .../modules/remote-loading/remote-loading.factor | 0 {extra => unmaintained}/modules/remote-loading/summary.txt | 0 {extra => unmaintained}/modules/rpc-server/authors.txt | 0 {extra => unmaintained}/modules/rpc-server/rpc-server.factor | 0 {extra => unmaintained}/modules/rpc-server/summary.txt | 0 {extra => unmaintained}/modules/rpc/authors.txt | 0 {extra => unmaintained}/modules/rpc/rpc-docs.factor | 0 {extra => unmaintained}/modules/rpc/rpc.factor | 0 {extra => unmaintained}/modules/rpc/summary.txt | 0 {extra => unmaintained}/modules/uploads/authors.txt | 0 {extra => unmaintained}/modules/uploads/summary.txt | 0 {extra => unmaintained}/modules/uploads/uploads.factor | 0 {extra => unmaintained}/modules/using/authors.txt | 0 {extra => unmaintained}/modules/using/summary.txt | 0 {extra => unmaintained}/modules/using/tests/tags.txt | 0 {extra => unmaintained}/modules/using/tests/test-server.factor | 0 {extra => unmaintained}/modules/using/tests/tests.factor | 0 {extra => unmaintained}/modules/using/using-docs.factor | 0 {extra => unmaintained}/modules/using/using.factor | 0 20 files changed, 0 insertions(+), 0 deletions(-) rename {extra => unmaintained}/modules/remote-loading/authors.txt (100%) rename {extra => unmaintained}/modules/remote-loading/remote-loading.factor (100%) rename {extra => unmaintained}/modules/remote-loading/summary.txt (100%) rename {extra => unmaintained}/modules/rpc-server/authors.txt (100%) rename {extra => unmaintained}/modules/rpc-server/rpc-server.factor (100%) rename {extra => unmaintained}/modules/rpc-server/summary.txt (100%) rename {extra => unmaintained}/modules/rpc/authors.txt (100%) rename {extra => unmaintained}/modules/rpc/rpc-docs.factor (100%) rename {extra => unmaintained}/modules/rpc/rpc.factor (100%) rename {extra => unmaintained}/modules/rpc/summary.txt (100%) rename {extra => unmaintained}/modules/uploads/authors.txt (100%) rename {extra => unmaintained}/modules/uploads/summary.txt (100%) rename {extra => unmaintained}/modules/uploads/uploads.factor (100%) rename {extra => unmaintained}/modules/using/authors.txt (100%) rename {extra => unmaintained}/modules/using/summary.txt (100%) rename {extra => unmaintained}/modules/using/tests/tags.txt (100%) rename {extra => unmaintained}/modules/using/tests/test-server.factor (100%) rename {extra => unmaintained}/modules/using/tests/tests.factor (100%) rename {extra => unmaintained}/modules/using/using-docs.factor (100%) rename {extra => unmaintained}/modules/using/using.factor (100%) diff --git a/extra/modules/remote-loading/authors.txt b/unmaintained/modules/remote-loading/authors.txt similarity index 100% rename from extra/modules/remote-loading/authors.txt rename to unmaintained/modules/remote-loading/authors.txt diff --git a/extra/modules/remote-loading/remote-loading.factor b/unmaintained/modules/remote-loading/remote-loading.factor similarity index 100% rename from extra/modules/remote-loading/remote-loading.factor rename to unmaintained/modules/remote-loading/remote-loading.factor diff --git a/extra/modules/remote-loading/summary.txt b/unmaintained/modules/remote-loading/summary.txt similarity index 100% rename from extra/modules/remote-loading/summary.txt rename to unmaintained/modules/remote-loading/summary.txt diff --git a/extra/modules/rpc-server/authors.txt b/unmaintained/modules/rpc-server/authors.txt similarity index 100% rename from extra/modules/rpc-server/authors.txt rename to unmaintained/modules/rpc-server/authors.txt diff --git a/extra/modules/rpc-server/rpc-server.factor b/unmaintained/modules/rpc-server/rpc-server.factor similarity index 100% rename from extra/modules/rpc-server/rpc-server.factor rename to unmaintained/modules/rpc-server/rpc-server.factor diff --git a/extra/modules/rpc-server/summary.txt b/unmaintained/modules/rpc-server/summary.txt similarity index 100% rename from extra/modules/rpc-server/summary.txt rename to unmaintained/modules/rpc-server/summary.txt diff --git a/extra/modules/rpc/authors.txt b/unmaintained/modules/rpc/authors.txt similarity index 100% rename from extra/modules/rpc/authors.txt rename to unmaintained/modules/rpc/authors.txt diff --git a/extra/modules/rpc/rpc-docs.factor b/unmaintained/modules/rpc/rpc-docs.factor similarity index 100% rename from extra/modules/rpc/rpc-docs.factor rename to unmaintained/modules/rpc/rpc-docs.factor diff --git a/extra/modules/rpc/rpc.factor b/unmaintained/modules/rpc/rpc.factor similarity index 100% rename from extra/modules/rpc/rpc.factor rename to unmaintained/modules/rpc/rpc.factor diff --git a/extra/modules/rpc/summary.txt b/unmaintained/modules/rpc/summary.txt similarity index 100% rename from extra/modules/rpc/summary.txt rename to unmaintained/modules/rpc/summary.txt diff --git a/extra/modules/uploads/authors.txt b/unmaintained/modules/uploads/authors.txt similarity index 100% rename from extra/modules/uploads/authors.txt rename to unmaintained/modules/uploads/authors.txt diff --git a/extra/modules/uploads/summary.txt b/unmaintained/modules/uploads/summary.txt similarity index 100% rename from extra/modules/uploads/summary.txt rename to unmaintained/modules/uploads/summary.txt diff --git a/extra/modules/uploads/uploads.factor b/unmaintained/modules/uploads/uploads.factor similarity index 100% rename from extra/modules/uploads/uploads.factor rename to unmaintained/modules/uploads/uploads.factor diff --git a/extra/modules/using/authors.txt b/unmaintained/modules/using/authors.txt similarity index 100% rename from extra/modules/using/authors.txt rename to unmaintained/modules/using/authors.txt diff --git a/extra/modules/using/summary.txt b/unmaintained/modules/using/summary.txt similarity index 100% rename from extra/modules/using/summary.txt rename to unmaintained/modules/using/summary.txt diff --git a/extra/modules/using/tests/tags.txt b/unmaintained/modules/using/tests/tags.txt similarity index 100% rename from extra/modules/using/tests/tags.txt rename to unmaintained/modules/using/tests/tags.txt diff --git a/extra/modules/using/tests/test-server.factor b/unmaintained/modules/using/tests/test-server.factor similarity index 100% rename from extra/modules/using/tests/test-server.factor rename to unmaintained/modules/using/tests/test-server.factor diff --git a/extra/modules/using/tests/tests.factor b/unmaintained/modules/using/tests/tests.factor similarity index 100% rename from extra/modules/using/tests/tests.factor rename to unmaintained/modules/using/tests/tests.factor diff --git a/extra/modules/using/using-docs.factor b/unmaintained/modules/using/using-docs.factor similarity index 100% rename from extra/modules/using/using-docs.factor rename to unmaintained/modules/using/using-docs.factor diff --git a/extra/modules/using/using.factor b/unmaintained/modules/using/using.factor similarity index 100% rename from extra/modules/using/using.factor rename to unmaintained/modules/using/using.factor From a2a5129a84972001054c4afc88a5fb633b433856 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Wed, 6 May 2009 12:21:30 -0500 Subject: [PATCH 10/10] fix miller-rabin, safe primes --- basis/math/miller-rabin/miller-rabin.factor | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/basis/math/miller-rabin/miller-rabin.factor b/basis/math/miller-rabin/miller-rabin.factor index 93d7f4c582..8c36dd96fe 100755 --- a/basis/math/miller-rabin/miller-rabin.factor +++ b/basis/math/miller-rabin/miller-rabin.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: combinators kernel locals math math.functions math.ranges -random sequences sets combinators.short-circuit ; +random sequences sets combinators.short-circuit math.bitwise ; IN: math.miller-rabin n-1 n-1 factor-2s :> s :> r 0 :> a! - t :> prime?! trials [ + drop n 1 - [1,b] random a! a s n ^mod 1 = [ + f + ] [ r iota [ 2^ s * a swap n ^mod n - -1 = - ] any? not [ f prime?! trials + ] when - ] unless drop - ] each prime? ; + ] any? not + ] if + ] any? not ; PRIVATE> @@ -83,7 +85,6 @@ ERROR: too-few-primes ; 1 + 6 divisor? ; : next-safe-prime-candidate ( n -- candidate ) - 1 - 2/ next-prime dup safe-prime-candidate? [ next-safe-prime-candidate ] unless ; @@ -101,5 +102,8 @@ PRIVATE> dup miller-rabin [ nip ] [ drop next-safe-prime ] if ; +: random-bits* ( numbits -- n ) + [ random-bits ] keep set-bit ; + : random-safe-prime ( numbits -- p ) - random-bits next-safe-prime ; + 1- random-bits* next-safe-prime ;