I wonder if I doing this to save time ?
Anyway - here is some revisions to objects from before ---- no laughs ----
still incomplete -
\ collector.fs
cr s" loading collector.fs " type cr
include oof.fs
\ we reserve a set of memory locations to back
\ up the collection state at any given time :
\ this is passed to the collection object in init
create vbp 9 cells allot
create vbpx 9 cells allot
object class precollect
method @1
method !1
method @2
method !2
method @3
method !3
method @4
method !4
method @5
method !5
method @6
method !6
method @7
method !7
method @8
method !8
method @9
method !9
method nextval@
method nextval!
method sv-next@
method sv-next!
method nv@
method nv!
method dump-collection
method nextval-prt
method reset-all
method sv-nextval
method reset-nextval
method check-unique
method store-input
method backup-current
method restore-current
method nextvalinc
method mode-set-1
method mode-init
method mode-get
method mode-get-prt
method mode-swt
class;
precollect class collector
cell var v1
cell var v2
cell var v3
cell var v4
cell var v5
cell var v6
cell var v7
cell var v8
cell var v9
cell var nextval
cell var sv-next
cell var inpv
cell var dupr
cell var lclvbp
cell var lclvbpx
cell var mode
cell var fnd
how:
: @1 v1 @ ;
: !1 v1 ! ;
: @2 v2 @ ;
: !2 v2 ! ;
: @3 v3 @ ;
: !3 v3 ! ;
: @4 v4 @ ;
: !4 v4 ! ;
: @5 v5 @ ;
: !5 v5 ! ;
: @6 v6 @ ;
: !6 v6 ! ;
: @7 v7 @ ;
: !7 v7 ! ;
: @8 v8 @ ;
: !8 v8 ! ;
: @9 v9 @ ;
: !9 v9 ! ;
: nextval@ nextval @ ;
: nextval! nextval ! ;
: nextvalinc nextval@ 1 + nextval! ;
: sv-next@ sv-next @ ;
: sv-next! sv-next ! ;
: nv! nextval@ 1 = if !1 else nextval@
2 = if !2 else nextval@
3 = if !3 else nextval@
4 = if !4 else nextval@
5 = if !5 else nextval@
6 = if !6 else nextval@
7 = if !7 else nextval@
8 = if !8 else nextval@
9 = if !9
then then then then then then then then then ;
: nv@ nextval@ 1 = if @1 else nextval@
2 = if @2 else nextval@
3 = if @3 else nextval@
4 = if @4 else nextval@
5 = if @5 else nextval@
6 = if @6 else nextval@
7 = if @7 else nextval@
8 = if @8 else nextval@
9 = if @9
then then then then then then then then then ;
: reset-nextval sv-next@ nextval! ;
: sv-nextval nextval@ sv-next! ;
: nextval-prt cr s" nextval = " type nextval@ . ;
: reset-all 10 1 ?do i nextval! 42 nv! loop 1 nextval ! ;
: dump-collection sv-nextval 10 1 ?do i nextval! nv@ dup 10 < if . else emit then s" - " type loop reset-nextval ;
: check-unique inpv ! 0 dupr ! sv-nextval
10 1 ?do i nextval! nv@ inpv @ = if 1 dupr ! leave then loop
reset-nextval dupr @ ;
: store-input check-unique 0 = if inpv @ nv! nextval@ 1 + nextval! then ;
: backup-current-vpb sv-nextval 9 0 ?do i nextval! 1 + nv@ lclvbp nextval@ + ! loop reset-nextval ;
: restore-current-vpb sv-nextval 9 0 ? do i dup nextval! mode-get 0 = if lclvbp + @ else lclvbp + @ then nextvalinc nv! loop reset-nextval ;
: backup-current-vpbx sv-nextval 9 0 ?do i nextval! 1 + nv@ lclvbpx nextval@ + ! loop reset-nextval ;
: restore-current-vpbx sv-nextval 9 0 ? do i dup nextval! mode-get 0 = if lclvbpx + @ else lclvbpx + @ then nextvalinc nv! loop reset-nextval ;
: backup-current mode-get 0 = if backup-current-vpb else backup-current-vpbx then ;
: restore-current mode-get 0 = if restore-current-vpb else restore-current-vpbx then ;
: mode-set-1 1 mode ! ;
: mode-init 0 mode ! ;
: mode-get mode @ ;
: mode-get-prt mode @ . ;
: mode-swt mode-get = 0 if mode-set-1 else mode-init then ;
: check-possible mode-init backup-current mode-set-1 restore-current nextval @ 1 - mode-int restore-current ;
: store-possible-lcl 1 fnd ! mode-init backup-current mode-set-1 restore-current np! nextval @ 1 + nextval ! backup-current mode-init restore-current ;
: find-possible-lcl 0 fnd ! 10 1 ?do i dup check-val ! nextval! nv@ check-val @ = if store-possible-lcl then loop ;
\ in order for find possible to work the mode of the object must change -
\ because - possible values end up in a different container -
\ to make this simpiliar a change must be made to the backup and restore ----
\ so that if the mode is 0 it goes to lclvbp and if 1 if goes to lclvbpx
\ initially in find possible the mode is 0 then you do a backup - then change mode to 1 store and do a backup - the mode 0 restore -
\ to sent things back.
: init lclvbpx ! lclvbp ! reset-all cr s" init collector " type cr ;
class;
cr s" collector class loaded " type cr
collector : mycollector1
collector : mycollector2
collector : mycollector3
collector : mycollector4
collector : mycollector5
collector : mycollector6
collector : mycollector7
collector : mycollector8
collector : mycollector9
collector class collectorcollector
cell var collector-pointer
class;
No comments:
Post a Comment