|
@@ -3,6 +3,7 @@ package ekforth
|
|
|
import java.io.Closeable
|
|
|
import java.io.IOException
|
|
|
import java.net.ServerSocket
|
|
|
+import java.util.*
|
|
|
import kotlin.concurrent.thread
|
|
|
|
|
|
class StackUnderflowException : Exception()
|
|
@@ -34,6 +35,14 @@ class Stack {
|
|
|
fun clear() {
|
|
|
stack.clear()
|
|
|
}
|
|
|
+
|
|
|
+ fun roll(u: Int) {
|
|
|
+ if (stack.size < u + 1) error("Stack underflow")
|
|
|
+ val tail = stack.takeLast(u + 1).toMutableList()
|
|
|
+ Collections.rotate(tail, -1)
|
|
|
+ repeat(u + 1) { stack.removeLast() }
|
|
|
+ stack.addAll(tail)
|
|
|
+ }
|
|
|
}
|
|
|
|
|
|
class Dictionary {
|
|
@@ -47,6 +56,9 @@ class Dictionary {
|
|
|
return here() - 1
|
|
|
}
|
|
|
fun here(): Int = entries.size
|
|
|
+ fun dropLast(n: Int) {
|
|
|
+ entries.dropLast(n)
|
|
|
+ }
|
|
|
|
|
|
override fun toString() = entries.withIndex().map { "${it.index}: ${it.value}" }.joinToString("\n") { it }
|
|
|
|
|
@@ -92,6 +104,11 @@ private sealed class Instruction {
|
|
|
|
|
|
override fun toString(): String = "JUMP $address"
|
|
|
}
|
|
|
+ class JSR(val address: () -> Int) : Instruction() {
|
|
|
+ override fun perform(forth: EKForth): String? {
|
|
|
+ TODO("Not yet implemented")
|
|
|
+ }
|
|
|
+ }
|
|
|
object End : Instruction() {
|
|
|
override fun perform(forth: EKForth): String? {
|
|
|
forth.end = true
|
|
@@ -112,21 +129,35 @@ sealed class Input {
|
|
|
}
|
|
|
|
|
|
abstract fun word(): Any?
|
|
|
+ abstract fun word(delimiter: Char): Any?
|
|
|
|
|
|
class StringInput(val string: String) : Input() {
|
|
|
var start = 0
|
|
|
+ val strippedComment = string.replace("\\\\.*".toRegex(), "")
|
|
|
override fun word(): Any? {
|
|
|
- while (start < string.length && string[start].isWhitespace()) ++start
|
|
|
- if (start == string.length) return eof
|
|
|
+ while (start < strippedComment.length && strippedComment[start].isWhitespace()) ++start
|
|
|
+ if (start == strippedComment.length) return eof
|
|
|
+ val tokenStart = start
|
|
|
+ while (start < strippedComment.length && !strippedComment[start].isWhitespace()) ++start
|
|
|
+ val token = strippedComment.substring(tokenStart, start)
|
|
|
+ while (start < strippedComment.length && strippedComment[start].isWhitespace()) ++start
|
|
|
+ return token.toIntOrNull() ?: token.toDoubleOrNull() ?: ForthWord(token)
|
|
|
+ }
|
|
|
+
|
|
|
+ override fun word(delimiter: Char): Any? {
|
|
|
+ while (start < strippedComment.length && strippedComment[start] == delimiter) ++start
|
|
|
+ if (start == strippedComment.length) return eof
|
|
|
val tokenStart = start
|
|
|
- while (start < string.length && !string[start].isWhitespace()) ++start
|
|
|
- val token = string.substring(tokenStart, start)
|
|
|
+ while (start < strippedComment.length && !(strippedComment[start] == delimiter)) ++start
|
|
|
+ val token = strippedComment.substring(tokenStart, start)
|
|
|
+ if (start < strippedComment.length && strippedComment[start] == delimiter) ++start
|
|
|
return token.toIntOrNull() ?: token.toDoubleOrNull() ?: ForthWord(token)
|
|
|
}
|
|
|
}
|
|
|
|
|
|
class ParsedInput(val input: Iterator<Any?>) : Input() {
|
|
|
override fun word(): Any? = if (input.hasNext()) input.next() else eof
|
|
|
+ override fun word(delimiter: Char): Any? = word()
|
|
|
}
|
|
|
}
|
|
|
|
|
@@ -152,6 +183,11 @@ class EKForth {
|
|
|
|
|
|
var input: Input = Input.accept("")
|
|
|
|
|
|
+ fun accept(input: Input) {
|
|
|
+ this.input = input
|
|
|
+ run()
|
|
|
+ }
|
|
|
+
|
|
|
fun accept(input: String) {
|
|
|
this.input = Input.accept(input)
|
|
|
run()
|
|
@@ -180,10 +216,19 @@ class EKForth {
|
|
|
private val docreate = dictionary.here().also {
|
|
|
dictionary.add(Instruction.FunCall { forth ->
|
|
|
with(forth) {
|
|
|
- stack.push(pfa)
|
|
|
+ stack.push(w + 1)
|
|
|
+ eip = next
|
|
|
+ }
|
|
|
+ })
|
|
|
+ }
|
|
|
+
|
|
|
+ private val doconst = dictionary.here().also {
|
|
|
+ dictionary.add(Instruction.FunCall { forth ->
|
|
|
+ with(forth) {
|
|
|
+ stack.push(dictionary[w + 1])
|
|
|
+ eip = next
|
|
|
}
|
|
|
})
|
|
|
- dictionary.add(Instruction.Jump(next))
|
|
|
}
|
|
|
|
|
|
private val dovar = docreate
|
|
@@ -201,6 +246,25 @@ class EKForth {
|
|
|
}
|
|
|
}
|
|
|
|
|
|
+ val constant = defWord("CONSTANT") { forth ->
|
|
|
+ with (forth) {
|
|
|
+ lastDefinition = createHeader(((kWord() as ForthWord).word))
|
|
|
+ comma(Instruction.Jump(doconst))
|
|
|
+ comma(0)
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ val allot = defWord("ALLOT") { forth ->
|
|
|
+ with (forth) {
|
|
|
+ val n = stack.pop() as Int
|
|
|
+ when {
|
|
|
+ n > 0 -> repeat(stack.pop() as Int) { comma(0) }
|
|
|
+ n < 0 -> dictionary.dropLast(- n)
|
|
|
+ }
|
|
|
+
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
val enter = dictionary.here().also {
|
|
|
dictionary.add(Instruction.FunCall { forth ->
|
|
|
with(forth) {
|
|
@@ -211,9 +275,10 @@ class EKForth {
|
|
|
dictionary.add(Instruction.Jump(next))
|
|
|
}
|
|
|
|
|
|
- val exit = dictionary.here().also {
|
|
|
+ val exit = createHeader("EXIT").also {
|
|
|
dictionary.add(Instruction.FunCall { forth -> forth.ip = forth.returnStack.pop() as Int })
|
|
|
dictionary.add(Instruction.Jump(next))
|
|
|
+ lastDefinition = it
|
|
|
}
|
|
|
|
|
|
val eoln = defWord("") { forth -> forth.ip = forth.returnStack.pop() as Int }
|
|
@@ -265,7 +330,7 @@ class EKForth {
|
|
|
var output: (Any?) -> Unit = ::print
|
|
|
|
|
|
val dot = defWord(".") { forth ->
|
|
|
- output.invoke(forth.stack.pop())
|
|
|
+ output.invoke("${forth.stack.pop()} ")
|
|
|
}
|
|
|
|
|
|
val docon = defWord("DOCON") { forth ->
|
|
@@ -312,6 +377,12 @@ class EKForth {
|
|
|
}
|
|
|
}
|
|
|
|
|
|
+ val print = defWord("PRINT") { forth ->
|
|
|
+ with (forth) {
|
|
|
+ output.invoke(dictionary[ip++])
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
val branch = defWord("BRANCH") { forth ->
|
|
|
forth.ip = dictionary[forth.ip] as Int
|
|
|
}
|
|
@@ -325,24 +396,33 @@ class EKForth {
|
|
|
}
|
|
|
|
|
|
fun kWord() = input.word()
|
|
|
+ fun kDelimitedWord(delimiter: Char) = input.word(delimiter)
|
|
|
|
|
|
val kWord = defWord("KWORD") { forth ->
|
|
|
forth.stack.push(kWord())
|
|
|
}
|
|
|
|
|
|
+ val kDelimitedWord = defWord("KDELIMITEDWORD") { forth ->
|
|
|
+ forth.stack.push(kDelimitedWord(stack.pop() as Char))
|
|
|
+ }
|
|
|
+
|
|
|
+ fun kFind(token: Any?): Pair<Any?, Int> {
|
|
|
+ if (token is ForthWord) {
|
|
|
+ val definition = findWord(token.word) ?: throw Exception("$token not found")
|
|
|
+ val isImmediate = if (dictionary[definitionPrecedence(definition)] as Boolean) 1 else -1
|
|
|
+ val xt = definitionCodeField(definition)
|
|
|
+ return Pair(xt, isImmediate)
|
|
|
+ } else {
|
|
|
+ return Pair(token, 0)
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
val kFind = defWord("KFIND") { forth ->
|
|
|
with (forth) {
|
|
|
val token = stack.pop()
|
|
|
- if (token is ForthWord) {
|
|
|
- val definition = findWord(token.word) ?: throw Exception("$token not found")
|
|
|
- val isImmediate = if (dictionary[definitionPrecedence(definition)] as Boolean) 1 else -1
|
|
|
- val xt = definitionCodeField(definition)
|
|
|
- stack.push(xt)
|
|
|
- stack.push(isImmediate)
|
|
|
- } else {
|
|
|
- stack.push(token)
|
|
|
- stack.push(0)
|
|
|
- }
|
|
|
+ val (res, isImmediate) = kFind(token)
|
|
|
+ stack.push(res)
|
|
|
+ stack.push(isImmediate)
|
|
|
}
|
|
|
}
|
|
|
|
|
@@ -424,6 +504,10 @@ class EKForth {
|
|
|
dictionary[state + 1] = -1
|
|
|
}
|
|
|
|
|
|
+ val lBracket = defWord("[") { forth ->
|
|
|
+ dictionary[state + 1] = 0
|
|
|
+ }
|
|
|
+
|
|
|
val semicolon = defWord(";") { forth ->
|
|
|
with(forth) {
|
|
|
comma(exit)
|
|
@@ -463,18 +547,107 @@ class EKForth {
|
|
|
dictionary[stack.pop() as Int] = dictionary.here()
|
|
|
}
|
|
|
|
|
|
- val createHeader = defWord("CREATEHEADER") { forth ->
|
|
|
- forth.defWord((forth.stack.pop() as ForthWord).word, action = Instruction.Jump(forth.enter), precedence = false)
|
|
|
+ val create = defWord("CREATE") { forth ->
|
|
|
+ with (forth) {
|
|
|
+ val word = kWord()
|
|
|
+ if (word !is ForthWord) error("Cannot create definition for $word")
|
|
|
+ if (word.word.isBlank()) error("Cannot create definition for a blank word")
|
|
|
+ forth.last = createHeader(word.word, precedence = false)
|
|
|
+ dictionary.add(Instruction.Jump(docreate))
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ /*
|
|
|
+ https://www.bradrodriguez.com/papers/moving3.htm
|
|
|
+ (;CODE) is part of the word CONSTANT, so it executes when CONSTANT executes (Sequence 2). It performs the following actions:
|
|
|
+
|
|
|
+a. It gets the address of the machine code that immediately follows. This is done by popping IP from the Forth Return Stack.
|
|
|
+
|
|
|
+b. It puts that address into the Code Field of the word just defined by CREATE. The Forth word LAST (sometimes LATEST) gets the address of that word.
|
|
|
+
|
|
|
+c. It does the action of EXIT (a.k.a. ;S) so that the Forth inner interpreter doesn't try to execute the machine code that follows as part of the Forth thread. This is the high-level "subroutine return" which ends a Forth thread.
|
|
|
+
|
|
|
+ : (;CODE)
|
|
|
+ R> \ pops the adrs of the machine code
|
|
|
+ LAST @ NAME> \ gets the CFA of the latest word
|
|
|
+ ! \ stores the code address in the
|
|
|
+ ; \ Code Field
|
|
|
+ =====================
|
|
|
+ For DTC and STC, the action of ;CODE and (;CODE) is identical to ITC, with one important exception: instead of holding an address, the Code Field holds a JUMP or CALL instruction.
|
|
|
+ */
|
|
|
+
|
|
|
+ val parSemicolonCode = defWord("(;CODE)") { forth ->
|
|
|
+ with (forth) {
|
|
|
+ dictionary[forth.last] = Instruction.Jump(ip)
|
|
|
+ // interpretation state
|
|
|
+ dictionary[state + 1] = 0
|
|
|
+ lastDefinition = last // REVEAL
|
|
|
+ // exit
|
|
|
+ ip = returnStack.pop() as Int
|
|
|
+ eip = next
|
|
|
+ }
|
|
|
}
|
|
|
+ /*
|
|
|
+ .also {
|
|
|
+ dictionary[definitionPrecedence(it)] = true
|
|
|
+ }
|
|
|
+
|
|
|
+ */
|
|
|
+
|
|
|
+
|
|
|
+ /*
|
|
|
+ https://www.bradrodriguez.com/papers/moving3.htm
|
|
|
+ ;CODE is executed during Sequence 1, when CONSTANT is compiled. This is an example of a Forth IMMEDIATE word -- a word executed during the Forth compilation. ;CODE does three things:
|
|
|
+
|
|
|
+a. it compiles the Forth word (;CODE) into CONSTANT,
|
|
|
+b. it turns off the Forth compiler, and
|
|
|
+c. it turns on the Forth assembler.
|
|
|
+ */
|
|
|
|
|
|
- val create = defColon("CREATE", kWord, createHeader)
|
|
|
+ var last = -1
|
|
|
+
|
|
|
+
|
|
|
+ private fun semicolonCode(instruction: Instruction) {
|
|
|
+ }
|
|
|
+
|
|
|
+
|
|
|
+ /*
|
|
|
+ : constant create , does> @ ;
|
|
|
+ create , (;code) instruction @ exit
|
|
|
+ constant deux
|
|
|
+ deux jump 2
|
|
|
+ */
|
|
|
+
|
|
|
+ val dodoes = enter
|
|
|
+
|
|
|
+ val does = defWord("DOES>") {
|
|
|
+ comma(parSemicolonCode)
|
|
|
+ comma(Instruction.FunCall { forth ->
|
|
|
+ with (forth) {
|
|
|
+ /*
|
|
|
+ right now:
|
|
|
+ eip: the first cell of thread following (;code)
|
|
|
+ ip: somewhere e. g. in the interpreter, which is fine
|
|
|
+ w: CFA of the definition, w + 1 is the PFA of the definition
|
|
|
+
|
|
|
+ we want:
|
|
|
+ ip where it is
|
|
|
+ w: before the thread following (:code)
|
|
|
+ eip at dodoes = enter
|
|
|
+ */
|
|
|
+ stack.push(w + 1)
|
|
|
+ w = eip - 1
|
|
|
+ eip = dodoes
|
|
|
+ }
|
|
|
+ })
|
|
|
+ }.also { dictionary[definitionPrecedence(it)] = true }
|
|
|
|
|
|
val clearReturnStack = defWord("CLEAR-RETURN-STACK") { forth ->
|
|
|
forth.returnStack.clear()
|
|
|
}
|
|
|
|
|
|
val printOK = defWord(".OK") {
|
|
|
- output.invoke(" ok ")
|
|
|
+ output.invoke(" ok ")
|
|
|
}
|
|
|
|
|
|
val cr = defWord("CR") {
|
|
@@ -504,19 +677,6 @@ class EKForth {
|
|
|
}
|
|
|
}
|
|
|
|
|
|
- val begin = defWord("BEGIN") { forth -> forth.stack.push(forth.dictionary.here().also {println("begin $it")}) }.also {
|
|
|
- dictionary[definitionPrecedence(it)] = true
|
|
|
- }
|
|
|
-
|
|
|
- val again = defWord("AGAIN") { forth ->
|
|
|
- with (forth) {
|
|
|
- dictionary.add(branch)
|
|
|
- dictionary.add(stack.pop())
|
|
|
- }
|
|
|
- }.also {
|
|
|
- dictionary[definitionPrecedence(it)] = true
|
|
|
- }
|
|
|
-
|
|
|
val interpret = colonDefinition("INTERPRET") {
|
|
|
begin()
|
|
|
comma(kWord)
|
|
@@ -573,10 +733,6 @@ class EKForth {
|
|
|
private val initPointers = Pointers(next, start, 0, 0)
|
|
|
private var pointers = initPointers
|
|
|
|
|
|
- init {
|
|
|
- run()
|
|
|
- }
|
|
|
-
|
|
|
fun init() {
|
|
|
eip = pointers.eip
|
|
|
ip = pointers.ip
|
|
@@ -590,7 +746,6 @@ class EKForth {
|
|
|
|
|
|
fun mainLoop() {
|
|
|
while (!end) {
|
|
|
- //println("eip: $eip ip: $ip w: $w pfa: $pfa stack: ${stack.stack} return stack: ${returnStack.stack}")
|
|
|
val error = (dictionary[eip] as Instruction).perform(this)
|
|
|
if (error != null) {
|
|
|
output.invoke("$error\n")
|
|
@@ -601,13 +756,16 @@ class EKForth {
|
|
|
}
|
|
|
|
|
|
fun run() {
|
|
|
+ if (eip >= 0 && dictionary[eip] == Instruction.End) return
|
|
|
init()
|
|
|
end = false
|
|
|
mainLoop()
|
|
|
}
|
|
|
|
|
|
val dotS = defWord(".S") { forth ->
|
|
|
- output.invoke(stack.stack.map { it.toString() }.joinToString(" "))
|
|
|
+ with(forth) {
|
|
|
+ output.invoke(stack.stack.map { it.toString() }.joinToString(" "))
|
|
|
+ }
|
|
|
}
|
|
|
|
|
|
val mul = defWord("*") { forth ->
|
|
@@ -670,6 +828,51 @@ class EKForth {
|
|
|
forth.stack.push(result)
|
|
|
}
|
|
|
|
|
|
+ val less = defWord("<") { forth ->
|
|
|
+ val y = forth.stack.pop()
|
|
|
+ val x = forth.stack.pop()
|
|
|
+ val result = if (x is Int) {
|
|
|
+ if (y is Int) {
|
|
|
+ if (x < y) -1 else 0
|
|
|
+ } else {
|
|
|
+ if (x < y as Double) -1 else 0
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ if ((x as Double) < (y as Double)) -1 else 0
|
|
|
+ }
|
|
|
+ forth.stack.push(result)
|
|
|
+ }
|
|
|
+
|
|
|
+ val more = defWord(">") { forth ->
|
|
|
+ val y = forth.stack.pop()
|
|
|
+ val x = forth.stack.pop()
|
|
|
+ val result = if (x is Int) {
|
|
|
+ if (y is Int) {
|
|
|
+ if (x > y) -1 else 0
|
|
|
+ } else {
|
|
|
+ if (x > y as Double) -1 else 0
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ if ((x as Double) > (y as Double)) -1 else 0
|
|
|
+ }
|
|
|
+ forth.stack.push(result)
|
|
|
+ }
|
|
|
+
|
|
|
+ val equal = defWord("=") { forth ->
|
|
|
+ val y = forth.stack.pop()
|
|
|
+ val x = forth.stack.pop()
|
|
|
+ val result = if (x is Int) {
|
|
|
+ if (y is Int) {
|
|
|
+ if (x == y) -1 else 0
|
|
|
+ } else {
|
|
|
+ if (x == y as Double) -1 else 0
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ if ((x as Double) == (y as Double)) -1 else 0
|
|
|
+ }
|
|
|
+ forth.stack.push(result)
|
|
|
+ }
|
|
|
+
|
|
|
val negate = defWord("NEGATE") { forth ->
|
|
|
val x = forth.stack.pop()
|
|
|
val result = if (x is Int) {
|
|
@@ -685,17 +888,210 @@ class EKForth {
|
|
|
comma(dot)
|
|
|
}
|
|
|
|
|
|
+ val dotDictionary = defWord(".DICTIONARY") { forth -> forth.output.invoke(forth.dictionary) }
|
|
|
+
|
|
|
+ val here = defWord("HERE") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ stack.push(dictionary.here())
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ val oneplus = defWord("1+") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ val n = stack.pop()
|
|
|
+ when (n) {
|
|
|
+ is Int -> stack.push(n + 1)
|
|
|
+ is Double -> stack.push(n + 1.0)
|
|
|
+ else -> error("Cannot add 1 to $n")
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ val oneminus = defWord("1-") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ val n = stack.pop()
|
|
|
+ when (n) {
|
|
|
+ is Int -> stack.push(n - 1)
|
|
|
+ is Double -> stack.push(n - 1.0)
|
|
|
+ else -> error("Cannot subtract 1 from $n")
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ val rfrom = defWord("R>") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ stack.push(returnStack.pop())
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ val toR = defWord(">R") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ returnStack.push(stack.pop())
|
|
|
+ }
|
|
|
+ }
|
|
|
+ val twoToR = defWord("2>R") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ val x = stack.pop()
|
|
|
+ val y = stack.pop()
|
|
|
+ returnStack.push(y)
|
|
|
+ returnStack.push(x)
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ val rAt = defWord("R@") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ stack.push(returnStack.peek())
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ // : postpone kword kfind if , then //
|
|
|
+ val postpone = defWord("POSTPONE") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ val (xt, isImmediate) = kFind(kWord())
|
|
|
+ if (isImmediate < 0) {
|
|
|
+ comma(onStack)
|
|
|
+ comma(xt)
|
|
|
+ comma(comma)
|
|
|
+ } else if (isImmediate > 0) {
|
|
|
+ comma(xt)
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }.also { dictionary[definitionPrecedence(it)] = true}
|
|
|
+
|
|
|
+ /*
|
|
|
+
|
|
|
+ private fun fif() {
|
|
|
+ comma(qbranch)
|
|
|
+ stack.push(dictionary.here())
|
|
|
+ comma(0)
|
|
|
+ }
|
|
|
+
|
|
|
+ private fun felse() {
|
|
|
+ dictionary[stack.pop() as Int] = dictionary.here() + 2
|
|
|
+ comma(branch)
|
|
|
+ stack.push(dictionary.here())
|
|
|
+ comma(0)
|
|
|
+ }
|
|
|
+
|
|
|
+ fun fthen() {
|
|
|
+ dictionary[stack.pop() as Int] = dictionary.here()
|
|
|
+ }
|
|
|
+ */
|
|
|
+ /*
|
|
|
+
|
|
|
+ : DO [ HERE ] >R >R ;
|
|
|
+ : I R@ ;
|
|
|
+ */
|
|
|
+
|
|
|
+ fun dotQuote() {
|
|
|
+ comma(print)
|
|
|
+ val word = kDelimitedWord('"')
|
|
|
+ comma(if (word is ForthWord) word.word else word.toString())
|
|
|
+ }
|
|
|
+
|
|
|
+ val dotQuote = defWord(".\"") {
|
|
|
+ dotQuote()
|
|
|
+ }.also {
|
|
|
+ dictionary[definitionPrecedence(it)] = true
|
|
|
+ }
|
|
|
+
|
|
|
+ fun paren() {
|
|
|
+ kDelimitedWord(')')
|
|
|
+ }
|
|
|
+
|
|
|
+ val paren = defWord("(") {
|
|
|
+ paren()
|
|
|
+ }.also {
|
|
|
+ dictionary[definitionPrecedence(it)] = true
|
|
|
+ }
|
|
|
+
|
|
|
+ val parLoop = defWord("(LOOP)") { forth ->
|
|
|
+ with (forth) {
|
|
|
+ val index = (returnStack.pop() as Int) + 1
|
|
|
+ val limit = returnStack.peek() as Int
|
|
|
+ val start = dictionary[ip] as Int
|
|
|
+ if (index < limit) {
|
|
|
+ returnStack.push(index)
|
|
|
+ ip = start
|
|
|
+ } else {
|
|
|
+ returnStack.pop()
|
|
|
+ ++ ip
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ val parPlusLoop = defWord("(+LOOP)") { forth ->
|
|
|
+ with (forth) {
|
|
|
+ val increment = stack.pop() as Int
|
|
|
+ val oldIndex = returnStack.pop() as Int
|
|
|
+ val newIndex = oldIndex + increment
|
|
|
+ val limit = returnStack.peek() as Int
|
|
|
+ val start = dictionary[ip] as Int
|
|
|
+ if ((oldIndex >= limit && newIndex >= limit) || (oldIndex <= limit - 1 && newIndex <= limit - 1)) {
|
|
|
+ returnStack.push(newIndex)
|
|
|
+ ip = start
|
|
|
+ } else {
|
|
|
+ returnStack.pop()
|
|
|
+ ++ ip
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ val csRoll = defWord("CS-ROLL") { forth ->
|
|
|
+ with(forth) {
|
|
|
+ stack.roll(stack.pop() as Int)
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ init {
|
|
|
+ accept("1 2 + .")
|
|
|
+ accept("""
|
|
|
+ : IF POSTPONE ?BRANCH HERE 0 , ; IMMEDIATE
|
|
|
+ : ELSE HERE 2 + SWAP ! POSTPONE BRANCH HERE 0 , ; IMMEDIATE
|
|
|
+ : THEN HERE SWAP ! ; IMMEDIATE
|
|
|
+ : DO POSTPONE 2>R HERE ; IMMEDIATE
|
|
|
+ : LOOP POSTPONE (LOOP) , ; IMMEDIATE
|
|
|
+ : +LOOP POSTPONE (+LOOP) , ; IMMEDIATE
|
|
|
+ : I POSTPONE R@ ; IMMEDIATE
|
|
|
+ : BEGIN HERE ; IMMEDIATE
|
|
|
+ : AGAIN POSTPONE BRANCH , ; IMMEDIATE
|
|
|
+ : UNTIL POSTPONE ?BRANCH , ; IMMEDIATE
|
|
|
+ : REPEAT POSTPONE AGAIN POSTPONE THEN ; IMMEDIATE
|
|
|
+ : WHILE ( dest -- orig dest )
|
|
|
+ POSTPONE IF 1 CS-ROLL
|
|
|
+ ; IMMEDIATE
|
|
|
+ """.trimIndent())
|
|
|
+ run()
|
|
|
+ }
|
|
|
+
|
|
|
+ fun isDone(): Boolean = (dictionary[eip] == Instruction.End)
|
|
|
+
|
|
|
+
|
|
|
}
|
|
|
|
|
|
data class ForthWord(val word: String)
|
|
|
|
|
|
-val mainFn = ::forth
|
|
|
+val mainFn = ::main1
|
|
|
+//val mainFn = ::mainServer
|
|
|
+//val mainFn = ::forth
|
|
|
//val mainFn = { remoteForth(12345) }
|
|
|
|
|
|
fun main() {
|
|
|
mainFn.invoke()
|
|
|
}
|
|
|
|
|
|
+fun mainServer() {
|
|
|
+ data class C(var a: Int, var b: Int)
|
|
|
+ val c = C(1, 2)
|
|
|
+ Forth.defConstant("c") { c }
|
|
|
+ Forth.defVariable("c.a",
|
|
|
+ getter = { c.a },
|
|
|
+ setter = { c.a = it as Int}
|
|
|
+ )
|
|
|
+ Forth.script(": square dup * ;")
|
|
|
+ Forth.onSocket(12345)
|
|
|
+}
|
|
|
+
|
|
|
fun forth() {
|
|
|
EKForth().run {
|
|
|
output = { print(it) }
|
|
@@ -706,6 +1102,60 @@ fun forth() {
|
|
|
}
|
|
|
}
|
|
|
|
|
|
+fun main1() {
|
|
|
+ EKForth().run {
|
|
|
+ output = { print(it) }
|
|
|
+
|
|
|
+ accept("""
|
|
|
+ \.DICTIONARY
|
|
|
+ \: hello ." hello world " here . ;
|
|
|
+ \cr hello
|
|
|
+ : ?FULL 12 = IF ." It's full " THEN ;
|
|
|
+ 10 ?FULL
|
|
|
+ 12 ?FULL
|
|
|
+ : ?FULL2 cr dup . ." : " 12 = IF ." plenum" else ." nondum plenum" THEN ;
|
|
|
+ 10 ?FULL2
|
|
|
+ 12 ?FULL2
|
|
|
+ : DECADE 10 0 DO I . LOOP ;
|
|
|
+ : PENTAJUMPS 50 0 DO I . 5 +LOOP ;
|
|
|
+ : FALLING -10 0 DO I . -1 +LOOP ;
|
|
|
+ : INC-COUNT DO I . DUP +LOOP DROP ;
|
|
|
+ CR DECADE
|
|
|
+ CR PENTAJUMPS
|
|
|
+ CR FALLING
|
|
|
+ CR 1 5 0 INC-COUNT
|
|
|
+ CR 2 5 0 INC-COUNT
|
|
|
+ CR -3 -10 10 INC-COUNT
|
|
|
+ : foo ( n -- )
|
|
|
+ begin
|
|
|
+ cr ." begin" cr
|
|
|
+ dup 10 < while
|
|
|
+ dup . 1+
|
|
|
+ repeat
|
|
|
+ drop
|
|
|
+ cr ." end"
|
|
|
+ ;
|
|
|
+ 0 foo
|
|
|
+
|
|
|
+ : FACTORIAL ( +n1 -- +n2 )
|
|
|
+ DUP 2 < IF DROP 1 EXIT THEN
|
|
|
+ DUP
|
|
|
+ BEGIN DUP 2 > WHILE
|
|
|
+ 1- SWAP OVER * SWAP
|
|
|
+ REPEAT DROP
|
|
|
+ ;
|
|
|
+ cr 5 factorial .
|
|
|
+ """.trimIndent())
|
|
|
+ /*
|
|
|
+
|
|
|
+ accept("""
|
|
|
+ : DECADE 10 0 DO I . LOOP ;
|
|
|
+ DECADE
|
|
|
+ """.trimIndent())
|
|
|
+ */
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
fun remoteForth(port: Int) = ForthIOServer(EKForth(), port)
|
|
|
|
|
|
class ForthIOServer(val forth: EKForth, port: Int, backlog: Int = 5) : Closeable {
|
|
@@ -714,16 +1164,17 @@ class ForthIOServer(val forth: EKForth, port: Int, backlog: Int = 5) : Closeable
|
|
|
private val sock = ServerSocket(port, backlog)
|
|
|
private var thread: Thread = thread {
|
|
|
while (!Thread.currentThread().isInterrupted) {
|
|
|
- val client = sock.accept()
|
|
|
- val reader = client.getInputStream().bufferedReader()
|
|
|
- val writer = client.getOutputStream().bufferedWriter()
|
|
|
- forth.output = { writer.write("$it"); writer.flush() }
|
|
|
- while (true) {
|
|
|
- val input = reader.readLine() ?: break
|
|
|
- try {
|
|
|
- forth.accept(input)
|
|
|
- } catch (e: IOException) {
|
|
|
- break
|
|
|
+ sock.accept().use { client ->
|
|
|
+ val reader = client.getInputStream().bufferedReader()
|
|
|
+ val writer = client.getOutputStream().bufferedWriter()
|
|
|
+ forth.output = { writer.write("$it"); writer.flush() }
|
|
|
+ while (true) {
|
|
|
+ val input = reader.readLine() ?: break
|
|
|
+ try {
|
|
|
+ forth.accept(input)
|
|
|
+ } catch (e: IOException) {
|
|
|
+ break
|
|
|
+ }
|
|
|
}
|
|
|
}
|
|
|
forth.output = oldOutput
|
|
@@ -736,3 +1187,104 @@ class ForthIOServer(val forth: EKForth, port: Int, backlog: Int = 5) : Closeable
|
|
|
thread.interrupt()
|
|
|
}
|
|
|
}
|
|
|
+
|
|
|
+object Forth {
|
|
|
+ private var forth: EKForth? = null
|
|
|
+ private val preamble = mutableListOf<(EKForth) -> Unit>()
|
|
|
+
|
|
|
+ fun addToPreamble(action: EKForth.() -> Unit) {
|
|
|
+ preamble.add(action)
|
|
|
+ forth?.let { action.invoke(it) }
|
|
|
+ }
|
|
|
+
|
|
|
+ fun script(script: String) {
|
|
|
+ addToPreamble { accept(script) }
|
|
|
+ }
|
|
|
+
|
|
|
+ fun defWord(name: String, action: () -> Unit) {
|
|
|
+ addToPreamble { defWord(name, action) }
|
|
|
+ }
|
|
|
+
|
|
|
+ fun defConstant(name: String, value: () -> Any?) {
|
|
|
+ addToPreamble { defWord(name) { forth -> forth.stack.push(value.invoke()) } }
|
|
|
+ }
|
|
|
+
|
|
|
+ fun defVariable(name: String, getter: () -> Any?, setter: (Any?) -> Unit) {
|
|
|
+ val memoryCell = MemoryCell(getter, setter)
|
|
|
+ addToPreamble { defWord(name) { forth -> forth.stack.push(memoryCell) } }
|
|
|
+ }
|
|
|
+
|
|
|
+ fun accept(input: String) {
|
|
|
+ if (forth == null) setupForth()
|
|
|
+ forth?.let {
|
|
|
+ it.accept(input)
|
|
|
+ if (it.isDone()) forth = null
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ var output: (String) -> Unit = {}
|
|
|
+ set(value) {
|
|
|
+ field = value
|
|
|
+ forth?.let { it.output = { output("$it") } }
|
|
|
+ }
|
|
|
+
|
|
|
+ private fun setupForth() {
|
|
|
+ forth = EKForth().apply {
|
|
|
+ output = {}
|
|
|
+ preamble.forEach { it.invoke(this) }
|
|
|
+ }
|
|
|
+ output = output
|
|
|
+ }
|
|
|
+
|
|
|
+ private var sock: ServerSocket? = null
|
|
|
+ private var io: SocketIO? = null
|
|
|
+
|
|
|
+ fun onSocket(port: Int, backlog: Int = 5) {
|
|
|
+ val ioUser = object : SocketIOUser {
|
|
|
+ override fun input(input: String) {
|
|
|
+ accept(input)
|
|
|
+ }
|
|
|
+
|
|
|
+ override fun onNewWriter(writer: (String) -> Unit) {
|
|
|
+ output = writer
|
|
|
+ }
|
|
|
+ }
|
|
|
+ sock = ServerSocket(port, backlog)
|
|
|
+ sock?.let { io = SocketIO(it, ioUser) }
|
|
|
+ }
|
|
|
+
|
|
|
+ fun close() {
|
|
|
+ sock?.close()
|
|
|
+ io?.close()
|
|
|
+ forth = null
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+interface SocketIOUser {
|
|
|
+ fun input(input: String) {}
|
|
|
+ fun onNewWriter(writer: (String) -> Unit) {}
|
|
|
+}
|
|
|
+
|
|
|
+class SocketIO(val sock: ServerSocket, val user: SocketIOUser) : Closeable {
|
|
|
+ private var thread: Thread = thread {
|
|
|
+ while (!Thread.currentThread().isInterrupted) {
|
|
|
+ sock.accept().use { client ->
|
|
|
+ val reader = client.getInputStream().bufferedReader()
|
|
|
+ val writer = client.getOutputStream().bufferedWriter()
|
|
|
+ user.onNewWriter { writer.write(it); writer.flush() }
|
|
|
+ while (true) {
|
|
|
+ val input = reader.readLine() ?: break
|
|
|
+ try {
|
|
|
+ user.input(input)
|
|
|
+ } catch (e: IOException) {
|
|
|
+ break
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ override fun close() {
|
|
|
+ thread?.interrupt()
|
|
|
+ }
|
|
|
+}
|