2024年8月29日 星期四

一百個例題 (25 ~ 29)


Ching-Tang Tseng
Hamilton, New Zealand
30 August 2024

第(25)個範例程式是一套很好用的位元顯示發展工具。

這個範例又分成三個套件,第一個是正向的顯示方式,第二個是反向的顯示方式,第三個則是大數目字的方陣顯示方式。

發展數學計算系統的最艱難處,不在設計出單純的四則運算能力,反而是在所有數字的輸出/輸入處理設計上。我在發展系統之初與發展過程中,一直為此類問題所困擾,所以才會自行開發出這些工具來協助自己仔細認知所有數字的位元花樣,以便在追蹤輸入轉換與輸出處理的程式時,了解程式是如何被設計出來的。

您如果也想研究浮點系統,不碰這些東西,就難以進行研究,碰過之後,也才會發現,今人都已無能力搞二進制的輸入轉換了,只會做十進制的輸出顯示程式設計。因為輸入轉換工作都已交給硬體數學處理器(coprocessor)以組合語言命令來執行,很難再見到高階設計而成的公益程式了。

這些工具的用法,程式中的註解,足夠說明了,請自行閱讀或試用,程式中的位元底尺,是我的創作,利於觀測。

後來,發現網上資料都用反向的顯示法表示數字的位元花樣,我就再下功夫,把反向的顯示方式也設計出來。

再後來,我又面對了大數目字的計算問題,也設計出了大數計算系統。這種數字的位元花樣與輸出顯示就不得不研究了。因此,又搞出了方陣式的顯示格式。這些東西,全都是我自己獨立完成的創作。

程式中,留存有不少我曾實際執行出來的結果,如果您有疑問,就請自行查找網上維基百科類的網頁訊息,比對一下。由於此類網頁刊登的內容,常會遭人改寫蓋壓,我指出固定網頁來介紹也沒有用,還是請靠自己搜索出有意義的網頁來參考比較實際。

2024 年的今天,我們從 XP 一直發展到了 W10 , Win32Forth 系統已經被廣泛採用過了 30 幾年,還能使用,非常難能可貴。我從 2012 年起,轉用 Lina64 發展系統時,這些東西都還要用到,但發展時所需的材料,已全跟 Win32Forth 系統無關了。可見,不只是留存住系統的源程式很有必要,它的發展工具與所有的範例也都很重要,我要拿它們來用,也要拿它們來測試。這個範例的留參價值就在這裡。
:

 
\ (25-1)正向之位元顯示器.f
\ 20140427

: 32cRuler ( -- )
CR ." =========1=========2=========3=="
CR ." 12345678901234567890123456789012"
CR ." ==== LSB --> MSB ==============="
CR
;

: 50cRuler ( -- )
CR ." =========1=========2=========3=========4=========5"
CR ." 12345678901234567890123456789012345678901234567890"
CR ." ========(c) 2014 Copyright, Counting Ruler========"
CR
;

: 64cRuler ( -- )
CR ." |========1=========2=========3=========4=========5==||======6==|"
CR ." 1234567890123456789012345678901234567890123456789012345678901234"
CR ." |=== LSB --> MSB ===================================||=========|"
CR
;

: 80cCounterRuler ( -- )
CR ." =========1=========2=========3=========4=========5=========6=========7=========8"
CR ." 12345678901234567890123456789012345678901234567890123456789012345678901234567890"
CR ." 09876543210987654321098765432109876543210987654321098765432109876543210987654321"
CR ." 8=========7=========6=========5=========4=========3=========2=========1========="
CR
; 

: 32BitsDump ( un -- )
  1 32
  DO
     0 2 UM/MOD SWAP
     IF 1 0 .R ELSE 0 0 .R THEN
     -1
  +LOOP
  DROP
;

VARIABLE iTTT
$FFFFffff iTTT !

: TEST32 ( -- )
  iTTT @ CR 32BitsDump 32cRuler
;

\ : unBinaryDump ( un -- )
: unBDump
  cr 32BitsDump 32cRuler
;

\ : dBinaryDump ( ud -- )
: udBDump
  cr SWAP 32BitsDump 32BitsDump 64cRuler
;

\ : fpBinaryDump ( f -- )
: fpBDump
  cr PAD F! PAD @ 32BitsDump PAD cell + @ 32BitsDump 64cRuler
;

FVARIABLE fTTT
1.625E0 fTTT F!

: addrBinaryDump ( addr -- )
  cr DUP @ 32BitsDump CELL + @ 32BitsDump
;

: TEST64 ( -- )
  fTTT CR addrBinaryDump 64cRuler
;

cr cr
.( Usage: ) cr
.( TEST32 TEST64 ) cr
.( unBDump udBDump fpBDump 32BitsDump addrBinaryDump ) cr

\s

: 32cCounterRuler ( -- )
CR ." S=3=====|S==2=========1========="
CR ." 21098765432109876543210987654321"
CR ." 01234567890123456789012345678901"
CR ." S=======|S1=========2=========3="
CR
;

: 64cCounterRuler ( -- )
CR ." S===6======|S=5=========4=========3=========2=========1========="
CR ." 4321098765432109876543210987654321098765432109876543210987654321"
CR ." 1234567890123456789012345678901234567890123456789012345678901234"
CR ." S========1=|S======2=========3=========4=========5=========6===="
CR
;

1.625E3 fTTT F!  ok
test64 
0000000000000000000000000000000000000000001001101001100100000010
=========1=========2=========3=========4=========5=========6====
1234567890123456789012345678901234567890123456789012345678901234
LSB --> MSB =======================================S|==========S
 ok
1.625e3 fs. 1.62500E3  ok
1.625e3 f. 1625.00  ok
binary  ok
11001011001 decimal . 1625  ok

\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

\ (25-2)反向之位元顯示器.f
\ 20140511

1 CHARS CONSTANT /char  ( -- n )  \ Length of a character

: cappend  ( c s -- )  \ Add c to the counted string s
  1 OVER c+! COUNT 1- CHARS + C! ;

: cexchange  ( ca1 ca2 -- )  \ Swap characters of ca1 and ca2
  2DUP 2>R  C@ SWAP C@  R> C!  R> C! ;

: squeeze  ( a1 a2 n -- a1+n a2-n )  \ Add/subtract n to/from a1/a2
  TUCK - >R + R> ;

: turn  ( ca u -- )  \ Reverse string ca u
  1- CHARS  OVER +  ( start-addr end-addr )
  BEGIN  2DUP U< WHILE  2DUP cexchange /char squeeze REPEAT 2DROP ;

: 32cRuler ( -- )
CR ." ==3=========2=========1========="
CR ." 21098765432109876543210987654321"
CR ." ==== MSB <-- LSB ==============="
CR
;

: 50cRuler ( -- )
CR ." =========1=========2=========3=========4=========5"
CR ." 12345678901234567890123456789012345678901234567890"
CR ." ========(c) 2014 Copyright, Counting Ruler========"
CR
;

: 64cRuler ( -- )
CR ." S|==6======||=5=========4=========3=========2=========1========|"
CR ." 4321098765432109876543210987654321098765432109876543210987654321"
CR ." $===$===$===$===$===$===$===$===$===$= MSB <-- LSB =$===$===$==="
CR
;

: 96cRuler ( -- )
CR ."                 8|========7====||===6=====||==5=========4=========3=========2=========1========|"
CR ." 654321098765432109876543210987654321098765432109876543210987654321098765432109876543210987654321"
CR ." $===$===$===$===S===$===$===$===$===$===$===$===$===$===$===$===$===$= MSB <-- LSB =$===$===$==="
CR
;

: 96<>Ruler ( -- )
CR ." =========1=========2=========3=========4=========5=========6=========7=========8=========9======"
CR ." 123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456"
CR ." 654321098765432109876543210987654321098765432109876543210987654321098765432109876543210987654321"
CR ." ======9=========8=========7=========6=========5=========4=========3=========2=========1========="
CR
;

CREATE BitBUF 128 allot

: 32BitsDump ( un -- )
  BitBUF 84 0 FILL
  1 32
  DO
     0 2 UM/MOD SWAP
     IF 49 BitBUF cappend ELSE 48 BitBUF cappend THEN
     -1
  +LOOP
  DROP
  BitBUF COUNT TURN
  BitBUF COUNT TYPE
;

\ unBinaryDump
: unBDump  ( un -- )
  cr 32BitsDump 32cRuler
;

\ udBinaryDump
: udBDump  ( ud -- )
  cr 32BitsDump 32BitsDump 64cRuler
;

CREATE fpPAD  B/FLOAT ALLOT

\ fpBinaryDump
: fpBDump   ( f -- )
  cr fpPAD F! fpPAD cell + @ 32BitsDump fpPAD @ 32BitsDump 64cRuler
;

((
: fpBDump   ( f -- )
  cr f>r 2r> swap 32BitsDump 32BitsDump 64cRuler
;
Warning(-4104): F>R is a *** deprecated *** word (see src\compat\evolve.f) 
: F>R           R> RP@ B/FLOAT - RP! RP@ F! >R ;  
))

VARIABLE iTTT
$FFFFffff iTTT !

: TEST32 ( -- )
  iTTT @ CR 32BitsDump 32cRuler
;

: addrBinaryDump ( addr -- )
  cr DUP CELL + @ 32BitsDump @ 32BitsDump
;

\ 以上均為:於 8 B/FLOAT 時使用
: TEST64 ( -- )
  sigdigits @
  20 sigdigits !
  $7fefFFFF fpPAD CELL + ! $ffffFFFF fpPad !
  fpPAD CR addrBinaryDump 64cRuler
  cr ." Maximum positive floating point number: " fpPAD f@ fs. cr
  0 fpPAD cell + ! 1 fpPAD !
  fpPAD cr addrBinaryDump 64cRuler
  cr ." Minimum positive floating point number: " fpPAD f@ fs. cr
  sigdigits !
;

\ 於 10 B/FLOAT 時使用
: TEST80 ( -- )
  sigdigits @
  20 sigdigits !
  $7ffe fpPAD 2 CELLs + W! $ffffFFFF fpPad cell + ! $ffffFFFF fppad !
  cr fpPAD 2 cells + W@ 32Bitsdump fpPad cell + @ 32bitsdump fppad @ 32bitsdump 96cRuler
  cr ." Maximum positive floating point number: " fpPAD f@ fs. cr
  0 fpPAD 2 cells + W! 0 fpPad cell + ! 1 fpPAD !
  cr fpPAD 2 cells + W@ 32Bitsdump fpPad cell + @ 32bitsdump fppad @ 32bitsdump 96cRuler
  cr ." Minimum positive floating point number: " fpPAD f@ fs. cr
  sigdigits !
;

cr cr
.( Usage: ) cr
.( TEST32 TEST64 TEST80) cr
.( unBDump udBDump fpBDump 32BitsDump addrBinaryDump ) cr

\S

test64 
0111111111101111111111111111111111111111111111111111111111111111
S|==6======||=5=========4=========3=========2=========1========|
4321098765432109876543210987654321098765432109876543210987654321
$===$===$===$===$===$===$===$===$===$= MSB <-- LSB =$===$===$===

Maximum positive floating point number: 1.7976931348623148800E308 


0000000000000000000000000000000000000000000000000000000000000001
S|==6======||=5=========4=========3=========2=========1========|
4321098765432109876543210987654321098765432109876543210987654321
$===$===$===$===$===$===$===$===$===$= MSB <-- LSB =$===$===$===

Minimum positive floating point number: 4.9406564584124691200E-324

t41 
Minnimum subnormal positive double floating point number
for 8 B/FLOAT 64 bits IEEE 754 = 

4.940656458412465441765687928682213723650598026143
24764425585682500675507270208751865299836361635992
379796564656 
X10^ -324 

與系統印出數字比較如下:
最後三位數不準,因此,18位數只有15位數準確。20140519
4.9406564584124691200E-32


test80
000000000000000001111111111111101111111111111111111111111111111111111111111111111111111111111111
                8|========7====||===6=====||==5=========4=========3=========2=========1========|
654321098765432109876543210987654321098765432109876543210987654321098765432109876543210987654321
$===$===$===$===S===$===$===$===$===$===$===$===$===$===$===$===$===$= MSB <-- LSB =$===$===$===

Maximum positive floating point number: 1.1897314953572317700E4932 

000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001
                8|========7====||===6=====||==5=========4=========3=========2=========1========|
654321098765432109876543210987654321098765432109876543210987654321098765432109876543210987654321
$===$===$===$===S===$===$===$===$===$===$===$===$===$===$===$===$===$= MSB <-- LSB =$===$===$===

Minimum positive floating point number: 3.6451995318824745900E-4951

\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\

\ (25-3)大型大數字顯示器.f ,可以顯示多於 256 位數的數字
\ 20140420

\ (1)起始設定最大容量為 40 cells ,最大顯示位數不會超過400位數
\ (2)起始設定值放在 TestValue
\ (3)顯示前,數值經由 >XRegister 搬到 XRegister
\ (4)顯示後 XRegister 的內容會被計算至 0
\ (5)被顯示的數字字串,放置在系統規劃指定的PAD1緩衝區內
\ (6)轉換出來的數字字串,顯示秩序原為顛倒,故需倒轉後才印出來
\ (7)延伸的應用為 TestValue 可以為任何數字,經 >XRegister 指令移入 XRegister
\ (8)固定執行指令 UX. 顯示數字。

40 VALUE NN

CREATE TestValue
\ $FFFFFFFF , 0 , 0 , 0 , 0 ,
$ffffffff , $ffffffff , $ffffffff , $ffffffff , $ffffffff ,
0 , 0 , 0 , 0 , 0 ,
0 , 0 , 0 , 0 , 0 ,
0 , 0 , 0 , 0 , 0 ,
0 , 0 , 0 , 0 , 0 ,
0 , 0 , 0 , 0 , 0 ,
0 , 0 , 0 , 0 , 0 ,
0 , 0 , 0 , 0 , $f ,

CREATE XRegister NN Cells allot

1 CHARS CONSTANT /char  ( -- n )  \ Length of a character

\ 改用cBigAppend及BigCount在PAD1區處理字串,其餘所用指令與一般大數顯示程式相同
\ : cAppend  ( c s -- )  \ Add c to the counted string s
\   1 OVER c+! COUNT 1- CHARS + C! ;

: cExchange  ( ca1 ca2 -- )  \ Swap characters of ca1 and ca2
   2DUP 2>R  C@ SWAP C@  R> C!  R> C! ;

: squeeze  ( a1 a2 n -- a1+n a2-n )  \ Add/subtract n to/from a1/a2  
   TUCK - >R + R> ;

: turn  ( ca u -- )  \ Reverse string ca u
   1- CHARS  OVER +  ( start-addr end-addr )
   BEGIN  2DUP U< WHILE  2DUP cexchange /char squeeze REPEAT 2DROP ;

: X/MODS ( n -- c )         \ ( n=Divisor=base@ -- c=RemainderChar )
  0                         \ n:Divisor=base@ 0:r=remainder
  0  NN 1-
  DO                        \ n r
     XREGISTER I CELLS + @  \ n r q
     SWAP                   \ = $100000000 r UM* q M+ ( n lq hr )
     rot dup >r -rot r>     \ n lq hr n
     UM/MOD                 \ n r q           ( ud u -- u' u" )
     XREGISTER I CELLS + !  \ n r
     -1
  +LOOP                     \ n r
  NIP                       \ r
  9 OVER <
  IF 7 + THEN
  48 +                      \ r --> c
;

: ZeroCheck  ( -- f )
  -1
  0 NN 1-
  DO
  XRegister I cells + @ 0= AND
  -1 +LOOP
;

: (UX.) ( -- addr count )    ( addr:PAD1addr count:length )
  PAD1 1024 0 FILL
  BEGIN
  BASE @ X/MODS PAD1 cBigAppend
  ZeroCheck
  UNTIL
  PAD1 BigCount
  2DUP TURN
;

: >XRegister ( addr -- )
  XRegister NN cells MOVE ;

: UX. ( -- )
  (UX.) BigType ;

: MAIN ( -- )
  TestValue >XRegister
  CR UX.
  TypeCountingRuler
;

cr cr
.( Usage : main ) cr

\s
72698566559686319077796584419189618471650841510389   :50 
26657279333344476955053168367802639659104216138961   :100 
38203908732692781448693729442194346215678838077397   :150 
82990628789152317139462189095909821299721140924092   :200 
06005527971693100647871067150635851431673698774742   :250 
70692250131011998411623056863545598788156045965681   :300 
70016494590478505523789394870247171196184946947116   :350 
842844713173773541038882815
=========1=========2=========3=========4=========5
12345678901234567890123456789012345678901234567890
========(c) 2014 Copyright, Counting Ruler========
 ok

第(26)個範例程式很簡單,只展示數基(Base)的定義方式與名稱。

資料來源,程式中有,我們引用別人的創作時,不要佔為己有,能用,才有意義。

我買的書,絕不丟棄,因為有用才買,一輩子就好好的使用。我也不亂買書,這本書,是在台灣實施版權制度以前,就由中央圖書公司盜版發行了,我躬逢其盛,廉價購得後享用終生。我手頭上有許多 FORTH 方面的盜版書籍,買時絕對合法,一直用到今天,照樣經常參考,貼文用到時,就會回顧。

此前有一段時間,我全面改用英文貼文,我的個人網頁的讀者統計,來自台灣的數字立刻大跌,國際讀者反而大增。實際上,英國早就有管制瀏覽權的網頁,把我所有的貼文都譯成英文重新收集,他們在 comp.lang.forth 國際論壇網頁上,公佈過這個訊息。他們認識我,我若去拜訪,肯定不讓我進入,所以,我也不會去自討沒趣,只能任由它去。我改貼英文時,英文雖不好,他們也照樣收集,寫得離譜處,他們可能也看不懂,這就很有趣了。十幾年前,用文言文說:『德不孤,必有鄰』,自動翻譯會譯成:『德國人不孤獨,他一定有很多鄰居』,看得我不亦樂乎。

以前,丁陳老師有一次也對臺灣貼了篇英文訊息,當天就被人翻譯得體無完膚,次日,丁陳老師乾脆重新補貼中文。這個實例,豈不跟我貼文的遭遇完全相同 ? 所以,這第(26)個範例還是很有意義的,值得保留,我才刻意留下來。

有個使用例子,就是我在英文貼文中,要用英文表示十二進制時,只好回頭看這個程式,裡面就有。有些英文字雖不常用,實際上都存在,例如:我們知道,習慣上,大家都只用百、千、百萬來講數字,不用萬,但是,英文確實有一個來自希臘的用語,對應到萬的單字: myriad 。

最近網上的 OpenAI 大流行幾年之後,譯文離譜的事情已經少了很多。但我回顧自己已貼出十幾年的網文時,發現網頁貼文的顯示方式全都出了問題,已經不能再強調美觀了。有些網文的內容若與網頁標記語言(HTML) 用語衝突時,內容就亂了。並不是只有我貼出的網文才被如此處裡,網上的技術貼文數量龐大,許多熱心公益的作者也已過世,在無人重新整理的情況下,這種網文就只剩文字內容還在,其它免談。有鑒於此,我在停止貼文十二年之後重新開始貼文。舊貼文則抽空整理。由此看來,將來出版技術書籍還是有價值的,因為網頁不具備保存技術文獻的能力,技術要想徹底全面留得下來,靠書比較可靠,至少寫成 .pdf 格式的檔案書籍,也比單靠網頁貼文要好。另外,我也年近80了,貼文就考慮採用柔和的綠色襯底,選用大字,只考慮給使用電腦的讀者比較容易參考。

這一個範例雖然簡單,不違背我的貼文原則,仍然循序貼出,一百個範例,繼續進行。
:

 
\ (26)數基名稱.f
\ 20140501 Name of Various Number Bases
\ Leo J. Scanlon, FORTH PROGRAMMING, Howard W. Sams & Co., Inc. 1982, p.157

DECIMAL

\ : Binary 2 base ! ;
: Ternary 3 base ! ;
: Quatenary 4 base ! ;
: Quinary 5 base ! ;
: Senary 6 base ! ;
: Septenary 7 base ! ;
: Octonary 8 base ! ;  \ : Octal 8 base ! ;
: Novenary 9 base ! ;
\ : Decimal 10 base ! ;
: Undecimal 11 base ! ;
: Duodecimal 12 base ! ;
: Terdenary 13 base ! ;
: Quaterdenary 14 base ! ;
: Quindenary 15 base ! ;
: Hexadecimal 16 base ! ; : Sexadecimal base ! ;
: Septendecimal 17 base ! ;
: Octodenary 18 base ! ;
: Novemdenary 19 base ! ;
: Vicenary 20 base ! ;
: Duosexadecimal 32 base ! ; : Duotricinary 32 base ! ;
: Sexagenary 60 base ! ;

第(27)個範例,探討使用系統內記憶體時將位址對準的程式設計方法。

早在 APPLE II 的時代,因 6502 CPU 執行存取數據的指令時,若不考慮分頁邊界問題而直接存取數據,可能就會出錯。那時,我們就能體會到程式設計必須先將記憶體位址值對準之後才執行存取指令的意義,這樣才能確保存取的數據不出問題。

許多硬體 CPU 都有同樣的問題,因此,一套所謂的 ALIGN 指令便應運而生。目前,幾乎所有的現代 Forth 系統都有這種相關指令。 ALIGN ( — )會將系統現行使用上限 HERE 之值自動對準, ALINED ( a1 —- a2 ) 則會以指定的位址 a1 換算出對準後的新位址 a2 來。

這篇範例參考了國際論壇上曾經有過的討論,我把別人提出來的做法,全部寫成程式,進行測試。程式後面列有註解,告訴您那幾個設計是錯誤的,那幾個才是正確的。最佳的解答,則記錄在程式的最後面,供您參考。但是,這都還不夠完整,仍有延伸性的問題可以探討。您也可以將這些程式反組譯出來後,見到系統執行組合語言時之機器碼,想把 Forth 系統的軟硬體問題都搞清楚者,必須懂得這些組合語言,才能有所作為。

如果您夠勤快,探討這個對準範例程式時,就會主動繼續思考,這些對準程式是不是夠用了?我在程式中指出, VFX Forth 系統執行對準動作後,另外還執行把因對準而跳過的記憶體之內容填 0 ,這很斤斤計較,但理念正確,不留後患。這些系統的設計者,考慮周全。我卻覺得他們就事論事的精神還不夠完美,因為 Forth 系統內,恆有必須宣告出資料結構來使用的需求,如果考慮了填 0 的問題,那麼,為什麼不也考慮把宣告資料結構的指令也強行先搞對準?例如:執行 PAD 指令時,就應該也搞對準。

除此之外,請小心使用系統中現成的對準指令,這些設計通則能夠受用的大前題,是專對系統記憶體位址之值而設計的,他們都有共同的使用限制,也就是只對偶數值有效,但未必適用於古怪的奇數值。例如:有一天您想要處理圍棋的棋盤座標量 19x19 ,且需用到以 19 為準的對準程式時,請先試過針對 19 的對準運算,看看能否得到正確的結果,然後才用。如果不行,您知道該如何自行設計出對任何數值均有效的對準程式了嗎?這個問題就留給大家自己練習。

我在這裡貼出的訊息,有許多地方,都顯示出就算國際論壇上的討論也罕有人能論及的問題。我並不想去點醒全世界,我也知道世界上還有比我更高明的好手,能把問題談得比我更深入與更廣泛。
:

 
\ (27)可令記憶體自動對準之指令.f
\ 20140501

: align1 ( n -- n' )   DUP 4 MOD ?DUP IF 4 SWAP - THEN + ; \ 4 錯,還令堆疊不定

: align2 ( n -- n' )   1- 3 OR 1+ ;                \ ok

: align3 ( n -- n' )   NEGATE -4 AND NEGATE ;      \ ok

: align4 ( c-addr -- a-addr ) 3 + -4 and ;         \ ok佳

: Align5         \ addr -- addr' ;                 \ 0 錯
    %0011 and    \ clear 2 lsbs
    %0100 +      \ next quad
;

: Align6       \ addr -- addr' ;                   \ 0 錯
    $03 +      \ force to next quad unless on boundary
    %011 and   \ clear 2 lsbs
;

\ : ALIGNED+      ( a -- n)       1- 1 cells 1- tuck and - ;

: aALIGNED+      ( a -- n)       1- 3 tuck and - ;
: aALIGNED       ( a -- a)       dup aaligned+ + ;

\ 對準技術問題的最佳方法就是:
\ 先將現行數目加上一數,令其進入下一群數目的範圍,對 cell=4 者而言為加上 cell-1=3。
\ 然後執行一次與等於負的對準量之 AND 運算,對 cell=4 者而言為與 -4 AND。
\ 於是就能得到合理的結果,以純 Forth 的表達方式寫成的程式形如下式:

: align7 ( a -- a' ) [ cell 1- ] literal + [ cell negate ] literal and ;  \ ok

0 value tt

: test ( n -- )
to tt
cr  ." test value = " tt .
cr  ." align1 = " tt align1 .   \ XXX
cr  ." align2 = " tt align2 .
cr  ." align3 = " tt align3 .
cr  ." align4 = " tt align4 .
cr  ." align5 = " tt align5 .   \ XXX
cr  ." align6 = " tt align6 .   \ XXX
cr  ." align7 = " tt align7 .
cr  ." aligned  = " tt aaligned .
;

\ 當系統進入 64 位元後,勢必再有必須與 8 對準之要求,根據上述設計推導如下

: align8 ( a -- a' )
  7  + -8  and  ;

第(28)個範例,介紹可用各種高階定義的方式,設計出 ROT 指令的程式。

這個 ROT 堆疊操作指令,涉及到對堆疊上三個單元進行操作的工作,比較特殊,我收集與添加了總共十種方法,展示於程式。

方法依次顯示,完全不用另外宣告出變數、宣告一個、兩個、三個變數後的使用效果,都能完成任務。但實際上,系統現成的 ROT 指令,是用低階組合語言調整堆疊指標來設計產生的。此範例僅供參考,用來展示在指令不完整的 Forth 環境中,可以用什麼方法快速解決指令欠缺的問題?這種問題我經常會碰到,用了幾十年的筆記本就專門記錄這些使用技巧。

根據我個人的經驗,除非您要設計更高級的系統,否則很少用到 ROT 指令。另有兩個涉及可操作堆疊上更多單元的指令: ROLL 及 PICK ,更為罕用,此範例中用了一次ROLL 。

我為什麼要收集這些範例?因為我長期從事於數學體系的設計工作,免不了必須接觸各種不同資料結構的數字,當它們被放在堆疊上時,一定會有必須執行堆疊操作指令的需求。例如:浮點數,每個都至少要佔用到兩個或三個堆疊單元,來代表浮點數字,能夠執行堆疊上的 FROT 的指令,就得自己設計。

曾有人嘗試發展出單用高階方式,設計出所有堆疊操作指令的技術,其中使用了系統變數、系統指標、暫存於回返堆疊、簡單邏輯.....等等等的運用技巧。我沒有將筆記本內這麼多的材料放進範例。如果您有興趣,也可以自己想一想,還有什麼創意能與眾不同?

另外,您也可以想一想,體會一下程式設計時,若要少用堆疊操作指令,又不想多宣告出變數來用,那麼,程式執行時產生的中間過度數值,您可以放在系統的什麼地方?我就常有這種想法,它能促進自己更加了解系統的結構。
:

 
\ (28)各種ROT設計範例.f
\ 20140501

: ROT1 >r swap r> swap ;

: ROT2 2 ROLL ;
: ROT3 TUCK 2SWAP DROP ;
: ROT4 over swap 2SWAP DROP ;        \ NUP = over swap
: ROT5 >R SWAP >R 2R> ;
: ROT6 >R 2>R R> 2R> ;

\ E.g., ROT using one register A:
variable A
: ROT7 >R >R A ! R> R> A @ ;
: ROT8 A ! SWAP A @ SWAP ;

\ E.g., ROT using two registers A and B:
variable B
: ROT9 A ! B ! >R B @ A @ R> ;

3 values t1 t2 t3
1 to t1  2 to t2  3 to t3

: .3t . . . ;
: @3t t3 t2 t1 ;
: pre cr @3t .3t @3t ;
: aft ." ==> " .3t ;

: main ( -- )
  pre rot1 aft
  cr @3t .3t @3t  rot2 ." ==> " .3t
  cr @3t .3t @3t  rot3 ." ==> " .3t
  cr @3t .3t @3t  rot4 ." ==> " .3t
  cr @3t .3t @3t  rot5 ." ==> " .3t
  cr @3t .3t @3t  rot6 ." ==> " .3t
  cr @3t .3t @3t  rot7 ." ==> " .3t
  cr @3t .3t @3t  rot8 ." ==> " .3t
  cr @3t .3t @3t  rot1 ." ==> " .3t
;

第(29)個範例,是以實際程式算出數據,查證多項式該有的程式寫法。顯示出程式寫法不同時,確實會影響算出數值的精確度。

所有數值分析課本的第一章,都會言及此事。我有好幾本數值分析書籍,本本如此,但都只是解說用了幾個乘法、用了幾個加法的運算量不同之影響,書本無法提供大家實測數據。

我在設計這個程式時,熟知現在的系統能藉著運用 coprocessor 算出精準結果之性能後,便決定以實際程式驗證此事。

程式內列有測試結果,您可以看到只有五項的多項式,經過這樣的測試,從第 12 位數開始就不一樣了。

所以,多項式的程式寫法,確實很重要,設計程式時,不要隨便亂寫,亂寫就會影響科技報告內所用分析數據的品質,別人看了定會發現數據處裡效果很差。

請注意本範例中有正向與反向之兩套 BASIC 式程式寫法。以多項式表示的很多場合,都有正寫或反寫的情況,都是為了考慮解釋問題的方便性,才這樣列出他們認為比較適當的數學式子。正寫與反寫的方式,都是一定會碰得到的情況,這個程式就能被用得上。

另外,我初次設計系統時,仍採用 Charles H. Moore 原創設計時的陣列與矩陣之資料結構,他為了節省記憶體,就把宣告時的指標少留一個,而且,也不讓指標可以從 0 開示。以前,記憶體很寶貴,能省則省。今天,已不是這樣,所以,我後來改寫出來的系統,除了全能從 0 開始作為指標外,資料結構中也全數保留宣告維度時的數字量。這個決定,有利於後來發展出只須一個印出指令,便能印出不同維度矩陣或陣列的內容,就只是因為留下了所有宣告維度時的數字量,才能設計得出這種統一格式的印出指令。這些事情,使用者看不出來,用了才會知道,但是,這些都是系統設計上的哲理,此處特別提出來探討隱含於其中的意義。

若有人用過 Matlab ,可以去試一試,我知道,以前的版本是不能用 0 作為指標的。有很多場合,不能用 0 當作指標會很不方便,所以,我設計系統時,寧可讓系統多耗一點記憶體用量,使用者也可以不用 0 當作指標,要用,也能用,這樣的系統才是合理的設計。
:

 
\ (29)標準之多項式計算程式 2012-09-20
\ Polynomial equation
\ P(N)=A(0)+A(1)*X^1+A(2)*X^2+......+A(N)*X^N

3 INTEGERS I N N-1
2 REALS X P
10 ARRAY A

: SETUP-POLYNOMIAL-COEFFICIENTS 
BASIC
10 REM (1)The degree of polynomial is N.
20 LET N = 4
30 REM (2)Set all coefficients in A(N) to be 0. N=0,1,2...n
40 FOR I = 0 TO N
50 LET { A ( I ) = 0 }
60 NEXT I
70 REM (3)Put all coefficients into A(N).
80 LET { A ( 0 ) = -5 }
    :: { A ( 1 ) =  2 }
    :: { A ( 2 ) = -1 }
    :: { A ( 3 ) =  2 }
    :: { A ( 4 ) =  3 }
90 END ;

: EVALUATING-POLYNOMIAL 
BASIC
10 REM
20 REM Typical program
30 REM
40 LET { P = A ( N ) }
50 FOR I = 0 TO N - 1
60 LET N-1 = N - I - 1
70 LET { P = P * X + A ( N-1 ) }
80 NEXT I
90 END ;

: POOREVAL ( x -- p )
  {{ X }} F!
  {{ P = 3 * X ^ 4 + 2 * X ^ 3 - X ^ 2 + 2 * X - 5 }}
  P ;

: SOSOEVAL ( x -- p )
  {[ X }} F!
  {{ P = 3 * X * X * X * X + 2 * X * X * X - X * X + 2 * X - 5 }}
  P ;

: GOODEVAL ( x -- p )
  {{ X }} F!
  SETUP-POLYNOMIAL-COEFFICIENTS
  EVALUATING-POLYNOMIAL
  P ;

: main1
  sigdigits @ >r
  18 sigdigits ! cr cr
  ." POOREVAL P(pi)^4 = " fpi pooreval pooreval pooreval pooreval fs. cr cr
  ." SOSOEVAL P(pi)^4 = " fpi sosoeval sosoeval sosoeval sosoeval fs. cr cr
  ." GOODEVAL P(pi)^4 = " fpi goodeval goodeval goodeval goodeval fs. cr cr
  r> sigdigits ! ;

main1

\ 多項式係數指標以反向表示時的計算程式
\ F(X)=A(0)*X^N+A(1)*X^(N-1)+........+A(N-1)*X^1+A(N)
\ 自動控制教科書中所使用的實際範例
\ Test for F(X)=X^4+15*X^3+270*X^2+1600*X+2000

: INIT1    BASIC
10 LET N = 4
20 LET { A ( 0 ) = 1 }
30 LET { A ( 1 ) = 15 }
40 LET { A ( 2 ) = 270 }
50 LET { A ( 3 ) = 1600 }
60 LET { A ( 4 ) = 2000 }
70 END ;

COMPLEX F(X)   COMPLEX (X)   REAL ABSF(X)

10 [ARRAY] ZA                           \ 將實數係數陣列轉換成複數係數陣列
 3 INTEGERS II JJ NN                    \ 指標有不得再重覆使用於上列中者之困擾

: ZINIT BASIC
10 LET NN = N                            \ 方次與實數係數在算完之後均未變
20 FOR JJ = 0 TO NN                      \ 指標有不得再重覆使用於上列中者之困擾
30 LET [ ZA ( JJ ) = R>ZR ( A ( JJ ) ) ]
40 NEXT JJ
50 END ;

: FUNCTION(X) BASIC
10 RUN ZINIT
20 LET [ (X) = ( -3.5 - 2.4 i ) ]
30 LET [ F(X) = ZA ( 0 ) ]
40 FOR II = 1 TO NN                      \ 指標有不得再重覆使用於上列中者之困擾
50 LET [ F(X) = F(X) * (X) + ZA ( II ) ]
60 NEXT II
70 LET { ABSF(X) = ZABS ( F(X) ) }
80 END ;

\ 印出結果
: MAIN2  BASIC
10 FOR I = 1 TO N
20 RUN FUNCTION(X)
30 PRINT " F(X( " ; I ; " )) = " ; [ F(X) ]
40 PRINT " ABS(F(X( " ; I ; " )))=" ; { ABSF(X) }
50 PRINT "     "
60 NEXT I
70 END ;

MAIN2

\S

POOREVAL P(pi)^4 = 3.20575403126800320E172 

SOSOEVAL P(pi)^4 = 3.20575403126795584E172 

GOODEVAL P(pi)^4 = 3.20575403126795584E172

F(X( 1 )) =              1225.31950000 -  1260.67200000 i   
ABS(F(X( 1 )))=       1758.03918291  
    
F(X( 2 )) =              1225.31950000 -  1260.67200000 i   
ABS(F(X( 2 )))=       1758.03918291  
    
F(X( 3 )) =              1225.31950000 -  1260.67200000 i   
ABS(F(X( 3 )))=       1758.03918291  
    
F(X( 4 )) =              1225.31950000 -  1260.67200000 i   
ABS(F(X( 4 )))=       1758.03918291  
     ok

沒有留言: