-- (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