This repository has been archived by the owner on May 21, 2020. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 0
/
PicoEnv.c
175 lines (159 loc) · 6.15 KB
/
PicoEnv.c
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
/*-----------------------------------*/
/* >>>Pico<<< */
/* Theo D'Hondt */
/* VUB Programming Technology Lab */
/* (c) 1997 */
/*-----------------------------------*/
/* Environments */
/*-----------------------------------*/
/*------------------------------------------------------------------------*/
/* */
/* _stk_poke_CNT_(CNT) => stack[_CNT_tos_] = CNT */
/* _stk_push_CNT_(CNT) => stack[--_CNT_tos_] = CNT */
/* _stk_peek_CNT_(CNT) => stack[_CNT_tos_] */
/* _stk_pop_EXP_ ( ) => stack[_EXP_tos_++] */
/* _stk_zap_CNT_ ( ) => _CNT_tos_++ */
/* */
/* _stk_poke_EXP_(EXP) => stack[_EXP_tos_] = EXP */
/* _stk_push_EXP_(EXP) => stack[++_EXP_tos_] = EXP */
/* _stk_peek_EXP_(EXP) => stack[_EXP_tos_] */
/* _stk_pop_EXP_ ( ) => stack[_EXP_tos_--] */
/* _stk_zap_EXP_ ( ) => _EXP_tos_-- */
/* */
/*------------------------------------------------------------------------*/
#include <string.h>
#include "Pico.h"
#include "PicoMai.h"
#include "PicoMem.h"
#include "PicoNat.h"
#include "PicoEnv.h"
/* private variables */
static _SIZ_TYPE_ DCT_top = 1;
static _SIZ_TYPE_ DCT_siz = 0;
/* public variables */
_EXP_TYPE_ _DCT_;
_UNS_TYPE_ _CNT_;
_UNS_TYPE_ _EXP_;
_EXP_TYPE_ _STK_;
_EXP_TYPE_ _CRO_; //CuRrent Owner //TOEGEVOEGD
/* public functions */
_NIL_TYPE_ _env_setup_(const _SIZ_TYPE_ siz)
{ _SIZ_TYPE_ idx;
_NAMES_ = _ag_make_TAB_(siz);
DCT_top = 1;
DCT_siz = siz;
for (idx = 1; idx <= DCT_siz; idx++)
_ag_set_TAB_EXP_(_NAMES_, idx, _VOID_); }
_EXP_TYPE_ _env_make_NAM_(const _STR_TYPE_ str)
{ _SIZ_TYPE_ idx;
_EXP_TYPE_ nam;
for (idx = 1; idx < DCT_top; idx++)
{ nam = _ag_get_TAB_EXP_(_NAMES_, idx);
if (!strcmp(str, _ag_get_TXT_(nam)))
return nam; }
if (DCT_top > DCT_siz)
_error_(_DCT_ERROR_);
nam = _ag_make_TXT_(str);
_ag_set_TAB_EXP_(_NAMES_, DCT_top++, nam);
return nam; }
_EXP_TYPE_ _env_initialise_(const _EXP_TYPE_ dct)
{ _EXP_TYPE_ env, top, stk;
_mem_claim_SIZ_(_STK_INIT_);
_CRO_ = _VOID_; //TOEGEVOEGD
env = _ag_make_ENV_();
stk = _ag_make_TAB_(_STK_INIT_);
top = _ag_make_NBR_(_STK_INIT_ + 1);
_ag_set_ENV_DCT_(env, dct);
_ag_set_ENV_BOT_(env, _ZERO_);
_ag_set_ENV_TOP_(env, top);
_ag_set_ENV_TAB_(env, stk);
return env; }
_NIL_TYPE_ _env_capture_(const _EXP_TYPE_ env)
{ _EXP_TYPE_ bot, top;
_UNS_TYPE_ adr, lwn, upn;
adr = (_UNS_TYPE_)_mem_cast_raw_(_STK_, _TAB_TAG_);
lwn = 1 + (_EXP_ - adr)/_EXP_SIZE_;
upn = 1 + (_CNT_ - adr)/_EXP_SIZE_;
bot = _ag_make_NBU_(lwn);
top = _ag_make_NBU_(upn);
_ag_set_ENV_DCT_(env, _DCT_);
_ag_set_ENV_BOT_(env, bot);
_ag_set_ENV_TOP_(env, top);
_ag_set_ENV_TAB_(env, _STK_); }
_NIL_TYPE_ _env_restore_(const _EXP_TYPE_ env)
{ _EXP_TYPE_ bot, top;
_UNS_TYPE_ adr, lwn, upn;
_DCT_ = _ag_get_ENV_DCT_(env);
bot = _ag_get_ENV_BOT_(env);
top = _ag_get_ENV_TOP_(env);
_STK_ = _ag_get_ENV_TAB_(env);
lwn = _ag_get_NBU_(bot);
upn = _ag_get_NBU_(top);
adr = (_UNS_TYPE_)_mem_cast_raw_(_STK_, _TAB_TAG_);
_EXP_ = adr + (lwn - 1)*_EXP_SIZE_;
_CNT_ = adr + (upn - 1)*_EXP_SIZE_; }
_NIL_TYPE_ _env_expand_(_NIL_TYPE_)
{ _EXP_TYPE_ exp, stk;
_UNS_TYPE_ adr, idx, lwn, siz, upn, xsz;
siz = _ag_get_TAB_SIZ_(_STK_);
xsz = 2*siz;
if (xsz > _STK_MAX_)
_error_(_STK_ERROR_);
_mem_claim_SIZ_(xsz);
adr = (_UNS_TYPE_)_mem_cast_raw_(_STK_, _TAB_TAG_);
lwn = 1 + (_EXP_ - adr)/_EXP_SIZE_;
upn = 1 + (_CNT_ - adr)/_EXP_SIZE_;
stk = _ag_make_TAB_(xsz);
for (idx = 1 ; idx <= lwn ; idx++)
{ exp = _ag_get_TAB_EXP_(_STK_, idx);
_ag_set_TAB_EXP_(stk, idx, exp); }
for (idx = siz ; idx >= upn ; idx--)
{ exp = _ag_get_TAB_EXP_(_STK_, idx);
_ag_set_TAB_EXP_(stk, xsz--, exp); }
for ( ; xsz > lwn ; xsz--)
_ag_set_TAB_EXP_(stk, xsz, _VOID_);
adr = (_UNS_TYPE_)_mem_cast_raw_(stk, _TAB_TAG_);
_EXP_ = adr + (lwn - 1)*_EXP_SIZE_;
_CNT_ = adr + (upn + siz - 1)*_EXP_SIZE_;
_STK_ = stk; }
_NIL_TYPE_ _env_save_(const _EXP_TYPE_ env)
{ _EXP_TYPE_ bot, exp, stk, top;
_UNS_TYPE_ adr, idx, lwn, siz, upn;
siz = _ag_get_TAB_SIZ_(_STK_);
// _mem_claim_SIZ_(siz); // dvd: would corrupt, cfr CLL
adr = (_UNS_TYPE_)_mem_cast_raw_(_STK_, _TAB_TAG_);
lwn = 1 + (_EXP_ - adr)/_EXP_SIZE_;
upn = 1 + (_CNT_ - adr)/_EXP_SIZE_;
bot = _ag_make_NBU_(lwn);
top = _ag_make_NBU_(upn);
stk = _ag_make_TAB_(siz);
for (idx = 1 ; idx <= siz ; idx++)
{ exp = _ag_get_TAB_EXP_(_STK_, idx);
_ag_set_TAB_EXP_(stk, idx, exp); }
_ag_set_ENV_DCT_(env, _DCT_);
_ag_set_ENV_BOT_(env, bot);
_ag_set_ENV_TOP_(env, top);
_ag_set_ENV_TAB_(env, stk); }
_NIL_TYPE_ _env_load_(const _EXP_TYPE_ env)
{ _EXP_TYPE_ bot, exp, stk, top;
_UNS_TYPE_ adr, idx, lwn, siz_1, siz_2, upn_1, upn_2;
siz_1 = _ag_get_TAB_SIZ_(_STK_); // jdk: stack sizes can differ
_DCT_ = _ag_get_ENV_DCT_(env);
bot = _ag_get_ENV_BOT_(env);
top = _ag_get_ENV_TOP_(env);
lwn = _ag_get_NBU_(bot);
upn_1 = _ag_get_NBU_(top);
stk = _ag_get_ENV_TAB_(env);
siz_2 = _ag_get_TAB_SIZ_(stk);
upn_2 = (siz_1 - siz_2 + upn_1);
for (idx = 1 ; idx <= lwn ; idx++)
{ exp = _ag_get_TAB_EXP_(stk, idx);
_ag_set_TAB_EXP_(_STK_, idx, exp); }
for (; idx < upn_2 ; idx++)
_ag_set_TAB_EXP_(_STK_, idx, _VOID_);
for (; idx <= siz_1 ; idx++)
{ exp = _ag_get_TAB_EXP_(stk, (idx + siz_2 - siz_1));
_ag_set_TAB_EXP_(_STK_, idx, exp); }
adr = (_UNS_TYPE_)_mem_cast_raw_(_STK_, _TAB_TAG_);
_EXP_ = adr + (lwn - 1)*_EXP_SIZE_;
_CNT_ = adr + (upn_2 - 1)*_EXP_SIZE_; }