Bugfixes

LICENSE

@@ -1,4 +1,4 @@
-Code by Nore, WTFPL.
+Code by Nore, licensed under the CC-BY.
 Textures of CPU by kaeza, CC-BY-SA.
 Textures and nodebox of screen by kaeza, edited by Nore, WTFPL.
 Textures of floppy drive by kaeza, CC-BY-SA.

f.py

@@ -25,7 +25,7 @@ def to_int(x):
     except:
         return None
 
-def header(name):
+def header(name, lt=None):
     global here
     global latest
     memory[here] = 0
@@ -33,10 +33,14 @@ def header(name):
     for c in name.strip():
         memory[here] = ord(c)
         here += 1
+    if lt!=None:
+        setmemory(here, lt)
+    else:
         setmemory(here, latest)
     here += 2
     memory[here] = len(name)
     here += 1
+    if lt==None:
         latest = here
         df[name] = here
 
@@ -53,6 +57,42 @@ def compile_constant(name, value):
     memory[here] = 41
     here += 1
     
+def env_compile_2constant(name, value):
+    value=to_int(value)
+    global here
+    global env_latest
+    header(name, env_latest)
+    env_latest = here
+    memory[here] = 77
+    here += 1
+    setmemory(here, value&0xffff)
+    here += 2
+    memory[here] = 33
+    here += 1
+    memory[here] = 77
+    here += 1
+    setmemory(here, value>>16)
+    here += 2
+    memory[here] = 33
+    here += 1
+    memory[here] = 41
+    here += 1
+
+def env_compile_constant(name, value):
+    value=to_int(value)
+    global here
+    global env_latest
+    header(name, env_latest)
+    env_latest = here
+    memory[here] = 77
+    here += 1
+    setmemory(here, value)
+    here += 2
+    memory[here] = 33
+    here += 1
+    memory[here] = 41
+    here += 1
+
 ITABLE = {
 "IPOP":0x28,
 "NXT":0x29,
@@ -267,6 +307,12 @@ def compile_def(name, l, immed=False, save_in=None):
             setmemory(here, stack.pop())
             here += 2
             setmemory(stack.pop(), here)
+        elif word == "+LOOP":
+            setmemory(here, df["(+loop)"])
+            here += 2
+            setmemory(here, stack.pop())
+            here += 2
+            setmemory(stack.pop(), here)
         elif word == "QUIT":
             squit.append(here)
             here += 2
@@ -294,15 +340,24 @@ def compile_def(name, l, immed=False, save_in=None):
 memory=[0]*0x10000
 here=0x40c
 latest=0
+env_latest = 0
 state="forth"
 for i in lf:
     k = i.split()
     if len(k)>=1 and k[0] == "ASSEMBLER":
         state="assembler"
+    elif len(k)>=1 and k[0] == "ENVIRONMENT":
+        state="env"
     elif len(k)>=1 and k[0] == "FORTH":
         state="forth"
     elif len(k)>=3 and k[1] == "CONSTANT" and k[0]!=":":
+        if state == "env":
+            env_compile_constant(k[2], k[0])
+        else:
             compile_constant(k[2],k[0])
+    elif len(k)>=3 and k[1] == "2CONSTANT" and k[0]!=":":
+        if state == "env":
+            env_compile_2constant(k[2], k[0])
     elif len(k)>=3:
         #print(k[0])
         if k[0][0] == "\\":
@@ -335,6 +390,12 @@ setmemory(0x409, df["COLD"])
 memory[0x40b]=0x1a
 setmemory(0x10c, latest)
 setmemory(0x112, here)
+setmemory(0x1a6, 1)
+setmemory(0x1b0, latest)
+setmemory(0x1b2, env_latest)
+setmemory(0x1a4, 0x1b0)
+setmemory(0x1d0, 0x1b0)
+setmemory(0x1a2, 0x1b4)
 
 memory[0xff00]=0x4d
 memory[0xff01]=0x00

forth.fth

@@ -84,6 +84,24 @@ ASSEMBLER
 : SET-CHANNEL PLY PLX CHAN NXT ;
 : SEND PLY PLX SEND NXT ;
 
+ENVIRONMENT
+256 CONSTANT /COUNTED-STRING
+34 CONSTANT /HOLD
+84 CONSTANT /PAD
+8 CONSTANT ADRESS-UNIT-BITS
+-1 CONSTANT CORE
+-1 CONSTANT CORE-EXT
+-1 CONSTANT FLOORED
+255 CONSTANT MAX-CHAR
+32767 CONSTANT MAX-N
+-1 CONSTANT MAX-U
+128 CONSTANT RETURN-STACK-CELLS
+128 CONSTANT STACK-CELLS
+0xffffffff 2CONSTANT MAX-UD
+0x7fffffff 2CONSTANT MAX-D
+-1 CONSTANT SEARCH-ORDER
+-1 CONSTANT SEARCH-ORDER-EXT
+8 CONSTANT WORDLISTS
 
 FORTH
 32 CONSTANT BL
@@ -95,13 +113,19 @@ FORTH
 0x108 CONSTANT BASE
 0x10a CONSTANT STATE
 0x10c CONSTANT LATEST
-0x10e CONSTANT ENVDICO
 0x110 CONSTANT SPAN
 0x112 CONSTANT (here)
 0x114 CONSTANT LT
 0x116 CONSTANT #TIB
 0x118 CONSTANT TIB
 0x1a0 CONSTANT 'NUMBER
+0x1a2 CONSTANT NEW-WORDLIST
+0x1a4 CONSTANT CW
+0x1a6 CONSTANT NWORDER
+0x1b0 CONSTANT WORDLISTS
+0x1b0 CONSTANT FORTH-WORDLIST
+0x1b2 CONSTANT ENVDICO
+0x1d0 CONSTANT WORDER
 
 : CHARS ; IMMEDIATE
 : ALIGN ; IMMEDIATE
@@ -169,8 +193,8 @@ FORTH
 : THEN HERE SWAP ! ; IMMEDIATE
 : BEGIN HERE ; IMMEDIATE
 : FIND-WORD-DICO SWAP >R BEGIN DUP 4 - RSTR R@ = IF 2 PICK R@ STR= IF NIP R> DROP EXIT THEN ELSE DROP THEN 3 - @ DUP 0= UNTIL NIP R> DROP ;
-: FIND-WORD LATEST @ FIND-WORD-DICO ;
+: GET-WL-LATEST DUP CW @ = IF DROP LATEST @ ELSE @ THEN ;
-: FIND DUP COUNT FIND-WORD DUP IF NIP DUP 1- C@ 128 AND IF 1 ELSE -1 THEN THEN ;
+: FIND-WORD WORDER NWORDER @ 2* + WORDER DO I @ GET-WL-LATEST FIND-WORD-DICO ?DUP IF UNLOOP EXIT THEN 2 +LOOP 0 ;
 : ' PARSE-WORD FIND-WORD ;
 : POSTPONE ' DUP 1- C@ 128 AND IF , ELSE ['] (lit) , , ['] , , THEN ; IMMEDIATE
 : LITERAL ['] (lit) , , ; IMMEDIATE
@@ -245,4 +269,17 @@ FORTH
 : OFF SET-CHANNEL S" off" SEND ;
 : IO@ RECEIVE 3 < ;
 : LOADPKG 0 0x11e C! PARSE-WORD 0x11a 2! BEGIN 0x11a 2@ SET-CHANNEL 0x11e 1 SEND 0x11e C@ 1+ 0x11e C! 0x11a 2@ 16 RECEIVE-AT 16 C@ WHILE 16 SWAP EVALUATE REPEAT DROP ;
+: GET-CURRENT CW @ ;
+: SET-CURRENT LATEST @ CW @ ! DUP CW ! @ LATEST ! ;
+: WORDLIST NEW-WORDLIST @ DUP CELL+ NEW-WORDLIST ! ;
+: DEFINITIONS WORDER @ SET-CURRENT ;
+: GET-ORDER WORDER NWORDER @ 1- 2* + ?DO I @ -2 +LOOP NWORDER @ ;
+: SET-ORDER DUP NWORDER ! WORDER 0 ?DO TUCK ! CELL+ LOOP DROP ;
+: ALSO WORDER DUP CELL+ NWORDER @ 2* MOVE NWORDER 2 +! ;
+: FORTH FORTH-WORDLIST WORDER ! ;
+: ONLY FORTH 1 NWORDER ! ;
+: ORDER WORDER NWORDER @ 2* + WORDER DO I @ . 2 +LOOP CR CW @ ;
+: PREVIOUS WORDER CELL+ WORDER NWORDER @ 1- 2* MOVE NWORDER -2 +! ;
+: SEARCH-WORDLIST GET-WL-LATEST FIND-WORD-DICO DUP IF DUP 1- C@ 128 AND IF 1 ELSE -1 THEN THEN ;
+: FIND DUP COUNT WORDER NWORDER @ 2* + WORDER DO 2DUP I @ SEARCH-WORDLIST ?DUP IF 2>R 2DROP DROP 2R> UNLOOP EXIT THEN 2 +LOOP 2DROP 0 ;
 : COLD S" Computer is ready (" TYPE UNUSED U. S" bytes free)" TYPE QUIT ;

init.lua

@@ -25,6 +25,26 @@ local bit32 = loadpkg("bit32")
 dofile(modpath.."/computer_memory.lua")
 dofile(modpath.."/forth_floppy.lua")
 
+local wpath = minetest.get_worldpath()
+local function read_file(fn)
+	local f = io.open(fn, "r")
+	if f==nil then return {} end
+	local t = f:read("*all")
+	f:close()
+	if t=="" or t==nil then return {} end
+	return minetest.deserialize(t)
+end
+
+local function write_file(fn, tbl)
+	local f = io.open(fn, "w")
+	f:write(minetest.serialize(tbl))
+	f:close()
+end
+
+local cptrs = read_file(wpath.."/forth_computers")
+local oldcptrs = read_file(wpath.."/forth_computers")
+local screens = read_file(wpath.."/screens")
+
 function hacky_swap_node(pos,name)
    local node = minetest.get_node(pos)
    if node.name ~= name then
@@ -195,19 +215,33 @@ end
 local function send_message(pos, cptr, maddr, mlen)
 	local msg = string_at(cptr, maddr, mlen)
 	cptr.digiline_events[cptr.channel] = msg
-	--print(cptr.channel)
-	--print(msg)
 	digiline:receptor_send(pos, digiline.rules.default, cptr.channel, msg)
 end
 
 local function run_computer(pos,cptr)
+	local meta = minetest.get_meta(pos)
+	local oldpos = meta:get_string("pos")
+	if oldpos == "" then
+		return
+	end
+	oldpos = minetest.deserialize(oldpos)
+	if oldpos.x ~= pos.x or oldpos.y ~= pos.y or oldpos.z ~= pos.z then
+		local old_cptr = oldcptrs[hashpos(oldpos)]
+		for key, _ in pairs(oldcptrs) do
+			print(key)
+		end
+		meta:set_string("pos", minetest.serialize(pos))
+		print(hashpos(oldpos))
+		if old_cptr ~= nil then
+			cptrs[hashpos(pos)].cptr = old_cptr.cptr
+		end
+	end
 	if cptr.stopped then return end
 	cptr.cycles = math.max(MAX_CYCLES,cptr.cycles+CYCLES_PER_STEP)
 	while 1 do
 		instr = cptr[cptr.PC]
 		local f = ITABLE[instr]
 		if f == nil then return end
-		--print("Instr: "..tostring(instr).." PC:  "..tostring(cptr.PC).." SP: "..tostring(cptr.SP).." RP: "..tostring(cptr.RP).." X: "..tostring(cptr.X).." Y: "..tostring(cptr.Y).." Z: "..tostring(cptr.Z).." I: "..tostring(cptr.I))
 		cptr.PC = bit32.band(cptr.PC+1, 0xffff)
 		setfenv(f, {cptr = cptr, pos=pos, emit=emit, receive=receive, delete_message=delete_message, set_channel=set_channel, send_message=send_message, u16=u16, u32=u32, s16=s16, s32=s32, read=read, write=write, readC=readC, writeC=writeC, push=push, pop=pop, rpush=rpush, rpop=rpop, bit32=bit32, math=math})
 		f()
@@ -374,25 +408,6 @@ for i, v in pairs(ITABLE_RAW) do
 	ITABLE[i] = loadstring(v) -- Parse everything at the beginning, way faster
 end
 
-local wpath = minetest.get_worldpath()
-local function read_file(fn)
-	local f = io.open(fn, "r")
-	if f==nil then return {} end
-	local t = f:read("*all")
-	f:close()
-	if t=="" or t==nil then return {} end
-	return minetest.deserialize(t)
-end
-
-local function write_file(fn, tbl)
-	local f = io.open(fn, "w")
-	f:write(minetest.serialize(tbl))
-	f:close()
-end
-
-local cptrs = read_file(wpath.."/forth_computers")
-local screens = read_file(wpath.."/screens")
-
 local on_computer_digiline_receive = function (pos, node, channel, msg)
 	local cptr = cptrs[hashpos(pos)].cptr
 	if cptr == nil then return end
@@ -413,6 +428,8 @@ minetest.register_node("forth_computer:computer",{
 	on_construct = function(pos)
 		if cptrs[hashpos(pos)] then return end
 		cptrs[hashpos(pos)] = {pos=pos, cptr=create_cptr()}
+		local meta = minetest.get_meta(pos)
+		meta:set_string("pos", minetest.serialize(pos))
 	end,
 	on_destruct = function(pos)
 		if cptrs[hashpos(pos)] == nil then return end
@@ -420,6 +437,7 @@ minetest.register_node("forth_computer:computer",{
 			cptrs[hashpos(pos)].swapping = nil
 			return
 		end
+		oldcptrs[hashpos(pos)] = cptrs[hashpos(pos)]
 		cptrs[hashpos(pos)] = nil
 	end,
 	on_punch = function(pos, node, puncher)
@@ -445,6 +463,8 @@ minetest.register_node("forth_computer:computer_off",{
 	on_construct = function(pos)
 		if cptrs[hashpos(pos)] then return end
 		cptrs[hashpos(pos)] = {pos=pos, cptr=create_cptr()}
+		local meta = minetest.get_meta(pos)
+		meta:set_string("pos", minetest.serialize(pos))
 	end,
 	on_destruct = function(pos)
 		if cptrs[hashpos(pos)] == nil then return end
@@ -452,6 +472,7 @@ minetest.register_node("forth_computer:computer_off",{
 			cptrs[hashpos(pos)].swapping = nil
 			return
 		end
+		oldcptrs[hashpos(pos)] = cptrs[hashpos(pos)]
 		cptrs[hashpos(pos)] = nil
 	end,
 	on_punch = function(pos, node, puncher)
@@ -658,6 +679,7 @@ minetest.register_globalstep(function(dtime)
 	for _,i in pairs(cptrs) do
 		run_computer(i.pos, i.cptr)
 	end
+	oldcptrs = {}
 	for _,i in pairs(screens) do
 		if i.fmodif then
 			i.fmodif=false
@@ -675,6 +697,7 @@ minetest.register_on_shutdown(function()
 		i.pname = nil
 	end
 	write_file(wpath.."/forth_computers",cptrs)
+	write_file(wpath.."/old_forth_computers",oldcptrs)
 	write_file(wpath.."/screens",screens)
 end)