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 
26 static	TLMRESULT	lispMachineState_evalLambdaArgFin		(TLispMachine*) ;
27 static	TLMRESULT	lispMachineState_evalArgStep1			(TLispMachine*) ;
28 static	TLMRESULT	lispMachineState_evalArgStep2			(TLispMachine*) ;
29 static	TLMRESULT	lispMachineState_evalArgStep3			(TLispMachine*) ;
30 static	TLMRESULT	lispMachineState_mapcarListApply		(TLispMachine*) ;
31 static	TLMRESULT	lispMachineState_mapcarListPostApply	(TLispMachine*) ;
32 static	TLMRESULT	lispMachineState_mapcarVectorApply		(TLispMachine*) ;
33 static	TLMRESULT	lispMachineState_mapcarVectorPostApply	(TLispMachine*) ;
34 static	TLMRESULT	lispMachineState_mapcarStringApply		(TLispMachine*) ;
35 static	TLMRESULT	lispMachineState_mapcarStringPostApply	(TLispMachine*) ;
36 static	TLMRESULT	lispMachineState_mapcarPostApplyCommon	(TLispMachine*, TLMRESULT (*)(TLispMachine*)) ;
37 static	TLMRESULT	lispMachineState_mapcarFinalize			(TLispMachine*) ;
38 static	TLMRESULT	lispMachineState_runHooksStep			(TLispMachine*) ;
39 static	TLMRESULT	lispMachineState_runHooksStep2			(TLispMachine*) ;
40 static	TLMRESULT	lispMachineState_runHooksStep3			(TLispMachine*) ;
41 static	TLMRESULT	lispMachineState_runHooksFinalize		(TLispMachine*) ;
42 
43 static	TLMRESULT	lispMachine_evalSubr					(TLispMachine*, TLispEntity*, TLispEntity*) ;
44 static	TLMRESULT	lispMachine_evalLambdaOrMacro			(TLispMachine*, TLispEntity*, TLispEntity*) ;
45 
46 /*
47  *	(eval FORM)
48  *
49  *	FORM ��ɾ�����ơ������ͤ��֤���
50  */
51 TLMRESULT
lispMachineState_Eval(register TLispMachine * pLM)52 lispMachineState_Eval (
53 	register TLispMachine* pLM)
54 {
55 	TLispEntity*	pArglist ;
56 	TLispEntity*	pArg ;
57 
58 	assert (pLM != NULL) ;
59 
60 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pArglist) ;
61 	if (TFAILED (lispEntity_GetCar (pLM->m_pLispMgr, pArglist, &pArg))) {
62 		lispMachineCode_SetError (pLM) ;
63 		return	LMR_RETURN ;
64 	}
65 	lispMachineCode_Evaln (pLM, pArg, &lispMachineState_ReturnOnly) ;
66 	return	LMR_CONTINUE ;
67 }
68 
69 /*
70  *	�ǽ�ΰ�����ؿ��Ȥ��ƸƤӽФ����Ĥ�ϰ����Ȥ��Ƥ��δؿ����Ϥ���
71  *	�ؿ����֤����ͤ��֤���롣�㤨�С�
72  *	(funcall 'cons 'x 'y) �� (x . y) ���֤���
73  */
74 TLMRESULT
lispMachineState_Funcall(register TLispMachine * pLM)75 lispMachineState_Funcall (
76 	register TLispMachine* pLM)
77 {
78 	register TLispManager*	pLispMgr ;
79 	TLispEntity*		pTarget ;
80 	TLispEntity*		pCar ;
81 	TLispEntity*		pFunc ;
82 	TLispEntity*		pArglist ;
83 	LMCMDINFO const*	pProcInfo ;
84 	int					nArg ;
85 
86 	assert (pLM != NULL) ;
87 	pLispMgr	= pLM->m_pLispMgr ;
88 	assert (pLispMgr != NULL) ;
89 
90 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pTarget) ;
91 #if defined (DEBUG)
92 	fprintf (stderr, "funcall = ") ;
93 	lispEntity_Print (pLispMgr, pTarget) ;
94 	fprintf (stderr, "\n") ;
95 #endif
96 	if (TFAILED (lispEntity_GetCar (pLispMgr, pTarget, &pCar)))
97 		goto	error ;
98 	if (TFAILED (lispMachine_GetSymbolFunctionValue (pLM, pCar, &pFunc)))
99 		goto	error ;
100 
101 	if (TSUCCEEDED (lispEntity_Symbolp (pLispMgr, pFunc))) {
102 		/*	symbol-fucntion �� symbol �ʤ�С�����ˤ��ɤ�ɬ�פ����롣
103 		 *	�����롼�פˤʤäƤ����ǽ��������ΤǾ�¤�ɬ�ס�*/
104 		if (TFAILED (lispMachine_GetFinalSymbolFunctionValue (pLM, pFunc, &pFunc)))
105 			goto	error ;
106 	}
107 	if (TSUCCEEDED (lispEntity_Consp (pLispMgr, pFunc))) {
108 		TLispEntity*	pCdr ;
109 		assert (pFunc != NULL) ;
110 
111 		if (TFAILED (lispEntity_GetCdr (pLispMgr, pTarget, &pCdr)))
112 			goto	error ;
113 		if (TFAILED (lispMgr_CreateConscell (pLispMgr, pFunc, pCdr, &pTarget)) ||
114 			pTarget == NULL)
115 			return	LMR_ERROR ;
116 
117 		/*	defun �ˤ�ä��������Ƥ���ؿ��ξ��ˤϡ������������Ƥ���
118 		 *	��� (lambda��) ������ɾ���оݤ��ѹ����롣*/
119 		lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pTarget) ;
120 		if (TFAILED (lispMachine_GetSymbolFunctionValue (pLM, pFunc, &pFunc)))
121 			goto	error ;
122 	}
123 	if (TFAILED (lispSubr_GetProc (pLispMgr, pFunc, &pProcInfo)) ||
124 		TFAILED (lispEntity_GetCdr (pLispMgr, pTarget, &pArglist)) ||
125 		TFAILED (lispMachine_CheckArgument (pLM, pArglist, pProcInfo, &nArg)))
126 		goto	error ;
127 	switch (pProcInfo->m_iArgtype) {
128 	case	LISPCMD_ARGTYPE_CDR:
129 	case	LISPCMD_ARGTYPE_MACRO:
130 		goto	error ;
131 
132 	case	LISPCMD_ARGTYPE_LAMBDA:
133 	case	LISPCMD_ARGTYPE_SPECIAL:
134 		lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pTarget) ;
135 		break ;
136 	default:
137 		lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pArglist) ;
138 		lispMachineCode_SetInteractive (pLM, False) ;
139 		break ;
140 	}
141 	lispMachineCode_SetState (pLM, pProcInfo->m_pProc) ;
142 	return	LMR_CONTINUE ;
143 
144   error:
145 	lispMachineCode_SetError (pLM) ;
146 	return	LMR_RETURN ;
147 }
148 
149 /*
150  *	FUNCTION ��Ĥ�ΰ����Ǥ�äƸƤӽФ������������Ǹ�ΰ���
151  *	�ϥꥹ�ȤǤ��롣FUNCTION ���֤��ͤ���apply ���֤��ͤǤ��롣
152  *	�㤨�С�(apply '+ 1 2 '(3 4)) �� 10 ���֤���
153  */
154 TLMRESULT
lispMachineState_Apply(register TLispMachine * pLM)155 lispMachineState_Apply (
156 	register TLispMachine*	pLM)
157 {
158 	TLispManager*	pLispMgr ;
159 	TLispEntity*	pList ;
160 	TLispEntity*	pTopofList ;
161 	TLispEntity*	pPrevList ;
162 	TLispEntity*	pLastArg ;
163 
164 	assert (pLM != NULL) ;
165 
166 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pList) ;
167 	pTopofList	= pList ;
168 	pLispMgr	= pLM->m_pLispMgr ;
169 	assert (pLispMgr != NULL) ;
170 #if defined (DEBUG)
171 	fprintf (stderr, "apply => ") ;
172 	lispEntity_Print (pLispMgr, pTopofList) ;
173 	fprintf (stderr, "\n") ;
174 #endif
175 
176 	pPrevList	= NULL ;
177 	for ( ; ; ) {
178 		TLispEntity*	pNextList ;
179 		if (TFAILED (lispEntity_GetCdr (pLispMgr, pList, &pNextList)) ||
180 			TSUCCEEDED (lispEntity_Nullp (pLispMgr, pNextList)))
181 			break ;
182 		pPrevList	= pList ;
183 		pList		= pNextList ;
184 	}
185 	if (TFAILED (lispEntity_GetCar (pLispMgr, pList, &pLastArg)) ||
186 		TFAILED (lispEntity_Listp  (pLispMgr, pLastArg))) {
187 		lispMachineCode_SetError (pLM) ;
188 		return	LMR_RETURN ;
189 	}
190 	if (pPrevList != NULL) {
191 		lispEntity_SetCdr (pLispMgr, pPrevList, pLastArg) ;
192 	} else {
193 		pTopofList	= pLastArg ;
194 	}
195 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pTopofList) ;
196 	lispMachineCode_SetState (pLM, &lispMachineState_Funcall) ;
197 #if defined (DEBUG)
198 	fprintf (stderr, "=> ") ;
199 	lispEntity_Print (pLispMgr, pTopofList) ;
200 	fprintf (stderr, "\n") ;
201 #endif
202 	return	LMR_CONTINUE ;
203 }
204 
205 /*
206  *	(run-hooks &rest HOOKS)
207  *
208  *	HOOKS ����� hook ���줾���¹Ԥ��롣Major mode function ������
209  *	�����Ѥ��롣�����Τ��줾��ϥ���ܥ롢hook �ѿ��Ǥ��롣������
210  *	����ܥ�ϻ��ꤷ�����֤˽�������롣�⤷ hook ����ܥ뤬 non-nil
211  *	���ͤ���äƤ���С������ͤ� function �Ǥ��뤫 function �Υꥹ��
212  *	�Ǥ��롣
213  *	�⤷�ͤ� function �Ǥ���С������ʤ��˸ƤФ�롣�⤷���ꥹ�Ȥ�
214  *	����С��������Ǥ����֤˰���̵���˸ƤФ�롣
215  */
216 TLMRESULT
lispMachineState_RunHooks(register TLispMachine * pLM)217 lispMachineState_RunHooks (
218 	register TLispMachine* pLM)
219 {
220 	register TLispManager*	pLispMgr ;
221 	TLispEntity*	pEntArglist ;
222 
223 	assert (pLM != NULL) ;
224 	pLispMgr	= pLM->m_pLispMgr ;
225 	assert (pLispMgr != NULL) ;
226 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
227 	assert (pEntArglist != NULL) ;
228 	lispMachineCode_PushLReg (pLM, LM_LREG_1) ;
229 	lispMachineCode_PushLReg (pLM, LM_LREG_2) ;
230 	lispMachineCode_SetLReg  (pLM, LM_LREG_1, pEntArglist) ;
231 	lispMachineCode_SetState (pLM, &lispMachineState_runHooksStep) ;
232 	return	LMR_CONTINUE ;
233 }
234 
235 /*
236  *	(fboundp SYMBOL)
237  */
238 TLMRESULT
lispMachineState_Fboundp(register TLispMachine * pLM)239 lispMachineState_Fboundp (
240 	register TLispMachine* pLM)
241 {
242 	register TLispManager*	pLispMgr ;
243 	TLispEntity*			pEntArglist ;
244 	TLispEntity*			pEntFunc ;
245 	TLispEntity*			pEntSymbol ;
246 	TLispEntity*			pEntRetval ;
247 
248 	assert (pLM != NULL) ;
249 	pLispMgr	= pLM->m_pLispMgr ;
250 	assert (pLispMgr != NULL) ;
251 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
252 	assert (pEntArglist != NULL) ;
253 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pEntArglist, &pEntSymbol)) ||
254 		TFAILED (lispEntity_Symbolp (pLispMgr, pEntSymbol))) {
255 		lispMachineCode_SetError (pLM) ;
256 		return	LMR_RETURN ;
257 	}
258 	/*	�桼������ؿ��ˤʤ���Ĵ�٤롣*/
259 	if (TSUCCEEDED (lispMachine_GetSymbolFunctionValue (pLM, pEntSymbol, &pEntFunc)) &&
260 		TFAILED (lispEntity_Voidp (pLispMgr, pEntFunc))) {
261 		lispMgr_CreateT   (pLispMgr, &pEntRetval) ;
262 	} else {
263 		lispMgr_CreateNil (pLispMgr, &pEntRetval) ;
264 	}
265 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
266 	return	LMR_RETURN ;
267 }
268 
269 /*
270  *	(symbol-function SYMBOL)
271  *
272  *	SYMBOL �δؿ�������֤����⤷ void �ʤ� Error �ˤʤ롣
273  */
274 TLMRESULT
lispMachineState_SymbolFunction(register TLispMachine * pLM)275 lispMachineState_SymbolFunction (
276 	register TLispMachine* pLM)
277 {
278 	register TLispManager*	pLispMgr ;
279 	TLispEntity*			pEntArglist ;
280 	TLispEntity*			pEntFunc ;
281 	TLispEntity*			pEntSymbol ;
282 
283 	assert (pLM != NULL) ;
284 	pLispMgr	= pLM->m_pLispMgr ;
285 	assert (pLispMgr != NULL) ;
286 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
287 	assert (pEntArglist != NULL) ;
288 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pEntArglist, &pEntSymbol)) ||
289 		TFAILED (lispEntity_Symbolp (pLispMgr, pEntSymbol))) {
290 		lispMachineCode_SetError (pLM) ;
291 		return	LMR_RETURN ;
292 	}
293 	/*	�桼������ؿ��ˤʤ���Ĵ�٤롣*/
294 	if (TFAILED (lispMachine_GetSymbolFunctionValue (pLM, pEntSymbol, &pEntFunc)) ||
295 		TSUCCEEDED (lispEntity_Voidp (pLispMgr, pEntFunc))) {
296 		lispMachineCode_SetError (pLM) ;
297 	} else {
298 		lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntFunc) ;
299 	}
300 	return	LMR_RETURN ;
301 }
302 
303 /*
304  *	(mapcar FUNCTION SEQUENCE)
305  *
306  *	SEQUENCE �� element �ơ��� FUNCTION �� apply ����result �Υꥹ��
307  *	���롣result �� SEQUENCE ��Ʊ��Ĺ���Υꥹ�Ȥˤʤ롣SEQUENCE ��
308  *	�ꥹ�ȡ��٥��ȥ�ޤ��� bool-vector �ޤ��� string �Ǥ��롣
309  */
310 TLMRESULT
lispMachineState_Mapcar(register TLispMachine * pLM)311 lispMachineState_Mapcar (
312 	register TLispMachine* pLM)
313 {
314 	register TLispManager*	pLispMgr ;
315 	TLispEntity*	pArglist ;
316 	TLispEntity*	pFunction ;
317 	TLispEntity*	pSequence ;
318 	TLispEntity*	pFunclist ;
319 	TLispEntity*	pFunctail ;
320 	TLispEntity*	pNil ;
321 	int			iType ;
322 
323 	assert (pLM != NULL) ;
324 	pLispMgr	= pLM->m_pLispMgr ;
325 	assert (pLispMgr != NULL) ;
326 
327 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pArglist) ;
328 	if (TFAILED (lispEntity_GetCar  (pLispMgr, pArglist, &pFunction)) ||
329 		TFAILED (lispEntity_GetCadr (pLispMgr, pArglist, &pSequence)) ||
330 		TFAILED (lispEntity_GetType (pLispMgr, pSequence, &iType))) {
331 		lispMachineCode_SetError (pLM) ;
332 		return	LMR_RETURN ;
333 	}
334 	switch (iType) {
335 	case	LISPENTITY_CONSCELL:
336 		lispMachineCode_SetState (pLM, &lispMachineState_mapcarListApply) ;
337 		break ;
338 	case	LISPENTITY_VECTOR:
339 		lispMachineCode_SetState (pLM, &lispMachineState_mapcarVectorApply) ;
340 		break ;
341 	case	LISPENTITY_STRING:
342 		lispMachineCode_SetState (pLM, &lispMachineState_mapcarStringApply) ;
343 		break ;
344 	case	LISPENTITY_SYMBOL:
345 		if (TSUCCEEDED (lispEntity_Symbolp (pLispMgr, pSequence))) {
346 			lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pSequence) ;
347 			return	LMR_RETURN ;
348 		}
349 	case	LISPENTITY_BOOLVECTOR:
350 	default:
351 		lispMachineCode_SetError (pLM) ;
352 		return	LMR_RETURN ;
353 	}
354 
355 	lispMachineCode_PushLReg (pLM, LM_LREG_1) ;
356 	lispMachineCode_PushLReg (pLM, LM_LREG_2) ;
357 	lispMachineCode_PushLReg (pLM, LM_LREG_3) ;
358 	lispMachineCode_PushLReg (pLM, LM_LREG_4) ;
359 	lispMachineCode_PushLReg (pLM, LM_LREG_5) ;
360 
361 	lispMgr_CreateNil      (pLispMgr, &pNil) ;
362 	if (TFAILED (lispMgr_CreateConscell (pLispMgr, pNil, pNil, &pFunctail)))
363 		return	LMR_ERROR ;
364 	lispMachineCode_SetLReg  (pLM, LM_LREG_2, pFunctail) ;
365 	if (TFAILED (lispMgr_CreateConscell (pLispMgr, pFunction, pFunctail, &pFunclist)))
366 		return	LMR_ERROR ;
367 	lispMachineCode_SetLReg  (pLM, LM_LREG_1, pFunclist) ;
368 	lispMachineCode_SetLReg  (pLM, LM_LREG_3, pSequence) ;
369 	lispMachineCode_SetLReg  (pLM, LM_LREG_4, pNil) ;
370 	lispMachineCode_SetLReg  (pLM, LM_LREG_5, pNil) ;
371 
372 	lispMachineCode_PushVReg (pLM, LM_VREG_1) ;
373 	lispMachineCode_SetVRegI (pLM, LM_VREG_1, 0) ;
374 	return	LMR_CONTINUE ;
375 }
376 
377 TLMRESULT
lispMachineState_Evaluate(register TLispMachine * pLM)378 lispMachineState_Evaluate (
379 	register TLispMachine* pLM)
380 {
381 	TLispEntity*		pTarget ;
382 	int			iType ;
383 
384 	assert (pLM != NULL) ;
385 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pTarget) ;
386 	assert (pTarget != NULL) ;
387 	assert (pLM->m_pLispMgr != NULL) ;
388 
389 	if (TFAILED (lispEntity_GetType (pLM->m_pLispMgr, pTarget, &iType))) {
390 		lispMachineCode_SetError (pLM) ;
391 		/*	������� State �����äƤ���Τǡ�CONTINUE �Ǥ��롣*/
392 		return	LMR_CONTINUE ;
393 	}
394 
395 	switch (iType) {
396 	case	LISPENTITY_SYMBOL:
397 		lispMachineCode_PushState (pLM, pLM->m_pState) ;
398 		lispMachineCode_SetState  (pLM, &lispMachineState_EvalSymbol) ;
399 		return	LMR_CONTINUE ;
400 
401 	case	LISPENTITY_CONSCELL:
402 		lispMachineCode_PushState (pLM, pLM->m_pState) ;
403 		lispMachineCode_SetState  (pLM, &lispMachineState_EvalCons) ;
404 		return	LMR_CONTINUE ;
405 
406 	case	LISPENTITY_INTEGER:
407 	case	LISPENTITY_FLOAT:
408 	case	LISPENTITY_VECTOR:
409 	case	LISPENTITY_MARKER:
410 	case	LISPENTITY_BUFFER:
411 	case	LISPENTITY_STRING:
412 	default:
413 		return	LMR_CONTINUE ;
414 	}
415 }
416 
417 TLMRESULT
lispMachineState_EvalSymbol(register TLispMachine * pLM)418 lispMachineState_EvalSymbol (
419 	register TLispMachine*	pLM)
420 {
421 	register TLispManager*	pLispMgr ;
422 	TLispEntity*	pTarget ;
423 	TLispEntity*	pReturn ;
424 
425 	assert (pLM      != NULL) ;
426 	pLispMgr	= pLM->m_pLispMgr ;
427 	assert (pLispMgr != NULL) ;
428 
429 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pTarget) ;
430 
431 	if (TFAILED (lispMgr_SymbolRequireEvalp (pLispMgr, pTarget)))
432 		return	LMR_RETURN ;
433 
434 	if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pTarget, &pReturn)) ||
435 		TSUCCEEDED (lispEntity_Voidp (pLispMgr, pReturn))) {
436 		lispMachineCode_SetError (pLM) ;
437 		return	LMR_RETURN ;
438 	}
439 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pReturn) ;
440 	return	LMR_RETURN ;
441 }
442 
443 /*
444  *	EVAL ���褦�Ȥ��Ƥ����оݤ� ACC �����äƤ����Τȹͤ��롣
445  *	���� ACC ���֤��ͤˤ�ʤ�Τǡ�̵������¸����ɬ�פϤʤ����ɡ�
446  *	������ɾ�����Ƥ����ʳ��� EVAL ��ɬ�פˤʤ뤫���ɤ�Ʊ�����⡣
447  */
448 TLMRESULT
lispMachineState_EvalCons(register TLispMachine * pLM)449 lispMachineState_EvalCons (
450 	register TLispMachine* pLM)
451 {
452 	register TLispManager*	pLispMgr ;
453 	TLispEntity*			pEntTarget ;
454 	TLispEntity*			pEntCar ;
455 	TLispEntity*			pEntFunc ;
456 
457 	pLispMgr	= pLM->m_pLispMgr ;
458 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntTarget) ;
459 
460 	if (TFAILED (lispEntity_GetCar (pLispMgr, pEntTarget, &pEntCar)) ||
461 		TFAILED (lispMachine_GetSymbolFunctionValue (pLM, pEntCar, &pEntFunc))) {
462 #if defined (DEBUG) || 1
463 		fprintf (stderr, "Symbol's function value is void: ") ;
464 		lispEntity_Print (pLispMgr, pEntCar) ;
465 		fprintf (stderr, "\n") ;
466 #endif
467 		lispMachineCode_SetError (pLM) ;
468 		return	LMR_RETURN ;
469 	}
470 
471 	if (TSUCCEEDED (lispEntity_Symbolp (pLispMgr, pEntFunc))) {
472 		/*	symbol-fucntion �� symbol �ʤ�С�����ˤ��ɤ�ɬ�פ����롣
473 		 *	�����롼�פˤʤäƤ����ǽ��������ΤǾ�¤�ɬ�ס�*/
474 		if (TFAILED (lispMachine_GetFinalSymbolFunctionValue (pLM, pEntFunc, &pEntFunc))) {
475 #if defined (DEBUG) || 1
476 			fprintf (stderr, "Symbol's function value is void: ") ;
477 			lispEntity_Print (pLispMgr, pEntFunc) ;
478 			fprintf (stderr, "\n") ;
479 #endif
480 			lispMachineCode_SetError (pLM) ;
481 			return	LMR_RETURN ;
482 		}
483 	}
484 	if (TSUCCEEDED (lispEntity_Consp (pLispMgr, pEntFunc))) {
485 		return	lispMachine_evalLambdaOrMacro (pLM, pEntTarget, pEntFunc) ;
486 	}
487 	return	lispMachine_evalSubr (pLM, pEntTarget, pEntFunc) ;
488 }
489 
490 TLMRESULT
lispMachineState_ReturnOnly(register TLispMachine * pLM)491 lispMachineState_ReturnOnly (
492 	register TLispMachine*	pLM)
493 {
494 	return	LMR_RETURN ;
495 }
496 
497 /*	eval-cons private functions */
498 TLMRESULT
lispMachine_evalSubr(register TLispMachine * pLM,register TLispEntity * pEntTarget,register TLispEntity * pEntFuncValue)499 lispMachine_evalSubr (
500 	register TLispMachine*	pLM,
501 	register TLispEntity*	pEntTarget,
502 	register TLispEntity*	pEntFuncValue)
503 {
504 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
505 	TLispEntity*			pEntArglist ;
506 	LMCMDINFO const*		pProcInfo	= NULL ;
507 	int						nArg ;
508 
509 	/*	�ؿ���������� ``����'' ��õ���Ф��������Υ����å����롣*/
510 	if (TFAILED (lispSubr_GetProc (pLispMgr, pEntFuncValue, &pProcInfo)) ||
511 		TFAILED (lispEntity_GetCdr (pLispMgr, pEntTarget, &pEntArglist)) ||
512 		TFAILED (lispMachine_CheckArgument (pLM, pEntArglist, pProcInfo, &nArg))) {
513 #if defined (DEBUG) || 1
514 		fprintf (stderr, "Wrong number of arguments: ") ;
515 		lispEntity_Print (pLispMgr, pEntFuncValue) ;
516 		fprintf (stderr, " %d\n", nArg) ;
517 #endif
518 		lispMachineCode_SetError (pLM) ;
519 		return	LMR_RETURN ;
520 	}
521 	switch (pProcInfo->m_iArgtype) {
522 		Boolean	fOrgInteractive ;
523 	case	LISPCMD_ARGTYPE_CDR:
524 		pEntTarget	= pEntArglist ;
525 	case	LISPCMD_ARGTYPE_SPECIAL:
526 	case	LISPCMD_ARGTYPE_MACRO:
527 		lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pEntTarget) ;
528 		/*	������ɾ�����ü�Ǥ��ꡢ�����֤�ɾ�����줿�ꡢɾ������ʤ��ä�
529 		 *	�ꤹ�롣*/
530 		lispMachineCode_SetState (pLM, pProcInfo->m_pProc) ;
531 		break ;
532 
533 	case	LISPCMD_ARGTYPE_LAMBDA:
534 		lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pEntTarget) ;
535 		lispMachineCode_PushLReg  (pLM, LM_LREG_ACC) ;
536 		/*	���ξ��ˤϡ��������餫����ɾ�����Ƥ������Ȥ�ɬ�פˤʤ롣*/
537 		lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pEntArglist) ;
538 		assert (pEntArglist != NULL) ;
539 
540 		/*	������ɾ���ϿƤ� interactive �������ºݤ˴ؿ������ɾ�������ä�
541 		 *	�顢interactive �� False �ˤʤ롣*/
542 		lispMachineCode_GetInteractive (pLM, &fOrgInteractive) ;
543 		lispMachineCode_SetInteractive (pLM, False) ;
544 		lispMachineCode_PushState (pLM, pProcInfo->m_pProc) ;
545 		lispMachineCode_UnsetInteractive (pLM, fOrgInteractive) ;
546 		lispMachineCode_PushState (pLM, &lispMachineState_evalLambdaArgFin) ;
547 		lispMachineCode_SetState (pLM, &lispMachineState_evalArgStep1) ;
548 		break ;
549 
550 	default:
551 		/*	���ξ��ˤϡ��������餫����ɾ�����Ƥ������Ȥ�ɬ�פˤʤ롣*/
552 		lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pEntArglist) ;
553 		assert (pEntArglist != NULL) ;
554 
555 		/*	������ɾ���ϿƤ� interactive �������ºݤ˴ؿ������ɾ�������ä�
556 		 *	�顢interactive �� False �ˤʤ롣*/
557 		lispMachineCode_GetInteractive (pLM, &fOrgInteractive) ;
558 		lispMachineCode_SetInteractive (pLM, False) ;
559 		lispMachineCode_PushState (pLM, pProcInfo->m_pProc) ;
560 		lispMachineCode_UnsetInteractive (pLM, fOrgInteractive) ;
561 		lispMachineCode_SetState (pLM, &lispMachineState_evalArgStep1) ;
562 		break ;
563 	}
564 	return	LMR_CONTINUE ;
565 }
566 
567 TLMRESULT
lispMachine_evalLambdaOrMacro(register TLispMachine * pLM,register TLispEntity * pEntTarget,register TLispEntity * pEntFuncValue)568 lispMachine_evalLambdaOrMacro (
569 	register TLispMachine*	pLM,
570 	register TLispEntity*	pEntTarget,
571 	register TLispEntity*	pEntFuncValue)
572 {
573 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
574 	TLispEntity*		pEntCdr ;
575 	TLispEntity*		pEntForm ;
576 	TLispEntity*		pEntSubr ;
577 	Boolean				fOrgInteractive ;
578 	LMCMDINFO const*	pProcInfo	= NULL ;
579 
580 	if (TFAILED (lispEntity_GetCdr (pLispMgr, pEntTarget, &pEntCdr)))
581 		goto	error ;
582 	if (TFAILED (lispMgr_CreateConscell (pLispMgr, pEntFuncValue, pEntCdr, &pEntForm)) ||
583 		pEntForm == NULL)
584 		return	LMR_ERROR ;
585 
586 	/*	defun �ˤ�ä��������Ƥ���ؿ��ξ��ˤϡ������������Ƥ���
587 	 *	��� (lambda��) ������ɾ���оݤ��ѹ����롣*/
588 	lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pEntForm) ;
589 	if (TFAILED (lispMachine_GetSymbolFunctionValue (pLM, pEntFuncValue, &pEntSubr)) ||
590 		TFAILED (lispSubr_GetProc (pLispMgr, pEntSubr, &pProcInfo)))
591 		goto	error ;
592 #if defined (DEBUG)
593 	fprintf (stderr, "eval form = ") ;
594 	lispEntity_Print (pLispMgr, pEntForm) ;
595 	fprintf (stderr, "\n") ;
596 #endif
597 	if (pProcInfo->m_iArgtype != LISPCMD_ARGTYPE_LAMBDA) {
598 		lispMachineCode_SetState (pLM, pProcInfo->m_pProc) ;
599 	} else {
600 		lispMachineCode_PushLReg  (pLM, LM_LREG_ACC) ;
601 		/*	���ξ��ˤϡ��������餫����ɾ�����Ƥ������Ȥ�ɬ�פˤʤ롣*/
602 		lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pEntCdr) ;
603 		assert (pEntCdr != NULL) ;
604 
605 		/*	������ɾ���ϿƤ� interactive �������ºݤ˴ؿ������ɾ�������ä�
606 		 *	�顢interactive �� False �ˤʤ롣*/
607 		lispMachineCode_GetInteractive (pLM, &fOrgInteractive) ;
608 		lispMachineCode_SetInteractive (pLM, False) ;
609 		lispMachineCode_PushState (pLM, pProcInfo->m_pProc) ;
610 		lispMachineCode_UnsetInteractive (pLM, fOrgInteractive) ;
611 		lispMachineCode_PushState (pLM, &lispMachineState_evalLambdaArgFin) ;
612 		lispMachineCode_SetState (pLM, &lispMachineState_evalArgStep1) ;
613 	}
614 	return	LMR_CONTINUE ;
615 
616   error:
617 	lispMachineCode_SetError (pLM) ;
618 	return	LMR_RETURN ;
619 }
620 
621 TLMRESULT
lispMachineState_evalLambdaArgFin(register TLispMachine * pLM)622 lispMachineState_evalLambdaArgFin (
623 	register TLispMachine*	pLM)
624 {
625 	if (LISPMACHINE_EXCEPTIONORSIGNALP (pLM)) {
626 		lispMachineCode_PopLReg (pLM, LM_LREG_ACC) ;
627 	} else {
628 		TLispEntity*	pEntArglist ;
629 		TLispEntity*	pEntLambdaForm ;
630 		lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
631 		lispMachineCode_PopLReg (pLM, LM_LREG_ACC) ;
632 		lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntLambdaForm) ;
633 		lispEntity_SetCdr (pLM->m_pLispMgr, pEntLambdaForm, pEntArglist) ;
634 	}
635 	return	LMR_RETURN ;
636 }
637 
638 TLMRESULT
lispMachineState_evalArgStep1(register TLispMachine * pLM)639 lispMachineState_evalArgStep1 (
640 	register TLispMachine*	pLM)
641 {
642 	TLispEntity*	pNil ;
643 
644 	assert (pLM != NULL) ;
645 
646 	lispMgr_CreateNil (pLM->m_pLispMgr, &pNil) ;
647 	assert (pLM->m_apLREGS [LM_LREG_ACC] != NULL) ;
648 
649 	lispMachineCode_PushLReg (pLM, LM_LREG_1) ;
650 	lispMachineCode_PushLReg (pLM, LM_LREG_2) ;
651 	lispMachineCode_SetLReg  (pLM, LM_LREG_1, pNil) ;
652 	lispMachineCode_SetLReg  (pLM, LM_LREG_2, pNil) ;
653 	lispMachineCode_SetState (pLM, &lispMachineState_evalArgStep2) ;
654 	return	LMR_CONTINUE ;
655 }
656 
657 TLMRESULT
lispMachineState_evalArgStep2(register TLispMachine * pLM)658 lispMachineState_evalArgStep2 (
659 	register TLispMachine*	pLM)
660 {
661 	register TLispManager*	pLispMgr	= pLM->m_pLispMgr ;
662 	TLispEntity*	pArglist ;
663 	TLispEntity*	pCAR ;
664 
665 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pArglist) ;
666 	assert (pArglist != NULL) ;
667 	if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pArglist))) {
668 		lispMachineCode_MoveLReg (pLM, LM_LREG_ACC, LM_LREG_1) ;
669 		/*	��� PUSH ���Ƥ����� LREG1/2 �����᤹��
670 		 *	ARGLIST �����Ѥ���¦�ϥ쥸�������˲����ʤ�(ACC�ʳ�)��
671 		 *	���ꤷ�Ƥ��롣
672 		 *	�ޤ��������Τʤ��������Ƥ�����������*/
673 		lispMachineCode_PopLReg  (pLM, LM_LREG_2) ;
674 		lispMachineCode_PopLReg  (pLM, LM_LREG_1) ;
675 		return	LMR_RETURN ;
676 	}
677 
678 	if (TFAILED (lispEntity_GetCar (pLispMgr, pArglist, &pCAR)) ||
679 		pCAR == NULL) {
680 		lispMachineCode_SetError (pLM) ;
681 		/*	��� PUSH ���Ƥ����� LREG1/2 �����᤹��*/
682 		lispMachineCode_PopLReg (pLM, LM_LREG_2) ;
683 		lispMachineCode_PopLReg (pLM, LM_LREG_1) ;
684 		return	LMR_RETURN ;
685 	}
686 #if defined (DEBUG_LV99)
687 	lispMachine_ShowRegisterValue (pLM) ;
688 #endif
689 	lispMachineCode_PushLReg (pLM, LM_LREG_ACC) ;
690 
691 	/*	EVAL �� register ���˲����ʤ����ƶ��� ACC �ΤߤȤ��롣*/
692 	lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pCAR) ;
693 #if defined (DEBUG_LV99)
694 	fprintf (stderr, "Eval-Arg: ") ;
695 	lispEntity_Print (pLM->m_pLispMgr, pCAR) ;
696 	fprintf (stderr, "\n") ;
697 #endif
698 	lispMachineCode_Evaln (pLM, pCAR, &lispMachineState_evalArgStep3) ;
699 	return	LMR_CONTINUE ;
700 }
701 
702 TLMRESULT
lispMachineState_evalArgStep3(register TLispMachine * pLM)703 lispMachineState_evalArgStep3 (
704 	register TLispMachine*	pLM)
705 {
706 	TLispManager*	pLispMgr ;
707 	TLispEntity*	pEvaledArglistTop ;
708 	TLispEntity*	pEvaledArglistLast ;
709 	TLispEntity*	pValue ;
710 	TLispEntity*	pNil ;
711 	TLispEntity*	pNewLast ;
712 
713 	assert (pLM != NULL) ;
714 	pLispMgr	= pLM->m_pLispMgr ;
715 	assert (pLispMgr != NULL) ;
716 
717 #if defined (DEBUG_LV99)
718 	fprintf (stderr, "state = eval-arg-step3\n") ;
719 	lispMachine_ShowRegisterValue (pLM) ;
720 #endif
721 	/*	EVAL ������ǥ��顼��ȯ������С���������ߤ��롣*/
722 	if (LISPMACHINE_EXCEPTIONORSIGNALP (pLM)) {
723 		lispMachineCode_PopLReg (pLM, LM_LREG_ACC) ;
724 		/*	��� PUSH ���Ƥ����� LREG1/2 �����᤹��*/
725 		lispMachineCode_PopLReg (pLM, LM_LREG_2) ;
726 		lispMachineCode_PopLReg (pLM, LM_LREG_1) ;
727 		return	LMR_RETURN ;
728 	}
729 
730 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pValue) ;
731 	lispMgr_CreateNil (pLispMgr, &pNil) ;
732 	if (TFAILED (lispMgr_CreateConscell (pLispMgr, pValue, pNil, &pNewLast)) ||
733 		pNewLast == NULL)
734 		return	LMR_ERROR ;
735 
736 	lispMachineCode_GetLReg (pLM, LM_LREG_1,   &pEvaledArglistTop) ;
737 	lispMachineCode_GetLReg (pLM, LM_LREG_2,   &pEvaledArglistLast) ;
738 	if (TFAILED (lispEntity_Nullp (pLispMgr, pEvaledArglistTop))) {
739 		lispEntity_SetCdr (pLispMgr, pEvaledArglistLast, pNewLast) ;
740 	} else {
741 		lispMachineCode_SetLReg (pLM, LM_LREG_1, pNewLast) ;
742 	}
743 	lispMachineCode_SetLReg (pLM, LM_LREG_2, pNewLast) ;
744 	lispMachineCode_PopLReg (pLM, LM_LREG_ACC) ;
745 
746 	if (TFAILED (lispMachineCode_Cdr (pLM, LM_LREG_ACC, LM_LREG_ACC))) {
747 		lispMachineCode_SetError (pLM) ;
748 		return	LMR_RETURN ;
749 	} else {
750 		lispMachineCode_SetState (pLM, &lispMachineState_evalArgStep2) ;
751 		return	LMR_CONTINUE ;
752 	}
753 }
754 
755 /*	run-hooks private functions */
756 TLMRESULT
lispMachineState_runHooksStep(register TLispMachine * pLM)757 lispMachineState_runHooksStep (
758 	register TLispMachine*	pLM)
759 {
760 	register TLispManager*	pLispMgr ;
761 	TLispEntity*	pEntHooks ;
762 	TLispEntity*	pEntHook ;
763 	TLispEntity*	pEntHookValue ;
764 	TLispEntity*	pEntNil ;
765 	TLispEntity*	pEntTemp ;
766 
767 	assert (pLM != NULL) ;
768 	pLispMgr	= pLM->m_pLispMgr ;
769 	assert (pLispMgr != NULL) ;
770 	lispMachineCode_GetLReg (pLM, LM_LREG_1, &pEntHooks) ;
771 	if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntHooks)))
772 		goto	finalize ;
773 	if (TFAILED (lispEntity_GetCar (pLispMgr, pEntHooks, &pEntHook)) ||
774 		TFAILED (lispEntity_Symbolp (pLispMgr, pEntHook)))
775 		goto	error ;
776 
777 	if (TFAILED (lispMachine_GetCurrentSymbolValue (pLM, pEntHook, &pEntHookValue)) ||
778 		TSUCCEEDED (lispEntity_Voidp (pLispMgr, pEntHookValue)))
779 		goto	finalize ;
780 
781 	lispMachineCode_SetState (pLM, &lispMachineState_runHooksStep2) ;
782 	if (TSUCCEEDED (lispEntity_Listp (pLispMgr, pEntHookValue))) {
783 		lispMachineCode_SetLReg (pLM, LM_LREG_2, pEntHookValue) ;
784 		goto	skip ;
785 	}
786 	if (TFAILED (lispMgr_CreateNil (pLispMgr, &pEntNil)) ||
787 		TFAILED (lispMgr_CreateConscell (pLispMgr, pEntHookValue, pEntNil, &pEntTemp)))
788 		return	LMR_ERROR ;
789 	lispMachineCode_SetLReg (pLM, LM_LREG_2, pEntTemp) ;
790 
791  skip:
792 	lispEntity_GetCdr (pLispMgr, pEntHooks, &pEntHooks) ;
793 	lispMachineCode_SetLReg (pLM, LM_LREG_1, pEntHooks) ;
794 	return	LMR_CONTINUE ;
795 
796  error:
797 	lispMachineCode_SetError (pLM) ;
798  finalize:
799 	lispMachineCode_SetState (pLM, &lispMachineState_runHooksFinalize) ;
800 	return	LMR_CONTINUE ;
801 }
802 
803 TLMRESULT
lispMachineState_runHooksStep2(register TLispMachine * pLM)804 lispMachineState_runHooksStep2 (
805 	register TLispMachine*	pLM)
806 {
807 	register TLispManager*	pLispMgr ;
808 	TLispEntity*	pEntHooks ;
809 	TLispEntity*	pEntCar ;
810 	TLispEntity*	pEntNil ;
811 	TLispEntity*	pEntTemp ;
812 
813 	assert (pLM != NULL) ;
814 	pLispMgr	= pLM->m_pLispMgr ;
815 	assert (pLispMgr != NULL) ;
816 	lispMachineCode_GetLReg (pLM, LM_LREG_2, &pEntHooks) ;
817 	assert (pEntHooks != NULL) ;
818 	if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pEntHooks)))
819 		goto	finalize ;
820 	if (TFAILED (lispEntity_GetCar (pLispMgr, pEntHooks, &pEntCar))) {
821 		lispMachineCode_SetError (pLM) ;
822 		goto	finalize ;
823 	}
824 	if (TSUCCEEDED (lispEntity_Tp (pLispMgr, pEntCar))) {
825 		lispMachineCode_SetState (pLM, &lispMachineState_runHooksStep3) ;
826 		return	LMR_CONTINUE ;
827 	}
828 	if (TFAILED (lispMgr_CreateNil (pLispMgr, &pEntNil)) ||
829 		TFAILED (lispMgr_CreateConscell (pLispMgr, pEntCar, pEntNil, &pEntTemp)))
830 		return	LMR_ERROR ;
831 
832 	lispMachineCode_PushState (pLM, &lispMachineState_runHooksStep3) ;
833 	lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pEntTemp) ;
834 	lispMachineCode_SetState (pLM, &lispMachineState_EvalCons) ;
835 	return	LMR_CONTINUE ;
836 
837  finalize:
838 	lispMachineCode_SetState (pLM, &lispMachineState_runHooksFinalize) ;
839 	return	LMR_CONTINUE ;
840 }
841 
842 TLMRESULT
lispMachineState_runHooksStep3(register TLispMachine * pLM)843 lispMachineState_runHooksStep3 (
844 	register TLispMachine*	pLM)
845 {
846 	register TLispManager*	pLispMgr ;
847 	TLispEntity*	pEntHooks ;
848 	TLispEntity*	pEntCdr ;
849 
850 	assert (pLM != NULL) ;
851 	pLispMgr	= pLM->m_pLispMgr ;
852 	assert (pLispMgr != NULL) ;
853 	if (LISPMACHINE_EXCEPTIONORSIGNALP (pLM)) {
854 		lispMachineCode_SetState (pLM, &lispMachineState_runHooksFinalize) ;
855 		return	LMR_CONTINUE ;
856 	}
857 	lispMachineCode_GetLReg (pLM, LM_LREG_2, &pEntHooks) ;
858 	assert (pEntHooks != NULL) ;
859 	if (TFAILED (lispEntity_GetCdr (pLispMgr, pEntHooks, &pEntCdr))) {
860 		lispMachineCode_SetError (pLM) ;
861 		lispMachineCode_SetState (pLM, &lispMachineState_runHooksFinalize) ;
862 	} else {
863 		lispMachineCode_SetLReg (pLM, LM_LREG_2, pEntCdr) ;
864 		lispMachineCode_SetState (pLM, &lispMachineState_runHooksStep2) ;
865 	}
866 	return	LMR_CONTINUE ;
867 }
868 
869 TLMRESULT
lispMachineState_runHooksFinalize(register TLispMachine * pLM)870 lispMachineState_runHooksFinalize (
871 	register TLispMachine*	pLM)
872 {
873 	lispMachineCode_MoveLReg (pLM, LM_LREG_ACC, LM_LREG_1) ;
874 	lispMachineCode_PopLReg  (pLM, LM_LREG_2) ;
875 	lispMachineCode_PopLReg  (pLM, LM_LREG_1) ;
876 	return	LMR_RETURN ;
877 }
878 
879 /*	mapcar private functions */
880 TLMRESULT
lispMachineState_mapcarListApply(register TLispMachine * pLM)881 lispMachineState_mapcarListApply (
882 	register TLispMachine*	pLM)
883 {
884 	register TLispManager*	pLispMgr ;
885 	TLispEntity*	pFunctail ;
886 	TLispEntity*	pFunclist ;
887 	TLispEntity*	pSequence ;
888 	TLispEntity*	pEntCar ;
889 
890 	assert (pLM != NULL) ;
891 	pLispMgr	= pLM->m_pLispMgr ;
892 	assert (pLispMgr != NULL) ;
893 
894 	lispMachineCode_GetLReg (pLM, LM_LREG_3, &pSequence) ;
895 	if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pSequence))) {
896 		lispMachineCode_SetState (pLM, &lispMachineState_mapcarFinalize) ;
897 		return	LMR_CONTINUE ;
898 	}
899 	if (TFAILED (lispEntity_GetCar (pLispMgr, pSequence, &pEntCar))) {
900 		lispMachineCode_SetError (pLM) ;
901 		lispMachineCode_SetState (pLM, &lispMachineState_mapcarFinalize) ;
902 		return	LMR_CONTINUE ;
903 	}
904 	lispMachineCode_GetLReg   (pLM, LM_LREG_2,   &pFunctail) ;
905 	lispEntity_SetCar         (pLispMgr, pFunctail, pEntCar) ;
906 	lispMachineCode_GetLReg   (pLM, LM_LREG_1,   &pFunclist) ;
907 
908 	lispMachineCode_PushState (pLM, &lispMachineState_mapcarListPostApply) ;
909 	lispMachineCode_Cdr       (pLM, LM_LREG_3,   LM_LREG_3) ;
910 	lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pFunclist) ;
911 	lispMachineCode_SetState (pLM, &lispMachineState_Funcall) ;
912 	return	LMR_CONTINUE ;
913 }
914 
915 TLMRESULT
lispMachineState_mapcarListPostApply(register TLispMachine * pLM)916 lispMachineState_mapcarListPostApply (
917 	register TLispMachine*	pLM)
918 {
919 	return	lispMachineState_mapcarPostApplyCommon (pLM, &lispMachineState_mapcarListApply) ;
920 }
921 
922 TLMRESULT
lispMachineState_mapcarVectorApply(register TLispMachine * pLM)923 lispMachineState_mapcarVectorApply (
924 	register TLispMachine*	pLM)
925 {
926 	register TLispManager*	pLispMgr ;
927 	TLispEntity*	pSequence ;
928 	TLispEntity*	pElement	= NULL ;
929 	TLispEntity*	pFunctail ;
930 	TLispEntity*	pFunclist ;
931 	long		lIndex ;
932 
933 	assert (pLM != NULL) ;
934 	pLispMgr	= pLM->m_pLispMgr ;
935 	assert (pLispMgr != NULL) ;
936 
937 	lispMachineCode_GetLReg  (pLM, LM_LREG_3, &pSequence) ;
938 	lispMachineCode_GetVRegI (pLM, LM_VREG_1, &lIndex) ;
939 #if defined (DEBUG)
940 	fprintf (stderr, "Sequence = ") ;
941 	lispEntity_Print (pLispMgr, pSequence) ;
942 	fprintf (stderr, "\nIndex = %ld\n", lIndex) ;
943 #endif
944 	if (TFAILED (lispEntity_GetVectorElement (pLispMgr, pSequence, lIndex, &pElement)) ||
945 		pElement == NULL) {
946 		/*	pSequence �� VECTOR �Ǥ���Τϳ�ǧ����Ƥ���ġ�*/
947 		lispMachineCode_SetState (pLM, &lispMachineState_mapcarFinalize) ;
948 		return	LMR_CONTINUE ;
949 	}
950 	lIndex	++ ;
951 	lispMachineCode_SetVRegI  (pLM, LM_VREG_1,   lIndex) ;
952 
953 	lispMachineCode_GetLReg   (pLM, LM_LREG_2,   &pFunctail) ;
954 	lispEntity_SetCar         (pLispMgr, pFunctail, pElement) ;
955 	lispMachineCode_GetLReg   (pLM, LM_LREG_1,   &pFunclist) ;
956 
957 	lispMachineCode_PushState (pLM, &lispMachineState_mapcarVectorPostApply) ;
958 	lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pFunclist) ;
959 	lispMachineCode_SetState (pLM, &lispMachineState_Funcall) ;
960 	return	LMR_CONTINUE ;
961 }
962 
963 TLMRESULT
lispMachineState_mapcarVectorPostApply(register TLispMachine * pLM)964 lispMachineState_mapcarVectorPostApply (
965 	register TLispMachine*	pLM)
966 {
967 	return	lispMachineState_mapcarPostApplyCommon (pLM, &lispMachineState_mapcarVectorApply) ;
968 }
969 
970 TLMRESULT
lispMachineState_mapcarStringApply(register TLispMachine * pLM)971 lispMachineState_mapcarStringApply (
972 	register TLispMachine*	pLM)
973 {
974 	register TLispManager*	pLispMgr ;
975 	TLispEntity*	pSequence ;
976 	TLispEntity*	pElement ;
977 	TLispEntity*	pFunctail ;
978 	TLispEntity*	pFunclist ;
979 	long			lIndex ;
980 	Char			cc ;
981 
982 	assert (pLM != NULL) ;
983 	pLispMgr	= pLM->m_pLispMgr ;
984 	assert (pLispMgr != NULL) ;
985 
986 	lispMachineCode_GetLReg  (pLM, LM_LREG_3, &pSequence) ;
987 	lispMachineCode_GetVRegI (pLM, LM_VREG_1, &lIndex) ;
988 	if (TFAILED (lispEntity_GetStringElement (pLispMgr, pSequence, lIndex, &cc))) {
989 		/*	pSequence �� VECTOR �Ǥ���Τϳ�ǧ����Ƥ���ġ�*/
990 		lispMachineCode_SetState (pLM, &lispMachineState_mapcarFinalize) ;
991 		return	LMR_CONTINUE ;
992 	}
993 	if (TFAILED (lispMgr_CreateInteger (pLispMgr, cc, &pElement)))
994 		return	LMR_ERROR ;
995 
996 	lIndex	++ ;
997 	lispMachineCode_SetVRegI  (pLM, LM_VREG_1,   lIndex) ;
998 
999 	lispMachineCode_GetLReg   (pLM, LM_LREG_2,   &pFunctail) ;
1000 	lispEntity_SetCar         (pLispMgr, pFunctail, pElement) ;
1001 	lispMachineCode_GetLReg   (pLM, LM_LREG_1,   &pFunclist) ;
1002 
1003 	lispMachineCode_PushState (pLM, &lispMachineState_mapcarStringPostApply) ;
1004 	lispMachineCode_SetLReg   (pLM, LM_LREG_ACC, pFunclist) ;
1005 	lispMachineCode_SetState (pLM, &lispMachineState_Funcall) ;
1006 	return	LMR_CONTINUE ;
1007 }
1008 
1009 TLMRESULT
lispMachineState_mapcarStringPostApply(register TLispMachine * pLM)1010 lispMachineState_mapcarStringPostApply (
1011 	register TLispMachine*	pLM)
1012 {
1013 	return	lispMachineState_mapcarPostApplyCommon (pLM, &lispMachineState_mapcarStringApply) ;
1014 }
1015 
1016 TLMRESULT
lispMachineState_mapcarPostApplyCommon(register TLispMachine * pLM,register TLMRESULT (* pNextState)(TLispMachine *))1017 lispMachineState_mapcarPostApplyCommon (
1018 	register TLispMachine*	pLM,
1019 	register TLMRESULT		(*pNextState)(TLispMachine*))
1020 {
1021 	register TLispManager*	pLispMgr ;
1022 	TLispEntity*	pTail ;
1023 	TLispEntity*	pResult ;
1024 	TLispEntity*	pNewTail ;
1025 	TLispEntity*	pNil ;
1026 
1027 	assert (pLM != NULL) ;
1028 	pLispMgr	= pLM->m_pLispMgr ;
1029 	assert (pLispMgr != NULL) ;
1030 
1031 	if (LISPMACHINE_EXCEPTIONORSIGNALP (pLM)) {
1032 		lispMachineCode_SetState (pLM, &lispMachineState_mapcarFinalize) ;
1033 		return	LMR_CONTINUE ;
1034 	}
1035 	lispMachineCode_GetLReg (pLM, LM_LREG_5,   &pTail) ;
1036 	lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pResult) ;
1037 
1038 	lispMgr_CreateNil      (pLispMgr, &pNil) ;
1039 	lispMgr_CreateConscell (pLispMgr, pResult, pNil, &pNewTail) ;
1040 	if (TSUCCEEDED (lispEntity_Nullp (pLispMgr, pTail))) {
1041 		lispMachineCode_SetLReg (pLM, LM_LREG_4, pNewTail) ;
1042 	} else {
1043 		lispEntity_SetCdr (pLispMgr, pTail, pNewTail) ;
1044 	}
1045 	lispMachineCode_SetLReg (pLM, LM_LREG_5, pNewTail) ;
1046 	lispMachineCode_SetState (pLM, pNextState) ;
1047 	return	LMR_CONTINUE ;
1048 }
1049 
1050 TLMRESULT
lispMachineState_mapcarFinalize(register TLispMachine * pLM)1051 lispMachineState_mapcarFinalize (
1052 	register TLispMachine*	pLM)
1053 {
1054 	lispMachineCode_MoveLReg (pLM, LM_LREG_ACC, LM_LREG_4) ;
1055 	lispMachineCode_PopVReg  (pLM, LM_VREG_1) ;
1056 	lispMachineCode_PopLReg  (pLM, LM_LREG_5) ;
1057 	lispMachineCode_PopLReg  (pLM, LM_LREG_4) ;
1058 	lispMachineCode_PopLReg  (pLM, LM_LREG_3) ;
1059 	lispMachineCode_PopLReg  (pLM, LM_LREG_2) ;
1060 	lispMachineCode_PopLReg  (pLM, LM_LREG_1) ;
1061 	return	LMR_RETURN ;
1062 }
1063 
1064