\* The dynamics for the fhp2 gas subsystem is the same as that used on several other platforms. To ensure this equivalence, we load in lookup tables used on other platforms, and convert them for use here. We load three concatenated tables, each 4K long, into a combined buffer, and then create pointers to each of the three segments. The first table takes a 12-bit state and converts it into a base address pointing into another 4K table that has all the states listed with members of mass/momentum equivalence classes grouped together. The base address is the first location for the given equivalence class. The remaining 4K table converts 12-bit states into the length of the corresponding equivalence class. By encoding a state into a base address and adding a random number to it mod the length of the equivalence class, we get a new (updated) state. Here we will use equivalence class numbers instead of base addresses, since they will be shorter, and allow us to do two of the table lookups simultaneously (equiv number, and length) using a single 16-bit cell. We use the supplied tables to construct two new tables, one for converting base addresses into equiv-class numbers, and one for going back the other way. *\ 12 K create-buffer combined.tables "" luts/combined.lut combined.tables load-buffer : state>base.tab combined.tables 0 3 part ; : state>len.tab combined.tables 1 3 part ; : base+offs>state.tab combined.tables 2 3 part ; : entry@ (s n -- entry.n ) buffer swap wa+ w@ ; : entry! (s entry.n n -- ) buffer swap wa+ w! ; 4 K create-buffer base>equiv.tab 4 K create-buffer equiv>base.tab variable equiv# variable equiv-len : make-base>equiv 1 equiv# ! 4 K 0 do i state>base.tab entry@ dup base>equiv.tab entry@ 0= if equiv# @ swap entry! 1 equiv# +! else drop then loop ; make-base>equiv : make-equiv>base 4 K 0 do i base>equiv.tab entry@ dup 0<> if i swap equiv>base.tab entry! else drop then loop ; make-equiv>base \* Now with all these tables defined, its an easy matter to create CAM tables that will encode, randomize, and decode states. The only real work we need to do in these definitions is to add in the forcing information. We begin by encoding the state: this turns gas+force into eq#+index, except in 3 force cases (tracer source, tracer sink, and bounce-back) where it leaves things as gas+force: *\ create-lut encode-state.tab create-lut randomize-index.tab create-lut decode-state.tab 7 constant force-dir1 9 constant force-dir5 11 constant vert-wall 12 constant horz-wall 13 constant tracer-source 14 constant tracer-sink 15 constant bounce-back 18 constant max-len : gas>eq# gas state>base.tab entry@ base>equiv.tab entry@ -> eq# ; : len>index gas state>len.tab entry@ 1 max 1- -> index ; : force>index force force-dir1 - max-len + -> index ; : bounce-bwall p0 <-> p3 p1 <-> p4 p2 <-> p5 ; : bounce-vwall p0 <-> p3 p1 <-> p2 p4 <-> p5 ; : bounce-hwall p1 <-> p5 p2 <-> p4 ; : encode-state force force-dir1 < if gas>eq# len>index then force force-dir1 force-dir5 between if gas>eq# force>index then force bounce-back = if bounce-bwall then force vert-wall = if bounce-vwall then force horz-wall = if bounce-hwall then ; ?rule>table encode-state encode-state.tab \* The randomize step should only change "index" if its in the range that indicates that it is encoding an equivalence-class length. We should always churn the random bits while we have them available. *\ : randomize-index index max-len < if rand index 1+ mod -> index then rand negate -> rand ; ?rule>table randomize-index randomize-index.tab \* The decode step should change things if the state is encoded. It should force the direction of the gas particles if necessary, and it should calculate the gradient direction if no forcing is being done, and leave it in "force" for the tracer steps to use. We begin by defining what it means to force the particles as much as possible in a given direction, for different values of the total mass available. We write our routines as if we're trying to force direction 0, and we will adjust our arguments to the forcing functions to force other directions. *\ : force-mass0 (s dir -- mass.dir ) drop 0 ; : force-mass1 (s dir -- mass.dir ) 6 mod {{ 1 0 0 0 0 0 }} ; : force-mass2 (s dir -- mass.dir ) 6 mod {{ 2 0 0 0 0 0 }} ; : force-mass3 (s dir -- mass.dir ) 6 mod {{ 3 0 0 0 0 0 }} ; : force-mass4 (s dir -- mass.dir ) 6 mod {{ 2 1 0 0 0 1 }} ; : force-mass5 (s dir -- mass.dir ) 6 mod {{ 3 1 0 0 0 1 }} ; : force-mass6 (s dir -- mass.dir ) 6 mod {{ 2 2 0 0 0 2 }} ; : force-mass7 (s dir -- mass.dir ) 6 mod {{ 3 2 0 0 0 2 }} ; : force-mass8 (s dir -- mass.dir ) 6 mod {{ 2 3 0 0 0 3 }} ; : force-mass9 (s dir -- mass.dir ) 6 mod {{ 3 3 0 0 0 3 }} ; : force-mass10 (s dir -- mass.dir ) 6 mod {{ 2 3 1 0 1 3 }} ; : force-mass11 (s dir -- mass.dir ) 6 mod {{ 3 3 1 0 1 3 }} ; : force-mass12 (s dir -- mass.dir ) 6 mod {{ 2 3 2 0 2 3 }} ; : force-mass13 (s dir -- mass.dir ) 6 mod {{ 3 3 2 0 2 3 }} ; : force-mass14 (s dir -- mass.dir ) 6 mod {{ 2 3 3 0 3 3 }} ; : force-mass15 (s dir -- mass.dir ) 6 mod {{ 3 3 3 0 3 3 }} ; : force-mass16 (s dir -- mass.dir ) 6 mod {{ 2 3 3 2 3 3 }} ; : force-mass17 (s dir -- mass.dir ) 6 mod {{ 3 3 3 2 3 3 }} ; : force-mass18 (s dir -- mass.dir ) drop 3 ; : pn (s n -- value ) 6 mod {{ p0 p1 p2 p3 p4 p5 }} ; : fhp2-mass (s -- mass ) 0 6 0 do i pn + loop ; : force# (s -- dir ) force force-dir1 mod 2* 1+ ; : force-mass (s dir -- mass ) 6 force# - + fhp2-mass ( subtract force# to make dir act like 0 ) {{ force-mass0 force-mass1 force-mass2 force-mass3 force-mass4 force-mass5 force-mass6 force-mass7 force-mass8 force-mass9 force-mass10 force-mass11 force-mass12 force-mass13 force-mass14 force-mass15 force-mass16 force-mass17 force-mass18 }} ; : force-fhp2 6 0 do i force-mass i pn !! loop ; 0 constant grad0 5 constant grad5 6 constant tie 3 constant #force-directions : mom-n (s -- mom ) dup pn swap 3 + 6 mod pn - ; : mom-max (s -- mom ) 0 3 0 do i mom-n abs max loop ; : #max (s -- n ) 0 3 0 do i mom-n abs mom-max = if 1+ then loop ; : choose-dir (s -- dir# ) 6 0 do i mom-n mom-max = if i leave then loop ; : net-dir>force #max 1 = if choose-dir else tie then -> force ; : eq#>gas eq# equiv>base.tab entry@ index + base+offs>state.tab entry@ -> gas ; \* We need to be careful about which functions are evaluated on the encoded state, and which need to be partially decoded first. For example, we apply the forcing by reconstructing element 0 of the equivalence class, restoring the value of "force", and only then applying the "force-fhp2" rule. *\ : decode-state index max-len < if eq#>gas update net-dir>force else index max-len #force-directions + < if index 0 -> index update eq#>gas max-len - force-dir1 + -> force update force-fhp2 then then ; ?rule>table decode-state decode-state.tab \ STEPS ------------------------------------------------------------- \ direction numbering: \ \ 12 12 \ 0 3 (sheared) = 0 3 (unsheared) \ 54 54 \ define-step fhp2-step lut-data encode-state.tab switch-luts site-src lut lut-src site kick p0 field -1 x 0 y p1 field 0 x -1 y p2 field 1 x -1 y p3 field 1 x 0 y p4 field 0 x 1 y p5 field -1 x 1 y run lut-data randomize-index.tab switch-luts { rand index } assemble-fields kick r0 field 3 x -21 y r1 field 5 x -19 y r2 field 7 x -17 y r3 field 9 x -15 y r4 field 11 x -13 y r5 field 13 x -11 y r6 field 15 x -9 y r7 field 17 x -7 y r8 field 19 x -5 y r9 field 21 x -3 y r10 field 23 x -1 y run lut-data decode-state.tab switch-luts { eq# index } assemble-fields kick run end-step \ DISPLAY --------------------------------------------------------- \* For test purposes, we provide a colormap for seeing the density in four of the channels. To see all channels, you should use a display function, but this should be adequate for a density display. *\ : fmap p0 p1 p2 p3 + + + bright * 12 / >gray ; \ DEBUGGING --------------------------------------------------------- : fhp-case ( force p0 p1 p2 p3 p4 p5 -- ) 0 -> cell -> p5 -> p4 -> p3 -> p2 -> p1 -> p0 -> force update ; : apply-table cell entry@ -> cell update ; : check-encode (s force p0 p1 p2 p3 p4 p5 -- ) fhp-case encode-state.tab apply-table 1 force field #bits/field << 0 ?do i -> force update cell cell entry@ -> cell update ." Equiv# " eq# . ." Length " index . cr -> cell update loop ; : check-decode (s equiv# len -- ) decode-state.tab 0 -> cell swap -> eq# 0 ?do i -> index update cell dup entry@ -> cell update p0 . p1 . p2 . p3 . p4 . p5 . cr -> cell update loop ; : check-case (s force p0 p1 p2 p3 p4 p5 -- ) fhp-case encode-state.tab apply-table ." Encodes to " eq# . ." with length " index (.) type ." . Possible results:" cr decode-state.tab force force-dir1 < if index 0 ?do i -> index update cell dup entry@ -> cell update force .h ." ; " p0 . p1 . p2 . p3 . p4 . p5 . cr -> cell update loop cr else apply-table force .h ." ; " p0 . p1 . p2 . p3 . p4 . p5 . cr then ;