-- (find-flua "inc.lua")
-- (find-flua "flua-comp.lua")
-- (find-flua "flua-prims.lua")
-- (find-flua "flua-lua.lua")
-- (find-flua "flua.lua")
-- (find-flua "flua-demos.lua")


-- «.Hprims»	(to "Hprims")
-- «.FIPprims»	(to "FIPprims")
-- «.Fprims»	(to "Fprims")


--%%%%%
--%
--% «Hprims»  (to ".Hprims")
--%
--%%%%%

add_Hprims(
"COL   "," goto forth;",
"CON   "," DS[1]=*(int *)(_f0+RS[0]); DS++; RS--; goto forth;",
"TO    "," *(int *)(_f0+RS[0]+1)=DS[0]; DS--; RS--; goto forth;",
"AT    "," DS[1]=((int)_f0)+RS[0]+2; DS++; RS--; goto forth;",
"RSR   "," SS[1]=((int)_f0)+RS[-1]; SS++; RS[-1]=FIP_RSREXIT; goto head;",
"C0    "," fun=*(funptr *)(_f0+RS[0]); DS[1]=(*fun)(); DS++;RS--; goto forth;",
"C1    "," fun=*(funptr *)(_f0+RS[0]); DS[0]=(*fun)(DS[0]); RS--; goto forth;",
"C2    "," fun=*(funptr *)(_f0+RS[0]); DS[-1]=(*fun)(DS[-1], DS[0]);"
       .." DS--; RS--; goto forth;",
"C3    "," fun=*(funptr *)(_f0+RS[0]); DS[-2]=(*fun)(DS[-2], DS[-1], DS[0]);"
       .." DS-=2; RS--; goto forth;",
"DROPPING"," RS[1]=RS[0]; RS[0]=FIP_FIPDROP; RS++; goto head;"
)
-- Most heads change the state from "head" to "forth".
-- The only exceptions at this moment are RSR and DROPPING, that are
-- used as prefixes to other heads, and thus stay in "head" state.
-- Stack diagrams:
-- COL : ( R: ip           -- R: ip )
-- CON   ( R: ip0 ip       -- R: ip0                D: *(i*)ip )
-- TO    ( R: ip0 ip  D: x -- R: ip0 )
-- AT    ( R: ip0 ip       -- R: ip0                D: ip0+2 )
-- RSR   ( R: ip0 ip       -- R: rsrret ip S: ip0 )		-> head
-- C0    ( R: ip0 ip  D:          -- R: ip0 D: retval )
-- C1    ( R: ip0 ip  D: p1       -- R: ip0 D: retval )
-- C2    ( R: ip0 ip  D: p1 p2    -- R: ip0 D: retval )
-- C3    ( R: ip0 ip  D: p1 p2 p3 -- R: ip0 D: retval )
-- DROPPING ( R: ip               -- R: fipdrop ip )		-> head




--%%%%%
--%
--% «FIPprims»  (to ".FIPprims")
--%
--%%%%%

add_FIPprims(
"RETURN  "," RS--; return;",
"RSREXIT "," RS[0]=SS[0]-((int)_f0); SS--; goto forth;",
"FIPDROP "," RS--; DS--; goto forth;"
)
-- RETURN  ( R: return -- )                  exits the engine
-- RSREXIT ( R: rsrret S: ip0 -- R: ip0 S: )
-- FIPDROP ( R: ip0 fipdrop D: x -- R: ip0 )




--%%%%%
--%
--% «Fprims»  (to ".Fprims")
--%
--%%%%%

add_Fprims(
"EXIT ;    "," RS--; goto forth;",
"PLUS +    "," DS[-1]+=DS[0]; DS--; goto forth;",
"DUP       "," DS[1]=DS[0]; DS++; goto forth;",
"2DUP      "," DS[1]=DS[-1]; DS[2]=DS[0]; DS+=2; goto forth;",
"SWAP      "," itmp=DS[-1]; DS[-1]=DS[0]; DS[0]=itmp; goto forth;",
"DROP      "," DS--; goto forth;",
"SBRANCH   "," SS[0]=(int)_f0+*((ushort *)(SS[0])); goto forth;",
"S0BRANCH  "," tmp=*((ushort *)(SS[0]))++; if(DS[0]==0) SS[0]=(int)_f0+tmp;"
           .." DS--; goto forth;",
"0         "," DS[1]=0; DS++; goto forth;",
"1         "," DS[1]=1; DS++; goto forth;",
"TIMES *   "," DS[-1]*=DS[0]; DS--; goto forth;",
"COUNT     "," DS[1]=*((uchar *)(DS[0]))++; DS++; goto forth;",
"TYPE      "," fwrite((void *)(DS[-1]), 1, DS[0], stdout); DS-=2; goto forth;",
"CR        "," printf(\"\\n\"); goto forth;",
"STO S>    "," DS[1]=SS[0]; DS++; SS--; goto forth;",
"TOS >S    "," SS[1]=DS[0]; SS++; DS--; goto forth;",
"SGOBBLE1  "," DS[1]=*((uchar *)(SS[0]))++; DS++; goto forth;",
"SGOBBLE2  "," DS[1]=*((ushort *)(SS[0]))++; DS++; goto forth;",
"WSTORE W! "," *((ushort *)(DS[0]))=DS[1]; DS-=2; goto forth;",
"WFETCH W@ "," DS[0]=*((ushort *)(DS[0])); goto forth;"
)
-- SBRANCH  ( S: adr         -- S: _f0+*(uw*)adr )
-- S0BRANCH ( S: adr D: 0    -- S: adr+2 )
--       or ( S: adr D: non0 -- S: _f0+*(uw*)adr )
-- COUNT    ( adr -- adr+1 *(uc*)adr )
-- TYPE     ( adr len -- )
-- CR       ( -- )
-- STO S>   ( S: x -- D: x )
-- TOS >S   ( D: x -- S: x )
-- SGOBBLE1 ( S: adr -- S: adr+1 D: *(uc*)adr )
-- SGOBBLE2 ( S: adr -- S: adr+2 D: *(uw*)adr )
-- WSTORE W! ( w adr -- )
-- WFETCH W@ ( adr -- w )



add_SFprims(";", "mark_as_used")	-- always give the code 0xFF to SF_EXIT
add_SFprims("EXIT ; DUP")		-- force one-byte versions