1 /* # skkinput (Simple Kana-Kanji Input)
2 *
3 * This file is part of skkinput.
4 * Copyright (C) 2002
5 * Takashi SAKAMOTO (PXG01715@nifty.ne.jp)
6 *
7 * This program is free software; you can redistribute it and/or modify
8 * it under the terms of the GNU General Public License as published by
9 * the Free Software Foundation; either version 2, or (at your option)
10 * any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with skkinput; see the file COPYING. If not, write to
19 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20 */
21 #include "local.h"
22 #include <stdio.h>
23 #include <assert.h>
24 #include "lmachinep.h"
25 #include "varbuffer.h"
26 #include "cstring.h"
27 #include "kanji.h"
28 #include "regex.h"
29
30 static Boolean lispMachine_addTail (TLispManager*, TLispEntity*, TLispEntity**, TLispEntity**) ;
31 #if defined (DEBUG)
32 static void cputstr (FILE*, const Char*, int) ;
33 #endif
34
35 Boolean
lispMachineCode_PushVReg(register TLispMachine * pLM,register int nReg)36 lispMachineCode_PushVReg (
37 register TLispMachine* pLM,
38 register int nReg)
39 {
40 assert (pLM != NULL) ;
41 assert (0 <= nReg && nReg < MAX_NONLISPOBJ_REGS) ;
42 return Vstack_Push (&pLM->m_vstNonLispObj, &pLM->m_alVREGS [nReg]) ;
43 }
44
45 Boolean
lispMachineCode_PopVReg(register TLispMachine * pLM,register int nReg)46 lispMachineCode_PopVReg (
47 register TLispMachine* pLM,
48 register int nReg)
49 {
50 assert (pLM != NULL) ;
51 assert (0 <= nReg && nReg < MAX_NONLISPOBJ_REGS) ;
52
53 return Vstack_Pop (&pLM->m_vstNonLispObj, &pLM->m_alVREGS [nReg]) ;
54 }
55
56 Boolean
lispMachineCode_SetVRegI(register TLispMachine * pLM,register int nReg,register long lValue)57 lispMachineCode_SetVRegI (
58 register TLispMachine* pLM,
59 register int nReg,
60 register long lValue)
61 {
62 assert (pLM != NULL) ;
63 assert (0 <= nReg && nReg < MAX_NONLISPOBJ_REGS) ;
64
65 pLM->m_alVREGS [nReg].m_lValue = lValue ;
66 return True ;
67 }
68
69 Boolean
lispMachineCode_SetVRegP(register TLispMachine * pLM,register int nReg,register void * pvValue)70 lispMachineCode_SetVRegP (
71 register TLispMachine* pLM,
72 register int nReg,
73 register void* pvValue)
74 {
75 assert (pLM != NULL) ;
76 assert (0 <= nReg && nReg < MAX_NONLISPOBJ_REGS) ;
77
78 pLM->m_alVREGS [nReg].m_pvValue = pvValue ;
79 return True ;
80 }
81
82 Boolean
lispMachineCode_GetVRegI(register TLispMachine * pLM,register int nReg,register long * plValue)83 lispMachineCode_GetVRegI (
84 register TLispMachine* pLM,
85 register int nReg,
86 register long* plValue)
87 {
88 assert (pLM != NULL) ;
89 assert (0 <= nReg && nReg < MAX_NONLISPOBJ_REGS) ;
90 assert (plValue != NULL) ;
91
92 *plValue = pLM->m_alVREGS [nReg].m_lValue ;
93 return True ;
94 }
95
96 Boolean
lispMachineCode_GetVRegP(register TLispMachine * pLM,register int nReg,register void ** ppvValue)97 lispMachineCode_GetVRegP (
98 register TLispMachine* pLM,
99 register int nReg,
100 register void** ppvValue)
101 {
102 assert (pLM != NULL) ;
103 assert (0 <= nReg && nReg < MAX_NONLISPOBJ_REGS) ;
104 assert (ppvValue != NULL) ;
105
106 *ppvValue = pLM->m_alVREGS [nReg].m_pvValue ;
107 return True ;
108 }
109
110 Boolean
lispMachineCode_MoveVReg(register TLispMachine * pLM,register int nDestReg,register int nSrcReg)111 lispMachineCode_MoveVReg (
112 register TLispMachine* pLM,
113 register int nDestReg,
114 register int nSrcReg)
115 {
116 assert (pLM != NULL) ;
117 assert (0 <= nDestReg && nDestReg < MAX_NONLISPOBJ_REGS) ;
118 assert (0 <= nSrcReg && nSrcReg < MAX_NONLISPOBJ_REGS) ;
119
120 memcpy (&pLM->m_alVREGS [nDestReg], &pLM->m_alVREGS [nSrcReg], sizeof (TNotLispValue)) ;
121 return True ;
122 }
123
124 /*
125 * �֤��ͤ� ACC �����롣
126 */
127 Boolean
lispMachineCode_Evaln(register TLispMachine * pLM,register TLispEntity * pEntTarget,register TLMRESULT (* pNextState)(TLispMachine *))128 lispMachineCode_Evaln (
129 register TLispMachine* pLM,
130 register TLispEntity* pEntTarget,
131 register TLMRESULT (*pNextState)(TLispMachine*))
132 {
133 int iType ;
134
135 assert (pLM != NULL) ;
136 assert (pEntTarget != NULL) ;
137 assert (pLM->m_pLispMgr != NULL) ;
138
139 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntTarget) ;
140
141 (void )lispEntity_GetType (pLM->m_pLispMgr, pEntTarget, &iType) ;
142 switch (iType) {
143 case LISPENTITY_SYMBOL:
144 lispMachineCode_PushState (pLM, pNextState) ;
145 pLM->m_pState = &lispMachineState_EvalSymbol ;
146 break ;
147
148 case LISPENTITY_CONSCELL:
149 lispMachineCode_PushState (pLM, pNextState) ;
150 pLM->m_pState = &lispMachineState_EvalCons ;
151 break ;
152
153 case LISPENTITY_INTEGER:
154 case LISPENTITY_FLOAT:
155 case LISPENTITY_VECTOR:
156 case LISPENTITY_MARKER:
157 case LISPENTITY_BUFFER:
158 case LISPENTITY_STRING:
159 default:
160 pLM->m_pState = pNextState ;
161 break ;
162 }
163 return True ;
164 }
165
166 Boolean
lispMachineCode_Car(register TLispMachine * pLM,register int nDestReg,register int nSrcReg)167 lispMachineCode_Car (
168 register TLispMachine* pLM,
169 register int nDestReg,
170 register int nSrcReg)
171 {
172 register TLispManager* pLispMgr ;
173 TLispEntity* pCAR ;
174
175 assert (pLM != NULL) ;
176 assert (0 <= nDestReg && nDestReg < MAX_LISPOBJ_REGS) ;
177 assert (0 <= nSrcReg && nSrcReg < MAX_LISPOBJ_REGS) ;
178
179 pLispMgr = pLM->m_pLispMgr ;
180 if (TFAILED (lispEntity_GetCar (pLispMgr, pLM->m_apLREGS [nSrcReg], &pCAR)) ||
181 pCAR == NULL)
182 return False ;
183 lispEntity_AddRef (pLispMgr, pCAR) ;
184 if (pLM->m_apLREGS [nDestReg] != NULL)
185 lispEntity_Release (pLispMgr, pLM->m_apLREGS [nDestReg]) ;
186 pLM->m_apLREGS [nDestReg] = pCAR ;
187 return True ;
188 }
189
190 Boolean
lispMachineCode_SetCurrentFrame(register TLispMachine * pLM,register TLispEntity * pSelFrame)191 lispMachineCode_SetCurrentFrame (
192 register TLispMachine* pLM,
193 register TLispEntity* pSelFrame)
194 {
195 assert (pLM != NULL) ;
196 assert (pSelFrame != NULL) ;
197 assert (pSelFrame->m_iType == LISPENTITY_FRAME) ;
198
199 pLM->m_pCurFrame = pSelFrame ;
200 return True ;
201 }
202
203 Boolean
lispMachineCode_GetCurrentFrame(register TLispMachine * pLM,register TLispEntity ** ppSelFrame)204 lispMachineCode_GetCurrentFrame (
205 register TLispMachine* pLM,
206 register TLispEntity** ppSelFrame)
207 {
208 register TLispEntity* pEntFrame ;
209
210 assert (pLM != NULL) ;
211 assert (ppSelFrame != NULL) ;
212
213 pEntFrame = pLM->m_pCurFrame ;
214 *ppSelFrame = pEntFrame ;
215 return (pEntFrame != NULL)? True : False ;
216 }
217
218 Boolean
lispMachineCode_SetCurrentWindow(register TLispMachine * pLM,register TLispEntity * pCurWindow)219 lispMachineCode_SetCurrentWindow (
220 register TLispMachine* pLM,
221 register TLispEntity* pCurWindow)
222 {
223 assert (pLM != NULL) ;
224 assert (pCurWindow != NULL) ;
225 assert (pCurWindow->m_iType == LISPENTITY_WINDOW) ;
226
227 pLM->m_pCurWindow = pCurWindow ;
228 return True ;
229 }
230
231 Boolean
lispMachineCode_GetCurrentWindow(register TLispMachine * pLM,register TLispEntity ** ppCurWindow)232 lispMachineCode_GetCurrentWindow (
233 register TLispMachine* pLM,
234 register TLispEntity** ppCurWindow)
235 {
236 assert (pLM != NULL) ;
237 assert (ppCurWindow != NULL) ;
238
239 *ppCurWindow = pLM->m_pCurWindow ;
240 return True ;
241 }
242
243 Boolean
lispMachineCode_SetCurrentBuffer(register TLispMachine * pLM,register TLispEntity * pCurBuffer)244 lispMachineCode_SetCurrentBuffer (
245 register TLispMachine* pLM,
246 register TLispEntity* pCurBuffer)
247 {
248 assert (pLM != NULL) ;
249 assert (pCurBuffer != NULL) ;
250 assert (pCurBuffer->m_iType == LISPENTITY_BUFFER) ;
251
252 pLM->m_pCurBuffer = pCurBuffer ;
253 return True ;
254 }
255
256 Boolean
lispMachineCode_GetCurrentBuffer(register TLispMachine * pLM,register TLispEntity ** ppCurBuffer)257 lispMachineCode_GetCurrentBuffer (
258 register TLispMachine* pLM,
259 register TLispEntity** ppCurBuffer)
260 {
261 assert (pLM != NULL) ;
262 assert (ppCurBuffer != NULL) ;
263 assert (pLM->m_pCurBuffer != NULL) ;
264
265 *ppCurBuffer = pLM->m_pCurBuffer ;
266 return True ;
267 }
268
269 Boolean
lispMachineCode_SetException(register TLispMachine * pLM,register TLispEntity * pEntException,register TLispEntity * pEntValue)270 lispMachineCode_SetException (
271 register TLispMachine* pLM,
272 register TLispEntity* pEntException,
273 register TLispEntity* pEntValue)
274 {
275 register TLispManager* pLispMgr ;
276
277 assert (pLM != NULL) ;
278 pLispMgr = pLM->m_pLispMgr ;
279 assert (pLispMgr != NULL) ;
280
281 assert (pEntException != NULL) ;
282 assert (pEntValue != NULL) ;
283 lispEntity_AddRef (pLispMgr, pEntException) ;
284 lispEntity_AddRef (pLispMgr, pEntValue) ;
285
286 if (pLM->m_pEntException != NULL)
287 lispEntity_Release (pLispMgr, pLM->m_pEntException) ;
288 if (pLM->m_pEntExceptionValue != NULL)
289 lispEntity_Release (pLispMgr, pLM->m_pEntExceptionValue) ;
290
291 pLM->m_pEntException = pEntException ;
292 pLM->m_pEntExceptionValue = pEntValue ;
293
294 /* ������ exception �����ꤵ�줿�Τʤ顢�ե饰���ƤƤ�����*/
295 if (TFAILED (lispEntity_Nullp (pLispMgr, pEntException))) {
296 pLM->m_uStatusFlag |= LMSTATE_EXCEPTION ;
297 } else {
298 pLM->m_uStatusFlag &= ~LMSTATE_EXCEPTION ;
299 }
300 return True ;
301 }
302
303 Boolean
lispMachineCode_GetException(register TLispMachine * pLM,register TLispEntity ** ppEntExceptionRet,register TLispEntity ** ppEntExceptionValueRet)304 lispMachineCode_GetException (
305 register TLispMachine* pLM,
306 register TLispEntity** ppEntExceptionRet,
307 register TLispEntity** ppEntExceptionValueRet)
308 {
309 assert (pLM != NULL) ;
310 *ppEntExceptionRet = pLM->m_pEntException ;
311 *ppEntExceptionValueRet = pLM->m_pEntExceptionValue ;
312 return True ;
313 }
314
315 Boolean
lispMachineCode_ResetException(register TLispMachine * pLM)316 lispMachineCode_ResetException (
317 register TLispMachine* pLM)
318 {
319 register TLispManager* pLispMgr ;
320 register TLispEntity* pEntNil ;
321
322 assert (pLM != NULL) ;
323 pLispMgr = pLM->m_pLispMgr ;
324 assert (pLispMgr != NULL) ;
325 pEntNil = pLispMgr->m_apEntReserved [LISPMGR_INDEX_NIL] ;
326 return lispMachineCode_SetException (pLM, pEntNil, pEntNil) ;
327 }
328
329 Boolean
lispMachineCode_SetSignal(register TLispMachine * pLM,register TLispEntity * pEntSymbol,register TLispEntity * pEntValue)330 lispMachineCode_SetSignal (
331 register TLispMachine* pLM,
332 register TLispEntity* pEntSymbol,
333 register TLispEntity* pEntValue)
334 {
335 register TLispManager* pLispMgr ;
336
337 assert (pLM != NULL) ;
338 pLispMgr = pLM->m_pLispMgr ;
339
340 assert (pLispMgr != NULL) ;
341 assert (pEntSymbol != NULL) ;
342 assert (pEntValue != NULL) ;
343
344 lispEntity_AddRef (pLispMgr, pEntSymbol) ;
345 lispEntity_AddRef (pLispMgr, pEntValue) ;
346
347 if (pLM->m_pEntSignal != NULL)
348 lispEntity_Release (pLispMgr, pLM->m_pEntSignal) ;
349 if (pLM->m_pEntSignalValue != NULL)
350 lispEntity_Release (pLispMgr, pLM->m_pEntSignalValue) ;
351
352 pLM->m_pEntSignal = pEntSymbol ;
353 pLM->m_pEntSignalValue = pEntValue ;
354 /* ������ signal �����ꤵ�줿�Τʤ顢�ե饰���ƤƤ�����*/
355 if (TFAILED (lispEntity_Nullp (pLispMgr, pEntSymbol))) {
356 pLM->m_uStatusFlag |= LMSTATE_SIGNAL ;
357 } else {
358 pLM->m_uStatusFlag &= ~LMSTATE_SIGNAL ;
359 }
360 return True ;
361 }
362
363 Boolean
lispMachineCode_SetError(register TLispMachine * pLM)364 lispMachineCode_SetError (
365 register TLispMachine* pLM)
366 {
367 register TLispManager* pLispMgr ;
368 register TLispEntity* pEntError ;
369 TLispEntity* pEntNil ;
370
371 assert (pLM != NULL) ;
372 pLispMgr = pLM->m_pLispMgr ;
373 assert (pLispMgr != NULL) ;
374 lispMgr_CreateNil (pLispMgr, &pEntNil) ;
375 pEntError = lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_ERROR) ;
376 assert (pEntError != NULL) ;
377 return lispMachineCode_SetSignal (pLM, pEntError, pEntNil) ;
378 }
379
380 Boolean
lispMachineCode_SetErrorEx(register TLispMachine * pLM,register TLispEntity * pEntErrorValue)381 lispMachineCode_SetErrorEx (
382 register TLispMachine* pLM,
383 register TLispEntity* pEntErrorValue)
384 {
385 register TLispManager* pLispMgr ;
386 register TLispEntity* pEntError ;
387
388 assert (pLM != NULL) ;
389 pLispMgr = pLM->m_pLispMgr ;
390 assert (pLispMgr != NULL) ;
391 pEntError = lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_ERROR) ;
392 assert (pEntError != NULL) ;
393 assert (pEntErrorValue != NULL) ;
394 return lispMachineCode_SetSignal (pLM, pEntError, pEntErrorValue) ;
395 }
396
397 Boolean
lispMachineCode_ResetSignal(register TLispMachine * pLM)398 lispMachineCode_ResetSignal (
399 register TLispMachine* pLM)
400 {
401 register TLispManager* pLispMgr ;
402 register TLispEntity* pEntNil ;
403
404 assert (pLM != NULL) ;
405 pLispMgr = pLM->m_pLispMgr ;
406 assert (pLispMgr != NULL) ;
407 pEntNil = pLispMgr->m_apEntReserved [LISPMGR_INDEX_NIL] ;
408 return lispMachineCode_SetSignal (pLM, pEntNil, pEntNil) ;
409 }
410
411 Boolean
lispMachineCode_GetSignal(register TLispMachine * pLM,register TLispEntity ** ppEntSignalRet,register TLispEntity ** ppEntSignalValueRet)412 lispMachineCode_GetSignal (
413 register TLispMachine* pLM,
414 register TLispEntity** ppEntSignalRet,
415 register TLispEntity** ppEntSignalValueRet)
416 {
417 assert (pLM != NULL) ;
418 *ppEntSignalRet = pLM->m_pEntSignal ;
419 *ppEntSignalValueRet = pLM->m_pEntSignalValue ;
420 return True ;
421 }
422
423 Boolean
lispMachineCode_SetMessage(register TLispMachine * pLM,register TLispEntity * pEntString)424 lispMachineCode_SetMessage (
425 register TLispMachine* pLM,
426 register TLispEntity* pEntString)
427 {
428 TLispEntity* pMinWnd ;
429
430 assert (pLM != NULL) ;
431 assert (pLM->m_pCurFrame != NULL) ;
432
433 if (pLM->m_pCurFrame == NULL) {
434 #if defined (DEBUG) || 1
435 if (pEntString != NULL) {
436 lispEntity_Print (pLM->m_pLispMgr, pEntString) ;
437 fprintf (stderr, "\n") ;
438 }
439 #endif
440 return False ;
441 }
442 if (! lispFrame_GetMinibufferWindow (pLM->m_pCurFrame, &pMinWnd))
443 return True ;
444 return lispWindow_SetMessage (pLM->m_pLispMgr, pMinWnd, pEntString) ;
445 }
446
447 /*[ư��]
448 * KEYMAP-ALIST: ((SYMBOL1 KEYMAP1) (SYMBOL2 KEYMAP2) ...)
449 *
450 * �η������� SYMBOL �� VALUE ���� KEYMAP ��ȴ���Ф��ƹԤ���
451 */
452 Boolean
lispMachineCode_CurrentMinorModeMaps(register TLispMachine * pLM,register TLispEntity ** ppEntRetval)453 lispMachineCode_CurrentMinorModeMaps (
454 register TLispMachine* pLM,
455 register TLispEntity** ppEntRetval)
456 {
457 register TLispManager* pLispMgr ;
458 register TLispEntity* pEntMinorModeMapAlist ;
459 TLispEntity* pEntNil ;
460 TLispEntity* pEntAlist ;
461 TLispEntity* pEntSymbolKeymap ;
462 TLispEntity* pEntSymbol ;
463 TLispEntity* pEntKeymap ;
464 TLispEntity* pEntSymVal ;
465 TLispEntity* pEntTop ;
466 TLispEntity* pEntTail ;
467
468 assert (pLM != NULL) ;
469 assert (ppEntRetval != NULL) ;
470 pLispMgr = pLM->m_pLispMgr ;
471 assert (pLispMgr != NULL) ;
472 lispMgr_CreateNil (pLispMgr, &pEntNil) ;
473 pEntTop = pEntTail = NULL ;
474
475 pEntMinorModeMapAlist = lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_MINOR_MODE_MAP_ALIST) ;
476 if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntMinorModeMapAlist, &pEntAlist)) ||
477 TSUCCEEDED (lispEntity_Voidp (pLispMgr, pEntAlist))) {
478 *ppEntRetval = pEntNil ;
479 return True ;
480 }
481 while (TFAILED (lispEntity_Nullp (pLispMgr, pEntAlist))) {
482 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntAlist, &pEntSymbolKeymap)) ||
483 TFAILED (lispEntity_GetCar (pLispMgr, pEntSymbolKeymap, &pEntSymbol)) ||
484 TFAILED (lispEntity_GetCdr (pLispMgr, pEntSymbolKeymap, &pEntKeymap)))
485 break ;
486 if (TSUCCEEDED (lispMachine_GetCurrentSymbolValue (pLM, pEntSymbol, &pEntSymVal)) &&
487 TFAILED (lispEntity_Voidp (pLispMgr, pEntSymVal)))
488 if (TFAILED (lispMachine_addTail (pLispMgr, pEntKeymap, &pEntTop, &pEntTail)))
489 break ;
490 lispEntity_GetCdr (pLispMgr, pEntAlist, &pEntAlist) ;
491 }
492 if (pEntTop == NULL) {
493 *ppEntRetval = pEntNil ;
494 } else {
495 lispEntity_Release (pLispMgr, pEntTop) ;
496 *ppEntRetval = pEntTop ;
497 }
498 return True ;
499 }
500
501 Boolean
lispMachineCode_PushThisCommandKeys(register TLispMachine * pLM,const Char cc)502 lispMachineCode_PushThisCommandKeys (
503 register TLispMachine* pLM,
504 const Char cc)
505 {
506 return TVarbuffer_Add (&pLM->m_vbufCmdEvents, &cc, 1) ;
507 }
508
509 Boolean
lispMachineCode_GetThisCommandKeys(register TLispMachine * pLM,register Char const ** ppString,register int * const pnString)510 lispMachineCode_GetThisCommandKeys (
511 register TLispMachine* pLM,
512 register Char const ** ppString,
513 register int* const pnString)
514 {
515 *ppString = TVarbuffer_GetBuffer (&pLM->m_vbufCmdEvents) ;
516 *pnString = TVarbuffer_GetUsage (&pLM->m_vbufCmdEvents) ;
517 return True ;
518 }
519
520 Boolean
lispMachineCode_ClearThisCommandKeys(register TLispMachine * pLM)521 lispMachineCode_ClearThisCommandKeys (
522 register TLispMachine* pLM)
523 {
524 TVarbuffer_Clear (&pLM->m_vbufCmdEvents) ;
525 return True ;
526 }
527
528 Boolean
lispMachineCode_SetRegmatchTarget(register TLispMachine * pLM,register TLispEntity * pEntTarget)529 lispMachineCode_SetRegmatchTarget (
530 register TLispMachine* pLM,
531 register TLispEntity* pEntTarget)
532 {
533 register TLispManager* pLispMgr ;
534
535 assert (pLM != NULL) ;
536
537 pLispMgr = pLM->m_pLispMgr ;
538 assert (pLispMgr != NULL) ;
539
540 if (pLM->m_pEntRegMatch != NULL)
541 lispEntity_Release (pLispMgr, pLM->m_pEntRegMatch) ;
542 pLM->m_pEntRegMatch = pEntTarget ;
543 if (pEntTarget != NULL)
544 lispEntity_AddRef (pLispMgr, pEntTarget) ;
545 return True ;
546 }
547
548 Boolean
lispMachineCode_StringMatch(register TLispMachine * pLM,register const Char * pStrREGEXP,register int nStrREGEXP,register const Char * pStrSTRING,register int nStrSTRING,register int nStart)549 lispMachineCode_StringMatch (
550 register TLispMachine* pLM,
551 register const Char* pStrREGEXP,
552 register int nStrREGEXP,
553 register const Char* pStrSTRING,
554 register int nStrSTRING,
555 register int nStart)
556 {
557 regex_t re ;
558 Boolean fRetval ;
559 rm_detail_t rd ;
560 register regmatch_t* pMatch ;
561 register int i ;
562
563 assert (pLM != NULL) ;
564 #if defined (DEBUG)
565 fprintf (stderr, "(code) string-match: regexp= \"") ;
566 cputstr (stderr, pStrREGEXP, nStrREGEXP) ;
567 fprintf (stderr, "\"\n") ;
568 fprintf (stderr, "(code) string-match: target= \"") ;
569 cputstr (stderr, pStrSTRING, nStrSTRING) ;
570 fprintf (stderr, "\"\n") ;
571 #endif
572 if (ReComp (&re, pStrREGEXP, nStrREGEXP, REG_EXTENDED | REG_ADVF | REG_NEWLINE) != 0)
573 return False ;
574 pLM->m_aRegMatch [0].rm_so = -1 ;
575 pLM->m_aRegMatch [0].rm_eo = -1 ;
576 fRetval = !ReExec (&re, pStrSTRING + nStart, nStrSTRING - nStart, &rd, MAX_REGEXP_MATCHES, pLM->m_aRegMatch, 0) ;
577 ReFree (&re) ;
578
579 pMatch = pLM->m_aRegMatch ;
580 for (i = 0 ; i < MAX_REGEXP_MATCHES && pMatch->rm_eo >= 0 ; i ++, pMatch ++) {
581 pMatch->rm_so += nStart ;
582 pMatch->rm_eo += nStart ;
583 }
584 return fRetval ;
585 }
586
587 /*
588 *
589 */
590 Boolean
lispMachineCode_SearchForward(register TLispMachine * pLM,register TLispEntity * pEntBuffer,register const Char * pStrPATTERN,register int nStrPATTERN,register int nBOUND,register int nCOUNT)591 lispMachineCode_SearchForward (
592 register TLispMachine* pLM,
593 register TLispEntity* pEntBuffer,
594 register const Char* pStrPATTERN,
595 register int nStrPATTERN,
596 register int nBOUND,
597 register int nCOUNT)
598 {
599 register TLispManager* pLispMgr ;
600 register Boolean fFound ;
601 TBufStringMarker mkBuffer, mkBufferBack ;
602 register int nCheck, nOffset ;
603 int nStrSTRING ;
604 int nPoint, nPointMin, nPointMax, nPointBTop ;
605 register const Char* pPtr ;
606 register int nPtr ;
607
608 pLispMgr = pLM->m_pLispMgr ;
609 assert (pLispMgr != NULL) ;
610 assert (nStrPATTERN >= 0) ;
611 lispMachineCode_SetRegmatchTarget (pLM, pEntBuffer) ;
612 lispBuffer_GetString (pLispMgr, pEntBuffer, &mkBuffer, &nStrSTRING) ;
613 lispBuffer_Point (pLispMgr, pEntBuffer, &nPoint) ;
614 lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nPointBTop) ;
615 lispBuffer_PointMin (pLispMgr, pEntBuffer, &nPointMin) ;
616 lispBuffer_PointMax (pLispMgr, pEntBuffer, &nPointMax) ;
617
618 #if defined (DEBUG)
619 fprintf (stderr, "(code) search-forward: pattern(%d) = \"", nStrPATTERN) ;
620 cputstr (stderr, pStrPATTERN, nStrPATTERN) ;
621 fprintf (stderr, "\", nCount(%d)\n", nCOUNT) ;
622 #endif
623 TBufStringMarker_Forward (&mkBuffer, nPoint - nPointBTop) ;
624 if (nPointMax > nBOUND)
625 nPointMax = nBOUND ;
626 nPtr = nPointMax - nPoint ;
627 nOffset = 0 ;
628 assert (nPtr <= nStrSTRING) ;
629
630 fFound = False ;
631 while (nCOUNT -- > 0) {
632 pLM->m_aRegMatch [0].rm_so = -1 ;
633 pLM->m_aRegMatch [0].rm_eo = -1 ;
634 fFound = False ;
635
636 while (nPtr >= nStrPATTERN && TFAILED (fFound)) {
637 mkBufferBack = mkBuffer ;
638 pPtr = pStrPATTERN ;
639 nCheck = nStrPATTERN ;
640 while (nCheck > 0 && *pPtr == TBufStringMarker_GetChar (&mkBuffer)) {
641 TBufStringMarker_Forward (&mkBuffer, 1) ;
642 pPtr ++ ;
643 nCheck -- ;
644 }
645 if (nCheck == 0) {
646 pLM->m_aRegMatch [0].rm_so = nOffset + nPoint ;
647 pLM->m_aRegMatch [0].rm_eo = nOffset + nPoint + nStrPATTERN ;
648 #if defined (DEBUG)
649 fprintf (stderr, "(search-forward) [%d ... %d]\n",
650 (int)pLM->m_aRegMatch [0].rm_so, (int)pLM->m_aRegMatch [0].rm_eo) ;
651 #endif
652 fFound = True ;
653 }
654 mkBuffer = mkBufferBack ;
655 TBufStringMarker_Forward (&mkBuffer, 1) ;
656 nOffset ++ ;
657 nPtr -- ;
658 }
659 TBufStringMarker_Forward (&mkBuffer, nStrPATTERN) ;
660 nOffset += nStrPATTERN ;
661 nPtr -= nStrPATTERN ;
662 }
663 return fFound ;
664 }
665
666 /*
667 *
668 */
669 Boolean
lispMachineCode_SearchBackward(register TLispMachine * pLM,register TLispEntity * pEntBuffer,register const Char * pStrPATTERN,register int nStrPATTERN,register int nBOUND,register int nCOUNT)670 lispMachineCode_SearchBackward (
671 register TLispMachine* pLM,
672 register TLispEntity* pEntBuffer,
673 register const Char* pStrPATTERN,
674 register int nStrPATTERN,
675 register int nBOUND,
676 register int nCOUNT)
677 {
678 register TLispManager* pLispMgr ;
679 register Boolean fFound ;
680 TBufStringMarker mkBuffer, mkBufferBack ;
681 register int nCheck, nOffset ;
682 int nStrSTRING ;
683 int nPoint, nPointMin, nPointMax, nPointBTop ;
684 register const Char* pPtr ;
685 register int nPtr ;
686
687 pLispMgr = pLM->m_pLispMgr ;
688 assert (pLispMgr != NULL) ;
689 assert (nStrPATTERN >= 0) ;
690 lispMachineCode_SetRegmatchTarget (pLM, pEntBuffer) ;
691 lispBuffer_GetString (pLispMgr, pEntBuffer, &mkBuffer, &nStrSTRING) ;
692 lispBuffer_Point (pLispMgr, pEntBuffer, &nPoint) ;
693 lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nPointBTop) ;
694 lispBuffer_PointMin (pLispMgr, pEntBuffer, &nPointMin) ;
695 lispBuffer_PointMax (pLispMgr, pEntBuffer, &nPointMax) ;
696
697 #if defined (DEBUG)
698 fprintf (stderr, "(code) search-backward: pattern(%d) = \"", nStrPATTERN) ;
699 cputstr (stderr, pStrPATTERN, nStrPATTERN) ;
700 fprintf (stderr, "\"\n") ;
701 fprintf (stderr, "(code) search-backward: target(%d) = \"", nStrSTRING) ;
702 fprintf (stderr, "\"\n") ;
703 fprintf (stderr, "(code) search-backward: (min/-/max) = (%d/%d/%d)\n",
704 nPointMin, nPoint, nPointMax) ;
705 #endif
706 nPoint -- ;
707 TBufStringMarker_Forward (&mkBuffer, nPoint - nPointBTop) ;
708 if (nPointMin < nBOUND)
709 nBOUND = nPointMin ;
710 nPtr = nPoint - nBOUND ;
711 nOffset = 0 ;
712 assert (nPtr <= nStrSTRING) ;
713
714 fFound = False ;
715 while (nCOUNT -- > 0 && nPtr > 0) {
716 pLM->m_aRegMatch [0].rm_so = -1 ;
717 pLM->m_aRegMatch [0].rm_eo = -1 ;
718 fFound = False ;
719
720 while (nPtr >= nStrPATTERN) {
721 mkBufferBack = mkBuffer ;
722 pPtr = pStrPATTERN + nStrPATTERN - 1 ;
723 nCheck = nStrPATTERN ;
724 while (nCheck > 0 && *pPtr == TBufStringMarker_GetChar (&mkBuffer)) {
725 TBufStringMarker_Backward (&mkBuffer, 1) ;
726 pPtr -- ;
727 nCheck -- ;
728 }
729 if (nCheck == 0) {
730 pLM->m_aRegMatch [0].rm_so = nOffset + nPoint - nStrPATTERN ;
731 pLM->m_aRegMatch [0].rm_eo = nOffset + nPoint ;
732 fFound = True ;
733 #if defined (DEBUG)
734 fprintf (stderr, "(search-backward) [%d ... %d]\n",
735 (int) pLM->m_aRegMatch [0].rm_so, (int) pLM->m_aRegMatch [0].rm_eo) ;
736 #endif
737 break ;
738 }
739 mkBuffer = mkBufferBack ;
740 TBufStringMarker_Backward (&mkBuffer, 1) ;
741 nOffset -- ;
742 nPtr -- ;
743 }
744 TBufStringMarker_Backward (&mkBuffer, nStrPATTERN) ;
745 nOffset -= nStrPATTERN ;
746 nPtr -= nStrPATTERN ;
747 }
748 return fFound ;
749 }
750
751 Boolean
lispMachineCode_ReSearchForward(register TLispMachine * pLM,register TLispEntity * pEntBuffer,register const Char * pStrREGEXP,register int nStrREGEXP,register int nBOUND,register int nCOUNT)752 lispMachineCode_ReSearchForward (
753 register TLispMachine* pLM,
754 register TLispEntity* pEntBuffer,
755 register const Char* pStrREGEXP,
756 register int nStrREGEXP,
757 register int nBOUND,
758 register int nCOUNT)
759 {
760 register TLispManager* pLispMgr ;
761 register Boolean fRetval = False ;
762 register int i ;
763 register regmatch_t* pMatch ;
764 regex_t re ;
765 rm_detail_t rd ;
766 TBufStringMarker mkStart, mkStop ;
767 int nStrSTRING ;
768 int nPoint, nPointMin, nPointMax, nPointBTop ;
769 register int nBase, nBaseAdd ;
770
771 assert (pLM != NULL) ;
772 #if defined (DEBUG)
773 fprintf (stderr, "(code) re-search-forward: regexp= \"") ;
774 cputstr (stderr, pStrREGEXP, nStrREGEXP) ;
775 fprintf (stderr, "\"\n") ;
776 #endif
777 if (ReComp (&re, pStrREGEXP, nStrREGEXP, REG_EXTENDED | REG_NEWLINE) != 0)
778 return False ;
779 pLispMgr = pLM->m_pLispMgr ;
780 assert (pLispMgr != NULL) ;
781 lispMachineCode_SetRegmatchTarget (pLM, pEntBuffer) ;
782 lispBuffer_GetString (pLispMgr, pEntBuffer, &mkStart, &nStrSTRING) ;
783 lispBuffer_Point (pLispMgr, pEntBuffer, &nPoint) ;
784 lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nPointBTop) ;
785 lispBuffer_PointMin (pLispMgr, pEntBuffer, &nPointMin) ;
786 lispBuffer_PointMax (pLispMgr, pEntBuffer, &nPointMax) ;
787 #if defined (DEBUG)
788 fprintf (stderr, "(code) re-search-forward: (min/-/max) = (%d/%d/%d)\n",
789 nPointMin, nPoint, nPointMax) ;
790 #endif
791 TBufStringMarker_Forward (&mkStart, nPoint - nPointBTop) ;
792 if (nPointMax > nBOUND)
793 nPointMax = nBOUND ;
794 assert ((nPointMax - nPointBTop) <= nStrSTRING) ;
795 nStrSTRING = nPointMax - nPoint ;
796 if (nStrSTRING <= 0)
797 nStrSTRING = 0 ;
798 mkStop = mkStart ;
799 TBufStringMarker_Forward (&mkStop, nStrSTRING) ;
800
801 nBase = 0 ;
802 nBaseAdd = 0 ;
803 while (nCOUNT -- > 0) {
804 nBase += nBaseAdd ;
805 pLM->m_aRegMatch [0].rm_so = -1 ;
806 pLM->m_aRegMatch [0].rm_eo = -1 ;
807 fRetval = !ReExec_2 (&re, mkStart, mkStop, &rd, MAX_REGEXP_MATCHES, pLM->m_aRegMatch, 0) ;
808 if (TFAILED (fRetval))
809 break ;
810 nBaseAdd = pLM->m_aRegMatch [0].rm_eo ;
811 TBufStringMarker_Forward (&mkStart, nBaseAdd) ;
812 }
813
814 /* pStrSTRING �� buffer-string �� point �������������Τǡ��ҥåȤ���
815 * ���֤ˤϤ���������ɬ�פˤʤ롣
816 */
817 pMatch = pLM->m_aRegMatch ;
818 for (i = 0 ; i < MAX_REGEXP_MATCHES && pMatch->rm_eo >= 0 ; i ++) {
819 pMatch->rm_so ++ ;
820 pMatch->rm_eo ++ ;
821 #if defined (DEBUG)
822 fprintf (stderr, "(%d) [rm_so ... rm_eo] = [%ld ... %ld]\n",
823 i, pMatch->rm_so, pMatch->rm_eo) ;
824 #endif
825 pMatch ++ ;
826 }
827 ReFree (&re) ;
828 return fRetval ;
829 }
830
831 /* re-search-backward ��¸����뤿��δؿ���
832 *
833 * re-search-backward �� re-search-forward ��(�����ǤϤʤ���)�����δط��ˤ��롣
834 * point ����Ƭ����äȤ�ᤤ REGEXP �˰��פ�������֤�������ɽ����õ���ϵ�
835 * �����ˤ��ɤ�ʤ�(���Υ����Ȥ�ʧ���Τ����Τʤ�)�Τǡ�����Ƭ���ᤤ�פȤ���
836 * ����ˤʤ롣
837 * �ǡ��դˤ��ɤ�ʤ��Ȥʤ�� limit ���� point �ޤǽ��֤�õ�����뤷���꤬�ʤ�
838 * �ơ� O(n) �����롣
839 */
840 Boolean
lispMachineCode_ReSearchBackward(register TLispMachine * pLM,register TLispEntity * pEntBuffer,register const Char * pStrREGEXP,register int nStrREGEXP,register int nBOUND,register int nCOUNT)841 lispMachineCode_ReSearchBackward (
842 register TLispMachine* pLM,
843 register TLispEntity* pEntBuffer,
844 register const Char* pStrREGEXP,
845 register int nStrREGEXP,
846 register int nBOUND,
847 register int nCOUNT)
848 {
849 register TLispManager* pLispMgr ;
850 register Boolean fRetval = False ;
851 register regmatch_t* pMatch ;
852 register int nForward, nHit, n, i ;
853 regmatch_t match ;
854 TVarbuffer vbufMatch ;
855 regex_t re ;
856 rm_detail_t rd ;
857 TBufStringMarker mkStart, mkStop ;
858 int nStrSTRING ;
859 int nPoint, nPointMin, nPointMax, nPointBTop ;
860
861 assert (pLM != NULL) ;
862
863 #if defined (DEBUG)
864 fprintf (stderr, "(code) re-search-backward: regexp= \"") ;
865 cputstr (stderr, pStrREGEXP, nStrREGEXP) ;
866 fprintf (stderr, "\"\n") ;
867 #endif
868
869 if (TFAILED (TVarbuffer_Initialize (&vbufMatch, sizeof (regmatch_t))) ||
870 TFAILED (TVarbuffer_Require (&vbufMatch, nCOUNT)))
871 return False ;
872 if (ReComp (&re, pStrREGEXP, nStrREGEXP, REG_EXTENDED | REG_NEWLINE) != 0) {
873 TVarbuffer_Uninitialize (&vbufMatch) ;
874 return False ;
875 }
876 pLispMgr = pLM->m_pLispMgr ;
877 assert (pLispMgr != NULL) ;
878
879 lispMachineCode_SetRegmatchTarget (pLM, pEntBuffer) ;
880 lispBuffer_GetString (pLispMgr, pEntBuffer, &mkStart, &nStrSTRING) ;
881 lispBuffer_Point (pLispMgr, pEntBuffer, &nPoint) ;
882 lispBuffer_PointBufferTop (pLispMgr, pEntBuffer, &nPointBTop) ;
883 lispBuffer_PointMin (pLispMgr, pEntBuffer, &nPointMin) ;
884 lispBuffer_PointMax (pLispMgr, pEntBuffer, &nPointMax) ;
885 #if defined (DEBUG)
886 fprintf (stderr, "(code) re-search-backward: (min/-/max) = (%d/%d/%d)\n",
887 nPointMin, nPoint, nPointMax) ;
888 #endif
889
890 /* õ���γ��ϰ��֤� nBOUND �ǻ��ꤵ��롣
891 */
892 if (nBOUND < nPointMin)
893 nBOUND = nPointMin ;
894 TBufStringMarker_Forward (&mkStart, nBOUND - nPointBTop) ;
895
896 assert (nStrSTRING > (nPoint - nBOUND)) ;
897 nStrSTRING = nPoint - nBOUND ;
898 if (nStrSTRING <= 0)
899 nStrSTRING = 0 ;
900 mkStop = mkStart ;
901 TBufStringMarker_Forward (&mkStop, nStrSTRING) ;
902
903 pMatch = TVarbuffer_GetBuffer (&vbufMatch) ;
904 for (nHit = 0 ; ; nHit ++) {
905 n = nHit % nCOUNT ;
906 match.rm_so = -1 ;
907 match.rm_eo = -1 ;
908 fRetval = !ReExec_2 (&re, mkStart, mkStop, &rd, 1, &match, 0) ;
909 if (TFAILED (fRetval) || match.rm_so < 0)
910 break ;
911 memcpy (pMatch + n, &match, sizeof (regmatch_t)) ;
912 nForward = match.rm_eo - TBufStringMarker_GetOffset (&mkStart) ;
913 assert (nForward > 0) ;
914 TBufStringMarker_Forward (&mkStart, nForward) ;
915 }
916 /* ���٤�ҥåȤ��ʤ���С�NOT_MATCH ���֤���
917 */
918 if (nHit <= 0)
919 goto not_hit ;
920
921 if (nHit < nCOUNT) {
922 nHit = 0 ;
923 } else {
924 nHit = (nHit - nCOUNT) % nCOUNT ;
925 }
926 assert (0 <= nHit && nHit < nCOUNT) ;
927 nForward = (pMatch + nHit)->rm_so - TBufStringMarker_GetOffset (&mkStart) ;
928 TBufStringMarker_Forward (&mkStart, nForward) ;
929 nForward = (pMatch + nHit)->rm_eo - TBufStringMarker_GetOffset (&mkStop) ;
930 TBufStringMarker_Forward (&mkStop, nForward) ;
931 /* �����������˥ޥå������롣��������Submatch ���ɤ줯�餤����Τ�ʬ����ʤ�����
932 * ���ʤ��ᤷ�����⡣
933 */
934 fRetval = !exec_2 (&re, mkStart, mkStop, &rd, MAX_REGEXP_MATCHES, pLM->m_aRegMatch, 0) ;
935 assert (TSUCCEEDED (fRetval)) ;
936
937 /* pStrSTRING �� buffer-string �� point �������������Τǡ��ҥåȤ���
938 * ���֤ˤϤ���������ɬ�פˤʤ롣
939 */
940 pMatch = pLM->m_aRegMatch ;
941 for (i = 0 ; i < MAX_REGEXP_MATCHES && pMatch->rm_eo >= 0 ; i ++) {
942 pMatch->rm_so ++ ;
943 pMatch->rm_eo ++ ;
944 #if defined (DEBUG)
945 fprintf (stderr, "(%d) [rm_so ... rm_eo] = [%ld ... %ld]\n",
946 i, pMatch->rm_so, pMatch->rm_eo) ;
947 #endif
948 pMatch ++ ;
949 }
950 not_hit:
951 ReFree (&re) ;
952 TVarbuffer_Uninitialize (&vbufMatch) ;
953 return fRetval ;
954 }
955
956 Boolean
lispMachineCode_MatchBeginning(register TLispMachine * pLM,register int nSubexp,register int * pnRetval)957 lispMachineCode_MatchBeginning (
958 register TLispMachine* pLM,
959 register int nSubexp,
960 register int* pnRetval)
961 {
962 assert (pLM != NULL) ;
963 assert (pnRetval != NULL) ;
964 if (nSubexp < 0 || nSubexp >= MAX_REGEXP_MATCHES ||
965 pLM->m_aRegMatch [nSubexp].rm_so < 0)
966 return False ;
967 *pnRetval = pLM->m_aRegMatch [nSubexp].rm_so ;
968 return True ;
969 }
970
971 Boolean
lispMachineCode_MatchEnd(register TLispMachine * pLM,register int nSubexp,register int * pnRetval)972 lispMachineCode_MatchEnd (
973 register TLispMachine* pLM,
974 register int nSubexp,
975 register int* pnRetval)
976 {
977 assert (pLM != NULL) ;
978 assert (pnRetval != NULL) ;
979 if (nSubexp < 0 || nSubexp >= MAX_REGEXP_MATCHES ||
980 pLM->m_aRegMatch [nSubexp].rm_eo < 0)
981 return False ;
982 *pnRetval = pLM->m_aRegMatch [nSubexp].rm_eo ;
983 return True ;
984 }
985
986 Boolean
lispMachineCode_MatchData(register TLispMachine * pLM,register TLispEntity ** ppEntRetval)987 lispMachineCode_MatchData (
988 register TLispMachine* pLM,
989 register TLispEntity** ppEntRetval)
990 {
991 register TLispManager* pLispMgr = pLM->m_pLispMgr ;
992 register regmatch_t* pMatch ;
993 register int i ;
994 TLispEntity* pEntTop ;
995 TLispEntity* pEntTail ;
996 TLispEntity* pEntPosition ;
997
998 pEntTop = NULL ;
999 pEntTail = NULL ;
1000 pMatch = pLM->m_aRegMatch ;
1001 for ( i = 0 ; i < MAX_REGEXP_MATCHES ; i ++, pMatch ++) {
1002 if (pMatch->rm_so < 0)
1003 break ;
1004 if (TFAILED (lispMgr_CreateInteger (pLispMgr, pMatch->rm_so, &pEntPosition)))
1005 return False ;
1006 lispMachine_addTail (pLispMgr, pEntPosition, &pEntTop, &pEntTail) ;
1007 if (TFAILED (lispMgr_CreateInteger (pLispMgr, pMatch->rm_eo, &pEntPosition)))
1008 return False ;
1009 lispMachine_addTail (pLispMgr, pEntPosition, &pEntTop, &pEntTail) ;
1010 }
1011 if (pEntTop == NULL) {
1012 lispMgr_CreateNil (pLispMgr, ppEntRetval) ;
1013 } else {
1014 lispEntity_Release (pLispMgr, pEntTop) ;
1015 *ppEntRetval = pEntTop ;
1016 }
1017 return True ;
1018 }
1019
1020 Boolean
lispMachineCode_CreateMarker(register TLispMachine * pLM,register TLispEntity * pEntBuffer,register int nPosition,register TLispEntity ** ppEntRetval)1021 lispMachineCode_CreateMarker (
1022 register TLispMachine* pLM,
1023 register TLispEntity* pEntBuffer,
1024 register int nPosition,
1025 register TLispEntity** ppEntRetval)
1026 {
1027 register TLispManager* pLispMgr = pLM->m_pLispMgr ;
1028 TLispEntity* pEntMarker ;
1029
1030 assert (pLM != NULL) ;
1031 assert (pLispMgr != NULL) ;
1032 assert (ppEntRetval != NULL) ;
1033
1034 if (TFAILED (lispMgr_CreateMarker (pLispMgr, &pEntMarker)))
1035 return False ;
1036 if (pEntBuffer != NULL) {
1037 lispBuffer_AddMarker (pLispMgr, pEntBuffer, pEntMarker) ;
1038 lispMarker_SetBufferPosition (pLispMgr, pEntMarker, pEntBuffer, nPosition) ;
1039 }
1040 *ppEntRetval = pEntMarker ;
1041 return True ;
1042 }
1043
1044 Boolean
lispMachineCode_Featurep(register TLispMachine * pLM,register TLispEntity * pEntFeature)1045 lispMachineCode_Featurep (
1046 register TLispMachine* pLM,
1047 register TLispEntity* pEntFeature)
1048 {
1049 register TLispManager* pLispMgr = pLM->m_pLispMgr ;
1050 register TLispEntity* pEntFeatures ;
1051 TLispEntity* pEntCar ;
1052 TLispEntity* pValFeatures ;
1053
1054 pEntFeatures = lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_FEATURES) ;
1055 if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntFeatures, &pValFeatures)) ||
1056 TSUCCEEDED (lispEntity_Voidp (pLispMgr, pValFeatures)))
1057 return False ;
1058
1059 while (TFAILED (lispEntity_Nullp (pLispMgr, pValFeatures))) {
1060 if (TFAILED (lispEntity_GetCar (pLispMgr, pValFeatures, &pEntCar)) ||
1061 TFAILED (lispEntity_GetCdr (pLispMgr, pValFeatures, &pValFeatures)))
1062 return False ;
1063 if (TSUCCEEDED (lispEntity_Eq (pLispMgr, pEntCar, pEntFeature))) {
1064 return True ;
1065 }
1066 }
1067 return False ;
1068 }
1069
1070 Boolean
lispMachineCode_Provide(register TLispMachine * pLM,register TLispEntity * pEntFeature)1071 lispMachineCode_Provide (
1072 register TLispMachine* pLM,
1073 register TLispEntity* pEntFeature)
1074 {
1075 register TLispManager* pLispMgr = pLM->m_pLispMgr ;
1076 register TLispEntity* pEntFeatures ;
1077 TLispEntity* pValFeatures ;
1078 TLispEntity* pEntity ;
1079
1080 if (TSUCCEEDED (lispMachineCode_Featurep (pLM, pEntFeature)))
1081 return True ;
1082
1083 pEntFeatures = lispMgr_GetReservedEntity (pLispMgr, LISPMGR_INDEX_FEATURES) ;
1084 if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntFeatures, &pValFeatures)) ||
1085 TSUCCEEDED (lispEntity_Voidp (pLispMgr, pValFeatures)))
1086 lispMgr_CreateNil (pLispMgr, &pValFeatures) ;
1087 if (TFAILED (lispMgr_CreateConscell (pLispMgr, pEntFeature, pValFeatures, &pEntity)))
1088 return False ;
1089 return lispMachine_SetCurrentSymbolValue (pLM, pEntFeatures, pEntity) ;
1090 }
1091
1092 /* private functions */
1093 Boolean
lispMachine_addTail(register TLispManager * pLispMgr,register TLispEntity * pEntElement,register TLispEntity ** ppEntTop,register TLispEntity ** ppEntTail)1094 lispMachine_addTail (
1095 register TLispManager* pLispMgr,
1096 register TLispEntity* pEntElement,
1097 register TLispEntity** ppEntTop,
1098 register TLispEntity** ppEntTail)
1099 {
1100 register TLispEntity* pEntTail ;
1101 TLispEntity* pEntNil ;
1102 TLispEntity* pEntNewTail ;
1103
1104 assert (pLispMgr != NULL) ;
1105 assert (pEntElement != NULL) ;
1106 assert (ppEntTop != NULL) ;
1107 assert (ppEntTail != NULL) ;
1108
1109 lispMgr_CreateNil (pLispMgr, &pEntNil) ;
1110 if (TFAILED (lispMgr_CreateConscell (pLispMgr, pEntElement, pEntNil, &pEntNewTail)))
1111 return False ;
1112 pEntTail = *ppEntTail ;
1113 if (pEntTail == NULL) {
1114 assert (*ppEntTop == NULL) ;
1115 *ppEntTop = pEntNewTail ;
1116 lispEntity_AddRef (pLispMgr, pEntNewTail) ;
1117 } else {
1118 if (TFAILED (lispEntity_SetCdr (pLispMgr, pEntTail, pEntNewTail)))
1119 return False ;
1120 }
1121 *ppEntTail = pEntNewTail ;
1122 return True ;
1123 }
1124
1125 #if defined (DEBUG)
1126 void
cputstr(register FILE * pFile,register const Char * pString,register int nLength)1127 cputstr (
1128 register FILE* pFile,
1129 register const Char* pString,
1130 register int nLength)
1131 {
1132 KANJISTATEMACHINE ksm ;
1133 int n ;
1134 char achBuf [16] ;
1135
1136 InitializeKanjiFiniteStateMachine (&ksm, KCODING_SYSTEM_SHIFTJIS) ;
1137 while (nLength > 0) {
1138 n = RtransferKanjiFiniteStateMachine (&ksm, *pString ++, achBuf) ;
1139 achBuf [n] = '\0' ;
1140 fprintf (pFile, "%s", achBuf) ;
1141 nLength -- ;
1142 }
1143 return ;
1144 }
1145 #endif
1146
1147
1148