[wip] registerized interpreter

This commit is contained in:
Edward Amsden 2022-12-15 22:48:46 -06:00
parent 3c5d2519dd
commit 3435439299
3 changed files with 504 additions and 162 deletions

View File

@ -1,11 +1,182 @@
/- *sock /- *sock
/- *gene /- *gene
/+ ska /+ ska
=| burg=town
|% |%
++ mill :: XX todo observe crashes
=* this .
|= [ject=* gist=barn]
^- [* _this]
=| quay=(list [curb=berm sign=(map @ *) vale=@])
=^ [goes=lake uses=pool] this (belt gist)
=/ sign (dole uses ject)
=/ reed ~| %miss-entry (~(got by goes) ~)
|^ ^- [* _this]
?~ body.reed
?- -.bend.reed
%clq
?@ (loan +<.bend.reed)
(lump +>+.bend.reed)
(lump +>-.bend.reed)
::
%eqq
~! +<.bend.reed
~! +>-.bend.reed
?: =((loan +<.bend.reed) (loan +>-.bend.reed))
(lump +>+<.bend.reed)
(lump +>+>.bend.reed)
::
%brn
?: =(0 (loan +<.bend.reed))
(lump +>-.bend.reed)
?: =(1 (loan +<.bend.reed))
(lump +>+.bend.reed)
~| %bad-bean !!
::
%hop (lump +.bend.reed)
%lnk
=^ [goop=lake ruse=pool] this
(belt [%toss ~] (loan +<.bend.reed))
%= $
quay [[+>+>.bend.reed sign +>+<.bend.reed] quay]
goes goop
sign (dole ruse (loan +>-.bend.reed))
==
::
%cal
=/ [goop=lake ruse=pool] does:(~(got by land.burg) +<.bend.reed)
%= $
quay [[+>+>.bend.reed sign +>+<.bend.reed] quay]
goes goop
sign (yoke +>-.bend.reed ruse)
==
::
%bec ~| %bec-slip !!
%lnt
=^ [goop=lake ruse=pool] this
(belt [%toss ~] (loan +<.bend.reed))
~! +>.bend.reed
%= $
goes goop
sign (dole ruse (loan +>.bend.reed))
==
::
%jmp
=/ [goop=lake ruse=pool] does:(~(got by land.burg) +<.bend.reed)
%= $
goes goop
sign (yoke +>.bend.reed ruse)
==
::
%eye ~| %eye-slip !!
%spy ~| %fbi !!
%hnt ?>((~(has by sign) +<.bend.reed) (lump +>.bend.reed))
%don
?~ quay [(loan +.bend.reed) this]
=/ rail [sub for]:curb.i.quay
=/ [goop=lake ruse=pool] does:(~(got by land.burg) rail)
%= $
sign (~(put by sign.i.quay) vale.i.quay (loan +.bend.reed))
goes goop
reed ~|(%miss-entry (~(got by goes) `curb.i.quay))
quay t.quay
==
::
%bom
~| %boom !!
==
%= $
body.reed t.body.reed
sign
%- ~(put by sign)
?- -.i.body.reed
%imm [+> +<]:i.body.reed
%mov
:- +>.i.body.reed
(loan +<.i.body.reed)
::
%inc
:- +>.i.body.reed
=/ bink (loan +<.i.body.reed)
?> ?=(@ bink)
.+(bink)
::
%unc
:- +>.i.body.reed
=/ bink (loan +<.i.body.reed)
?> ?=(@ bink)
.+(bink)
::
%con
:- +>+.i.body.reed
:- (loan +<.i.body.reed)
(loan +>-.i.body.reed)
::
%hed
=/ cash (loan +<.i.body.reed)
?> ?=(^ cash)
[+>.i.body.reed -.cash]
::
%hud
=/ cash (loan +<.i.body.reed)
?> ?=(^ cash)
[+>.i.body.reed -.cash]
::
%tal
=/ cash (loan +<.i.body.reed)
?> ?=(^ cash)
[+>.i.body.reed +.cash]
::
%tul
=/ cash (loan +<.i.body.reed)
?> ?=(^ cash)
[+>.i.body.reed +.cash]
==
==
++ loan
|= @
~| %loan-miss (~(got by sign) +<)
++ lump
|= berm
^$(reed ~|(%miss-entry (~(got by goes) `+<)))
++ yoke
|= [ox=(list @) lo=pool]
=| link=(map @ *)
|- ^- (map @ *)
?~ ox
?~ lo link
~| %yoke-match !!
?~ lo
~| %yoke-match !!
$(link (~(put by link) ssa.i.lo (loan i.ox)), ox t.ox, lo t.lo)
--
++ dole
|= [=pool ject=*]
%- malt
%+ turn pool
|= [axe=@ ssa=@ ?]
[ssa .*(ject [0 axe])]
++ belt
=* this .
|= gist=barn
^- [rice _this]
=. this +:(reap gist)
does:(~(got by burg) gist)
++ reap
=* this .
|= =barn
^- [boot _this]
=/ [=boot =farm] (plot barn)
=^ work this (till farm)
:- boot
(weed:(rake:this work) work)
++ plot :: subject knowledge analysis, emitting nock-- or "nomm" ++ plot :: subject knowledge analysis, emitting nock-- or "nomm"
=* this .
=| ski=farm =| ski=farm
|= ent=barn |= ent=barn
^- [boot farm] ^- [boot farm]
=/ bot (~(get by land.burg) ent)
?. ?=(~ bot) [says.u.bot ski] :: no need to re-plot a barn we already know
=/ ext (~(get by yard.ski) ent) =/ ext (~(get by yard.ski) ent)
?. ?=(~ ext) [says.u.ext ski] ?. ?=(~ ext) [says.u.ext ski]
=; [res=[does=nomm says=boot:ska] sku=farm] =; [res=[does=nomm says=boot:ska] sku=farm]
@ -235,12 +406,13 @@
[[[%zer 0 %.n] [%boom ~]] ski] [[[%zer 0 %.n] [%boom ~]] ski]
-- --
++ till ++ till
=| burg=town =* this .
|= =farm |= =farm
^- town ^- [(list barn) _this]
=/ work (flop (skip wood.farm ~(has in ~(key by land.burg)))) =/ work (flop (skip wood.farm ~(has by land.burg)))
|- ^+ burg :- work
?~ work burg |- ^- _this
?~ work this
=/ next i.work =/ next i.work
=+ ~| %next-miss (~(got by yard.farm) next) =+ ~| %next-miss (~(got by yard.farm) next)
:: now we have the nock-- in does :: now we have the nock-- in does
@ -850,4 +1022,328 @@
^- [berm _dock] ^- [berm _dock]
(mend %boom ~ [%bom ~]) (mend %boom ~ [%bom ~])
-- --
++ rake :: clean up unused basic blocks, and rewrite bec/eye into cal/jmp
=* this .
|= work=(list barn)
^- _this
?~ work this
%= $
burg
=+ ~| %barn-miss (~(got by land.burg) i.work)
^- town
=| loch=lake
=| sigh=(map @ $%([%mov @] [%con @] [%rug ~]))
=/ tack=[(list (unit berm)) (list (unit berm))] [[~]~ ~] :: label queue
|- ^- town :: loop over basic blocks using a queue
?~ -.tack
?~ +.tack
%= burg
land
(~(put by land.burg) i.work [[loch uses.does] says])
==
$(tack [(flop +.tack) ~])
=/ hock ~| %miss-berm (~(got by goes.does) i.-.tack)
=/ bock body.hock
|^ ^- town :: loop over instructions in a basic block
?~ body.hock
?: ?=(%bec -.bend.hock)
(rend [+< +>- `+>+]:bend.hock)
?: ?=(%eye -.bend.hock)
(rend [+< +>- ~]:bend.bock)
=. loch (~(put by loch) i.-.tack [bock bend.hock])
?- bend.hock
[%clq *]
^$(-.tack t.-.tack, +.tack [+>-.bend.hock +>+.bend.hock +.tack])
::
[%eqq *]
^$(-.tack t.-.tack, +.tack [+>+<.bend.hock +>+>.bend.hock +.tack])
::
[%brn *]
^$(-.tack t.-.tack, +.tack [+>-.bend.hock +>+.bend.hock +.tack])
::
[%hop *]
^$(-.tack t.-.tack, +.tack [+.bend.hock +.tack])
::
[%lnk *]
%= ^$
sigh (~(put by sigh) +>+<.bend.bock [%rug ~])
-.tack t.-.tack
+.tack [+>+>.bend.hock +.tack]
==
::
[%cal *]
%= ^$
sigh (~(put by sigh) +>+<.bend.hock [%rug ~])
-.tack t.-.tack
+.tack [+>+>.bend.hock +.tack]
==
::
[%lnt *] ^$(-.tack t.-.tack)
[%jmp *] ^$(-.tack t.-.tack)
[%spy *]
%= ^$
sigh (~(put by sigh) +>+<.bend.hock [%rug ~])
-.tack t.-.tack
+.tack [+>+>.bend.hock +.tack]
==
::
[%hnt *]
^$(-.tack t.-.tack, +.tack [+>.bend.hock +.tack])
::
[%don *] ^$(-.tack t.-.tack)
[%bom *] ^$(-.tack t.-.tack)
==
?- i.body.hock
[%imm *] :: XX we should split immediates too
$(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
::
[%mov *]
%= $
body.hock t.body.hock
sigh (~(put by sigh) +>.i.body.hock [%mov +<.i.body.hock])
==
::
[%inc *]
$(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
::
[%unc *]
$(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.hock [%rug ~]))
::
[%con *]
%= $
body.hock t.body.hock
sigh
%+ ~(put by sigh)
+>+.i.body.hock
[%con +<.body.hock +>-.i.body.hock]
==
::
[%hed @ @]
$(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.bock [%rug ~]))
::
[%hud @ @]
$(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.bock [%rug ~]))
::
[%tal @ @]
$(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.bock [%rug ~]))
::
[%tul @ @]
$(body.hock t.body.hock, sigh (~(put by sigh) +>.i.body.bock [%rug ~]))
==
++ rend :: make register assignments to translate a bec/eye into a cal/jmp.
|= [=barn tart=@ poem=(unit [@ berm])]
=/ uses ~| %uses-miss uses:does:(~(got by land.burg) barn)
^- town
=-
=. burg fort
=? sigh ?=([~ *] poem) (~(put by sigh) -.u.poem [%rug ~])
=/ term
?~ poem
[%jmp barn bits]
[%cal barn bits u.poem]
%= ^^$
loch
(~(put by loch) i.-.tack [(weld bock bins) term])
::
-.tack t.-.tack
==
=/ gasp :: turn the sigh register-relating map into a register-for-axis map
=/ axe 1
|- ^- (map @ @)
=/ waft (~(put by *(map @ @)) axe tart)
=/ puff (~(gut by sigh) tart [%rug ~])
?- puff
[%rug ~] waft
[%mov *] (~(uni by waft) $(tart +.puff))
[%con *]
~! axe
=/ left $(tart +<.puff, axe (peg axe 2))
%- ~(uni by waft)
%- ~(uni by left)
$(tart +>.puff, axe (peg axe 3))
==
=| bits=(list @)
=| bins=(list bran)
|- ^- [bits=(list @) bins=(list bran) fort=town]
?~ uses [(flop bits) bins burg]
=/ sour -.i.uses
=/ axle 1
=/ vale ~| %vale-miss (~(got by gasp) 1)
|- ^- [bits=(list @) bins=(list bran) fort=town]
?: =(1 sour)
^$(bits [vale bits], uses t.uses)
?- (cap sour)
%2
=. axle (peg axle 2)
=. sour (mas sour)
=/ pale (~(get by gasp) axle)
?~ pale
%= $
bins [%hed vale lamb.burg]
vale lamb.burg
gasp (~(put by gasp) axle lamb.burg)
lamb.burg .+(lamb.burg)
==
$(vale u.pale)
::
%3
=. axle (peg axle 3)
=. sour (mas sour)
=/ pale (~(get by gasp) axle)
?~ pale
%= $
bins [%tal vale lamb.burg]
vale lamb.burg
gasp (~(put by gasp) axle lamb.burg)
lamb.burg .+(lamb.burg)
==
$(vale u.pale)
==
--
::
work t.work
==
++ weed :: remove unused safe operations (imm,mov,unc,con,hud,tul)
=* this .
|= work=(list barn)
^- _this
?~ work this
=/ herd (~(got by land.burg) i.work) :: sack for this arm
=| dead=(jug (unit berm) @) :: values used by a label and its successor code
=/ furs=(list (unit berm)) [~]~
|- ^- _this
?~ furs
^$(work t.work, land.burg (~(put by land.burg) i.work herd))
?: (~(has by dead) i.furs) :: did we already analyze this arm
$(furs t.furs)
=/ meat (~(got by goes.does.herd) i.furs)
|^
?- -.bend.meat
%clq
=/ troo (~(get by dead) `+>-.bend.meat)
?~ troo $(furs [`+>-.bend.meat furs])
=/ fals (~(get by dead) `+>+.bend.meat)
?~ fals $(furs [`+>+.bend.meat furs])
~! u.troo
~! u.fals
~! +<.bend.meat
(vein (~(uni in u.troo) (~(put in u.fals) +<.bend.meat)))
::
%eqq
=/ troo (~(get by dead) `+>+<.bend.meat)
?~ troo $(furs [`+>+<.bend.meat furs])
=/ fals (~(get by dead) `+>+>.bend.meat)
?~ fals $(furs [`+>+>.bend.meat furs])
(vein (~(uni in u.troo) (~(gas in u.fals) [+<.bend.meat +>-.bend.meat ~])))
::
%brn
=/ troo (~(get by dead) `+>-.bend.meat)
?~ troo $(furs [`+>-.bend.meat furs])
=/ fals (~(get by dead) `+>+.bend.meat)
?~ fals $(furs [`+>+.bend.meat furs])
(vein (~(uni in u.troo) (~(put in u.fals) +<.bend.meat)))
::
%hop
=/ want (~(get by dead) `+.bend.meat)
?~ want $(furs [`+.bend.meat furs])
(vein u.want)
::
%lnk
=/ want (~(get by dead) `+>+>.bend.meat)
?~ want $(furs [`+>+>.bend.meat furs])
(vein (~(gas in u.want) [+<.bend.meat +>-.bend.meat ~]))
::
%cal
=/ want (~(get by dead) `+>+>.bend.meat)
?~ want $(furs [`+>+>.bend.meat furs])
(vein (~(gas in u.want) +>-.bend.meat))
::
%bec
~| %bec-trip !!
::
%lnt
(vein (silt [+<.bend.meat]~))
::
%jmp
(vein (silt +>.bend.meat))
::
%eye
~| %eye-trip !!
::
%spy
=/ want (~(get by dead) `+>+>.bend.meat)
?~ want $(furs [`+>+>.bend.meat furs])
(vein (~(gas in u.want) [+<.bend.meat +>-.bend.meat ~]))
::
%hnt
=/ want (~(get by dead) `+>.bend.meat)
?~ want $(furs [`+>.bend.meat furs])
(vein (~(put in u.want) +<.bend.meat))
::
%don
(vein (silt [+.bend.meat]~))
::
%bom
(vein ~)
==
++ vein
|= uses=(set @)
=/ boyd (flop body.meat)
=| bond=(list bran)
|- ^- _this
~! goes.does.herd
~! i.furs
?~ boyd
%= ^^^$
furs t.furs
goes.does.herd
(~(put by goes.does.herd) i.furs [bond bend.meat])
dead
(~(put by dead) i.furs `(set @)`uses)
==
?- -.i.boyd
%imm
?: (~(has in uses) +>.i.boyd)
$(bond [i.boyd bond], boyd t.boyd)
$(boyd t.boyd)
::
%mov
?: (~(has in uses) +>.i.boyd)
$(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
$(boyd t.boyd)
::
%inc
$(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
::
%unc
?: (~(has in uses) +>.i.boyd)
$(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
$(boyd t.boyd)
::
%con
?: (~(has in uses) +>+.i.boyd)
%= $
bond [i.boyd bond]
boyd t.boyd
uses (~(gas in uses) [+<.i.boyd +>-.i.boyd ~])
==
$(boyd t.boyd)
::
%hed
$(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
::
%hud
?: (~(has in uses) +>.i.boyd)
$(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
$(boyd t.boyd)
::
%tal
$(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
::
%tul
?: (~(has in uses) +>.i.boyd)
$(bond [i.boyd bond], boyd t.boyd, uses (~(put in uses) +<.i.boyd))
$(boyd t.boyd)
==
--
-- --

View File

@ -1,155 +0,0 @@
/- *gene
/+ degen
|%
++ real
|= [ject=* form=*]
=/ labl [[%toss ~] form]
=/ prog prog:+:(gene:degen labl)
(play ject prog labl)
++ play
|= [ject=* prog=tinn entr=labl]
^- *
=/ tend=* [[0 0] ject]
=| tack=(list [togo=linn rend=_tend])
=/ inst=linn
=/ entu (~(get by prog) entr)
?~ entu
~| 'No entry for given labl' !!
does.u.entu
|^
^- *
=^ next inst ~|(%empty-instruction-list ?>(?=(^ inst) inst))
?+ next ~|('TODO: full instruction set' !!)
[%don ~]
?: =(tack ~)
(gett 4) :: TODO pop stack
=/ res (gett 4)
=^ [pins=linn pend=_tend] tack tack
=. inst pins
=. tend pend
=. this (putt 4 res)
$
::
[%jmp *]
=/ entu (~(get by prog) +.next)
?~ entu
~| 'No entry for given labl' !!
$:this(inst does.u.entu)
::
[%cal *]
=/ entu (~(get by prog) +.next)
?~ entu
~| 'No entry for given labl' !!
=/ ject (gett 3)
=/ mend tend
=. this (putt 2 [0 0])
=. tack [[inst mend] tack]
=. inst does.u.entu
$
::
[%lnt ~]
=/ dorm (gett 4)
=. prog prog:+:(gene:degen(prog prog) [[%toss ~] dorm])
=/ entu (~(get by prog) [[%toss ~] dorm])
?~ entu
~| 'No entry for given labl' !!
$:this(inst does.u.entu)
::
[%lnk ~]
=/ dorm (gett 4)
=. prog prog:+:(gene:degen(prog prog) [[%toss ~] dorm])
=/ entu (~(get by prog) entr)
?~ entu
~| 'No entry for given labl' !!
=/ ject (gett 3)
=/ mend tend
=/ thin (putt 2 [0 0])
$:thin(tack [[inst mend] tack], inst does.u.entu)
::
[%bom *]
~| 'Crashed on command' !!
::
[%imm * @]
$:(putt +>.next +<.next)
::
[%mov @ @]
$:(putt +>.next (gett +<.next))
::
[%clq * *]
?@ (gett 4)
$:(find +>.next)
$:(find +<.next)
::
[%inc @]
=/ ting (gett +.next)
?@ ting
$:(putt +.next .+(ting))
~| 'Increment of cell' !!
::
[%eqq * *]
?: =((gett 8) (gett 9))
$:(find +<.next)
$:(find +>.next)
::
[%brn * *]
=/ ting (gett 4)
?: =(ting 0)
$:(find +<.next)
?: =(ting 1)
$:(find +>.next)
~| 'Branch on something not a loobean' !!
::
[%hop *]
$:(find +.next)
::
[%her *]
~& 'Running over label'
$
==
++ this .
++ find
|= wher=dabl
^- _this
?~ inst
~| 'Empty instruction list' !!
?: ?= [%her *] -.inst
?: =(wher ->.inst)
this(inst +.inst)
$(inst +.inst)
$(inst +.inst)
++ gett
|= wher=@
^- *
?: =(1 wher)
tend
?@ tend
~| 'Get axis from atom' !!
?- (cap wher)
%2 $(wher (mas wher), tend -.tend)
%3 $(wher (mas wher), tend +.tend)
==
++ putt
|= [wher=@ what=*]
^- _this
%= this
tend
|-
?: =(1 wher)
what
?- (cap wher)
%2
?@ tend
:- $(wher (mas wher))
0
:- $(wher (mas wher), tend -.tend)
+.tend
%3
?@ tend
:- 0
$(wher (mas wher))
:- -.tend
$(wher (mas wher), tend +.tend)
==
==
--
--

View File

@ -82,12 +82,13 @@
:: define the third as the result :: define the third as the result
[%hnt @ berm] :: Treat the result in the SSA register as a hint and continue to the given label [%hnt @ berm] :: Treat the result in the SSA register as a hint and continue to the given label
[%don @] :: Finish the procedure, returning the value at axis 4 [%don @] :: Finish the procedure, returning the value in the SSA
[%bom ~] :: Crash [%bom ~] :: Crash
== ==
+$ pool (list [axe=@ ssa=@ saf=?]) :: entry point subject uses: ordered subject/ssa/safety
+$ lock [body=(list bran) bend=germ] :: basic block: instructions + a terminator or branch +$ lock [body=(list bran) bend=germ] :: basic block: instructions + a terminator or branch
+$ lake (map (unit berm) lock) :: labeled basic blocks +$ lake (map (unit berm) lock) :: labeled basic blocks
+$ rice [goes=lake uses=(list [@ @ ?])] :: labeled basic blocks and entry point arguments as subject axes +$ rice [goes=lake uses=pool] :: labeled basic blocks
+$ sack [does=rice says=boot] :: code table entry: basic blocks + SKA result for an arm +$ sack [does=rice says=boot] :: code table entry: basic blocks + SKA result for an arm
+$ town [land=(map barn sack) lamb=@] :: code table +$ town [land=(map barn sack) lamb=@] :: code table
-- --