From 2047423b2846c9c40284f7bd65e4954f55da983f Mon Sep 17 00:00:00 2001 From: albert Date: Tue, 23 Apr 2013 14:57:11 +0000 Subject: [PATCH] PRIME? simplified based on factor. 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. --- blocks.frt | 10 +++---- ci86.gnr | 77 +++++++++++++++++++++++++++++++++++++------------ constant_64.m4 | 51 ++++++++++++++++++++++++++++++++ constant_osx.m4 | 48 ++++++++++++++++++++++++++++++ 4 files changed, 163 insertions(+), 23 deletions(-) create mode 100644 constant_64.m4 create mode 100644 constant_osx.m4 diff --git a/blocks.frt b/blocks.frt index acf5ebf..53194ee 100644 --- a/blocks.frt +++ b/blocks.frt @@ -862,7 +862,7 @@ 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 @@ -870,14 +870,14 @@ VARIABLE m ( Modulo number) 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 diff --git a/ci86.gnr b/ci86.gnr index 0ac7c88..5bfafc3 100644 --- a/ci86.gnr +++ b/ci86.gnr @@ -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 @@ -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 @@ -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_}) @@ -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.} @@ -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_({ @@ -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 @@ -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 diff --git a/constant_64.m4 b/constant_64.m4 new file mode 100644 index 0000000..578ed0d --- /dev/null +++ b/constant_64.m4 @@ -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{ ------------------------------------------------------------ } diff --git a/constant_osx.m4 b/constant_osx.m4 new file mode 100644 index 0000000..689d6d9 --- /dev/null +++ b/constant_osx.m4 @@ -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. +; ------------------------------------------------------------