Initial commit

This commit is contained in:
Novatux 2013-07-04 19:35:29 +02:00
commit b0dbd68921
7 changed files with 66673 additions and 0 deletions

1
.gitignore vendored Normal file

@ -0,0 +1 @@
*~

3
README Normal file

@ -0,0 +1,3 @@
How to build
gcc bit32.c -shared -fpic -I../../src/lua/src -o bit32.so

302
bit32.c Normal file

@ -0,0 +1,302 @@
/*
* This is the bit32 library (lbitlib.c) from lua 5.2.0-alpha,
* backported to lua 5.1.4.
*
* version 5.2.0-alpha-backport1
*
* Copyright (C) 1994-2010 Lua.org, PUC-Rio. All rights reserved.
*
* Permission is hereby granted, free of charge, to any person obtaining
* a copy of this software and associated documentation files (the
* "Software"), to deal in the Software without restriction, including
* without limitation the rights to use, copy, modify, merge, publish,
* distribute, sublicense, and/or sell copies of the Software, and to
* permit persons to whom the Software is furnished to do so, subject to
* the following conditions:
*
* The above copyright notice and this permission notice shall be
* included in all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
* MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
* IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
* CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
* TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
* SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
*/
#define lbitlib_c
#define LUA_LIB
#include "lua.h"
#include "lauxlib.h"
#include "lualib.h"
/* ===== begin modifications to lbitlib.c ===== */
/* ----- adapted from lua-5.2.0-alpha luaconf.h: ----- */
/*
* @@ LUA_UNSIGNED is the integral type used by lua_pushunsigned/lua_tounsigned.
* ** It must have at least 32 bits.
* */
#define LUA_UNSIGNED unsigned LUAI_INT32
#if defined(LUA_NUMBER_DOUBLE) && !defined(LUA_ANSI) /* { */
/* On a Microsoft compiler on a Pentium, use assembler to avoid clashes
with a DirectX idiosyncrasy */
#if defined(_MSC_VER) && defined(M_IX86) /* { */
# define MS_ASMTRICK
#else /* }{ */
/* the next definition uses a trick that should work on any machine
using IEEE754 with a 32-bit integer type */
#define LUA_IEEE754TRICK
/*
@@ LUA_IEEEENDIAN is the endianness of doubles in your machine
@@ (0 for little endian, 1 for big endian); if not defined, Lua will
@@ check it dynamically.
*/
/* check for known architectures */
#if defined(__i386__) || defined(__i386) || defined(i386) || \
defined (__x86_64)
#define LUA_IEEEENDIAN 0
#elif defined(__POWERPC__) || defined(__ppc__)
#define LUA_IEEEENDIAN 1
#endif
#endif /* } */
#endif /* } */
/* ----- from lua-5.2.0-alpha lua.h: ----- */
typedef LUA_UNSIGNED lua_Unsigned;
/* ----- adapted from lua-5.2.0-alpha llimits.h: ----- */
/* lua_number2unsigned is a macro to convert a lua_Number to a lua_Unsigned.
** lua_unsigned2number is a macro to convert a lua_Unsigned to a lua_Number.
*/
#if defined(MS_ASMTRICK) /* { */
/* trick with Microsoft assembler for X86 */
#define lua_number2unsigned(i,n) \
{__int64 l; __asm {__asm fld n __asm fistp l} i = (unsigned int)l;}
#elif defined(LUA_IEEE754TRICK) /* }{ */
/* the next trick should work on any machine using IEEE754 with
a 32-bit integer type */
union luai_Cast2 { double l_d; LUAI_INT32 l_p[2]; };
#if !defined(LUA_IEEEENDIAN) /* { */
#define LUAI_EXTRAIEEE \
static const union luai_Cast2 ieeeendian = {-(33.0 + 6755399441055744.0)};
#define LUA_IEEEENDIAN (ieeeendian.l_p[1] == 33)
#else
#define LUAI_EXTRAIEEE /* empty */
#endif /* } */
#define lua_number2int32(i,n,t) \
{ LUAI_EXTRAIEEE \
volatile union luai_Cast2 u; u.l_d = (n) + 6755399441055744.0; \
(i) = (t)u.l_p[LUA_IEEEENDIAN]; }
#define lua_number2unsigned(i,n) lua_number2int32(i, n, lua_Unsigned)
#endif /* } */
#if !defined(lua_number2unsigned) /* { */
/* the following definition assures proper modulo behavior */
#if defined(LUA_NUMBER_DOUBLE)
#include <math.h>
#define SUPUNSIGNED ((lua_Number)(~(lua_Unsigned)0) + 1)
#define lua_number2unsigned(i,n) \
((i)=(lua_Unsigned)((n) - floor((n)/SUPUNSIGNED)*SUPUNSIGNED))
#else
#define lua_number2unsigned(i,n) ((i)=(lua_Unsigned)(n))
#endif
#endif /* } */
/* on several machines, coercion from unsigned to double is slow,
so it may be worth to avoid */
#define lua_unsigned2number(u) \
(((u) <= (lua_Unsigned)INT_MAX) ? (lua_Number)(int)(u) : (lua_Number)(u))
/* ----- adapted from lua-5.2.0-alpha lapi.c: ----- */
void lua_pushunsigned (lua_State *L, lua_Unsigned u) {
lua_Number n;
n = lua_unsigned2number(u);
lua_pushnumber(L, n);
}
/* ===== end modifications to lbitlib.c ===== */
/* number of bits to consider in a number */
#define NBITS 32
#define ALLONES (~(((~(lua_Unsigned)0) << (NBITS - 1)) << 1))
/* mask to trim extra bits */
#define trim(x) ((x) & ALLONES)
typedef lua_Unsigned b_uint;
/* ===== begin modifications to lbitlib.c ===== */
/* ----- adapted from lua-5.2.0-work3 lbitlib.c: ----- */
static b_uint getuintarg (lua_State *L, int arg) {
b_uint r;
lua_Number x = lua_tonumber(L, arg);
if (x == 0) luaL_checktype(L, arg, LUA_TNUMBER);
lua_number2unsigned(r, x);
return r;
}
/* ===== end modifications to lbitlib.c ===== */
static b_uint andaux (lua_State *L) {
int i, n = lua_gettop(L);
b_uint r = ~(b_uint)0;
for (i = 1; i <= n; i++)
r &= getuintarg(L, i);
return trim(r);
}
static int b_and (lua_State *L) {
b_uint r = andaux(L);
lua_pushunsigned(L, r);
return 1;
}
static int b_test (lua_State *L) {
b_uint r = andaux(L);
lua_pushboolean(L, r != 0);
return 1;
}
static int b_or (lua_State *L) {
int i, n = lua_gettop(L);
b_uint r = 0;
for (i = 1; i <= n; i++)
r |= getuintarg(L, i);
lua_pushunsigned(L, trim(r));
return 1;
}
static int b_xor (lua_State *L) {
int i, n = lua_gettop(L);
b_uint r = 0;
for (i = 1; i <= n; i++)
r ^= getuintarg(L, i);
lua_pushunsigned(L, trim(r));
return 1;
}
static int b_not (lua_State *L) {
b_uint r = ~getuintarg(L, 1);
lua_pushunsigned(L, trim(r));
return 1;
}
static int b_shift (lua_State *L, b_uint r, int i) {
if (i < 0) { /* shift right? */
i = -i;
r = trim(r);
if (i >= NBITS) r = 0;
else r >>= i;
}
else { /* shift left */
if (i >= NBITS) r = 0;
else r <<= i;
r = trim(r);
}
lua_pushunsigned(L, r);
return 1;
}
static int b_lshift (lua_State *L) {
return b_shift(L, getuintarg(L, 1), luaL_checkint(L, 2));
}
static int b_rshift (lua_State *L) {
return b_shift(L, getuintarg(L, 1), -luaL_checkint(L, 2));
}
static int b_arshift (lua_State *L) {
b_uint r = getuintarg(L, 1);
int i = luaL_checkint(L, 2);
if (i < 0 || !(r & ((b_uint)1 << (NBITS - 1))))
return b_shift(L, r, -i);
else { /* arithmetic shift for 'negative' number */
if (i >= NBITS) r = ALLONES;
else
r = trim((r >> i) | ~(~(b_uint)0 >> i)); /* add signal bit */
lua_pushunsigned(L, r);
return 1;
}
}
static int b_rot (lua_State *L, int i) {
b_uint r = getuintarg(L, 1);
i &= (NBITS - 1); /* i = i % NBITS */
r = trim(r);
r = (r << i) | (r >> (NBITS - i));
lua_pushunsigned(L, trim(r));
return 1;
}
static int b_lrot (lua_State *L) {
return b_rot(L, luaL_checkint(L, 2));
}
static int b_rrot (lua_State *L) {
return b_rot(L, -luaL_checkint(L, 2));
}
static const luaL_Reg bitlib[] = {
{"arshift", b_arshift},
{"band", b_and},
{"bnot", b_not},
{"bor", b_or},
{"bxor", b_xor},
{"lrotate", b_lrot},
{"lshift", b_lshift},
{"rrotate", b_rrot},
{"rshift", b_rshift},
{"btest", b_test},
{NULL, NULL}
};
int luaopen_bit32 (lua_State *L) {
luaL_register(L, "bit32", bitlib);
return 1;
}

65540
computer_memory.lua Normal file

File diff suppressed because it is too large Load Diff

269
f.py Normal file

@ -0,0 +1,269 @@
f = open('forth.fth','r')
lf = f.readlines()
f.close()
df = {}
def setmemory(addr, value):
memory[addr] = value&0xff
memory[addr+1] = (value>>8)&0xff
def to_int(x):
if x[:2]=="0x":
try:
a=int(x[2:],16)
return a
except:
return None
try:
a=int(x)
return a
except:
return None
def header(name):
global here
global latest
memory[here] = 0
here += 1
for c in name.strip():
memory[here] = ord(c)
here += 1
setmemory(here, latest)
here += 2
memory[here] = len(name)
here += 1
latest = here
df[name] = here
def compile_constant(name, value):
value=to_int(value)
global here
header(name)
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,
"CALL":0x2a,
"CRX":0x2b,
"TSX":0x08,
"TRX":0x09,
"TPX":0x0a,
"TIX":0x0b,
"BRK":0x00,
"RPHX":0x01,
"RPHY":0x02,
"RPHZ":0x03,
"RPX":0x10,
"RPLX":0x11,
"RPLY":0x12,
"RPLZ":0x13,
"PSX":0x20,
"PHX":0x21,
"PHY":0x22,
"PHZ":0x23,
"SPX":0x30,
"PLX":0x31,
"PLY":0x32,
"PLZ":0x33,
"RXX":0x04,
"RXY":0x05,
"RYX":0x06,
"RYY":0x07,
"CRXX":0x14,
"CRXY":0x15,
"CRYX":0x16,
"CRYY":0x17,
"WXY":0x25,
"WYX":0x26,
"CWXY":0x35,
"CWYX":0x36,
}"""
def compile_assembly(name, l):
global here
header(name)
for inst in l:
memory[here] = to_int(inst)
#memory[here] = ITABLE[inst]
here += 1
squit = []
def compile_def(name, l, immed=False):
global here
global squit
header(name)
if immed:
memory[here-1] |= 128
memory[here] = 42
here += 1
i = 0
stack = []
#print(name)
while i<len(l):
#print(stack)
word = l[i]
i += 1
if to_int(word)!=None:
setmemory(here, df["(lit)"])
here += 2
setmemory(here, to_int(word))
here += 2
elif word == "POSTPONE":
nw = l[i]
i += 1
setmemory(here, df[nw])
here += 2
elif word == "LITERAL":
setmemory(here, df["(lit)"])
here += 2
setmemory(here, stack.pop())
here += 2
elif word == "[']":
setmemory(here, df["(lit)"])
here += 2
nw = l[i]
i += 1
setmemory(here, df[nw])
here += 2
elif word == "[COMPILE]":
setmemory(here, df["(lit)"])
here += 2
nw = l[i]
i += 1
setmemory(here, df[nw])
here += 2
setmemory(here, df[","])
here += 2
elif word == "IF":
setmemory(here, df["(0branch)"])
here += 2
stack.append(here)
setmemory(here, 0)
here += 2
elif word == "ELSE":
setmemory(here, df["(branch)"])
here += 2
n = stack.pop()
stack.append(here)
setmemory(here, 0)
here += 2
setmemory(n, here)
elif word == "THEN":
setmemory(stack.pop(), here)
elif word == "BEGIN":
stack.append(here)
elif word == "UNTIL":
setmemory(here, df["(0branch)"])
here += 2
setmemory(here, stack.pop())
here += 2
elif word == "REPEAT":
setmemory(here, df["(branch)"])
here += 2
setmemory(here, stack.pop())
here += 2
setmemory(stack.pop(), here)
elif word == "AGAIN":
setmemory(here, df["(branch)"])
here += 2
setmemory(here, stack.pop())
here += 2
elif word == "WHILE":
setmemory(here, df["(0branch)"])
here += 2
n = stack.pop()
stack.append(here)
stack.append(n)
setmemory(here, 0)
here += 2
elif word == "DO":
setmemory(here, df["(do)"])
here += 2
stack.append(here)
here += 2
stack.append(here)
elif word == "?DO":
setmemory(here, df["(?do)"])
here += 2
stack.append(here)
here += 2
stack.append(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
else:
setmemory(here, df[word])
here += 2
setmemory(here, df["EXIT"])
here += 2
memory=[0]*0x10000
here=0x404
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] == "FORTH":
state="forth"
elif len(k)>=3 and k[1] == "CONSTANT" and k[0]!=":":
compile_constant(k[2],k[0])
elif len(k)>=3:
#print(k[0])
if k[0][0] == "\\":
continue
if state=="forth":
if k[-1] == "IMMEDIATE":
compile_def(k[1],k[2:-2],True)
else:
compile_def(k[1],k[2:-1])
else:
compile_assembly(k[1],k[2:-1])
for i in squit:
setmemory(i, df["QUIT"])
memory[0x108]=10
memory[0x400]=0x4d
setmemory(0x401, df["COLD"])
memory[0x403]=0x1a
setmemory(0x10c, latest)
setmemory(0x112, here)
def getc(i):
for key,k in df.items():
if k==i:
return key
f = open('computer_memory.lua','w')
f.write("function create_cptr_memory()\n\treturn {\n")
for i in range(len(memory)):
f.write("\t\t["+str(i)+"] = "+str(memory[i])+",\n")
f.write("\t}\nend")
f.close()

233
forth.fth Normal file

@ -0,0 +1,233 @@
ASSEMBLER
: EXIT 0x28 0x29 ;
: (lit) 0x2b 0x21 0x29 ;
: DUP 0x30 0x21 0x29 ;
: SWAP 0x31 0x32 0x21 0x22 0x29 ;
: ROT 0x31 0x32 0x33 0x22 0x21 0x23 0x29 ;
: -ROT 0x31 0x32 0x33 0x21 0x23 0x22 0x29 ;
: OVER 0x32 0x30 0x22 0x21 0x29 ;
: PICK 0x32 0x44 0x0c 0x08 0x0d 0x07 0x22 0x29 ;
: DROP 0x31 0x29 ;
: 2DROP 0x31 0x31 0x29 ;
: 2DUP 0x32 0x30 0x22 0x21 0x22 0x29 ;
: 2SWAP 0x31 0x32 0x33 0x03 0x33 0x22 0x21 0x23 0x13 0x23 0x29 ;
: 2OVER 0x33 0x03 0x33 0x32 0x30 0x22 0x23 0x13 0x23 0x21 0x22 0x29 ;
: NIP 0x31 0x20 0x29 ;
: TUCK 0x31 0x32 0x21 0x22 0x21 0x29 ;
: ?DUP 0x30 0x39 0x01 0x00 0x29 0x21 0x29 ;
: >R 0x31 0x01 0x29 ;
: R> 0x11 0x21 0x29 ;
: R@ 0x10 0x21 0x29 ;
: ! 0x32 0x31 0x26 0x29 ;
: C! 0x32 0x31 0x36 0x29 ;
: @ 0x30 0x04 0x20 0x29 ;
: C@ 0x30 0x14 0x20 0x29 ;
: AND 0x32 0x30 0x2c 0x20 0x29 ;
: OR 0x32 0x30 0x2d 0x20 0x29 ;
: XOR 0x32 0x30 0x2e 0x20 0x29 ;
: INVERT 0x30 0x2f 0x20 0x29 ;
: (branch) 0x2b 0x1b 0x29 ;
: (0branch) 0x32 0x2b 0x3a 0x01 0x00 0x1b 0x29 ;
: ROLL 0x32 0x41 0x4b 0x44 0x0c 0x08 0x0d 0x05 0x21 0x31 0x44 0x4a 0x4a 0x07 0x25 0x49 0x49 0x45 0x48 0x3b 0xf5 0xff 0x29 ;
: + 0x32 0x31 0x0c 0x22 0x29 ;
: - 0x32 0x31 0x0d 0x22 0x29 ;
: +! 0x32 0x41 0x07 0x31 0x0c 0x42 0x25 0x29 ;
: * 0x32 0x31 0x0e 0x22 0x29 ;
: U< 0x32 0x30 0x0d 0x20 0x29 ;
: U> 0x31 0x32 0x0d 0x21 0x29 ;
: M* 0x32 0x31 0x0f 0x22 0x21 0x29 ;
: UM* 0x32 0x31 0x0e 0x22 0x21 0x29 ;
: 0= 0x30 0x39 0x03 0x00 0x2f 0x20 0x29 0x4d 0x00 0x00 0x20 0x29 ;
: 0<> 0x30 0x39 0x01 0x00 0x29 0x4d 0xff 0xff 0x20 0x29 ;
: 0< 0x32 0x3f 0x21 0x29 ;
: 0> 0x32 0x3a 0x02 0x00 0x22 0x29 0x3f 0x2f 0x21 0x29 ;
: <> 0x32 0x30 0x0d 0x3a 0x02 0x00 0x20 0x29 0x4d 0xff 0xff 0x20 0x29 ;
: = 0x32 0x30 0x0d 0x3a 0x05 0x00 0x4d 0xff 0xff 0x20 0x29 0x4d 0x00 0x00 0x20 0x29 ;
: EMPTYR 0x4d 0x00 0x03 0x19 0x29 ;
: EMPTYS 0x4d 0x00 0x02 0x18 0x29 ;
: DEPTH 0x08 0x4e 0x00 0x02 0x0d 0x44 0x4e 0x01 0x00 0x3d 0x21 0x29 ;
: 2* 0x4e 0x01 0x00 0x30 0x3e 0x20 0x29 ;
: 2/ 0x4e 0x01 0x00 0x30 0x3d 0x20 0x29 ;
: RSHIFT 0x32 0x30 0x3c 0x20 0x29 ;
: LSHIFT 0x32 0x30 0x3e 0x20 0x29 ;
: 2>R 0x32 0x31 0x01 0x02 0x29 ;
: 2R> 0x12 0x11 0x21 0x22 0x29 ;
: 2R@ 0x12 0x10 0x02 0x21 0x22 0x29 ;
: 1+ 0x30 0x49 0x20 0x29 ;
: 1- 0x30 0x46 0x20 0x29 ;
: EXECUTE 0x31 0x1a ;
: */MOD 0x33 0x32 0x31 0x0f 0x1f 0x23 0x22 0x29 ;
: */ 0x33 0x32 0x31 0x0f 0x1f 0x22 0x29 ;
: /MOD 0x33 0x32 0x3f 0x1f 0x23 0x22 0x29 ;
: / 0x33 0x32 0x3f 0x1f 0x22 0x29 ;
: MOD 0x33 0x32 0x3f 0x1f 0x23 0x29 ;
: UM/MOD 0x33 0x31 0x32 0x1e 0x23 0x22 0x29 ;
: FM/MOD 0x33 0x31 0x32 0x1f 0x23 0x22 0x29 ;
: O+ 0x32 0x31 0x0c 0x22 0x21 0x29 ;
: UDM/MOD 0x33 0x31 0x32 0x1e 0x23 0x22 0x21 0x29 ;
\ : RAWKEY 0x50 0x21 0x29 ;
: EMIT 0x31 0x51 0x29 ;
: < 0x32 0x3f 0x41 0x32 0x22 0x2e 0x45 0x3f 0x2f 0x39 0x04 0x00 0x32 0x3f 0x21 0x29 0x31 0x43 0x0d 0x21 0x29 ;
: > 0x31 0x32 0x21 0x3f 0x41 0x32 0x22 0x2e 0x45 0x3f 0x2f 0x39 0x04 0x00 0x32 0x3f 0x21 0x29 0x31 0x43 0x0d 0x21 0x29 ;
: NEGATE 0x32 0x4d 0x00 0x00 0x0d 0x22 0x29 ;
: (do) 0x2b 0x01 0x32 0x33 0x03 0x02 0x29 ;
: (?do) 0x2b 0x01 0x40 0x32 0x31 0x01 0x02 0x0d 0x42 0x3a 0x04 0x00 0x12 0x12 0x12 0x1b 0x29 ;
: I 0x10 0x21 0x29 ;
: J 0x13 0x12 0x22 0x12 0x10 0x02 0x32 0x02 0x03 0x21 0x29 ;
: UNLOOP 0x12 0x12 0x12 0x29 ;
: (loop) 0x12 0x4a 0x10 0x02 0x0d 0x2b 0x3a 0x04 0x00 0x12 0x12 0x12 0x29 0x1b 0x29 ;
: (+loop) 0x12 0x41 0x31 0x0c 0x10 0x46 0x02 0x43 0x40 0x0d 0x3f 0x21 0x42 0x12 0x02 0x0d 0x3f 0x32 0x2e 0x45 0x2b 0x3a 0x02 0x00 0x1b 0x29 0x12 0x12 0x12 0x29 ;
: WAIT 0x00 0x29 ;
: WAIT-INPUT 0x50 0x29 ;
: LEAVE 0x11 0x11 0x11 0x1b 0x29 ;
FORTH
32 CONSTANT BL
0 CONSTANT FALSE
-1 CONSTANT TRUE
0x100 CONSTANT (source)
0x104 CONSTANT >IN
0x106 CONSTANT SOURCE-ID
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
: CHARS ;
: ALIGN ;
: ALIGNED ;
: CELL+ 2 + ;
: CELL- 2 - ;
: CHAR+ 1+ ;
: CELLS 2* ;
: 2! SWAP OVER ! CELL+ ! ;
: 2@ DUP CELL+ @ SWAP @ ;
: SOURCE (source) 2@ ;
: S>D DUP 0< ;
: MAX 2DUP > IF DROP ELSE NIP THEN ;
: MIN 2DUP > IF NIP ELSE DROP THEN ;
: D+ ROT + -ROT O+ ROT + ;
: HEX 16 BASE ! ;
: DECIMAL 10 BASE ! ;
: TUCK SWAP OVER ;
: NIP SWAP DROP ;
: ABS DUP 0< IF NEGATE THEN ;
: (marker) LATEST ! (here) ! ;
: TYPE DUP 0> IF OVER + SWAP DO I C@ EMIT LOOP ELSE 2DROP THEN ;
: RSTR 1+ DUP 2 + C@ 127 AND TUCK - SWAP ;
: CR 10 EMIT ;
: SPACE 32 EMIT ;
: SPACES DUP 0> IF 0 DO SPACE LOOP ELSE DROP THEN ;
: STR= 0 DO OVER C@ OVER C@ <> IF UNLOOP 2DROP FALSE EXIT THEN SWAP 1+ SWAP 1+ LOOP 2DROP TRUE ;
: IMMEDIATE LATEST @ 1- DUP C@ 128 OR SWAP C! ;
: HERE (here) @ ;
: [ FALSE STATE ! ; IMMEDIATE
: ] TRUE STATE ! ;
: ALLOT (here) +! ;
: , HERE ! 2 ALLOT ;
: C, HERE C! 1 ALLOT ;
: SKIP-WHITE BEGIN DUP C@ 33 < WHILE 1+ 2DUP = IF EXIT THEN REPEAT ;
: EXIT-IF-END SOURCE NIP >IN @ = IF SOURCE + 0 R> DROP THEN ;
: PARSE-LIMITS SOURCE OVER + SWAP >IN @ + ;
: >IN-END SOURCE NIP >IN ! ;
: COUNTED-STRING DUP HERE C! HERE 1+ -ROT OVER + SWAP DO I C@ OVER C! 1+ LOOP DROP HERE ;
: PARSE-WORD EXIT-IF-END PARSE-LIMITS SKIP-WHITE 2DUP = IF >IN-END DROP 0 EXIT THEN DUP >R BEGIN DUP C@ 32 > WHILE 1+ 2DUP = IF >IN-END DROP R@ - R> SWAP EXIT THEN REPEAT NIP DUP SOURCE DROP - 1+ >IN ! R@ - R> SWAP ;
: PARSE SOURCE NIP >IN @ = IF DROP SOURCE + 0 EXIT THEN PARSE-LIMITS DUP >R ROT >R BEGIN DUP C@ R@ <> WHILE 1+ 2DUP = IF R> DROP >IN-END DROP R@ - R> SWAP EXIT THEN REPEAT R> DROP NIP DUP SOURCE DROP - 1+ >IN ! R@ - R> SWAP ;
\ TODO: Fix WORD not skipping leading delimiters
: WORD SOURCE NIP >IN @ = IF DROP 0 HERE C! HERE EXIT THEN PARSE-LIMITS DUP >R ROT >R BEGIN DUP C@ R@ <> WHILE 1+ 2DUP = IF R> DROP >IN-END DROP R@ - R> SWAP EXIT THEN REPEAT R> DROP NIP DUP SOURCE DROP - 1+ >IN ! R@ - R> SWAP COUNTED-STRING ;
: HEADER PARSE-WORD TUCK 0 C, OVER + SWAP DO I C@ C, LOOP LATEST @ , C, ;
: : HEADER HERE DUP LT ! 42 C, ] ;
: UNUSED HERE NEGATE ;
: NCHAR DUP C@ DUP 58 < IF 48 - ELSE DUP 97 < IF 55 - ELSE 87 - THEN THEN ;
: >NUMBER DUP >R 0 DO NCHAR DUP BASE @ < OVER 0< INVERT AND IF 2SWAP BASE @ * 0 SWAP ROT BASE @ UM* D+ ROT 0 D+ ROT 1+ ELSE DROP I UNLOOP R> SWAP - EXIT THEN LOOP R> DROP 0 ;
: NUMBER 0 0 2SWAP OVER C@ 45 = IF SWAP 1+ SWAP 1- >NUMBER 2SWAP DROP NEGATE -ROT ELSE >NUMBER ROT DROP THEN ;
: SAVE-INPUT >IN @ 1 ;
: RESTORE-INPUT DUP 1 = IF DROP >IN ! FALSE ELSE 0 ?DO DROP LOOP TRUE THEN ;
: COUNT DUP 1+ SWAP C@ ;
: CHAR PARSE-WORD DROP C@ ;
: FILL -ROT DUP 0> IF OVER + SWAP DO DUP I C! LOOP ELSE 2DROP THEN DROP ;
: ERASE 0 FILL ;
: ( 41 PARSE 2DROP ; IMMEDIATE
: .( 41 PARSE TYPE ; IMMEDIATE
: \ 10 PARSE 2DROP ; IMMEDIATE
: 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 ;
: FIND COUNT OVER SWAP FIND-WORD DUP IF NIP DUP 1- C@ 128 AND IF 1 ELSE -1 THEN THEN ;
: ' PARSE-WORD FIND-WORD ;
: POSTPONE ' DUP 1- C@ 128 AND IF , ELSE ['] (lit) , , ['] , , THEN ; IMMEDIATE
: LITERAL ['] (lit) , , ; IMMEDIATE
: (dodoes) ['] (branch) LATEST @ 1+ ! LATEST @ 7 + R@ CELL+ ! R> LATEST @ 3 + ! ;
: DOES> ['] (dodoes) , ['] (lit) , 0 , ; IMMEDIATE
: ['] ' POSTPONE LITERAL ; IMMEDIATE
: [COMPILE] ' , ; IMMEDIATE
: ; ['] EXIT , LATEST ! POSTPONE [ ; IMMEDIATE
: [CHAR] CHAR POSTPONE LITERAL ; IMMEDIATE
: CREATE HEADER HERE LATEST ! 42 C, HERE 6 + POSTPONE LITERAL ['] EXIT , ;
: VARIABLE CREATE 2 ALLOT ;
: CONSTANT HEADER HERE LATEST ! 77 C, , 33 C, 41 C, ;
: MARKER HERE HEADER HERE SWAP 42 C, POSTPONE LITERAL LATEST @ POSTPONE LITERAL ['] (marker) , ['] EXIT , LATEST ! ;
: IF ['] (0branch) , HERE 0 , ; IMMEDIATE
: ELSE ['] (branch) , HERE SWAP 0 , HERE SWAP ! ; IMMEDIATE
: UNTIL ['] (0branch) , , ; IMMEDIATE
: REPEAT ['] (branch) , , HERE SWAP ! ; IMMEDIATE
: WHILE ['] (0branch) , HERE SWAP 0 , ; IMMEDIATE
: CASE 0 ; IMMEDIATE
: ENDCASE ['] DROP , BEGIN DUP 0<> WHILE HERE SWAP ! REPEAT DROP ; IMMEDIATE
: OF ['] OVER , ['] = , ['] (0branch) , HERE 0 , ['] DROP , ; IMMEDIATE
: ENDOF ['] (branch) , HERE 0 , HERE ROT ! ; IMMEDIATE
: S" 34 PARSE ['] (branch) , HERE 0 , -ROT 2DUP OVER + SWAP ?DO I C@ C, LOOP NIP SWAP DUP HERE SWAP ! 2 + POSTPONE LITERAL POSTPONE LITERAL ; IMMEDIATE
: PAD HERE 36 + ;
: VALUE HEADER HERE LATEST ! 77 C, , 33 C, 41 C, ;
: TO PARSE-WORD FIND-WORD 1+ STATE @ IF POSTPONE LITERAL ['] ! , ELSE ! THEN ; IMMEDIATE
: COMPILE, , ;
: AGAIN ['] (branch) , , ;
: ABORT EMPTYS QUIT ;
: COMPILE-WORD 2DUP FIND-WORD ?DUP IF -ROT 2DROP DUP 1- C@ 128 AND IF EXECUTE ELSE , THEN ELSE 2DUP NUMBER 0= IF DROP -ROT 2DROP POSTPONE LITERAL ELSE 2DROP TYPE SPACE 63 EMIT ABORT THEN THEN ;
: COUNT DUP 1+ SWAP C@ ;
: RECURSE LT @ , ; IMMEDIATE
: :NONAME HERE DUP LT ! 42 C, LATEST @ ] ;
: >BODY 7 + ;
: ENVIRONMENT? ENVDICO @ FIND-WORD-DICO DUP IF EXECUTE TRUE THEN ;
: D0= 0= SWAP 0= AND ;
: HOLD HERE @ 1- DUP HERE ! C! ;
: # BASE @ UDM/MOD ROT DUP 9 > IF 55 + ELSE 48 + THEN HOLD ;
: #S BEGIN # 2DUP D0= UNTIL ;
: ." POSTPONE S" ['] TYPE , ; IMMEDIATE
: C" 34 PARSE ['] (branch) , HERE 0 , -ROT HERE -ROT DUP C, OVER + SWAP ?DO I C@ C, LOOP SWAP HERE SWAP ! POSTPONE LITERAL ; IMMEDIATE
: <# PAD HERE ! ;
: #> 2DROP HERE @ PAD OVER - ;
: SIGN 0< IF 45 HOLD THEN ;
: CONVERT -1 >NUMBER DROP ;
: MOVE DUP 0= IF DROP 2DROP EXIT THEN -ROT 2DUP U> IF ROT 0 DO OVER C@ OVER C! 1+ SWAP 1+ SWAP LOOP ELSE 2 PICK TUCK + -ROT + SWAP ROT 0 DO 1- SWAP 1- SWAP OVER C@ OVER C! LOOP THEN 2DROP ;
: . DUP >R ABS 0 <# BL HOLD #S R> SIGN #> TYPE ;
: U. 0 <# BL HOLD #S #> TYPE ;
: .R >R DUP >R ABS 0 <# BL HOLD #S R> SIGN #> R> OVER - SPACES TYPE ;
: U.R >R 0 <# BL HOLD #S #> R> OVER - SPACES TYPE ;
: WITHIN OVER - >R - R> U< ;
: DO ['] (do) , HERE 0 , HERE ; IMMEDIATE
: ?DO ['] (?do) , HERE 0 , HERE ; IMMEDIATE
: LOOP ['] (loop) , , HERE SWAP ! ; IMMEDIATE
: +LOOP ['] (+loop) , , HERE SWAP ! ; IMMEDIATE
: ACCEPT WAIT-INPUT 0 @ MIN 16 -ROT MOVE ;
: EXPECT ACCEPT SPAN ! ;
: QUERY 0 >IN ! 0 SOURCE-ID ! TIB DUP 80 ACCEPT SPACE (source) 2! ;
: REFILL SOURCE-ID @ IF FALSE ELSE 0 >IN ! TIB DUP 80 ACCEPT SPACE (source) 2! TRUE THEN ;
: INTERPRET-WORD 2DUP FIND-WORD ?DUP IF -ROT 2DROP EXECUTE ELSE 2DUP NUMBER 0= IF DROP -ROT 2DROP ELSE 2DROP TYPE SPACE 63 EMIT ABORT THEN THEN ;
: EVALUATE SOURCE 2>R >IN @ >R SOURCE-ID @ >R -1 SOURCE-ID ! 0 >IN ! (source) 2! BEGIN PARSE-WORD ?DUP WHILE STATE @ IF COMPILE-WORD ELSE INTERPRET-WORD THEN REPEAT DROP R> SOURCE-ID ! R> >IN ! 2R> (source) 2! ;
: QUIT EMPTYR CR BEGIN REFILL WHILE BEGIN PARSE-WORD ?DUP WHILE STATE @ IF COMPILE-WORD ELSE INTERPRET-WORD THEN REPEAT DROP SPACE 79 EMIT 75 EMIT CR REPEAT ;
: (abort") ROT IF TYPE ABORT THEN 2DROP ;
: ABORT" POSTPONE S" ['] (abort") , ; IMMEDIATE
: DABS DUP 0< IF OVER NEGATE ROT IF SWAP INVERT ELSE SWAP NEGATE THEN THEN ;
: SM/REM OVER >R 2DUP XOR >R ABS >R DABS R> UM/MOD R> 0< IF NEGATE THEN SWAP R> 0< IF NEGATE THEN SWAP ;
\ : KEY BEGIN RAWKEY DUP 31 > OVER 127 < AND IF EXIT THEN DROP AGAIN ;
: COLD 82 EMIT 101 EMIT 97 EMIT 100 EMIT 121 EMIT QUIT ;

325
init.lua Normal file

@ -0,0 +1,325 @@
CYCLES_PER_STEP = 1000
MAX_CYCLES = 100000
local modpath = minetest.get_modpath("forth_computer")
package.cpath = modpath.."/?.so;"..modpath.."/?.dll;"..package.cpath;
local bit32 = require 'bit32';
dofile(modpath.."/computer_memory.lua")
local function s16(x)
if bit32.band(x, 0x8000)~=0 then
return bit32.band(x, 0xffff)-0x10000
end
return bit32.band(x, 0xffff)
end
local function u16(x)
return bit32.band(x, 0xffff)
end
local function s32(x)
if bit32.band(x, 0x80000000)~=0 then
return bit32.band(x, 0xffffffff)-0x100000000
end
return bit32.band(x, 0xffffffff)
end
local function u32(x)
return bit32.band(x, 0xffffffff)
end
function lines(str)
local t = {}
local function helper(line) table.insert(t, line) return "" end
helper((str:gsub("(.-)\r?\n", helper)))
return t
end
function newline(text, toadd)
local f = lines(text)
table.insert(f, toadd)
return table.concat(f, "\n", 2)
end
local function readC(cptr, addr)
return cptr[addr]
end
local function writeC(cptr, addr, value)
cptr[addr] = bit32.band(value, 0xff)
end
local function read(cptr, addr)
return cptr[addr] + 256*cptr[u16(addr+1)]
end
local function write(cptr, addr, value)
cptr[addr] = bit32.band(value, 0xff)
cptr[addr+1] = bit32.band(value, 0xff00)/256
end
local function push(cptr, value)
cptr.SP = u16(cptr.SP+2)
write(cptr, cptr.SP, value)
end
local function pop(cptr, value)
local n = read(cptr, cptr.SP)
cptr.SP = u16(cptr.SP-2)
return n
end
local function rpush(cptr, value)
cptr.RP = u16(cptr.RP+2)
write(cptr, cptr.RP, value)
end
local function rpop(cptr, value)
local n = read(cptr, cptr.RP)
cptr.RP = u16(cptr.RP-2)
return n
end
local function emit(pos, c, cptr)
local s = string.char(bit32.band(c, 0xff))
local meta = minetest.get_meta(pos)
local text = meta:get_string("text")
local ls = lines(text)
local ll = ls[#ls]
if s=="\n" or s=="\r" then
meta:set_string("text", newline(text,""))
elseif string.len(ll)>=52 then
meta:set_string("text", newline(text, s))
else
meta:set_string("text", text..s)
end
cptr.fmodif = true
end
local function run_computer(pos,cptr)
cptr.cycles = math.max(MAX_CYCLES,cptr.cycles+CYCLES_PER_STEP)
while 1 do
instr = cptr[cptr.PC]
--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)
local f = ITABLE[instr]
setfenv(f, {cptr = cptr, pos=pos, emit=emit, 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()
cptr.cycles = cptr.cycles - 1
if cptr.paused or cptr.cycles == 0 then
cptr.paused = false
return
end
end
end
local function create_cptr()
local cptr = create_cptr_memory()
cptr.X = 0
cptr.Y = 0
cptr.Z = 0
cptr.I = 0
cptr.PC = 0x400
cptr.RP = 0x300
cptr.SP = 0x200
cptr.paused = false
cptr.has_input = false
cptr.cycles = 0
return cptr
end
ITABLE_RAW = {
[0x28] = "cptr.I = rpop(cptr)",
[0x29] = "cptr.PC = read(cptr, cptr.I); cptr.I = u16(cptr.I+2)",
[0x2a] = "rpush(cptr, cptr.I); cptr.I = u16(cptr.PC+2); cptr.PC=read(cptr, cptr.PC)",
[0x2b] = "cptr.X = read(cptr, cptr.I); cptr.I = u16(cptr.I+2)",
[0x08] = "cptr.X = cptr.SP",
[0x09] = "cptr.X = cptr.RP",
[0x0a] = "cptr.X = cptr.PC",
[0x0b] = "cptr.X = cptr.I",
[0x00] = "cptr.paused = true",
[0x01] = "rpush(cptr, cptr.X)",
[0x02] = "rpush(cptr, cptr.Y)",
[0x03] = "rpush(cptr, cptr.Z)",
[0x10] = "cptr.X = read(cptr, cptr.RP)",
[0x11] = "cptr.X = rpop(cptr)",
[0x12] = "cptr.Y = rpop(cptr)",
[0x13] = "cptr.Z = rpop(cptr)",
[0x20] = "write(cptr, cptr.SP, cptr.X)",
[0x21] = "push(cptr, cptr.X)",
[0x22] = "push(cptr, cptr.Y)",
[0x23] = "push(cptr, cptr.Z)",
[0x30] = "cptr.X = read(cptr, cptr.SP)",
[0x31] = "cptr.X = pop(cptr)",
[0x32] = "cptr.Y = pop(cptr)",
[0x33] = "cptr.Z = pop(cptr)",
[0x04] = "cptr.X = read(cptr, cptr.X)",
[0x05] = "cptr.X = read(cptr, cptr.Y)",
[0x06] = "cptr.Y = read(cptr, cptr.X)",
[0x07] = "cptr.Y = read(cptr, cptr.Y)",
[0x14] = "cptr.X = readC(cptr, cptr.X)",
[0x15] = "cptr.X = readC(cptr, cptr.Y)",
[0x16] = "cptr.Y = readC(cptr, cptr.X)",
[0x17] = "cptr.Y = readC(cptr, cptr.Y)",
[0x25] = "write(cptr, cptr.X, cptr.Y)",
[0x26] = "write(cptr, cptr.Y, cptr.X)",
[0x35] = "writeC(cptr, cptr.X, cptr.Y)",
[0x36] = "writeC(cptr, cptr.Y, cptr.X)",
[0x0c] = "n=cptr.X+cptr.Y; cptr.Y = u16(n); cptr.X = u16(math.floor(n/0x10000))",
[0x0d] = "n=cptr.X-cptr.Y; cptr.Y = u16(n); cptr.X = u16(math.floor(n/0x10000))",
[0x0e] = "n=cptr.X*cptr.Y; cptr.Y = u16(n); cptr.X = u16(math.floor(n/0x10000))",
[0x0f] = "n=s16(cptr.X)*s16(cptr.Y); cptr.Y = u16(n); cptr.X = u16(math.floor(n/0x10000))",
[0x1e] = "n = cptr.X*0x10000+cptr.Y; cptr.Y = u16(math.floor(n/cptr.Z)); cptr.X = u16(math.floor(n/cptr.Z)/0x10000); cptr.Z = u16(n%cptr.Z)",
[0x1f] = "n = s32(cptr.X*0x10000+cptr.Y); cptr.Y = u16(math.floor(n/s16(cptr.Z))); cptr.X = u16(math.floor(n/s16(cptr.Z))/0x10000); cptr.Z = u16(n%s16(cptr.Z))",
[0x2c] = "cptr.X = u16(bit32.band(cptr.X, cptr.Y))",
[0x2d] = "cptr.X = u16(bit32.bor(cptr.X, cptr.Y))",
[0x2e] = "cptr.X = u16(bit32.bxor(cptr.X, cptr.Y))",
[0x2f] = "cptr.X = u16(bit32.bnot(cptr.X))",
[0x3c] = "cptr.X = bit32.rshift(cptr.X, cptr.Y)",
[0x3d] = "cptr.X = u16(bit32.arshift(s16(cptr.X), cptr.Y))",
[0x3e] = "n = cptr.X; cptr.X = u16(bit32.lshift(n, cptr.Y)); cptr.Y = u16(bit32.lshift(n, cptr.Y-16))",
[0x3f] = "cptr.X = u16(bit32.arshift(s16(cptr.X), 15))",
[0x38] = "cptr.PC = u16(cptr.PC+read(cptr, cptr.PC)+2)",
[0x39] = "if cptr.X~=0 then cptr.PC = u16(cptr.PC+read(cptr, cptr.PC)) end; cptr.PC = u16(cptr.PC+2)",
[0x3a] = "if cptr.Y~=0 then cptr.PC = u16(cptr.PC+read(cptr, cptr.PC)) end; cptr.PC = u16(cptr.PC+2)",
[0x3b] = "if cptr.Z~=0 then cptr.PC = u16(cptr.PC+read(cptr, cptr.PC)) end; cptr.PC = u16(cptr.PC+2)",
[0x18] = "cptr.SP = cptr.X",
[0x19] = "cptr.RP = cptr.X",
[0x1a] = "cptr.PC = cptr.X",
[0x1b] = "cptr.I = cptr.X",
[0x40] = "cptr.Z = cptr.X",
[0x41] = "cptr.Z = cptr.Y",
[0x42] = "cptr.X = cptr.Z",
[0x43] = "cptr.Y = cptr.Z",
[0x44] = "cptr.X = cptr.Y",
[0x45] = "cptr.Y = cptr.X",
[0x46] = "cptr.X = u16(cptr.X-1)",
[0x47] = "cptr.Y = u16(cptr.Y-1)",
[0x48] = "cptr.Z = u16(cptr.Z-1)",
[0x49] = "cptr.X = u16(cptr.X+1)",
[0x4a] = "cptr.Y = u16(cptr.Y+1)",
[0x4b] = "cptr.Z = u16(cptr.Z+1)",
[0x4d] = "cptr.X = read(cptr, cptr.PC); cptr.PC = u16(cptr.PC+2)",
[0x4e] = "cptr.Y = read(cptr, cptr.PC); cptr.PC = u16(cptr.PC+2)",
[0x4f] = "cptr.Z = read(cptr, cptr.PC); cptr.PC = u16(cptr.PC+2)",
[0x50] = "if cptr.has_input then\ncptr.has_input = false\nelse\ncptr.paused = true\ncptr.PC = u16(cptr.PC-1)\nend",
[0x51] = "emit(pos, cptr.X, cptr)",
}
ITABLE = {}
for i, v in pairs(ITABLE_RAW) do
ITABLE[i] = loadstring(v)
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")
minetest.register_node("forth_computer:computer",{
description = "Computer",
tiles = {"computer.png"},
groups = {cracky=3},
sounds = default.node_sound_stone_defaults(),
on_construct = function(pos)
local meta=minetest.get_meta(pos)
meta:set_string("text","\n\n\n\n\n\n\n\n\n\n")
cptrs[minetest.serialize(pos)] = {pos=pos, cptr=create_cptr(), fmodif=false}
end,
on_destruct = function(pos)
cptrs[minetest.serialize(pos)] = nil
end,
on_rightclick = function(pos, node, clicker)
local meta = minetest.get_meta(pos)
local name = clicker:get_player_name()
cptrs[minetest.serialize(pos)].cptr.pname = name
minetest.show_formspec(name,"computer"..minetest.serialize(pos),create_formspec(meta:get_string("text")))
end,
})
minetest.register_globalstep(function(dtime)
for _,i in pairs(cptrs) do
run_computer(i.pos, i.cptr)
if i.cptr.fmodif then
i.cptr.fmodif=false
if i.cptr.pname~=nil then
local meta = minetest.get_meta(i.pos)
minetest.show_formspec(i.cptr.pname,"computer"..minetest.serialize(i.pos),create_formspec(meta:get_string("text")))
end
end
end
end)
minetest.register_on_shutdown(function()
for _,i in pairs(cptrs) do
i.cptr.fmodif = false
i.cptr.panme = nil
end
write_file(wpath.."/forth_computers",cptrs)
end)
function create_formspec(text)
local f = lines(text)
s = "size[5,4.5;"
i = -0.25
for _,x in ipairs(f) do
s = s.."]label[0,"..tostring(i)..";"..minetest.formspec_escape(x)
i = i+0.3
end
s = s.."]field[0.3,"..tostring(i+0.4)..";4.4,1;f;;]"
return s
end
minetest.register_on_player_receive_fields(function(player, formname, fields)
if formname:sub(1,8)~="computer" then return end
if fields["f"]==nil or fields["f"]=="" then return end
local pos = minetest.deserialize(formname:sub(9,-1))
local c = cptrs[minetest.serialize(pos)]
if c==nil then return end
local cptr=c.cptr
cptr.has_input = true
if string.len(fields["f"])>52 then
fields["f"] = string.sub(fields["f"],1,52)
end
for i=1,string.len(fields["f"]) do
cptr[15+i] = string.byte(fields["f"],i)
end
write(cptr, 0, string.len(fields["f"]))
local meta = minetest.get_meta(pos)
local ntext = newline(meta:get_string("text"),fields["f"])
meta:set_string("text",ntext)
minetest.show_formspec(player:get_player_name(),formname,create_formspec(ntext))
end)