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 /*
22 * ��¾����μ¸�������Υ�������ʬ����¾���椹��ɬ�פ����롣
23 * �⤷������ι�����˥����֤���褿�顩
24 */
25 #include "local.h"
26 #include <stdio.h>
27 #include <assert.h>
28 #include "lmachinep.h"
29
30 static TLMRESULT lispMachineState_mutualEvalTryLock (TLispMachine*) ;
31 static TLMRESULT lispMachineState_mutualEvalFinalize (TLispMachine*) ;
32
33 TLMRESULT
lispMachineState_Mutexp(register TLispMachine * pLM)34 lispMachineState_Mutexp (
35 register TLispMachine* pLM)
36 {
37 register TLispManager* pLispMgr ;
38 TLispEntity* pEntArglist ;
39 TLispEntity* pEntMutex ;
40 TLispEntity* pEntRetval ;
41
42 assert (pLM != NULL) ;
43 pLispMgr = pLM->m_pLispMgr ;
44 assert (pLispMgr != NULL) ;
45
46 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
47 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntMutex))) {
48 lispMachineCode_SetError (pLM) ;
49 return LMR_RETURN ;
50 }
51 if (TSUCCEEDED (lispEntity_Mutexp (pLispMgr, pEntMutex))) {
52 lispMgr_CreateT (pLispMgr, &pEntRetval) ;
53 } else {
54 lispMgr_CreateNil (pLispMgr, &pEntRetval) ;
55 }
56 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntRetval) ;
57 return LMR_RETURN ;
58 }
59
60 /* (get-mutex MUTEX-NAME)
61 *
62 * ���դ���ʤ��ä��� nil ���֤���
63 */
64 TLMRESULT
lispMachineState_GetMutex(register TLispMachine * pLM)65 lispMachineState_GetMutex (
66 register TLispMachine* pLM)
67 {
68 register TLispManager* pLispMgr ;
69 TLispEntity* pEntArglist ;
70 TLispEntity* pEntMutex ;
71 TLispEntity* pEntMutexName ;
72 const Char* strMutexName ;
73 int nMutexName ;
74
75 assert (pLM != NULL) ;
76 pLispMgr = pLM->m_pLispMgr ;
77 assert (pLispMgr != NULL) ;
78
79 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
80 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntMutexName)) ||
81 TFAILED (lispEntity_GetStringValue (pLispMgr, pEntMutexName, &strMutexName, &nMutexName))) {
82 lispMachineCode_SetError (pLM) ;
83 return LMR_RETURN ;
84 }
85 if (TFAILED (lispMgr_SearchMutex (pLispMgr, strMutexName, nMutexName, &pEntMutex)))
86 lispMgr_CreateNil (pLispMgr, &pEntMutex) ;
87 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntMutex) ;
88 return LMR_RETURN ;
89 }
90
91 /* (get-mutex-create MUTEX-NAME INITIAL-LOCK)
92 *
93 * MUTEX-NAME �� nil �ʤ�̵̾�� Mutex Object ��������뤳�Ȥˤʤ롣
94 */
95 TLMRESULT
lispMachineState_GetMutexCreate(register TLispMachine * pLM)96 lispMachineState_GetMutexCreate (
97 register TLispMachine* pLM)
98 {
99 register TLispManager* pLispMgr ;
100 TLispEntity* pEntArglist ;
101 TLispEntity* pEntMutexName ;
102 TLispEntity* pEntInitialLock ;
103 const Char* strMutexName ;
104 int nMutexName ;
105 TLispEntity* pEntMutex ;
106
107 assert (pLM != NULL) ;
108 pLispMgr = pLM->m_pLispMgr ;
109 assert (pLispMgr != NULL) ;
110
111 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
112 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntMutexName)) ||
113 TFAILED (lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntInitialLock)))
114 goto error ;
115
116 if (TSUCCEEDED (lispEntity_GetStringValue (pLispMgr, pEntMutexName, &strMutexName, &nMutexName))) {
117 if (TSUCCEEDED (lispMgr_SearchMutex (pLispMgr, strMutexName, nMutexName, &pEntMutex))) {
118 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntMutex) ;
119 return LMR_RETURN ;
120 }
121 } else {
122 if (TFAILED (lispEntity_Nullp (pLispMgr, pEntMutexName)))
123 goto error ;
124 pEntMutexName = NULL ;
125 nMutexName = 0 ;
126 }
127 /* Mutex Object ��������롣̾���դ��ξ��ˤϡ����ȥ������������ʳ���
128 * 1 �ˤʤäƤ��ơ���������ʤ���*/
129 if (TFAILED (lispMgr_CreateMutex (pLispMgr, strMutexName, nMutexName, &pEntMutex)))
130 return LMR_ERROR ;
131 if (TFAILED (lispEntity_Nullp (pLispMgr, pEntInitialLock)))
132 (void) lispMgr_LockMutex (pLispMgr, pEntMutex, pLM) ;
133
134 lispMachineCode_SetLReg (pLM, LM_LREG_ACC, pEntMutex) ;
135 return LMR_RETURN ;
136
137 error:
138 lispMachineCode_SetError (pLM) ;
139 return LMR_RETURN ;
140 }
141
142 /* (mutual-eval MUTEX BODYFORM)
143 */
144 TLMRESULT
lispMachineState_MutualEval(register TLispMachine * pLM)145 lispMachineState_MutualEval (
146 register TLispMachine* pLM)
147 {
148 register TLispManager* pLispMgr ;
149 TLispEntity* pEntArglist ;
150 TLispEntity* pEntMutex ;
151 TLispEntity* pEntTarget ;
152
153 assert (pLM != NULL) ;
154 pLispMgr = pLM->m_pLispMgr ;
155 assert (pLispMgr != NULL) ;
156
157 lispMachineCode_GetLReg (pLM, LM_LREG_ACC, &pEntArglist) ;
158 if (TFAILED (lispEntity_GetCar (pLispMgr, pEntArglist, &pEntMutex)) ||
159 TFAILED (lispEntity_Mutexp (pLispMgr, pEntMutex)) ||
160 TFAILED (lispEntity_GetCadr (pLispMgr, pEntArglist, &pEntTarget))) {
161 lispMachineCode_SetError (pLM) ;
162 return LMR_RETURN ;
163 }
164
165 lispMachineCode_PushLReg (pLM, LM_LREG_1) ;
166 lispMachineCode_PushLReg (pLM, LM_LREG_2) ;
167 lispMachineCode_SetLReg (pLM, LM_LREG_1, pEntMutex) ;
168 lispMachineCode_SetLReg (pLM, LM_LREG_2, pEntTarget) ;
169 return lispMachineState_mutualEvalTryLock (pLM) ;
170 }
171
172 TLMRESULT
lispMachineState_mutualEvalTryLock(register TLispMachine * pLM)173 lispMachineState_mutualEvalTryLock (
174 register TLispMachine* pLM)
175 {
176 TLispEntity* pEntMutex ;
177 TLispEntity* pEntTarget ;
178
179 assert (pLM != NULL) ;
180 lispMachineCode_GetLReg (pLM, LM_LREG_1, &pEntMutex) ;
181 assert (pEntMutex != NULL) ;
182
183 /* lock ���ߤ롣Ʊ��� process �ʤ��Ʊ��� LispMachine ��
184 * �顢lock ���̤�ȴ����ġ�TICK �ʤΤ��ˤ����ġ�Mutex �β���
185 * �� broadcast ���뵡�������ʤ��Τǡ�*/
186 if (TFAILED (lispMgr_LockMutex (pLM->m_pLispMgr, pEntMutex, pLM)))
187 return LMR_TICK ;
188
189 lispMachineCode_GetLReg (pLM, LM_LREG_2, &pEntTarget) ;
190 lispMachineCode_Evaln (pLM, pEntTarget, &lispMachineState_mutualEvalFinalize) ;
191 return LMR_CONTINUE ;
192 }
193
194 TLMRESULT
lispMachineState_mutualEvalFinalize(register TLispMachine * pLM)195 lispMachineState_mutualEvalFinalize (
196 register TLispMachine* pLM)
197 {
198 TLispEntity* pEntMutex ;
199
200 /* Mutex Object �� unlock ���롣*/
201 lispMachineCode_GetLReg (pLM, LM_LREG_1, &pEntMutex) ;
202 lispMgr_UnlockMutex (pLM->m_pLispMgr, pEntMutex, pLM) ;
203
204 lispMachineCode_PopLReg (pLM, LM_LREG_2) ;
205 lispMachineCode_PopLReg (pLM, LM_LREG_1) ;
206 return LMR_RETURN ;
207 }
208
209