細談輻射食物的檢測
Ching-Tang Tseng
Hamilton, New Zealand
1 Dec 2017
ilikeforth@gmail.com
http://forthfortnight.blogspot.com
本文曾於2016年11月29日貼示於我的個人臉書，一年後的今天，深覺這個問題在台灣已經變得更加嚴重，而且還要惡化，因此，刻意再度轉貼於此，供全世界永久警示。
關於輻射物質對人身危害方面的輻射度量，不是一般的簡易輻射測量儀器可以解決的問題，理由有幾：
1.輻射有很多種，世上也沒有可以從0量到無限大的測量儀器，光是這方面的知識與技術，就不是整本書能寫得盡的東西。
所以，想要量出有意義的數據，就已經不是很簡單的事情。
2.人類的生活環境內，平時就有來自於宇宙與地表物質的背景輻射(background radiation)。不強，卻對有意義的輻射量度造成很大的影響。
對人體絕對有害的輻射物質之輻射強度，就很可能遠低於大自然的背景輻射，所以難量。
3.輻射物質對人體傷害的關鍵，主要出在內曝露(inner exposure)問題上，也就是東西跑進身體內部了，輻射就能以最近距離、源近流長地連續傷害細胞。
而且還因某些元素會集中在特定的標靶器官(target organ)。例如：碘131集中到甲狀腺，鍶90與所有的鈽元素都會快速集中到骨髓...等等。後果都很可怕。
4.核子科學職業工作人員，雖訂定了一些單位工作時間內允許接受的輻射劑量（dose)上限，也就是所謂的門檻值(threshold value)，都只有外曝露，絕無內曝露。
基本上，非職業工作人員也就是一般民眾的門檻值，無論內曝露或外曝露都必須為0，意即任何時間都不該接受任何輻射劑量。
愛民的政府必須朝此原則施政，王八政府之前的政府，據此原則辦事。
單就根據上述我能簡記的幾條因素，想要單憑簡易儀器管控來自日本之絕對帶有輻射物質的食物，很難產生效果。
台灣已經長期沒有這方面的人才，我知之甚詳，就算給你最好、最精密的輻射測量儀器，也沒人會用，更何況是一般民眾？
我一直擁有天下最簡單的蓋格米勒計數器（Geiger-Muller counter)，現在還有，現在還用。它也只能量gamma射線，不能用來確認食物中有無輻射傷害物質。
想要量測食物內痕量的有害物質，有些，可能還必須使用核子科學的中子活化技術，才能量出有意義的數值。
不幸台灣賣國賊張憲義，出賣了國家，台灣被美帝國強拆了一座很貴、很有用的研究用原子爐，拆前，我管這座原子爐，拆後，較強原子爐的中子活化技術研究，也從台灣永久消失了。
講大道理，並非人人能懂，簡而言之，就該人人都懂。絕不進口日本食物，就絕對不會受害，這麼簡單，還需要強調嗎？
日本被原子彈轟炸過兩次，又到處都出過極其嚴重的核子意外事故，可謂已經是全日本到處汙染。
爐心熔毀，就釋出過最毒、最有害的鈽元素，它的半衰期長達接近2000年，日本之髒，還需要我特別強調嗎？
64 bits FORTH era
Ching-Tang Tseng
Hamilton, New Zealand
1 Dec 2017
ilikeforth@gmail.com
http://forthfortnight.blogspot.com
Thanks to
all public domain 64 bits FORTH system authors. I did something to follow their
enthusiasm and wish more developments could be contributed out.
This is the
first one: Wina64. I ran it under 64 bits W7 sometimes, found that its SAVE-SYSTEM
is not working yet for the moment, owing to the file head structure in 64 bits
environment is different from 32 bits.
I’d like to
show you a modified software Floating point emulation program contributed by BNE.
It is working in Wina64 now. The following modified code can be included
directly into Wina64 and get its output results immediately. All marks “\ ***
“at the tail of many lines are my modifications. Unfortunately, this emulation
let us have mantissa formatted I/O only. With exponent formatted I/O is not
included.
\ SFP.F
modified by Ching-Tang Tseng 2017 in New Zealand
1 LOAD
WANT DUMP
\ Floating
point emulation 11/02 BNE
\ include
locals.fth
\ anew
floatingpoint
\ ANS Forth
using CORE, CORE EXT and DOUBLE wordsets.
\ Rev 0. See
bottom for rev history.
\ Floating
point representation on floating point stack:
\ 0 upper
mantissa
\ 1 lower
mantissa
\ 2
exponent: MSB = sign of mantissa, others = signed exponent
10 CONSTANT
maxdepth \
*** 8 --> 10
3 CELLS
CONSTANT b/float
CREATE
fstak maxdepth b/float * ALLOT \ floating point stack
VARIABLE
fsp \ stack
pointer
VARIABLE
sigdigits \ # of digits to display after
decimal
VARIABLE
ferror \ last
seen error
CREATE
fpad b/float ALLOT \ temporary float variable
HEX
\ 10000 0=
[IF] 10 [ELSE] 20 [THEN] CONSTANT bits/cell \ 16-bit or 32-bit Forth
40 CONSTANT
bits/cell \ ***
DECIMAL
bits/cell 1-
602 1000 */ CONSTANT maxdig \ max decimal digits that fit in double
-1 1 RSHIFT
DUP CONSTANT &unsign INVERT CONSTANT
&sign \ 7F... 80...
&sign 1 RSHIFT CONSTANT &esign \ 40...
\
------------------------------------------------------------------------------
\ Low level
math you could CODE for better speed
\ : DLSHIFT
>R SWAP DUP R@ LSHIFT SWAP 8 CELLS R@ - RSHIFT ROT R> LSHIFT OR ; \ ***
\ : DRSHIFT
>R DUP R@ RSHIFT SWAP 8 CELLS R@ - LSHIFT ROT R> RSHIFT OR SWAP ; \ ***
\ : D2/ 1
DRSHIFT ; \
***
HEX
: D2/
DUP 1 AND
IF
2/ SWAP 2/ 8000000000000000 OR
SWAP
ELSE
2/ SWAP 2/ 7FFFFFFFFFFFFFFF AND SWAP
THEN
;
DECIMAL
: UD2/ ( d -- d' )
D2/ &unsign AND ;
\ : 0MAX (
n1 -- n2 ) DUP 0< IF DROP 0 THEN ; \
***
:
frshift ( count 'man -- ) \ right shift mantissa
SWAP 0 MAX bits/cell 2* MIN \ ***
>R DUP 2@ R> 0
?DO UD2/ LOOP ROT 2! ;
:
exp>sign ( exp -- exp' sign )
DUP &unsign AND \ mask off exponent
DUP &esign AND 2* OR \ sign extend exponent
SWAP &sign AND ; \ get sign of mantissa
:
sign>exp ( exp sign -- exp' )
SWAP &unsign AND OR ;
: +ex ( n1 offset -- n1' ) \ bump n1 but preserve its MSB
SWAP exp>sign >R + R>
sign>exp ;
\ : D2* 1
DLSHIFT ; \ ***
: D2* 2DUP
D+ ;
: T2* ( triple -- triple' )
D2* ROT DUP 0< 1 AND >R
2* ROT ROT R> 0 D+ ;
: 0<>
0= 0= ; \ ***
: T2/ ( triple -- triple' )
OVER 1 AND 0<> &sign
AND >R D2/ ROT \ MHL|C
1 RSHIFT R> OR ROT ROT ;
: 2>R
POSTPONE SWAP POSTPONE >R POSTPONE >R ;
IMMEDIATE \ ***
: 2R>
POSTPONE R> POSTPONE R> POSTPONE
SWAP ; IMMEDIATE \ ***
: 2R@
POSTPONE 2R> POSTPONE 2DUP POSTPONE 2>R ; IMMEDIATE \ ***
: T+ ( t1 t2 -- t3 )
2>R >R ROT 0 R> 0 D+ 0
2R> D+
ROT >R D+ R> ROT ROT ;
: *norm ( triple exp -- double exp' ) \ normalize triple
>R BEGIN DUP 0< 0=
WHILE
T2* R> 1- >R
REPEAT &sign 0 0 T+ \ round
ROT DROP R> ;
\
------------------------------------------------------------------------------
\ Parameter
indicies
: 'rx ( ofs -- addr ) fsp @ 3 * + CELLS fstak + ;
: 'm1 ( -- addr ) -3 'rx ; \ -> 1st stack mantissa
: 'm2 ( -- addr ) -6 'rx ; \ -> 2nd stack mantissa
: 'm3 ( -- addr ) -9 'rx ; \ -> 3rd stack mantissa \ *** -6 -->-9
: 'e1 ( -- addr ) -1 'rx ; \ -> 1st stack exponent
: 'e2 ( -- addr ) -4 'rx ; \ -> 2nd stack exponent
: 'e3 ( -- addr ) -7 'rx ; \ -> 3nd stack exponent \ *** added
: fmove ( a1 a2 -- ) b/float MOVE ;
: m1get ( addr -- ) 'm1 fmove ; \ move to M1
: m1sto ( addr -- ) 'm1 SWAP fmove ; \ move from M1
: expx1 ( -- exp sign ) 'e1 @ exp>sign ;
: expx2 ( -- exp sign ) 'e2 @ exp>sign ;
\
------------------------------------------------------------------------------
\ For
testing:
\ : f? 'm1 2@ UD2/ D>F expx1 IF FNEGATE THEN
\ &sign OR 1+ S>F 2e0 FLN
f* FEXP F* FS. ;
\ 20
SET-PRECISION : f?? FSWAP f? FSWAP f? ;
\ : fd fstak fsp @ b/float * DUMP ; \ dump stack
\
------------------------------------------------------------------------------
\ A
normalized float has an unsigned mantissa with its MSB = 1
:
normalize ( -- )
'm1 2@ 2DUP OR 0=
IF
2DROP \
Zero is a special case.
ELSE
expx1 >R >R
BEGIN
DUP 0< 0=
\ not normalized?
WHILE
D2* R> 1- >R \ shift mantissa left
REPEAT 'm1 2!
R> R> sign>exp 'e1 !
THEN
;
\
------------------------------------------------------------------------------
\ Floating
Point Words
: F2* ( fs: r1 -- r3 ) 'e1 @ 1 +ex 'e1 ! ;
: F2/ ( fs: r1 -- r3 ) 'e1 @ -1 +ex 'e1 !
;
:
PRECISION ( -- n ) sigdigits @ ;
:
SET-PRECISION ( n -- ) maxdig MIN
sigdigits ! ;
:
FCLEAR ( -- ) 0 fsp ! 0 ferror ! ;
:
FDEPTH ( -- ) fsp @ ;
: FDUP ( fs: r -- r r ) 1 fsp +! 'm2 m1get ;
: FDROP ( fs: r -- ) -1 fsp +! ;
:
FNEGATE ( fs: r1 -- r3 ) 'e1 @
&sign XOR 'e1 ! ;
:
D>F ( d -- | -- r ) FDUP DUP 0< IF DNEGATE &sign ELSE 0
THEN
'e1 ! 'm1
2! normalize ;
:
F>D ( -- d | r -- ) expx1 >R DUP &esign AND
IF
NEGATE &unsign AND 'm1 frshift 'm1 2@ R> IF DNEGATE THEN
ELSE
R> 2DROP -1 &unsign 1
ferror ! \ overflow: return maxdint
THEN
FDROP ;
:
S>F ( n -- | -- r ) S>D D>F ;
: FLOAT+ ( n1 -- n2 ) b/float + ;
:
FLOATS ( n1 -- n2 ) b/float * ;
: F@ ( a -- | -- r ) FDUP m1get ;
: F! ( a -- | r -- ) m1sto FDROP ;
: F0= ( -- t | r -- ) 'm1 2@ OR 0= FDROP ;
:
F0< ( -- t | r -- ) 'e1 @ 0< FDROP ;
: FLOOR ( fs: r1 -- r2 ) F>D DUP 0< IF
-1 S>D D+ THEN D>F ;
: FABS ( fs: r1 -- r3 ) 'e1 @ 0< IF
FNEGATE THEN ;
:
FALIGN ( -- ) ALIGN ;
:
FALIGNED ( addr -- addr ) ALIGNED ;
: FSWAP ( fs: r1 r2 -- r2 r1 ) 'm1 fpad fmove
'm2 m1get fpad 'm2 fmove ;
: FOVER ( fs: r1 r2 -- r1 r2 r3 ) 1 fsp +! 'm3
m1get ;
\ :
FPICK ( n -- ) ( fs: -- r ) 1 fsp +! 1+ -3 * 'rx m1get ;
: FPICK ( n -- ) ( f: -- r )
1 fsp +! 2 + b/float * 'rx m1get ; ( **
was BUG ) \ ***
: FNIP ( fs: r1 r2 -- r2 ) FSWAP FDROP ;
: FROT ( fs: r1 r2 r3 -- r2 r3 r1 )
'm3 fpad fmove 'm2 'm3 b/float 2* MOVE fpad m1get ;
: F+ ( fs: r1 r2 -- r3 )
FDUP F0= IF FDROP EXIT THEN \ r2 = 0
FOVER F0= IF FNIP 'e1 @ 0< IF FNEGATE
THEN EXIT THEN \ r1 = 0
expx1 >R expx2 >R - DUP 0<
IF
NEGATE 'm1 frshift 0
\ align exponents
ELSE DUP 'm2 frshift
THEN
'e2 @ +
'm2 2@ R> IF DNEGATE -1 ELSE
0 THEN
'm1 2@ R> IF DNEGATE -1 ELSE
0 THEN
T+ DUP >R ( exp L M H | sign )
DUP IF
T2/ IF DNEGATE THEN 'm2 2! 1+
ELSE
DROP 'm2 2!
THEN
R> &sign AND sign>exp 'e2 !
FDROP normalize ;
: F- ( fs: r1 r2 -- r3 ) FNEGATE F+ ;
: F< ( -- t ) ( F: r1 r2 -- ) FOVER
FOVER F- F0< ;
:
FROUND ( fs: r1 -- r2 )
expx1 >R DUP NEGATE 1- 'm1
frshift \ convert to half steps
'm1 2@ 1 0 D+ \ round
'm1 2! R> sign>exp 'e1 !
normalize ; \ re-float
: FMIN ( F: r1 r2 -- rmin ) FOVER FOVER F<
IF FDROP ELSE FNIP THEN ;
: FMAX ( F: r1 r2 -- rmax ) FOVER FOVER
F<
IF FNIP ELSE FDROP THEN ;
\ 1. VALUE
: VALUE
CREATE , \
( n -- )
DOES> @ \
( -- n )
;
: VALUES ( N
-- )
0 ?DO 0 VALUE LOOP ;
: TO ( N -- )
' >BODY STATE @
IF
POSTPONE LITERAL POSTPONE !
ELSE !
THEN ; IMMEDIATE
: +TO ( N -- )
' >BODY STATE @
IF
POSTPONE LITERAL POSTPONE +!
ELSE +!
THEN ; IMMEDIATE
0 VALUE L1
0 VALUE U1
0 VALUE L2
0 VALUE U2
: PICK 1+
CELLS DSP@ + @ ; \ ***
: F* ( fs: r1 r2 -- r3 )
'm1 2@ TO U1 TO L1 'm2 2@ TO U2
TO L2 \
{ L1 U1 L2 U2 -- } ***
L1 L2 OR
IF
L1 L2 UM* &sign 0 D+ NIP \ round
U1 U2 UM*
L1 U2 UM* 0 T+
L2 U1 UM* 0 T+
ELSE
0 U1 U2 UM*
\ lower parts are 0
THEN
2DUP OR 3 PICK OR
\ zero?
IF
expx1 >R expx2 >R + bits/cell 2* + *norm
R> R> XOR sign>exp 'e2
! 'm2 2!
ELSE
DROP D>F \ zero result
THEN
FDROP ;
: DU< ROT
2DUP = IF 2DROP U< EXIT THEN 2SWAP 2DROP SWAP U< ; \ ***
: D- ( d1 d2
-- d1-d2 ) DNEGATE D+ ; \
***
: -ROT ROT
ROT ; \
***
: U> SWAP
U< ; \
***
: F/ ( fs: r1 r2 -- r3 )
FDUP F0=
IF
FDROP -1 -1 'm1 2! 2 ferror
! \ div by 0, man= umaxint
'e1 @ &sign AND &sign
2/ 1- OR 'e1 ! \ exponent = maxint/2
ELSE
'm1 2@ 'm2 2@ DU< IF 1 'm2 frshift THEN \ divisor <= dividend
'm1 CELL+ @
IF
'm2 2@ UD2/ 'm1 2@ UD2/
\ max divisor = dmaxint
0 0 PAD 2!
bits/cell 2* 1+ 0 \ long division
DO 2OVER 2OVER DU< \ double/double
IF 0
ELSE 2DUP 2>R D- 2R>
1 \ a b --> a-b b
THEN 0 PAD 2@ D2* D+ PAD 2!
2SWAP D2* 2SWAP
LOOP DU< 0= 1 AND 0 \ round
PAD 2@ D+
bits/cell 2*
ELSE 0 'm2 2@ 'm1 @ DUP >R UM/MOD \ 0 rem quot | divisor
-ROT R@ UM/MOD -ROT R> 1
RSHIFT U> IF 1 0 D+ THEN \ round
bits/cell 2*
THEN expx2 >R expx1 >R - SWAP
-
>R 'm2 2! R> R> R>
XOR sign>exp 'e2 !
FDROP
THEN
;
: F~ ( f: r1 r2 r3 -- ) ( -- flag ) \ f-proximate
FDUP F0< \ Win32forth
version
IF
FABS FOVER FABS 3 FPICK FABS F+ F*
\ r1 r2 r3*(r1+r2)
FROT FROT F- FABS FSWAP F<
ELSE
FDUP F0=
IF FDROP F- F0=
ELSE FROT FROT F- FABS FSWAP F<
THEN
THEN ;
\ For
fixed-width fields, it makes sense to use these words for output:
\ fsplit ( F: r -- ) ( fracdigits -- sign Dint
Dfrac )
\ Converts to integers suitable
for pictured numeric format.
\ Fracdigits is the number of
digits to the right of the decimal.
\
.digits ( UD fracdigits -- )
\ Outputs a fixed number of digits
:
fsplit ( F: r -- ) ( fracdigits --
sign Dint Dfrac )
>R expx1 NIP FABS \ int part must fit in a double
FDUP F>D 2DUP D>F F- \ get int, leave frac
2 0 R> 0
?DO D2* 2DUP D2* D2* D+
LOOP \ 2 * 10^precision
D>F F* F>D 1 0 D+ UD2/ ; \ round
:
.digits ( UD cnt -- )
0 ?DO # LOOP 2DROP ;
\
Nonstandard: PRECISION is the number of digits after the decimal, not the
\ total
number of digits.
\ :
0> 0 > ; \ ***
: (F.) ( F: r -- ) ( -- addr len )
<# FDEPTH 0 > 0= IF #>
EXIT THEN \ empty stack -> blank \ *** 0< --> 0 <
PRECISION fsplit
PRECISION .digits
PRECISION IF [CHAR] . HOLD THEN
#S SIGN #> ;
: F. ( F: r -- ) (F.) TYPE SPACE ;
:
FCONSTANT ( -<name>- ) ( F: r
-- ) \ compile time
( F: -- r ) \ runtime
CREATE HERE F! b/float ALLOT
DOES> F@ ;
:
FVARIABLE ( -<name>- ) \ compile time
( F: -- r ) \ runtime
CREATE b/float ALLOT ;
\ test
goodies
: \S CR -1
ABORT" OK, abort at \S point, no more loaded. " ; \ ***
FCLEAR
100
SET-PRECISION \ max precision for
testing
CR .( 1/7 =
) 1 S>F 7 S>F F/ F.
CR .( 1/3 =
) 1 S>F 3 S>F F/ F.
CR .( 2/3 =
) 2 S>F 3 S>F F/ F.
CR .(
355/113 = ) 355 S>F 113 S>F F/ F.
: SS fstak
120 DUMP ;
\S
\
------------------------------------------------------------------------------
\ FLOATING
and FLOATING EXT words not implemented here:
\ >FLOAT
FLITERAL REPRESENT F** F. FACOS FACOSH
FALOG FASIN FASINH FATAN FATAN2
\ FATANH
FCOS FCOSH FE. FEXP FEXPM1 FLN FLNP1 FLOG FS.
\ FSIN
FSINCOS FSINH FSQRT FTAN FTANH
\ Revision
history:
\ 0: Initial
release 11/7/02 -- BNE
\ 1:
standard names converted to upper case;
\ "0 <=" changed to "0>
0=" -- 08.11.2002 -- mlg
: D2* 2DUP
D+ ;
: D2/
DUP 1 AND
IF
2/ SWAP 2/ $80000000 OR SWAP
ELSE
2/ SWAP 2/ $7fffFfff AND SWAP
THEN
;
: D2/
>R
1 RSHIFT
R@ 1 AND IF
Sign-Bit OR THEN
R> 2/ ;
: 'm3 ( -- addr )
-c/float 3 * 'rx ; \ -> 3rd stack mantissa ( ** was BUG
)
: FPICK ( n -- ) ( f: -- r )
1 fsp +! 2+ -c/float * 'rx m1get ; ( **
was BUG )
\ $20
CONSTANT bits/cell
0 1 >IN @
ROT 1+ ROT 2* ROT OVER [IF] DUP >IN ! [THEN] 2DROP CONSTANT bits/cell
: D2/ SWAP 1
RSHIFT OVER 1 AND [ bits/cell 1- ] LITERAL LSHIFT OR SWAP 2/ ;
\
*********************execution result************************
AMDX86
ciforth beta 2017apr7beta
"SFP"
INCLUDED
1/7 =
0.1428571428571428571428571428571428571
1/3 =
0.3333333333333333333333333333333333333
2/3 =
0.6666666666666666666666666666666666667
355/113 =
3.1415929203539823008849557522123893805
OK, abort at
\S point, no more loaded.
Go no to the next article -----
