Skip to content

Commit

Permalink
PRIME? simplified based on factor.
Browse files Browse the repository at this point in the history 
Separate constant.m4 for linux 32, linux 64 and osx.
Only constant.m4 generated.
linux 64 uses 64 bit system calls, which triggered cosmetic changes.
  • Loading branch information
albert committed Apr 23, 2013
1 parent d3043d4 commit 2047423
Show file tree
Hide file tree
Showing 4 changed files with 163 additions and 23 deletions.
10 changes: 5 additions & 5 deletions blocks.frt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -862,22 +862,22 @@ VARIABLE m ( Modulo number)
: x^x m @ >R m ! 1 ROT ROT
BEGIN DUP 1 AND IF reduce_1- THEN reduce_2/
DUP 0= UNTIL 2DROP R> m ! ;
( PRIME? FACTOR GCD ) \ AvdH A9feb06
( PRIME? FACTOR GCD ) \ AvdH B3apr03
\ For N and HINT return FACTOR >= hint, maybe n.
: FACTOR BEGIN 2DUP /MOD SWAP
0= IF DROP SWAP DROP EXIT THEN
OVER < IF DROP EXIT THEN
1+ 1 OR AGAIN ;

\ For N return: "It IS prime" ( Cases 0 1 return FALSE)
: PRIME?
DUP 4 < IF 1 > EXIT THEN \ 0 1 2 3
DUP 1 AND 0= IF DROP 0 EXIT THEN \ Even non-prime.
DUP 3 FACTOR = ;
: PRIME? DUP 4 < IF 1 > ELSE DUP 2 FACTOR = THEN ;

\ For M N , return their GCD.
: GCD BEGIN OVER MOD DUP WHILE SWAP REPEAT DROP ;




( /STRING -LEADING DROP-WORD ) \ AvdH B@aug12

\ From SC trim N char's
Expand Down
77 changes: 59 additions & 18 deletions ci86.gnr
View file
Original file line number Diff line number Diff line change
Expand Up @@ -325,16 +325,15 @@ BOOTOFFSET EQU 0
})_C{}_END_({ _SWITCH_})

_HOSTED_LINUX_({
include(constant.m4)
_BITS32_({include(constant.m4) })
_BITS64_({include(constant_64.m4) })
RAWIO EQU (ECHO _OR_ ICANON)
_LINUX_C_({Called from c. Remainder c-routines to be called from here.
extern c_type,c_expec,c_key,c_qterm
extern c_rslw, c_block_exit, c_block_init, c_debug
GLOBAL ciforth})
})_C{}_END_({ _HOSTED_LINUX_})
_HOSTED_OSX_({
include(constant_osx.m4)
})_C{}_END_({ _HOSTED_OSX_})
_HOSTED_OSX_({include(constant_osx.m4) })
_PC_({
create EQU 0x3C00
open EQU 0x3D00
Expand Down Expand Up @@ -1990,12 +1989,12 @@ _C{ Initialisation block for user variables through DOC-LINK}
_C{ <<<<< must be in same order as user variables >>>>>}
_C{ Still fig-compatible! Both entries take two cells.}
_C
MOV WOR,_OFFSET COLD
LEA WOR,[COLD]
JMP _CELL_PTR[WOR] _C{Hope stacks are still okay.}
_ALIGN(_CELLS(1))
dnl This is for indirect threaded code, loading HIP with PHA would be portable.
_C{ Make it possible to revector WARM. You can even make it low level. }
MOV WOR,_OFFSET WARM
LEA WOR,[WARM]
JMP _CELL_PTR[WOR] _C{Hope stacks are still okay.}
_ALIGN(_CELLS(1))
USINI: DC STRUSA dnl
Expand Down Expand Up @@ -7342,11 +7341,26 @@ that are handled by forthcode({XOS5}) .
enddoc)
_LINUX_N_({
CODE_HEADER({XOS},{XOS})
_BITS32_({
POP AX _C{ Function number}
POP DX _C{ Third parameter, if any}
POP CX _C{ Second parameter, if any}
POP DX _C{ Third parameter, or dummy}
POP CX _C{ Second parameter, or dummy}
POP BX _C{ First parameter.}
INT 0x80 _C{ Generic call on LINUX }
})_C{}_END_({_BITS32_})
_BITS64_({
LEA RPO,[RPO - _CELLS(1)] _C{Save HIP on return stack.}
MOV [RPO],HIP
_C({ XCHG BX,HIP #Save HIP in BX why not })
POP AX # Function number
POP DX # Third parameter, or dummy
POP SI # Second parameter, or dummy
POP DI # First parameter.
SYSCALL # Generic call on LINUX
MOV HIP,[RPO] _C{ Restore}
LEA RPO,[RPO+_CELLS(1)]
_C({ XCHG BX,HIP #Restore why not })
})_C{}_END_({_BITS64_})
_PUSH _C{ Positive means okay. Negative means -errno.}
_C
})_C{}_END_({_LINUX_N_})
Expand Down Expand Up @@ -7379,13 +7393,26 @@ _LINUX_N_({
CODE_HEADER({XOS5},{XOS5})
LEA RPO,[RPO - _CELLS(1)] _C{Save HIP on return stack.}
MOV [RPO],HIP

_BITS32_({
POP AX _C{ Function number}
POP DI _C{ 5th parameter, if any}
POP SI _C{ 4th parameter, if any}
POP DX _C{ Third parameter, if any}
POP CX _C{ Second parameter, if any}
POP DI _C{ 5th parameter, or dummy}
POP SI _C{ 4th parameter, or dummy}
POP DX _C{ Third parameter, or dummy}
POP CX _C{ Second parameter, or dummy}
POP BX _C{ First parameter.}
INT 0x80 _C{ Generic call on LINUX }
})_C{}_END_({_BITS32_})
_BITS64_({
POP AX # Function number
POP %R8 # 5th parameter, or dummy
POP %R10 # 4th parameter, or dummy
POP DX # Third parameter, or dummy
POP SI # Second parameter, or dummy
POP DI # First parameter.
SYSCALL # Generic call on LINUX
})_C{}_END_({_BITS64_})

MOV HIP,[RPO] _C{ Restore}
LEA RPO,[RPO+_CELLS(1)]
_PUSH _C{ Positive means okay. Negative means -errno.}
Expand Down Expand Up @@ -7435,16 +7462,30 @@ worddoc( {OPERATINGSYSTEM},{MS},{millisecond},{n ---},{ISO},
{{ 123 10 MS . },{123}},
enddoc)
_HEADER({MS},{MS},{DOCOL})
_BITS32_({
_C{ Use select because nanosleep has a 20 MS resolution. }
DC LIT, 1000, LIT, 1000000, SSMOD _C{ (ms -- us s) }
_BITS64_({DC LIT, TV, LSTOR, LIT, TV+4, LSTOR}
,{ DC LIT, TV, TSTOR})
DC LIT, TV, TSTOR
DC ZERO, ZERO
DC ZERO, ZERO
DC LIT, TV
DC LIT, _newselect, XOS5
})_C{}_END_({ _BITS32_})
_BITS64_({
_C{ Use select because nanosleep has a 20 MS resolution. }
_C{ Maybe change because 64 bits is better. }
DC LIT, 1000, LIT, 1000000, SSMOD _C{ (ms -- us s) }
DC LIT, TV, LSTOR, LIT, TV+4, LSTOR
DC ZERO, ZERO
DC ZERO, ZERO
DC LIT, TV
DC LIT, _newselect, XOS5
})_C{}_END_({ _BITS64_})

DC QERRUR
DC SEMIS
TV: _RESB( 8 )
TV: _RESB( _CELLS(2) ) _C{ A time_t and a long, both cells.}

_C
})_C{}_END_({ _HOSTED_X_})
_PC_({
Expand Down Expand Up @@ -8450,8 +8491,8 @@ _HEADER({KEY?},{KEYQ},{DOCOL})
DC NEGATE _C{ 1 -> flag.}
DC ZERO, LIT, RAWIO, STTERM
DC SEMIS
_ALIGN(4)
RFDS: _RESB(128) _C{32 channels maximum.}
_ALIGN(_CELLS(1))
RFDS: _RESB( _CELLS(32)) _C{32 channels maximum.}
_C
worddoc( {OUTPUT},{TYPE},{type},{addr count ---},{ISO,FIG},
{Transmit forthvar({count}) characters from forthvar({addr}) to
Expand Down Expand Up @@ -10699,7 +10740,7 @@ worddoc( {OPERATINGSYSTEM},{BYE},{bye},{---},{ISO},
enddoc)
_HEADER({BYE},{BYE},{DOCOL})
_C{ Exit to linux, with status as stored. }
DC XCODE, FETCH, X, X, ONE, XOS
DC XCODE, FETCH, X, X, LIT, exit, XOS
DC SEMIS _C{Unnecessary, but helpful for decompilation.}
})_C{}_END_({ _HOSTED_X_})
_C
Expand Down
51 changes: 51 additions & 0 deletions constant_64.m4
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@

_C{ ------------------------------------------------------------ }
_C{ Constants stolen from C in linux 64 bit environment. }
_C{ ------------------------------------------------------------ }

SEEK_SET EQU 0x0
TCGETS EQU 0x5401
TCSETS EQU 0x5402
ECHO EQU 0x8
EAGAIN EQU 0xb
EINTR EQU 0x4
EPIPE EQU 0x20
VMIN EQU 0x6
VTIME EQU 0x5
ICANON EQU 0x2
O_RDWR EQU 0x2
O_RDONLY EQU 0x0
O_WRONLY EQU 0x1
O_CREAT EQU 0x40
O_NONBLOCK EQU 0x800
SIZE_TERMIO EQU 0x3c

_C{ Numbers of system calls. See "Linux kernel Internals" Appendix A. }
_C{ By M.Beck, H. Boehme e.a. Addison Wesley. }
_C{ The system calls themselves are extensively documented in chapter }
_C{ 2 of the man pages, e.g. "man 2 exit"}

exit EQU 0x3c
open EQU 0x2
close EQU 0x3
creat EQU 0x55
unlink EQU 0x57
chdir EQU 0x50
read EQU 0x0
select EQU 0x17
write EQU 0x1
ioctl EQU 0x10
ioperm EQU 0xad
iopl EQU 0xac
lseek EQU 0x8
execve EQU 0x3b
fork EQU 0x39
waitpid EQU 0x3d
pipe EQU 0x16

wait4 EQU waitpid
RAWIO EQU (ECHO | ICANON)

_C{ ------------------------------------------------------------ }
_C{ End of constants stolen from C in linux 64 bit environment. }
_C{ ------------------------------------------------------------ }
48 changes: 48 additions & 0 deletions constant_osx.m4
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,48 @@
; ------------------------------------------------------------
; Constants stolen from C in OSX environment.
; ------------------------------------------------------------

SEEK_SET EQU 0x0
TCGETS EQU 0x5401
TCSETS EQU 0x5402
ECHO EQU 0x8
EAGAIN EQU 0xb
EINTR EQU 0x4
EPIPE EQU 0x20
VMIN EQU 0x6
VTIME EQU 0x5
ICANON EQU 0x2
O_RDWR EQU 0x2
O_RDONLY EQU 0x0
O_WRONLY EQU 0x1
O_CREAT EQU 0x40
O_NONBLOCK EQU 0x800
SIZE_TERMIO EQU 0x3c


; ------------------------------
; syscall constant declarations:
; ------------------------------

exit EQU 0x1
open EQU 0x5
close EQU 0x6
creat EQU 0x8
unlink EQU 0xa
chdir EQU 0xc
read EQU 0x3
_newselect EQU 0x5D
write EQU 0x4
ioctl EQU 0x36
; ioperm EQU 0x65 ; non-existent?
; iopl EQU 0x6e ; non-existent?
_osx_lseek EQU 0xC7
_osx_execve EQU 59
fork EQU 0x2
waitpid EQU 0x7

RAWIO EQU (ECHO | ICANON)

; ------------------------------------------------------------
; End of constants stolen from C in OSX environment.
; ------------------------------------------------------------

0 comments on commit 2047423

Please sign in to comment.