Deleted Added
sdiff udiff text old ( 42679 ) new ( 43078 )
full compact
words.c (42679) words.c (43078)
1/*******************************************************************
2** w o r d s . c
3** Forth Inspired Command Language
4** ANS Forth CORE word-set written in C
5** Author: John Sadler (john_sadler@alum.mit.edu)
6** Created: 19 July 1997
7**
8*******************************************************************/

--- 866 unchanged lines hidden (view full) ---

875}
876
877
878static void commentLine(FICL_VM *pVM)
879{
880 char *cp = vmGetInBuf(pVM);
881 char ch = *cp;
882
1/*******************************************************************
2** w o r d s . c
3** Forth Inspired Command Language
4** ANS Forth CORE word-set written in C
5** Author: John Sadler (john_sadler@alum.mit.edu)
6** Created: 19 July 1997
7**
8*******************************************************************/

--- 866 unchanged lines hidden (view full) ---

875}
876
877
878static void commentLine(FICL_VM *pVM)
879{
880 char *cp = vmGetInBuf(pVM);
881 char ch = *cp;
882
883 while ((ch != '\0') && (ch != '\r') && (ch != '\n'))
883 while ((pVM->tib.end != cp) && (ch != '\0') && (ch != '\r') && (ch != '\n'))
884 {
885 ch = *++cp;
886 }
887
888 /*
889 ** Cope with DOS or UNIX-style EOLs -
890 ** Check for /r, /n, /r/n, or /n/r end-of-line sequences,
891 ** and point cp to next char. If EOL is \0, we're done.
892 */
884 {
885 ch = *++cp;
886 }
887
888 /*
889 ** Cope with DOS or UNIX-style EOLs -
890 ** Check for /r, /n, /r/n, or /n/r end-of-line sequences,
891 ** and point cp to next char. If EOL is \0, we're done.
892 */
893 if (ch != '\0')
893 if ((pVM->tib.end != cp) && (ch != '\0'))
894 {
895 cp++;
896
894 {
895 cp++;
896
897 if ( (ch != *cp)
897 if ( (pVM->tib.end != cp) && (ch != *cp)
898 && ((*cp == '\r') || (*cp == '\n')) )
899 cp++;
900 }
901
902 vmUpdateTib(pVM, cp);
903 return;
904}
905

--- 269 unchanged lines hidden (view full) ---

1175 assert(pVM);
1176
1177 vmBranchRelative(pVM, -1);
1178
1179 /*
1180 // Get next word...if out of text, we're done.
1181 */
1182 if (si.count == 0)
898 && ((*cp == '\r') || (*cp == '\n')) )
899 cp++;
900 }
901
902 vmUpdateTib(pVM, cp);
903 return;
904}
905

--- 269 unchanged lines hidden (view full) ---

1175 assert(pVM);
1176
1177 vmBranchRelative(pVM, -1);
1178
1179 /*
1180 // Get next word...if out of text, we're done.
1181 */
1182 if (si.count == 0)
1183 {
1184 vmThrow(pVM, VM_OUTOFTEXT);
1183 vmThrow(pVM, VM_OUTOFTEXT);
1185 }
1186
1187 interpWord(pVM, si);
1188
1184
1185 interpWord(pVM, si);
1186
1189
1190 return; /* back to inner interpreter */
1191}
1192
1193/**************************************************************************
1194** From the standard, section 3.4
1195** b) Search the dictionary name space (see 3.4.2). If a definition name
1196** matching the string is found:
1197** 1.if interpreting, perform the interpretation semantics of the definition

--- 31 unchanged lines hidden (view full) ---

1229 if (pVM->state == INTERPRET)
1230 {
1231 if (tempFW != NULL)
1232 {
1233 if (wordIsCompileOnly(tempFW))
1234 {
1235 vmThrowErr(pVM, "Error: Compile only!");
1236 }
1187 return; /* back to inner interpreter */
1188}
1189
1190/**************************************************************************
1191** From the standard, section 3.4
1192** b) Search the dictionary name space (see 3.4.2). If a definition name
1193** matching the string is found:
1194** 1.if interpreting, perform the interpretation semantics of the definition

--- 31 unchanged lines hidden (view full) ---

1226 if (pVM->state == INTERPRET)
1227 {
1228 if (tempFW != NULL)
1229 {
1230 if (wordIsCompileOnly(tempFW))
1231 {
1232 vmThrowErr(pVM, "Error: Compile only!");
1233 }
1237
1238 vmExecute(pVM, tempFW);
1239 }
1240
1241 else if (!isNumber(pVM, si))
1242 {
1243 int i = SI_COUNT(si);
1244 vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
1245 }

--- 818 unchanged lines hidden (view full) ---

2064
2065
2066static void dotParen(FICL_VM *pVM)
2067{
2068 char *pSrc = vmGetInBuf(pVM);
2069 char *pDest = pVM->pad;
2070 char ch;
2071
1234 vmExecute(pVM, tempFW);
1235 }
1236
1237 else if (!isNumber(pVM, si))
1238 {
1239 int i = SI_COUNT(si);
1240 vmThrowErr(pVM, "%.*s not found", i, SI_PTR(si));
1241 }

--- 818 unchanged lines hidden (view full) ---

2060
2061
2062static void dotParen(FICL_VM *pVM)
2063{
2064 char *pSrc = vmGetInBuf(pVM);
2065 char *pDest = pVM->pad;
2066 char ch;
2067
2072 pSrc = skipSpace(pSrc);
2068 pSrc = skipSpace(pSrc,pVM->tib.end);
2073
2069
2074 for (ch = *pSrc; (ch != '\0') && (ch != ')'); ch = *++pSrc)
2070 for (ch = *pSrc; (pVM->tib.end != pSrc) && (ch != '\0') && (ch != ')'); ch = *++pSrc)
2075 *pDest++ = ch;
2076
2077 *pDest = '\0';
2071 *pDest++ = ch;
2072
2073 *pDest = '\0';
2078 if (ch == ')')
2074 if ((pVM->tib.end != pSrc) && (ch == ')'))
2079 pSrc++;
2080
2081 vmTextOut(pVM, pVM->pad, 0);
2082 vmUpdateTib(pVM, pSrc);
2083
2084 return;
2085}
2086

--- 349 unchanged lines hidden (view full) ---

2436{
2437 vmThrow(pVM, VM_QUIT);
2438 return;
2439}
2440
2441
2442static void ficlAbort(FICL_VM *pVM)
2443{
2075 pSrc++;
2076
2077 vmTextOut(pVM, pVM->pad, 0);
2078 vmUpdateTib(pVM, pSrc);
2079
2080 return;
2081}
2082

--- 349 unchanged lines hidden (view full) ---

2432{
2433 vmThrow(pVM, VM_QUIT);
2434 return;
2435}
2436
2437
2438static void ficlAbort(FICL_VM *pVM)
2439{
2444 vmThrow(pVM, VM_ERREXIT);
2440 vmThrow(pVM, VM_ABORT);
2445 return;
2446}
2447
2448
2449/**************************************************************************
2450 a c c e p t
2451** accept CORE ( c-addr +n1 -- +n2 )
2452** Receive a string of at most +n1 characters. An ambiguous condition

--- 4 unchanged lines hidden (view full) ---

2457** construct the string are implementation-defined.
2458**
2459** (Although the standard text doesn't say so, I assume that the intent
2460** of 'accept' is to store the string at the address specified on
2461** the stack.)
2462** Implementation: if there's more text in the TIB, use it. Otherwise
2463** throw out for more text. Copy characters up to the max count into the
2464** address given, and return the number of actual characters copied.
2441 return;
2442}
2443
2444
2445/**************************************************************************
2446 a c c e p t
2447** accept CORE ( c-addr +n1 -- +n2 )
2448** Receive a string of at most +n1 characters. An ambiguous condition

--- 4 unchanged lines hidden (view full) ---

2453** construct the string are implementation-defined.
2454**
2455** (Although the standard text doesn't say so, I assume that the intent
2456** of 'accept' is to store the string at the address specified on
2457** the stack.)
2458** Implementation: if there's more text in the TIB, use it. Otherwise
2459** throw out for more text. Copy characters up to the max count into the
2460** address given, and return the number of actual characters copied.
2461**
2462** This may not strictly violate the standard, but I'm sure any programs
2463** asking for user input at load time will *not* be expecting this
2464** behavior. (sobral)
2465**************************************************************************/
2466static void accept(FICL_VM *pVM)
2467{
2468 UNS32 count, len;
2469 char *cp;
2470 char *pBuf = vmGetInBuf(pVM);
2471
2465**************************************************************************/
2466static void accept(FICL_VM *pVM)
2467{
2468 UNS32 count, len;
2469 char *cp;
2470 char *pBuf = vmGetInBuf(pVM);
2471
2472 len = strlen(pBuf);
2472 for (len = 0; pVM->tib.end != &pBuf[len] && pBuf[len]; len++);
2473 if (len == 0)
2474 vmThrow(pVM, VM_RESTART);
2475 /* OK - now we have something in the text buffer - use it */
2476 count = stackPopUNS32(pVM->pStack);
2477 cp = stackPopPtr(pVM->pStack);
2478
2479 strncpy(cp, vmGetInBuf(pVM), count);
2480 len = (count < len) ? count : len;

--- 206 unchanged lines hidden (view full) ---

2687 return;
2688}
2689
2690/**************************************************************************
2691 e v a l u a t e
2692** EVALUATE CORE ( i*x c-addr u -- j*x )
2693** Save the current input source specification. Store minus-one (-1) in
2694** SOURCE-ID if it is present. Make the string described by c-addr and u
2473 if (len == 0)
2474 vmThrow(pVM, VM_RESTART);
2475 /* OK - now we have something in the text buffer - use it */
2476 count = stackPopUNS32(pVM->pStack);
2477 cp = stackPopPtr(pVM->pStack);
2478
2479 strncpy(cp, vmGetInBuf(pVM), count);
2480 len = (count < len) ? count : len;

--- 206 unchanged lines hidden (view full) ---

2687 return;
2688}
2689
2690/**************************************************************************
2691 e v a l u a t e
2692** EVALUATE CORE ( i*x c-addr u -- j*x )
2693** Save the current input source specification. Store minus-one (-1) in
2694** SOURCE-ID if it is present. Make the string described by c-addr and u
2695** both the input source and input buffer, set >IN to zero, and interpret.
2695** both the input source andinput buffer, set >IN to zero, and interpret.
2696** When the parse area is empty, restore the prior input source
2697** specification. Other stack effects are due to the words EVALUATEd.
2698**
2696** When the parse area is empty, restore the prior input source
2697** specification. Other stack effects are due to the words EVALUATEd.
2698**
2699** DEFICIENCY: this version does not handle errors or restarts.
2699** DEFICIENCY: this version does not handle restarts. Also, exceptions
2700** are just passed ahead. Is this the Right Thing? I don't know...
2700**************************************************************************/
2701static void evaluate(FICL_VM *pVM)
2702{
2701**************************************************************************/
2702static void evaluate(FICL_VM *pVM)
2703{
2703 UNS32 count = stackPopUNS32(pVM->pStack);
2704 INT32 count = stackPopINT32(pVM->pStack);
2704 char *cp = stackPopPtr(pVM->pStack);
2705 CELL id;
2705 char *cp = stackPopPtr(pVM->pStack);
2706 CELL id;
2707 int result;
2706
2708
2707 IGNORE(count);
2708 id = pVM->sourceID;
2709 pVM->sourceID.i = -1;
2710 vmPushIP(pVM, &pInterpret);
2709 id = pVM->sourceID;
2710 pVM->sourceID.i = -1;
2711 vmPushIP(pVM, &pInterpret);
2711 ficlExec(pVM, cp);
2712 result = ficlExec(pVM, cp, count);
2712 vmPopIP(pVM);
2713 pVM->sourceID = id;
2713 vmPopIP(pVM);
2714 pVM->sourceID = id;
2715 if (result != VM_OUTOFTEXT)
2716 vmThrow(pVM, result);
2714 return;
2715}
2716
2717
2718/**************************************************************************
2719 s t r i n g q u o t e
2720** Intrpreting: get string delimited by a quote from the input stream,
2721** copy to a scratch area, and put its count and address on the stack.

--- 116 unchanged lines hidden (view full) ---

2838{
2839 char *pSrc = vmGetInBuf(pVM);
2840 char *cp;
2841 UNS32 count;
2842 char delim = (char)stackPopINT32(pVM->pStack);
2843
2844 cp = pSrc; /* mark start of text */
2845
2717 return;
2718}
2719
2720
2721/**************************************************************************
2722 s t r i n g q u o t e
2723** Intrpreting: get string delimited by a quote from the input stream,
2724** copy to a scratch area, and put its count and address on the stack.

--- 116 unchanged lines hidden (view full) ---

2841{
2842 char *pSrc = vmGetInBuf(pVM);
2843 char *cp;
2844 UNS32 count;
2845 char delim = (char)stackPopINT32(pVM->pStack);
2846
2847 cp = pSrc; /* mark start of text */
2848
2846 while ((*pSrc != delim) && (*pSrc != '\0'))
2849 while ((pVM->tib.end != pSrc) && (*pSrc != delim) && (*pSrc != '\0'))
2847 pSrc++; /* find next delimiter or end */
2848
2849 count = pSrc - cp; /* set length of result */
2850
2850 pSrc++; /* find next delimiter or end */
2851
2852 count = pSrc - cp; /* set length of result */
2853
2851 if (*pSrc == delim) /* gobble trailing delimiter */
2854 if ((pVM->tib.end != pSrc) && (*pSrc == delim)) /* gobble trailing delimiter */
2852 pSrc++;
2853
2854 vmUpdateTib(pVM, pSrc);
2855 stackPushPtr(pVM->pStack, cp);
2856 stackPushUNS32(pVM->pStack, count);
2857 return;
2858}
2859

--- 294 unchanged lines hidden (view full) ---

3154
3155/**************************************************************************
3156 s o u r c e
3157** CORE ( -- c-addr u )
3158** c-addr is the address of, and u is the number of characters in, the
3159** input buffer.
3160**************************************************************************/
3161static void source(FICL_VM *pVM)
2855 pSrc++;
2856
2857 vmUpdateTib(pVM, pSrc);
2858 stackPushPtr(pVM->pStack, cp);
2859 stackPushUNS32(pVM->pStack, count);
2860 return;
2861}
2862

--- 294 unchanged lines hidden (view full) ---

3157
3158/**************************************************************************
3159 s o u r c e
3160** CORE ( -- c-addr u )
3161** c-addr is the address of, and u is the number of characters in, the
3162** input buffer.
3163**************************************************************************/
3164static void source(FICL_VM *pVM)
3162{
3165{ int i;
3166
3163 stackPushPtr(pVM->pStack, pVM->tib.cp);
3167 stackPushPtr(pVM->pStack, pVM->tib.cp);
3164 stackPushINT32(pVM->pStack, strlen(pVM->tib.cp));
3168 for (i = 0; (pVM->tib.end != &pVM->tib.cp[i]) && pVM->tib.cp[i]; i++);
3169 stackPushINT32(pVM->pStack, i);
3165 return;
3166}
3167
3168
3169/**************************************************************************
3170 v e r s i o n
3171** non-standard...
3172**************************************************************************/

--- 871 unchanged lines hidden (view full) ---

4044 tick(pVM);
4045 where = ((FICL_WORD *)stackPopPtr(pVM->pStack))->name;
4046 hashForget(pHash, where);
4047 pDict->here = PTRtoCELL where;
4048
4049 return;
4050}
4051
3170 return;
3171}
3172
3173
3174/**************************************************************************
3175 v e r s i o n
3176** non-standard...
3177**************************************************************************/

--- 871 unchanged lines hidden (view full) ---

4049 tick(pVM);
4050 where = ((FICL_WORD *)stackPopPtr(pVM->pStack))->name;
4051 hashForget(pHash, where);
4052 pDict->here = PTRtoCELL where;
4053
4054 return;
4055}
4056
4057/*************** freebsd added memory-alloc handling words ******************/
4058
4059static void allocate(FICL_VM *pVM)
4060{
4061 size_t size;
4062 void *p;
4063
4064 size = stackPopINT32(pVM->pStack);
4065 p = ficlMalloc(size);
4066 stackPushPtr(pVM->pStack, p);
4067 if (p)
4068 stackPushINT32(pVM->pStack, 0);
4069 else
4070 stackPushINT32(pVM->pStack, 1);
4071}
4072
4073static void free4th(FICL_VM *pVM)
4074{
4075 void *p;
4076
4077 p = stackPopPtr(pVM->pStack);
4078 ficlFree(p);
4079 stackPushINT32(pVM->pStack, 0);
4080}
4081
4082static void resize(FICL_VM *pVM)
4083{
4084 size_t size;
4085 void *new, *old;
4086
4087 size = stackPopINT32(pVM->pStack);
4088 old = stackPopPtr(pVM->pStack);
4089 new = ficlRealloc(old, size);
4090 if (new) {
4091 stackPushPtr(pVM->pStack, new);
4092 stackPushINT32(pVM->pStack, 0);
4093 } else {
4094 stackPushPtr(pVM->pStack, old);
4095 stackPushINT32(pVM->pStack, 1);
4096 }
4097}
4098
4099/***************** freebsd added exception handling words *******************/
4100
4101/*
4102 * Catch, from ANS Forth standard. Installs a safety net, then EXECUTE
4103 * the word in ToS. If an exception happens, restore the state to what
4104 * it was before, and pushes the exception value on the stack. If not,
4105 * push zero.
4106 *
4107 * Notice that Catch implements an inner interpreter. This is ugly,
4108 * but given how ficl works, it cannot be helped. The problem is that
4109 * colon definitions will be executed *after* the function returns,
4110 * while "code" definitions will be executed immediately. I considered
4111 * other solutions to this problem, but all of them shared the same
4112 * basic problem (with added disadvantages): if ficl ever changes it's
4113 * inner thread modus operandi, one would have to fix this word.
4114 *
4115 * More comments can be found throughout catch's code.
4116 *
4117 * BUGS: do not handle locals unnesting correctly... I think...
4118 *
4119 * Daniel C. Sobral Jan 09/1999
4120 */
4121
4122static void catch(FICL_VM *pVM)
4123{
4124 int except;
4125 jmp_buf vmState;
4126 FICL_VM VM;
4127 FICL_STACK pStack;
4128 FICL_STACK rStack;
4129 FICL_WORD *pFW;
4130 IPTYPE exitIP;
4131
4132 /*
4133 * Get xt.
4134 * We need this *before* we save the stack pointer, or
4135 * we'll have to pop one element out of the stack after
4136 * an exception. I prefer to get done with it up front. :-)
4137 */
4138#if FICL_ROBUST > 1
4139 vmCheckStack(pVM, 1, 0);
4140#endif
4141 pFW = stackPopPtr(pVM->pStack);
4142
4143 /*
4144 * Save vm's state -- a catch will not back out environmental
4145 * changes.
4146 *
4147 * We are *not* saving dictionary state, since it is
4148 * global instead of per vm, and we are not saving
4149 * stack contents, since we are not required to (and,
4150 * thus, it would be useless). We save pVM, and pVM
4151 * "stacks" (a structure containing general information
4152 * about it, including the current stack pointer).
4153 */
4154 memcpy((void*)&VM, (void*)pVM, sizeof(FICL_VM));
4155 memcpy((void*)&pStack, (void*)pVM->pStack, sizeof(FICL_STACK));
4156 memcpy((void*)&rStack, (void*)pVM->rStack, sizeof(FICL_STACK));
4157
4158 /*
4159 * Give pVM a jmp_buf
4160 */
4161 pVM->pState = &vmState;
4162
4163 /*
4164 * Safety net
4165 */
4166 except = setjmp(vmState);
4167
4168 /*
4169 * And now, choose what to do depending on except.
4170 */
4171
4172 /* Things having gone wrong... */
4173 if(except) {
4174 /* Restore vm's state */
4175 memcpy((void*)pVM, (void*)&VM, sizeof(FICL_VM));
4176 memcpy((void*)pVM->pStack, (void*)&pStack, sizeof(FICL_STACK));
4177 memcpy((void*)pVM->rStack, (void*)&rStack, sizeof(FICL_STACK));
4178
4179 /* Push error */
4180 stackPushINT32(pVM->pStack, except);
4181
4182 /* Things being ok... */
4183 } else {
4184 /*
4185 * We need to know when to exit the inner loop
4186 * Colonp, the "code" for colon words, just pushes
4187 * the word's IP onto the RP, and expect the inner
4188 * interpreter to do the rest. Well, I'd rather have
4189 * it done *before* I return from this function,
4190 * losing the automatic variables I'm using to save
4191 * state. Sure, I could save this on dynamic memory
4192 * and save state on RP, or I could even implement
4193 * the poor man's version of this word in Forth with
4194 * sp@, sp!, rp@ and rp!, but we have a lot of state
4195 * neatly tucked away in pVM, so why not save it?
4196 */
4197 exitIP = pVM->ip;
4198
4199 /* Execute the xt -- inline code for vmExecute */
4200
4201 pVM->runningWord = pFW;
4202 pFW->code(pVM);
4203
4204 /*
4205 * Run the inner loop until we get back to exitIP
4206 */
4207 for (; pVM->ip != exitIP;) {
4208 pFW = *pVM->ip++;
4209
4210 /* Inline code for vmExecute */
4211 pVM->runningWord = pFW;
4212 pFW->code(pVM);
4213 }
4214
4215
4216 /* Restore just the setjmp vector */
4217 pVM->pState = VM.pState;
4218
4219 /* Push 0 -- everything is ok */
4220 stackPushINT32(pVM->pStack, 0);
4221 }
4222}
4223
4224/*
4225 * Throw -- maybe vmThow already do what's required, but I don't really
4226 * know what happens when you longjmp(buf, 0). From ANS Forth standard.
4227 *
4228 * Anyway, throw takes the ToS and, if that's different from zero,
4229 * returns to the last executed catch context. Further throws will
4230 * unstack previously executed "catches", in LIFO mode.
4231 *
4232 * Daniel C. Sobral Jan 09/1999
4233 */
4234
4235static void throw(FICL_VM *pVM)
4236{
4237 int except;
4238
4239 except = stackPopINT32(pVM->pStack);
4240
4241 if (except)
4242 vmThrow(pVM, except);
4243}
4244
4052/************************* freebsd added I/O words **************************/
4053
4054/* fopen - open a file and return new fd on stack.
4055 *
4056 * fopen ( count ptr -- fd )
4057 */
4058static void pfopen(FICL_VM *pVM)
4059{

--- 320 unchanged lines hidden (view full) ---

4380 dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT);
4381 dictAppendWord(dp, "fread", pfread, FW_DEFAULT);
4382 dictAppendWord(dp, "fload", pfload, FW_DEFAULT);
4383 dictAppendWord(dp, "fkey", fkey, FW_DEFAULT);
4384 dictAppendWord(dp, "key", key, FW_DEFAULT);
4385 dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT);
4386 dictAppendWord(dp, "ms", ms, FW_DEFAULT);
4387 dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT);
4245/************************* freebsd added I/O words **************************/
4246
4247/* fopen - open a file and return new fd on stack.
4248 *
4249 * fopen ( count ptr -- fd )
4250 */
4251static void pfopen(FICL_VM *pVM)
4252{

--- 320 unchanged lines hidden (view full) ---

4573 dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT);
4574 dictAppendWord(dp, "fread", pfread, FW_DEFAULT);
4575 dictAppendWord(dp, "fload", pfload, FW_DEFAULT);
4576 dictAppendWord(dp, "fkey", fkey, FW_DEFAULT);
4577 dictAppendWord(dp, "key", key, FW_DEFAULT);
4578 dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT);
4579 dictAppendWord(dp, "ms", ms, FW_DEFAULT);
4580 dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT);
4388#ifdef __i386__
4581 /*
4582 ** EXCEPTION word set
4583 */
4584 dictAppendWord(dp, "catch", catch, FW_DEFAULT);
4585 dictAppendWord(dp, "throw", throw, FW_DEFAULT);
4586
4587 ficlSetEnv("exception", FICL_TRUE);
4588 ficlSetEnv("exception-ext", FICL_TRUE);
4589
4590 /*
4591 ** MEMORY-ALLOC word set
4592 */
4593 dictAppendWord(dp, "allocate", allocate, FW_DEFAULT);
4594 dictAppendWord(dp, "free", free4th, FW_DEFAULT);
4595 dictAppendWord(dp, "resize", resize, FW_DEFAULT);
4596
4597 ficlSetEnv("memory-alloc", FICL_TRUE);
4598
4389#ifndef TESTMAIN
4599#ifndef TESTMAIN
4600#ifdef __i386__
4390 dictAppendWord(dp, "outb", ficlOutb, FW_DEFAULT);
4391 dictAppendWord(dp, "inb", ficlInb, FW_DEFAULT);
4392#endif
4601 dictAppendWord(dp, "outb", ficlOutb, FW_DEFAULT);
4602 dictAppendWord(dp, "inb", ficlInb, FW_DEFAULT);
4603#endif
4604#endif
4605
4606#if defined(__i386__)
4393 ficlSetEnv("arch-i386", FICL_TRUE);
4607 ficlSetEnv("arch-i386", FICL_TRUE);
4394#else
4608 ficlSetEnv("arch-alpha", FICL_FALSE);
4609#elif defined(__alpha__)
4395 ficlSetEnv("arch-i386", FICL_FALSE);
4610 ficlSetEnv("arch-i386", FICL_FALSE);
4611 ficlSetEnv("arch-alpha", FICL_TRUE);
4396#endif
4397
4398 /*
4399 ** Set CORE environment query values
4400 */
4401 ficlSetEnv("/counted-string", FICL_STRING_MAX);
4402 ficlSetEnv("/hold", nPAD);
4403 ficlSetEnv("/pad", nPAD);

--- 141 unchanged lines hidden --- 		4612#endif
4613
4614 /*
4615 ** Set CORE environment query values
4616 */
4617 ficlSetEnv("/counted-string", FICL_STRING_MAX);
4618 ficlSetEnv("/hold", nPAD);
4619 ficlSetEnv("/pad", nPAD);

--- 141 unchanged lines hidden ---