1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
Index: ForthVM.cpp
===================================================================
--- ForthVM.cpp (revision 7)
+++ ForthVM.cpp (working copy)
@@ -155,6 +155,14 @@
// PUSH_IVAL and PUSH_ADDR
// 2011-02-06 km fixed problem with FS. not restoring original precision.
// 2011-03-05 km removed commented out code which was replaced by macros.
+// 2011-03-10 km added global string dir_env_var to allow default directory
+// environment variable to be specified externally, in the
+// Makefile.
+// 2011-11-01 km revised CPP_allot to ensure all created words which have
+// ALLOTed memory also have appropriate execution code;
+// This change also allows removal of common code from
+// CPP_variable and CPP_fvariable.
+const char* dir_env_var=DIR_ENV_VAR;
#include <string.h>
#include <stdlib.h>
@@ -1550,6 +1558,13 @@
{
id->Pfa = new byte[n];
if (id->Pfa) memset (id->Pfa, 0, n);
+
+ // Provide execution code to the word to return its Pfa
+ byte *bp = new byte[6];
+ id->Cfa = bp;
+ bp[0] = OP_ADDR;
+ *((int*) &bp[1]) = (int) id->Pfa;
+ bp[5] = OP_RET;
}
else
return E_V_REALLOT;
@@ -1642,14 +1657,7 @@
DEC_DSP
STD_IVAL
int e = CPP_allot();
- if (e) return e;
- WordIndex id = pCompilationWL->end() - 1;
- byte *bp = new byte[6];
- id->Cfa = bp;
- bp[0] = OP_ADDR;
- *((int*) &bp[1]) = (int) id->Pfa;
- bp[5] = OP_RET;
- return 0;
+ return e;
}
//-----------------------------------------------------------------
@@ -1662,14 +1670,7 @@
DEC_DSP
STD_IVAL
int e = CPP_allot();
- if (e) return e;
- WordIndex id = pCompilationWL->end() - 1;
- byte *bp = new byte[6];
- id->Cfa = bp;
- bp[0] = OP_ADDR;
- *((int*) &bp[1]) = (int) id->Pfa;
- bp[5] = OP_RET;
- return 0;
+ return e;
}
//------------------------------------------------------------------
@@ -2464,10 +2465,10 @@
ifstream f(filename);
if (!f)
{
- if (getenv("KFORTH_DIR"))
+ if (getenv(dir_env_var))
{
char temp[256];
- strcpy(temp, getenv("KFORTH_DIR"));
+ strcpy(temp, getenv(dir_env_var));
strcat(temp, "/");
strcat(temp, filename);
strcpy(filename, temp);
|
