diff options
Diffstat (limited to 'Instructions.icl')
| -rw-r--r-- | Instructions.icl | 386 |
1 files changed, 0 insertions, 386 deletions
diff --git a/Instructions.icl b/Instructions.icl deleted file mode 100644 index 6317972..0000000 --- a/Instructions.icl +++ /dev/null @@ -1,386 +0,0 @@ -implementation module ABC.Instructions - -import StdEnv - -import ABC.Machine -import ABC.Misc - -int_desc :== 0 -bool_desc :== 1 -rnf_entry :== 1 - -add_args :: ASrc NrArgs ADst State -> State -add_args a_src nr_args a_dst st=:{astack,graphstore} - = {st & astack=astack`, graphstore=graphstore`} -where - astack` = as_popn nr_args astack - graphstore` = gs_update dstid (n_fill descid entry newargs) graphstore - dstid = as_get a_dst astack - srcid = as_get a_src astack - node = gs_get srcid graphstore - descid = n_descid node - entry = n_entry node - arity = n_arity node - newargs = n_args node arity ++ as_topn nr_args astack - -create :: State -> State -create st=:{astack,graphstore} - = {st & astack=astack`, graphstore=graphstore`} -where - astack` = as_push nodeid astack - (graphstore`,nodeid) = gs_newnode graphstore - -del_args :: ASrc NrArgs ADst State -> State -del_args a_src nr_args a_dst st=:{astack,graphstore} - = {st & astack=astack`, graphstore=graphstore`} -where - astack` = as_pushn newargs astack - graphstore` = gs_update dstid (n_fill descid entry newargs) graphstore - dstid = as_get a_dst astack - srcid = as_get a_src astack - node = gs_get srcid graphstore - descid = n_descid node - entry = n_entry node - newargs = n_nargs node (arity - nr_args) arity - arity = n_arity node - -dump :: String State -> State -dump s st=:{io} - = {st & io=io_print ("\n" <+ s <+ "\n" <+ st) io} - -eq_desc :: DescId ASrc State -> State -eq_desc descid a_src st=:{astack,bstack,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushB equal bstack - equal = n_eq_descid node descid - node = gs_get nodeid graphstore - nodeid = as_get a_src astack - -eq_desc_arity :: DescId Arity ASrc State -> State -eq_desc_arity descid arity a_src st=:{astack,bstack,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushB equal bstack - equal = n_eq_descid node descid && n_eq_arity node arity - node = gs_get nodeid graphstore - nodeid = as_get a_src astack - -eq_symbol :: ASrc ASrc State -> State -eq_symbol a_src1 a_src2 st=:{astack,bstack,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushB equal bstack - equal = n_eq_symbol node1 node2 - (node1, node2) = (gs_get id1 graphstore, gs_get id2 graphstore) - (id1, id2) = (as_get a_src1 astack, as_get a_src2 astack) - -eqB :: State -> State -eqB st=:{bstack} - = {st & bstack=bs_eqB bstack} - -eqB_a :: Bool ASrc State -> State -eqB_a b a_src st=:{astack,bstack,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushB equal bstack - equal = n_eq_B (gs_get nodeid graphstore) b - nodeid = as_get a_src astack - -eqB_b :: Bool BSrc State -> State -eqB_b b b_src st=:{bstack} - = {st & bstack=bs_eqBi b b_src bstack} - -eqI :: State -> State -eqI st=:{bstack} - = {st & bstack=bs_eqI bstack} - -eqI_a :: Int ASrc State -> State -eqI_a i a_src st=:{astack,bstack,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushB equal bstack - equal = n_eq_I (gs_get nodeid graphstore) i - nodeid = as_get a_src astack - -eqI_b :: Int BSrc State -> State -eqI_b i b_src st=:{bstack} - = {st & bstack=bs_eqIi i b_src bstack} - -fill :: DescId NrArgs InstrId ADst State -> State -fill desc nr_args entry a_dst st=:{astack,graphstore} - = {st & astack=astack`, graphstore=graphstore`} -where - astack` = as_popn nr_args astack - graphstore` = gs_update nodeid (n_fill desc entry args) graphstore - nodeid = as_get a_dst astack - args = as_topn nr_args astack - -fill_a :: ASrc ADst State -> State -fill_a a_src a_dst st=:{astack,graphstore} - = {st & graphstore=graphstore`} -where - graphstore` = gs_update nodeid_dst (n_copy node_src) graphstore - node_src = gs_get nodeid_src graphstore - nodeid_dst = as_get a_dst astack - nodeid_src = as_get a_src astack - -fillB :: Bool ADst State -> State -fillB b a_dst st=:{astack,graphstore} - = {st & graphstore=graphstore`} -where - graphstore` = gs_update nodeid (n_fillB bool_desc rnf_entry b) graphstore - nodeid = as_get a_dst astack - -fillB_b :: BSrc ADst State -> State -fillB_b b_src a_dst st=:{astack,bstack,graphstore} - = {st & graphstore=graphstore`} -where - graphstore` = gs_update nodeid (n_fillB bool_desc rnf_entry b) graphstore - b = bs_getB b_src bstack - nodeid = as_get a_dst astack - -fillI :: Int ADst State -> State -fillI i a_dst st=:{astack,graphstore} - = {st & graphstore=graphstore`} -where - graphstore` = gs_update nodeid (n_fillI int_desc rnf_entry i) graphstore - nodeid = as_get a_dst astack - -fillI_b :: BSrc ADst State -> State -fillI_b b_src a_dst st=:{astack,bstack,graphstore} - = {st & graphstore=graphstore`} -where - graphstore` = gs_update nodeid (n_fillI int_desc rnf_entry i) graphstore - i = bs_getI b_src bstack - nodeid = as_get a_dst astack - -get_desc_arity :: ASrc State -> State -get_desc_arity a_src st=:{astack,bstack,descstore,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushI arity bstack - arity = d_arity (ds_get descid descstore) - descid = n_descid (gs_get nodeid graphstore) - nodeid = as_get a_src astack - -get_node_arity :: ASrc State -> State -get_node_arity a_src st=:{astack,bstack,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushI arity bstack - arity = n_arity (gs_get nodeid graphstore) - nodeid = as_get a_src astack - -halt :: State -> State -halt st=:{pc} - = {st & pc=pc_halt pc} - -jmp :: InstrId State -> State -jmp addr st - = {st & pc=addr} - -jmp_eval :: State -> State -jmp_eval st=:{astack,graphstore} - = {st & pc=pc`} -where - pc` = n_entry (gs_get nodeid graphstore) - nodeid = as_get 0 astack - -jmp_false :: InstrId State -> State -jmp_false addr st=:{bstack,pc} - = {st & bstack=bstack`, pc=pc`} -where - pc` = if (not b) addr pc - b = bs_getB 0 bstack - bstack` = bs_popn 1 bstack - -jmp_true :: InstrId State -> State -jmp_true addr st=:{bstack,pc} - = {st & bstack=bstack`, pc=pc`} -where - pc` = if b addr pc - b = bs_getB 0 bstack - bstack` = bs_popn 1 bstack - -jsr :: InstrId State -> State -jsr addr st=:{cstack,pc} - = {st & cstack=cstack`, pc=pc`} -where - pc` = addr - cstack` = cs_push pc cstack - -jsr_eval :: State -> State -jsr_eval st=:{astack,cstack,graphstore,pc} - = {st & cstack=cstack`, pc=pc`} -where - pc` = n_entry (gs_get nodeid graphstore) - nodeid = as_get 0 astack - cstack` = cs_push pc cstack - -no_op :: State -> State -no_op st = st - -pop_a :: NrArgs State -> State -pop_a n st=:{astack} - = {st & astack=as_popn n astack} - -pop_b :: NrArgs State -> State -pop_b n st=:{bstack} - = {st & bstack=bs_popn n bstack} - -print :: String State -> State -print s st=:{io} - = {st & io=io_print s io} - -print_symbol :: ASrc State -> State -print_symbol a_src st=:{astack,descstore,graphstore,io} - = {st & io=io`} -where - io` = io_print string io - string = show_node node desc - desc = ds_get (n_descid node) descstore - node = gs_get nodeid graphstore - nodeid = as_get a_src astack - -push_a :: ASrc State -> State -push_a a_src st=:{astack} - = {st & astack=as_push (as_get a_src astack) astack} - -push_ap_entry :: ASrc State -> State -push_ap_entry a_src st=:{astack,cstack,descstore,graphstore} - = {st & cstack=cstack`} -where - cstack` = cs_push (d_ap_entry (ds_get descid descstore)) cstack - descid = n_descid (gs_get nodeid graphstore) - nodeid = as_get a_src astack - -push_arg :: ASrc Arity ArgNr State -> State -push_arg a_src arity arg_nr st=:{astack,graphstore} - = {st & astack=astack`} -where - astack` = as_push arg astack - arg = n_arg (gs_get nodeid graphstore) arg_nr arity - nodeid = as_get a_src astack - -push_arg_b :: ASrc State -> State -push_arg_b a_src st=:{astack,bstack,graphstore} - = {st & astack=astack`} -where - astack` = as_push arg astack - arg = n_arg (gs_get nodeid graphstore) arg_nr arity - nodeid = as_get a_src astack - arg_nr = bs_getI 0 bstack - arity = bs_getI 1 bstack - -push_args :: ASrc Arity NrArgs State -> State -push_args a_src arity nr_args st=:{astack,graphstore} - = {st & astack=astack`} -where - astack` = as_pushn args astack - args = n_nargs (gs_get nodeid graphstore) nr_args arity - nodeid = as_get a_src astack - -push_args_b :: ASrc State -> State -push_args_b a_src st=:{astack,bstack,graphstore} - = {st & astack=astack`} -where - astack` = as_pushn args astack - args = n_nargs (gs_get nodeid graphstore) nargs arity - nargs = bs_getI 0 bstack - nodeid = as_get a_src astack - arity = bs_getI 1 bstack - -push_b :: BSrc State -> State -push_b b_src st=:{bstack} - = {st & bstack=bs_push (bs_get b_src bstack) bstack} - -pushB :: Bool State -> State -pushB b st=:{bstack} - = {st & bstack=bs_pushB b bstack} - -pushB_a :: ASrc State -> State -pushB_a a_src st=:{astack,bstack,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushB b bstack - b = n_B (gs_get nodeid graphstore) - nodeid = as_get a_src astack - -pushI :: Int State -> State -pushI i st=:{bstack} - = {st & bstack=bs_pushI i bstack} - -pushI_a :: ASrc State -> State -pushI_a a_src st=:{astack,bstack,graphstore} - = {st & bstack=bstack`} -where - bstack` = bs_pushI i bstack - i = n_I (gs_get nodeid graphstore) - nodeid = as_get a_src astack - -repl_args :: Arity NrArgs State -> State -repl_args arity nr_args st=:{astack,graphstore} - = {st & astack=astack`} -where - astack` = as_pushn args (as_popn 1 astack) - args = n_nargs (gs_get nodeid graphstore) nr_args arity - nodeid = as_get 0 astack - -repl_args_b :: State -> State -repl_args_b st=:{astack,bstack,graphstore} - = {st & astack=astack`} -where - astack` = as_pushn args (as_popn 1 astack) - args = n_nargs (gs_get nodeid graphstore) nr_args arity - nodeid = as_get 0 astack - arity = bs_getI 0 bstack - nr_args = bs_getI 1 bstack - -rtn :: State -> State -rtn st=:{cstack} - = {st & cstack=cs_popn 1 cstack, pc=cs_get 0 cstack} - -set_entry :: InstrId ADst State -> State -set_entry entry a_dst st=:{astack,graphstore} - = {st & graphstore=graphstore`} -where - graphstore` = gs_update nodeid (n_setentry entry) graphstore - nodeid = as_get a_dst astack - -update_a :: ASrc ADst State -> State -update_a a_src a_dst st=:{astack} - = {st & astack=as_update a_dst (as_get a_src astack) astack} - -update_b :: BSrc BDst State -> State -update_b b_src b_dst st=:{bstack} - = {st & bstack=bs_update b_dst (bs_get b_src bstack) bstack} - - -addI :: State -> State -addI st=:{bstack} - = {st & bstack=bs_addI bstack} - -decI :: State -> State -decI st=:{bstack} - = {st & bstack=bs_decI bstack} - -gtI :: State -> State -gtI st=:{bstack} - = {st & bstack=bs_gtI bstack} - -incI :: State -> State -incI st=:{bstack} - = {st & bstack=bs_incI bstack} - -ltI :: State -> State -ltI st=:{bstack} - = {st & bstack=bs_ltI bstack} - -mulI :: State -> State -mulI st=:{bstack} - = {st & bstack=bs_mulI bstack} - -subI :: State -> State -subI st=:{bstack} - = {st & bstack=bs_subI bstack} |