aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Changelog.md130
-rw-r--r--Makefile44
-rw-r--r--README.md681
-rw-r--r--pic/benchmark_reuse.pngbin0 -> 30089 bytes
-rw-r--r--sample/245II.in60
-rw-r--r--sample/AckSZ-3_5.in18
-rw-r--r--sample/FibSZ_9.in29
-rw-r--r--sample/ack_3_5.in32
-rw-r--r--sample/bsort.in18
-rw-r--r--sample/fib-tail-38.in10
-rw-r--r--sample/fib-tail_9.in10
-rw-r--r--sample/fib_9.in16
-rw-r--r--sample/gcd.in16
-rw-r--r--sample/isort.in15
-rw-r--r--sample/linear-systemT.in142
-rw-r--r--sample/msort.in28
-rw-r--r--sample/processnet1.in20
-rw-r--r--sample/qsort.in21
-rw-r--r--src/ast.c331
-rw-r--r--src/ast.h62
-rw-r--r--src/cas_spinlock.h11
-rw-r--r--src/id_table.c171
-rw-r--r--src/id_table.h75
-rw-r--r--src/inpla.l191
-rw-r--r--src/inpla.y7606
-rw-r--r--src/linenoise/.gitignore3
-rw-r--r--src/linenoise/linenoise.c1225
-rw-r--r--src/linenoise/linenoise.h75
-rw-r--r--src/mytype.h49
-rw-r--r--src/name_table.c423
-rw-r--r--src/name_table.h50
-rw-r--r--src/timer.h31
32 files changed, 11593 insertions, 0 deletions
diff --git a/Changelog.md b/Changelog.md
new file mode 100644
index 0000000..93f0c07
--- /dev/null
+++ b/Changelog.md
@@ -0,0 +1,130 @@
+# Changelog
+
+
+
+## v0.4.1 (24 September 2021)
+
+### Improved
+
+- Line edit is improved so that history can be handled by linenoise:
+ https://github.com/antirez/linenoise
+
+- The priority of rules are changed so that user defined rules can be taken before built-in rules.
+
+### Bug Fix
+
+- Constants were consumed when they are referred to, but these should be kept and it was fixed as so.
+
+- A global name that has evaluated and occurred twice already was able to be defined. Now it is prevented.
+
+- A global name that has evaluated and occurred twice already was able to be defined. Now it is prevented.
+
+
+
+## v0.4.0 (17 September 2021)
+
+### New Feature:
+
+- Nested guards are supported. As shown in below, nested guards are supported now:
+
+ ```
+ A(r)><B(int a, int b)
+ | a==1 =>
+ | b==0 => r~10
+ | _ =>
+ | a+b>10 => r~20
+ | _ => r~2000
+ | _ => r~100;
+ ```
+
+- Strings that have brackets, such as `inc(x)`, are recognised as agents even if these starts from a not capital letter.
+
+
+- Built-in rules that match each element for the same built-in agents are implemented. For instance, the following rules are realised as built-in:
+
+ ```
+ a:b >< x:y => a~x, b~y;
+ [] >< [] =>;
+ (a,b) >< (x,y) => a~x, b~y;
+ ```
+
+
+
+## v0.3.2 (3 August 2021)
+
+### New Feature:
+
+- WHNF strategy is supported with -w option. Weak Head Normal Form strategy is available when the Inpla is invoked with -w option. The following is an execution log:
+
+ ```
+ $ ./inpla -w
+ Inpla 0.32 (WHNF) : Interaction nets as a programming language [3 August 2021]
+ >>> use "sample/processnet1.in";
+ (2 interactions, 0.00 sec)
+ >>> ifce; # show interfaces
+ r
+ >>> r; # show the connected net from the `r'
+ [1,<a1>...
+ >>> h:t ~ r; # decompose it as h:t
+ (3 interactions, 0.00 sec)
+ >>> ifce;
+ h t
+ >>> h;
+ 1
+ >>> t;
+ [2,<b1>...
+ >>>
+ ```
+
+
+
+## v0.3.1 (7 May 2021)
+
+### New Feature:
+
+- New notation for the built-in Cons agent, h:t. The built-in Cons agent is also written as h:t, besides [h|t]. For instance, a reverse list operation is written as follows:
+
+ ```
+ Rev(ret, acc) >< [] => ret ~ acc;
+ Rev(ret, acc) >< h:t => Rev(ret, h:acc) ~ t;
+
+ Rev(ret,[]) ~ [1,3,5,8];
+ ret; // -> [8,5,3,1]
+ ```
+
+- The built-in agent for integer numbers is introduced. Integer numbers are recognised as agents. In addition:
+
+ - expressions on attributes are written as agents.
+ - `Add(ret, m)><(int n)` is implemented as a built-in rule.
+
+ For instance, Fibonacci number is obtained as follows:
+
+ ```
+ Fib(ret) >< (int n)
+ | n == 0 => ret~0
+ | n == 1 => ret~1
+ | _ => Add(ret,cnt2)~cnt1, Fib(cnt1)~(n-1), Fib(cnt2)~(n-2);
+
+ Fib(r)~38;
+ r; // it should be 39088169.
+ ```
+
+ As another example, the greatest common divisor is obtained as follows:
+
+ ```
+ Gcd(ret, int a) >< (int b)
+ | b==0 => ret~a
+ | _ => Gcd(ret, b) ~ (a%b);
+
+ Gcd(r, 14) ~ 21;
+ r; // it should be 7
+ ```
+
+- Append for two lists is implemented as built-in as follows:
+
+ ```
+ Append(r,[1,2,3])~[7,8,9];
+ r; // it should be [7,8,9,1,2,3]
+ ```
+
+
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..13d52af
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,44 @@
+CC = gcc
+CFLAGS = -Wall -Winline -O3 -std=gnu99 --param inline-unit-growth=2000 --param max-inline-insns-single=2000
+LDFLAGS =
+LIBS =
+INCLUDE = -I ./src
+SRC_DIR = ./src
+OBJ_DIR = ./build
+#SOURCES = $(SRC_DIR)/ast.c $(SRC_DIR)/id_table.c $(SRC_DIR)/linenoise/linenoise.c
+TARGET = inpla
+OBJS = $(OBJ_DIR)/$(TARGET).tab.c $(OBJ_DIR)/ast.o $(OBJ_DIR)/id_table.o $(OBJ_DIR)/linenoise.o
+
+#MYOPTION = -DHAND_FIB -DHAND_FIB_INT -DHAND_I_CONS -DHAND_IS_CONS -DHAND_Apnd_CONS -DHAND_Part_CONS -DHAND_Split_CONS -DHAND_MergeCC_CONS -DHAND_B_CONS -DHAND_DUP_S -DHAND_ADD_S -DHAND_ACK_S
+#MYOPTION = -DHAND_Split_CONS -DHAND_MergeCC_CONS
+
+.PHONY: all
+
+all: $(OBJ_DIR) $(TARGET)
+
+$(TARGET): $(OBJS) $(LIBS)
+ $(CC) $(CFLAGS) $(INCLUDE) $(MYOPTION) -o $@ $(OBJS) $(LDFLAGS)
+
+$(OBJ_DIR)/%.o: $(SRC_DIR)/linenoise/%.c
+ $(CC) $(CFLAGS) $(INCLUDE) -o $@ -c $<
+
+
+$(OBJ_DIR)/%.o: $(SRC_DIR)/%.c
+ $(CC) $(CFLAGS) $(INCLUDE) -o $@ -c $<
+
+$(OBJ_DIR)/$(TARGET).tab.c : $(SRC_DIR)/$(TARGET).y $(OBJ_DIR)/lex.yy.c
+ bison -o $@ $<
+
+$(OBJ_DIR)/lex.yy.c : $(SRC_DIR)/$(TARGET).l
+ flex -o $@ $^
+
+$(OBJ_DIR):
+ @if [ ! -d $(OBJ_DIR) ]; then \
+ echo ";; mkdir $(OBJ_DIR)"; mkdir $(OBJ_DIR); \
+ fi
+
+clean:
+ rm -f $(TARGET) $(OBJ_DIR)/* *stackdump*
+
+thread: $(OBJS) $(LIBS)
+ $(CC) $(CFLAGS) $(INCLUDE) $(MYOPTION) -DTHREAD -o $(TARGET) $(OBJS) $(LDFLAGS) -lpthread
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..022acc6
--- /dev/null
+++ b/README.md
@@ -0,0 +1,681 @@
+# Inpla: Interaction nets as a programming language
+
+
+
+## What is Inpla
+
+Inpla is a multi-threaded parallel interpreter of interaction nets. Once you write programs for sequential execution, it also works in multi-threaded parallel execution. Each thread is managed on each core with Posix-thread library.
+
+![speedup-ratio](pic/benchmark_reuse.png)
+
+
+### Feature of Version 0.4.1
+- Integer numbers can be written the same as one of the first-class objects.
+- Interaction rules can re-allocate heaps of the rule agents for agents in nets. This re-allocation is specified by modifications such as (\*L), (\*R), called reuse annotation [1], to agents in nets. This annotation can improve execution performance in parallel.
+- Wead Head Normal Form reduction strategy is supported. It turns on by invoked with ```-w``` option.
+- Nested guards in conditional rules are supporeted.
+- Comparison with other interpreters: Standard ML v110.74 (SML) and Python v3.8.5 (Python) in execution time. (We are planing to have benchmark of Haskell, C, as well in future.)
+ - Execution time in second (Linux PC, Core i7-9700 (8 threads, no Hyper-threading), 16GB memory).
+ - Inpla*n* and Inpla*n*_**r** mean *n* threads without/with reuse-annotated execution, respectively.
+ - `ack(3,6)` is computation of Ackermann function with (3,6), though its execution time is too short. Python cannot calculate the case of (3,7) due to stack size limitation, so anyway we include it in the comparison table.
+
+| | SML | Python | Inpla1 | Inpla1_r | Inpla3 | Inpla3_r | Inpla7 | Inpla7_r |
+| --- | :-: | :-: | :-: | :-: | :-: | :-: | :-: | :-: |
+|ack(3,6) (too short)|0.05|0.04|0.11|0.11|0.11|0.11|0.11|0.11|
+|ack(3,11)|**0.41**|-|4.76|4.36|1.65|1.49|0.98|0.88|
+|fibonacci 38|**0.26**|8.49|3.59|3.56|1.24|1.23|0.56|0.54|
+|bsort 40000|11.17|76.72| 22.85 | 18.40 | 8.07 | 6.34 | 5.53 | **2.94** |
+|isort 40000|2.97|36.63| 10.59 | 8.74 | 3.91 | 3.04 | 2.59 | **1.43** |
+|qsort 800000|1.16|97.30| 1.85 | 1.55 | 0.84 | 0.65 | 0.76 | **0.41** |
+|msort 800000|1.00|98.27| 1.18 | 1.34 | 0.61 | 0.57 | 0.65 | **0.49** |
+
+
+
+## Getting started
+- Requirement
+ - gcc (>= 4.0), flex, bison
+
+- Build
+ - Single-thread version: Use `make` command as follows (the symbol `$` means a shell prompt):
+```
+$ make
+```
+
+ - Multi-thread version: Use `make` with `thread` option (it may also need `make clear` before that):
+```
+$ make thread
+```
+
+
+
+## How to execute
+
+### Interactive mode (single-thread version)
+- Inpla starts in the interactive mode by typing the following command:
+
+ ```
+ $ ./inpla
+ Inpla 0.4.1 : Interaction nets as a programming language [built: 21 Sept. 2021]
+ >>>
+ ```
+
+
+- The symbol `>>>` is a prompt of this system. After the prompt you can write rules and nets as follows (`//` is a comment):
+
+ ```
+ >>> inc(ret)><(int i) => ret~(i+1); // a rule for inc >< (int i)
+ >>> inc(r)~10; // a net
+ (1 interactions, 0.16 sec)
+ >>> r; // show a connected net from the r
+ 11
+ >>>
+ ```
+
+- To quit this system, use `exit` command:
+
+ ```
+ >>> exit;
+ ```
+
+### Interactive mode (multi-thread version)
+- There is an execution option `-t` in order to specify the number of threads in a thread pool. For instance, by invoking with `-t 4` Inpla starts with 4 threads in the pool:
+
+ ```
+ $ ./inpla -t 4
+ ```
+
+
+
+### Batch mode and sample files
+
+- Inpla has also the batch mode in which a file is evaluated. This is available when invoked with an execution option `-f` *filename*. There are sample files in the `sample` folder. Here we introduce some of ones:
+
+#### Greatest common divisor
+
+ - Sample file: `sample/gcd.in`
+
+ ```
+ // def gcd(a: Int, b: Int): Int =
+ // if (b==0) a else gcd(b, a%b)
+
+ // Rules
+ gcd(ret) >< (int a, int b)
+ | b==0 => ret ~ a
+ | _ => gcd(ret) ~ (b, a%b);
+
+ // Nets
+ gcd(r) ~ (14,21);
+ r; // it should be 7
+ ```
+
+ - Execution:
+
+ ```
+ $ ./inpla -f sample/gcd.in
+ Inpla 0.4.1 : Interaction nets as a programming language [built: 21 Sept. 2021]
+ (4 interactions, 0.00 sec)
+ 7
+
+ $
+ ```
+
+
+
+#### Insertion sort
+
+ - Sample file: `sample/isort.in`
+
+ ```
+ // Rules
+ isort(ret) >< [] => ret~[];
+ isort(ret) >< x:xs => insert(ret, x)~cnt, isort(cnt)~xs;
+
+ insert(ret, int x) >< [] => ret~[x];
+ insert(ret, int x) >< (int y):ys
+ | x<=y => ret~(x:y:ys)
+ | _ => ret~(y:cnt), insert(cnt, x)~ys;
+
+ // Nets
+ isort(r)~[3,6,1,9,2];
+ r;
+ ```
+
+ - Execution:
+
+ ```
+ $ ./inpla -f sample/isort.in
+ Inpla 0.4.1 : Interaction nets as a programming language [built: 21 Sept. 2021]
+ (16 interactions, 0.00 sec)
+ [1,2,3,6,9]
+
+ $
+ ```
+
+
+#### Other samples
+- Evaluation of a lambda term `245II` in [YALE encoding](http://dl.acm.org/citation.cfm?id=289434), where `2 4 5` mean church numbers of lambda terms respectively and `I` is a lambda term $\lambda x.x$:
+
+ $ ./inpla -f sample/245II.in
+
+
+- Samples of linear systemT encoding (see [our paper](http://link.springer.com/chapter/10.1007%2F978-3-319-29604-3_6) presented at [FLOPS 2016](http://www.info.kochi-tech.ac.jp/FLOPS2016/)).
+
+ $ ./inpla -f sample/linear-systemT.in
+
+
+
+### Execution Options
+
+- When invoking Inpla, you can specify the following options:
+```
+$ ./inpla -h
+Usage: inpla [options]
+
+Options:
+ -f <filename> Set input file name (Defalut is STDIN)
+ -c <number> Set the size of term cells (Defalut is 100000)
+ -x <number> Set the size of the AP stack (Default is 10000)
+ -t <number> Set the number of threads (Default is 1)
+ -w Enable Weak Head Normal Form strategy (Default: false)
+ -h Print this help message
+```
+(The option ```-t``` is available for the multi-thread version that is compiled by ```make thread```.)
+
+
+
+
+
+# Introduction to programming in Inpla
+Inpla evaluates *nets*, which are built by *connections between terms*. First, we learn about terms and connections.
+
+## Terms
+**Terms** are built on *names* and *agents* as follows:
+
+```
+<term> ::= <name> | <agent>
+<name> ::= <nameID>
+<agent> ::= <agentID>
+ | <agentID> [( <term> , ... , <term> )]
+```
+- **Name**: It works a buffer between terms. The ```<nameID>``` is defined as strings start with a small letter, e.g. ```x``` and ```y```.
+
+- **Agent**: It works constructors and de-constructors (defined functions). The ```<agentID>``` is defined as strings start with a capital letter, e.g. ```A``` and ```Succ```, and also strings the same as ```<nameID>``` when it is followed by a open curry bracket```(```. So, ```foo(x)``` is recognised as an agent.
+
+
+
+## Connections
+
+A **connection** is a relation between two terms, and it is expressed with the symbol `~`. For instance, a connection between a name `x` and an agent `A` is denoted as `x~A`.
+
+- Connections between a name and an agent, such as `x~A`, evaluated that the `A` is connected from the `x`.
+- Connections between agents are evaluated according to `interaction rules` explained later.
+
+Here, as an example, type `x~A` with the termination symbol `;` as follows:
+
+```
+>>> x~A;
+(0 interactions, 0.00 sec)
+>>>
+```
+
+To show the connected terms from the name x, type just `x`:
+```
+>>> x;
+A
+>>>
+```
+
+To dispose the name `x` and anything connceted from the `x`, use `free` command:
+```
+>>> free x;
+>>> x;
+<NON-DEFINED>
+>>>
+```
+
+One more connections are also evaluated. For instance, `x~A, x~y` is evaluated as `y~A`. **We note** that the `x` is disposed because it is consumed (used) by this re-connection:
+```
+>>> x~A, x~y;
+(0 interactions, 0.00 sec)
+>>> y;
+A
+>>> x; // x has been consumed and displosed by the re-connection of x~A and x~y.
+<NON-DEFINED>
+>>>
+```
+
+Just in case for other examples, let the `y` disposed:
+
+```
+>>> free y;
+>>> y;
+<NON-DEFINED>
+>>>
+```
+
+
+
+## Interaction rules
+
+Connections between agents are re-written according to **interaction rules**:
+
+```
+<interaction-rule> ::= <rule-agent> >< <rule-agent> => <connections> ;
+<rule-agent> ::= <agentID>
+ | <agentID> ( <name>, ... , <name> )
+```
+ where
+
+ - each name of the ```<name>``` must be **distinct**, and must **occur once** in the ```<connections>```.
+
+Something complicated? No problem! Let's us learn how to define the rules with some example!
+
+### Example: Operations on unary natural numbers.
+
+Unary natural numbers are built by Z and S. For instance, 0, 1, 2, 3 are expressed as Z, S(Z), S(S(Z)), S(S(S(Z))). Here, let's think about an increment operation `inc` such that inc(n) = S(n). This is written as rules for Z and S(x) as follows:
+
+```
+>>> inc(result) >< Z => result~S(Z);
+>>> inc(result) >< S(x) => result~S(S(x));
+```
+
+In the first rule, the name `result` occurs in its `<connection>` part once, so it satisfies the rule proviso. In the second rule, the `result` and `x` satisfies also because these are distinct and occur once in its `<connections>` part.
+
+When agents can be separated into constructors and de-constructors, then it could be good to use strings of all small letters for de-constructors like `inc` , and ones start from a capital letter for constructors like `Z` and `S`.
+
+Let's have a result of the increment operation for `S(S(Z))`:
+
+```
+>>> inc(r)~S(S(Z));
+(1 interactions, 0.01 sec)
+>>> r;
+S(S(S(Z))
+>>>
+```
+
+Good! We get the result `S(S(S(Z)))` of incrementation of `S(S(Z))` .
+
+To show the result as a natural number, use `prnat` command:
+
+```
+>>> prnat result;
+3
+>>>
+```
+
+Let's clean the result in case it could be used anywhere:
+
+```
+>>> free r;
+>>>
+```
+
+- Exercise: Addition on unary natural numbers.
+
+ It is defined recursively as follows:
+
+ - add(x, Z) = x,
+ - add(x, S(y)) = add(S(x), y),
+
+We note that `Add` is already used as a built-in rule, so use `add`.
+
+```
+>>> add(result, x) >< Z => result~x;
+>>> add(result, x) >< S(y) => add(result, S(x))~y;
+>>> add(r,S(Z))~S(S(Z));
+(3 interactions, 0.00 sec)
+>>> r;
+S(S(S(Z)))
+>>> prnat result;
+3
+>>> free r;
+>>>
+```
+
+
+
+## Built-in agents
+Inpla has built-in agents:
+
+### Tuples
+
+- `Tuple0`, `Tuple2(x1,x2)`, `Tuple3(x1,x2,x2)`, `Tuple4(x1,x2,x3,x4)`, `Tuple5(x1,x2,x3,x4,x5)`,
+ are written as
+ `()`, `(x1,x2)`, `(x1,x2,x3)`, `(x1,x2,x3,x4)`, `(x1,x2,x3,x4,x5)`.
+
+- There is no Tuple1, and so `(x)` is evaluated as just `x`.
+
+
+### Lists
+
+- `Nil`, `Cons(x,xs)`
+ are written as
+ `[]` and `x:xs`, respectively.
+- A nested `Cons` that terminated at `Nil` is written as a list notation using brackets `[` and `]`. For instance,
+ `x1 : x2: x3 : Nil`
+ is written as
+ `[x1,x2,x3]` .
+
+
+
+### Built-in rules for tuples and lists
+
+For pairs of the same built-in agents there are built-in rules that match and connect each element such that:
+
+```
+(x1,x2)><(y1,y2) => x1~y1, x2~y2 // This is already defined as a built-in rule.
+```
+
+With respect to lists, we also have a built-in agent `Append` to append two lists as shown in the following pseudo code:
+
+```
+Append(r, alist) ~ blist --> r~ (blist @ alist) // pseudo code
+```
+
+- The following is an example of built-in agents:
+
+```
+>>> x~(Z, S(Z));
+(0 interactions, 0.00 sec)
+>>> (x1,x2)~x;
+>>> x1 x2;
+Z S(Z)
+>>> y~[Z, S(Z), S(S(Z))];
+(0 interactions, 0.00 sec)
+>>> [y1, y2, y3]~y;
+>>> y1 y2 y3;
+Z S(Z) S(S(Z))
+>>> Append(r, [Z, S(Z)]) ~ [A,B,C];
+>>> r;
+[A,B,C,Z,S(Z)]
+>>> free x1 x2 y1 y2 y3 r;
+>>>
+```
+
+
+
+## Attributes (integers)
+
+Agents can have integers as arguments. These integers are called attributes.
+
+- For instance, `A(100)` is evaluated as an agent `A` that holds an attribute of an integer 100.
+
+```
+>>> x~A(100);
+(0 interactions, 0.01 sec)
+>>> x;
+A(100);
+>>> free x;
+>>>
+```
+It is possible to use integers the same as agents, but these are recognised as attributes of an anonymous built-in agent in Inpla:
+```
+>>> x~100;
+(0 interactions, 0.00 sec)
+>>> x;
+100
+>>> free x;
+>>>
+```
+
+
+
+### Arithmetic expressions on attributes
+Attributes can be given as the results of arithmetic operation using `where` statement after connections:
+
+```
+<connections-with-expressions> ::=
+ <connections>
+ | <connections> where <let-clause>* ;
+
+<let-clause> ::= <name> = <arithmetic expression>
+```
+
+The symbol of addition, subtraction, multiplication, division and modulo are `+`, `-`, `*`, `/` and `%`, respectively.
+
+- For instance, the following is an expression using `where`:
+
+```
+>>> x~A(a) where a=3+5;
+(0 interactions, 0.00 sec)
+>>> x;
+A(8)
+>>> free x;
+>>>
+```
+
+- Arithmetic expressions can be written in arguments directly without using `where`:
+
+```
+>>> x~A(3+5);
+(0 interactions, 0.00 sec)
+>>> x;
+A(8)
+>>> free x;
+>>>
+```
+
+- Arithmetic expressions are also available for the anonymous agent:
+
+```
+>>> x~(3+5); // this is also written without brackets as x~3+5;
+(0 interactions, 0.00 sec)
+>>> x;
+8
+>>> free x;
+>>>
+```
+
+
+
+### Interaction rules with expressions on attributes
+In interaction rules, attributes can be managed by using a modifier `int`.
+- Example: Incrementor on an attribute:
+```
+>>> inc(result) >< (int a) => result~(a+1);
+>>> inc(r)~10;
+(1 interactions, 0.00 sec)
+>>> r;
+11
+>>> free r;
+>>>
+```
+
+
+
+### Built-in rules of attributes in the anonymous agents
+
+There is a built-in rule for attributes on the two anonymous agents. This could be required to calculate attributes obtained as evaluation results of two nets. In this version, we have the following rules as built-in:
+
+```
+Add(result, y)><(int x) => Addn(result, x)~y;
+Addn(result, int x)><(int y) => result~(x+y);
+```
+
+- Example:
+
+```
+>>> Add(r, 3)~5; // Add is already defined as a bulit-in
+>>> r;
+8
+>>>
+```
+
+
+
+
+### Interaction rules with conditions on attributes
+In interaction rules, conditional rewritings on attributes are available. The following is a general form:
+
+```
+<rule-with-conditions> ::=
+ <agent> '><' <agent>
+ '|' <condition-on-attributes> '=>' <connections-with-expressions>
+ '|' <condition-on-attributes> '=>' <connections-with-expressions>
+ ...
+ '|' '_' '=>' <connections-with-expressions> ';'
+
+<condition-on-attributes> is an expression on attributes specified in the two <agent>.
+```
+
+The sequence of `<condition-on-attributes> ` must be finished with the otherwise case `_`.
+
+- Example: The following shows rules to obtain a list that contains only even numbers:
+```
+// Rules (because it is long definition, so copy and paste is recommended)
+evenList(result) >< [] => r~[];
+evenList(result) >< (int x):xs
+| x%2==0 => result~(x:r1), evenList(r1)~xs
+| _ => evenList(result)~xs;
+```
+
+```
+>>> evenList(r)~[1,3,7,5,3,4,9,10];
+>>> r;
+[4,10]
+>>> free r;
+>>>
+```
+
+- Example: Fibonacci number:
+```
+fib(result) >< (int n)
+| n == 0 => result~0
+| n == 1 => result~1
+| _ => fib(r1)~(n-1), fib(r2)~(n-1), Add(result, r2)~r1;
+
+// * We cannot write result~(r1+r2)
+// because r1 and r2 are not recognised as attributes.
+// Therefore, we have to apply those to the built-in rule Add(r, int x)><(int y).
+```
+
+```
+>>> fib(r)~39;
+>>> r;
+63245986
+>>> free r;
+>>>
+```
+
+
+
+## Commands
+
+- Inpla has the following commands:
+ - `free` *name_1* ... *name_n* `;`
+ Terms connected from the *name_1* ... *name_n* and itself are disposed.
+ - *name_1* ... *name_n* `;`
+ Put terms connected from the *name_1* ... *name_n*.
+ - `prnat`*name*`;`
+ Put a term connected from the *name* as a natural number.
+ - `use` `"`filename`";`
+ Read the file named as "filename".
+ - `ifce;`
+ Put all live names and connections from these name. The living name list is called *interface*, and the `ifce` is an abbreviation of Interface.
+ - `exit;`
+ Quit the system.
+
+- Inpla has the following macro:
+ - `const` *NAME*`=` *i* `;`
+ The *NAME* is replaced with the integer value *i* in nets and interaction rules.
+
+
+
+## Extensions in Version 0.4
+
+### Reuse annotations
+
+In interaction rule definitions, we can specify which agent is reused in the nets again by annotations `(*L)` and `(*R)`, which means the left-hand side and the right-hand side agents in the rule. This annotations promote in-place computing, and as the result performance in parallel execution can be improved well.
+
+- For instance, in the rule `gcd(ret) >< (int a, int b)`, we can reuse the `gcd` and `Tuple2` in nets as follows:
+
+ ```
+ gcd(ret) >< (int a, int b)
+ | b==0 => ret ~ a
+ | _ => (*L)gcd(ret) ~ (*R)(b, a%b);
+ ```
+
+
+
+### Weak Head Normal Form reduction stragety
+
+In this reduction strategy, only connections that have living names are re-written by interaction rules. This is taken for non-terminate computation such as fixed point combinator and process networks.
+
+- Example: We have a sample net in `sample/processnet1.in` that keep producing natural numbers from 1 and output these to the port `r`:
+
+ ```
+ // Rules
+ dup(a1,a2) >< (int i):xs => a1~(i:xs1), a2~(i:xs2), dup(xs1,xs2)~xs;
+ dup(a1,a2) >< [] => a1~[], a2~[];
+
+ inc(r) >< (int i):xs => r~(i+1):w, inc(w)~xs;
+ inc(r) >< [] => r~[];
+
+ // Nets
+ dup(r,w)~r1, inc(r1) ~ 0:w;
+
+ // +-----+ +-----+ +---+
+ // r ----| | r1 | | | |
+ // | dup |--->---| inc |---><---| 0 |----+
+ // +---| | | | | | |
+ // | +-----+ +-----+ +---+ |
+ // | |
+ // +-----------------------------------------+
+ // w
+ ```
+
+ This is executable in this reduction strategy as follows:
+
+ ```
+ $ ./inpla -w
+ Inpla 0.4.1 : Interaction nets as a programming language [built: 21 Sept. 2021]
+ >>> use "sample/processnet1.in";
+ (2 interactions, 0.00 sec)
+ >>> ifce;
+ r
+
+ Connections:
+ r ->[1,<a1>... // this means a list of 1 and something.
+
+ >>> a:b ~ r;
+ (2 interactions, 0.00 sec)
+ >>> ifce;
+ a b
+
+ Connections:
+ a ->1
+ b ->[2,<b1>...
+
+ >>>
+ ```
+
+
+
+
+
+# Publications
+- [1] Ian Mackie, Shinya Sato,
+[*In-place Graph Rewriting with Interaction Nets*](https://arxiv.org/abs/1609.03641), TERMGRAPH 2016, EPTCS 225, pp.15-24, 2016.
+- [2] Shinya Sato,
+[*Design and implementation of a low-level language for interaction nets*](http://sro.sussex.ac.uk/54469/),
+PhD Thesis, University of Sussex, September 2014.
+- [3] Abubakar Hassan, Ian Mackie and Shinya Sato,
+[*An implementation model for interaction nets*](http://arxiv.org/abs/1505.07164),
+Proceedings 8th International Workshop on Computing with Terms and Graphs, TERMGRAPH 2014, EPTCS 183, May 2015.
+- [4] Ian Mackie and Shinya Sato,
+[*Parallel Evaluation of Interaction Nets: Case Studies and Experiments*](http://journal.ub.tu-berlin.de/eceasst/article/view/1034),
+Electronic Communications of the EASST, Volume 73: Graph Computation Models - Selected Revised Papers from GCM 2015, March 2016.
+
+
+
+# Related works
+
+- [HINet: Interaction Nets in Haskell](http://www.cas.mcmaster.ca/~kahl/Haskell/HINet/)
+
+
+
+# Licence
+
+Copyright (c) 2021 [Shinya SATO](http://satolab.com/)
+ Released under the MIT license
+ http://opensource.org/licenses/mit-license.php
diff --git a/pic/benchmark_reuse.png b/pic/benchmark_reuse.png
new file mode 100644
index 0000000..14004d5
--- /dev/null
+++ b/pic/benchmark_reuse.png
Binary files differ
diff --git a/sample/245II.in b/sample/245II.in
new file mode 100644
index 0000000..6962ace
--- /dev/null
+++ b/sample/245II.in
@@ -0,0 +1,60 @@
+// 245II in YALE encoding
+
+// Rules
+Lam(a,b,c) >< App(x,y) => a~x, b~y, c~D;
+D >< V => ;
+B(a,b,c) >< Z => a~c, b~Z;
+B(a,x,e) >< Lam(b,c,y) => x~Lam(b,c,d), y~DB(a,d,e);
+DB(a,b,c) >< V => a~c, b~V;
+C(x,y) >< Z => x~Z, y~Z;
+C(x,y) >< Lam(s,t,u) =>
+ x~Lam(a,b,c), y~Lam(d,e,f),
+ s~Delta(a,d), t~Delta(b,e), u~C(c,f);
+C(x,y) >< V => x~V, y~V;
+Delta(x,y) >< Delta(a,b) => x~a, y~b;
+B(x,a,b) >< Delta(c,d) => x~CB(a,b,Delta(c,d));
+Delta(a,b) >< CB(x,y,z) =>
+ x~Delta(c,d), y~Delta(e,f), z~Delta(B(a,c,e),B(b,d,f));
+Delta(x,y) >< S(z) =>
+ x~S(a), y~S(b), z~Delta(a,b);
+Delta(x,y) >< Z => x~Z, y~Z;
+Delta(x,y) >< V => x~V, y~V;
+Delta(x,y) >< C(t,s) =>
+ x~C(a,b), y~C(c,d), t~Delta(b,d), s~Delta(a,c);
+Delta(x,y) >< App(t,s) =>
+ x~App(a,b), y~App(c,d), t~Delta(a,c), s~Delta(b,d);
+Delta(x,y) >< Lam(t,s,u)=>
+ x~Lam(a,b,c), y~Lam(d,e,f),
+ t~Delta(a,d), s~Delta(b,e), u~Delta(c,f);
+DB(x,y,z) >< CB(t,s,u) =>
+ x~CB(d,e,u), y~CB(t,f,d), s~DB(e,f,z);
+C(x,y) >< CB(t,s,u) =>
+ x~CB(a,b,c), y~CB(d,e,f),
+ t~Delta(a,d), s~C(b,e), u~C(c,f);
+D >< CB(a,b,c) => a~c, b~D;
+
+Eps >< Eps => ;
+Eps >< S(x) => x~Eps;
+Eps >< V => ;
+Eps >< D =>;
+Eps >< Delta(t,s) => t~Eps,s~Eps;
+Eps >< Lam(t,s,u) => t~Eps,s~Eps,u~Eps;
+Eps >< App(t,s) => t~Eps,s~Eps;
+Eps >< B(t,s,u) => t~Eps,s~Eps,u~Eps;
+Eps >< CB(t,s,u) => t~Eps,s~Eps,u~Eps;
+
+
+// Execution
+id1 ~ Lam(i,i,V);
+id2 ~ Lam(i2,i2,V);
+two1 ~ Lam(Lam(a,b,c),B(c,C(App(a,d),App(d,b)),V),V);
+four1 ~ Lam(Lam(dz4, dx2, da1), B(da1, C(App(dz4, dz3), C(App(dz3, dz2), C(App(dz2, dz1), App(dz1, dx2)))), V), V);
+five3 ~ Lam(Lam(z53, x23, a13), B(a13, C(App(z53, z43), C(App(z43, z33), C(App(z33,z23), C(App(z23, z13), App(z13, x23))))), V), V);
+
+// 245II
+two1 ~ App(aux1, four1);
+aux1 ~ App(aux2, five3);
+aux2 ~ App(aux3, id1);
+aux3 ~ App(aux4, id2);
+aux4;
+exit;
diff --git a/sample/AckSZ-3_5.in b/sample/AckSZ-3_5.in
new file mode 100644
index 0000000..0d0ebe4
--- /dev/null
+++ b/sample/AckSZ-3_5.in
@@ -0,0 +1,18 @@
+// Ackermann function on unary natural numbers
+// fun ack(0,y) = y+1
+// | ack(x,0) = ack(x-1,1)
+// | ack(x,y) = ack(x-1,ack(x,y-1));
+//
+ack(r,y)>< Z => r~S(y);
+ack(r,y)>< S(x) => ack_Sx(r, x)~y;
+ack_Sx(r,x)>< Z => ack(r, S(Z))~x;
+ack_Sx(r,x)>< S(y) => dup(x1,x2)~x, ack(r,cnt)~x1, ack_Sx(cnt,x2)~y;
+
+
+dup(a1,a2)>< Z => a1~Z, a2~Z;
+dup(a1,a2)>< S(x) => a1~S(w1), a2~S(w2), dup(w1,w2)~x;
+
+// Ack 3 5
+ack(r, S(S(S(S(S(Z))))))~S(S(S(Z)));
+prnat r;
+exit;
diff --git a/sample/FibSZ_9.in b/sample/FibSZ_9.in
new file mode 100644
index 0000000..288a8bc
--- /dev/null
+++ b/sample/FibSZ_9.in
@@ -0,0 +1,29 @@
+// Fibonacci number on unary natural numbers
+fib(r)><Z => r~Z;
+fib(r)><S(x) => fibS(r)~x;
+fibS(r)><Z => r~S(Z);
+fibS(r)><S(x) => dup(x1,x2)~x, add(r,r2)~r1, fib(r2)~x2, fibS(r1)~x1;
+
+
+
+// ------ DUP ------
+dup(x1,x2)><Z => x1~Z, x2~Z;
+dup(x1,x2)><S(x) => x1~S(w1), x2~S(w2), dup(w1,w2)~x;
+
+
+//------ ADD ------
+//Add para
+add(r,x)><Z => r~x;
+add(r,x)><S(y) => r~S(w), add(w,x)~y;
+
+//Add_Seq
+//add(r,y)><Z => y~r;
+//add(r,y)><S(x) => add(r, S(y))~x;
+
+
+// Execution
+// Fib 9
+fib(r)~S(S(S(S(S(S(S(S(S(Z)))))))));
+prnat r;
+free r;
+
diff --git a/sample/ack_3_5.in b/sample/ack_3_5.in
new file mode 100644
index 0000000..87057a2
--- /dev/null
+++ b/sample/ack_3_5.in
@@ -0,0 +1,32 @@
+// Ackermann Function
+//
+// fun ack(0,n) = n+1
+// | ack(m,0) = ack(m-1,1)
+// | ack(m,n) = ack(m-1,ack(m,n-1));
+
+// The below rule is wrong because there is no gurantee that
+// the 'cnt' is an integer agent when ack(r)~(m-1,cnt) is evaluated.
+//
+// ack(r) >< (int m, int n)
+// | m==0 => r~(n+1)
+// | n==0 => ack(r) ~ (m-1,1)
+// | _ => ack(cnt)~(m,n-1), ack(r)~(m-1,cnt);
+
+
+ack(ret, n) >< (int m)
+| m==0 => inc(ret)~n
+| _ => ackn(ret, m)~n;
+
+ackn(ret, int m) >< (int n)
+| n==0 => ack(ret,1) ~ (m-1)
+| _ => ack(cnt,n-1)~m, ack(ret,cnt)~(m-1);
+
+inc(ret)><(int n) => ret~(n+1);
+
+
+ackMain(ret)><(int m, int n) => ack(ret,n)~m;
+
+ackMain(ret)~(3,5);
+ret;
+free ret;
+
diff --git a/sample/bsort.in b/sample/bsort.in
new file mode 100644
index 0000000..7b2e2d6
--- /dev/null
+++ b/sample/bsort.in
@@ -0,0 +1,18 @@
+// Bubble sort
+
+// Rules
+bsort(ret) >< [] => ret~[];
+bsort(ret) >< x:xs => bsort(ret)~cnt, bubble(cnt, x)~xs;
+bsort(ret) >< M(x) => ret~x;
+
+bubble(ret, int x) >< [] => ret~M([x]);
+bubble(ret, int x) >< M(w) => ret~M(x:w);
+bubble(ret, int x) >< (int y):ys
+| x<y => ret~(x:cnt), bubble(cnt, y)~ys
+| _ => ret~(y:cnt), bubble(cnt, x)~ys;
+
+
+// Nets
+bsort(r)~[3,6,1,9,2];
+r;
+
diff --git a/sample/fib-tail-38.in b/sample/fib-tail-38.in
new file mode 100644
index 0000000..5996337
--- /dev/null
+++ b/sample/fib-tail-38.in
@@ -0,0 +1,10 @@
+// Fibonacci number
+fibt(r, int a, int b) >< (int n)
+| n == 0 => r~1
+| n == 1 => r~a
+| _ => fibt(r, a+b, a) ~ (n-1);
+
+fibMain(r) >< (int n) => fibt(r, 1, 1) ~ n;
+
+fibMain(r)~9;
+r;
diff --git a/sample/fib-tail_9.in b/sample/fib-tail_9.in
new file mode 100644
index 0000000..58f4cc5
--- /dev/null
+++ b/sample/fib-tail_9.in
@@ -0,0 +1,10 @@
+// Fibonacci number
+fibt(r, int a, int b) >< (int n)
+| n == 0 => r~0
+| n == 1 => r~a
+| _ => fibt(r, a+b, a) ~ (n-1);
+
+fibMain(r) >< (int n) => fibt(r, 1, 0) ~ n;
+
+fibMain(r)~9;
+r;
diff --git a/sample/fib_9.in b/sample/fib_9.in
new file mode 100644
index 0000000..f4f17e8
--- /dev/null
+++ b/sample/fib_9.in
@@ -0,0 +1,16 @@
+// Fibonacci number
+
+// Rules
+fib(ret) >< (int n)
+| n == 0 => ret~0
+| n == 1 => ret~1
+| _ => fib(cnt1)~(n-1), fib(cnt2)~(n-2), Add(ret, cnt2)~cnt1;
+
+
+// Note: Add is implemented as a built-in agent such that:
+// Add(ret, int m) ~ (int n) --> ret~(n+m);
+
+// Nets
+fib(ret)~9;
+ret;
+
diff --git a/sample/gcd.in b/sample/gcd.in
new file mode 100644
index 0000000..e616e28
--- /dev/null
+++ b/sample/gcd.in
@@ -0,0 +1,16 @@
+// Greatest common divisor
+//
+//def gcd(a: Int, b: Int): Int =
+// if (b==0) a else gcd(b, a%b)
+
+
+// Rule
+gcd(ret) >< (int a, int b)
+| b==0 => ret ~ a
+| _ => gcd(ret) ~ (b, a%b);
+
+// Net
+gcd(r) ~ (14,21);
+r; // it should be 7
+
+
diff --git a/sample/isort.in b/sample/isort.in
new file mode 100644
index 0000000..e637055
--- /dev/null
+++ b/sample/isort.in
@@ -0,0 +1,15 @@
+// Insertion sort
+
+// Rules
+isort(ret) >< [] => ret~[];
+isort(ret) >< x:xs => insert(ret, x)~cnt, isort(cnt)~xs;
+
+insert(ret, int x) >< [] => ret~[x];
+insert(ret, int x) >< (int y):ys
+| x<=y => ret~(x:y:ys)
+| _ => ret~(y:cnt), insert(cnt, x)~ys;
+
+
+// Nets
+isort(r)~[3,6,1,9,2];
+r;
diff --git a/sample/linear-systemT.in b/sample/linear-systemT.in
new file mode 100644
index 0000000..648d9e1
--- /dev/null
+++ b/sample/linear-systemT.in
@@ -0,0 +1,142 @@
+// sample programs of linear-systemT (see POPL2016 paper)
+
+// Basic Rules ----------------------------------------
+Lamc(x,y) >< App(a,b) => a~x, b~y;
+Times(a,b) >< Par(x,y) => a~x, b~y;
+B(a,b,c) >< Lamc(x,y) => a~c, b~Lamc(x,y);
+V >< Lam(x,y,z) => z~Lamc(x,y);
+B(a,b,c)><S(x) => b~S(w), x~B(a,w,c); // original
+//B(a,b,c) >< S(x) => a~c, b~S(x); // alternative
+B(a,b,c) >< Z => a~c, b~Z;
+
+
+// Iterator ----------------------------------------
+Iter(r,n,u) >< Lamc(x,t) => n~Itc(u,x,t,r);
+Itc(u,x,t,r) >< Z => u~r,x~Eps,t~Eps;
+Itc(u,x,t,r) >< S(y) => y~Itc(t2,w,t1,r), x~Dup(w,u),t~Dup(t1,t2);
+
+// Dup ----------------------------------------
+Dup(x,y) >< Dup(a,b) => x~a, y~b;
+Dup(x,y) >< Lamc(a,b) => x~Lamc(w1,w2), y~Lamc(z1,z2), a~Dup(w1,z1), b~Dup(w2,z2);
+Dup(x,y) >< App(a,b) => x~App(w1,w2), y~App(z1,z2), a~Dup(w1,z1), b~Dup(w2,z2);
+Dup(x,y) >< Times(a,b) => x~Times(w1,w2), y~Times(z1,z2), a~Dup(w1,z1), b~Dup(w2,z2);
+Dup(x,y) >< Par(a,b) => x~Par(w1,w2), y~Par(z1,z2), a~Dup(w1,z1), b~Dup(w2,z2);
+Dup(x,y) >< V => x~V, y~V;
+
+Dup(a1,a2)>< Z => a1~Z, a2~Z;
+Dup(a1,a2)>< S(x) => a1~S(w1), a2~S(w2), x~Dup(w1,w2);
+
+
+Dup(x,y) >< Iter(a,b,c) =>
+ x~Iter(u1,w1,z1), y~Iter(u2,w2,z2),
+ a~Dup(u1,u2), b~Dup(w1,w2), c~Dup(z1,z2);
+
+Dup(x,y) >< Itc(a,b,c,d) =>
+ x~Itc(u1,w1,z1,k1), y~Itc(u2,w2,z2,k2),
+ a~Dup(u1,u2), b~Dup(w1,w2), c~Dup(z1,z2), d~Dup(k1,k2);
+
+
+/* needed */
+Dup(x,y) >< B(a,b,c) => x~B(u1,z1,w1), y~B(u2,z2,w2),
+ a~Dup(u1,u2), b~Dup(z1,z2), c~Dup(w1,w2);
+Dup(x,y) >< Lam(a,b,c) => x~Lam(w1,u1,z1), y~Lam(w2,u2,z2),
+ a~Dup(w1,w2), b~Dup(u1,u2), c~Dup(z1,z2);
+
+
+// Eps ----------------------------------------
+Eps >< Eps => ;
+Eps >< Dup(x,y) => Eps~x,Eps~y;
+Eps >< Lamc(x,y) => Eps~x,Eps~y;
+Eps >< App(x,y) => Eps~x, Eps~y;
+Eps >< Par(x,y) => Eps~x, Eps~y;
+Eps >< Times(x,y) => Eps~x, Eps~y;
+
+Eps >< S(x) => x~Eps;
+Eps >< Z => ;
+
+Eps >< Iter(a,b,c) => a~Eps, b~Eps, c~Eps;
+Eps >< Itc(a,b,c,d) => a~Eps, b~Eps, c~Eps,d~Eps;
+
+/* required */
+Eps >< B(a,b,c) => a~Eps, b~Eps, c~Eps;
+Eps >< Lam(a,b,c) => a~Eps, b~Eps, c~Eps;
+Eps >< V => ;
+
+
+// sample ----------------------------------------
+// Cp: nat -o nat Times nat
+n~S(S(Z)),
+cp~Lamc(x,r), Iter(r,x,Times(Z,Z))~Lamc(Par(a,b),Times(S(a),S(b)));
+cp~App(n,res);
+res;
+free res;
+
+// fst: nat Times nat -o nat
+pair~Times(S(S(S(Z))),S(Z)),
+fst~Lamc(Par(n,m), r), Iter(r,m,n)~Lamc(x,x);
+fst~App(pair,res);
+res;
+free res;
+
+// snd: nat Times nat -o nat
+pair~Times(S(S(S(Z))),S(Z)),
+snd~Lamc(Par(n,m), r), Iter(r,n,m)~Lamc(x,x);
+snd~App(pair,res);
+res;
+free res;
+
+
+// ((Add a) b)
+a~S(S(Z)), b~S(S(S(Z))),
+add~Lamc(B(V,u,Lam(n,r,r1)),r1), Iter(r,n,u)~Lamc(x,S(x));
+add~App(a,App(b,res));
+prnat res;
+free res;
+
+
+// ((Mult a) b)
+a~S(S(Z)), b~S(S(S(Z)));
+add~Lamc(B(V,au,Lam(an,ar,ar1)),ar1),Iter(ar,an,au)~Lamc(ax,S(ax)),
+App(n,Iter(r,m,Z))~add,
+mult~Lamc(B(V,n,Lam(m,r,r1)),r1);
+mult~App(a,App(b,res));
+prnat res;
+free res;
+
+// ((Exp a) b)
+a~S(S(Z)), b~S(S(S(Z)));
+add~Lamc(B(V,au,Lam(an,ar,ar1)),ar1),Iter(ar,an,au)~Lamc(ax,S(ax)),
+App(mn,Iter(mr,mm,Z))~add,
+mult~Lamc(B(V,mn,Lam(mm,mr,mr1)),mr1),
+App(n,Iter(r,m,S(Z)))~mult,
+exp~Lamc(B(V,n,Lam(m,r,r1)),r1);
+exp~App(a,App(b,res));
+prnat res;
+free res;
+
+
+// Ack 3 10
+// ver 1: the same as the example on the paper
+a~S(S(S(Z))),
+b~S(S(S(S(S(S(S(S(S(S(Z))))))))));
+Iter(t,x,Lamc(x1,S(x1)))~Lamc(B(V,Iter(r2,S(y),S(Z)),Lam(y,r2,r1)),r1),
+Lamc(x,t)~App(a,App(b, r));
+prnat r;
+free r;
+
+// ver 2: \m.(\n.(iter m (\x.(S x)) (\x.(\y.(iter (S y) (S 0) x))) n))
+a~S(S(S(Z))),
+b~S(S(S(S(S(S(S(S(S(S(Z))))))))));
+Iter(App(n,apr),x,Lamc(x1,S(x1)))~Lamc(B(V,Iter(r2,S(y),S(Z)),Lam(y,r2,r1)),r1),
+Lamc(B(V,x,Lam(n,apr,nr)),nr)~App(a,App(b, r));
+prnat r;
+free r;
+
+// ver 3: another encoding of ver 2.
+a~S(S(S(Z))),
+b~S(S(S(S(S(S(S(S(S(S(Z))))))))));
+Iter(t,m,Lamc(x1,S(x1)))~Lamc(B(V,Iter(r2,S(y),S(Z)),Lam(y,r2,r1)),r1),
+Lamc(m,t)~App(n,apr),
+Lamc(n,apr)~App(a,App(b, r));
+prnat r;
+free r;
diff --git a/sample/msort.in b/sample/msort.in
new file mode 100644
index 0000000..599990b
--- /dev/null
+++ b/sample/msort.in
@@ -0,0 +1,28 @@
+// Merge sort
+
+// Rules
+msort(ret) >< [] => ret~[];
+msort(ret) >< x:xs => ms_tail(ret, x)~xs;
+
+ms_tail(ret, n) >< [] => ret~[n];
+ms_tail(ret, n) >< x:xs =>
+ split(left,right) ~ (n:x:xs),
+ msort(a)~left, msort(b)~right, merge(ret,b)~a;
+
+merge(ret, snd) >< [] => ret~snd;
+merge(ret, snd) >< x:xs => mergeCC(ret, x, xs)~snd;
+
+mergeCC(ret, int y, ys) >< [] => ret~(y:ys);
+mergeCC(ret, int y, ys) >< (int x):xs
+| x <= y => ret~(x:cnt), mergeCC(cnt, y, ys) ~ xs
+| _ => ret~(y:cnt), mergeCC(cnt, x, xs) ~ ys;
+
+
+split(right,left) >< [] => right~[], left~[];
+split(right,left) >< x:xs =>
+ right~(x:cntl), left~cntr, split(cntr,cntl)~xs;
+
+
+// Nets
+msort(ret)~[3,6,1,9,2];
+ret; \ No newline at end of file
diff --git a/sample/processnet1.in b/sample/processnet1.in
new file mode 100644
index 0000000..d02404e
--- /dev/null
+++ b/sample/processnet1.in
@@ -0,0 +1,20 @@
+// Rules
+dup(a1,a2) >< (int i):xs => a1~(i:xs1), a2~(i:xs2), dup(xs1,xs2)~xs;
+dup(a1,a2) >< [] => a1~[], a2~[];
+
+inc(r) >< (int i):xs => r~(i+1):w, inc(w)~xs;
+inc(r) >< [] => r~[];
+
+
+// Nets
+dup(r,w)~r1, inc(r1) ~ (0:w);
+
+// +-----+ +-----+ +---+
+// r ----| | r1 | | | |
+// | dup |--->---| inc |---><---| 0 |----+
+// +---| | | | | | |
+// | +-----+ +-----+ +---+ |
+// | |
+// +-----------------------------------------+
+// w
+ \ No newline at end of file
diff --git a/sample/qsort.in b/sample/qsort.in
new file mode 100644
index 0000000..35de8e4
--- /dev/null
+++ b/sample/qsort.in
@@ -0,0 +1,21 @@
+// Quick sort
+
+// Rules
+qsort(ret) >< [] => ret~[];
+qsort(ret) >< (int x):xs =>
+ part(x, left, right)~xs,
+ qsort(cntl)~left, qsort(cntr)~right,
+ Append(ret, x:cntl)~cntr;
+
+// Note: `Append' is implemented as built-in.
+// Append(ret, a)~b --> ret ~ b@a
+
+part(int x, a, b) >< [] => a~[], b~[];
+part(int x, a, b) >< (int y):ys
+| y<x => b~(y:cnt), part(x, a, cnt)~ys
+| _ => a~(y:cnt), part(x, cnt, b)~ys;
+
+
+// Nets
+qsort(ret)~[3,6,1,9,2];
+ret; \ No newline at end of file
diff --git a/src/ast.c b/src/ast.c
new file mode 100644
index 0000000..ca46600
--- /dev/null
+++ b/src/ast.c
@@ -0,0 +1,331 @@
+//----------------------------------------
+// for AST
+//----------------------------------------
+//http://www.hpcs.cs.tsukuba.ac.jp/~msato/lecture-note/comp-lecture/tiny-c-note2.html
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "ast.h"
+
+#define MAX_SYMBOLS 256
+typedef struct {
+ char* sym[MAX_SYMBOLS];
+ int val[MAX_SYMBOLS];
+ int nth;
+} SymbolTable;
+
+SymbolTable SymTable, ConstTable;
+
+
+void SymTable_init(SymbolTable *table) {
+ int i;
+ table->nth = 0;
+ for (i=0; i<MAX_SYMBOLS; i++) {
+ table->sym[i] = NULL;
+ }
+}
+
+char *recordSymbol(SymbolTable *table, char *name) {
+ int i;
+ char *result;
+
+ for (i=0; i< table->nth; i++) {
+ if (strcmp(table->sym[i], name) == 0) {
+
+ // The `name' has existed already,
+ // and table->sym[i] is used instead of that,
+ // so starduped memory for the `name' should be freed here.
+ free(name);
+
+ return table->sym[i];
+ }
+ }
+
+ // inpla.l で strdup されているので、
+ // ここでは stardup せずに、単に ポインタを格納するだけ。
+ table->sym[table->nth]=name;
+ result = table->sym[table->nth];
+ table->nth++;
+ if (table->nth > MAX_SYMBOLS) {
+ puts("ERROR: The SymbolTable in AST library is too small.");
+ exit(-1);
+ }
+
+ return result;
+}
+
+int lookupEntry(SymbolTable *table, char *name) {
+ int i;
+
+ for (i=0; i< table->nth; i++) {
+ if (strcmp(table->sym[i], name) == 0) {
+ return i;
+ }
+ }
+ return -1;
+}
+
+void recordVal(SymbolTable *table, char *name, int val) {
+ int i;
+
+ for (i=0; i< table->nth; i++) {
+ if (strcmp(table->sym[i], name) == 0) {
+
+ // The `name' has existed already,
+ // and table->sym[i] is used instead of that,
+ // so starduped memory for the `name' should be freed here.
+ free(name);
+
+ table->val[i] = val;
+ return;
+ }
+ }
+ //table->sym[table->nth]=strdup(name);
+ table->sym[table->nth]=name;
+ table->val[table->nth]=val;
+ table->nth++;
+ if (table->nth > MAX_SYMBOLS) {
+ puts("ERROR: The SymbolTable in AST library is too small.");
+ exit(-1);
+ }
+
+}
+
+
+static Ast *AstHeap;
+static int NextPtr_AstHeap;
+#define MAX_AST_HEAP 10000
+
+void ast_heapInit(void) {
+
+ NextPtr_AstHeap = 0;
+ AstHeap = malloc(sizeof(Ast)*MAX_AST_HEAP);
+ if (AstHeap == NULL) {
+ printf("Malloc error [AstHeap]\n");
+ exit(-1);
+ }
+
+ SymTable_init(&SymTable);
+ SymTable_init(&ConstTable);
+}
+
+void ast_heapReInit(void) {
+ NextPtr_AstHeap = 0;
+}
+
+static Ast *ast_myalloc(void) {
+ Ast *ptr;
+
+ if (NextPtr_AstHeap < MAX_AST_HEAP) {
+ ptr=&AstHeap[NextPtr_AstHeap];
+ NextPtr_AstHeap++;
+ } else {
+ printf("[Error] All memory for AST was run out.\n");
+ exit(-1);
+ }
+
+ return ptr;
+}
+
+
+Ast *ast_makeSymbol(char *name) {
+ Ast *ptr;
+ ptr = ast_myalloc();
+ ptr->id = AST_SYM;
+ ptr->sym = recordSymbol(&SymTable, name);
+ return ptr;
+}
+
+Ast *ast_makeInt(int num) {
+ Ast *ptr;
+ ptr = ast_myalloc();
+ ptr->id = AST_INT;
+ ptr->intval = num;
+ return ptr;
+}
+
+void ast_recordConst(char *name, int val) {
+ recordVal(&ConstTable, name, val);
+}
+
+
+Ast *ast_makeAST(AST_ID id, Ast *left, Ast *right) {
+ Ast *ptr;
+ if ((id == AST_AGENT) && (right == NULL)) {
+ int entry = lookupEntry(&ConstTable, left->sym);
+ if (entry != -1) {
+
+ ptr = ast_myalloc();
+ ptr->id = AST_INT;
+ ptr->intval = ConstTable.val[entry];
+ return ptr;
+ }
+ }
+
+ ptr = ast_myalloc();
+ ptr->id = id;
+ ptr->right = right;
+ ptr->left = left;
+ return ptr;
+}
+
+int count_elem(Ast *p) {
+ int count=0;
+ while (p!=NULL) {
+ p = ast_getTail(p);
+ count++;
+ }
+ return count;
+}
+
+Ast *ast_makeTuple(Ast *tuple) {
+ Ast *ptr;
+ ptr = ast_myalloc();
+ ptr->id = AST_TUPLE;
+ ptr->right = tuple;
+ ptr->intval = count_elem(tuple);
+ return ptr;
+}
+
+Ast *ast_paramToCons(Ast *ast) {
+ // ast は List(a, List(b,NULL)) という astlist が入ってくるとして、
+ // これを AST_CONS(nonsym, a, AST_CONS(nonsym, b, AST_NIL())) と変換する
+
+ Ast *at = ast;
+ while (ast != NULL) {
+ at->id = AST_CONS;
+ if (at->right == NULL) {
+ Ast *ptr;
+ ptr = ast_myalloc();
+ ptr->id = AST_NIL;
+ at->right = ptr;
+ break;
+ }
+ at=at->right;
+ }
+ return ast;
+}
+
+
+
+Ast *ast_addLast(Ast *l, Ast *p)
+{
+ Ast *q;
+
+ if(l == NULL) return ast_makeAST(AST_LIST,p,NULL);
+ q = l;
+ while(q->right != NULL) q = q->right;
+ q->right = ast_makeAST(AST_LIST,p,NULL);
+ return l;
+}
+
+Ast *ast_getNth(Ast *p,int nth)
+{
+ if(p->id != AST_LIST){
+ fprintf(stderr,"bad access to list\n");
+ exit(1);
+ }
+ if(nth > 0) return(ast_getNth(p->right,nth-1));
+ else return p->left;
+}
+
+Ast *ast_getTail(Ast *p)
+{
+ if(p->id != AST_LIST){
+ fprintf(stderr,"bad access to list\n");
+ exit(1);
+ }
+ else return p->right;
+}
+
+void puts_ast(Ast *p) {
+ static char *string_AstID[] = {
+ // basic
+ "SYM", "NAME", "INTNAME", "AGENT", "CNCT", "RULE",
+ "BODY", "IF", "THEN_ELSE",
+
+ // LIST
+ "LIST",
+
+ // annotation
+ "(*L)", "(*R)",
+
+ // extension
+ "TUPLE",
+ "INT", "LD", "ADD", "SUB", "MUL", "DIV", "MOD",
+ "LT", "LE", "EQ", "NE", "UNM",
+ "CONS", "NIL", "OPCONS",
+ "RAND", "SRAND",
+
+ // default
+ "UNDEFINED",
+ };
+
+ if (p==NULL) {printf("NULL"); return;}
+
+ switch(p->id) {
+ case AST_INT:
+ printf("int %d", p->intval);
+ break;
+ case AST_SYM:
+ printf("%s", p->sym);
+ break;
+ case AST_TUPLE:
+ printf("TUPLE(%d)(", p->intval);
+ puts_ast(p->right);
+ printf(")");
+ break;
+ case AST_NIL:
+ printf("NIL");
+ break;
+ case AST_ANNOTATION_L:
+ case AST_ANNOTATION_R:
+ printf("%s", string_AstID[p->id]);
+ puts_ast(p->left);
+ break;
+ default:
+ printf("%s(", string_AstID[p->id]);
+ puts_ast(p->left);
+ printf(",");
+ puts_ast(p->right);
+ printf(")");
+
+ }
+}
+
+
+Ast *ast_remove_tuple1(Ast *p) {
+
+ if (p==NULL) return p;
+
+ switch(p->id) {
+ case AST_INT:
+ return p;
+ break;
+ case AST_SYM:
+ return p;
+ break;
+ case AST_TUPLE:
+ if (p->intval == 1) {
+ // (AST_TUPLE NULL (LIST left right))
+ p = p->right->left;
+ }
+ p->right = ast_remove_tuple1(p->right);
+ return p;
+ break;
+ case AST_NIL:
+ return p;
+ break;
+ case AST_ANNOTATION_L:
+ case AST_ANNOTATION_R:
+ p->left = ast_remove_tuple1(p->left);
+ return p;
+ break;
+ default:
+ p->left = ast_remove_tuple1(p->left);
+ p->right = ast_remove_tuple1(p->right);
+ return p;
+
+ }
+}
diff --git a/src/ast.h b/src/ast.h
new file mode 100644
index 0000000..0acc5bb
--- /dev/null
+++ b/src/ast.h
@@ -0,0 +1,62 @@
+// http://www.hpcs.cs.tsukuba.ac.jp/~msato/lecture-note/comp-lecture/tiny-c/AST.h
+
+#ifndef _AST_
+#define _AST_
+
+typedef enum {
+ AST_SYM=0, AST_NAME, AST_INTVAR, AST_AGENT, AST_CNCT, AST_RULE,
+ AST_BODY, AST_IF, AST_THEN_ELSE,
+
+ // this is for ASTLIST
+ AST_LIST,
+
+ // annotation
+ AST_ANNOTATION_L, AST_ANNOTATION_R,
+
+ // builtin tuble
+ AST_TUPLE,
+
+ // operation
+ AST_INT, AST_LD, AST_PLUS, AST_SUB, AST_MUL, AST_DIV, AST_MOD,
+ AST_LT, AST_LE, AST_EQ, AST_NE, AST_UNM,
+
+ // for built-in lists
+ AST_CONS, AST_NIL, AST_OPCONS,
+
+ // for built-in agents
+
+ AST_RAND, AST_SRAND,
+
+} AST_ID;
+
+
+typedef struct abstract_syntax_tree {
+ AST_ID id;
+ int intval;
+ char *sym;
+ struct abstract_syntax_tree *left,*right;
+} Ast;
+
+void ast_heapInit(void);
+void ast_heapReInit(void);
+Ast *ast_makeSymbol(char *name);
+Ast *ast_makeInt(int num);
+Ast *ast_makeAST(AST_ID id, Ast *left, Ast *right);
+Ast *ast_makeTuple(Ast *tuple);
+Ast *ast_addLast(Ast *l, Ast *p);
+Ast *ast_getNth(Ast *p,int nth);
+Ast *ast_getTail(Ast *p);
+void puts_ast(Ast *p);
+Ast *ast_paramToCons(Ast *ast);
+void ast_recordConst(char *name, int val);
+Ast *ast_remove_tuple1(Ast *p);
+
+
+#define ast_makeCons(x1,x2) ast_makeAST(AST_LIST,x1,x2)
+#define ast_makeList1(x1) ast_makeAST(AST_LIST,x1,NULL)
+#define ast_makeList2(x1,x2) ast_makeAST(AST_LIST,x1,ast_makeAST(AST_LIST,x2,NULL))
+#define ast_makeList3(x1,x2,x3) ast_makeAST(AST_LIST,x1,ast_makeAST(AST_LIST,x2,ast_makeAST(AST_LIST,x3,NULL)))
+#define getFirst(p) getNth(p,0)
+
+
+#endif
diff --git a/src/cas_spinlock.h b/src/cas_spinlock.h
new file mode 100644
index 0000000..cb2dabd
--- /dev/null
+++ b/src/cas_spinlock.h
@@ -0,0 +1,11 @@
+//#define CAS_LOCK_USLEEP 4
+#define CAS_LOCK_USLEEP 200
+
+static inline void lock(volatile int *aexclusion) {
+ while (__sync_lock_test_and_set(aexclusion, 1))
+ while (*aexclusion)
+ usleep(CAS_LOCK_USLEEP);
+}
+static inline void unlock(volatile int *aexclusion) {
+ __sync_lock_release(aexclusion);
+}
diff --git a/src/id_table.c b/src/id_table.c
new file mode 100644
index 0000000..b7b267b
--- /dev/null
+++ b/src/id_table.c
@@ -0,0 +1,171 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "ast.h"
+#include "id_table.h"
+
+
+static IdTableT IdTable[IDTABLE_SIZE];
+
+static int NextAgentId, NextGnameId;
+
+void IdTable_init() {
+
+ int i;
+ NextAgentId = START_ID_OF_AGENT -1;
+ NextGnameId = START_ID_OF_GNAME -1;
+ // 0 : ID_INT(used in expressions)
+ // 1 .. START_ID_OF_AGENT-1 : built-in agents
+ // START_IS_OF_AGENT .. NUM_AGENTS-1: user defined agents
+ // NUM_AGENTS(=ID_NAME) .. : names
+
+ for (i=0; i<IDTABLE_SIZE; i++) {
+ IdTable[i].arity = -1;
+ IdTable[i].name = NULL;
+ }
+
+ // built-in agent
+ IdTable[ID_TUPLE0].arity = 0;
+ IdTable[ID_TUPLE1].arity = 1;
+ IdTable[ID_TUPLE2].arity = 2;
+ IdTable[ID_TUPLE3].arity = 3;
+ IdTable[ID_TUPLE4].arity = 4;
+ IdTable[ID_TUPLE5].arity = 5;
+ IdTable[ID_NIL].arity = 0;
+ IdTable[ID_CONS].arity = 2;
+ IdTable[ID_INTAGENT].arity = 1;
+
+ IdTable[ID_ADD].arity = 2;
+ IdTable[ID_ADD2].arity = 2;
+ // IdTable[ID_APPEND].arity = 2;
+ // IdTable[ID_APPEND2].arity = 2;
+
+ IdTable[ID_INT].name = "int";
+ IdTable[ID_TUPLE0].name = "Tuple0";
+ IdTable[ID_TUPLE1].name = "Tuple1";
+ IdTable[ID_TUPLE2].name = "Tuple2";
+ IdTable[ID_TUPLE3].name = "Tuple3";
+ IdTable[ID_TUPLE4].name = "Tuple4";
+ IdTable[ID_TUPLE5].name = "Tuple5";
+ IdTable[ID_NIL].name = "[]";
+ IdTable[ID_CONS].name = "Cons";
+ IdTable[ID_INTAGENT].name = "Int";
+
+ IdTable[ID_ADD].name = "Add";
+ IdTable[ID_ADD2].name = "Add2";
+ IdTable[ID_APPEND].name = "Append";
+ IdTable[ID_APPEND2].name = "Append2";
+}
+
+
+int IdTable_getid_builtin_funcAgent(Ast *agent) {
+ // returns -1 if the agent is not built-in.
+
+ int id = -1;
+
+ if (agent->id != AST_AGENT) {
+ return -1;
+ }
+
+ if (strcmp((char *)agent->left->sym, "Add2") == 0) {
+ id = ID_ADD2;
+ } else if (strcmp((char *)agent->left->sym, "Add") == 0) {
+ id = ID_ADD;
+ } else if (strcmp((char *)agent->left->sym, "Append") == 0) {
+ id = ID_APPEND;
+ } else if (strcmp((char *)agent->left->sym, "Append2") == 0) {
+ id = ID_APPEND2;
+ } else if (strcmp((char *)agent->left->sym, "Int") == 0) {
+ id = ID_INTAGENT;
+ }
+
+ return id;
+}
+
+
+int IdTable_is_builtin_rule(Ast *agentL, Ast *agentR) {
+ // puts_ast(agentL);
+ // printf(" ");
+ // puts_ast(agentR);
+ // printf("\n");
+
+
+ if ( (agentL->id == AST_TUPLE) && (agentR->id == AST_TUPLE) ) {
+ // compare these arities
+ if (agentL->intval == agentR->intval) {
+ return 1;
+ }
+ return 0;
+ }
+
+ int idL = IdTable_getid_builtin_funcAgent(agentL);
+ if (agentR->id == AST_INT) {
+ if ((idL == ID_ADD) || (idL == ID_ADD2)) {
+ return 1;
+ }
+ return 0;
+ }
+
+ if (idL == ID_APPEND) {
+ if ((agentR->id == AST_CONS) || (agentR->id == AST_NIL)) {
+ return 1;
+ }
+ return 0;
+ }
+
+ return 0;
+}
+
+
+void IdTable_set_name(int id, char *symname)
+{
+ if (id > IDTABLE_SIZE) {
+ printf("Error: The given id %d was beyond of the size of IdTable (%d)\n",
+ id, IDTABLE_SIZE);
+ exit(-1);
+ }
+ IdTable[id].name = symname;
+}
+
+
+void IdTable_set_arity(int id, int arity)
+{
+ if ((IdTable[id].arity == -1) || (IdTable[id].arity == arity)) {
+ IdTable[id].arity = arity;
+ } else {
+ printf("Warning: The agent '%s' has been already defined as whose arity is %d, but now redefined as the arity is %d.\n",
+ IdTable[id].name, IdTable[id].arity, arity);
+ IdTable[id].arity = arity;
+ }
+}
+
+
+char *IdTable_get_name(int id)
+{
+ return IdTable[id].name;
+}
+
+int IdTable_get_arity(int id)
+{
+ return IdTable[id].arity;
+}
+
+int IdTable_new_agentid() {
+ NextAgentId++;
+ if (NextAgentId > ID_NAME) {
+ printf("ERROR: The number of agents exceeded the size of agents in SYMTABLE (%d)\n",
+ ID_NAME);
+ exit(-1);
+ }
+ return(NextAgentId);
+}
+
+int IdTable_new_gnameid() {
+ NextGnameId++;
+ if (NextAgentId > IDTABLE_SIZE) {
+ printf("ERROR: The number of agents exceeded the size of names in SYMTABLE (%d)\n",
+ ID_NAME);
+ exit(-1);
+ }
+ return(NextGnameId);
+}
diff --git a/src/id_table.h b/src/id_table.h
new file mode 100644
index 0000000..8dbdeef
--- /dev/null
+++ b/src/id_table.h
@@ -0,0 +1,75 @@
+#ifndef _ID_TABLE_
+#define _ID_TABLE_
+
+
+// When NUM_AGENT is 256:
+// 0 .. 255: AGENT
+// 256 : NAME,
+// 257 .. : GNAME
+
+
+#define ID_INT 0
+
+// builtin を加えたら void IdTable_init() 内で
+// IdTable に arity と 表示方法の登録を忘れないように！
+#define ID_TUPLE0 1
+#define ID_TUPLE1 2
+#define ID_TUPLE2 3
+#define ID_TUPLE3 4
+#define ID_TUPLE4 5
+#define ID_TUPLE5 6
+#define GET_TUPLEID(arity) (ID_TUPLE0+arity)
+#define IS_TUPLEID(id) ((id >= ID_TUPLE0) && (id <= ID_TUPLE5))
+#define GET_TUPLEARITY(id) (id - ID_TUPLE0)
+
+#define ID_NIL 7
+#define ID_CONS 8
+#define IS_LISTID(id) ((id == ID_NIL) && (id == ID_CONS))
+
+#define ID_INTAGENT 9
+
+#define START_ID_OF_BUILTIN_AGENT 10
+#define ID_ADD 10
+#define ID_ADD2 11
+#define ID_APPEND 12
+#define ID_APPEND2 13
+#define END_ID_OF_BUILTIN_AGENT 13
+
+
+#define START_ID_OF_AGENT 20
+//#define NUM_AGENTS 1024
+#define END_ID_OF_AGENT 255
+#define NUM_AGENTS END_ID_OF_AGENT+1 // 256
+
+#define ID_NAME NUM_AGENTS // 256
+#define START_ID_OF_GNAME ID_NAME+1
+#define IS_AGENTID(a) (a < ID_NAME)
+#define IS_NAMEID(a) (a >= ID_NAME)
+#define IS_GNAMEID(a) (a > ID_NAME)
+#define IS_LOCAL_NAMEID(a) (a == ID_NAME)
+#define IS_BUILTIN_AGENTID(a) (a <= END_ID_OF_BUILTIN_AGENT)
+#define SET_LOCAL_NAMEID(a) (a = ID_NAME)
+
+/**************************************
+ TABLE for SYMBOLS
+**************************************/
+typedef struct {
+ char *name;
+ int arity;
+} IdTableT;
+
+#define IDTABLE_SIZE (NUM_AGENTS)*2 // AGENT + NAME
+
+void IdTable_init();
+void IdTable_set_name(int id, char *symname);
+void IdTable_set_arity(int id, int arity);
+char *IdTable_get_name(int id);
+int IdTable_get_arity(int id);
+int IdTable_new_agentid();
+int IdTable_new_gnameid();
+
+int IdTable_getid_builtin_funcAgent(Ast *agent);
+int IdTable_is_builtin_rule(Ast *agentL, Ast *agentR);
+
+
+#endif
diff --git a/src/inpla.l b/src/inpla.l
new file mode 100644
index 0000000..5547d32
--- /dev/null
+++ b/src/inpla.l
@@ -0,0 +1,191 @@
+%{
+#include <stdio.h>
+#include <stdlib.h>
+#include "linenoise/linenoise.h"
+
+#undef YY_INPUT
+#define YY_INPUT(buf,result,max_size) result = mygetinput(buf, max_size);
+
+// lineno de kubetu?
+static int mygetinput(char *buf, int size) {
+ char *line;
+ if (feof(yyin)) return YY_NULL;
+
+ if (yyin!=stdin) {
+ int len;
+ char ch;
+ for (len = 0; len < size; len++) {
+ ch = getc(yyin);
+ if (ch == EOF)
+ break;
+ buf[len] = ch;
+ }
+ return len;
+ }
+
+ if (yylineno == 1) {
+ line = linenoise(">>> ");
+ } else {
+ line = linenoise("... ");
+ }
+ if(!line) return YY_NULL;
+ if(strlen(line) > size-2){
+ fprintf(stderr,"input line too long\n"); return YY_NULL; }
+ sprintf(buf,"%s\n",line);
+ linenoiseHistoryAdd(line);
+ //linenoiseHistorySave(".inpla.history.txt");
+ free(line);
+ return strlen(buf);
+}
+
+
+//#undef YY_INPUT
+//#define YYINPUT(buf, result, max_size) result = (c == EOF) ? YY_NULL : (buf[0] = c, 1);
+
+
+/************************************
+ Strings
+*************************************/
+#define MAX_STRING_LENGTH 1024
+static char ParseStringBuffer[MAX_STRING_LENGTH];
+static int nextPtr_ParseStringBuffer = 0;
+void Parse_StringBuffer_reInit() {
+ nextPtr_ParseStringBuffer = 0;
+}
+
+void Parse_addString(char ch) {
+ ParseStringBuffer[nextPtr_ParseStringBuffer] = ch;
+ nextPtr_ParseStringBuffer++;
+}
+
+char *Parse_closeStringBuffer() {
+ char *ret;
+ ParseStringBuffer[nextPtr_ParseStringBuffer]='\0';
+ ret = ParseStringBuffer;
+ return ret;
+}
+
+
+
+%}
+
+%option nounput
+%option yylineno
+%option noyywrap
+%x STRING_STATE COM_STATE
+%%
+<INITIAL>";" return (DELIMITER);
+<INITIAL>":" return (COLON);
+<INITIAL>"(" return (LP);
+<INITIAL>")" return (RP);
+<INITIAL>"{" return LC;
+<INITIAL>"}" return RC;
+<INITIAL>"[" return LB;
+<INITIAL>"]" return RB;
+<INITIAL>"," return (COMMA);
+<INITIAL>"><" return (CROSS);
+<INITIAL>"=>" return (TO);
+<INITIAL>"~" return (CNCT);
+<INITIAL>"-" return (SUB);
+<INITIAL>"|" return(PIPE);
+<INITIAL>"&" return(AMP);
+<INITIAL>"=" return(LD);
+<INITIAL>"==" return(EQUAL);
+<INITIAL>"!=" return(NE);
+<INITIAL>">" return(GT);
+<INITIAL>">=" return(GE);
+<INITIAL>"<" return(LT);
+<INITIAL>"<=" return(LE);
+<INITIAL>"+" return (ADD);
+<INITIAL>"*" return (MUL);
+<INITIAL>"/" return (DIV);
+<INITIAL>"%" return (MOD);
+<INITIAL>"_" return (ANY);
+<INITIAL>"?" return (QUE);
+
+<INITIAL>"int" return(INT);
+
+<INITIAL>"let" return(LET);
+<INITIAL>"in" return(IN);
+<INITIAL>"end" return(END);
+
+<INITIAL>"where" return(WHERE);
+
+<INITIAL>"if" return(IF);
+<INITIAL>"then" return(THEN);
+<INITIAL>"else" return(ELSE);
+
+<INITIAL>"interface" return(INTERFACE);
+<INITIAL>"ifce" return(IFCE);
+
+<INITIAL>"prnat" return(PRNAT);
+<INITIAL>"free" return(FREE);
+<INITIAL>"exit" return(EXIT);
+
+<INITIAL>"rand" return(RAND);
+
+<INITIAL>"const" return(DEF);
+
+<INITIAL>"use" return(USE);
+
+<INITIAL>"*L" return(ANNOTATE_L);
+<INITIAL>"*R" return(ANNOTATE_R);
+<INITIAL>[a-z][a-zA-Z0-9_'\.]* { yylval.chval = strdup(yytext);
+ return (NAME);}
+<INITIAL>[_A-Z][a-zA-Z0-9_'\.]* { yylval.chval = strdup(yytext);
+ return (AGENT);}
+<INITIAL>[0-9]+ { yylval.intval = atoi(yytext);
+ return (INT_LITERAL);}
+
+<INITIAL>"//"[^\n]* ; //comment
+<INITIAL>"/*" BEGIN(COM_STATE);
+<COM_STATE>. ;
+<COM_STATE>\n ;
+<COM_STATE>"*/" BEGIN INITIAL; //comment
+
+<INITIAL>\r\n {}
+<INITIAL>[\n|\r] {}
+<INITIAL>[ \t]+ ;
+<INITIAL><<EOF>> {return END_OF_FILE;}
+<INITIAL>\" {
+ Parse_StringBuffer_reInit();
+ BEGIN STRING_STATE;
+}
+
+<INITIAL>. {return yytext[0];}
+
+
+
+
+<STRING_STATE>\" {
+ yylval.chval = strdup(Parse_closeStringBuffer());
+ BEGIN INITIAL;
+ return STRING_LITERAL;
+}
+<STRING_STATE>\n {
+// Parse_addString('\n');
+yyerror("Unterminated string");
+BEGIN(INITIAL);
+return DELIMITER;
+}
+<STRING_STATE>\\\" Parse_addString('"');
+<STRING_STATE>\\n Parse_addString('\n');
+<STRING_STATE>\\t Parse_addString('\t');
+<STRING_STATE>\\\\ Parse_addString('\\');
+<STRING_STATE>. Parse_addString(yytext[0]);
+%%
+
+void pushFP(FILE *fp) {
+ yypush_buffer_state(yy_create_buffer(fp, YY_BUF_SIZE));
+}
+
+int popFP() {
+ yypop_buffer_state();
+ if (! YY_CURRENT_BUFFER ) {
+ yyterminate();
+ return 0;
+ }
+ return 1;
+}
+
+
diff --git a/src/inpla.y b/src/inpla.y
new file mode 100644
index 0000000..3de93c1
--- /dev/null
+++ b/src/inpla.y
@@ -0,0 +1,7606 @@
+%{
+#define _GNU_SOURCE
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <errno.h>
+#include <sched.h>
+
+#include "ast.h"
+#include "id_table.h"
+#include "name_table.h"
+
+#include "timer.h" //#include <time.h>
+
+//#define DEBUG
+#define COUNT_INTERACTION // count of interaction
+
+//#define COUNT_CNCT // count of execution of JMP_CNCT
+
+//#define COUNT_MKAGENT // count of execution fo mkagent
+//#define CELL_USE_VERBOSE // count of memory access
+
+
+
+/**************************************
+ NAME TABLE
+**************************************/
+//#include "name_table.h"
+
+
+// ----------------------------------------------
+
+int MaxThreadNum=1;
+
+#ifdef THREAD
+#include <pthread.h>
+extern int pthread_setconcurrency(int concurrency);
+
+int ActiveThreadNum=0;
+
+// for cas spinlock
+#include "cas_spinlock.h"
+
+#endif
+
+//#define YYDEBUG 1
+
+#define VERSION "0.4.1"
+#define BUILT_DATE "22 Sept. 2021"
+
+extern FILE *yyin;
+
+
+
+// It means 'available' when its on 31bit flag is '1'
+#define FLAG_AVAIL 0x01 << 31
+#define IS_FLAG_AVAIL(a) ((a) & FLAG_AVAIL)
+#define SET_FLAG_AVAIL(a) ((a) = ((a) | FLAG_AVAIL))
+#define TOGGLE_FLAG_AVAIL(a) ((a) = ((a) ^ FLAG_AVAIL))
+
+
+#include "mytype.h"
+
+// Equation
+typedef struct EQ_tag {
+ VALUE l, r;
+} EQ;
+
+typedef struct EQList_tag {
+ EQ eq;
+ struct EQList_tag *next;
+} EQList;
+
+
+
+
+
+
+
+void makeRule(Ast *ast);
+void freeAgentRec(VALUE ptr);
+
+//static inline void freeName(VALUE ptr);
+void freeName(VALUE ptr);
+
+//static inline void freeAgent(VALUE ptr);
+void freeAgent(VALUE ptr);
+
+//void puts_name_port0(VALUE ptr);
+//void flush_name_port0(VALUE ptr);
+void puts_names_ast(Ast *ast);
+void free_names_ast(Ast *ast);
+void puts_name_port0_nat(VALUE ptr);
+void puts_term(VALUE ptr);
+void puts_aplist(EQList *at);
+void PushEQStack(VALUE l, VALUE r);
+
+
+int exec(Ast *st);
+int destroy(void);
+int AstHeap_MakeAgent(int arity, char *name, int *port);
+int AstHeap_MakeTerm(char *name);
+int AstHeap_MakeName(char *name);
+
+
+
+extern int yylex();
+int yyerror();
+#define YY_NO_INPUT
+extern int yylineno;
+
+#define MY_YYLINENO // For error message when nested source files are used.
+#ifdef MY_YYLINENO
+ typedef struct InfoLinenoType_tag {
+ char *fname;
+ int yylineno;
+ struct InfoLinenoType_tag *next;
+ } InfoLinenoType;
+static InfoLinenoType *InfoLineno;
+
+#define initInfoLineno() InfoLineno = NULL;
+
+void InfoLineno_Push(char *fname, int lineno) {
+ InfoLinenoType *aInfo;
+ aInfo = (InfoLinenoType *)malloc(sizeof(InfoLinenoType));
+ if (aInfo == NULL) {
+ printf("[InfoLineno]Malloc error\n");
+ exit(-1);
+ }
+ aInfo->next = InfoLineno;
+ aInfo->yylineno = lineno+1;
+ aInfo->fname = strdup(fname);
+
+ InfoLineno = aInfo;
+}
+
+void InfoLineno_Free() {
+ InfoLinenoType *aInfo;
+ free(InfoLineno->fname);
+ aInfo = InfoLineno;
+ InfoLineno = InfoLineno->next;
+ free(aInfo);
+}
+
+void InfoLineno_AllDestroy() {
+ // InfoLinenoType *aInfo;
+ while (InfoLineno != NULL) {
+ InfoLineno_Free();
+ }
+}
+
+#endif
+
+
+extern void pushFP(FILE *fp);
+extern int popFP();
+
+
+static char *Errormsg = NULL; // yyerror でメッセージが出ないように、ここに格納する
+
+
+//#define YYDEBUG 1
+//#define YYERROR_VERBOSE 1
+//int yydebug = 1;
+
+/*
+extern void eat_to_newline(void);
+void eat_to_newline(void)
+{
+ int c;
+ while ((c = getchar()) != EOF && c != '\n')
+ ;
+}
+*/
+
+%}
+%union{
+ int intval;
+ char *chval;
+ Ast *ast;
+}
+
+%token <chval> NAME AGENT
+%token <intval> INT_LITERAL
+%token <chval> STRING_LITERAL
+%token LP RP LC RC LB RB COMMA CROSS DELIMITER QUE
+%token COLON
+%token TO CNCT
+
+%token ANNOTATE_L ANNOTATE_R
+
+%token PIPE AMP LD EQUAL NE GT GE LT LE
+%token ADD SUB MUL DIV MOD INT LET IN END IF THEN ELSE ANY WHERE RAND DEF
+%token INTERFACE IFCE PRNAT FREE EXIT
+%token END_OF_FILE USE
+
+%type <ast> body astterm astterm_item nameterm agentterm astparam astparams
+val_declare
+rule
+ap aplist
+stm stmlist_nondelimiter
+stmlist
+expr additive_expr equational_expr relational_expr unary_expr
+multiplicative_expr primary_expr agent_tuple agent_list agent_cons
+bodyguard bd_else bd_elif bd_compound
+if_sentence if_compound
+name_params
+ //body
+
+%nonassoc REDUCE
+%nonassoc RP
+
+%right COLON
+ //%right LD
+ //%right EQ
+ //%left NE GE GT LT
+ //%left ADD SUB
+ //%left MULT DIV
+
+%%
+s
+: error DELIMITER {
+ yyclearin;
+ yyerrok;
+ puts(Errormsg);
+ free(Errormsg);
+ ast_heapReInit();
+ if (yyin == stdin) yylineno=0;
+ // YYACCEPT;
+ YYABORT;
+}
+| DELIMITER {
+ if (yyin == stdin) yylineno=0;
+ YYACCEPT;
+}
+| body DELIMITER
+{
+ exec($1); // $1 is a list such as [stmlist, aplist]
+ ast_heapReInit();
+ if (yyin == stdin) yylineno=0;
+ YYACCEPT;
+}
+| rule DELIMITER {
+ makeRule($1);
+ if (yyin == stdin) yylineno=0;
+ YYACCEPT;
+}
+| command {
+ if (yyin == stdin) yylineno=0;
+ YYACCEPT;
+}
+;
+
+
+
+// body は [stmlist, aplist] というリスト
+// ==> (AST_BODY stmlist aplist) に変更
+body
+: aplist { $$ = ast_makeAST(AST_BODY, NULL, $1); }
+| aplist WHERE stmlist_nondelimiter { $$ = ast_makeAST(AST_BODY, $3, $1);}
+| aplist WHERE { $$ = ast_makeAST(AST_BODY, NULL, $1);}
+| LET stmlist IN aplist END { $$ = ast_makeAST(AST_BODY, $2, $4);}
+| LET stmlist DELIMITER IN aplist END { $$ = ast_makeAST(AST_BODY, $2, $5);}
+| LET IN aplist END { $$ = ast_makeAST(AST_BODY, NULL, $3);}
+| LC stmlist RC aplist { $$ = ast_makeAST(AST_BODY, $2, $4);}
+| LC stmlist DELIMITER RC aplist { $$ = ast_makeAST(AST_BODY, $2, $5);}
+;
+
+// rule は下記に変更
+// (ASTRULE (AST_CNCT agentL agentR)
+// <if-sentence>)
+//
+// WHERE
+// <if-sentence> ::= (AST_IF guard (AST_BRANCH <then> <else>))
+// | <body>
+// | NULL
+// <then> ::= <if-sentence>
+// <else> ::= <if-sentence>
+
+
+rule
+: astterm CROSS astterm TO
+{ $$ = ast_makeAST(AST_RULE, ast_makeAST(AST_CNCT, $1, $3),
+ NULL); }
+
+| astterm CROSS astterm TO body
+{ $$ = ast_makeAST(AST_RULE, ast_makeAST(AST_CNCT, $1, $3),
+ $5); }
+
+
+| astterm CROSS astterm TO if_sentence
+{ $$ = ast_makeAST(AST_RULE, ast_makeAST(AST_CNCT, $1, $3),
+ $5); }
+
+
+| astterm CROSS astterm bodyguard
+{ $$ = ast_makeAST(AST_RULE, ast_makeAST(AST_CNCT, $1, $3),
+ $4); }
+;
+
+
+name_params
+: NAME
+{ $$ = ast_makeList1(ast_makeSymbol($1)); }
+| name_params NAME
+{ $$ = ast_addLast($1, ast_makeSymbol($2)); }
+;
+
+command:
+| FREE name_params DELIMITER
+{
+ free_names_ast($2);
+}
+| FREE DELIMITER
+| FREE IFCE DELIMITER
+{
+ NameTable_free_all();
+}
+| FREE INTERFACE DELIMITER
+{
+ NameTable_free_all();
+}
+| name_params DELIMITER
+{
+ puts_names_ast($1);
+}
+
+| PRNAT NAME DELIMITER
+{
+ puts_name_port0_nat(NameTable_get_heap($2));
+}
+| INTERFACE DELIMITER
+{
+ NameTable_puts_all();
+}
+| IFCE DELIMITER
+{
+ NameTable_puts_all();
+}
+| EXIT DELIMITER {destroy(); exit(0);}
+| USE STRING_LITERAL DELIMITER {
+ // http://flex.sourceforge.net/manual/Multiple-Input-Buffers.html
+ yyin = fopen($2, "r");
+ if (!yyin) {
+ printf("Error: The file '%s' does not exist.\n", $2);
+ free($2);
+ yyin = stdin;
+
+ } else {
+#ifdef MY_YYLINENO
+ InfoLineno_Push($2, yylineno+1);
+ yylineno = 0;
+#endif
+
+ pushFP(yyin);
+ }
+}
+| error END_OF_FILE {}
+| END_OF_FILE {
+ if (!popFP()) {
+ destroy(); exit(-1);
+ }
+#ifdef MY_YYLINENO
+ yylineno = InfoLineno->yylineno;
+ InfoLineno_Free();
+ destroy();
+#endif
+
+
+}
+| DEF AGENT LD INT_LITERAL DELIMITER {
+ ast_recordConst($2,$4);
+ }
+;
+
+
+bodyguard
+: PIPE expr TO bd_compound bd_elif
+{ $$ = ast_makeAST(AST_IF, $2, ast_makeAST(AST_THEN_ELSE, $4, $5));}
+;
+
+bd_compound
+: body
+| bodyguard
+;
+
+bd_elif
+: bd_else
+| PIPE expr TO bd_compound bd_elif
+{ $$ = ast_makeAST(AST_IF, $2, ast_makeAST(AST_THEN_ELSE, $4, $5));}
+;
+
+bd_else
+: PIPE ANY TO bd_compound
+{ $$ = $4; }
+;
+
+
+
+// if_sentence
+if_sentence
+: IF expr THEN if_compound ELSE if_compound
+{ $$ = ast_makeAST(AST_IF, $2, ast_makeAST(AST_THEN_ELSE, $4, $6));}
+;
+
+if_compound
+: if_sentence
+| body
+;
+
+
+
+// AST -----------------
+astterm
+: LP ANNOTATE_L RP astterm_item
+{ $$=ast_makeAST(AST_ANNOTATION_L, $4, NULL); }
+| LP ANNOTATE_R RP astterm_item
+{ $$=ast_makeAST(AST_ANNOTATION_R, $4, NULL); }
+//| astterm_item COLON astterm_item
+| astterm_item COLON astterm // h:t
+{$$ = ast_makeAST(AST_OPCONS, NULL, ast_makeList2($1, $3)); }
+| astterm_item
+;
+
+
+astterm_item
+ : agentterm
+ | agent_tuple
+ | agent_list
+ | agent_cons
+ | val_declare
+ | expr %prec REDUCE
+;
+
+val_declare
+: INT NAME { $$ = ast_makeAST(AST_INTVAR, ast_makeSymbol($2), NULL); }
+;
+
+agent_cons
+: LB astterm PIPE astterm RB
+{$$ = ast_makeAST(AST_OPCONS, NULL, ast_makeList2($2, $4)); }
+;
+
+agent_list
+: LB RB { $$ = ast_makeAST(AST_NIL, NULL, NULL); }
+| LB astparams RB { $$ = ast_paramToCons($2); }
+;
+
+agent_tuple
+: astparam { $$ = ast_makeTuple($1);}
+;
+
+nameterm
+: NAME {$$=ast_makeAST(AST_NAME, ast_makeSymbol($1), NULL);}
+
+agentterm
+: AGENT astparam
+{ $$=ast_makeAST(AST_AGENT, ast_makeSymbol($1), $2); }
+| NAME astparam
+{ $$=ast_makeAST(AST_AGENT, ast_makeSymbol($1), $2); }
+;
+
+
+astparam :
+LP RP { $$ = NULL; }
+| LP astparams RP { $$ = $2; }
+;
+
+astparams
+: astterm { $$ = ast_makeList1($1); }
+| astparams COMMA astterm { $$ = ast_addLast($1, $3); }
+;
+
+ap
+: astterm CNCT astterm { $$ = ast_makeAST(AST_CNCT, $1, $3); }
+;
+
+aplist
+: ap { $$ = ast_makeList1($1); }
+| aplist COMMA ap { $$ = ast_addLast($1, $3); }
+;
+
+stm
+: nameterm LD expr { $$ = ast_makeAST(AST_LD, $1, $3); }
+
+stmlist
+: stm { $$ = ast_makeList1($1); }
+| stmlist DELIMITER stm { $$ = ast_addLast($1, $3); }
+
+stmlist_nondelimiter
+: stm { $$ = ast_makeList1($1); }
+| stmlist_nondelimiter stm { $$ = ast_addLast($1, $2); }
+
+
+expr
+: equational_expr
+;
+
+equational_expr
+: relational_expr
+| equational_expr EQUAL relational_expr { $$ = ast_makeAST(AST_EQ, $1, $3); }
+| equational_expr NE relational_expr { $$ = ast_makeAST(AST_NE, $1, $3); }
+
+relational_expr
+: additive_expr
+| relational_expr LT additive_expr { $$ = ast_makeAST(AST_LT, $1, $3); }
+| relational_expr LE additive_expr { $$ = ast_makeAST(AST_LE, $1, $3); }
+| relational_expr GT additive_expr { $$ = ast_makeAST(AST_LT, $3, $1); }
+| relational_expr GE additive_expr { $$ = ast_makeAST(AST_LE, $3, $1); }
+;
+
+additive_expr
+: multiplicative_expr
+| additive_expr ADD multiplicative_expr { $$ = ast_makeAST(AST_PLUS, $1, $3); }
+| additive_expr SUB multiplicative_expr { $$ = ast_makeAST(AST_SUB, $1, $3); }
+;
+
+multiplicative_expr
+: unary_expr
+| multiplicative_expr MUL primary_expr { $$ = ast_makeAST(AST_MUL, $1, $3); }
+| multiplicative_expr DIV primary_expr { $$ = ast_makeAST(AST_DIV, $1, $3); }
+| multiplicative_expr MOD primary_expr { $$ = ast_makeAST(AST_MOD, $1, $3); }
+
+
+unary_expr
+: primary_expr
+| SUB primary_expr { $$ = ast_makeAST(AST_UNM, $2, NULL); }
+| RAND LP primary_expr RP { $$ = ast_makeAST(AST_RAND, $3, NULL); }
+;
+
+primary_expr
+: nameterm { $$ = $1;}
+| INT_LITERAL { $$ = ast_makeInt($1); }
+| AGENT { $$=ast_makeAST(AST_AGENT, ast_makeSymbol($1), NULL); }
+| LP expr RP { $$ = $2; }
+
+;
+
+%%
+
+
+
+int yyerror(char *s) {
+ extern char *yytext;
+ char msg[256];
+ //printf("%s\nSorry, this version does not support error recovery.\n",s);
+ // printf("%s\n",s);
+
+#ifdef MY_YYLINENO
+ if (InfoLineno != NULL) {
+ sprintf(msg, "%s:%d: %s near token '%s'.\n",
+ InfoLineno->fname, yylineno+1, s, yytext);
+ } else {
+ sprintf(msg, "%d: %s near token '%s'.\n",
+ yylineno, s, yytext);
+ }
+#else
+ sprintf(msg, "%d: %s near token '%s'.\n", yylineno, s, yytext);
+#endif
+
+ Errormsg = strdup(msg);
+ // printf("%d: %s near token '%s'\n", yylineno, s, yytext);
+
+ if (yyin != stdin) {
+ // puts(Errormsg);
+ destroy();
+ // exit(0);
+ }
+
+ return 0;
+}
+
+
+
+
+/**************************************
+ TABLE for SYMBOLS
+**************************************/
+//#include "id_table.h"
+
+
+
+
+/**********************************
+ Heap
+*********************************/
+
+typedef struct Heap_tag {
+ VALUE *heap;
+ int lastAlloc;
+ unsigned int size;
+} Heap;
+
+
+/**********************************
+ VIRTUAL MACHINE
+*********************************/
+#define VM_LOCALVAR_SIZE 200
+#define VM_OFFSET_META_L(a) (a)
+#define VM_OFFSET_META_R(a) (MAX_PORT+(a))
+#define VM_OFFSET_ANNOTATE_L (MAX_PORT*2)
+#define VM_OFFSET_ANNOTATE_R (MAX_PORT*2+1)
+#define VM_OFFSET_LOCALVAR (MAX_PORT*2+2)
+
+
+
+typedef struct {
+ // AgentHeap, nameHeap, valHeap
+ // Heap agentHeap, nameHeap, valHeap;
+ Heap agentHeap, nameHeap;
+
+ // EQStack
+ EQ *eqStack;
+ int nextPtr_eqStack;
+ unsigned int eqStack_size;
+
+
+ // code execution
+ VALUE agentReg[VM_LOCALVAR_SIZE+(MAX_PORT*2 + 2)];
+
+ unsigned int id;
+#ifdef COUNT_INTERACTION
+ unsigned int NumberOfInteraction;
+
+#endif
+
+} VirtualMachine;
+
+#ifndef THREAD
+static VirtualMachine VM;
+#endif
+
+#ifdef COUNT_MKAGENT
+ unsigned int NumberOfMkAgent;
+ // unsigned int id;
+#endif
+
+
+/*************************************
+ AGENT Heap
+**************************************/
+
+//#define MALLOC
+
+
+
+void VM_InitBuffer(VirtualMachine *vm, int size) {
+
+#ifndef MALLOC
+ int i;
+
+ // Agent Heap
+
+ //vm->agentHeap.lastAlloc = size-1;
+ vm->agentHeap.lastAlloc = 0;
+ vm->agentHeap.heap = (VALUE *)malloc(sizeof(Agent)*size);
+ vm->agentHeap.size = size;
+ if (vm->agentHeap.heap == (VALUE *)NULL) {
+ printf("[Heap]Malloc error\n");
+ exit(-1);
+ }
+ for (i=0; i<size; i++) {
+ SET_FLAG_AVAIL(((Agent *)(vm->agentHeap.heap))[i].basic.id);
+ }
+
+
+ // Name Heap
+
+ //size = size/2;
+ vm->nameHeap.lastAlloc = size-1;
+ //vm->nameHeap.lastAlloc = 0;
+ vm->nameHeap.heap = (VALUE *)malloc(sizeof(Name)*size);
+ vm->nameHeap.size = size;
+ if (vm->nameHeap.heap == (VALUE *)NULL) {
+ printf("[Heap]Malloc error\n");
+ exit(-1);
+ }
+ for (i=0; i<size; i++) {
+ ((Name *)(vm->nameHeap.heap))[i].basic.id = ID_NAME;
+ SET_FLAG_AVAIL(((Name *)(vm->nameHeap.heap))[i].basic.id);
+ // ((Name *)(vm->nameHeap.heap))[i].name = NULL;
+ }
+
+
+ /*
+ vm->valHeap.lastAlloc = VAL_HEAP_SIZE-1;
+ vm->valHeap.heap = (VALUE *)malloc(sizeof(Agent)*VAL_HEAP_SIZE);
+ vm->valHeap.size = VAL_HEAP_SIZE;
+ if (vm->valHeap.heap == (VALUE *)NULL) {
+ printf("[Val]Malloc error\n");
+ exit(-1);
+ }
+ for (i=0; i<VAL_HEAP_SIZE; i++) {
+ SET_FLAG_AVAIL(((Val *)(vm->valHeap.heap))[i].basic.id);
+ }
+ */
+
+#endif
+}
+
+
+
+static inline
+VALUE myallocAgent(Heap *hp) {
+
+#ifdef MALLOC
+ Agent *ptr;
+ ptr = malloc(sizeof(Agent));
+ return ptr;
+#else
+
+ int i, idx, hp_size;
+ Agent *hp_heap;
+
+ hp_size = hp->size;
+ hp_heap = (Agent *)(hp->heap);
+
+ idx = hp->lastAlloc-1;
+
+ for (i=0; i < hp_size; i++) {
+ // if (!IS_FLAG_AVAIL(((Agent *)hp_heap)[idx].basic.id)) {
+ if (!IS_FLAG_AVAIL(hp_heap[idx].basic.id)) {
+ idx++;
+ if (idx >= hp_size) {
+ idx -= hp_size;
+ }
+ continue;
+ }
+ // TOGGLE_FLAG_AVAIL(((Agent *)hp_heap)[idx].basic.id);
+ TOGGLE_FLAG_AVAIL(hp_heap[idx].basic.id);
+
+ hp->lastAlloc = idx;
+
+ // return (VALUE)&(((Agent *)hp_heap)[idx]);
+ return (VALUE)&(hp_heap[idx]);
+ }
+
+ printf("\nCritical ERROR: All %d term cells have been consumed.\n", hp->size);
+ printf("You should have more term cells with -c option.\n");
+ exit(-1);
+
+#endif
+
+}
+
+
+static inline
+VALUE myallocName(Heap *hp) {
+
+#ifdef MALLOC
+ Agent *ptr;
+ ptr = malloc(sizeof(Name));
+ return ptr;
+#else
+
+ int i,idx,hp_size;
+ Name *hp_heap;
+
+ hp_size = hp->size;
+ hp_heap = (Name *)(hp->heap);
+
+ idx = hp->lastAlloc;
+
+
+ for (i=0; i < hp_size; i++) {
+ // if (!IS_FLAG_AVAIL(((Name *)hp->heap)[idx].basic.id)) {
+ if (!IS_FLAG_AVAIL(hp_heap[idx].basic.id)) {
+ idx++;
+ if (idx >= hp_size) {
+ idx -= hp_size;
+ }
+ continue;
+ }
+ // TOGGLE_FLAG_AVAIL(((Name *)hp->heap)[idx].basic.id);
+ TOGGLE_FLAG_AVAIL(hp_heap[idx].basic.id);
+
+ hp->lastAlloc = idx;
+
+ // return (VALUE)&(((Name *)hp->heap)[idx]);
+ return (VALUE)&(hp_heap[idx]);
+ }
+
+ printf("\nCritical ERROR: All %d name cells have been consumed.\n", hp->size);
+ printf("You should have more term cells with -c option.\n");
+ exit(-1);
+
+#endif
+
+}
+
+
+unsigned long getNumOfAvailNameHeap(Heap *hp) {
+ int i;
+ unsigned long total=0;
+ for (i=0; i < hp->size; i++) {
+ if (IS_FLAG_AVAIL( ((Name *)hp->heap)[i].basic.id)) {
+ total++;
+ }
+ }
+ return total;
+}
+unsigned long getNumOfAvailAgentHeap(Heap *hp) {
+ int i;
+ unsigned long total=0;
+ for (i=0; i < hp->size; i++) {
+ if (IS_FLAG_AVAIL( ((Agent *)hp->heap)[i].basic.id)) {
+ total++;
+ }
+ }
+ return total;
+}
+
+
+
+
+/*
+VALUE myallocVal(Heap *hp) {
+
+#ifdef MALLOC
+ Agent *ptr;
+ ptr = malloc(sizeof(Agent));
+ return ptr;
+#else
+
+ int i,idx;
+
+ idx = hp->lastAlloc;
+
+ for (i=0; i < hp->size; i++) {
+ if (!IS_FLAG_AVAIL(((Val *)hp->heap)[idx].basic.id)) {
+ idx++;
+ if (idx >= hp->size) {
+ idx -= hp->size;
+ }
+ continue;
+ }
+ TOGGLE_FLAG_AVAIL(((Val *)hp->heap)[idx].basic.id);
+ hp->lastAlloc = idx;
+ return (VALUE)&(((Val *)hp->heap)[idx]);
+ }
+
+ printf("\nCritical ERROR: All %d term cells have been consumed.\n", hp->size);
+ printf("You should have more term cells with -c option.\n");
+ exit(-1);
+
+#endif
+
+}
+*/
+
+
+
+//static inline
+void myfree(VALUE ptr) {
+
+#ifdef MALLOC
+
+ if (ptr == NULL) return;
+ free(ptr);
+ ptr = NULL;
+#else
+
+ TOGGLE_FLAG_AVAIL(BASIC(ptr)->id);
+#endif
+
+}
+
+
+//static inline
+VALUE makeAgent(VirtualMachine *vm, int id) {
+ VALUE ptr;
+ ptr = myallocAgent(&vm->agentHeap);
+
+#ifdef COUNT_MKAGENT
+ NumberOfMkAgent++;
+#endif
+
+ AGENT(ptr)->basic.id = id;
+ return ptr;
+}
+
+
+
+static inline
+VALUE makeName(VirtualMachine *vm) {
+ VALUE ptr;
+
+ ptr = myallocName(&vm->nameHeap);
+ // AGENT(ptr)->basic.id = ID_NAME;
+ NAME(ptr)->port = (VALUE)NULL;
+
+ return ptr;
+}
+
+
+/*
+VALUE makeVal_int(VirtualMachine *vm, int num) {
+ VALUE ptr;
+ ptr = myallocVal(&vm->agentHeap);
+
+ BASIC(ptr)->id = ID_INT;
+ RVAL(ptr)->u.intval = num;
+ return ptr;
+}
+*/
+
+
+/**********************************
+ Counter for Interaction times
+*********************************/
+#ifdef COUNT_INTERACTION
+int VM_GetInteractionNum(VirtualMachine *vm) {
+ return(vm->NumberOfInteraction);
+}
+
+void VM_ClearInteractionNum(VirtualMachine *vm) {
+ vm->NumberOfInteraction = 0;
+}
+#endif
+
+
+
+
+
+
+
+
+
+
+//-----------------------------------------
+// Pretty printing for terms
+//-----------------------------------------
+
+static VALUE ShowNameHeap=(VALUE)NULL; // showname で表示するときの cyclic 防止
+// showname 時に、呼び出し変数の heap num を入れておく。
+// showname 呼び出し以外は NULL に。
+
+void puts_name(VALUE ptr) {
+
+ if (ptr == (VALUE)NULL) {
+ printf("[NULL]");
+ return;
+ }
+
+ if (IS_GNAMEID(BASIC(ptr)->id)) {
+ printf("%s", IdTable_get_name(BASIC(ptr)->id));
+ } else if (BASIC(ptr)->id == ID_NAME) {
+ printf("<var%lu>", (unsigned long)(ptr));
+ } else {
+ puts_term(ptr);
+ }
+
+}
+
+
+#define PRETTY_VAR
+#ifdef PRETTY_VAR
+typedef struct PrettyList_tag {
+ VALUE id;
+ char *name;
+ struct PrettyList_tag *next;
+} PrettyList;
+
+typedef struct {
+ PrettyList *list;
+ int alphabet;
+ int index;
+ char namebuf[10];
+} PrettyStruct;
+
+PrettyStruct Pretty;
+
+#define MAX_PRETTY_ALPHABET 26
+void Pretty_init(void) {
+ Pretty.alphabet = -1;
+ Pretty.list = NULL;
+ Pretty.index = 1;
+}
+
+PrettyList *PrettyList_new(void) {
+ PrettyList *alist;
+ alist = malloc(sizeof(PrettyList));
+ if (alist == NULL) {
+ printf("[PrettyList] Malloc error\n");
+ exit(-1);
+ }
+ return alist;
+}
+
+char *Pretty_newName(void) {
+ Pretty.alphabet++;
+ if (Pretty.alphabet >= MAX_PRETTY_ALPHABET) {
+ Pretty.alphabet = 0;
+ Pretty.index++;
+ }
+ sprintf(Pretty.namebuf, "%c%d", 'a'+Pretty.alphabet, Pretty.index);
+ return(Pretty.namebuf);
+}
+
+PrettyList *PrettyList_recordName(VALUE a) {
+ PrettyList *alist;
+ alist = PrettyList_new();
+ alist->id = a;
+ alist->name = strdup(Pretty_newName());
+ alist->next = Pretty.list;
+ Pretty.list = alist;
+ return (alist);
+}
+
+char *Pretty_Name(VALUE a) {
+ PrettyList *alist;
+ if (Pretty.list == NULL) {
+ alist = PrettyList_recordName(a);
+ Pretty.list = alist;
+ return (alist->name);
+ } else {
+ PrettyList *at = Pretty.list;
+ while (at != NULL) {
+ if (at->id == a) {
+ return (at->name);
+ }
+ at = at->next;
+ }
+
+ alist = PrettyList_recordName(a);
+ Pretty.list = alist;
+ return (alist->name);
+ }
+}
+#endif
+
+
+#define PUTS_ELEMENTS_NUM 12
+static int Puts_list_element=0;
+
+
+
+static int PutIndirection = 1; // put t for x->t when it is 1
+void puts_term(VALUE ptr) {
+ if (IS_FIXNUM(ptr)) {
+ printf("%d", FIX2INT(ptr));
+ return;
+ } else if (BASIC(ptr) == NULL) {
+ printf("[NULL]");
+ return;
+ }
+
+ if (IS_NAMEID(BASIC(ptr)->id)) {
+ if (NAME(ptr)->port == (VALUE)NULL) {
+ if (IS_GNAMEID(BASIC(ptr)->id)) {
+ //printf("%s", NAME(ptr)->name);
+ printf("%s", IdTable_get_name(BASIC(ptr)->id));
+ } else {
+#ifndef PRETTY_VAR
+ printf("<var%lu>", (unsigned long)(ptr));
+#else
+ printf("<%s>", Pretty_Name(ptr));
+#endif
+ }
+ } else {
+ if (ptr == ShowNameHeap) {
+ printf("<Warning:%s is cyclic>", IdTable_get_name(BASIC(ptr)->id));
+ return;
+ }
+
+ if ((PutIndirection) &&
+ (IdTable_get_name(BASIC(ptr)->id) != NULL)) {
+ printf("%s", IdTable_get_name(BASIC(ptr)->id));
+ } else {
+ puts_term(NAME(ptr)->port);
+ }
+
+ }
+
+ } else if (IS_TUPLEID(BASIC(ptr)->id)) {
+ int i, arity;
+ arity = GET_TUPLEARITY(BASIC(ptr)->id);
+ printf("(");
+ for (i=0; i<arity; i++) {
+ puts_term(AGENT(ptr)->port[i]);
+ if (i != arity - 1) {
+ printf(",");
+ }
+ }
+ printf(")");
+
+ } else if (BASIC(ptr)->id == ID_NIL) {
+ printf("[]");
+
+ } else if (BASIC(ptr)->id == ID_CONS) {
+ printf("[");
+
+ while (ptr != (VALUE)NULL) {
+ puts_term(AGENT(ptr)->port[0]);
+
+ ptr = AGENT(ptr)->port[1];
+ while ((IS_NAMEID(BASIC(ptr)->id)) && (NAME(ptr)->port != (VALUE)NULL)) {
+ ptr = NAME(ptr)->port;
+ }
+ if (BASIC(ptr)->id == ID_NIL) {
+ printf("]");
+ Puts_list_element=0;
+ break;
+ }
+
+ if ((IS_NAMEID(BASIC(ptr)->id)) && (NAME(ptr)->port == (VALUE)NULL)) {
+ // for WHNF
+ printf(",");
+ puts_term(ptr);
+ printf("...");
+ break;
+ }
+
+ printf(",");
+
+ Puts_list_element++;
+ if (Puts_list_element > PUTS_ELEMENTS_NUM) {
+ printf("...]");
+ break;
+ }
+
+ }
+
+ } else {
+ // Agent
+ int i, arity;
+
+ arity = IdTable_get_arity(AGENT(ptr)->basic.id);
+ printf("%s", IdTable_get_name(AGENT(ptr)->basic.id));
+ if (arity != 0) {
+ printf("(");
+ }
+ for (i=0; i<arity; i++) {
+ puts_term(AGENT(ptr)->port[i]);
+ if (i != arity - 1) {
+ printf(",");
+ }
+ }
+ if (arity != 0) {
+ printf(")");
+ }
+ }
+}
+
+
+void puts_name_port0(VALUE ptr) {
+
+ if (ptr == (VALUE)NULL) {
+ printf("<NON-DEFINED>");
+
+ } else if (IS_NAMEID(BASIC(ptr)->id)) {
+ if (NAME(ptr)->port == (VALUE)NULL) {
+ printf("<EMPTY>");
+ } else {
+ ShowNameHeap=ptr;
+ puts_term(NAME(ptr)->port);
+ ShowNameHeap=(VALUE)NULL;
+ }
+ } else {
+ puts("ERROR: it is not a name.");
+ }
+
+}
+
+void puts_names_ast(Ast *ast) {
+ Ast *param = ast;
+
+ int preserve = PutIndirection;
+ PutIndirection = 0;
+
+ while (param != NULL) {
+ char *sym = param->left->sym;
+ puts_name_port0(NameTable_get_heap(sym));
+ param = ast_getTail(param);
+ if (param != NULL)
+ printf(" ");
+
+ }
+ puts("");
+
+ PutIndirection = preserve;
+}
+
+void flush_name_port0(VALUE ptr) {
+ if (ptr == (VALUE)NULL) {
+ return;
+ }
+
+ if (IS_FIXNUM(ptr)) {
+ return;
+ }
+
+ // 使っている name を管理する Hash に記録があるなら flush しない
+ VALUE connected_from;
+ if (keynode_exists_in_another_term(ptr, &connected_from) >= 1) {
+ printf("Error: '%s' cannot be freed because it is referred to by '%s'.\n",
+ IdTable_get_name(BASIC(ptr)->id),
+ IdTable_get_name(BASIC(connected_from)->id));
+
+ return;
+ }
+
+
+ if (NAME(ptr)->port == (VALUE)NULL) {
+ freeName(ptr);
+ } else {
+ ShowNameHeap=ptr;
+ freeAgentRec(NAME(ptr)->port);
+ freeName(ptr);
+ ShowNameHeap=(VALUE)NULL;
+ }
+
+
+#ifdef CELL_USE_VERBOSE
+#ifndef THREAD
+ printf("(%lu agents and %lu names cells are used.)\n",
+ VM.agentHeap.size - getNumOfAvailAgentHeap(&VM.agentHeap),
+ VM.nameHeap.size - getNumOfAvailNameHeap(&VM.nameHeap));
+#endif
+#endif
+
+}
+
+void free_names_ast(Ast *ast) {
+ Ast *param = ast;
+
+ while (param != NULL) {
+ char *sym = param->left->sym;
+ flush_name_port0(NameTable_get_heap(sym));
+ param = ast_getTail(param);
+ }
+}
+
+
+void puts_name_port0_nat(VALUE a1) {
+ int result=0;
+ int idS, idZ;
+ idS = NameTable_get_set_id("S");
+ idZ = NameTable_get_set_id("Z");
+
+ if (a1 == (VALUE)NULL) {
+ printf("<NUll>");
+ } else if (!IS_NAMEID(BASIC(a1)->id)) {
+ printf("<NON-NAME>");
+ } else {
+ if (NAME(a1)->port == (VALUE)NULL) {
+ printf("<EMPTY>");
+ } else {
+
+ a1=NAME(a1)->port;
+ while (BASIC(a1)->id != idZ) {
+ if (BASIC(a1)->id == idS) {
+ result++;
+ a1=AGENT(a1)->port[0];
+ } else if (IS_NAMEID(BASIC(a1)->id)) {
+ a1=NAME(a1)->port;
+ } else {
+ puts("ERROR: puts_name_port0_nat");
+ exit(-1);
+ }
+ }
+ printf("%d\n", result);
+ }
+ }
+
+}
+
+
+
+void puts_eqlist(EQList *at) {
+ while (at != NULL) {
+ puts_term(at->eq.l);
+ printf("~");
+ puts_term(at->eq.r);
+ printf(",");
+ at=at->next;
+ }
+}
+
+
+/**************************************
+ Free node allocation
+**************************************/
+
+//static inline
+void freeAgent(VALUE ptr) {
+
+ if (ptr == (VALUE)NULL) {puts("ERROR: NULL is applied to freeAgent."); return;}
+
+ myfree(ptr);
+}
+
+//static inline
+void freeName(VALUE ptr) {
+ if (ptr == (VALUE)NULL) {puts("ERROR: NULL is applied to freeName."); return;}
+
+ if (IS_LOCAL_NAMEID(BASIC(ptr)->id)) {
+ myfree(ptr);
+ } else {
+ // Global name
+
+ NameTable_erase(IdTable_get_name(BASIC(ptr)->id));
+ // BASIC(ptr)->id = ID_NAME;
+ SET_LOCAL_NAMEID(BASIC(ptr)->id);
+ myfree(ptr);
+ }
+
+}
+
+
+void freeAgentRec(VALUE ptr) {
+
+ loop:
+ if ((IS_FIXNUM(ptr)) || (ptr == (VALUE)NULL)) {
+ return;
+ } else if (IS_NAMEID(BASIC(ptr)->id)) {
+ if (ptr == ShowNameHeap) return;
+
+ if (NAME(ptr)->port != (VALUE)NULL) {
+ VALUE port = NAME(ptr)->port;
+ freeName(ptr);
+ ptr = port; goto loop;
+ } else {
+
+ // The name is kept living if it occurs anywhere as a global.
+ if (keynode_exists_in_another_term(ptr, NULL) < 2) {
+ freeName(ptr);
+ }
+ }
+ } else {
+ if (BASIC(ptr)->id == ID_CONS) {
+ if (IS_FIXNUM(AGENT(ptr)->port[0])) {
+ VALUE port1 = AGENT(ptr)->port[0];
+ freeAgent(ptr);
+ ptr = port1; goto loop;
+ }
+ }
+
+
+ int arity;
+ arity = IdTable_get_arity(AGENT(ptr)->basic.id);
+ if (arity == 1) {
+ VALUE port1 = AGENT(ptr)->port[0];
+ freeAgent(ptr);
+ ptr = port1; goto loop;
+ } else {
+ freeAgent(ptr);
+ // printf(" .");
+ int i;
+ for(i=0; i<arity; i++) {
+ freeAgentRec(AGENT(ptr)->port[i]);
+ }
+ }
+ }
+}
+
+
+
+
+
+
+
+/**************************************
+ NAME TABLE
+**************************************/
+//#include "name_table.h"
+// Just include it, because the bbject file version causes *inefficiency* !
+#include "name_table.c"
+
+
+
+/*************************************
+ Exec STACK
+**************************************/
+
+#ifdef THREAD
+static pthread_cond_t EQStack_not_empty = PTHREAD_COND_INITIALIZER;
+static pthread_mutex_t Sleep_lock = PTHREAD_MUTEX_INITIALIZER;
+static pthread_mutex_t AllSleep_lock = PTHREAD_MUTEX_INITIALIZER;
+#endif
+
+
+
+// GlobalEQStack for execution with threads
+#ifdef THREAD
+typedef struct {
+ EQ *stack;
+ int nextPtr;
+ int size;
+ volatile int lock; // for lightweight spin lock
+} EQStack;
+static EQStack GlobalEQS;
+#endif
+
+
+#ifdef THREAD
+void GlobalEQStack_Init(int size) {
+ GlobalEQS.nextPtr = -1;
+ GlobalEQS.stack = malloc(sizeof(EQ)*size);
+ GlobalEQS.size = size;
+ if (GlobalEQS.stack == NULL) {
+ printf("Malloc error\n");
+ exit(-1);
+ }
+ // for cas_lock
+ GlobalEQS.lock = 0;
+}
+#endif
+
+void VM_EQStackInit(VirtualMachine *vm, int size) {
+ vm->nextPtr_eqStack = -1;
+ vm->eqStack = malloc(sizeof(EQ)*size);
+ vm->eqStack_size = size;
+ if (vm->eqStack == NULL) {
+ printf("Malloc error\n");
+ exit(-1);
+ }
+}
+
+
+void VM_PushEQStack(VirtualMachine *vm, VALUE l, VALUE r) {
+
+ vm->nextPtr_eqStack++;
+
+ if (vm->nextPtr_eqStack >= vm->eqStack_size) {
+ printf("Critical ERROR: Overflow of the EQ stack.\n");
+ printf("You should have larger size by '-x option'.\n");
+ printf("Please see help by using -h option.\n");
+ exit(-1);
+ }
+ vm->eqStack[vm->nextPtr_eqStack].l = l;
+ vm->eqStack[vm->nextPtr_eqStack].r = r;
+
+#ifdef DEBUG
+ //DEBUG
+ printf(" PUSH:");
+ puts_term(l);
+ puts("");
+ puts(" ><");
+ printf(" ");puts_term(r);
+ puts("");
+#endif
+
+
+ // printf("VM%d:pushed\n", vm->id);
+}
+
+int VM_PopEQStack(VirtualMachine *vm, VALUE *l, VALUE *r) {
+ if (vm->nextPtr_eqStack >= 0) {
+ *l = vm->eqStack[vm->nextPtr_eqStack].l;
+ *r = vm->eqStack[vm->nextPtr_eqStack].r;
+ vm->nextPtr_eqStack--;
+ return 1;
+ }
+ return 0;
+}
+
+
+#ifdef THREAD
+void PushEQStack(VALUE l, VALUE r) {
+
+
+
+ lock(&GlobalEQS.lock);
+
+ GlobalEQS.nextPtr++;
+ if (GlobalEQS.nextPtr >= GlobalEQS.size) {
+ printf("Critical ERROR: Overflow of the execution (coequation) stack.\n");
+ printf("You should have larger size.\n");
+ printf("Please see help by using -h option.\n");
+ exit(-1);
+ }
+ GlobalEQS.stack[GlobalEQS.nextPtr].l = l;
+ GlobalEQS.stack[GlobalEQS.nextPtr].r = r;
+
+ unlock(&GlobalEQS.lock);
+
+ if (ActiveThreadNum < MaxThreadNum) {
+ pthread_mutex_lock(&Sleep_lock);
+ pthread_cond_signal(&EQStack_not_empty);
+ pthread_mutex_unlock(&Sleep_lock);
+ }
+
+}
+#endif
+
+
+int PopEQStack(VirtualMachine *vm, VALUE *l, VALUE *r) {
+
+ if (vm->nextPtr_eqStack >= 0) {
+ *l = vm->eqStack[vm->nextPtr_eqStack].l;
+ *r = vm->eqStack[vm->nextPtr_eqStack].r;
+ vm->nextPtr_eqStack--;
+
+ /*
+#ifdef DEBUG
+ puts("");
+ puts("====================================");
+ puts("POP");
+ puts("====================================");
+ puts_term(*l);
+ puts("");
+ puts("><");
+ puts_term(*r);
+ puts("");
+ puts("====================================");
+#endif
+ */
+
+ return 1;
+ }
+#ifndef THREAD
+ return 0;
+#else
+
+ lock(&GlobalEQS.lock);
+
+ if (GlobalEQS.nextPtr < 0) {
+ // GlobalEQStack is empty
+ unlock(&GlobalEQS.lock);
+ return 0;
+ }
+
+ *l = GlobalEQS.stack[GlobalEQS.nextPtr].l;
+ *r = GlobalEQS.stack[GlobalEQS.nextPtr].r;
+ GlobalEQS.nextPtr--;
+
+ unlock(&GlobalEQS.lock);
+
+ return 1;
+#endif
+}
+
+
+#ifdef DEBUG
+void VM_EQStack_allputs(VirtualMachine *vm) {
+ int i;
+ if (vm->nextPtr_eqStack == -1) return;
+ for (i=0; i<=vm->nextPtr_eqStack+1; i++) {
+ printf("%02d: ", i); puts_term(vm->eqStack[i].l);
+ puts("");
+ printf(" ");
+ puts_term(vm->eqStack[i].r);
+ puts("");
+ }
+}
+#endif
+
+
+/* --------------------
+// Linearity check
+
+#ifdef DEBUG
+int VM_EQStack_name_occur(VALUE a, VALUE t) {
+ if (IS_NAMEID(BASIC(t)->id)) {
+ if (a == t) {
+ // puts_term(a); printf(" occurs in "); puts_term(t);puts("");
+ return 1;
+ }
+ return 0;
+ } else {
+ // Agent
+ int i, arity;
+
+ arity = IdTable_get_arity(AGENT(t)->basic.id);
+ for (i=0; i<arity; i++) {
+ if (VM_EQStack_name_occur(a, AGENT(t)->port[i])) {
+ // puts_term(a); printf(" occurs in the term "); puts_term(t);puts("");
+ return 1;
+ }
+ }
+ return 0;
+ }
+}
+
+int VM_EQStack_has_name(VALUE l, VALUE r) {
+
+ if (IS_FIXNUM(l)) {
+ return 1;
+ } else if (BASIC(l) == NULL) {
+ puts("has_name ERROR");
+ exit(-1);
+ }
+ if (IS_NAMEID(BASIC(l)->id)) {
+ if (NAME(l)->port == (VALUE)NULL) {
+ return VM_EQStack_name_occur(l, r);
+ } else {
+ return 0;
+ }
+ } else {
+ // Agent
+ int i, arity;
+ int success = 0;
+ arity = IdTable_get_arity(AGENT(l)->basic.id);
+ for (i=0; i<arity; i++) {
+ if (VM_EQStack_has_name(AGENT(l)->port[i],r)) {
+ success++;
+ } else {
+ // printf("?:");
+ // puts_term(AGENT(l)->port[i]);
+ // puts("");
+ }
+ }
+ printf("??:");
+ puts_term(l);
+ printf("\n ");
+ puts_term(r);
+ puts("");
+ return success;
+ }
+}
+
+int VM_EQStack_has_name_own(VALUE l) {
+ if (IS_FIXNUM(l)) {
+ return 0;
+ }
+ if (IS_NAMEID(BASIC(l)->id)) {
+ if (NAME(l)->port == (VALUE)NULL) {
+ return 0;
+ } else {
+ printf("!");puts_term(l);printf("->");
+ puts_term(NAME(l)->port); puts(""); puts("");
+ printf("id=%d\n", BASIC(l)->id);
+ return 1; //VM_EQStack_has_name_own(NAME(l)->port);
+ }
+ } else {
+ // Agent
+ int i, arity;
+ int success = 0;
+
+ arity = IdTable_get_arity(AGENT(l)->basic.id);
+ printf("Arity of "); puts_term(l);
+ printf(" is %d\n", arity);
+ for (i=0; i<arity; i++) {
+ int j;
+ for (j=0; j<arity; j++) {
+ if (j==i) {
+ printf("* :");
+ puts_term(AGENT(l)->port[j]);
+ puts("");
+ success+=VM_EQStack_has_name_own(AGENT(l)->port[j]);
+ continue;
+ }
+ printf("**:");
+ puts_term(AGENT(l)->port[i]);
+ puts("");
+ puts_term(AGENT(l)->port[j]);
+ puts("");
+ success+=VM_EQStack_has_name(AGENT(l)->port[i], AGENT(l)->port[j]);
+
+ }
+ }
+
+ printf("? :");
+ puts_term(l);
+ puts("");
+
+ return success;
+ }
+}
+
+
+
+int VM_EQStack_check_linearity(VirtualMachine *vm) {
+ int i,j;
+ VALUE l,r;
+ if (vm->nextPtr_eqStack == -1) return 1;
+ for (i=0; i<=vm->nextPtr_eqStack+1; i++) {
+
+ int success = 0;
+ int arity;
+
+ l = vm->eqStack[i].l;
+ r = vm->eqStack[i].r;
+ arity = IdTable_get_arity(AGENT(l)->basic.id);
+ success+=VM_EQStack_has_name_own(l);
+ printf("score=%d\n\n", success);
+
+ success+=VM_EQStack_has_name(l,r);
+ printf("score=%d\n\n", success);
+
+ success+=VM_EQStack_has_name_own(r);
+ printf("score=%d\n\n", success);
+
+ success+=VM_EQStack_has_name(r,l);
+ printf("score=%d\n\n", success);
+
+ if (success == 2) return 1;
+
+ success = 0;
+ for (j=0; j<=vm->nextPtr_eqStack+1; j++) {
+ if (i==j) continue;
+ success +=VM_EQStack_has_name(l, vm->eqStack[j].l);
+ printf("score=%d\n\n", success);
+ success +=VM_EQStack_has_name(l, vm->eqStack[j].r);
+ printf("score=%d\n\n", success);
+
+ success += VM_EQStack_has_name(r, vm->eqStack[j].l);
+ printf("score=%d\n\n", success);
+ success += VM_EQStack_has_name(r, vm->eqStack[j].r);
+ printf("score=%d\n\n", success);
+ }
+
+ printf("score=%d\n\n", success);
+
+ if (success == IdTable_get_arity(AGENT(l)->basic.id) +
+ IdTable_get_arity(AGENT(r)->basic.id)) {
+ return 1;
+ }
+ puts("Linearty ERROR:");
+ puts_term(l);
+ puts("");
+ puts_term(r);
+ puts("");
+ puts("");
+ // VM_EQStack_allputs(vm);
+ return 0;
+ }
+ return 0;
+}
+#endif
+*/
+
+
+/**************************************
+ CODE
+**************************************/
+// *** The occurrence order must be the same in labels in ExecCode. ***
+typedef enum {
+ PUSH=0,
+ PUSHI,
+ MKNAME,
+ MKGNAME,
+ MKAGENT,
+ REUSEAGENT,
+ MYPUSH,
+
+ RET,
+ RET_FREE_LR,
+ RET_FREE_L,
+ RET_FREE_R,
+
+ LOOP,
+ LOOP_RREC,
+ LOOP_RREC1,
+ LOOP_RREC2,
+
+ LOADI,
+ LOAD,
+ LOADP,
+ OP_ADD,
+ OP_SUB,
+ OP_SUBI,
+ OP_MUL,
+ OP_DIV,
+ OP_MOD,
+ OP_LT,
+ OP_LE,
+ OP_EQ,
+ OP_EQI,
+ OP_NE,
+ OP_JMPEQ0,
+ OP_JMPCNCT_CONS,
+ OP_JMPCNCT,
+ OP_JMP,
+ OP_UNM,
+ OP_RAND,
+
+ // connect operation for global names in given nets in the interactive mode.
+ CNCTGN,
+ SUBSTGN,
+
+ NOP,
+} Code;
+
+
+// The real addresses for the `Code':
+static void* CodeAddr[NOP+1];
+
+
+typedef enum {
+ NB_NAME=0,
+ NB_META,
+ NB_INTVAR,
+} NB_TYPE;
+
+
+// NBIND 数は meta数(MAX_PORT*2) + 一つの rule（や eqlist） における
+// 最大name出現数(100)
+#define MAX_NBIND MAX_PORT*2+100
+typedef struct {
+ char *name;
+ int reg;
+ int refnum; // 0: global name (thus created only),
+ // >0: local name
+ // (for the bind names: should be 1)
+ // (for the int names: not paticular)
+ NB_TYPE type; // NB_NAME, NB_META or NB_INTVAR
+} NameBind;
+
+
+
+#define MAX_CODE_SIZE 1024
+typedef struct {
+
+ // Management table for local and global names
+ NameBind bind[MAX_NBIND];
+ int bindPtr; // its index
+ int bindPtr_metanames; // The max index that stores info of meta names
+ // (default: -1)
+
+
+ // Index for local and global names in Regs
+ int localNamePtr; // It starts from VM_OFFSET_LOCALVAR
+ int vmStackSize; // the array size of the Regs.
+
+
+ // Compiled code and its index
+ void *code[MAX_CODE_SIZE];
+ int codeptr;
+
+
+ // For rule agents
+ int idL, idR; // ids of ruleAgentL and ruleAgentR
+ int reg_agentL, reg_agentR; // Beginning reg nums for args of
+ // ruleAgentL, ruleAgentR
+ int annotateL, annotateR; // `Annotation properties' such as (*L) (*R) (int)
+
+} CmEnvironment;
+
+// The annotation properties
+#define ANNOTATE_NOTHING 0 // The rule agent is not reused,
+#define ANNOTATE_REUSE 1 // annotation (*L), (*R) is specified,
+#define ANNOTATE_AS_INT_AGENT 2 // (int i), therefore it should not be freed.
+
+
+static CmEnvironment CmEnv;
+
+//void *ExecCode(int arg, VirtualMachine *vm, void **code);
+void *ExecCode(int mode, VirtualMachine *restrict vm, void *restrict *code);
+
+
+void CmEnv_clear_all();
+
+
+void CmEnv_Init(int vm_heapsize) {
+ CmEnv.vmStackSize = vm_heapsize;
+
+ void **table;
+ table = ExecCode(0, NULL, NULL);
+ for (int i=0; i<NOP; i++) {
+ CodeAddr[i] = table[i];
+ }
+
+ CmEnv_clear_all();
+}
+
+
+static inline
+void CmEnv_clear_localnamePtr() {
+ CmEnv.localNamePtr = VM_OFFSET_LOCALVAR;
+}
+
+void CmEnv_clear_bind(int preserve_idx) {
+ // clear reference counter only, until preserve_idx
+ for (int i=0; i<=preserve_idx; i++) {
+ CmEnv.bind[i].refnum = 0;
+ }
+
+ // after that, clear everything
+ for (int i=preserve_idx+1; i<MAX_NBIND; i++) {
+ CmEnv.bind[i].name = NULL;
+ CmEnv.bind[i].refnum = 0;
+ CmEnv.bind[i].reg = 0;
+ }
+
+ // new name information will be stored from preserve_idx+1
+ CmEnv.bindPtr = preserve_idx+1;
+}
+
+
+void CmEnv_clear_all()
+{
+ // clear all the information of names.
+ CmEnv_clear_bind(-1);
+
+ // reset the annotation properties for rule agents.
+ CmEnv.bindPtr_metanames = -1;
+ CmEnv.annotateL = ANNOTATE_NOTHING;
+ CmEnv.annotateR = ANNOTATE_NOTHING;
+
+ // reset the beginning number for local vars.
+ CmEnv_clear_localnamePtr();
+
+ // reset the index of code array in CmEnv.
+ CmEnv.codeptr = 0;
+
+}
+
+void CmEnv_clear_keeping_rule_properties()
+{
+ // clear the information of names EXCEPT meta ones.
+ CmEnv_clear_bind(CmEnv.bindPtr_metanames);
+
+ if (CmEnv.annotateL != ANNOTATE_AS_INT_AGENT) {
+ CmEnv.annotateL = ANNOTATE_NOTHING;
+ }
+ if (CmEnv.annotateR != ANNOTATE_AS_INT_AGENT) {
+ CmEnv.annotateR = ANNOTATE_NOTHING;
+ }
+
+
+ // reset the beginning number for local vars.
+ CmEnv_clear_localnamePtr();
+
+ // reset the index of code array in CmEnv.
+ CmEnv.codeptr = 0;
+
+}
+
+
+
+
+int CmEnv_set_symbol_as_name(char *name) {
+ // return: a regnum for the given name.
+
+ int result;
+
+ if (name != NULL) {
+ CmEnv.bind[CmEnv.bindPtr].name = name;
+ CmEnv.bind[CmEnv.bindPtr].reg = CmEnv.localNamePtr;
+ CmEnv.bind[CmEnv.bindPtr].refnum = 0;
+ CmEnv.bind[CmEnv.bindPtr].type = NB_NAME;
+
+ CmEnv.bindPtr++;
+ if (CmEnv.bindPtr > MAX_NBIND) {
+ puts("SYSTEM ERROR: CmEnv.bindPtr exceeded MAX_NBIND.");
+ exit(-1);
+ }
+
+ result = CmEnv.localNamePtr;
+ CmEnv.localNamePtr++;
+ if (CmEnv.localNamePtr > CmEnv.vmStackSize) {
+ puts("SYSTEM ERROR: CmEnv.localNamePtr exceeded CmEnv.vmStackSize.");
+ exit(-1);
+ }
+
+ return result;
+ }
+ return -1;
+}
+
+
+void CmEnv_set_symbol_as_meta(char *name, int reg, NB_TYPE type) {
+
+ if (name != NULL) {
+ CmEnv.bind[CmEnv.bindPtr].name = name;
+ CmEnv.bind[CmEnv.bindPtr].reg = reg;
+ CmEnv.bind[CmEnv.bindPtr].refnum = 0;
+ CmEnv.bind[CmEnv.bindPtr].type = type;
+
+ // update the last index for metanames
+ CmEnv.bindPtr_metanames = CmEnv.bindPtr;
+
+ CmEnv.bindPtr++;
+ if (CmEnv.bindPtr > MAX_NBIND) {
+ puts("SYSTEM ERROR: CmEnv.bindPtr exceeded MAX_NBIND.");
+ exit(-1);
+ }
+ }
+}
+
+
+int CmEnv_set_as_INTVAR(char *name) {
+ int result;
+
+ if (name != NULL) {
+ CmEnv.bind[CmEnv.bindPtr].name = name;
+ CmEnv.bind[CmEnv.bindPtr].reg = CmEnv.localNamePtr;
+ CmEnv.bind[CmEnv.bindPtr].refnum = 0;
+ CmEnv.bind[CmEnv.bindPtr].type = NB_INTVAR;
+ result = CmEnv.localNamePtr;
+
+ CmEnv.bindPtr++;
+ if (CmEnv.bindPtr > MAX_NBIND) {
+ puts("SYSTEM ERROR: CmEnv.bindPtr exceeded MAX_NBIND.");
+ exit(-1);
+ }
+
+ CmEnv.localNamePtr++;
+ if (CmEnv.localNamePtr > CmEnv.vmStackSize) {
+ puts("SYSTEM ERROR: CmEnv.localNamePtr exceeded CmEnv.vmStackSize.");
+ exit(-1);
+ }
+
+ return result;
+ }
+ return -1;
+}
+
+
+int CmEnv_reg_search(char *key) {
+ int i;
+ for (i=0; i<CmEnv.bindPtr; i++) {
+ if (strcmp(key, CmEnv.bind[i].name) == 0) {
+ CmEnv.bind[i].refnum++;
+ return CmEnv.bind[i].reg;
+ }
+ }
+ return -1;
+}
+
+int CmEnv_gettype_forname(char *key, NB_TYPE *type) {
+ int i;
+ for (i=0; i<CmEnv.bindPtr; i++) {
+ if (strcmp(key, CmEnv.bind[i].name) == 0) {
+ *type = CmEnv.bind[i].type;
+ return 1;
+ }
+ }
+ return 0;
+}
+
+
+// Agent用の RegNo を取得する (just for newreg)
+//（これらは、Envコンパイル時に mkName、mkGname の対象にならないため
+// 一時的な変数として使われる）
+int CmEnv_newreg() {
+
+ int result;
+ result = CmEnv.localNamePtr;
+ CmEnv.localNamePtr++;
+ if (CmEnv.localNamePtr > CmEnv.vmStackSize) {
+ puts("SYSTEM ERROR: CmEnv.localNamePtr exceeded CmEnv.vmStackSize.");
+ exit(-1);
+ }
+
+ return result;
+}
+
+
+
+#define EnvAddCode(c)\
+ if (CmEnv.codeptr >= MAX_CODE_SIZE) {\
+ puts("SYSTEM ERROR: The codeptr exceeded MAX_CODE_SIZE");\
+ exit(-1);\
+ }\
+ CmEnv.code[CmEnv.codeptr] = c;\
+ CmEnv.codeptr++;
+
+#define EnvAddCode2(c1,c2) \
+ if (CmEnv.codeptr+1 >= MAX_CODE_SIZE) {\
+ puts("SYSTEM ERROR: The codeptr exceeded MAX_CODE_SIZE");\
+ exit(-1);\
+ }\
+ CmEnv.code[CmEnv.codeptr++] = c1;\
+ CmEnv.code[CmEnv.codeptr++] = c2;
+
+#define EnvAddCode3(c1,c2,c3) \
+ if (CmEnv.codeptr+2 >= MAX_CODE_SIZE) {\
+ puts("SYSTEM ERROR: The codeptr exceeded MAX_CODE_SIZE");\
+ exit(-1);\
+ }\
+ CmEnv.code[CmEnv.codeptr++] = c1;\
+ CmEnv.code[CmEnv.codeptr++] = c2;\
+ CmEnv.code[CmEnv.codeptr++] = c3;
+
+#define EnvAddCode4(c1,c2,c3,c4) \
+ if (CmEnv.codeptr+3 >= MAX_CODE_SIZE) {\
+ puts("SYSTEM ERROR: The codeptr exceeded MAX_CODE_SIZE");\
+ exit(-1);\
+ }\
+ CmEnv.code[CmEnv.codeptr++] = c1;\
+ CmEnv.code[CmEnv.codeptr++] = c2;\
+ CmEnv.code[CmEnv.codeptr++] = c3;\
+ CmEnv.code[CmEnv.codeptr++] = c4;
+
+#define EnvAddCode5(c1,c2,c3,c4,c5) \
+ if (CmEnv.codeptr+4 >= MAX_CODE_SIZE) {\
+ puts("SYSTEM ERROR: The codeptr exceeded MAX_CODE_SIZE");\
+ exit(-1);\
+ }\
+ CmEnv.code[CmEnv.codeptr++] = c1;\
+ CmEnv.code[CmEnv.codeptr++] = c2;\
+ CmEnv.code[CmEnv.codeptr++] = c3;\
+ CmEnv.code[CmEnv.codeptr++] = c4;\
+ CmEnv.code[CmEnv.codeptr++] = c5;
+
+
+#define EnvAddCode6(c1,c2,c3,c4,c5,c6) \
+ if (CmEnv.codeptr+5 >= MAX_CODE_SIZE) {\
+ puts("SYSTEM ERROR: The codeptr exceeded MAX_CODE_SIZE");\
+ exit(-1);\
+ }\
+ CmEnv.code[CmEnv.codeptr++] = c1;\
+ CmEnv.code[CmEnv.codeptr++] = c2;\
+ CmEnv.code[CmEnv.codeptr++] = c3;\
+ CmEnv.code[CmEnv.codeptr++] = c4;\
+ CmEnv.code[CmEnv.codeptr++] = c5;\
+ CmEnv.code[CmEnv.codeptr++] = c6;
+
+
+
+#define EnvCodeClear() CmEnv.codeptr=0
+
+
+void EnvAddCodePUSH(void* c1, void* c2) {
+ EnvAddCode3(CodeAddr[PUSH],c1,c2);
+}
+
+
+void EnvAddCodeMYPUSH(void* c1, void* c2) {
+ EnvAddCode3(CodeAddr[MYPUSH],c1,c2);
+}
+
+void EnvAddCodeCNCTGN(void* c1, void* c2) {
+ EnvAddCode3(CodeAddr[CNCTGN],c1,c2);
+}
+
+void EnvAddCodeSUBSTGN(void* c1, void* c2) {
+ EnvAddCode3(CodeAddr[SUBSTGN],c1,c2);
+}
+
+
+int CmEnv_check_meta_occur_once() {
+ int i;
+
+ for (i=0; i<CmEnv.bindPtr; i++) {
+
+ if (CmEnv.bind[i].type == NB_META) {
+ if (CmEnv.bind[i].refnum != 1) { // Be just once!
+ printf("ERROR: '%s' is referred not once in the right-hand side of the rule definition", CmEnv.bind[i].name);
+ return 0;
+ }
+ // } else if (CmEnv.bind[i].type == NB_INTVAR) {
+ // if (CmEnv.bind[i].refnum == 0) {
+ // printf("Error: %s does not occur at RHS.\n", CmEnv.bind[i].name);
+ // return 0;
+ // }
+ }
+ }
+
+ return 1;
+
+}
+
+
+int CmEnv_check_name_reference_times() {
+ int i;
+ for (i=0; i<CmEnv.bindPtr; i++) {
+ if (CmEnv.bind[i].type == NB_NAME) {
+ if (CmEnv.bind[i].refnum > 2) {
+ printf("ERROR: The name '%s' occurs more than twice.\n",
+ CmEnv.bind[i].name);
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+int CmEnv_generate_code_with_nameinfo(void **code, int offset) {
+ // return: the number of produced codes
+
+ int i;
+
+ /*
+ // check whether the code size estimation is exceeded.
+ {
+ int count_names=0;
+ for (i=0; i<CmEnv.bindPtr; i++) {
+ if (CmEnv.bind[i].type == NB_NAME) {
+ count_names++;
+ }
+ }
+ if (offset + count_names*3 > MAX_CODE_SIZE) {
+ puts("System ERROR: Generated codes were too big.");
+ return -1;
+ }
+ }
+ */
+
+
+ {
+ int ptr=offset;
+
+ for (i=0; i<CmEnv.bindPtr; i++) {
+
+ if (CmEnv.bind[i].type == NB_NAME) {
+
+ if (CmEnv.bind[i].refnum > 0) {
+ code[ptr++] = CodeAddr[MKNAME];
+
+ } else {
+ code[ptr++] = CodeAddr[MKGNAME];
+ code[ptr++] = CmEnv.bind[i].name;
+ }
+ code[ptr++] = (void *)(unsigned long)CmEnv.bind[i].reg;
+ }
+ }
+
+ if (ptr + CmEnv.codeptr > MAX_CODE_SIZE) {
+ puts("System ERROR: Generated codes were too big.");
+ return -1;
+ }
+
+ for (i=0; i<CmEnv.codeptr; i++) {
+ code[ptr++] = CmEnv.code[i];
+ }
+
+ return (ptr-offset);
+ }
+}
+
+
+int CmEnv_generate_code(void **code, int offset) {
+ int ptr=offset;
+ int i;
+ for (i=0; i<CmEnv.codeptr; i++) {
+ code[ptr] = CmEnv.code[i];
+ ptr++;
+ }
+
+ return CmEnv.codeptr;
+}
+
+
+void CopyCode(int byte, void **source, void **target) {
+ int i;
+ for (i=0; i<byte; i++) {
+ target[i]=source[i];
+ }
+}
+
+
+/*
+void EnvPutsCode() {
+ int i,j,arity;
+ for (i=0; i<CmEnv.localNamePtr; i++) {
+ printf("var%d=mkName\n", i);
+ }
+ for (i=0; i<CmEnv.codeptr; i++) {
+ switch (CmEnv.code[i]) {
+ case RET:
+ puts("ret");
+ break;
+ case PUSH:
+ printf("push var%d var%d\n", CmEnv.code[i+1], CmEnv.code[i+2]);
+ i +=2;
+ break;
+ case MKNAME:
+ printf("var%d=mkname\n", CmEnv.code[i+1]);
+ i +=1;
+ break;
+ case MKAGENT:
+ printf("var%d=mkagent %d %d",
+ CmEnv.code[i+1], CmEnv.code[i+2], CmEnv.code[i+3]);
+ arity = CmEnv.code[i+3];
+ i +=3;
+ for(j=0; j<arity; j++) {
+ i++;
+ printf(" var%d", CmEnv.code[i]);
+ }
+ puts("");
+ break;
+ default:
+ printf("CODE %d\n", CmEnv.code[i]);
+
+ }
+ }
+}
+
+*/
+
+
+void PutsCodeN(void **code, int n) {
+ int i,j;
+ unsigned long arity;
+ i=0;
+
+ puts("[PutsCode]");
+ if (n==-1) n = MAX_CODE_SIZE;
+ for (i=0; i<n; i++) {
+ printf("%2d: ", i);
+ if (code[i] == CodeAddr[MKNAME]) {
+ printf("var%lu=mkname\n", (unsigned long)code[i+1]);
+ i +=1;
+ } else if (code[i] == CodeAddr[MKGNAME]) {
+ printf("var%lu=mkgname %s\n", (unsigned long)code[i+2], (char *)code[i+1]);
+ i +=2;
+ } else if (code[i] == CodeAddr[MKAGENT]) {
+ printf("MKAGENT var%lu id:%lu ar:%lu",
+ (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ arity = (unsigned long)code[i+3];
+ i +=3;
+ for(j=0; j<arity; j++) {
+ i++;
+ printf(" var%lu", (unsigned long)code[i]);
+ }
+ puts("");
+ } else if (code[i] == CodeAddr[REUSEAGENT]) {
+ printf("reuseagent var%lu as id=%lu arity=%lu",
+ (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ arity = (unsigned long)code[i+3];
+ i +=3;
+ for(j=0; j<arity; j++) {
+ i++;
+ printf(" var%lu", (unsigned long)code[i]);
+ }
+ puts("");
+ } else if (code[i] == CodeAddr[PUSH]) {
+ printf("PUSH var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2]);
+ i +=2;
+ } else if (code[i] == CodeAddr[PUSHI]) {
+ printf("PUSHI var%lu $%d\n", (unsigned long)code[i+1], FIX2INT((unsigned long)code[i+2]));
+ i +=2;
+ } else if (code[i] == CodeAddr[MYPUSH]) {
+ printf("MYPUSH var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2]);
+ i +=2;
+ } else if (code[i] == CodeAddr[RET]) {
+ puts("RET");
+ if (n==MAX_CODE_SIZE) {
+ return;
+ }
+ } else if (code[i] == CodeAddr[RET_FREE_L]) {
+ puts("RET_FREE_L");
+ if (n==MAX_CODE_SIZE) {
+ return;
+ }
+ } else if (code[i] == CodeAddr[RET_FREE_R]) {
+ puts("RET_FREE_R");
+ if (n==MAX_CODE_SIZE) {
+ return;
+ }
+ } else if (code[i] == CodeAddr[RET_FREE_LR]) {
+ puts("RET_FREE_LR");
+ if (n==MAX_CODE_SIZE) {
+ return;
+ }
+ } else if (code[i] == CodeAddr[LOADI]) {
+ printf("LOADI var%lu $%lu\n", (unsigned long)code[i+1],
+ (unsigned long)code[i+2]);
+ i+=2;
+ } else if (code[i] == CodeAddr[LOOP]) {
+ printf("LOOP\n");
+
+ } else if (code[i] == CodeAddr[LOOP_RREC]) {
+ printf("LOOP_RREC var%lu $%lu\n",
+ (unsigned long)code[i+1],
+ (unsigned long)code[i+2]);
+ i+=2;
+
+ } else if (code[i] == CodeAddr[LOOP_RREC1]) {
+ printf("LOOP_RREC1 var%lu\n",
+ (unsigned long)code[i+1]);
+ i+=1;
+
+ } else if (code[i] == CodeAddr[LOOP_RREC2]) {
+ printf("LOOP_RREC2 var%lu\n",
+ (unsigned long)code[i+1]);
+ i+=1;
+
+ } else if (code[i] == CodeAddr[LOAD]) {
+ printf("LOAD var%lu var%lu\n", (unsigned long)code[i+1],
+ (unsigned long)code[i+2]);
+ i+=2;
+ } else if (code[i] == CodeAddr[LOADP]) {
+ printf("LOADP var%lu var%lu[%lu]\n",
+ (unsigned long)code[i+1],
+ (unsigned long)code[i+2],
+ (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_ADD]) {
+ printf("ADD var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_SUB]) {
+ printf("SUB var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_SUBI]) {
+ printf("SUBI var%lu var%lu $%ld\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (long int)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_MUL]) {
+ printf("MUL var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_DIV]) {
+ printf("DIV var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_MOD]) {
+ printf("MOD var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_LT]) {
+ printf("LT var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_LE]) {
+ printf("LE var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_EQ]) {
+ printf("EQ var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_EQI]) {
+ printf("EQI var%lu var%lu $%ld\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (long int)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_NE]) {
+ printf("NE var%lu var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2], (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_JMPEQ0]) {
+ printf("JMPEQ0 var%lu $%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2]);
+ i+=2;
+ } else if (code[i] == CodeAddr[OP_JMPCNCT_CONS]) {
+ printf("JMPCNCT_CONS var%lu $%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2]);
+ i+=2;
+ } else if (code[i] == CodeAddr[OP_JMPCNCT]) {
+ printf("JMPCNCT var%lu $%lu $%lu\n",
+ (unsigned long)code[i+1],
+ (unsigned long)code[i+2],
+ (unsigned long)code[i+3]);
+ i+=3;
+ } else if (code[i] == CodeAddr[OP_JMP]) {
+ printf("JMP $%lu\n", (unsigned long)code[i+1]);
+ i+=1;
+ } else if (code[i] == CodeAddr[OP_UNM]) {
+ printf("UNM var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2]);
+ i+=2;
+ } else if (code[i] == CodeAddr[OP_RAND]) {
+ printf("RND var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2]);
+ i+=2;
+ } else if (code[i] == CodeAddr[CNCTGN]) {
+ printf("CNCTGN var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2]);
+ i +=2;
+ } else if (code[i] == CodeAddr[SUBSTGN]) {
+ printf("SUBSTGN var%lu var%lu\n", (unsigned long)code[i+1], (unsigned long)code[i+2]);
+ i +=2;
+ } else if (code[i] == CodeAddr[NOP]) {
+ printf("NOP\n");
+ } else {
+ printf("CODE %lu\n", (unsigned long)code[i]);
+ }
+ }
+}
+
+
+void PutsCode(void **code) {
+ PutsCodeN(code, -1);
+}
+
+
+
+int is_expr(Ast *ptr) {
+
+ if (ptr == NULL) {
+ return 0;
+ }
+
+ switch (ptr->id) {
+ case AST_INT:
+ return 1;
+ break;
+
+ case AST_NAME: {
+ NB_TYPE type;
+ int result = CmEnv_gettype_forname(ptr->left->sym, &type);
+ if (result == 0) {
+ return 9;
+ }
+ if (type != NB_INTVAR) {
+ return 0;
+ }
+
+ return 1;
+ break;
+ }
+
+ case AST_RAND:
+ case AST_UNM: {
+ if (!is_expr(ptr->left)) return 0;
+
+ return 1;
+ break;
+ }
+
+ case AST_PLUS:
+ case AST_SUB:
+ case AST_MUL:
+ case AST_DIV:
+ case AST_MOD:
+ case AST_LT:
+ case AST_LE:
+ case AST_EQ:
+ case AST_NE: {
+ if (!is_expr(ptr->left)) return 0;
+ if (!is_expr(ptr->right)) return 0;
+
+ return 1;
+ break;
+ }
+ default:
+ return 0;
+ }
+}
+
+
+
+int CompileExprFromAst(int target, Ast *ptr) {
+
+ if (ptr == NULL) {
+ return 1;
+ }
+
+ switch (ptr->id) {
+ case AST_INT:
+ EnvAddCode3(CodeAddr[LOADI],
+ (void *)(unsigned long)target,
+ (void *)(unsigned long)(ptr->intval));
+ return 1;
+ break;
+
+ case AST_NAME: {
+ int result = CmEnv_reg_search(ptr->left->sym);
+ if (result == -1) {
+ // result=CmEnv_set_as_INTVAR(ptr->left->sym);
+ printf("ERROR: '%s' has not been defined previously.\n",
+ ptr->left->sym);
+ return 0;
+ }
+ EnvAddCode3(CodeAddr[LOAD],
+ (void *)(unsigned long)target,
+ (void *)(unsigned long)result);
+ return 1;
+ break;
+ }
+ case AST_RAND: {
+ int newreg = CmEnv_newreg();
+ if (!CompileExprFromAst(newreg, ptr->left)) return 0;
+ EnvAddCode3(CodeAddr[OP_RAND],
+ (void *)(unsigned long)target,
+ (void *)(unsigned long)newreg);
+
+ return 1;
+ break;
+ }
+ case AST_UNM: {
+ int newreg = CmEnv_newreg();
+ if (!CompileExprFromAst(newreg, ptr->left)) return 0;
+ EnvAddCode3(CodeAddr[OP_UNM],
+ (void *)(unsigned long)target,
+ (void *)(unsigned long)newreg);
+
+ return 1;
+ break;
+ }
+ case AST_PLUS:
+ case AST_SUB:
+ case AST_MUL:
+ case AST_DIV:
+ case AST_MOD:
+ case AST_LT:
+ case AST_LE:
+ case AST_EQ:
+ case AST_NE: {
+ int newreg = CmEnv_newreg();
+ int newreg2 = CmEnv_newreg();
+ if (!CompileExprFromAst(newreg, ptr->left)) return 0;
+ if (!CompileExprFromAst(newreg2, ptr->right)) return 0;
+
+ switch (ptr->id) {
+ case AST_PLUS:
+ EnvAddCode(CodeAddr[OP_ADD]);
+ break;
+ case AST_SUB:
+ EnvAddCode(CodeAddr[OP_SUB]);
+ break;
+ case AST_MUL:
+ EnvAddCode(CodeAddr[OP_MUL]);
+ break;
+ case AST_DIV:
+ EnvAddCode(CodeAddr[OP_DIV]);
+ break;
+ case AST_MOD:
+ EnvAddCode(CodeAddr[OP_MOD]);
+ break;
+ case AST_LT:
+ EnvAddCode(CodeAddr[OP_LT]);
+ break;
+ case AST_LE:
+ EnvAddCode(CodeAddr[OP_LE]);
+ break;
+ case AST_EQ:
+ EnvAddCode(CodeAddr[OP_EQ]);
+ break;
+ case AST_NE:
+ EnvAddCode(CodeAddr[OP_NE]);
+ break;
+ default:
+ EnvAddCode(CodeAddr[OP_MOD]);
+ }
+ EnvAddCode3((void *)(unsigned long)target,
+ (void *)(unsigned long)newreg,
+ (void *)(unsigned long)newreg2);
+
+ return 1;
+ break;
+ }
+ default:
+ puts("System ERROR: Wrong AST was given to CompileExpr.");
+ return 0;
+
+ }
+
+}
+
+// Rule や eq の中の term をコンパイルするときに使う
+int CompileTermFromAst(Ast *ptr, int target) {
+ // input:
+ // target == -1 => a new cell is allocated from localHeap.
+ // othereise => a cell denoted by the `target' is reused as a new cell.
+ //
+ // output:
+ // return: offset in localHeap
+
+ int result, mkagent;
+ int i, arity;
+
+ int alloc[MAX_PORT];
+
+ if (ptr == NULL) {
+ return -1;
+ }
+
+ switch (ptr->id) {
+ case AST_NAME:
+
+ result = CmEnv_reg_search(ptr->left->sym);
+ if (result == -1) {
+ result=CmEnv_set_symbol_as_name(ptr->left->sym);
+ }
+ return result;
+ break;
+
+ case AST_INT:
+ result = CmEnv_newreg();
+ EnvAddCode3(CodeAddr[LOADI],
+ (void *)(unsigned long)result,
+ (void *)(unsigned long)(ptr->intval));
+ return result;
+ break;
+
+ case AST_NIL:
+ if (target == -1) {
+ result = CmEnv_newreg();
+ mkagent = MKAGENT;
+ } else {
+ result = target;
+ mkagent = REUSEAGENT;
+ }
+ EnvAddCode4(CodeAddr[mkagent],
+ (void *)(unsigned long)result,
+ (void *)(unsigned long)(ID_NIL),
+ (void *)(unsigned long)0);
+ return result;
+ break;
+
+ case AST_CONS:
+ if (target == -1) {
+ result = CmEnv_newreg();
+ mkagent = MKAGENT;
+ } else {
+ result = target;
+ mkagent = REUSEAGENT;
+ }
+ alloc[0] = CompileTermFromAst(ptr->left, -1);
+ alloc[1] = CompileTermFromAst(ptr->right, -1);
+ EnvAddCode6(CodeAddr[mkagent],
+ (void *)(unsigned long)result,
+ (void *)(unsigned long)(ID_CONS),
+ (void *)(unsigned long)(2),
+ (void *)(unsigned long)alloc[0],
+ (void *)(unsigned long)alloc[1]);
+ return result;
+ break;
+
+ case AST_OPCONS:
+ if (target == -1) {
+ result = CmEnv_newreg();
+ mkagent = MKAGENT;
+ } else {
+ result = target;
+ mkagent = REUSEAGENT;
+ }
+ ptr = ptr->right;
+ alloc[0] = CompileTermFromAst(ptr->left, -1);
+ alloc[1] = CompileTermFromAst(ptr->right->left, -1);
+ EnvAddCode6(CodeAddr[mkagent],
+ (void *)(unsigned long)result,
+ (void *)(unsigned long)(ID_CONS),
+ (void *)(unsigned long)(2),
+ (void *)(unsigned long)alloc[0],
+ (void *)(unsigned long)alloc[1]);
+ return result;
+ break;
+
+ /*
+ case AST_TUPLE:
+ if (target == -1) {
+ result = CmEnv_newreg();
+ mkagent = MKAGENT;
+ } else {
+ result = target;
+ mkagent = REUSEAGENT;
+ }
+ arity = ptr->intval;
+ ptr=ptr->right;
+ for(i=0; i< MAX_PORT; i++) {
+ if (ptr == NULL) break;
+ alloc[i] = CompileTermFromAst(ptr->left, -1);
+ ptr = ast_getTail(ptr);
+ }
+
+ EnvAddCode4(CodeAddr[mkagent],
+ (void *)(unsigned long)result,
+ (void *)(unsigned long)(GET_TUPLEID(arity)),
+ (void *)(unsigned long)(arity));
+ for(i=0; i< arity; i++) {
+ EnvAddCode((void *)(unsigned long)alloc[i]);
+ }
+ return result;
+ break;
+ */
+
+
+ case AST_TUPLE:
+ arity = ptr->intval;
+
+ if (arity == 1) {
+ // The case of (A),
+ // `A' is recognised not as an argument, as a first-class object.
+ ptr=ptr->right;
+ alloc[0] = CompileTermFromAst(ptr->left, target);
+ result = alloc[0];
+
+ } else {
+ // normal case
+
+ if (target == -1) {
+ result = CmEnv_newreg();
+ mkagent = MKAGENT;
+ } else {
+ result = target;
+ mkagent = REUSEAGENT;
+ }
+
+ ptr=ptr->right;
+ /*
+ for(i=0; i< MAX_PORT; i++) {
+ if (ptr == NULL) break;
+ alloc[i] = CompileTermFromAst(ptr->left, -1);
+ ptr = ast_getTail(ptr);
+ }
+ */
+ for(i=0; i< arity; i++) {
+ alloc[i] = CompileTermFromAst(ptr->left, -1);
+ ptr = ast_getTail(ptr);
+ }
+
+ EnvAddCode4(CodeAddr[mkagent],
+ (void *)(unsigned long)result,
+ (void *)(unsigned long)(GET_TUPLEID(arity)),
+ (void *)(unsigned long)(arity));
+ for(i=0; i< arity; i++) {
+ EnvAddCode((void *)(unsigned long)alloc[i]);
+ }
+
+ }
+
+ return result;
+ break;
+
+
+
+ case AST_AGENT:
+
+ if (target == -1) {
+ result = CmEnv_newreg();
+ mkagent = MKAGENT;
+ } else {
+ result = target;
+ mkagent = REUSEAGENT;
+ }
+
+ int id = IdTable_getid_builtin_funcAgent(ptr);
+ if (id == -1) {
+ id = NameTable_get_set_id((char *)ptr->left->sym);
+ }
+
+ /* For arity */
+ // result->arity = ptr->arity;
+ arity=0;
+ ptr=ptr->right;
+ for(i=0; i< MAX_PORT; i++) {
+ if (ptr == NULL) break;
+ alloc[i] = CompileTermFromAst(ptr->left, -1);
+ arity++;
+ ptr = ast_getTail(ptr);
+ }
+ // MKAGENT var ID ARITY var0 var1 ...
+ EnvAddCode4(CodeAddr[mkagent],
+ (void *)(unsigned long)result,
+ (void *)(unsigned long)id,
+ (void *)(unsigned long)arity);
+ IdTable_set_arity(id, arity);
+
+ for(i=0; i< arity; i++) {
+ EnvAddCode((void *)(unsigned long)alloc[i]);
+ }
+ return result;
+ break;
+
+ case AST_ANNOTATION_L:
+ case AST_ANNOTATION_R:
+ if (ptr->id == AST_ANNOTATION_L) {
+ CmEnv.annotateL = ANNOTATE_REUSE; // *L が出現したことを示す
+ result = CmEnv.reg_agentL; //VM_OFFSET_ANNOTATE_L;
+ } else {
+ CmEnv.annotateR = ANNOTATE_REUSE; // *L が出現したことを示す
+ result = CmEnv.reg_agentR; // VM_OFFSET_ANNOTATE_R;
+ }
+
+
+ result = CompileTermFromAst(ptr->left, result);
+ return result;
+ break;
+
+
+
+ default:
+ // expression case
+ result = CmEnv_newreg();
+ int compile_result = CompileExprFromAst(result, ptr);
+ if (compile_result != 0) {
+ return result;
+ } else {
+ puts("ERROR: something strange in CompileTermFromAst.");
+ puts_ast(ptr);
+ exit(1);
+ }
+ }
+
+}
+
+
+
+
+// rule の中の eqs をコンパイルするときに使う
+// この関数が呼ばれる前に、rule agents の meta names は
+// Environment に積まれている。
+int check_invalid_occurrence_as_rule(Ast *ast) {
+ NB_TYPE type;
+
+ if (ast->id == AST_NAME) {
+
+ if (CmEnv_gettype_forname(ast->left->sym, &type)) {
+ /*
+ if (type == NB_INTVAR) {
+ printf("ERROR: The variable '%s' for an integer cannot be used as an agent ",
+ ast->left->sym);
+ return 0;
+ }
+ */
+ } else {
+ // printf("ERROR: The name '%s' is not bound ", ast->left->sym);
+ // return 0;
+ }
+ } else if (ast->id == AST_INT) {
+ // printf("ERROR: The integer '%d' is used as an agent ",
+ // ast->intval);
+ // return 0;
+ }
+
+ return 1;
+}
+
+
+int check_invalid_occurrence(Ast *ast) {
+ // communication with global names
+ int count;
+
+ if (ast->id == AST_NAME) {
+ char *sym = ast->left->sym;
+
+
+ VALUE aheap = NameTable_get_heap(sym);
+ if (aheap != (VALUE)NULL) {
+ // already exists as a global
+
+ /*
+ // it is connected with something.
+ if (NAME(aheap)->port != (VALUE)NULL) {
+ printf("ERROR: '%s' is already connected with ", sym);
+ puts_term(NAME(aheap)->port);
+ puts(".");
+ return 1;
+ }
+ */
+
+ count = keynode_exists_in_another_term(aheap, NULL);
+ if (count == 2) {
+ // already twice
+ printf("ERROR: '%s' occurs twice already. \n", sym);
+ printf(" Use 'ifce' command to see the occurrence.\n");
+ return 1;
+ }
+
+ }
+ }
+
+
+ return 0;
+}
+
+
+
+int CompileEQListFromAst(Ast *at) {
+ int t1,t2;
+ Ast *next;
+
+ while (at!=NULL) {
+ if (!check_invalid_occurrence_as_rule(at->left->left) ||
+ !check_invalid_occurrence_as_rule(at->left->right)) {
+ return 0;
+ }
+
+ t1 = CompileTermFromAst(at->left->left, -1);
+ t2 = CompileTermFromAst(at->left->right, -1);
+
+ next = ast_getTail(at);
+
+ // 2021/9/6: It seems, always EnvAddCodePUSH is selected
+ // because at is not NULL in this step. Should be (next == NULL)?
+ //
+ // 2021/9/12: It is found that at==NULL faster than next==NULL
+ // in parallel execution.
+
+ /*
+ if (at == NULL) {
+ EnvAddCodeMYPUSH((void *)(unsigned long)t1, (void *)(unsigned long)t2);
+ } else {
+ EnvAddCodePUSH((void *)(unsigned long)t1, (void *)(unsigned long)t2);
+ }
+ */
+ EnvAddCodePUSH((void *)(unsigned long)t1, (void *)(unsigned long)t2);
+
+ at = next;
+ }
+
+ return 1;
+}
+
+void Compile_Put_Ret_ForRuleBody() {
+
+ if ((CmEnv.annotateL == ANNOTATE_NOTHING) &&
+ (CmEnv.annotateR == ANNOTATE_NOTHING)) {
+ EnvAddCode(CodeAddr[RET_FREE_LR]);
+
+ } else if ((CmEnv.annotateL == ANNOTATE_NOTHING) &&
+ (CmEnv.annotateR != ANNOTATE_NOTHING)) {
+ // FreeL
+ if (CmEnv.reg_agentL == VM_OFFSET_ANNOTATE_L) {
+ EnvAddCode(CodeAddr[RET_FREE_L]);
+ } else {
+ EnvAddCode(CodeAddr[RET_FREE_R]);
+ }
+
+ } else if ((CmEnv.annotateL != ANNOTATE_NOTHING) &&
+ (CmEnv.annotateR == ANNOTATE_NOTHING)) {
+ // FreeR
+ if (CmEnv.reg_agentL == VM_OFFSET_ANNOTATE_L) {
+ EnvAddCode(CodeAddr[RET_FREE_R]);
+ } else {
+ EnvAddCode(CodeAddr[RET_FREE_L]);
+ }
+ } else {
+ EnvAddCode(CodeAddr[RET]);
+ }
+
+}
+
+
+int CompileStmListFromAst(Ast *at) {
+ Ast *ptr;
+ int toRegLeft;
+
+ while (at!=NULL) {
+ ptr=at->left;
+
+ // (AST_LD (AST_NAME sym NULL) some)
+ if (ptr->id != AST_LD) {
+ puts("System ERROR: The given StmList contains something besides statements.");
+ exit(-1);
+ }
+ // operation of x=y:
+ // for the x
+ toRegLeft = CmEnv_reg_search(ptr->left->left->sym);
+ if (toRegLeft == -1) {
+ toRegLeft = CmEnv_set_as_INTVAR(ptr->left->left->sym);
+ } else {
+ printf("Warning: '%s' has been already defined.\n", ptr->left->left->sym);
+ }
+
+ // for the y
+ if (ptr->right->id == AST_NAME) {
+ // y is a name
+ int toRegRight = CmEnv_reg_search(ptr->right->left->sym);
+ if (toRegRight == -1) {
+ toRegRight = CmEnv_set_as_INTVAR(ptr->right->left->sym);
+ }
+ EnvAddCode3(CodeAddr[LOAD],
+ (void *)(unsigned long)toRegLeft,
+ (void *)(unsigned long)toRegRight);
+
+ } else if (ptr->right->id == AST_INT) {
+ // y is an integer
+ EnvAddCode3(CodeAddr[LOADI],
+ (void *)(unsigned long)toRegLeft,
+ (void *)(unsigned long)ptr->right->intval);
+
+ } else {
+ // y is an expression
+ if (!CompileExprFromAst(toRegLeft, ptr->right)) return 0;
+
+ }
+
+
+
+ at = ast_getTail(at);
+ }
+
+ return 1;
+}
+
+
+
+
+// --- RewriteEQListOnAst ---
+
+Ast* SubstAst(char *sym, Ast *aterm, Ast *target, int *result) {
+ // target is astterm: (AST asttermL asttermR)
+ // this function replaces sym with aterm in target, i.e. tgs[aterm/sym].
+
+ if (target->id == AST_NAME) {
+ if (strcmp(target->left->sym, sym) == 0) {
+ *result = 1;
+ return aterm;
+
+ } else {
+ return target;
+ }
+
+ } else if (target->id == AST_OPCONS) {
+ target->right = SubstAst(sym, aterm, target->right, result);
+ return target;
+
+ } else if (target->id == AST_CONS) {
+ target->left = SubstAst(sym, aterm, target->left, result);
+ if (*result) {
+ return target;
+ } else {
+ target->right = SubstAst(sym, aterm, target->right, result);
+ return target;
+ }
+
+ } else if ((target->id == AST_TUPLE) ||
+ (target->id == AST_AGENT)) {
+ // (AST_AGENT (ID_SYM sym NULL) paramlist)
+
+ Ast *port = target->right;
+
+ for(int i=0; i< MAX_PORT; i++) {
+ if (port == NULL) break;
+
+ port = SubstAst(sym, aterm, port, result);
+ if (*result) break;
+
+ port = ast_getTail(port);
+ }
+ return target;
+
+ } else if (target->id == AST_LIST) {
+ Ast *elem = target->right;
+
+ while (elem != NULL) {
+ elem = SubstAst(sym, aterm, elem, result);
+ if (*result) break;
+
+ elem = ast_getTail(elem);
+ }
+ return target;
+
+ } else {
+ return target;
+ }
+
+}
+
+
+int SubstASTList(int nth, char *sym, Ast *aterm, Ast *eqs) {
+ // eqs[aterm/sym] except nth-eq
+
+ Ast *eq, *at = eqs;
+ int ct = 0;
+ int result;
+
+ while (at != NULL) {
+ eq = at->left;
+
+ if (ct == nth) {
+ ct++;
+ at = ast_getTail(at);
+ continue;
+ }
+
+ result=0;
+ eq->left = SubstAst(sym, aterm, eq->left, &result);
+ if (result) {
+ return 1;
+ }
+
+ result=0;
+ eq->right = SubstAst(sym, aterm, eq->right, &result);
+ if (result) {
+ return 1;
+ }
+
+ ct++;
+ at = ast_getTail(at);
+
+ }
+
+ return 0;
+}
+
+
+void RewriteEQListOnAST(Ast *eqs) {
+ // eqs : (AST_LIST eq1 (AST_LIST eq2 (AST_LIST eq3 NULL)))
+ // eq : (AST_CNCT astterm1 astterm2)
+
+ Ast *at, *prev, *target, *term;
+ char *sym;
+ int nth = 0;
+
+ at = prev = eqs;
+
+ while (at != NULL) {
+ // (id, left, right)
+ // at : (AST_LIST, x1, NULL)
+ // at : (AST_LIST, x1, (AST_LIST, x2, NULL))
+ target = at->left;
+
+ // printf("\n[target] "); puts_ast(target);
+ // printf("\n%dnth in ", nth); puts_ast(eqs); printf("\n\n");
+
+
+ if (target->left->id == AST_NAME) {
+ sym = target->left->left->sym;
+ term = target->right;
+
+ if (SubstASTList(nth, sym, term, eqs)) {
+ // printf("=== hit %dth\n", nth);
+
+ if (prev != at) {
+
+ // 前のリストの接続先を、現在地を省いて、その次の要素に変更。
+ prev->right = at->right;
+ at = at->right;
+
+ } else {
+ // 先頭の要素が代入に使われたので、
+ // body 内の eqs から先頭を削除
+ // (AST_LIST, x1, (AST_LIST, x2, *next)) ==> (AST_LIST, x2, *next)
+ eqs->left = eqs->right->left;
+ eqs->right = eqs->right->right;
+ eqs = eqs->right;
+ // 対象 at を次の要素に更新し、prev も at とする
+ prev = at = at->right;
+ }
+
+ continue;
+ }
+ }
+
+
+
+ if (target->right->id == AST_NAME) {
+ sym = target->right->left->sym;
+ term = target->left;
+
+
+ if (SubstASTList(nth, sym, term, eqs)) {
+ // printf("=== hit %dth\n", nth);
+
+ if (prev != at) {
+
+ // 前のリストの接続先を、現在地を省いて、その次の要素に変更。
+ prev->right = at->right;
+ at = at->right;
+
+ } else {
+ // 先頭の要素が代入に使われたので、
+ // body 内の eqs から先頭を削除
+ // (AST_LIST, x1, (AST_LIST, x2, *next)) ==> (AST_LIST, x2, *next)
+ eqs->left = eqs->right->left;
+ eqs->right = eqs->right->right;
+ eqs = eqs->right;
+ // 対象 at を次の要素に更新し、prev も at とする
+ prev = at = at->right;
+ }
+
+ continue;
+
+ }
+
+ }
+
+ nth++;
+ prev = at;
+ at = at->right;
+
+ }
+}
+
+
+
+int CompileBodyFromAst(Ast *body) {
+ Ast *stms, *eqs;
+
+ if (body == NULL) return 1;
+
+ stms = body->left;
+ eqs = body->right;
+
+ RewriteEQListOnAST(eqs);
+
+ if (!CompileStmListFromAst(stms)) return 0;
+ if (!CompileEQListFromAst(eqs)) {
+ printf("in the rule:\n %s >< %s\n",
+ IdTable_get_name(CmEnv.idL),
+ IdTable_get_name(CmEnv.idR));
+ return 0;
+ }
+
+ return 1;
+}
+
+
+
+
+
+
+/**************************************
+ TABLE for RULES
+**************************************/
+typedef struct RuleList {
+ int sym;
+ int available;
+ void* code[MAX_CODE_SIZE];
+ struct RuleList *next;
+} RuleList;
+
+RuleList *RuleList_new() {
+ RuleList *alist;
+ alist = malloc(sizeof(RuleList));
+ if (alist == NULL) {
+ printf("Malloc error\n");
+ exit(-1);
+ }
+ alist->available = 0;
+ return alist;
+}
+
+void RuleList_set_code(RuleList *at, int sym, void **code, int byte, RuleList *next) {
+ at->sym = sym;
+ at->available = 1;
+ CopyCode(byte, code, at->code);
+ at->next = next;
+}
+
+void RuleList_inavailable(RuleList *at) {
+ at->available = 0;
+}
+
+
+#define RULEHASH_SIZE NUM_AGENTS
+static RuleList *RuleTable[RULEHASH_SIZE];
+
+void RuleTable_init() {
+ int i;
+ for (i=0; i<RULEHASH_SIZE; i++) {
+ RuleTable[i] = NULL;
+ }
+}
+
+
+void RuleTable_record(int symlID, int symrID, int byte, void **code) {
+
+ RuleList *add;
+
+ if (RuleTable[symlID] == NULL) { /* もしテーブルが空ならば */
+ add = RuleList_new(); /* データノードを作成し */
+
+ RuleList_set_code(add, symrID, code, byte, NULL);
+ RuleTable[symlID] = add; /* 単にセット */
+ return;
+
+ }
+
+ /* 線形探査が必要 */
+ RuleList *at = RuleTable[symlID]; // 先頭をセット
+
+ while( at != NULL ) {
+ if( at->sym == symrID) { // すでにあれば書き換える
+ CopyCode(byte, code, at->code);
+ return;
+ }
+ at = at->next;
+ }
+
+ // key がなかったら、 先頭に追加
+
+ /* 以前の先頭を自分の次にする */
+ add = RuleList_new();
+ RuleList_set_code(add, symrID, code, byte, RuleTable[symlID]);
+ RuleTable[symlID] = add;
+ return;
+}
+
+
+
+void RuleTable_delete(int symlID, int symrID) {
+
+ if (RuleTable[symlID] == NULL) { /* もしテーブルが空ならば */
+ // 何もしない
+ return;
+
+ }
+
+ /* 線形探査が必要 */
+ RuleList *at = RuleTable[symlID]; /* 先頭をセット */
+
+ while( at != NULL ) {
+ if( at->sym == symrID) { /* すでにあれば書き換える */
+ RuleList_inavailable(at);
+ return;
+ }
+ at = at->next; /* 次のチェーンを辿る */
+ }
+
+}
+
+
+
+
+
+// -------------------------------------------------------------
+
+int getArityFromAST(Ast *ast) {
+ int i;
+ Ast *ptr;
+
+ ptr = ast->right;
+ for (i=0; i<MAX_PORT; i++) {
+ if (ptr == NULL) break;
+ ptr = ast_getTail(ptr);
+ }
+ return i;
+}
+
+
+// setMetaL(Ast *ast)
+// A(x1,x2) が ast に与えられれば、rule 内で x1, x2 が
+// VM のレジスタである VM_OFFSET_META_L(0)番、VM_OFFSET_META_L(1)番を
+// 参照できるようにする。
+void setMetaL(Ast *ast) {
+ int i;
+ Ast *ptr;
+ NB_TYPE type;
+
+ ptr = ast->right;
+ for (i=0; i<MAX_PORT; i++) {
+ if (ptr == NULL) break;
+ if (ptr->left->id == AST_NAME) {
+ type = NB_META;
+ } else {
+ type = NB_INTVAR;
+ }
+ CmEnv_set_symbol_as_meta(ptr->left->left->sym, VM_OFFSET_META_L(i), type);
+
+ ptr = ast_getTail(ptr);
+ }
+}
+void setMetaR(Ast *ast) {
+ int i;
+ Ast *ptr;
+ NB_TYPE type;
+
+ ptr = ast->right;
+ for (i=0; i<MAX_PORT; i++) {
+ if (ptr == NULL) break;
+ if (ptr->left->id == AST_NAME) {
+ type = NB_META;
+ } else {
+ type = NB_INTVAR;
+ }
+ CmEnv_set_symbol_as_meta(ptr->left->left->sym, VM_OFFSET_META_R(i), type);
+ ptr = ast_getTail(ptr);
+ }
+}
+
+void setMetaL_asIntName(Ast *ast) {
+ //CmEnv_set_symbol_as_meta(ast->left->sym, VM_OFFSET_META_L(0), NB_INTVAR);
+ CmEnv_set_symbol_as_meta(ast->left->sym, CmEnv.reg_agentL, NB_INTVAR);
+
+}
+
+void setMetaR_asIntName(Ast *ast) {
+ // CmEnv_set_symbol_as_meta(ast->left->sym, VM_OFFSET_META_R(0), NB_INTVAR);
+ CmEnv_set_symbol_as_meta(ast->left->sym, CmEnv.reg_agentR, NB_INTVAR);
+}
+
+
+
+void setAnnotateLR(int left, int right) {
+ CmEnv.reg_agentL = left;
+ CmEnv.reg_agentR = right;
+}
+
+
+
+int getRuleAgentID(Ast *ruleAgent) {
+ // Returns agents ids of ast type.
+ // This is called from makeRule to get ids of rule agents.
+
+ int id;
+
+ if (ruleAgent->id == AST_TUPLE) {
+ id = GET_TUPLEID(ruleAgent->intval);
+
+ } else if (ruleAgent->id == AST_OPCONS) {
+ id = ID_CONS;
+
+ } else if (ruleAgent->id == AST_NIL) {
+ id = ID_NIL;
+
+ } else if (ruleAgent->id == AST_INTVAR) {
+ id = ID_INT;
+
+ } else if (strcmp((char *)ruleAgent->left->sym, "Int") == 0) {
+ id = ID_INTAGENT;
+ } else {
+
+ id = IdTable_getid_builtin_funcAgent(ruleAgent);
+ if (id == -1) {
+ id=NameTable_get_set_id(ruleAgent->left->sym);
+ }
+ }
+
+ return id;
+}
+
+
+
+
+int CompileGuardBodiesFromAST(Ast *guard_bodies_top,
+ void **code, int offset_code) {
+ // return codesize
+ // -1 : compile error
+ Ast *guard_bodies, *guard_body, *body, *guard;
+ int code_size = offset_code;
+
+ int generated_codesize; // コンパイルで生成されたコード数保存用
+
+ guard_bodies = guard_bodies_top;
+
+ do {
+
+ guard_body = guard_bodies->left;
+
+ guard = guard_body->left;
+ body = guard_body->right;
+
+ CmEnv_clear_keeping_rule_properties();
+
+
+ if (guard != NULL) {
+ int label; // 飛び先指定用
+
+ // Gurad のコンパイル
+ int newreg = CmEnv_newreg();
+ if (!CompileExprFromAst(newreg, guard)) return -1;
+ generated_codesize = CmEnv_generate_code(code,code_size);
+ code_size+=generated_codesize;
+
+ //JMPEQ0 用コードを作成
+ code[code_size++] = CodeAddr[OP_JMPEQ0];
+ code[code_size++] = (void *)(unsigned long)newreg;
+ label = code_size++; // 飛び先を格納するアドレスを記憶しておく
+
+ // stms と eqs のコンパイル
+ EnvCodeClear();
+ CmEnv_clear_localnamePtr(); // 局所変数としての reg番号を初期化
+
+ if (!CompileBodyFromAst(body)) return -1;
+ Compile_Put_Ret_ForRuleBody();
+
+ generated_codesize = CmEnv_generate_code_with_nameinfo(code,code_size);
+ if (generated_codesize < 0) {
+ puts("System ERROR: Generated codes were too big.");
+ return -1;
+ }
+
+ // 次の guard コンパイルで &code[code_size] にて指定できるように
+ // code_size を更新しておく。
+ code_size += generated_codesize;
+ if (code_size > MAX_CODE_SIZE) {
+ puts("System ERROR: Generated codes were too big.");
+ return -1;
+ }
+
+ // JMPEQ0 のとび先を格納
+ code[label]=(void *)(unsigned long)generated_codesize;
+
+
+ // puts("");
+ // PutsCodeN(code, code_size);
+ // puts("");
+
+ } else {
+ // 通常コンパイル
+ if (!CompileBodyFromAst(body)) return -1;
+ Compile_Put_Ret_ForRuleBody();
+
+ generated_codesize = CmEnv_generate_code_with_nameinfo(code,code_size);
+
+ code_size += generated_codesize;
+ if (generated_codesize < 0) {
+ puts("System ERROR: Generated codes were too long.");
+ return -1;
+ }
+
+ }
+
+
+
+ if (!CmEnv_check_meta_occur_once()) {
+ printf("in the rule:\n %s >< %s.\n",
+ IdTable_get_name(CmEnv.idL),
+ IdTable_get_name(CmEnv.idR));
+
+ // puts_ast(ruleL); printf("><");
+ // puts_ast(ruleR); puts("");
+ return -1;
+ }
+ guard_bodies = ast_getTail(guard_bodies);
+ } while (guard_bodies != NULL);
+
+
+ return code_size;
+
+
+}
+
+
+
+int CompileIfSentenceFromAST(Ast *if_sentence_top,
+ void **code, int offset_code) {
+ // return
+ // generated codesize
+ // -1 : compile error
+
+ // <if-sentence> ::= (AST_IF guard (AST_BRANCH <then> <else>))
+ // | <body>
+ // <then> ::= <if-sentence>
+ // <else> ::= <if-sentence>
+
+ Ast *if_sentence;
+
+ int generated_codesize; // コンパイルで生成されたコード数保存用
+
+ if_sentence = if_sentence_top;
+
+ CmEnv_clear_keeping_rule_properties();
+
+
+ if ((if_sentence == NULL) || (if_sentence->id == AST_BODY)) {
+ // 通常コンパイル
+ Ast *body = if_sentence;
+
+ if (!CompileBodyFromAst(body)) return -1;
+ Compile_Put_Ret_ForRuleBody();
+
+ generated_codesize = CmEnv_generate_code_with_nameinfo(code, offset_code);
+
+ //code_size += generated_codesize;
+ if (generated_codesize < 0) {
+ puts("System ERROR: Generated codes were too long.");
+ return -1;
+ }
+
+ if (!CmEnv_check_meta_occur_once()) {
+ printf("in the rule:\n %s >< %s.\n",
+ IdTable_get_name(CmEnv.idL),
+ IdTable_get_name(CmEnv.idR));
+ return -1;
+ }
+
+ return generated_codesize;
+
+ } else {
+ // if_sentence
+ Ast *guard, *then_branch, *else_branch;
+ int label; // 飛び先指定用
+
+ int offset = offset_code;
+
+ guard = if_sentence->left;
+ then_branch = if_sentence->right->left;
+ else_branch = if_sentence->right->right;
+
+ // Gurad のコンパイル
+ int newreg = CmEnv_newreg();
+ if (!CompileExprFromAst(newreg, guard)) return -1;
+ generated_codesize = CmEnv_generate_code(code, offset);
+ offset += generated_codesize;
+
+
+ //JMPEQ0 用コードを作成
+ code[offset++] = CodeAddr[OP_JMPEQ0];
+ code[offset++] = (void *)(unsigned long)newreg;
+ label = offset++; // 飛び先を格納するアドレスを記憶しておく
+
+ // then_branch のコンパイル
+ EnvCodeClear();
+ CmEnv_clear_localnamePtr(); // 局所変数としての reg番号を初期化
+
+ generated_codesize = CompileIfSentenceFromAST(then_branch, code, offset);
+ if (generated_codesize < 0) return -1;
+
+ offset += generated_codesize;
+
+ if (offset > MAX_CODE_SIZE) {
+ puts("System ERROR: Generated codes were too big.");
+ return -1;
+ }
+
+ // JMPEQ0 のとび先を格納（相対ジャンプ）
+ code[label]=(void *)(unsigned long)generated_codesize;
+
+
+ // else_branch のコンパイル
+ EnvCodeClear();
+ CmEnv_clear_localnamePtr(); // 局所変数としての reg番号を初期化
+
+ generated_codesize = CompileIfSentenceFromAST(else_branch, code, offset);
+ if (generated_codesize < 0) return -1;
+
+ offset += generated_codesize;
+
+ if (offset > MAX_CODE_SIZE) {
+ puts("System ERROR: Generated codes were too big.");
+ return -1;
+ }
+
+ return offset - offset_code;
+ }
+
+
+}
+
+
+
+
+void makeRule(Ast *ast) {
+ // (ASTRULE (AST_CNCT agentL agentR)
+ // <if-sentence>)
+ //
+ // WHERE
+ // <if-sentence> ::= (AST_IF guard (AST_BRANCH <then> <else>))
+ // | <body>
+ // <then> ::= <if-sentence>
+ // <else> ::= <if-sentence>
+
+
+ int idR, idL;
+ Ast *ruleL, *ruleR, *if_sentence;
+
+ void* code[MAX_CODE_SIZE];
+ int code_size=0;
+
+ ruleL = ast->left->left;
+ ruleR = ast->left->right;
+
+ if (ruleL->id == AST_NAME) {
+ printf("ERROR: The name '%s' was specified as the left-hand side of rule agents. It should be an agent.\n", ruleL->left->sym);
+ return;
+ }
+ if (ruleR->id == AST_NAME) {
+ printf("ERROR: The name '%s' was specified as the right-hand side of rule agents. It should be an agent.\n", ruleR->left->sym);
+ return;
+ }
+
+
+ if_sentence = ast->right;
+
+ ruleL = ast_remove_tuple1(ruleL);
+ ruleR = ast_remove_tuple1(ruleR);
+
+
+ // #define MYDEBUG1
+#ifdef MYDEBUG1
+ puts_ast(ruleL); puts("");
+ puts_ast(ruleR); puts("");
+ puts_ast(bodies);
+ exit(1);
+#endif
+
+
+
+ // store ids of rule agent
+ idL = getRuleAgentID(ruleL);
+ idR = getRuleAgentID(ruleR);
+
+
+ /*
+ // prevent re-defining of built-in agents.
+ if (IdTable_is_builtin_rule(ruleL, ruleR)) {
+ printf("Warning: %s >< %s is already defined as built-in.\n",
+ IdTable_get_name(idL), IdTable_get_name(idR));
+
+ } else {
+
+ if (IdTable_is_builtin_rule(ruleR, ruleL)) {
+ printf("Warning: %s >< %s is already defined as built-in.\n",
+ IdTable_get_name(idR), IdTable_get_name(idL));
+ }
+
+ }
+ */
+
+
+ // >< (int i) 対策
+ // int i は (AST_INTVAR (AST_SYM sym NULL) NULL) として構築されているので
+ // ID_TUPLE1 である間は読み飛ばす
+ while (idL == ID_TUPLE1) {
+ ruleL = ruleL->right->left;
+ idL = getRuleAgentID(ruleL);
+ }
+ while (idR == ID_TUPLE1) {
+ ruleR = ruleR->right->left;
+ idR = getRuleAgentID(ruleR);
+ }
+
+
+ // Annotation (*L)、(*R) の処理があるため
+ // 単純に ruleAgentL、ruleAgentR を入れ替えれば良いわけではない。
+
+ if (idL > idR) {
+ // 標準では Append(xs, r) >< [y|ys] なので
+ // idL の方が大きくなって欲しい
+
+ // annotation が (*L) なら左側、(*R) なら右側を指すものとする
+ setAnnotateLR(VM_OFFSET_ANNOTATE_L, VM_OFFSET_ANNOTATE_R);
+
+ } else {
+ Ast *tmp;
+ tmp = ruleL;
+ ruleL = ruleR;
+ ruleR = tmp;
+
+ int idTmp;
+ idTmp = idL;
+ idL = idR;
+ idR = idTmp;
+
+ // aplist 内の (*L) (*R) はそのままにしておき、
+ // annotation が (*L) なら右側、(*R) なら左側を指すものとする
+ setAnnotateLR(VM_OFFSET_ANNOTATE_R, VM_OFFSET_ANNOTATE_L);
+ }
+
+ {
+ int arity;
+
+ // code の先頭2つは idL、idR の arity を格納する
+ if (idL == ID_INT) {
+ arity = 0;
+ } else {
+ arity = getArityFromAST(ruleL);
+ }
+ IdTable_set_arity(idL, arity);
+ code[0] = (void *)(unsigned long)arity;
+
+ if (idR == ID_INT) {
+ arity = 0;
+ } else {
+ arity = getArityFromAST(ruleR);
+ }
+ IdTable_set_arity(idR, arity);
+ code[1] = (void *)(unsigned long)arity;
+
+ code_size = 2;
+ }
+
+
+
+ CmEnv_clear_all();
+
+ if (idL == ID_INT) {
+ setMetaL_asIntName(ruleL);
+ CmEnv.annotateL = ANNOTATE_AS_INT_AGENT; // FreeL 出力を防ぐ
+ } else {
+ setMetaL(ruleL);
+ }
+
+ if (idR == ID_INT) {
+ setMetaR_asIntName(ruleR);
+ CmEnv.annotateR = ANNOTATE_AS_INT_AGENT; // FreeR 出力を防ぐ
+ } else {
+ setMetaR(ruleR);
+ }
+
+ CmEnv.idL = idL;
+ CmEnv.idR = idR;
+
+
+
+ //code_size = CompileGuardBodiesFromAST(guard_bodies, code, code_size);
+ code_size += CompileIfSentenceFromAST(if_sentence, code, code_size);
+ if (code_size < 0)
+ return;
+
+
+#ifdef MYDEBUG
+ PutsCodeN(code, code_size); exit(1);
+#endif
+
+ /*
+ printf("Rule: %s(id:%d) >< %s(id:%d).\n",
+ IdTable_get_name(idL), idL,
+ IdTable_get_name(idR), idR);
+ PutsCodeN(&code[2], code_size-2);
+ //exit(1);
+ */
+
+
+// --------------------------------------------------------------
+// For Fibonacci (as much as possible)
+// #define HAND_FIB_AS_MUCH_AS_POSSIBLE
+// --------------------------------------------------------------
+#ifdef HAND_FIB_AS_MUCH_AS_POSSIBLE
+ if ((strcmp(IdTable_get_name(idL), "Fib") == 0) &&
+ (idR == ID_INT)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)14;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)0;
+ //
+ // code[i++] = CodeAddr[OP_EQ];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)11;
+ // code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_EQI];
+ //code[i++] = (void *)11; // ここで 11(OFFSET_R)を壊してしまうと他で影響あり
+ code[i++] = (void *)12;
+ code[i++] = (void *)11;
+ code[i++] = (void *)0;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ // code[i++] = (void *)8;
+ code[i++] = (void *)4;
+
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)1;
+ //
+ // code[i++] = CodeAddr[PUSH];
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[PUSHI];
+ code[i++] = (void *)0;
+ code[i++] = (void *)INT2FIX(1);
+
+ code[i++] = CodeAddr[RET_FREE_L];
+
+
+
+
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)14;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)1;
+ //
+ // code[i++] = CodeAddr[OP_EQ];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)11;
+ // code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_EQI];
+ code[i++] = (void *)12;
+ code[i++] = (void *)11;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ // code[i++] = (void *)8;
+ code[i++] = (void *)4;
+
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)1;
+ //
+ // code[i++] = CodeAddr[PUSH];
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[PUSHI];
+ code[i++] = (void *)0;
+ code[i++] = (void *)INT2FIX(1);
+
+
+ code[i++] = CodeAddr[RET_FREE_L];
+
+
+
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)16;
+
+
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)14;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)1;
+ //
+ // code[i++] = CodeAddr[OP_SUB];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)11;
+ // code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_SUBI];
+ code[i++] = (void *)12;
+ code[i++] = (void *)11;
+ code[i++] = (void *)1;
+
+
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)17;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)2;
+ //
+ // code[i++] = CodeAddr[OP_SUB];
+ // code[i++] = (void *)15;
+ // code[i++] = (void *)11;
+ // code[i++] = (void *)17;
+
+ code[i++] = CodeAddr[OP_SUBI];
+ code[i++] = (void *)13;
+ code[i++] = (void *)11;
+ code[i++] = (void *)2;
+
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)10;
+ code[i++] = (void *)2;
+ code[i++] = (void *)16;
+ code[i++] = (void *)0;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)20;
+ code[i++] = (void *)1;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)12;
+
+
+ // code[i++] = CodeAddr[REUSEAGENT];
+ // code[i++] = (void *)10;
+ // code[i++] = (void *)21;
+ // code[i++] = (void *)1;
+ // code[i++] = (void *)20;
+ //
+ // code[i++] = CodeAddr[PUSH];
+ // code[i++] = (void *)10;
+ // code[i++] = (void *)15;
+ //
+ // code[i++] = CodeAddr[RET];
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)16;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP];
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+// --------------------------------------------------------------
+// For Fibonacci (naive)
+// #define HAND_FIB
+// --------------------------------------------------------------
+#ifdef HAND_FIB
+ if ((strcmp(IdTable_get_name(idL), "Fib") == 0) &&
+ (idR == ID_INT)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)14;
+ code[i++] = (void *)0;
+
+ code[i++] = CodeAddr[OP_EQ];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)7;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)12;
+ code[i++] = (void *)0;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[RET_FREE_L];
+
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)14;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_EQ];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)7;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)12;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[RET_FREE_L];
+
+
+
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)13;
+ code[i++] = (void *)21;
+ code[i++] = (void *)2;
+ code[i++] = (void *)0;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)20;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)16;
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)17;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_SUB];
+ code[i++] = (void *)15;
+ code[i++] = (void *)16;
+ code[i++] = (void *)17;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)12;
+ code[i++] = (void *)15;
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)20;
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)21;
+ code[i++] = (void *)2;
+
+ code[i++] = CodeAddr[OP_SUB];
+ code[i++] = (void *)19;
+ code[i++] = (void *)20;
+ code[i++] = (void *)21;
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+ code[i++] = (void *)19;
+
+ code[i++] = CodeAddr[LOOP];
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+
+// --------------------------------------------------------------
+// For Fibonacci (naive)
+// #define HAND_FIB_INT
+// --------------------------------------------------------------
+#ifdef HAND_FIB_INT
+ if ((strcmp(IdTable_get_name(idL), "Fibi") == 0) &&
+ (strcmp(IdTable_get_name(idR), "Int") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)14;
+ code[i++] = (void *)0;
+
+ code[i++] = CodeAddr[OP_EQ];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)13;
+ code[i++] = (void *)0;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)(unsigned long)idR;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)14;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_EQ];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)13;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)(unsigned long)idR;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)20;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)14;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_SUB];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)16;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)17;
+ code[i++] = (void *)2;
+
+ code[i++] = CodeAddr[OP_SUB];
+ code[i++] = (void *)15;
+ code[i++] = (void *)16;
+ code[i++] = (void *)17;
+
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)19;
+ code[i++] = (void *)21;
+ code[i++] = (void *)2;
+ code[i++] = (void *)0;
+ code[i++] = (void *)20;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)18;
+ code[i++] = (void *)20;
+ code[i++] = (void *)1;
+ code[i++] = (void *)19;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)21;
+ code[i++] = (void *)9;
+ code[i++] = (void *)1;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)18;
+ code[i++] = (void *)21;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)20;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[LOOP];
+
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+// --------------------------------------------------------------
+// For Fibonacci (tail call version)
+// #define HAND_FIB_TAIL
+// --------------------------------------------------------------
+#ifdef HAND_FIB_TAIL
+ if (strcmp(IdTable_get_name(idL), "Fibt") == 0) {
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)14;
+ code[i++] = (void *)0;
+
+ code[i++] = CodeAddr[OP_EQ];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)7;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)12;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[RET_FREE_L];
+
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)14;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_EQ];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)4;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+
+ code[i++] = CodeAddr[RET_FREE_L];
+
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)14;
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)15;
+ code[i++] = (void *)VM_OFFSET_META_L(2);
+
+ code[i++] = CodeAddr[OP_ADD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)16;
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+
+ code[i++] = CodeAddr[LOADI];
+ code[i++] = (void *)17;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_SUB];
+ code[i++] = (void *)18;
+ code[i++] = (void *)16;
+ code[i++] = (void *)17;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)19;
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(2);
+ code[i++] = (void *)19;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+ code[i++] = (void *)18;
+
+ code[i++] = CodeAddr[LOOP];
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+
+// --------------------------------------------------------------
+// For Insersion Sort
+// #define HAND_I_CONS
+// #define HAND_IS_CONS
+// --------------------------------------------------------------
+#ifdef HAND_I_CONS
+ if ((strcmp(IdTable_get_name(idL), "I") == 0) &&
+ (strcmp(IdTable_get_name(idR), "Cons") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)14;
+ code[i++] = (void *)5;
+
+ code[i++] = CodeAddr[OP_LE];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)16;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)13;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)5;
+ code[i++] = (void *)6;
+
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+
+
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)5;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+ code[i++] = (void *)10;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)21;
+ code[i++] = (void *)2;
+ code[i++] = (void *)13;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)6;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+
+#ifdef HAND_IS_CONS
+ if ((strcmp(IdTable_get_name(idL), "IS") == 0) &&
+ (strcmp(IdTable_get_name(idR), "Cons") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)13;
+ code[i++] = (void *)21;
+ code[i++] = (void *)2;
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+ code[i++] = (void *)9;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)20;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)12;
+ code[i++] = (void *)VM_OFFSET_META_R(1);;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+// --------------------------------------------------------------
+// For Quick Sort
+// #define HAND_Apnd_CONS
+// #define HAND_Part_CONS
+// --------------------------------------------------------------
+
+#ifdef HAND_Apnd_CONS
+ if ((strcmp(IdTable_get_name(idL), "Apnd") == 0) &&
+ (idR == ID_CONS)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)5;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+ code[i++] = (void *)10;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)2;
+ code[i++] = (void *)13;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)6;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+#ifdef HAND_Part_CONS
+ if ((strcmp(IdTable_get_name(idL), "Part") == 0) &&
+ (strcmp(IdTable_get_name(idR), "Cons") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)14;
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+
+ code[i++] = CodeAddr[OP_LT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)30;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)5;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)VM_OFFSET_META_L(2);
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+ code[i++] = (void *)11;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)3;
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(2);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)5;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_L(2);
+ code[i++] = (void *)11;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)3;
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_META_L(2);
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+
+// --------------------------------------------------------------
+// For Merge Sort
+// #define HAND_Split_CONS
+// #define HAND_MergeCC_CONS
+// --------------------------------------------------------------
+
+#ifdef HAND_Split_CONS
+ if ((strcmp(IdTable_get_name(idL), "Split") == 0) &&
+ (strcmp(IdTable_get_name(idR), "Cons") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ //PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)5;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+ code[i++] = (void *)10;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)22;
+ code[i++] = (void *)2;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)6;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+ // #define HAND_MergeCC_CONS
+#ifdef HAND_MergeCC_CONS
+ if ((strcmp(IdTable_get_name(idL), "MergeCC") == 0) &&
+ (strcmp(IdTable_get_name(idR), "Cons") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ PutsCodeN(&code[2], code_size-2);
+ exit(1);
+
+ int i=2;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)14;
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+
+ code[i++] = CodeAddr[OP_LE];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)30;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)5;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+ code[i++] = (void *)11;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)3;
+ code[i++] = (void *)13;
+ code[i++] = (void *)1;
+ code[i++] = (void *)2;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)6;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_L(2);
+ code[i++] = (void *)11;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)3;
+ code[i++] = (void *)13;
+ code[i++] = (void *)5;
+ code[i++] = (void *)6;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)2;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)14;
+ code[i++] = (void *)VM_OFFSET_META_L(2); // ys
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(2);
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)14;
+
+
+
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+
+
+// --------------------------------------------------------------
+// For Bubble Sort
+// #define HAND_B_CONS
+// --------------------------------------------------------------
+
+#ifdef HAND_B_CONS
+ if ((strcmp(IdTable_get_name(idL), "B") == 0) &&
+ (strcmp(IdTable_get_name(idR), "Cons") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)14;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[OP_LT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)13;
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ code[i++] = (void *)32;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+ code[i++] = (void *)10;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)2;
+ code[i++] = (void *)13;
+ code[i++] = (void *)5;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)6;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)8;
+ code[i++] = (void *)2;
+ code[i++] = (void *)5;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)0;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT_CONS];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+ code[i++] = (void *)10;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)2;
+ code[i++] = (void *)13;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)6;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC2];
+ code[i++] = (void *)VM_OFFSET_META_R(1);
+
+
+
+
+ code_size = i;
+
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+
+
+// --------------------------------------------------------------
+// For Dup_SZ
+// #define HAND_DUP_S
+// --------------------------------------------------------------
+#ifdef HAND_DUP_S
+ if ((strcmp(IdTable_get_name(idL), "Dup") == 0) &&
+ (strcmp(IdTable_get_name(idR), "S") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)(unsigned long)idR;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idR;
+ code[i++] = (void *)1;
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)14;
+
+
+ code[i++] = CodeAddr[OP_JMPCNCT];
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+ code[i++] = (void *)(unsigned long)idR;
+ code[i++] = (void *)10;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)16;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)2;
+ code[i++] = (void *)13;
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)16;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[LOOP_RREC1];
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+ //code[i++] = (void *)1;
+
+ code_size = i;
+
+ //PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+
+// --------------------------------------------------------------
+// For ADD_SZ
+//#define HAND_ADD_S
+// --------------------------------------------------------------
+#ifdef HAND_ADD_S
+ if ((strcmp(IdTable_get_name(idL), "AddSZ") == 0) &&
+ (strcmp(IdTable_get_name(idR), "S") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+ //PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)(unsigned long)idR;
+ code[i++] = (void *)1;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)VM_OFFSET_META_L(0);;
+ code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[OP_JMPCNCT];
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+ code[i++] = (void *)(unsigned long)idR;
+ code[i++] = (void *)10;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)2;
+ code[i++] = (void *)13;
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)14;
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP_RREC1];
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code_size = i;
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+// --------------------------------------------------------------
+// For ACK_Sx
+// #define HAND_ACK_S
+// --------------------------------------------------------------
+#ifdef HAND_ACK_S
+ if ((strcmp(IdTable_get_name(idL), "Ack_Sx") == 0) &&
+ (strcmp(IdTable_get_name(idR), "S") == 0)) {
+
+ printf("Rule is optimised: %s >< %s.\n",
+ IdTable_get_name(idL),
+ IdTable_get_name(idR));
+ // PutsCodeN(&code[2], code_size-2);
+
+ int i=2;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)13;
+ code[i++] = (void *)20; // Ack
+ code[i++] = (void *)2;
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)12;
+ code[i++] = (void *)24; // Dup
+ code[i++] = (void *)2;
+ code[i++] = (void *)13;
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)12;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_JMPCNCT];
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+ code[i++] = (void *)(unsigned long)idR;
+ code[i++] = (void *)10;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)16;
+ code[i++] = (void *)(unsigned long)idL;
+ code[i++] = (void *)2;
+ code[i++] = (void *)14;
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)16;
+ code[i++] = (void *)5;
+
+ code[i++] = CodeAddr[RET_FREE_LR];
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(1);
+ code[i++] = (void *)15;
+
+ code[i++] = CodeAddr[LOOP_RREC1];
+ code[i++] = (void *)VM_OFFSET_META_R(0);
+
+ code_size = i;
+ // PutsCodeN(&code[2], i-2);
+ // exit(1);
+ }
+#endif
+
+
+
+
+ // #define HAND_FIB2
+#ifdef HAND_FIB2
+ PutsCodeN(&code[2], code_size-2);
+ int i=2;
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)14;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)0;
+ //
+ // code[i++] = CodeAddr[OP_EQ];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)11;
+ // code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_EQI];
+ //code[i++] = (void *)11; // ここで 11(OFFSET_R)を壊してしまうと他で影響あり
+ code[i++] = (void *)12;
+ code[i++] = (void *)11;
+ code[i++] = (void *)0;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ // code[i++] = (void *)8;
+ code[i++] = (void *)4;
+
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)1;
+ //
+ // code[i++] = CodeAddr[PUSH];
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[PUSHI];
+ code[i++] = (void *)0;
+ code[i++] = (void *)INT2FIX(1);
+
+ code[i++] = CodeAddr[RET_FREE_L];
+
+
+
+
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)14;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)1;
+ //
+ // code[i++] = CodeAddr[OP_EQ];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)11;
+ // code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[OP_EQI];
+ code[i++] = (void *)12;
+ code[i++] = (void *)11;
+ code[i++] = (void *)1;
+
+ code[i++] = CodeAddr[OP_JMPEQ0];
+ code[i++] = (void *)12;
+ // code[i++] = (void *)8;
+ code[i++] = (void *)4;
+
+ // code[i++] = CodeAddr[MKVAL];
+ // code[i++] = (void *)12;
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)1;
+ //
+ // code[i++] = CodeAddr[PUSH];
+ // code[i++] = (void *)0;
+ // code[i++] = (void *)12;
+
+ code[i++] = CodeAddr[PUSHI];
+ code[i++] = (void *)0;
+ code[i++] = (void *)INT2FIX(1);
+
+
+ code[i++] = CodeAddr[RET_FREE_L];
+
+
+
+ // Fib(Add(n2,r))~b, Fib(n2)~c
+ // -------------------------------
+ // Fib(n2)~c
+ code[i++] = CodeAddr[MKNAME];
+ code[i++] = (void *)16;
+
+
+ code[i++] = CodeAddr[OP_SUBI];
+ code[i++] = (void *)12;
+ code[i++] = (void *)11;
+ code[i++] = (void *)2;
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)13;
+ code[i++] = (void *)20;
+ code[i++] = (void *)1;
+ code[i++] = (void *)16;
+
+ code[i++] = CodeAddr[PUSH];
+ code[i++] = (void *)13;
+ code[i++] = (void *)12;
+
+
+ // -------------------------------
+ // Fib(Add(n2,r))~b
+ code[i++] = CodeAddr[OP_SUBI];
+ code[i++] = (void *)13;
+ code[i++] = (void *)11;
+ code[i++] = (void *)1;
+
+
+ code[i++] = CodeAddr[MKAGENT];
+ code[i++] = (void *)14;
+ code[i++] = (void *)10;
+ code[i++] = (void *)2;
+ code[i++] = (void *)16;
+ code[i++] = (void *)0;
+
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_META_L(0);
+ code[i++] = (void *)14;
+
+ code[i++] = CodeAddr[LOAD];
+ code[i++] = (void *)VM_OFFSET_ANNOTATE_R;
+ code[i++] = (void *)13;
+
+ code[i++] = CodeAddr[LOOP];
+
+ code_size = i;
+ PutsCodeN(&code[2], i-2);
+ // exit(1);
+#endif
+
+
+
+ //puts_ast(ruleL); printf("><");
+ //puts_ast(ruleR); puts("");
+
+ // Record the rule code for idR >< idL
+ RuleTable_record(idL, idR, code_size, code);
+
+ if (idL != idR) {
+ // Delete the rule code for idR >< idL
+ // because we need only the rule idL >< idR.
+ RuleTable_delete(idR, idL);
+
+ }
+}
+
+
+void *getRuleCode(VALUE heap_syml, VALUE heap_symr, int *result) {
+ int syml = AGENT(heap_syml)->basic.id;
+ int symr = AGENT(heap_symr)->basic.id;
+
+ //RuleList *add;
+
+ if( RuleTable[syml] == NULL ) { /* もしハッシュテーブルが空ならば */
+ *result=0;
+ return NULL;
+ }
+
+ /* 線形探査が必要 */
+ RuleList *at = RuleTable[syml]; /* 先頭をセット */
+ while( at != NULL ) {
+ if( at->sym == symr) { /* すでにあれば... */
+
+ if (at->available == 0) {
+ *result=0;
+ return NULL;
+
+ } else {
+ *result=1;
+ return at->code;
+ }
+ }
+ at = at->next; /* 次のチェーンを辿る */
+ }
+ /* key がなかった → 先頭に追加 */
+ *result=0;
+ return NULL;
+
+}
+
+
+static inline
+void getRuleCodeInt(VALUE heap_syml, void ***code) {
+ int syml = AGENT(heap_syml)->basic.id;
+
+ //RuleList *add;
+
+ if( RuleTable[syml] == NULL ) { /* もしハッシュテーブルが空ならば */
+ return;
+ }
+
+ /* 線形探査が必要 */
+ RuleList *at = RuleTable[syml]; /* 先頭をセット */
+ while( at != NULL ) {
+ if( at->sym == ID_INT) { /* すでにあれば... */
+
+ if (at->available == 0) {
+ return;
+ } else {
+ *code = at->code;
+ return;
+ }
+ }
+ at = at->next; /* 次のチェーンを辿る */
+ }
+ /* key がなかった → 先頭に追加 */
+ return;
+}
+
+
+#ifdef COUNT_CNCT
+int Count_cnct = 0;
+int Count_cnct_true = 0;
+int Count_cnct_indirect_op = 0;
+#endif
+
+
+//void *ExecCode(int arg, VirtualMachine *vm, void** code) {
+void *ExecCode(int mode, VirtualMachine *restrict vm, void *restrict *code) {
+
+ //http://magazine.rubyist.net/?0008-YarvManiacs
+ static const void *table[] = {
+ &&E_PUSH, &&E_PUSHI, &&E_MKNAME, &&E_MKGNAME, &&E_MKAGENT,
+ &&E_REUSEAGENT, &&E_MYPUSH,
+ &&E_RET, &&E_RET_FREE_LR, &&E_RET_FREE_L, &&E_RET_FREE_R,
+ &&E_LOOP, &&E_LOOP_RREC, &&E_LOOP_RREC1, &&E_LOOP_RREC2,
+ &&E_LOADI, &&E_LOAD, &&E_LOADP,
+ &&E_ADD, &&E_SUB, &&E_SUBI, &&E_MUL, &&E_DIV, &&E_MOD,
+ &&E_LT, &&E_LE, &&E_EQ, &&E_EQI, &&E_NE,
+ &&E_JMPEQ0, &&E_JMPCNCT_CONS, &&E_JMPCNCT, &&E_JMP,
+ &&E_UNM, &&E_RAND,
+ &&E_CNCTGN, &&E_SUBSTGN,
+ &&E_NOP,
+ };
+
+ // table 作成用（通常（コード実行時）は arg=1 で呼び出す）
+ if (mode == 0) {
+ return table;
+ }
+
+ //freeAgent(vm->L); freeAgent(vm->R);
+ //freeAgent(vm->agentReg[VM_OFFSET_META_L(MAX_PORT-1)]);
+ //freeAgent(vm->agentReg[VM_OFFSET_META_R(MAX_PORT-1)]);
+
+ int arity, i, pc=0;
+ VALUE a1;
+
+ goto *code[0];
+
+
+ E_MKNAME:
+ // puts("mkname");
+ vm->agentReg[(unsigned long)code[pc+1]] = makeName(vm);
+ pc +=2;
+ goto *code[pc];
+
+ E_MKGNAME:
+ // puts("mkgname");
+
+ //a1 = makeGlobalName(vm, (char *)code[pc+1]);
+
+ a1 = NameTable_get_heap((char *)code[pc+1]);
+ if (a1 == (VALUE)NULL) {
+ i = IdTable_new_gnameid();
+ a1 = makeName(vm);
+ BASIC(a1)->id = i; // GlobalName の ID をセット
+ NameTable_set_heap_id((char *)code[pc+1], a1, i);
+ }
+
+ vm->agentReg[(unsigned long)code[pc+2]] = a1;
+ pc +=3;
+ goto *code[pc];
+
+
+ E_MKAGENT:
+ // puts("mkagent");
+ arity = (unsigned long)code[pc+3];
+ a1 = makeAgent(vm, (unsigned long)code[pc+2]);
+ vm->agentReg[(unsigned long)code[pc+1]] = a1;
+ {
+ volatile VALUE *a1port = AGENT(a1)->port;
+
+ pc +=4;
+
+ for(i=0; i<arity; i++) {
+ // AGENT(a1)->port[i] = vm->agentReg[(unsigned long)code[pc]];
+ a1port[i] = vm->agentReg[(unsigned long)code[pc++]];
+ }
+
+ }
+ goto *code[pc];
+
+ E_REUSEAGENT: // reuseagent target id arity
+ // puts("reuseagent");
+ a1 = vm->agentReg[(unsigned long)code[pc+1]];
+ AGENT(a1)->basic.id = (unsigned long)code[pc+2];
+ {
+ volatile VALUE *a1port = AGENT(a1)->port;
+ arity = (unsigned long)code[pc+3];
+ pc +=4;
+ for(i=0; i<arity; i++) {
+ // AGENT(a1)->port[i] = vm->agentReg[(unsigned long)code[pc]];
+ a1port[i] = vm->agentReg[(unsigned long)code[pc]];
+ pc++;
+ }
+ }
+ goto *code[pc];
+
+
+
+ /*
+ ===TODO===
+ 2021/9/18
+ a2->t であるところに a1->a2 が与えられても a2->t, a1->a2 のままにしてある。
+ a2 がここで解放できればメモリ利用が助かるのでは？
+ 仮に助からないとしても、グローバル環境で与えられたネットの場合には
+ 単純に eval_equation へ持ち込んだ方が、indirection を生成しなくて済むのでは？
+
+ ==>
+ DONE 21 September 2021
+ 誤差程度しか変わらない。
+
+ */
+#ifndef THREAD
+#define PUSH(vm, a1, a2) \
+ if ((!IS_FIXNUM(a1)) && (IS_NAMEID(BASIC(a1)->id)) && \
+ (NAME(a1)->port == (VALUE)NULL)) { \
+ NAME(a1)->port = a2; \
+ } else if ((!IS_FIXNUM(a2)) && (IS_NAMEID(BASIC(a2)->id)) && \
+ (NAME(a2)->port == (VALUE)NULL)) { \
+ NAME(a2)->port = a1; \
+ } else { \
+ VM_PushEQStack(vm, a1, a2); \
+ }
+#else
+#define PUSH(vm, a1, a2) \
+ if ((!IS_FIXNUM(a1)) && (IS_NAMEID(BASIC(a1)->id)) && \
+ (NAME(a1)->port == (VALUE)NULL)) { \
+ if (!(__sync_bool_compare_and_swap(&(NAME(a1)->port), NULL, a2))) { \
+ if (MaxThreadNum - ActiveThreadNum > 0) { \
+ PushEQStack(NAME(a1)->port,a2); \
+ freeName(a1); \
+ } else { \
+ VM_PushEQStack(vm, NAME(a1)->port, a2); \
+ freeName(a1); \
+ } \
+ } \
+ } else if ((!IS_FIXNUM(a2)) && (IS_NAMEID(BASIC(a2)->id)) && \
+ (NAME(a2)->port == (VALUE)NULL)) { \
+ if (!(__sync_bool_compare_and_swap(&(NAME(a2)->port), NULL, a1))) { \
+ if (MaxThreadNum - ActiveThreadNum > 0) { \
+ PushEQStack(a1,NAME(a2)->port); \
+ freeName(a2); \
+ } else { \
+ VM_PushEQStack(vm, a1,NAME(a2)->port); \
+ freeName(a2); \
+ } \
+ } \
+ } else { \
+ if (MaxThreadNum - ActiveThreadNum > 0) { \
+ PushEQStack(a1,a2); \
+ } else { \
+ VM_PushEQStack(vm, a1,a2); \
+ } \
+ }
+#endif
+
+
+
+ E_PUSH:
+ // puts("push");
+ PUSH(vm, vm->agentReg[(unsigned long)code[pc+1]], vm->agentReg[(unsigned long)code[pc+2]]);
+ pc +=3;
+ goto *code[pc];
+
+
+ E_PUSHI:
+ // puts("pushi reg int");
+ PUSH(vm, vm->agentReg[(unsigned long)code[pc+1]], (unsigned long)code[pc+2]);
+ pc +=3;
+ goto *code[pc];
+
+
+
+#ifndef THREAD
+#define MYPUSH(vm, a1, a2) \
+ if ((!IS_FIXNUM(a1)) && (IS_NAMEID(BASIC(a1)->id)) && \
+ (NAME(a1)->port == (VALUE)NULL)) { \
+ NAME(a1)->port = a2; \
+ } else if ((!IS_FIXNUM(a2)) && (BASIC(a2)->id == ID_NAME) && \
+ (NAME(a2)->port == (VALUE)NULL)) { \
+ NAME(a2)->port = a1; \
+ } else { \
+ VM_PushEQStack(vm, a1,a2); \
+ }
+#else
+#define MYPUSH(vm, a1, a2) \
+ if ((!IS_FIXNUM(a1)) && (IS_NAMEID(BASIC(a1)->id)) && \
+ (NAME(a1)->port == (VALUE)NULL)) { \
+ if (!(__sync_bool_compare_and_swap(&(NAME(a1)->port), NULL, a2))) { \
+ VM_PushEQStack(vm, a1,a2); \
+ } \
+ } else if ((!IS_FIXNUM(a2)) && (IS_NAMEID(BASIC(a2)->id)) && \
+ (NAME(a2)->port == (VALUE)NULL)) { \
+ if (!(__sync_bool_compare_and_swap(&(NAME(a2)->port), NULL, a1))) { \
+ VM_PushEQStack(vm, a1,a2); \
+ } \
+ } else { \
+ VM_PushEQStack(vm, a1,a2); \
+ }
+#endif
+
+
+
+
+ E_MYPUSH:
+ // puts("mypush");
+ // VM_PushEQStack(vm, vm->agentReg[(unsigned long)code[pc+1]], vm->agentReg[(unsigned long)code[pc+2]]);
+ MYPUSH(vm, vm->agentReg[(unsigned long)code[pc+1]], vm->agentReg[(unsigned long)code[pc+2]]);
+ pc +=3;
+ goto *code[pc];
+
+
+
+ E_LOADI:
+ // puts("loadi reg num");
+ //a1 = makeVal_int(vm, (unsigned long)code[pc+3]);
+ a1 = INT2FIX((long)code[pc+2]);
+ vm->agentReg[(unsigned long)code[pc+1]] = a1;
+ pc +=3;
+ goto *code[pc];
+
+
+
+
+ E_RET:
+ // puts("ret");
+ return NULL;
+
+ E_RET_FREE_LR:
+ // puts("ret");
+ freeAgent(vm->agentReg[VM_OFFSET_ANNOTATE_L]);
+ freeAgent(vm->agentReg[VM_OFFSET_ANNOTATE_R]);
+ //
+
+ // freeAgent(vm->L);
+ // freeAgent(vm->R);
+ return NULL;
+
+ E_RET_FREE_L:
+ // puts("ret");
+ freeAgent(vm->agentReg[VM_OFFSET_ANNOTATE_L]);
+ // freeAgent(vm->L);
+ return NULL;
+
+ E_RET_FREE_R:
+ // puts("ret");
+ freeAgent(vm->agentReg[VM_OFFSET_ANNOTATE_R]);
+ // freeAgent(vm->R);
+ return NULL;
+
+
+ E_LOOP:
+ // puts("loop");
+ pc = 0;
+ goto *code[0];
+
+
+ E_LOOP_RREC:
+ // puts("looprrec reg ar");
+ freeAgent(vm->agentReg[VM_OFFSET_ANNOTATE_R]);
+
+ a1 = vm->agentReg[(unsigned long)code[pc+1]];
+ for (int i=0; i<(unsigned long)code[pc+2]; i++) {
+ vm->agentReg[VM_OFFSET_META_R(i)] = AGENT(a1)->port[i];
+ }
+
+ vm->agentReg[VM_OFFSET_ANNOTATE_R] = a1;
+
+ pc = 0;
+ goto *code[0];
+
+
+ E_LOOP_RREC1:
+ // puts("looprrec reg ar");
+ freeAgent(vm->agentReg[VM_OFFSET_ANNOTATE_R]);
+
+ a1 = vm->agentReg[(unsigned long)code[pc+1]];
+
+ vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a1)->port[0];
+
+ vm->agentReg[VM_OFFSET_ANNOTATE_R] = a1;
+
+ pc = 0;
+ goto *code[0];
+
+
+ E_LOOP_RREC2:
+ // puts("looprrec reg ar");
+ freeAgent(vm->agentReg[VM_OFFSET_ANNOTATE_R]);
+
+ a1 = vm->agentReg[(unsigned long)code[pc+1]];
+
+ vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a1)->port[0];
+ vm->agentReg[VM_OFFSET_META_R(1)] = AGENT(a1)->port[1];
+
+ vm->agentReg[VM_OFFSET_ANNOTATE_R] = a1;
+
+ pc = 0;
+ goto *code[0];
+
+
+
+
+
+ E_LOAD:
+ // puts("load reg reg");
+ //a1 = makeVal_int(vm, (unsigned long)code[pc+3]);
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ vm->agentReg[(unsigned long)code[pc+2]];
+ pc +=3;
+ goto *code[pc];
+
+ E_LOADP:
+ // puts("loadp reg reg port");
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ AGENT(vm->agentReg[(unsigned long)code[pc+2]])->port[vm->agentReg[(unsigned long)code[pc+3]]];
+ pc +=4;
+ goto *code[pc];
+
+
+ E_ADD:
+ // puts("ADD reg reg reg");
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ INT2FIX(FIX2INT(vm->agentReg[(unsigned long)code[pc+2]])+FIX2INT(vm->agentReg[(unsigned long)code[pc+3]]));
+ pc +=4;
+ goto *code[pc];
+
+ E_SUB:
+ // puts("SUB reg reg reg");
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ INT2FIX(FIX2INT(vm->agentReg[(unsigned long)code[pc+2]])-
+ FIX2INT(vm->agentReg[(unsigned long)code[pc+3]]));
+ pc +=4;
+ goto *code[pc];
+
+ E_SUBI:
+ //puts("SUBI reg reg int");exit(1);
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ INT2FIX(FIX2INT(vm->agentReg[(unsigned long)code[pc+2]])-
+ (unsigned long)code[pc+3]);
+ pc +=4;
+ goto *code[pc];
+
+
+ E_MUL:
+ // puts("SUB reg reg reg");
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ INT2FIX(FIX2INT(vm->agentReg[(unsigned long)code[pc+2]])*
+ FIX2INT(vm->agentReg[(unsigned long)code[pc+3]]));
+ pc +=4;
+ goto *code[pc];
+
+ E_DIV:
+ // puts("SUB reg reg reg");
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ INT2FIX(FIX2INT(vm->agentReg[(unsigned long)code[pc+2]])/
+ FIX2INT(vm->agentReg[(unsigned long)code[pc+3]]));
+ pc +=4;
+ goto *code[pc];
+
+ E_MOD:
+ // puts("SUB reg reg reg");
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ INT2FIX(FIX2INT(vm->agentReg[(unsigned long)code[pc+2]])%
+ FIX2INT(vm->agentReg[(unsigned long)code[pc+3]]));
+ pc +=4;
+ goto *code[pc];
+
+ E_LT:
+ // puts("SUB reg reg reg");
+ if (FIX2INT(vm->agentReg[(unsigned long)code[pc+2]]) <
+ FIX2INT(vm->agentReg[(unsigned long)code[pc+3]])) {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(1);
+ } else {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(0);
+ }
+ pc +=4;
+ goto *code[pc];
+
+ E_LE:
+ // puts("SUB reg reg reg");
+ if (FIX2INT(vm->agentReg[(unsigned long)code[pc+2]]) <=
+ FIX2INT(vm->agentReg[(unsigned long)code[pc+3]])) {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(1);
+ } else {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(0);
+ }
+ pc +=4;
+ goto *code[pc];
+
+ E_EQ:
+ // puts("SUB reg reg reg");
+ if (vm->agentReg[(unsigned long)code[pc+2]] ==
+ vm->agentReg[(unsigned long)code[pc+3]]) {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(1);
+ } else {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(0);
+ }
+ pc +=4;
+ goto *code[pc];
+
+
+ E_EQI:
+ // puts("SUB reg reg int");
+ if (FIX2INT(vm->agentReg[(unsigned long)code[pc+2]]) ==
+ (unsigned long)code[pc+3]) {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(1);
+ } else {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(0);
+ }
+
+ pc +=4;
+ goto *code[pc];
+
+
+
+ E_NE:
+ // puts("SUB reg reg reg");
+ if (vm->agentReg[(unsigned long)code[pc+2]] !=
+ vm->agentReg[(unsigned long)code[pc+3]]) {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(1);
+ } else {
+ vm->agentReg[(unsigned long)code[pc+1]] = INT2FIX(0);
+ }
+ pc +=4;
+ goto *code[pc];
+
+ E_JMPEQ0:
+ // puts("JMPEQ0 reg pc");
+ // pc is a relative address, not absolute one!
+ if (!FIX2INT(vm->agentReg[(unsigned long)code[pc+1]])) {
+ pc += (unsigned long)code[pc+2];
+ }
+ pc +=3;
+ goto *code[pc];
+
+
+ E_JMPCNCT_CONS:
+ // puts("JMPCNCT_CONS reg pc");
+#ifdef COUNT_CNCT
+ Count_cnct++;
+#endif
+
+ a1 = vm->agentReg[(unsigned long)code[pc+1]];
+ if (IS_FIXNUM(a1)) {
+ pc +=3;
+ goto *code[pc];
+ }
+
+ while (IS_NAMEID(BASIC(a1)->id)) {
+
+ if (NAME(a1)->port == (VALUE)NULL) {
+ pc +=3;
+ goto *code[pc];
+ }
+
+#ifdef COUNT_CNCT
+ Count_cnct_indirect_op++;
+#endif
+ VALUE a2 = NAME(a1)->port;
+ freeName(a1);
+ a1 = a2;
+ vm->agentReg[(unsigned long)code[pc+1]] = a2;
+ }
+
+ if (BASIC(a1)->id == ID_CONS) {
+#ifdef COUNT_CNCT
+ Count_cnct_true++;
+#endif
+
+ pc += (unsigned long)code[pc+2];
+ pc +=3;
+ goto *code[pc];
+ }
+
+ pc +=3;
+ goto *code[pc];
+
+
+ E_JMPCNCT:
+ // puts("JMPCNCT reg id pc");
+#ifdef COUNT_CNCT
+ Count_cnct++;
+#endif
+
+ a1 = vm->agentReg[(unsigned long)code[pc+1]];
+ if (IS_FIXNUM(a1)) {
+ pc +=4;
+ goto *code[pc];
+ }
+
+ while (IS_NAMEID(BASIC(a1)->id)) {
+
+ if (NAME(a1)->port == (VALUE)NULL) {
+ pc +=4;
+ goto *code[pc];
+ }
+
+#ifdef COUNT_CNCT
+ Count_cnct_indirect_op++;
+#endif
+ VALUE a2 = NAME(a1)->port;
+ freeName(a1);
+ a1 = a2;
+ vm->agentReg[(unsigned long)code[pc+1]] = a2;
+ }
+
+ if (BASIC(a1)->id == (unsigned long)code[pc+2]) {
+#ifdef COUNT_CNCT
+ Count_cnct_true++;
+#endif
+ pc += (unsigned long)code[pc+3];
+ pc +=4;
+ goto *code[pc];
+ }
+
+ pc +=4;
+ goto *code[pc];
+
+
+
+ E_JMP:
+ // puts("JMP pc");
+ pc += vm->agentReg[(unsigned long)code[pc+1]];
+ pc +=2;
+ goto *code[pc];
+
+
+
+ E_UNM:
+ // puts("UNM reg reg");
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ INT2FIX(-1 * FIX2INT(vm->agentReg[(unsigned long)code[pc+2]]));
+ pc +=3;
+ goto *code[pc];
+
+ E_RAND:
+ // puts("RAND reg reg");
+ vm->agentReg[(unsigned long)code[pc+1]] =
+ INT2FIX(rand()%FIX2INT(vm->agentReg[(unsigned long)code[pc+2]]));
+ pc +=3;
+ goto *code[pc];
+
+
+ E_CNCTGN:
+ // puts("CNCTGN reg reg");
+ // "x"~s, "x"->t ==> push(s,t), free("x") where "x" is a global name.
+ {
+ VALUE x = vm->agentReg[(unsigned long)code[pc+1]];
+ a1 = NAME(x)->port;
+ freeName(x);
+ PUSH(vm, vm->agentReg[(unsigned long)code[pc+2]], a1);
+ }
+ pc +=3;
+ goto *code[pc];
+
+
+
+ E_SUBSTGN:
+ // puts("SUBSTGN reg reg");
+ // "x"~s, t->u("x") ==> t->u(s), free("x") where "x" is a global name.
+ {
+ VALUE x = vm->agentReg[(unsigned long)code[pc+1]];
+ global_replace_keynode_in_another_term(x,vm->agentReg[(unsigned long)code[pc+2]]);
+ freeName(x);
+ }
+ pc +=3;
+ goto *code[pc];
+
+
+
+
+ // extended codes should be ended here.
+
+
+ E_NOP:
+ pc++;
+ goto *code[pc];
+
+
+
+}
+
+
+
+
+
+void errprintf(int tid) {
+ printf("%2d:", tid);
+}
+
+void errputs(char *s, int tid) {
+ /*
+ errprintf(tid);
+ puts(s);
+ */
+}
+
+
+/******************************************
+ Mark and Sweep
+******************************************/
+#ifndef THREAD
+
+/* 31bit目が 1 ならば、Garbage Collection の Mark&Sweep にて、
+ Mark されたことを意味する*/
+#define FLAG_MARKED 0x01 << 30
+#define IS_FLAG_MARKED(a) ((a) & FLAG_MARKED)
+#define SET_FLAG_MARKED(a) ((a) = ((a) | FLAG_MARKED))
+#define TOGGLE_FLAG_MARKED(a) ((a) = ((a) ^ FLAG_MARKED))
+
+
+void markHeapRec(VALUE ptr) {
+ loop:
+ if ((ptr == (VALUE)NULL) || (IS_FIXNUM(ptr))) {
+ return;
+ } else if (IS_NAMEID(BASIC(ptr)->id)) {
+ if (ptr == ShowNameHeap) return;
+
+ SET_FLAG_MARKED(BASIC(ptr)->id);
+ if (NAME(ptr)->port != (VALUE)NULL) {
+ ptr = NAME(ptr)->port;
+ goto loop;
+ }
+ } else {
+ if (BASIC(ptr)->id == ID_CONS) {
+ if (IS_FIXNUM(AGENT(ptr)->port[0])) {
+ SET_FLAG_MARKED(BASIC(ptr)->id);
+ ptr = AGENT(ptr)->port[1];
+ goto loop;
+ }
+ }
+
+ int arity = IdTable_get_arity(BASIC(ptr)->id);
+ SET_FLAG_MARKED(BASIC(ptr)->id);
+ if (arity == 1) {
+ ptr = AGENT(ptr)->port[0];
+ goto loop;
+ } else { // it contains the case that i==0.
+ int i;
+ for(i=0; i<arity; i++) {
+ markHeapRec(AGENT(ptr)->port[i]);
+ }
+ }
+ }
+}
+
+
+void mark_name_port0(VALUE ptr) {
+ if (ptr != (VALUE)NULL) {
+
+ SET_FLAG_MARKED(BASIC(ptr)->id);
+ if (NAME(ptr)->port != (VALUE)NULL) {
+ ShowNameHeap=ptr;
+ markHeapRec(NAME(ptr)->port);
+ ShowNameHeap=(VALUE)NULL;
+ }
+ }
+}
+
+
+void mark_allHash() {
+ int i;
+ NameList *at;
+
+ for (i=0; i<NAME_HASHSIZE; i++) {
+ at = NameHashTable[i];
+ while (at != NULL) {
+ if (at->heap != (VALUE)NULL) {
+ if (IS_NAMEID(BASIC(at->heap)->id)) {
+ mark_name_port0(at->heap);
+ }
+ }
+ at = at->next;
+ }
+ }
+}
+
+void sweepAgentHeap(Heap *hp) {
+ int i;
+ for (i=0; i < hp->size; i++) {
+ if (!IS_FLAG_MARKED( ((Agent *)hp->heap)[i].basic.id)) {
+ SET_FLAG_AVAIL( ((Agent *)hp->heap)[i].basic.id);
+ } else {
+ TOGGLE_FLAG_MARKED( ((Agent *)hp->heap)[i].basic.id);
+ }
+ }
+}
+void sweepNameHeap(Heap *hp) {
+ int i;
+ for (i=0; i < hp->size; i++) {
+ if (!IS_FLAG_MARKED( ((Name *)hp->heap)[i].basic.id)) {
+ SET_FLAG_AVAIL( ((Name *)hp->heap)[i].basic.id);
+ } else {
+ TOGGLE_FLAG_MARKED( ((Name *)hp->heap)[i].basic.id);
+ }
+ }
+}
+
+
+
+void mark_and_sweep() {
+ //puts("mark_and_sweep is called."); sleep(10);
+
+ mark_allHash();
+ sweepAgentHeap(&(VM.agentHeap));
+ sweepNameHeap(&VM.nameHeap);
+ VM.nextPtr_eqStack = -1;
+}
+
+#endif
+
+
+
+/***********************************
+ exec coequation
+**********************************/
+//#define DEBUG
+
+
+//#define CAS_USLEEP 4
+#define CAS_USLEEP 100
+
+
+// static inline にしないほうが速いようだ
+static inline
+void eval_equation(VirtualMachine *restrict vm, VALUE a1, VALUE a2) {
+
+loop:
+ // if (BASIC(a2)->id >= START_ID_OF_AGENT) {
+
+ // a2 が fixnum
+ if (IS_FIXNUM(a2)) {
+loop_a2IsFixnum:
+ if (IS_FIXNUM(a1)) {
+ printf("Runtime ERROR: "); puts_term(a1); printf("~"); puts_term(a2);
+ printf("\nInteger %d >< %d can not be used as an active pair\n",
+ FIX2INT(a1), FIX2INT(a2));
+#ifndef THREAD
+ mark_and_sweep();
+ return;
+#else
+ printf("Retrieve is not supported in the multi-threaded version.\n");
+ exit(-1);
+#endif
+ }
+
+ // a1 が agent
+ if (IS_AGENTID(BASIC(a1)->id)) {
+
+ void **code = NULL;
+
+ getRuleCodeInt(a1, &code);
+
+ if (code == NULL) {
+
+ // built-in
+ switch (BASIC(a1)->id) {
+ case ID_ADD:
+ {
+ BASIC(a1)->id = ID_ADD2;
+ VALUE a1port1 = AGENT(a1)->port[1];
+ AGENT(a1)->port[1] = a2;
+ a2 = a1port1;
+ goto loop;
+ }
+ case ID_ADD2:
+ {
+ int m = FIX2INT(AGENT(a1)->port[1]);
+ int n = FIX2INT(a2);
+ a2 = INT2FIX(m+n);
+ VALUE a1port0 = AGENT(a1)->port[0];
+ freeAgent(a1);
+ a1 = a1port0;
+ goto loop;
+ }
+ }
+
+
+ printf("Runtime Error: There is no interaction rule for the following pair:\n ");
+ puts_term(a1);
+ printf("~");
+ puts_term(a2);
+ puts("");
+
+ if (yyin != stdin) exit(-1);
+
+#ifndef THREAD
+ mark_and_sweep();
+ return;
+#else
+ printf("Retrieve is not supported in the multi-threaded version.\n");
+ exit(-1);
+#endif
+ }
+
+ int i;
+ unsigned long arity;
+ arity = (unsigned long)code[0];
+
+ switch(arity) {
+ case 0:
+ break;
+
+ case 1:
+ vm->agentReg[VM_OFFSET_META_L(0)] = AGENT(a1)->port[0];
+ break;
+
+ case 2:
+ vm->agentReg[VM_OFFSET_META_L(0)] = AGENT(a1)->port[0];
+ vm->agentReg[VM_OFFSET_META_L(1)] = AGENT(a1)->port[1];
+ break;
+
+ case 3:
+ vm->agentReg[VM_OFFSET_META_L(0)] = AGENT(a1)->port[0];
+ vm->agentReg[VM_OFFSET_META_L(1)] = AGENT(a1)->port[1];
+ vm->agentReg[VM_OFFSET_META_L(2)] = AGENT(a1)->port[2];
+ break;
+
+ default:
+ for (i=0; i<arity; i++) {
+ vm->agentReg[VM_OFFSET_META_L(i)] = AGENT(a1)->port[i];
+ }
+ }
+
+ vm->agentReg[VM_OFFSET_ANNOTATE_L] = a1;
+ vm->agentReg[VM_OFFSET_ANNOTATE_R] = a2;
+
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ ExecCode(1, vm, &code[2]);
+ return;
+
+ } else {
+ // a1 は name、a2 は fixint
+ if (NAME(a1)->port != (VALUE)NULL) {
+ VALUE a1p0;
+ a1p0=NAME(a1)->port;
+ freeName(a1);
+ a1=a1p0;
+ goto loop_a2IsFixnum;
+ } else {
+#ifndef THREAD
+ NAME(a1)->port=a2;
+#else
+ if (!(__sync_bool_compare_and_swap(&(NAME(a1)->port), NULL, a2))) {
+ // usleep(CAS_USLEEP);
+ // goto loop;
+ VALUE a1p0;
+ a1p0=NAME(a1)->port;
+ freeName(a1);
+ a1=a1p0;
+ goto loop_a2IsFixnum;
+
+ }
+#endif
+ }
+
+ }
+ return;
+ }
+
+
+
+ // a2 が agent
+ if (IS_AGENTID(BASIC(a2)->id)) {
+loop_a2IsAgent:
+
+ // a1 が fixnum
+ if (IS_FIXNUM(a1)) {
+ // fixnum >< agent
+
+ void **code = NULL;
+
+ getRuleCodeInt(a2, &code);
+
+ if (code == NULL) {
+
+
+ // built-in
+ VALUE tmp = a1;
+ a1 = a2;
+ a2 = tmp;
+ switch (BASIC(a1)->id) {
+
+ case ID_ADD:
+ {
+ BASIC(a1)->id = ID_ADD2;
+ VALUE a1port1 = AGENT(a1)->port[1];
+ AGENT(a1)->port[1] = a2;
+ a2 = a1port1;
+ goto loop;
+ }
+ case ID_ADD2:
+ {
+ int m = FIX2INT(AGENT(a1)->port[1]);
+ int n = FIX2INT(a2);
+ a2 = INT2FIX(m+n);
+ VALUE a1port0 = AGENT(a1)->port[0];
+ freeAgent(a1);
+ a1 = a1port0;
+ goto loop;
+ }
+
+ }
+
+
+
+
+ printf("Runtime Error: There is no interaction rule for the following pair:\n ");
+ puts_term(a1);
+ printf("~");
+ puts_term(a2);
+ puts("");
+
+ if (yyin != stdin) exit(-1);
+
+#ifndef THREAD
+ mark_and_sweep();
+ return;
+#else
+ printf("Retrieve is not supported in the multi-threaded version.\n");
+ exit(-1);
+#endif
+ }
+
+ int i;
+ unsigned long arity;
+ arity = (unsigned long)code[0];
+
+ switch(arity) {
+ case 0:
+ break;
+
+ case 1:
+ vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
+ break;
+
+ case 2:
+ vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
+ vm->agentReg[VM_OFFSET_META_R(1)] = AGENT(a2)->port[1];
+ break;
+
+ case 3:
+ vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
+ vm->agentReg[VM_OFFSET_META_R(1)] = AGENT(a2)->port[1];
+ vm->agentReg[VM_OFFSET_META_R(2)] = AGENT(a2)->port[2];
+ break;
+
+ default:
+ for (i=0; i<arity; i++) {
+ vm->agentReg[VM_OFFSET_META_R(i)] = AGENT(a2)->port[i];
+ }
+ }
+
+ vm->agentReg[VM_OFFSET_ANNOTATE_L] = a2;
+ vm->agentReg[VM_OFFSET_ANNOTATE_R] = a1;
+
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ ExecCode(1, vm, &code[2]);
+ return;
+ }
+
+ // a1 が agent
+ if (IS_AGENTID(BASIC(a1)->id)) {
+ /* for the case of Agent - Agent */
+
+#ifdef DEBUG
+ puts("");
+ puts("--------------------------------------");
+ puts("execActive");
+ puts("--------------------------------------");
+ puts_term(a1);puts("");
+ printf("><");puts("");
+ puts_term(a2);puts("");
+ puts("--------------------------------------");
+ puts("");
+#endif
+
+
+ if (BASIC(a1)->id < BASIC(a2)->id) {
+ VALUE tmp;
+ tmp=a1;
+ a1=a2;
+ a2=tmp;
+ }
+
+ int result;
+ void **code;
+
+ code = getRuleCode(a1, a2, &result);
+
+ if (result == 0) {
+
+
+ if (BASIC(a2)->id <= ID_CONS) {
+
+ // built-in
+ switch (BASIC(a1)->id) {
+
+ case ID_TUPLE0:
+ if (BASIC(a2)->id == ID_TUPLE0) {
+ // [] ~ [] --> nothing
+ freeAgent(a1);
+ freeAgent(a2);
+ return;
+ }
+
+ break; // end ID_TUPLE0
+
+
+ case ID_TUPLE2:
+ if (BASIC(a2)->id == ID_TUPLE2) {
+ // (x1,x2) ~ (y1,y2) --> x1~y1, x2~y2
+ VALUE a1p1 = AGENT(a1)->port[1];
+ VALUE a2p1 = AGENT(a2)->port[1];
+ PUSH(vm, a1p1, a2p1);
+
+ freeAgent(a1);
+ freeAgent(a2);
+ a1 = AGENT(a1)->port[0];
+ a2 = AGENT(a2)->port[0];
+ goto loop;
+ }
+
+ break; // end ID_TUPLE2
+
+ case ID_TUPLE3:
+ if (BASIC(a2)->id == ID_TUPLE3) {
+ // (x1,x2,x3) ~ (y1,y2,y3) --> x1~y1, x2~y2, x3~y3
+ PUSH(vm, AGENT(a1)->port[2], AGENT(a2)->port[2]);
+ PUSH(vm, AGENT(a1)->port[1], AGENT(a2)->port[1]);
+
+ freeAgent(a1);
+ freeAgent(a2);
+ a1 = AGENT(a1)->port[0];
+ a2 = AGENT(a2)->port[0];
+ goto loop;
+ }
+
+ break; // end ID_TUPLE2
+
+
+ case ID_TUPLE4:
+ if (BASIC(a2)->id == ID_TUPLE4) {
+ // (x1,x2,x3) ~ (y1,y2,y3) --> x1~y1, x2~y2, x3~y3
+ PUSH(vm, AGENT(a1)->port[3], AGENT(a2)->port[3]);
+ PUSH(vm, AGENT(a1)->port[2], AGENT(a2)->port[2]);
+ PUSH(vm, AGENT(a1)->port[1], AGENT(a2)->port[1]);
+
+ freeAgent(a1);
+ freeAgent(a2);
+ a1 = AGENT(a1)->port[0];
+ a2 = AGENT(a2)->port[0];
+ goto loop;
+ }
+
+ break; // end ID_TUPLE2
+
+
+ case ID_TUPLE5:
+ if (BASIC(a2)->id == ID_TUPLE5) {
+ // (x1,x2,x3) ~ (y1,y2,y3) --> x1~y1, x2~y2, x3~y3
+ PUSH(vm, AGENT(a1)->port[4], AGENT(a2)->port[4]);
+ PUSH(vm, AGENT(a1)->port[3], AGENT(a2)->port[3]);
+ PUSH(vm, AGENT(a1)->port[2], AGENT(a2)->port[2]);
+ PUSH(vm, AGENT(a1)->port[1], AGENT(a2)->port[1]);
+
+ freeAgent(a1);
+ freeAgent(a2);
+ a1 = AGENT(a1)->port[0];
+ a2 = AGENT(a2)->port[0];
+ goto loop;
+ }
+
+ break; // end ID_TUPLE2
+
+
+ case ID_NIL:
+ if (BASIC(a2)->id == ID_NIL) {
+ // [] ~ [] --> nothing
+ freeAgent(a1);
+ freeAgent(a2);
+ return;
+ }
+
+ break; // end ID_NIL
+
+
+ case ID_CONS:
+ if (BASIC(a2)->id == ID_CONS) {
+ // a:b ~ c:d --> a~c, b~d
+ VALUE a1p1 = AGENT(a1)->port[1];
+ VALUE a2p1 = AGENT(a2)->port[1];
+ PUSH(vm, a1p1, a2p1);
+
+ freeAgent(a1);
+ freeAgent(a2);
+ a1 = AGENT(a1)->port[0];
+ a2 = AGENT(a2)->port[0];
+ goto loop;
+ }
+
+ break; // end ID_CONS
+
+
+
+ // built-in funcAgent for lists and tuples
+ case ID_APPEND:
+ switch (BASIC(a2)->id) {
+ case ID_NIL:
+ {
+ // App(r,a) >< [] => r~a;
+ VALUE a1p0 = AGENT(a1)->port[0];
+ VALUE a1p1 = AGENT(a1)->port[1];
+ freeAgent(a1);
+ freeAgent(a2);
+ a1=a1p0;
+ a2=a1p1;
+ goto loop;
+ }
+
+ case ID_CONS:
+ {
+ // App(r,a) >< [x|xs] => r~(*R)[x|w], (*L)App(w,a)~xs;
+ VALUE a1p0 = AGENT(a1)->port[0];
+ VALUE a2p1 = AGENT(a2)->port[1];
+ VALUE w = makeName(vm);
+
+ AGENT(a2)->port[1] = w;
+ PUSH(vm, a1p0, a2);
+ //VM_PushEQStack(vm, a1p1, a2);
+
+ AGENT(a1)->port[0] = w;
+ a2 = a2p1;
+ goto loop;
+ }
+ }
+
+ break; // end ID_APPEND
+
+
+
+ }
+ }
+
+
+
+ printf("Runtime Error: There is no interaction rule for the following pair:\n ");
+ puts_term(a1);
+ printf("~");
+ puts_term(a2);
+ puts("");
+
+ if (yyin != stdin) exit(-1);
+
+#ifndef THREAD
+ mark_and_sweep();
+ return;
+#else
+ printf("Retrieve is not supported in the multi-threaded version.\n");
+ exit(-1);
+#endif
+ }
+ // normal op
+
+
+ // PutsCode(at);
+ // return;
+
+
+ int i;
+ unsigned long arity;
+ arity = (unsigned long)code[0];
+
+ switch(arity) {
+ case 0:
+ break;
+
+ case 1:
+ vm->agentReg[VM_OFFSET_META_L(0)] = AGENT(a1)->port[0];
+ break;
+
+ case 2:
+ vm->agentReg[VM_OFFSET_META_L(0)] = AGENT(a1)->port[0];
+ vm->agentReg[VM_OFFSET_META_L(1)] = AGENT(a1)->port[1];
+ break;
+
+ case 3:
+ vm->agentReg[VM_OFFSET_META_L(0)] = AGENT(a1)->port[0];
+ vm->agentReg[VM_OFFSET_META_L(1)] = AGENT(a1)->port[1];
+ vm->agentReg[VM_OFFSET_META_L(2)] = AGENT(a1)->port[2];
+ break;
+
+ default:
+ for (i=0; i<arity; i++) {
+ vm->agentReg[VM_OFFSET_META_L(i)] = AGENT(a1)->port[i];
+ }
+ }
+
+
+ arity = (unsigned long)code[1];
+ switch(arity) {
+ case 0:
+ break;
+
+ case 1:
+ vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
+ break;
+
+ case 2:
+ vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
+ vm->agentReg[VM_OFFSET_META_R(1)] = AGENT(a2)->port[1];
+ break;
+
+ case 3:
+ vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
+ vm->agentReg[VM_OFFSET_META_R(1)] = AGENT(a2)->port[1];
+ vm->agentReg[VM_OFFSET_META_R(2)] = AGENT(a2)->port[2];
+ break;
+
+ default:
+ for (i=0; i<arity; i++) {
+ vm->agentReg[VM_OFFSET_META_R(i)] = AGENT(a2)->port[i];
+ }
+ }
+
+
+ vm->agentReg[VM_OFFSET_ANNOTATE_L] = a1;
+ vm->agentReg[VM_OFFSET_ANNOTATE_R] = a2;
+
+ //freeAgent(a1);
+ //freeAgent(a2);
+
+ // vm->L = a1;
+ // vm->R = a2;
+
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ ExecCode(1, vm, &code[2]);
+
+
+
+ return;
+ } else {
+
+ // a1 が name
+ // a2 is agent
+ if (NAME(a1)->port != (VALUE)NULL) {
+
+ VALUE a1p0;
+ a1p0=NAME(a1)->port;
+ freeName(a1);
+ a1=a1p0;
+ goto loop_a2IsAgent;
+ } else {
+#ifndef THREAD
+ NAME(a1)->port=a2;
+#else
+ if (!(__sync_bool_compare_and_swap(&(NAME(a1)->port), NULL, a2))) {
+ VALUE a1p0;
+ a1p0=NAME(a1)->port;
+ freeName(a1);
+ a1=a1p0;
+ goto loop_a2IsAgent;
+
+ //usleep(CAS_USLEEP);
+ // // goto loop_a2IsAgent;
+ // goto loop;
+ }
+#endif
+
+ }
+ }
+ } else {
+ // a2 が name: a1 はわからない
+ if (NAME(a2)->port != (VALUE)NULL) {
+ VALUE a2p0;
+ a2p0=NAME(a2)->port;
+ freeName(a2);
+ a2=a2p0;
+ goto loop;
+ } else {
+#ifndef THREAD
+ NAME(a2)->port=a1;
+#else
+ if (!(__sync_bool_compare_and_swap(&(NAME(a2)->port), NULL, a1))) {
+ VALUE a2p0;
+ a2p0=NAME(a2)->port;
+ freeName(a2);
+ a2=a2p0;
+ goto loop;
+
+
+ // usleep(CAS_USLEEP);;
+ // goto loop;
+ }
+#endif
+ }
+ }
+}
+
+
+
+
+
+void Init_VM(VirtualMachine *vm,
+ unsigned int agentBufferSize, unsigned int eqStackSize) {
+ VM_InitBuffer(vm, agentBufferSize);
+ VM_EQStackInit(vm, eqStackSize);
+}
+
+
+
+#ifndef THREAD
+
+
+#define WHNF_UNUSED_STACK_SIZE 100
+typedef struct {
+ // EQStack
+ EQ *eqs;
+ int eqs_index;
+ int size;
+ int enabled; // 0: not Enabled, 1: Enabled.
+} WHNF_Info;
+WHNF_Info WHNFinfo;
+
+void Init_WHNFinfo() {
+ WHNFinfo.eqs_index = 0;
+ WHNFinfo.size = WHNF_UNUSED_STACK_SIZE;
+ WHNFinfo.enabled = 0; // not Enabled
+
+ WHNFinfo.eqs = malloc(sizeof(EQ) * WHNF_UNUSED_STACK_SIZE);
+ if (WHNFinfo.eqs == NULL) {
+ printf("WHNFinfo.eqs: Malloc error\n");
+ exit(-1);
+ }
+}
+
+void WHNFInfo_push_equation(VALUE t1, VALUE t2) {
+ WHNFinfo.eqs[WHNFinfo.eqs_index].l = t1;
+ WHNFinfo.eqs[WHNFinfo.eqs_index].r = t2;
+ WHNFinfo.eqs_index++;
+ if (WHNFinfo.eqs_index >= WHNF_UNUSED_STACK_SIZE) {
+ printf("ERROR: WHNFinfo.eqs stack becomes full.\n");
+ exit(-1);
+ }
+}
+
+
+void WHNF_execution_loop() {
+ VALUE t1, t2;
+ while (PopEQStack(&VM, &t1, &t2)) {
+
+ if ((NameTable_ckech_if_term_has_gname(t1) == 1) ||
+ (NameTable_ckech_if_term_has_gname(t2) == 1)) {
+
+ eval_equation(&VM, t1, t2);
+
+ } else {
+ WHNFInfo_push_equation(t1, t2);
+ }
+ }
+
+}
+
+
+void select_kind_of_push(Ast *ast, int p1, int p2) {
+ char *sym = ast->left->sym;
+ VALUE aheap = NameTable_get_heap(sym);
+
+ if (aheap != (VALUE)NULL) {
+ // aheap already exists as a global
+
+ // aheap is connected with something such as aheap->t
+ // ==> p2 should be conncected with t, so CNCTGN(p1,p2)
+ if (NAME(aheap)->port != (VALUE)NULL) {
+ EnvAddCodeCNCTGN((void *)(unsigned long)p1,
+ (void *)(unsigned long)p2);
+ } else {
+ // aheap occurs somewhere, so it should be replaced by SUBSTGN(p1,p2)
+ EnvAddCodeSUBSTGN((void *)(unsigned long)p1,
+ (void *)(unsigned long)p2);
+ }
+ } else {
+ EnvAddCodePUSH((void *)(unsigned long)p1, (void *)(unsigned long)p2);
+ }
+
+
+}
+
+
+int exec(Ast *at) {
+ // Ast at: (AST_BODY stmlist aplist)
+
+ unsigned long long t, time;
+
+ void* code[MAX_CODE_SIZE];
+
+
+ start_timer(&t);
+
+ CmEnv_clear_all();
+
+ // for `where' expression
+ if (!CompileStmListFromAst(at->left)) return 0;
+
+ // aplist
+ at = at->right;
+
+ // for aplists
+ // puts(""); puts_ast(at); puts("");
+ RewriteEQListOnAST(at);
+ // puts(""); puts_ast(at); puts("");
+ // exit(1);
+
+
+ // Syntax error check
+ {
+ Ast *tmp_at=at;
+ while (tmp_at != NULL) {
+ if ((check_invalid_occurrence(tmp_at->left->left))
+ && (check_invalid_occurrence(tmp_at->left->right))) {
+ // both ara invalid
+ if (yyin != stdin) exit(-1);
+ return 0;
+ }
+
+ tmp_at = ast_getTail(tmp_at);
+ }
+ }
+
+
+ while (at != NULL) {
+ int p1,p2;
+ Ast *left, *right;
+
+ left = at->left->left;
+ right = at->left->right;
+ p1 = CompileTermFromAst(left, -1);
+ p2 = CompileTermFromAst(right, -1);
+
+
+ /*
+ EnvAddCodePUSH((void *)(unsigned long)p1, (void *)(unsigned long)p2);
+ at = ast_getTail(at);
+ */
+
+ if (left->id == AST_NAME) {
+ select_kind_of_push(left, p1, p2);
+
+ } else if (right->id == AST_NAME) {
+ select_kind_of_push(right, p2, p1);
+
+ } else {
+ EnvAddCodePUSH((void *)(unsigned long)p1, (void *)(unsigned long)p2);
+ }
+
+ at = ast_getTail(at);
+
+
+
+ }
+ EnvAddCode(CodeAddr[RET]);
+
+ // checking whether names occur more than twice
+ if (!CmEnv_check_name_reference_times()) {
+ if (yyin != stdin) exit(-1);
+ return 0;
+ }
+
+ // Generate codes from CmEnv, where '0' means index of the `code',
+ // so here codes are stored from code[0].
+ CmEnv_generate_code_with_nameinfo(code,0);
+
+
+ //PutsCode(code); exit(1);
+
+#ifdef COUNT_MKAGENT
+ NumberOfMkAgent=0;
+#endif
+
+
+ // WHNF: Unused equations are stacked to be execution targets again.
+ if (WHNFinfo.enabled) {
+ for (int i=0; i < WHNFinfo.eqs_index ; i++) {
+ MYPUSH(&VM, WHNFinfo.eqs[i].l, WHNFinfo.eqs[i].r);
+ }
+ WHNFinfo.eqs_index = 0;
+ }
+
+
+ ExecCode(1, &VM, code);
+
+
+#ifdef COUNT_INTERACTION
+ VM_ClearInteractionNum(&VM);
+#endif
+
+
+
+ // EXECUTION LOOP
+
+ if (!WHNFinfo.enabled) {
+ // no-stategy execution
+
+ VALUE t1, t2;
+ while (PopEQStack(&VM, &t1, &t2)) {
+ eval_equation(&VM, t1, t2);
+ }
+
+ } else {
+ // WHNF stragety
+ WHNF_execution_loop();
+ }
+
+
+ time=stop_timer(&t);
+#ifdef COUNT_INTERACTION
+ printf("(%d interactions, %.2f sec)\n", VM_GetInteractionNum(&VM),
+ (double)(time)/1000000);
+#else
+ printf("(%.2f sec)\n",
+ (double)(time)/1000000);
+#endif
+
+#ifdef COUNT_MKAGENT
+ printf("(%d mkAgent calls)\n", NumberOfMkAgent);
+#endif
+
+
+#ifdef CELL_USE_VERBOSE
+ printf("(%lu agents and %lu names cells are used.)\n",
+ VM.agentHeap.size - getNumOfAvailAgentHeap(&VM.agentHeap),
+ VM.nameHeap.size - getNumOfAvailNameHeap(&VM.nameHeap));
+#endif
+
+#ifdef COUNT_CNCT
+ printf("JMP_CNCT:%d true:%d ratio:%.2f%%\n",
+ Count_cnct, Count_cnct_true, Count_cnct_true*100.0/Count_cnct);
+ printf(" ind_op:%d ratio(ind/JMP_CNCT):%.2f%%\n",
+ Count_cnct_indirect_op, Count_cnct_indirect_op*100.0/Count_cnct);
+#endif
+
+ return 1;
+}
+
+#else
+
+int CpuNum=1; // CPU 数の設定用（sysconf(_SC_NPROSSEORS_CONF)) を使って求める）
+
+static pthread_cond_t ActiveThread_all_sleep = PTHREAD_COND_INITIALIZER;
+static pthread_t *Threads;
+static VirtualMachine **VMs;
+
+void *tpool_thread(void *arg) {
+
+ VirtualMachine *vm;
+
+ vm = (VirtualMachine *)arg;
+
+#ifdef CPU_ZERO
+ cpu_set_t mask;
+ CPU_ZERO(&mask);
+ CPU_SET((vm->id)%CpuNum, &mask);
+ if(sched_setaffinity(0, sizeof(mask), &mask)==-1) {
+ printf("WARNING:");
+ printf("CPUNUM=%d, id=%d, cpuid=%d\n", CpuNum, vm->id, (vm->id)%CpuNum);
+ }
+ //printf("CPUNUM=%d, id=%d, cpuid=%d\n", CpuNum, vm->id, (vm->id)%CpuNum);
+#endif
+
+ while (1) {
+
+ VALUE t1, t2;
+ while (!PopEQStack(vm, &t1, &t2)) {
+ pthread_mutex_lock(&Sleep_lock);
+ ActiveThreadNum = ActiveThreadNum - 1;
+
+ if (ActiveThreadNum == 0) {
+ pthread_mutex_lock(&AllSleep_lock);
+ pthread_cond_signal(&ActiveThread_all_sleep);
+ pthread_mutex_unlock(&AllSleep_lock);
+ }
+
+ // printf("[Thread %d is slept.]\n", vm->id);
+ pthread_cond_wait(&EQStack_not_empty, &Sleep_lock);
+ ActiveThreadNum = ActiveThreadNum + 1;
+ pthread_mutex_unlock(&Sleep_lock);
+ // printf("[Thread %d is waked up.]\n", vm->id);
+
+
+ }
+
+
+ eval_equation(vm, t1, t2);
+
+
+ }
+
+ return (void *)NULL;
+}
+
+void tpool_init(unsigned int agentBufferSize, unsigned int eqstack_size) {
+ int i, status;
+ // static int id[100];
+
+
+ pthread_attr_t attr;
+ pthread_attr_init(&attr);
+ pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);
+
+
+ CpuNum = sysconf(_SC_NPROCESSORS_CONF);
+
+ pthread_setconcurrency(CpuNum);
+
+
+ Threads = (pthread_t *)malloc(sizeof(pthread_t)*MaxThreadNum);
+ if (Threads == NULL) {
+ printf("the thread pool could not be created.");
+ exit(-1);
+ }
+ ActiveThreadNum = MaxThreadNum;
+
+ VMs = malloc(sizeof(VirtualMachine*)*MaxThreadNum);
+ if (VMs == NULL) {
+ printf("the thread pool could not be created.");
+ exit(-1);
+ }
+
+
+ for (i=0; i<MaxThreadNum; i++) {
+ VMs[i] = malloc(sizeof(VirtualMachine));
+ VMs[i]->id = i;
+ Init_VM(VMs[i], agentBufferSize, eqstack_size);
+ status = pthread_create( &Threads[i],
+ &attr,
+ tpool_thread,
+ (void *)VMs[i]);
+ if (status!=0) {
+ printf("ERROR: Thread%d could not be created.", i);
+ exit(-1);
+ }
+ }
+}
+
+void tpool_destroy() {
+ int i;
+ for (i=0; i<MaxThreadNum; i++) {
+ pthread_join( Threads[i],
+ NULL);
+ }
+ free(Threads);
+
+
+}
+
+
+int exec(Ast *at) {
+ // Ast at: (AST_BODY stmlist aplist)
+
+ unsigned long long t, time;
+ int i;
+
+#ifdef COUNT_INTERACTION
+ for (i=0; i<MaxThreadNum; i++) {
+ VM_ClearInteractionNum(VMs[i]);
+ }
+#endif
+
+ void* code[MAX_CODE_SIZE];
+ int eqsnum = 0;
+
+ start_timer(&t);
+ CmEnv_clear_all();
+
+ // for `where' expression
+ if (!CompileStmListFromAst(at->left)) return 0;
+
+ // aplist
+ at = at->right;
+
+ RewriteEQListOnAST(at);
+
+ // Syntax error check
+ {
+ Ast *tmp_at=at;
+ while (tmp_at != NULL) {
+ if ((check_invalid_occurrence(tmp_at->left->left))
+ && (check_invalid_occurrence(tmp_at->left->right))) {
+ // both ara invalid
+ if (yyin != stdin) exit(-1);
+ return 0;
+ }
+
+ tmp_at = ast_getTail(tmp_at);
+ }
+ }
+
+
+ while (at!=NULL) {
+ int p1,p2;
+ p1 = CompileTermFromAst(at->left->left, -1);
+ p2 = CompileTermFromAst(at->left->right, -1);
+ EnvAddCodeMYPUSH((void *)(unsigned long)p1, (void *)(unsigned long)p2);
+ eqsnum++; //分散用
+ at = ast_getTail(at);
+ }
+ EnvAddCode(CodeAddr[RET]);
+
+ // checking whether names occur more than twice
+ if (!CmEnv_check_name_reference_times()) {
+ return 0;
+ }
+ // '0' means that generated codes are stored in code[0,...].
+ CmEnv_generate_code_with_nameinfo(code,0);
+
+ //PutsCode(code); exit(1);
+
+ ExecCode(1, VMs[0], code);
+
+ //分散用
+ {
+ int each_eqsnum = eqsnum / MaxThreadNum;
+ if (each_eqsnum == 0) each_eqsnum = 1;
+ for (i=1; i<MaxThreadNum; i++) {
+ VALUE t1, t2;
+ int j;
+ for (j=0; j<each_eqsnum; j++) {
+ if (!VM_PopEQStack(VMs[0], &t1, &t2)) goto endloop;
+ VM_PushEQStack(VMs[i], t1, t2);
+ }
+ }
+ }
+ endloop:
+
+
+ pthread_mutex_lock(&Sleep_lock);
+ pthread_cond_broadcast(&EQStack_not_empty);
+ pthread_mutex_unlock(&Sleep_lock);
+
+ usleep(100000);
+
+
+ if (ActiveThreadNum != 0) {
+ pthread_mutex_lock(&AllSleep_lock);
+ pthread_cond_wait(&ActiveThread_all_sleep, &AllSleep_lock);
+ pthread_mutex_unlock(&AllSleep_lock);
+ }
+
+ time=stop_timer(&t);
+
+#ifdef COUNT_INTERACTION
+ unsigned long total=0;
+ for (i=0; i<MaxThreadNum; i++) {
+ total += VM_GetInteractionNum(VMs[i]);
+ }
+ printf("(%lu interactions by %d threads, %.2f sec)\n",
+ total,
+ MaxThreadNum,
+ (double)(time)/1000000.0);
+
+ /*
+ printf("[");
+ for (i=0; i<MaxThreadNum-1; i++) {
+ printf("%.1f%%, ", VM_GetInteractionNum(VMs[i])/(double)total*100.0);
+ }
+ printf("%.1f%%] (CPUNUM=%d)\n", VM_GetInteractionNum(VMs[i])/(double)total*100.0, CpuNum);
+ */
+
+#else
+ printf("(%.2f sec by %d threads)\n",
+ (double)(time)/1000000.0,
+ MaxThreadNum);
+#endif
+
+
+ return 0;
+}
+#endif
+
+
+
+int destroy() {
+
+ return 0;
+}
+
+int yywrap() {
+ return 1;
+}
+
+
+int main(int argc, char *argv[])
+{
+ int retrieve_flag = 1; // 1:エラー時にインタプリタへ復帰, 0:終了
+
+
+#ifdef MY_YYLINENO
+ initInfoLineno();
+#endif
+
+ // Pritty printing for local variables
+#ifdef PRETTY_VAR
+ Pretty_init();
+#endif
+
+ {
+ int i, param;
+ char *fname = NULL;
+
+#ifndef MALLOC
+ unsigned int max_AgentBuffer=100000;
+ unsigned int min_AgentBuffer=20000;
+#endif
+ unsigned int max_EQStack=10000;
+
+
+#ifndef THREAD
+ Init_WHNFinfo();
+#endif
+
+
+ for (i=1; i<argc; i++) {
+ if (*argv[i] == '-') {
+ switch (*(argv[i] +1)) {
+ case 'v':
+ printf("Inpla version %s\n", VERSION);
+ exit(-1);
+ break;
+ case '-':
+ case 'h':
+ case '?':
+ puts("Usage: inpla [options]\n");
+ puts("Options:");
+ printf(" -f <filename> Set input file name (Defalut: STDIN)\n");
+
+#ifndef MALLOC
+ printf(" -c <number> Set the size of term cells (Defalut: %8u)\n",
+ max_AgentBuffer);
+#endif
+
+ printf(" -x <number> Set the size of the EQ stack (Default: %8u)\n",
+ max_EQStack);
+
+
+ // Extended Options for threads or non-threads
+#ifdef THREAD
+ printf(" -t <number> Set the number of threads (Default: %8d)\n",
+ MaxThreadNum);
+
+#else
+ printf(" -w Enable Weak Head Normal Form strategy (Default: false)\n"
+ );
+
+
+#endif
+
+
+ printf(" -h Print this help message\n\n");
+ exit(-1);
+ break;
+
+
+ case 'f' :
+ i++;
+ if (i < argc) {
+ fname = argv[i];
+ retrieve_flag = 0;
+ } else {
+ printf("ERROR: The option switch '-f' needs a string that specifies an input file name.");
+ exit(-1);
+ }
+ break;
+
+
+
+#ifndef MALLOC
+ case 'c' :
+ i++;
+ if (i < argc) {
+ param = atoi(argv[i]);
+ if (param == 0) {
+ printf("ERROR: '%s' is illegal parameter for -c\n", argv[i]);
+ exit(-1);
+ }
+ } else {
+ printf("ERROR: The option switch '-c' needs a number as an argument.");
+ exit(-1);
+ }
+ max_AgentBuffer=param;
+ break;
+#endif
+
+ case 'x' :
+ i++;
+ if (i < argc) {
+ param = atoi(argv[i]);
+ if (param == 0) {
+ printf("ERROR: '%s' is illegal parameter for -x\n", argv[i]);
+ exit(-1);
+ }
+ } else {
+ printf("ERROR: The option switch '-x' needs a number as an argument.");
+ exit(-1);
+ }
+ max_EQStack=param;
+ break;
+
+
+#ifdef THREAD
+ case 't' :
+ i++;
+ if (i < argc) {
+ param = atoi(argv[i]);
+ if (param == 0) {
+ printf("ERROR: '%s' is illegal parameter for -t\n", argv[i]);
+ exit(-1);
+ }
+ } else {
+ printf("ERROR: The option switch '-t' needs a number as an argument.");
+ exit(-1);
+ }
+
+ MaxThreadNum=param;
+ break;
+#else
+ case 'w' :
+ WHNFinfo.enabled = 1;
+ break;
+#endif
+
+
+ default:
+ printf("ERROR: Unrecognized option %s\n", argv[i]);
+ printf("Please use -h option for getting more information.\n\n");
+ exit(-1);
+ }
+ }
+ }
+
+
+ // Dealing with fname
+ if (fname == NULL) {
+ yyin = stdin;
+
+ } else {
+ if (!(yyin = fopen(fname, "r"))) {
+ printf("Error: The file '%s' can not be opened.\n", fname);
+ exit(-1);
+ }
+ }
+
+
+#ifndef THREAD
+ if (WHNFinfo.enabled) {
+ printf("Inpla %s (WHNF) : Interaction nets as a programming language",
+ VERSION);
+ printf(" [%s]\n", BUILT_DATE);
+ } else {
+ printf("Inpla %s : Interaction nets as a programming language",
+ VERSION);
+ printf(" [built: %s]\n", BUILT_DATE);
+ }
+#else
+ printf("Inpla %s : Interaction nets as a programming language",
+ VERSION);
+ printf(" [built: %s]\n", BUILT_DATE);
+#endif
+
+
+
+ max_AgentBuffer = min_AgentBuffer + max_AgentBuffer/MaxThreadNum;
+ printf("max_AgentBuffer:%d\n", max_AgentBuffer);
+
+ IdTable_init();
+ NameTable_init();
+ RuleTable_init();
+
+#ifdef THREAD
+ GlobalEQStack_Init(max_EQStack);
+#endif
+
+ ast_heapInit();
+
+ CmEnv_Init(VM_LOCALVAR_SIZE);
+
+
+ // builtin agents
+
+ // IdTable_set_name(ID_PAIR0, SYM_PAIR0);
+
+
+#ifndef THREAD
+ Init_VM(&VM, max_AgentBuffer, max_EQStack);
+#else
+ tpool_init(max_AgentBuffer, max_EQStack);
+#endif
+
+ /*
+ printf("Name size=%d\n", sizeof(Name));
+ printf("Basic size=%d\n", sizeof(Basic));
+ printf("VALUE size=%d\n", sizeof(VALUE));
+ printf("IDTYPE size=%d\n", sizeof(IDTYPE));
+ */
+
+ }
+
+
+
+ // the main loop of parsing and execution
+ while(1) {
+
+
+ // When errors occur during parsing
+ if (yyparse()!=0) {
+
+ if (!retrieve_flag) {
+ exit(0);
+ }
+
+ if (yyin != stdin) {
+ fclose(yyin);
+ while (yyin!=stdin) {
+ popFP();
+ }
+#ifdef MY_YYLINENO
+ InfoLineno_AllDestroy();
+#endif
+ }
+
+ }
+ }
+
+ exit(0);
+}
+
+
+#include "lex.yy.c"
diff --git a/src/linenoise/.gitignore b/src/linenoise/.gitignore
new file mode 100644
index 0000000..7ab7825
--- /dev/null
+++ b/src/linenoise/.gitignore
@@ -0,0 +1,3 @@
+linenoise_example
+*.dSYM
+history.txt
diff --git a/src/linenoise/linenoise.c b/src/linenoise/linenoise.c
new file mode 100644
index 0000000..cfe51e7
--- /dev/null
+++ b/src/linenoise/linenoise.c
@@ -0,0 +1,1225 @@
+/* linenoise.c -- guerrilla line editing library against the idea that a
+ * line editing lib needs to be 20,000 lines of C code.
+ *
+ * You can find the latest source code at:
+ *
+ * http://github.com/antirez/linenoise
+ *
+ * Does a number of crazy assumptions that happen to be true in 99.9999% of
+ * the 2010 UNIX computers around.
+ *
+ * ------------------------------------------------------------------------
+ *
+ * Copyright (c) 2010-2016, Salvatore Sanfilippo <antirez at gmail dot com>
+ * Copyright (c) 2010-2013, Pieter Noordhuis <pcnoordhuis at gmail dot com>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * * Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * ------------------------------------------------------------------------
+ *
+ * References:
+ * - http://invisible-island.net/xterm/ctlseqs/ctlseqs.html
+ * - http://www.3waylabs.com/nw/WWW/products/wizcon/vt220.html
+ *
+ * Todo list:
+ * - Filter bogus Ctrl+<char> combinations.
+ * - Win32 support
+ *
+ * Bloat:
+ * - History search like Ctrl+r in readline?
+ *
+ * List of escape sequences used by this program, we do everything just
+ * with three sequences. In order to be so cheap we may have some
+ * flickering effect with some slow terminal, but the lesser sequences
+ * the more compatible.
+ *
+ * EL (Erase Line)
+ * Sequence: ESC [ n K
+ * Effect: if n is 0 or missing, clear from cursor to end of line
+ * Effect: if n is 1, clear from beginning of line to cursor
+ * Effect: if n is 2, clear entire line
+ *
+ * CUF (CUrsor Forward)
+ * Sequence: ESC [ n C
+ * Effect: moves cursor forward n chars
+ *
+ * CUB (CUrsor Backward)
+ * Sequence: ESC [ n D
+ * Effect: moves cursor backward n chars
+ *
+ * The following is used to get the terminal width if getting
+ * the width with the TIOCGWINSZ ioctl fails
+ *
+ * DSR (Device Status Report)
+ * Sequence: ESC [ 6 n
+ * Effect: reports the current cusor position as ESC [ n ; m R
+ * where n is the row and m is the column
+ *
+ * When multi line mode is enabled, we also use an additional escape
+ * sequence. However multi line editing is disabled by default.
+ *
+ * CUU (Cursor Up)
+ * Sequence: ESC [ n A
+ * Effect: moves cursor up of n chars.
+ *
+ * CUD (Cursor Down)
+ * Sequence: ESC [ n B
+ * Effect: moves cursor down of n chars.
+ *
+ * When linenoiseClearScreen() is called, two additional escape sequences
+ * are used in order to clear the screen and position the cursor at home
+ * position.
+ *
+ * CUP (Cursor position)
+ * Sequence: ESC [ H
+ * Effect: moves the cursor to upper left corner
+ *
+ * ED (Erase display)
+ * Sequence: ESC [ 2 J
+ * Effect: clear the whole screen
+ *
+ */
+
+#include <termios.h>
+#include <unistd.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <errno.h>
+#include <string.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <sys/ioctl.h>
+#include <unistd.h>
+#include "linenoise.h"
+
+#define LINENOISE_DEFAULT_HISTORY_MAX_LEN 100
+#define LINENOISE_MAX_LINE 4096
+static char *unsupported_term[] = {"dumb","cons25","emacs",NULL};
+static linenoiseCompletionCallback *completionCallback = NULL;
+static linenoiseHintsCallback *hintsCallback = NULL;
+static linenoiseFreeHintsCallback *freeHintsCallback = NULL;
+
+static struct termios orig_termios; /* In order to restore at exit.*/
+static int maskmode = 0; /* Show "***" instead of input. For passwords. */
+static int rawmode = 0; /* For atexit() function to check if restore is needed*/
+static int mlmode = 0; /* Multi line mode. Default is single line. */
+static int atexit_registered = 0; /* Register atexit just 1 time. */
+static int history_max_len = LINENOISE_DEFAULT_HISTORY_MAX_LEN;
+static int history_len = 0;
+static char **history = NULL;
+
+/* The linenoiseState structure represents the state during line editing.
+ * We pass this state to functions implementing specific editing
+ * functionalities. */
+struct linenoiseState {
+ int ifd; /* Terminal stdin file descriptor. */
+ int ofd; /* Terminal stdout file descriptor. */
+ char *buf; /* Edited line buffer. */
+ size_t buflen; /* Edited line buffer size. */
+ const char *prompt; /* Prompt to display. */
+ size_t plen; /* Prompt length. */
+ size_t pos; /* Current cursor position. */
+ size_t oldpos; /* Previous refresh cursor position. */
+ size_t len; /* Current edited line length. */
+ size_t cols; /* Number of columns in terminal. */
+ size_t maxrows; /* Maximum num of rows used so far (multiline mode) */
+ int history_index; /* The history index we are currently editing. */
+};
+
+enum KEY_ACTION{
+ KEY_NULL = 0, /* NULL */
+ CTRL_A = 1, /* Ctrl+a */
+ CTRL_B = 2, /* Ctrl-b */
+ CTRL_C = 3, /* Ctrl-c */
+ CTRL_D = 4, /* Ctrl-d */
+ CTRL_E = 5, /* Ctrl-e */
+ CTRL_F = 6, /* Ctrl-f */
+ CTRL_H = 8, /* Ctrl-h */
+ TAB = 9, /* Tab */
+ CTRL_K = 11, /* Ctrl+k */
+ CTRL_L = 12, /* Ctrl+l */
+ ENTER = 13, /* Enter */
+ CTRL_N = 14, /* Ctrl-n */
+ CTRL_P = 16, /* Ctrl-p */
+ CTRL_T = 20, /* Ctrl-t */
+ CTRL_U = 21, /* Ctrl+u */
+ CTRL_W = 23, /* Ctrl+w */
+ ESC = 27, /* Escape */
+ BACKSPACE = 127 /* Backspace */
+};
+
+static void linenoiseAtExit(void);
+int linenoiseHistoryAdd(const char *line);
+static void refreshLine(struct linenoiseState *l);
+
+/* Debugging macro. */
+#if 0
+FILE *lndebug_fp = NULL;
+#define lndebug(...) \
+ do { \
+ if (lndebug_fp == NULL) { \
+ lndebug_fp = fopen("/tmp/lndebug.txt","a"); \
+ fprintf(lndebug_fp, \
+ "[%d %d %d] p: %d, rows: %d, rpos: %d, max: %d, oldmax: %d\n", \
+ (int)l->len,(int)l->pos,(int)l->oldpos,plen,rows,rpos, \
+ (int)l->maxrows,old_rows); \
+ } \
+ fprintf(lndebug_fp, ", " __VA_ARGS__); \
+ fflush(lndebug_fp); \
+ } while (0)
+#else
+#define lndebug(fmt, ...)
+#endif
+
+/* ======================= Low level terminal handling ====================== */
+
+/* Enable "mask mode". When it is enabled, instead of the input that
+ * the user is typing, the terminal will just display a corresponding
+ * number of asterisks, like "****". This is useful for passwords and other
+ * secrets that should not be displayed. */
+void linenoiseMaskModeEnable(void) {
+ maskmode = 1;
+}
+
+/* Disable mask mode. */
+void linenoiseMaskModeDisable(void) {
+ maskmode = 0;
+}
+
+/* Set if to use or not the multi line mode. */
+void linenoiseSetMultiLine(int ml) {
+ mlmode = ml;
+}
+
+/* Return true if the terminal name is in the list of terminals we know are
+ * not able to understand basic escape sequences. */
+static int isUnsupportedTerm(void) {
+ char *term = getenv("TERM");
+ int j;
+
+ if (term == NULL) return 0;
+ for (j = 0; unsupported_term[j]; j++)
+ if (!strcasecmp(term,unsupported_term[j])) return 1;
+ return 0;
+}
+
+/* Raw mode: 1960 magic shit. */
+static int enableRawMode(int fd) {
+ struct termios raw;
+
+ if (!isatty(STDIN_FILENO)) goto fatal;
+ if (!atexit_registered) {
+ atexit(linenoiseAtExit);
+ atexit_registered = 1;
+ }
+ if (tcgetattr(fd,&orig_termios) == -1) goto fatal;
+
+ raw = orig_termios; /* modify the original mode */
+ /* input modes: no break, no CR to NL, no parity check, no strip char,
+ * no start/stop output control. */
+ raw.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
+ /* output modes - disable post processing */
+ raw.c_oflag &= ~(OPOST);
+ /* control modes - set 8 bit chars */
+ raw.c_cflag |= (CS8);
+ /* local modes - choing off, canonical off, no extended functions,
+ * no signal chars (^Z,^C) */
+ raw.c_lflag &= ~(ECHO | ICANON | IEXTEN | ISIG);
+ /* control chars - set return condition: min number of bytes and timer.
+ * We want read to return every single byte, without timeout. */
+ raw.c_cc[VMIN] = 1; raw.c_cc[VTIME] = 0; /* 1 byte, no timer */
+
+ /* put terminal in raw mode after flushing */
+ if (tcsetattr(fd,TCSAFLUSH,&raw) < 0) goto fatal;
+ rawmode = 1;
+ return 0;
+
+fatal:
+ errno = ENOTTY;
+ return -1;
+}
+
+static void disableRawMode(int fd) {
+ /* Don't even check the return value as it's too late. */
+ if (rawmode && tcsetattr(fd,TCSAFLUSH,&orig_termios) != -1)
+ rawmode = 0;
+}
+
+/* Use the ESC [6n escape sequence to query the horizontal cursor position
+ * and return it. On error -1 is returned, on success the position of the
+ * cursor. */
+static int getCursorPosition(int ifd, int ofd) {
+ char buf[32];
+ int cols, rows;
+ unsigned int i = 0;
+
+ /* Report cursor location */
+ if (write(ofd, "\x1b[6n", 4) != 4) return -1;
+
+ /* Read the response: ESC [ rows ; cols R */
+ while (i < sizeof(buf)-1) {
+ if (read(ifd,buf+i,1) != 1) break;
+ if (buf[i] == 'R') break;
+ i++;
+ }
+ buf[i] = '\0';
+
+ /* Parse it. */
+ if (buf[0] != ESC || buf[1] != '[') return -1;
+ if (sscanf(buf+2,"%d;%d",&rows,&cols) != 2) return -1;
+ return cols;
+}
+
+/* Try to get the number of columns in the current terminal, or assume 80
+ * if it fails. */
+static int getColumns(int ifd, int ofd) {
+ struct winsize ws;
+
+ if (ioctl(1, TIOCGWINSZ, &ws) == -1 || ws.ws_col == 0) {
+ /* ioctl() failed. Try to query the terminal itself. */
+ int start, cols;
+
+ /* Get the initial position so we can restore it later. */
+ start = getCursorPosition(ifd,ofd);
+ if (start == -1) goto failed;
+
+ /* Go to right margin and get position. */
+ if (write(ofd,"\x1b[999C",6) != 6) goto failed;
+ cols = getCursorPosition(ifd,ofd);
+ if (cols == -1) goto failed;
+
+ /* Restore position. */
+ if (cols > start) {
+ char seq[32];
+ snprintf(seq,32,"\x1b[%dD",cols-start);
+ if (write(ofd,seq,strlen(seq)) == -1) {
+ /* Can't recover... */
+ }
+ }
+ return cols;
+ } else {
+ return ws.ws_col;
+ }
+
+failed:
+ return 80;
+}
+
+/* Clear the screen. Used to handle ctrl+l */
+void linenoiseClearScreen(void) {
+ if (write(STDOUT_FILENO,"\x1b[H\x1b[2J",7) <= 0) {
+ /* nothing to do, just to avoid warning. */
+ }
+}
+
+/* Beep, used for completion when there is nothing to complete or when all
+ * the choices were already shown. */
+static void linenoiseBeep(void) {
+ fprintf(stderr, "\x7");
+ fflush(stderr);
+}
+
+/* ============================== Completion ================================ */
+
+/* Free a list of completion option populated by linenoiseAddCompletion(). */
+static void freeCompletions(linenoiseCompletions *lc) {
+ size_t i;
+ for (i = 0; i < lc->len; i++)
+ free(lc->cvec[i]);
+ if (lc->cvec != NULL)
+ free(lc->cvec);
+}
+
+/* This is an helper function for linenoiseEdit() and is called when the
+ * user types the <tab> key in order to complete the string currently in the
+ * input.
+ *
+ * The state of the editing is encapsulated into the pointed linenoiseState
+ * structure as described in the structure definition. */
+static int completeLine(struct linenoiseState *ls) {
+ linenoiseCompletions lc = { 0, NULL };
+ int nread, nwritten;
+ char c = 0;
+
+ completionCallback(ls->buf,&lc);
+ if (lc.len == 0) {
+ linenoiseBeep();
+ } else {
+ size_t stop = 0, i = 0;
+
+ while(!stop) {
+ /* Show completion or original buffer */
+ if (i < lc.len) {
+ struct linenoiseState saved = *ls;
+
+ ls->len = ls->pos = strlen(lc.cvec[i]);
+ ls->buf = lc.cvec[i];
+ refreshLine(ls);
+ ls->len = saved.len;
+ ls->pos = saved.pos;
+ ls->buf = saved.buf;
+ } else {
+ refreshLine(ls);
+ }
+
+ nread = read(ls->ifd,&c,1);
+ if (nread <= 0) {
+ freeCompletions(&lc);
+ return -1;
+ }
+
+ switch(c) {
+ case 9: /* tab */
+ i = (i+1) % (lc.len+1);
+ if (i == lc.len) linenoiseBeep();
+ break;
+ case 27: /* escape */
+ /* Re-show original buffer */
+ if (i < lc.len) refreshLine(ls);
+ stop = 1;
+ break;
+ default:
+ /* Update buffer and return */
+ if (i < lc.len) {
+ nwritten = snprintf(ls->buf,ls->buflen,"%s",lc.cvec[i]);
+ ls->len = ls->pos = nwritten;
+ }
+ stop = 1;
+ break;
+ }
+ }
+ }
+
+ freeCompletions(&lc);
+ return c; /* Return last read character */
+}
+
+/* Register a callback function to be called for tab-completion. */
+void linenoiseSetCompletionCallback(linenoiseCompletionCallback *fn) {
+ completionCallback = fn;
+}
+
+/* Register a hits function to be called to show hits to the user at the
+ * right of the prompt. */
+void linenoiseSetHintsCallback(linenoiseHintsCallback *fn) {
+ hintsCallback = fn;
+}
+
+/* Register a function to free the hints returned by the hints callback
+ * registered with linenoiseSetHintsCallback(). */
+void linenoiseSetFreeHintsCallback(linenoiseFreeHintsCallback *fn) {
+ freeHintsCallback = fn;
+}
+
+/* This function is used by the callback function registered by the user
+ * in order to add completion options given the input string when the
+ * user typed <tab>. See the example.c source code for a very easy to
+ * understand example. */
+void linenoiseAddCompletion(linenoiseCompletions *lc, const char *str) {
+ size_t len = strlen(str);
+ char *copy, **cvec;
+
+ copy = malloc(len+1);
+ if (copy == NULL) return;
+ memcpy(copy,str,len+1);
+ cvec = realloc(lc->cvec,sizeof(char*)*(lc->len+1));
+ if (cvec == NULL) {
+ free(copy);
+ return;
+ }
+ lc->cvec = cvec;
+ lc->cvec[lc->len++] = copy;
+}
+
+/* =========================== Line editing ================================= */
+
+/* We define a very simple "append buffer" structure, that is an heap
+ * allocated string where we can append to. This is useful in order to
+ * write all the escape sequences in a buffer and flush them to the standard
+ * output in a single call, to avoid flickering effects. */
+struct abuf {
+ char *b;
+ int len;
+};
+
+static void abInit(struct abuf *ab) {
+ ab->b = NULL;
+ ab->len = 0;
+}
+
+static void abAppend(struct abuf *ab, const char *s, int len) {
+ char *new = realloc(ab->b,ab->len+len);
+
+ if (new == NULL) return;
+ memcpy(new+ab->len,s,len);
+ ab->b = new;
+ ab->len += len;
+}
+
+static void abFree(struct abuf *ab) {
+ free(ab->b);
+}
+
+/* Helper of refreshSingleLine() and refreshMultiLine() to show hints
+ * to the right of the prompt. */
+void refreshShowHints(struct abuf *ab, struct linenoiseState *l, int plen) {
+ char seq[64];
+ if (hintsCallback && plen+l->len < l->cols) {
+ int color = -1, bold = 0;
+ char *hint = hintsCallback(l->buf,&color,&bold);
+ if (hint) {
+ int hintlen = strlen(hint);
+ int hintmaxlen = l->cols-(plen+l->len);
+ if (hintlen > hintmaxlen) hintlen = hintmaxlen;
+ if (bold == 1 && color == -1) color = 37;
+ if (color != -1 || bold != 0)
+ snprintf(seq,64,"\033[%d;%d;49m",bold,color);
+ else
+ seq[0] = '\0';
+ abAppend(ab,seq,strlen(seq));
+ abAppend(ab,hint,hintlen);
+ if (color != -1 || bold != 0)
+ abAppend(ab,"\033[0m",4);
+ /* Call the function to free the hint returned. */
+ if (freeHintsCallback) freeHintsCallback(hint);
+ }
+ }
+}
+
+/* Single line low level line refresh.
+ *
+ * Rewrite the currently edited line accordingly to the buffer content,
+ * cursor position, and number of columns of the terminal. */
+static void refreshSingleLine(struct linenoiseState *l) {
+ char seq[64];
+ size_t plen = strlen(l->prompt);
+ int fd = l->ofd;
+ char *buf = l->buf;
+ size_t len = l->len;
+ size_t pos = l->pos;
+ struct abuf ab;
+
+ while((plen+pos) >= l->cols) {
+ buf++;
+ len--;
+ pos--;
+ }
+ while (plen+len > l->cols) {
+ len--;
+ }
+
+ abInit(&ab);
+ /* Cursor to left edge */
+ snprintf(seq,64,"\r");
+ abAppend(&ab,seq,strlen(seq));
+ /* Write the prompt and the current buffer content */
+ abAppend(&ab,l->prompt,strlen(l->prompt));
+ if (maskmode == 1) {
+ while (len--) abAppend(&ab,"*",1);
+ } else {
+ abAppend(&ab,buf,len);
+ }
+ /* Show hits if any. */
+ refreshShowHints(&ab,l,plen);
+ /* Erase to right */
+ snprintf(seq,64,"\x1b[0K");
+ abAppend(&ab,seq,strlen(seq));
+ /* Move cursor to original position. */
+ snprintf(seq,64,"\r\x1b[%dC", (int)(pos+plen));
+ abAppend(&ab,seq,strlen(seq));
+ if (write(fd,ab.b,ab.len) == -1) {} /* Can't recover from write error. */
+ abFree(&ab);
+}
+
+/* Multi line low level line refresh.
+ *
+ * Rewrite the currently edited line accordingly to the buffer content,
+ * cursor position, and number of columns of the terminal. */
+static void refreshMultiLine(struct linenoiseState *l) {
+ char seq[64];
+ int plen = strlen(l->prompt);
+ int rows = (plen+l->len+l->cols-1)/l->cols; /* rows used by current buf. */
+ int rpos = (plen+l->oldpos+l->cols)/l->cols; /* cursor relative row. */
+ int rpos2; /* rpos after refresh. */
+ int col; /* colum position, zero-based. */
+ int old_rows = l->maxrows;
+ int fd = l->ofd, j;
+ struct abuf ab;
+
+ /* Update maxrows if needed. */
+ if (rows > (int)l->maxrows) l->maxrows = rows;
+
+ /* First step: clear all the lines used before. To do so start by
+ * going to the last row. */
+ abInit(&ab);
+ if (old_rows-rpos > 0) {
+ lndebug("go down %d", old_rows-rpos);
+ snprintf(seq,64,"\x1b[%dB", old_rows-rpos);
+ abAppend(&ab,seq,strlen(seq));
+ }
+
+ /* Now for every row clear it, go up. */
+ for (j = 0; j < old_rows-1; j++) {
+ lndebug("clear+up");
+ snprintf(seq,64,"\r\x1b[0K\x1b[1A");
+ abAppend(&ab,seq,strlen(seq));
+ }
+
+ /* Clean the top line. */
+ lndebug("clear");
+ snprintf(seq,64,"\r\x1b[0K");
+ abAppend(&ab,seq,strlen(seq));
+
+ /* Write the prompt and the current buffer content */
+ abAppend(&ab,l->prompt,strlen(l->prompt));
+ if (maskmode == 1) {
+ unsigned int i;
+ for (i = 0; i < l->len; i++) abAppend(&ab,"*",1);
+ } else {
+ abAppend(&ab,l->buf,l->len);
+ }
+
+ /* Show hits if any. */
+ refreshShowHints(&ab,l,plen);
+
+ /* If we are at the very end of the screen with our prompt, we need to
+ * emit a newline and move the prompt to the first column. */
+ if (l->pos &&
+ l->pos == l->len &&
+ (l->pos+plen) % l->cols == 0)
+ {
+ lndebug("<newline>");
+ abAppend(&ab,"\n",1);
+ snprintf(seq,64,"\r");
+ abAppend(&ab,seq,strlen(seq));
+ rows++;
+ if (rows > (int)l->maxrows) l->maxrows = rows;
+ }
+
+ /* Move cursor to right position. */
+ rpos2 = (plen+l->pos+l->cols)/l->cols; /* current cursor relative row. */
+ lndebug("rpos2 %d", rpos2);
+
+ /* Go up till we reach the expected positon. */
+ if (rows-rpos2 > 0) {
+ lndebug("go-up %d", rows-rpos2);
+ snprintf(seq,64,"\x1b[%dA", rows-rpos2);
+ abAppend(&ab,seq,strlen(seq));
+ }
+
+ /* Set column. */
+ col = (plen+(int)l->pos) % (int)l->cols;
+ lndebug("set col %d", 1+col);
+ if (col)
+ snprintf(seq,64,"\r\x1b[%dC", col);
+ else
+ snprintf(seq,64,"\r");
+ abAppend(&ab,seq,strlen(seq));
+
+ lndebug("\n");
+ l->oldpos = l->pos;
+
+ if (write(fd,ab.b,ab.len) == -1) {} /* Can't recover from write error. */
+ abFree(&ab);
+}
+
+/* Calls the two low level functions refreshSingleLine() or
+ * refreshMultiLine() according to the selected mode. */
+static void refreshLine(struct linenoiseState *l) {
+ if (mlmode)
+ refreshMultiLine(l);
+ else
+ refreshSingleLine(l);
+}
+
+/* Insert the character 'c' at cursor current position.
+ *
+ * On error writing to the terminal -1 is returned, otherwise 0. */
+int linenoiseEditInsert(struct linenoiseState *l, char c) {
+ if (l->len < l->buflen) {
+ if (l->len == l->pos) {
+ l->buf[l->pos] = c;
+ l->pos++;
+ l->len++;
+ l->buf[l->len] = '\0';
+ if ((!mlmode && l->plen+l->len < l->cols && !hintsCallback)) {
+ /* Avoid a full update of the line in the
+ * trivial case. */
+ char d = (maskmode==1) ? '*' : c;
+ if (write(l->ofd,&d,1) == -1) return -1;
+ } else {
+ refreshLine(l);
+ }
+ } else {
+ memmove(l->buf+l->pos+1,l->buf+l->pos,l->len-l->pos);
+ l->buf[l->pos] = c;
+ l->len++;
+ l->pos++;
+ l->buf[l->len] = '\0';
+ refreshLine(l);
+ }
+ }
+ return 0;
+}
+
+/* Move cursor on the left. */
+void linenoiseEditMoveLeft(struct linenoiseState *l) {
+ if (l->pos > 0) {
+ l->pos--;
+ refreshLine(l);
+ }
+}
+
+/* Move cursor on the right. */
+void linenoiseEditMoveRight(struct linenoiseState *l) {
+ if (l->pos != l->len) {
+ l->pos++;
+ refreshLine(l);
+ }
+}
+
+/* Move cursor to the start of the line. */
+void linenoiseEditMoveHome(struct linenoiseState *l) {
+ if (l->pos != 0) {
+ l->pos = 0;
+ refreshLine(l);
+ }
+}
+
+/* Move cursor to the end of the line. */
+void linenoiseEditMoveEnd(struct linenoiseState *l) {
+ if (l->pos != l->len) {
+ l->pos = l->len;
+ refreshLine(l);
+ }
+}
+
+/* Substitute the currently edited line with the next or previous history
+ * entry as specified by 'dir'. */
+#define LINENOISE_HISTORY_NEXT 0
+#define LINENOISE_HISTORY_PREV 1
+void linenoiseEditHistoryNext(struct linenoiseState *l, int dir) {
+ if (history_len > 1) {
+ /* Update the current history entry before to
+ * overwrite it with the next one. */
+ free(history[history_len - 1 - l->history_index]);
+ history[history_len - 1 - l->history_index] = strdup(l->buf);
+ /* Show the new entry */
+ l->history_index += (dir == LINENOISE_HISTORY_PREV) ? 1 : -1;
+ if (l->history_index < 0) {
+ l->history_index = 0;
+ return;
+ } else if (l->history_index >= history_len) {
+ l->history_index = history_len-1;
+ return;
+ }
+ strncpy(l->buf,history[history_len - 1 - l->history_index],l->buflen);
+ l->buf[l->buflen-1] = '\0';
+ l->len = l->pos = strlen(l->buf);
+ refreshLine(l);
+ }
+}
+
+/* Delete the character at the right of the cursor without altering the cursor
+ * position. Basically this is what happens with the "Delete" keyboard key. */
+void linenoiseEditDelete(struct linenoiseState *l) {
+ if (l->len > 0 && l->pos < l->len) {
+ memmove(l->buf+l->pos,l->buf+l->pos+1,l->len-l->pos-1);
+ l->len--;
+ l->buf[l->len] = '\0';
+ refreshLine(l);
+ }
+}
+
+/* Backspace implementation. */
+void linenoiseEditBackspace(struct linenoiseState *l) {
+ if (l->pos > 0 && l->len > 0) {
+ memmove(l->buf+l->pos-1,l->buf+l->pos,l->len-l->pos);
+ l->pos--;
+ l->len--;
+ l->buf[l->len] = '\0';
+ refreshLine(l);
+ }
+}
+
+/* Delete the previosu word, maintaining the cursor at the start of the
+ * current word. */
+void linenoiseEditDeletePrevWord(struct linenoiseState *l) {
+ size_t old_pos = l->pos;
+ size_t diff;
+
+ while (l->pos > 0 && l->buf[l->pos-1] == ' ')
+ l->pos--;
+ while (l->pos > 0 && l->buf[l->pos-1] != ' ')
+ l->pos--;
+ diff = old_pos - l->pos;
+ memmove(l->buf+l->pos,l->buf+old_pos,l->len-old_pos+1);
+ l->len -= diff;
+ refreshLine(l);
+}
+
+/* This function is the core of the line editing capability of linenoise.
+ * It expects 'fd' to be already in "raw mode" so that every key pressed
+ * will be returned ASAP to read().
+ *
+ * The resulting string is put into 'buf' when the user type enter, or
+ * when ctrl+d is typed.
+ *
+ * The function returns the length of the current buffer. */
+static int linenoiseEdit(int stdin_fd, int stdout_fd, char *buf, size_t buflen, const char *prompt)
+{
+ struct linenoiseState l;
+
+ /* Populate the linenoise state that we pass to functions implementing
+ * specific editing functionalities. */
+ l.ifd = stdin_fd;
+ l.ofd = stdout_fd;
+ l.buf = buf;
+ l.buflen = buflen;
+ l.prompt = prompt;
+ l.plen = strlen(prompt);
+ l.oldpos = l.pos = 0;
+ l.len = 0;
+ l.cols = getColumns(stdin_fd, stdout_fd);
+ l.maxrows = 0;
+ l.history_index = 0;
+
+ /* Buffer starts empty. */
+ l.buf[0] = '\0';
+ l.buflen--; /* Make sure there is always space for the nulterm */
+
+ /* The latest history entry is always our current buffer, that
+ * initially is just an empty string. */
+ linenoiseHistoryAdd("");
+
+ if (write(l.ofd,prompt,l.plen) == -1) return -1;
+ while(1) {
+ char c;
+ int nread;
+ char seq[3];
+
+ nread = read(l.ifd,&c,1);
+ if (nread <= 0) return l.len;
+
+ /* Only autocomplete when the callback is set. It returns < 0 when
+ * there was an error reading from fd. Otherwise it will return the
+ * character that should be handled next. */
+ if (c == 9 && completionCallback != NULL) {
+ c = completeLine(&l);
+ /* Return on errors */
+ if (c < 0) return l.len;
+ /* Read next character when 0 */
+ if (c == 0) continue;
+ }
+
+ switch(c) {
+ case ENTER: /* enter */
+ history_len--;
+ free(history[history_len]);
+ if (mlmode) linenoiseEditMoveEnd(&l);
+ if (hintsCallback) {
+ /* Force a refresh without hints to leave the previous
+ * line as the user typed it after a newline. */
+ linenoiseHintsCallback *hc = hintsCallback;
+ hintsCallback = NULL;
+ refreshLine(&l);
+ hintsCallback = hc;
+ }
+ return (int)l.len;
+ case CTRL_C: /* ctrl-c */
+ errno = EAGAIN;
+ return -1;
+ case BACKSPACE: /* backspace */
+ case 8: /* ctrl-h */
+ linenoiseEditBackspace(&l);
+ break;
+ case CTRL_D: /* ctrl-d, remove char at right of cursor, or if the
+ line is empty, act as end-of-file. */
+ if (l.len > 0) {
+ linenoiseEditDelete(&l);
+ } else {
+ history_len--;
+ free(history[history_len]);
+ return -1;
+ }
+ break;
+ case CTRL_T: /* ctrl-t, swaps current character with previous. */
+ if (l.pos > 0 && l.pos < l.len) {
+ int aux = buf[l.pos-1];
+ buf[l.pos-1] = buf[l.pos];
+ buf[l.pos] = aux;
+ if (l.pos != l.len-1) l.pos++;
+ refreshLine(&l);
+ }
+ break;
+ case CTRL_B: /* ctrl-b */
+ linenoiseEditMoveLeft(&l);
+ break;
+ case CTRL_F: /* ctrl-f */
+ linenoiseEditMoveRight(&l);
+ break;
+ case CTRL_P: /* ctrl-p */
+ linenoiseEditHistoryNext(&l, LINENOISE_HISTORY_PREV);
+ break;
+ case CTRL_N: /* ctrl-n */
+ linenoiseEditHistoryNext(&l, LINENOISE_HISTORY_NEXT);
+ break;
+ case ESC: /* escape sequence */
+ /* Read the next two bytes representing the escape sequence.
+ * Use two calls to handle slow terminals returning the two
+ * chars at different times. */
+ if (read(l.ifd,seq,1) == -1) break;
+ if (read(l.ifd,seq+1,1) == -1) break;
+
+ /* ESC [ sequences. */
+ if (seq[0] == '[') {
+ if (seq[1] >= '0' && seq[1] <= '9') {
+ /* Extended escape, read additional byte. */
+ if (read(l.ifd,seq+2,1) == -1) break;
+ if (seq[2] == '~') {
+ switch(seq[1]) {
+ case '3': /* Delete key. */
+ linenoiseEditDelete(&l);
+ break;
+ }
+ }
+ } else {
+ switch(seq[1]) {
+ case 'A': /* Up */
+ linenoiseEditHistoryNext(&l, LINENOISE_HISTORY_PREV);
+ break;
+ case 'B': /* Down */
+ linenoiseEditHistoryNext(&l, LINENOISE_HISTORY_NEXT);
+ break;
+ case 'C': /* Right */
+ linenoiseEditMoveRight(&l);
+ break;
+ case 'D': /* Left */
+ linenoiseEditMoveLeft(&l);
+ break;
+ case 'H': /* Home */
+ linenoiseEditMoveHome(&l);
+ break;
+ case 'F': /* End*/
+ linenoiseEditMoveEnd(&l);
+ break;
+ }
+ }
+ }
+
+ /* ESC O sequences. */
+ else if (seq[0] == 'O') {
+ switch(seq[1]) {
+ case 'H': /* Home */
+ linenoiseEditMoveHome(&l);
+ break;
+ case 'F': /* End*/
+ linenoiseEditMoveEnd(&l);
+ break;
+ }
+ }
+ break;
+ default:
+ if (linenoiseEditInsert(&l,c)) return -1;
+ break;
+ case CTRL_U: /* Ctrl+u, delete the whole line. */
+ buf[0] = '\0';
+ l.pos = l.len = 0;
+ refreshLine(&l);
+ break;
+ case CTRL_K: /* Ctrl+k, delete from current to end of line. */
+ buf[l.pos] = '\0';
+ l.len = l.pos;
+ refreshLine(&l);
+ break;
+ case CTRL_A: /* Ctrl+a, go to the start of the line */
+ linenoiseEditMoveHome(&l);
+ break;
+ case CTRL_E: /* ctrl+e, go to the end of the line */
+ linenoiseEditMoveEnd(&l);
+ break;
+ case CTRL_L: /* ctrl+l, clear screen */
+ linenoiseClearScreen();
+ refreshLine(&l);
+ break;
+ case CTRL_W: /* ctrl+w, delete previous word */
+ linenoiseEditDeletePrevWord(&l);
+ break;
+ }
+ }
+ return l.len;
+}
+
+/* This special mode is used by linenoise in order to print scan codes
+ * on screen for debugging / development purposes. It is implemented
+ * by the linenoise_example program using the --keycodes option. */
+void linenoisePrintKeyCodes(void) {
+ char quit[4];
+
+ printf("Linenoise key codes debugging mode.\n"
+ "Press keys to see scan codes. Type 'quit' at any time to exit.\n");
+ if (enableRawMode(STDIN_FILENO) == -1) return;
+ memset(quit,' ',4);
+ while(1) {
+ char c;
+ int nread;
+
+ nread = read(STDIN_FILENO,&c,1);
+ if (nread <= 0) continue;
+ memmove(quit,quit+1,sizeof(quit)-1); /* shift string to left. */
+ quit[sizeof(quit)-1] = c; /* Insert current char on the right. */
+ if (memcmp(quit,"quit",sizeof(quit)) == 0) break;
+
+ printf("'%c' %02x (%d) (type quit to exit)\n",
+ isprint(c) ? c : '?', (int)c, (int)c);
+ printf("\r"); /* Go left edge manually, we are in raw mode. */
+ fflush(stdout);
+ }
+ disableRawMode(STDIN_FILENO);
+}
+
+/* This function calls the line editing function linenoiseEdit() using
+ * the STDIN file descriptor set in raw mode. */
+static int linenoiseRaw(char *buf, size_t buflen, const char *prompt) {
+ int count;
+
+ if (buflen == 0) {
+ errno = EINVAL;
+ return -1;
+ }
+
+ if (enableRawMode(STDIN_FILENO) == -1) return -1;
+ count = linenoiseEdit(STDIN_FILENO, STDOUT_FILENO, buf, buflen, prompt);
+ disableRawMode(STDIN_FILENO);
+ printf("\n");
+ return count;
+}
+
+/* This function is called when linenoise() is called with the standard
+ * input file descriptor not attached to a TTY. So for example when the
+ * program using linenoise is called in pipe or with a file redirected
+ * to its standard input. In this case, we want to be able to return the
+ * line regardless of its length (by default we are limited to 4k). */
+static char *linenoiseNoTTY(void) {
+ char *line = NULL;
+ size_t len = 0, maxlen = 0;
+
+ while(1) {
+ if (len == maxlen) {
+ if (maxlen == 0) maxlen = 16;
+ maxlen *= 2;
+ char *oldval = line;
+ line = realloc(line,maxlen);
+ if (line == NULL) {
+ if (oldval) free(oldval);
+ return NULL;
+ }
+ }
+ int c = fgetc(stdin);
+ if (c == EOF || c == '\n') {
+ if (c == EOF && len == 0) {
+ free(line);
+ return NULL;
+ } else {
+ line[len] = '\0';
+ return line;
+ }
+ } else {
+ line[len] = c;
+ len++;
+ }
+ }
+}
+
+/* The high level function that is the main API of the linenoise library.
+ * This function checks if the terminal has basic capabilities, just checking
+ * for a blacklist of stupid terminals, and later either calls the line
+ * editing function or uses dummy fgets() so that you will be able to type
+ * something even in the most desperate of the conditions. */
+char *linenoise(const char *prompt) {
+ char buf[LINENOISE_MAX_LINE];
+ int count;
+
+ if (!isatty(STDIN_FILENO)) {
+ /* Not a tty: read from file / pipe. In this mode we don't want any
+ * limit to the line size, so we call a function to handle that. */
+ return linenoiseNoTTY();
+ } else if (isUnsupportedTerm()) {
+ size_t len;
+
+ printf("%s",prompt);
+ fflush(stdout);
+ if (fgets(buf,LINENOISE_MAX_LINE,stdin) == NULL) return NULL;
+ len = strlen(buf);
+ while(len && (buf[len-1] == '\n' || buf[len-1] == '\r')) {
+ len--;
+ buf[len] = '\0';
+ }
+ return strdup(buf);
+ } else {
+ count = linenoiseRaw(buf,LINENOISE_MAX_LINE,prompt);
+ if (count == -1) return NULL;
+ return strdup(buf);
+ }
+}
+
+/* This is just a wrapper the user may want to call in order to make sure
+ * the linenoise returned buffer is freed with the same allocator it was
+ * created with. Useful when the main program is using an alternative
+ * allocator. */
+void linenoiseFree(void *ptr) {
+ free(ptr);
+}
+
+/* ================================ History ================================= */
+
+/* Free the history, but does not reset it. Only used when we have to
+ * exit() to avoid memory leaks are reported by valgrind & co. */
+static void freeHistory(void) {
+ if (history) {
+ int j;
+
+ for (j = 0; j < history_len; j++)
+ free(history[j]);
+ free(history);
+ }
+}
+
+/* At exit we'll try to fix the terminal to the initial conditions. */
+static void linenoiseAtExit(void) {
+ disableRawMode(STDIN_FILENO);
+ freeHistory();
+}
+
+/* This is the API call to add a new entry in the linenoise history.
+ * It uses a fixed array of char pointers that are shifted (memmoved)
+ * when the history max length is reached in order to remove the older
+ * entry and make room for the new one, so it is not exactly suitable for huge
+ * histories, but will work well for a few hundred of entries.
+ *
+ * Using a circular buffer is smarter, but a bit more complex to handle. */
+int linenoiseHistoryAdd(const char *line) {
+ char *linecopy;
+
+ if (history_max_len == 0) return 0;
+
+ /* Initialization on first call. */
+ if (history == NULL) {
+ history = malloc(sizeof(char*)*history_max_len);
+ if (history == NULL) return 0;
+ memset(history,0,(sizeof(char*)*history_max_len));
+ }
+
+ /* Don't add duplicated lines. */
+ if (history_len && !strcmp(history[history_len-1], line)) return 0;
+
+ /* Add an heap allocated copy of the line in the history.
+ * If we reached the max length, remove the older line. */
+ linecopy = strdup(line);
+ if (!linecopy) return 0;
+ if (history_len == history_max_len) {
+ free(history[0]);
+ memmove(history,history+1,sizeof(char*)*(history_max_len-1));
+ history_len--;
+ }
+ history[history_len] = linecopy;
+ history_len++;
+ return 1;
+}
+
+/* Set the maximum length for the history. This function can be called even
+ * if there is already some history, the function will make sure to retain
+ * just the latest 'len' elements if the new history length value is smaller
+ * than the amount of items already inside the history. */
+int linenoiseHistorySetMaxLen(int len) {
+ char **new;
+
+ if (len < 1) return 0;
+ if (history) {
+ int tocopy = history_len;
+
+ new = malloc(sizeof(char*)*len);
+ if (new == NULL) return 0;
+
+ /* If we can't copy everything, free the elements we'll not use. */
+ if (len < tocopy) {
+ int j;
+
+ for (j = 0; j < tocopy-len; j++) free(history[j]);
+ tocopy = len;
+ }
+ memset(new,0,sizeof(char*)*len);
+ memcpy(new,history+(history_len-tocopy), sizeof(char*)*tocopy);
+ free(history);
+ history = new;
+ }
+ history_max_len = len;
+ if (history_len > history_max_len)
+ history_len = history_max_len;
+ return 1;
+}
+
+/* Save the history in the specified file. On success 0 is returned
+ * otherwise -1 is returned. */
+int linenoiseHistorySave(const char *filename) {
+ mode_t old_umask = umask(S_IXUSR|S_IRWXG|S_IRWXO);
+ FILE *fp;
+ int j;
+
+ fp = fopen(filename,"w");
+ umask(old_umask);
+ if (fp == NULL) return -1;
+ chmod(filename,S_IRUSR|S_IWUSR);
+ for (j = 0; j < history_len; j++)
+ fprintf(fp,"%s\n",history[j]);
+ fclose(fp);
+ return 0;
+}
+
+/* Load the history from the specified file. If the file does not exist
+ * zero is returned and no operation is performed.
+ *
+ * If the file exists and the operation succeeded 0 is returned, otherwise
+ * on error -1 is returned. */
+int linenoiseHistoryLoad(const char *filename) {
+ FILE *fp = fopen(filename,"r");
+ char buf[LINENOISE_MAX_LINE];
+
+ if (fp == NULL) return -1;
+
+ while (fgets(buf,LINENOISE_MAX_LINE,fp) != NULL) {
+ char *p;
+
+ p = strchr(buf,'\r');
+ if (!p) p = strchr(buf,'\n');
+ if (p) *p = '\0';
+ linenoiseHistoryAdd(buf);
+ }
+ fclose(fp);
+ return 0;
+}
diff --git a/src/linenoise/linenoise.h b/src/linenoise/linenoise.h
new file mode 100644
index 0000000..6dfee73
--- /dev/null
+++ b/src/linenoise/linenoise.h
@@ -0,0 +1,75 @@
+/* linenoise.h -- VERSION 1.0
+ *
+ * Guerrilla line editing library against the idea that a line editing lib
+ * needs to be 20,000 lines of C code.
+ *
+ * See linenoise.c for more information.
+ *
+ * ------------------------------------------------------------------------
+ *
+ * Copyright (c) 2010-2014, Salvatore Sanfilippo <antirez at gmail dot com>
+ * Copyright (c) 2010-2013, Pieter Noordhuis <pcnoordhuis at gmail dot com>
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * * Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#ifndef __LINENOISE_H
+#define __LINENOISE_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+typedef struct linenoiseCompletions {
+ size_t len;
+ char **cvec;
+} linenoiseCompletions;
+
+typedef void(linenoiseCompletionCallback)(const char *, linenoiseCompletions *);
+typedef char*(linenoiseHintsCallback)(const char *, int *color, int *bold);
+typedef void(linenoiseFreeHintsCallback)(void *);
+void linenoiseSetCompletionCallback(linenoiseCompletionCallback *);
+void linenoiseSetHintsCallback(linenoiseHintsCallback *);
+void linenoiseSetFreeHintsCallback(linenoiseFreeHintsCallback *);
+void linenoiseAddCompletion(linenoiseCompletions *, const char *);
+
+char *linenoise(const char *prompt);
+void linenoiseFree(void *ptr);
+int linenoiseHistoryAdd(const char *line);
+int linenoiseHistorySetMaxLen(int len);
+int linenoiseHistorySave(const char *filename);
+int linenoiseHistoryLoad(const char *filename);
+void linenoiseClearScreen(void);
+void linenoiseSetMultiLine(int ml);
+void linenoisePrintKeyCodes(void);
+void linenoiseMaskModeEnable(void);
+void linenoiseMaskModeDisable(void);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* __LINENOISE_H */
diff --git a/src/mytype.h b/src/mytype.h
new file mode 100644
index 0000000..7e55a20
--- /dev/null
+++ b/src/mytype.h
@@ -0,0 +1,49 @@
+#ifndef _TYPE_
+#define _TYPE_
+
+typedef unsigned int IDTYPE;
+typedef unsigned long VALUE;
+
+
+typedef struct {
+ IDTYPE id;
+} Basic;
+
+
+#define MAX_PORT 5
+
+#ifndef THREAD
+typedef struct {
+ Basic basic;
+ VALUE port;
+} Name;
+
+typedef struct {
+ Basic basic;
+ VALUE port[MAX_PORT];
+} Agent;
+
+#else
+typedef struct {
+ Basic basic;
+ volatile VALUE port;
+} Name;
+
+typedef struct {
+ Basic basic;
+ volatile VALUE port[MAX_PORT];
+} Agent;
+#endif
+
+
+#define FIXNUM_FLAG 0x01
+#define INT2FIX(i) ((VALUE)(((long)(i) << 1) | FIXNUM_FLAG))
+#define FIX2INT(i) ((int)(i) >> 1)
+#define IS_FIXNUM(i) ((VALUE)(i) & FIXNUM_FLAG)
+
+
+#define AGENT(a) ((Agent *)(a))
+#define BASIC(a) ((Basic *)(a))
+#define NAME(a) ((Name *)(a))
+
+#endif
diff --git a/src/name_table.c b/src/name_table.c
new file mode 100644
index 0000000..5c6f9f6
--- /dev/null
+++ b/src/name_table.c
@@ -0,0 +1,423 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "name_table.h"
+
+NameList *NameList_new() {
+ NameList *alist;
+ alist = malloc(sizeof(NameList));
+ if (alist == NULL) {
+ printf("Malloc error\n");
+ exit(-1);
+ }
+ return alist;
+}
+
+
+// It should be called at first, and never called after that.
+void NameTable_init() {
+ int i;
+ for (i=0; i<NAME_HASHSIZE; i++) {
+ NameHashTable[i] = NULL;
+ }
+}
+
+int getHash(char *key)
+{
+ int len;
+ int ret;
+
+ // 0文字目、最後の文字、真中の文字の数値を加算し
+ len = strlen(key);
+ ret = key[0];
+ ret += key[len-1];
+ ret += key[(len-1)/2];
+
+ // ハッシュテーブルのサイズ（山の数）で modulo する
+ return ret % NAME_HASHSIZE;
+}
+
+
+
+
+
+void NameTable_set_heap_id(char *key, VALUE heap, IDTYPE id) {
+ int hash;
+ NameList *add;
+ hash = getHash(key);
+
+ if (NameHashTable[hash] == NULL) { // もしハッシュテーブルが空ならば
+ add = NameList_new(); // データノードを作成
+
+ add->name = key;
+ add->id = id;
+ IdTable_set_name(id, key);
+ add->heap = heap;
+ add->next = NULL;
+
+ NameHashTable[hash] = add; /* 単にセット */
+ }
+
+
+ /* 線形探査 */
+ NameList *at = NameHashTable[hash]; /* 先頭をセット */
+ while (at != NULL) {
+ if(strcmp( at->name, key ) == 0) { /* すでにあれば... */
+ at->id = id;
+ IdTable_set_name(at->id, key);
+ at->heap = heap;
+ return;
+
+ }
+ at = at->next; /* 次のチェーンを辿る */
+ }
+
+
+ /* key がなかったら、 先頭に追加 */
+ add = NameList_new();
+
+ add->name = key;
+ add->id = id;
+ IdTable_set_name(add->id, key);
+ add->heap = heap;
+
+ add->next = NameHashTable[hash]; // 以前の先頭を自分の次にする
+ NameHashTable[hash] = add; // add を先頭とする
+
+ return;
+}
+
+
+
+
+// NameHashTable から key のエントリーを削除
+void NameTable_erase(char *key) {
+ int hash;
+ //int heap;
+ //NameList *add;
+
+ if (key == NULL) return;
+
+ hash = getHash(key);
+
+ if (NameHashTable[hash] == NULL) { // ハッシュテーブルが空ならば何もしない
+ return;
+ }
+
+ /* 線形探査 */
+ NameList *at = NameHashTable[hash]; /* 先頭をセット */
+ while (at != NULL) {
+ if (strcmp(at->name, key) == 0) { /* すでにあれば... */
+ at->heap = (VALUE)NULL;
+ at->id = -1; // 登録削除したら ID を -1 にする
+ // これを削ると、10%の速度低下。なぜ？
+
+ return;
+
+ }
+ at = at->next; /* 次のチェーンを辿る */
+ }
+
+ return;
+}
+
+
+
+VALUE NameTable_get_heap(char *key) {
+ int hash;
+ //int heap;
+ //NameList *add;
+ hash = getHash(key);
+
+ if (NameHashTable[hash] == NULL) {
+ // ハッシュテーブルが空
+ return (VALUE)NULL;
+ }
+
+ // 線形探査
+ NameList *at = NameHashTable[hash]; // 先頭をセット
+ while (at != NULL) {
+ if (strcmp( at->name, key ) == 0) { // すでにあれば
+
+ if (at->heap != (VALUE)NULL) {
+ // NULLP でなければ、既に存在している変数
+ return at->heap;
+
+ } else {
+ return (VALUE)NULL;
+
+ }
+ }
+ at = at->next; // 次のチェーンを辿る
+ }
+
+ // key がなかった
+ return (VALUE)NULL;
+
+}
+
+
+IDTYPE NameTable_get_set_id(char *key) {
+ int hash;
+ NameList *add;
+
+
+ hash = getHash(key);
+
+ if (NameHashTable[hash] == NULL) {
+ // ハッシュテーブルが空
+ add = NameList_new(); // データノードを作成
+ add->name = key;
+ add->id = IdTable_new_agentid();
+ IdTable_set_name(add->id, add->name);
+ add->heap = (VALUE)NULL;
+ add->next = NULL;
+ NameHashTable[hash] = add; // 単にセット
+ return (add->id);
+
+ }
+
+ // 線形探査
+ NameList *at = NameHashTable[hash]; // 先頭をセット
+ while (at != NULL) {
+ if (strcmp(at->name, key) == 0) { // すでにあれば
+ return (at->id);
+
+ }
+ at = at->next; // 次のチェーンを辿る
+ }
+
+ // key がなかったら→ 先頭に追加
+ add = NameList_new();
+ add->name = key;
+ add->id = IdTable_new_agentid();
+ IdTable_set_name(add->id, add->name);
+ add->heap = (VALUE)NULL;
+ add->next = NameHashTable[hash]; // 以前の先頭を自分の次にする
+ NameHashTable[hash] = add; // 先頭に追加
+
+ return (add->id);
+}
+
+
+
+// Whether the given 'term' has a name node 'keynode'.
+int term_has_keynode(VALUE keynode, VALUE term) {
+ int i;
+
+ if ((term == (VALUE)NULL) || (IS_FIXNUM(term))) return 0;
+
+ //puts_term(term);
+ //puts("");
+
+ if (IS_NAMEID(BASIC(term)->id)) {
+
+ if (term == keynode) {
+ return 1;
+ } else {
+ if (NAME(term)->port == (VALUE)NULL) {
+ return 0;
+ } else {
+ return term_has_keynode(keynode, NAME(term)->port);
+ }
+ }
+
+ } else {
+ // general term
+ int arity;
+ arity = IdTable_get_arity(AGENT(term)->basic.id);
+ for (i=0; i < arity; i++) {
+ if (term_has_keynode(keynode, AGENT(term)->port[i]) ) {
+ return 1;
+ }
+ }
+ return 0;
+ }
+}
+
+
+int keynode_exists_in_another_term(VALUE keynode, VALUE *connected_from) {
+ // It returns how many occurs in terms connected from global names.
+ // Also, the one of the terms is stored in the 'connected_from'.
+ int i, result=0;
+ NameList *at;
+
+ for (i=0; i<NAME_HASHSIZE; i++) {
+ at = NameHashTable[i];
+ while (at != NULL) {
+ if (at->heap != (VALUE)NULL) {
+ if (at->heap != keynode) {
+ if (term_has_keynode(keynode, at->heap)) {
+ result++;
+ if (connected_from != NULL) {
+ *connected_from = at->heap;
+ }
+ /*
+ PutIndirection=1;
+ puts_name(at->heap);
+ puts("");
+ PutIndirection=0;
+ */
+ }
+ }
+ }
+ at = at->next;
+ }
+ }
+ return result;
+}
+
+
+
+
+VALUE replace_keynode(VALUE keynode, VALUE term, VALUE heap) {
+
+ if ((heap == (VALUE)NULL) || (IS_FIXNUM(heap))) {
+ return heap;
+ }
+
+ if (IS_GNAMEID(BASIC(heap)->id)) {
+ if (keynode == heap) {
+ return term;
+ }
+ }
+
+ if (IS_NAMEID(BASIC(heap)->id)) {
+ if (NAME(heap)->port == (VALUE)NULL) {
+ return heap;
+ } else {
+ NAME(heap)->port = replace_keynode(keynode, term, NAME(heap)->port);
+ return heap;
+ }
+ }
+
+ // general heap
+ int i, arity;
+ arity = IdTable_get_arity(AGENT(heap)->basic.id);
+ for (i=0; i < arity; i++) {
+ AGENT(heap)->port[i] = replace_keynode(keynode, term, AGENT(heap)->port[i]);
+ }
+ return heap;
+}
+
+
+
+void global_replace_keynode_in_another_term(VALUE keynode, VALUE term) {
+ // Replace keynode in Global environment with term.
+ int i;
+ NameList *at;
+
+ for (i=0; i<NAME_HASHSIZE; i++) {
+ at = NameHashTable[i];
+ while (at != NULL) {
+ if (at->heap != (VALUE)NULL) {
+ if (at->heap != keynode) {
+
+ if (term_has_keynode(keynode, at->heap)) {
+
+ VALUE replaced = replace_keynode(keynode, term, at->heap);
+ at->heap = replaced;
+
+ return;
+ }
+ }
+ }
+ at = at->next;
+ }
+ }
+}
+
+
+
+
+void NameTable_puts_all() {
+ int i;
+ NameList *at;
+ int count=0;
+
+ for (i=0; i<NAME_HASHSIZE; i++) {
+ at = NameHashTable[i];
+ while (at != NULL) {
+ if (at->heap != (VALUE)NULL) {
+ if (IS_NAMEID(BASIC(at->heap)->id)) {
+ printf("%s ", IdTable_get_name(BASIC(at->heap)->id));
+ count++;
+ }
+ }
+ at = at->next;
+ }
+ }
+ if (count == 0) {
+ printf("<NO-INTERFACE>\n");
+ return;
+ }
+
+ printf("\n\nConnections:\n");
+
+ for (i=0; i<NAME_HASHSIZE; i++) {
+ at = NameHashTable[i];
+ while (at != NULL) {
+ if (at->heap != (VALUE)NULL) {
+ if (IS_NAMEID(BASIC(at->heap)->id)) {
+ printf("%s ->", IdTable_get_name(BASIC(at->heap)->id));
+ puts_name_port0(at->heap);
+ printf("\n");
+ }
+ }
+ at = at->next;
+ }
+ }
+ puts("");
+}
+
+
+void NameTable_free_all() {
+ int i;
+ NameList *at;
+
+ for (i=0; i<NAME_HASHSIZE; i++) {
+ at = NameHashTable[i];
+ while (at != NULL) {
+ if (at->heap != (VALUE)NULL) {
+ if (IS_NAMEID(BASIC(at->heap)->id)) {
+ flush_name_port0(at->heap);
+ }
+ }
+ at = at->next;
+ }
+ }
+}
+
+
+int NameTable_ckech_if_term_has_gname(VALUE term) {
+ int i;
+ NameList *at;
+ VALUE ptr;
+
+ for (i=0; i<NAME_HASHSIZE; i++) {
+ at = NameHashTable[i];
+ while (at != NULL) {
+ if (at->heap != (VALUE)NULL) {
+ ptr = at->heap;
+ while ((ptr != (VALUE)NULL) &&
+ (! IS_FIXNUM(ptr)) &&
+ (IS_NAMEID(BASIC(ptr)->id))) {
+
+
+ if (term_has_keynode(ptr, term)) {
+ return 1;
+ }
+
+ ptr = NAME(ptr)->port;
+
+ }
+
+ }
+ at = at->next;
+ }
+ }
+
+ return 0;
+}
+
diff --git a/src/name_table.h b/src/name_table.h
new file mode 100644
index 0000000..c7f885d
--- /dev/null
+++ b/src/name_table.h
@@ -0,0 +1,50 @@
+#ifndef _NAME_TABLE_
+#define _NAME_TABLE_
+
+#include "mytype.h"
+#include "id_table.h"
+
+
+/**************************************
+ NAME TABLE
+**************************************/
+
+typedef struct NameList {
+ char *name; // KEY
+ IDTYPE id;
+
+ // `heap' stores a heap only of a global name,
+ // that is, is kept having NULL for other nodes, such as agents.
+ VALUE heap;
+
+ struct NameList *next;
+} NameList;
+
+#define NAME_HASHSIZE 127
+static NameList *NameHashTable[NAME_HASHSIZE]; /* ハッシュテーブル本体 */
+
+// It should be called at first, and never called after that.
+void NameTable_init();
+
+
+void NameTable_set_heap_id(char *key, VALUE heap, IDTYPE id);
+
+
+// Erace key entry from NameHashTable
+void NameTable_erase(char *key);
+
+
+VALUE NameTable_get_heap(char *key);
+IDTYPE NameTable_get_set_id(char *key);
+
+void NameTable_puts_all();
+void NameTable_free_all();
+
+int NameTable_ckech_if_term_has_gname(VALUE term);
+
+int term_has_keynode(VALUE keynode, VALUE term);
+int keynode_exists_in_another_term(VALUE keynode, VALUE *connected_from);
+void global_replace_keynode_in_another_term(VALUE keynode, VALUE term);
+
+
+#endif
diff --git a/src/timer.h b/src/timer.h
new file mode 100644
index 0000000..904bd6a
--- /dev/null
+++ b/src/timer.h
@@ -0,0 +1,31 @@
+//https://github.com/zuqqhi2/numerical_simulation/blob/master/multithread/laytrace/timer.h
+
+#ifndef _H_TIMER
+#define _H_TIMER
+
+#include <stdio.h>
+#include <sys/time.h>
+
+static inline
+unsigned long long gettimeval(void) {
+ struct timeval tv;
+ struct timezone tz;
+ gettimeofday(&tv, &tz);
+ return ((unsigned long long)tv.tv_sec)*1000000+tv.tv_usec;
+}
+
+static inline
+void start_timer(unsigned long long *startt) {
+ *startt = gettimeval();
+ return;
+}
+
+static inline
+unsigned long long stop_timer(unsigned long long *startt) {
+ unsigned long long stopt = gettimeval();
+ return (stopt>=*startt)?(stopt-*startt):(stopt);
+}
+
+#define print_timer(te) {printf("time of %s:%f[sec]\n", #te, (te*1.0e-3)/1000);}
+
+#endif
generated by cgit v1.2.3 (git 2.39.1) at 2026-11-10 16:07:59 +0000