vm-engine.c 104 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245
  1. /* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
  2. *
  3. * This library is free software; you can redistribute it and/or
  4. * modify it under the terms of the GNU Lesser General Public License
  5. * as published by the Free Software Foundation; either version 3 of
  6. * the License, or (at your option) any later version.
  7. *
  8. * This library is distributed in the hope that it will be useful, but
  9. * WITHOUT ANY WARRANTY; without even the implied warranty of
  10. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  11. * Lesser General Public License for more details.
  12. *
  13. * You should have received a copy of the GNU Lesser General Public
  14. * License along with this library; if not, write to the Free Software
  15. * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16. * 02110-1301 USA
  17. */
  18. /* This file is included in vm.c multiple times. */
  19. #define UNPACK_8_8_8(op,a,b,c) \
  20. do \
  21. { \
  22. a = (op >> 8) & 0xff; \
  23. b = (op >> 16) & 0xff; \
  24. c = op >> 24; \
  25. } \
  26. while (0)
  27. #define UNPACK_8_16(op,a,b) \
  28. do \
  29. { \
  30. a = (op >> 8) & 0xff; \
  31. b = op >> 16; \
  32. } \
  33. while (0)
  34. #define UNPACK_16_8(op,a,b) \
  35. do \
  36. { \
  37. a = (op >> 8) & 0xffff; \
  38. b = op >> 24; \
  39. } \
  40. while (0)
  41. #define UNPACK_12_12(op,a,b) \
  42. do \
  43. { \
  44. a = (op >> 8) & 0xfff; \
  45. b = op >> 20; \
  46. } \
  47. while (0)
  48. #define UNPACK_24(op,a) \
  49. do \
  50. { \
  51. a = op >> 8; \
  52. } \
  53. while (0)
  54. /* Assign some registers by hand. There used to be a bigger list here,
  55. but it was never tested, and in the case of x86-32, was a source of
  56. compilation failures. It can be revived if it's useful, but my naive
  57. hope is that simply annotating the locals with "register" will be a
  58. sufficient hint to the compiler. */
  59. #ifdef __GNUC__
  60. # if defined __x86_64__
  61. /* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
  62. well. Tell it to keep the jump table in a r12, which is
  63. callee-saved. */
  64. # define JT_REG asm ("r12")
  65. # endif
  66. #endif
  67. #ifndef IP_REG
  68. # define IP_REG
  69. #endif
  70. #ifndef FP_REG
  71. # define FP_REG
  72. #endif
  73. #ifndef JT_REG
  74. # define JT_REG
  75. #endif
  76. #define VM_ASSERT(condition, handler) \
  77. do { \
  78. if (SCM_UNLIKELY (!(condition))) \
  79. { \
  80. SYNC_IP(); \
  81. handler; \
  82. } \
  83. } while (0)
  84. #ifdef VM_ENABLE_ASSERTIONS
  85. # define ASSERT(condition) VM_ASSERT (condition, abort())
  86. #else
  87. # define ASSERT(condition)
  88. #endif
  89. #if VM_USE_HOOKS
  90. #define RUN_HOOK(exp) \
  91. do { \
  92. if (SCM_UNLIKELY (vp->trace_level > 0)) \
  93. { \
  94. SYNC_IP (); \
  95. exp; \
  96. CACHE_FP (); \
  97. } \
  98. } while (0)
  99. #else
  100. #define RUN_HOOK(exp)
  101. #endif
  102. #define RUN_HOOK0(h) RUN_HOOK (vm_dispatch_##h##_hook (vp))
  103. #define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (vp, arg))
  104. #define APPLY_HOOK() \
  105. RUN_HOOK0 (apply)
  106. #define PUSH_CONTINUATION_HOOK() \
  107. RUN_HOOK0 (push_continuation)
  108. #define POP_CONTINUATION_HOOK(old_fp) \
  109. RUN_HOOK1 (pop_continuation, old_fp)
  110. #define NEXT_HOOK() \
  111. RUN_HOOK0 (next)
  112. #define ABORT_CONTINUATION_HOOK() \
  113. RUN_HOOK0 (abort)
  114. #define VM_HANDLE_INTERRUPTS \
  115. SCM_ASYNC_TICK_WITH_GUARD_CODE (current_thread, SYNC_IP (), CACHE_FP ())
  116. /* Virtual Machine
  117. This is Guile's new virtual machine. When I say "new", I mean
  118. relative to the current virtual machine. At some point it will
  119. become "the" virtual machine, and we'll delete this paragraph. As
  120. such, the rest of the comments speak as if there's only one VM.
  121. In difference from the old VM, local 0 is the procedure, and the
  122. first argument is local 1. At some point in the future we should
  123. change the fp to point to the procedure and not to local 1.
  124. <more overview here>
  125. */
  126. /* The VM has three state bits: the instruction pointer (IP), the frame
  127. pointer (FP), and the top-of-stack pointer (SP). We cache the first
  128. two of these in machine registers, local to the VM, because they are
  129. used extensively by the VM. As the SP is used more by code outside
  130. the VM than by the VM itself, we don't bother caching it locally.
  131. Since the FP changes infrequently, relative to the IP, we keep vp->fp
  132. in sync with the local FP. This would be a big lose for the IP,
  133. though, so instead of updating vp->ip all the time, we call SYNC_IP
  134. whenever we would need to know the IP of the top frame. In practice,
  135. we need to SYNC_IP whenever we call out of the VM to a function that
  136. would like to walk the stack, perhaps as the result of an
  137. exception.
  138. One more thing. We allow the stack to move, when it expands.
  139. Therefore if you call out to a C procedure that could call Scheme
  140. code, or otherwise push anything on the stack, you will need to
  141. CACHE_FP afterwards to restore the possibly-changed FP. */
  142. #define SYNC_IP() vp->ip = (ip)
  143. #define CACHE_FP() fp = (vp->fp)
  144. #define CACHE_REGISTER() \
  145. do { \
  146. ip = vp->ip; \
  147. fp = vp->fp; \
  148. } while (0)
  149. /* After advancing vp->sp, but before writing any stack slots, check
  150. that it is actually in bounds. If it is not in bounds, currently we
  151. signal an error. In the future we may expand the stack instead,
  152. possibly by moving it elsewhere, therefore no pointer into the stack
  153. besides FP is valid across a CHECK_OVERFLOW call. Be careful! */
  154. #define CHECK_OVERFLOW() \
  155. do { \
  156. if (SCM_UNLIKELY (vp->sp >= vp->stack_limit)) \
  157. { \
  158. SYNC_IP (); \
  159. vm_expand_stack (vp); \
  160. CACHE_FP (); \
  161. } \
  162. } while (0)
  163. /* Reserve stack space for a frame. Will check that there is sufficient
  164. stack space for N locals, including the procedure. Invoke after
  165. preparing the new frame and setting the fp and ip. */
  166. #define ALLOC_FRAME(n) \
  167. do { \
  168. vp->sp = LOCAL_ADDRESS (n - 1); \
  169. CHECK_OVERFLOW (); \
  170. } while (0)
  171. /* Reset the current frame to hold N locals. Used when we know that no
  172. stack expansion is needed. */
  173. #define RESET_FRAME(n) \
  174. do { \
  175. vp->sp = LOCAL_ADDRESS (n - 1); \
  176. } while (0)
  177. /* Compute the number of locals in the frame. At a call, this is equal
  178. to the number of actual arguments when a function is first called,
  179. plus one for the function. */
  180. #define FRAME_LOCALS_COUNT_FROM(slot) \
  181. (vp->sp + 1 - LOCAL_ADDRESS (slot))
  182. #define FRAME_LOCALS_COUNT() \
  183. FRAME_LOCALS_COUNT_FROM (0)
  184. /* Restore registers after returning from a frame. */
  185. #define RESTORE_FRAME() \
  186. do { \
  187. } while (0)
  188. #ifdef HAVE_LABELS_AS_VALUES
  189. # define BEGIN_DISPATCH_SWITCH /* */
  190. # define END_DISPATCH_SWITCH /* */
  191. # define NEXT(n) \
  192. do \
  193. { \
  194. ip += n; \
  195. NEXT_HOOK (); \
  196. op = *ip; \
  197. goto *jump_table[op & 0xff]; \
  198. } \
  199. while (0)
  200. # define VM_DEFINE_OP(opcode, tag, name, meta) \
  201. op_##tag:
  202. #else
  203. # define BEGIN_DISPATCH_SWITCH \
  204. vm_start: \
  205. NEXT_HOOK (); \
  206. op = *ip; \
  207. switch (op & 0xff) \
  208. {
  209. # define END_DISPATCH_SWITCH \
  210. }
  211. # define NEXT(n) \
  212. do \
  213. { \
  214. ip += n; \
  215. goto vm_start; \
  216. } \
  217. while (0)
  218. # define VM_DEFINE_OP(opcode, tag, name, meta) \
  219. op_##tag: \
  220. case opcode:
  221. #endif
  222. #define LOCAL_ADDRESS(i) (&SCM_FRAME_LOCAL (fp, i))
  223. #define LOCAL_REF(i) SCM_FRAME_LOCAL (fp, i)
  224. #define LOCAL_SET(i,o) SCM_FRAME_LOCAL (fp, i) = o
  225. #define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
  226. #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
  227. #define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
  228. #define RETURN_ONE_VALUE(ret) \
  229. do { \
  230. SCM val = ret; \
  231. SCM *old_fp; \
  232. VM_HANDLE_INTERRUPTS; \
  233. old_fp = fp; \
  234. ip = SCM_FRAME_RETURN_ADDRESS (fp); \
  235. fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
  236. /* Clear frame. */ \
  237. old_fp[-1] = SCM_BOOL_F; \
  238. old_fp[-2] = SCM_BOOL_F; \
  239. /* Leave proc. */ \
  240. SCM_FRAME_LOCAL (old_fp, 1) = val; \
  241. vp->sp = &SCM_FRAME_LOCAL (old_fp, 1); \
  242. POP_CONTINUATION_HOOK (old_fp); \
  243. NEXT (0); \
  244. } while (0)
  245. /* While we could generate the list-unrolling code here, it's fine for
  246. now to just tail-call (apply values vals). */
  247. #define RETURN_VALUE_LIST(vals_) \
  248. do { \
  249. SCM vals = vals_; \
  250. VM_HANDLE_INTERRUPTS; \
  251. fp[0] = vm_builtin_apply; \
  252. fp[1] = vm_builtin_values; \
  253. fp[2] = vals; \
  254. RESET_FRAME (3); \
  255. ip = (scm_t_uint32 *) vm_builtin_apply_code; \
  256. goto op_tail_apply; \
  257. } while (0)
  258. #define BR_NARGS(rel) \
  259. scm_t_uint32 expected; \
  260. UNPACK_24 (op, expected); \
  261. if (FRAME_LOCALS_COUNT() rel expected) \
  262. { \
  263. scm_t_int32 offset = ip[1]; \
  264. offset >>= 8; /* Sign-extending shift. */ \
  265. NEXT (offset); \
  266. } \
  267. NEXT (2)
  268. #define BR_UNARY(x, exp) \
  269. scm_t_uint32 test; \
  270. SCM x; \
  271. UNPACK_24 (op, test); \
  272. x = LOCAL_REF (test); \
  273. if ((ip[1] & 0x1) ? !(exp) : (exp)) \
  274. { \
  275. scm_t_int32 offset = ip[1]; \
  276. offset >>= 8; /* Sign-extending shift. */ \
  277. if (offset < 0) \
  278. VM_HANDLE_INTERRUPTS; \
  279. NEXT (offset); \
  280. } \
  281. NEXT (2)
  282. #define BR_BINARY(x, y, exp) \
  283. scm_t_uint16 a, b; \
  284. SCM x, y; \
  285. UNPACK_12_12 (op, a, b); \
  286. x = LOCAL_REF (a); \
  287. y = LOCAL_REF (b); \
  288. if ((ip[1] & 0x1) ? !(exp) : (exp)) \
  289. { \
  290. scm_t_int32 offset = ip[1]; \
  291. offset >>= 8; /* Sign-extending shift. */ \
  292. if (offset < 0) \
  293. VM_HANDLE_INTERRUPTS; \
  294. NEXT (offset); \
  295. } \
  296. NEXT (2)
  297. #define BR_ARITHMETIC(crel,srel) \
  298. { \
  299. scm_t_uint16 a, b; \
  300. SCM x, y; \
  301. UNPACK_12_12 (op, a, b); \
  302. x = LOCAL_REF (a); \
  303. y = LOCAL_REF (b); \
  304. if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
  305. { \
  306. scm_t_signed_bits x_bits = SCM_UNPACK (x); \
  307. scm_t_signed_bits y_bits = SCM_UNPACK (y); \
  308. if ((ip[1] & 0x1) ? !(x_bits crel y_bits) : (x_bits crel y_bits)) \
  309. { \
  310. scm_t_int32 offset = ip[1]; \
  311. offset >>= 8; /* Sign-extending shift. */ \
  312. if (offset < 0) \
  313. VM_HANDLE_INTERRUPTS; \
  314. NEXT (offset); \
  315. } \
  316. NEXT (2); \
  317. } \
  318. else \
  319. { \
  320. SCM res; \
  321. SYNC_IP (); \
  322. res = srel (x, y); \
  323. CACHE_FP (); \
  324. if ((ip[1] & 0x1) ? scm_is_false (res) : scm_is_true (res)) \
  325. { \
  326. scm_t_int32 offset = ip[1]; \
  327. offset >>= 8; /* Sign-extending shift. */ \
  328. if (offset < 0) \
  329. VM_HANDLE_INTERRUPTS; \
  330. NEXT (offset); \
  331. } \
  332. NEXT (2); \
  333. } \
  334. }
  335. #define ARGS1(a1) \
  336. scm_t_uint16 dst, src; \
  337. SCM a1; \
  338. UNPACK_12_12 (op, dst, src); \
  339. a1 = LOCAL_REF (src)
  340. #define ARGS2(a1, a2) \
  341. scm_t_uint8 dst, src1, src2; \
  342. SCM a1, a2; \
  343. UNPACK_8_8_8 (op, dst, src1, src2); \
  344. a1 = LOCAL_REF (src1); \
  345. a2 = LOCAL_REF (src2)
  346. #define RETURN(x) \
  347. do { LOCAL_SET (dst, x); NEXT (1); } while (0)
  348. #define RETURN_EXP(exp) \
  349. do { SCM __x; SYNC_IP (); __x = exp; CACHE_FP (); RETURN (__x); } while (0)
  350. /* The maximum/minimum tagged integers. */
  351. #define INUM_MAX \
  352. ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_POSITIVE_FIXNUM)))
  353. #define INUM_MIN \
  354. ((scm_t_signed_bits) SCM_UNPACK (SCM_I_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM)))
  355. #define INUM_STEP \
  356. ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \
  357. - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
  358. #define BINARY_INTEGER_OP(CFUNC,SFUNC) \
  359. { \
  360. ARGS2 (x, y); \
  361. if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
  362. { \
  363. scm_t_int64 n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y); \
  364. if (SCM_FIXABLE (n)) \
  365. RETURN (SCM_I_MAKINUM (n)); \
  366. } \
  367. RETURN_EXP (SFUNC (x, y)); \
  368. }
  369. #define VM_VALIDATE_PAIR(x, proc) \
  370. VM_ASSERT (scm_is_pair (x), vm_error_not_a_pair (proc, x))
  371. #define VM_VALIDATE_STRUCT(obj, proc) \
  372. VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj))
  373. #define VM_VALIDATE_BYTEVECTOR(x, proc) \
  374. VM_ASSERT (SCM_BYTEVECTOR_P (x), vm_error_not_a_bytevector (proc, x))
  375. /* Return true (non-zero) if PTR has suitable alignment for TYPE. */
  376. #define ALIGNED_P(ptr, type) \
  377. ((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
  378. static SCM
  379. VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
  380. scm_i_jmp_buf *registers, int resume)
  381. {
  382. /* Instruction pointer: A pointer to the opcode that is currently
  383. running. */
  384. register scm_t_uint32 *ip IP_REG;
  385. /* Frame pointer: A pointer into the stack, off of which we index
  386. arguments and local variables. Pushed at function calls, popped on
  387. returns. */
  388. register SCM *fp FP_REG;
  389. /* Current opcode: A cache of *ip. */
  390. register scm_t_uint32 op;
  391. #ifdef HAVE_LABELS_AS_VALUES
  392. static const void *jump_table_[256] = {
  393. #define LABEL_ADDR(opcode, tag, name, meta) &&op_##tag,
  394. FOR_EACH_VM_OPERATION(LABEL_ADDR)
  395. #undef LABEL_ADDR
  396. };
  397. register const void **jump_table JT_REG;
  398. /* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one
  399. load instruction at each instruction dispatch. */
  400. jump_table = jump_table_;
  401. #endif
  402. /* Load VM registers. */
  403. CACHE_REGISTER ();
  404. VM_HANDLE_INTERRUPTS;
  405. /* Usually a call to the VM happens on application, with the boot
  406. continuation on the next frame. Sometimes it happens after a
  407. non-local exit however; in that case the VM state is all set up,
  408. and we have but to jump to the next opcode. */
  409. if (SCM_UNLIKELY (resume))
  410. NEXT (0);
  411. apply:
  412. while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
  413. {
  414. SCM proc = SCM_FRAME_PROGRAM (fp);
  415. if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
  416. {
  417. LOCAL_SET (0, SCM_STRUCT_PROCEDURE (proc));
  418. continue;
  419. }
  420. if (SCM_HAS_TYP7 (proc, scm_tc7_smob) && SCM_SMOB_APPLICABLE_P (proc))
  421. {
  422. scm_t_uint32 n = FRAME_LOCALS_COUNT();
  423. /* Shuffle args up. */
  424. RESET_FRAME (n + 1);
  425. while (n--)
  426. LOCAL_SET (n + 1, LOCAL_REF (n));
  427. LOCAL_SET (0, SCM_SMOB_DESCRIPTOR (proc).apply_trampoline);
  428. continue;
  429. }
  430. SYNC_IP();
  431. vm_error_wrong_type_apply (proc);
  432. }
  433. /* Let's go! */
  434. ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
  435. NEXT (0);
  436. BEGIN_DISPATCH_SWITCH;
  437. /*
  438. * Call and return
  439. */
  440. /* halt _:24
  441. *
  442. * Bring the VM to a halt, returning all the values from the stack.
  443. */
  444. VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24))
  445. {
  446. /* Boot closure in r0, empty frame in r1/r2, proc in r3, values from r4. */
  447. scm_t_uint32 nvals = FRAME_LOCALS_COUNT_FROM (4);
  448. SCM ret;
  449. if (nvals == 1)
  450. ret = LOCAL_REF (4);
  451. else
  452. {
  453. scm_t_uint32 n;
  454. ret = SCM_EOL;
  455. for (n = nvals; n > 0; n--)
  456. ret = scm_cons (LOCAL_REF (4 + n - 1), ret);
  457. ret = scm_values (ret);
  458. }
  459. vp->ip = SCM_FRAME_RETURN_ADDRESS (fp);
  460. vp->sp = SCM_FRAME_PREVIOUS_SP (fp);
  461. vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
  462. return ret;
  463. }
  464. /* call proc:24 _:8 nlocals:24
  465. *
  466. * Call a procedure. PROC is the local corresponding to a procedure.
  467. * The two values below PROC will be overwritten by the saved call
  468. * frame data. The new frame will have space for NLOCALS locals: one
  469. * for the procedure, and the rest for the arguments which should
  470. * already have been pushed on.
  471. *
  472. * When the call returns, execution proceeds with the next
  473. * instruction. There may be any number of values on the return
  474. * stack; the precise number can be had by subtracting the address of
  475. * PROC from the post-call SP.
  476. */
  477. VM_DEFINE_OP (1, call, "call", OP2 (U8_U24, X8_U24))
  478. {
  479. scm_t_uint32 proc, nlocals;
  480. SCM *old_fp;
  481. UNPACK_24 (op, proc);
  482. UNPACK_24 (ip[1], nlocals);
  483. VM_HANDLE_INTERRUPTS;
  484. old_fp = fp;
  485. fp = vp->fp = old_fp + proc;
  486. SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
  487. SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 2);
  488. RESET_FRAME (nlocals);
  489. PUSH_CONTINUATION_HOOK ();
  490. APPLY_HOOK ();
  491. if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
  492. goto apply;
  493. ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
  494. NEXT (0);
  495. }
  496. /* tail-call nlocals:24
  497. *
  498. * Tail-call a procedure. Requires that the procedure and all of the
  499. * arguments have already been shuffled into position. Will reset the
  500. * frame to NLOCALS.
  501. */
  502. VM_DEFINE_OP (2, tail_call, "tail-call", OP1 (U8_U24))
  503. {
  504. scm_t_uint32 nlocals;
  505. UNPACK_24 (op, nlocals);
  506. VM_HANDLE_INTERRUPTS;
  507. RESET_FRAME (nlocals);
  508. APPLY_HOOK ();
  509. if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
  510. goto apply;
  511. ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
  512. NEXT (0);
  513. }
  514. /* tail-call/shuffle from:24
  515. *
  516. * Tail-call a procedure. The procedure should already be set to slot
  517. * 0. The rest of the args are taken from the frame, starting at
  518. * FROM, shuffled down to start at slot 0. This is part of the
  519. * implementation of the call-with-values builtin.
  520. */
  521. VM_DEFINE_OP (3, tail_call_shuffle, "tail-call/shuffle", OP1 (U8_U24))
  522. {
  523. scm_t_uint32 n, from, nlocals;
  524. UNPACK_24 (op, from);
  525. VM_HANDLE_INTERRUPTS;
  526. VM_ASSERT (from > 0, abort ());
  527. nlocals = FRAME_LOCALS_COUNT ();
  528. for (n = 0; from + n < nlocals; n++)
  529. LOCAL_SET (n + 1, LOCAL_REF (from + n));
  530. RESET_FRAME (n + 1);
  531. APPLY_HOOK ();
  532. if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
  533. goto apply;
  534. ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
  535. NEXT (0);
  536. }
  537. /* receive dst:12 proc:12 _:8 nlocals:24
  538. *
  539. * Receive a single return value from a call whose procedure was in
  540. * PROC, asserting that the call actually returned at least one
  541. * value. Afterwards, resets the frame to NLOCALS locals.
  542. */
  543. VM_DEFINE_OP (4, receive, "receive", OP2 (U8_U12_U12, X8_U24) | OP_DST)
  544. {
  545. scm_t_uint16 dst, proc;
  546. scm_t_uint32 nlocals;
  547. UNPACK_12_12 (op, dst, proc);
  548. UNPACK_24 (ip[1], nlocals);
  549. VM_ASSERT (FRAME_LOCALS_COUNT () > proc + 1, vm_error_no_values ());
  550. LOCAL_SET (dst, LOCAL_REF (proc + 1));
  551. RESET_FRAME (nlocals);
  552. NEXT (2);
  553. }
  554. /* receive-values proc:24 allow-extra?:1 _:7 nvalues:24
  555. *
  556. * Receive a return of multiple values from a call whose procedure was
  557. * in PROC. If fewer than NVALUES values were returned, signal an
  558. * error. Unless ALLOW-EXTRA? is true, require that the number of
  559. * return values equals NVALUES exactly. After receive-values has
  560. * run, the values can be copied down via `mov'.
  561. */
  562. VM_DEFINE_OP (5, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24))
  563. {
  564. scm_t_uint32 proc, nvalues;
  565. UNPACK_24 (op, proc);
  566. UNPACK_24 (ip[1], nvalues);
  567. if (ip[1] & 0x1)
  568. VM_ASSERT (FRAME_LOCALS_COUNT () > proc + nvalues,
  569. vm_error_not_enough_values ());
  570. else
  571. VM_ASSERT (FRAME_LOCALS_COUNT () == proc + 1 + nvalues,
  572. vm_error_wrong_number_of_values (nvalues));
  573. NEXT (2);
  574. }
  575. /* return src:24
  576. *
  577. * Return a value.
  578. */
  579. VM_DEFINE_OP (6, return, "return", OP1 (U8_U24))
  580. {
  581. scm_t_uint32 src;
  582. UNPACK_24 (op, src);
  583. RETURN_ONE_VALUE (LOCAL_REF (src));
  584. }
  585. /* return-values _:24
  586. *
  587. * Return a number of values from a call frame. This opcode
  588. * corresponds to an application of `values' in tail position. As
  589. * with tail calls, we expect that the values have already been
  590. * shuffled down to a contiguous array starting at slot 1.
  591. * We also expect the frame has already been reset.
  592. */
  593. VM_DEFINE_OP (7, return_values, "return-values", OP1 (U8_X24))
  594. {
  595. SCM *old_fp;
  596. VM_HANDLE_INTERRUPTS;
  597. old_fp = fp;
  598. ip = SCM_FRAME_RETURN_ADDRESS (fp);
  599. fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
  600. /* Clear stack frame. */
  601. old_fp[-1] = SCM_BOOL_F;
  602. old_fp[-2] = SCM_BOOL_F;
  603. POP_CONTINUATION_HOOK (old_fp);
  604. NEXT (0);
  605. }
  606. /*
  607. * Specialized call stubs
  608. */
  609. /* subr-call ptr-idx:24
  610. *
  611. * Call a subr, passing all locals in this frame as arguments. Fetch
  612. * the foreign pointer from PTR-IDX, a free variable. Return from the
  613. * calling frame. This instruction is part of the trampolines
  614. * created in gsubr.c, and is not generated by the compiler.
  615. */
  616. VM_DEFINE_OP (8, subr_call, "subr-call", OP1 (U8_U24))
  617. {
  618. scm_t_uint32 ptr_idx;
  619. SCM pointer, ret;
  620. SCM (*subr)();
  621. UNPACK_24 (op, ptr_idx);
  622. pointer = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
  623. subr = SCM_POINTER_VALUE (pointer);
  624. VM_HANDLE_INTERRUPTS;
  625. SYNC_IP ();
  626. switch (FRAME_LOCALS_COUNT_FROM (1))
  627. {
  628. case 0:
  629. ret = subr ();
  630. break;
  631. case 1:
  632. ret = subr (fp[1]);
  633. break;
  634. case 2:
  635. ret = subr (fp[1], fp[2]);
  636. break;
  637. case 3:
  638. ret = subr (fp[1], fp[2], fp[3]);
  639. break;
  640. case 4:
  641. ret = subr (fp[1], fp[2], fp[3], fp[4]);
  642. break;
  643. case 5:
  644. ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5]);
  645. break;
  646. case 6:
  647. ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6]);
  648. break;
  649. case 7:
  650. ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7]);
  651. break;
  652. case 8:
  653. ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8]);
  654. break;
  655. case 9:
  656. ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9]);
  657. break;
  658. case 10:
  659. ret = subr (fp[1], fp[2], fp[3], fp[4], fp[5], fp[6], fp[7], fp[8], fp[9], fp[10]);
  660. break;
  661. default:
  662. abort ();
  663. }
  664. CACHE_FP ();
  665. if (SCM_UNLIKELY (SCM_VALUESP (ret)))
  666. /* multiple values returned to continuation */
  667. RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
  668. else
  669. RETURN_ONE_VALUE (ret);
  670. }
  671. /* foreign-call cif-idx:12 ptr-idx:12
  672. *
  673. * Call a foreign function. Fetch the CIF and foreign pointer from
  674. * CIF-IDX and PTR-IDX, both free variables. Return from the calling
  675. * frame. Arguments are taken from the stack. This instruction is
  676. * part of the trampolines created by the FFI, and is not generated by
  677. * the compiler.
  678. */
  679. VM_DEFINE_OP (9, foreign_call, "foreign-call", OP1 (U8_U12_U12))
  680. {
  681. scm_t_uint16 cif_idx, ptr_idx;
  682. SCM closure, cif, pointer, ret;
  683. UNPACK_12_12 (op, cif_idx, ptr_idx);
  684. closure = LOCAL_REF (0);
  685. cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
  686. pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
  687. SYNC_IP ();
  688. VM_HANDLE_INTERRUPTS;
  689. // FIXME: separate args
  690. ret = scm_i_foreign_call (scm_cons (cif, pointer), LOCAL_ADDRESS (1));
  691. CACHE_FP ();
  692. if (SCM_UNLIKELY (SCM_VALUESP (ret)))
  693. /* multiple values returned to continuation */
  694. RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
  695. else
  696. RETURN_ONE_VALUE (ret);
  697. }
  698. /* continuation-call contregs:24
  699. *
  700. * Return to a continuation, nonlocally. The arguments to the
  701. * continuation are taken from the stack. CONTREGS is a free variable
  702. * containing the reified continuation. This instruction is part of
  703. * the implementation of undelimited continuations, and is not
  704. * generated by the compiler.
  705. */
  706. VM_DEFINE_OP (10, continuation_call, "continuation-call", OP1 (U8_U24))
  707. {
  708. SCM contregs;
  709. scm_t_uint32 contregs_idx;
  710. UNPACK_24 (op, contregs_idx);
  711. contregs =
  712. SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
  713. SYNC_IP ();
  714. scm_i_check_continuation (contregs);
  715. vm_return_to_continuation (scm_i_contregs_vp (contregs),
  716. scm_i_contregs_vm_cont (contregs),
  717. FRAME_LOCALS_COUNT_FROM (1),
  718. LOCAL_ADDRESS (1));
  719. scm_i_reinstate_continuation (contregs);
  720. /* no NEXT */
  721. abort ();
  722. }
  723. /* compose-continuation cont:24
  724. *
  725. * Compose a partial continution with the current continuation. The
  726. * arguments to the continuation are taken from the stack. CONT is a
  727. * free variable containing the reified continuation. This
  728. * instruction is part of the implementation of partial continuations,
  729. * and is not generated by the compiler.
  730. */
  731. VM_DEFINE_OP (11, compose_continuation, "compose-continuation", OP1 (U8_U24))
  732. {
  733. SCM vmcont;
  734. scm_t_uint32 cont_idx;
  735. UNPACK_24 (op, cont_idx);
  736. vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
  737. SYNC_IP ();
  738. VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
  739. vm_error_continuation_not_rewindable (vmcont));
  740. vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM (1),
  741. LOCAL_ADDRESS (1),
  742. &current_thread->dynstack,
  743. registers);
  744. CACHE_REGISTER ();
  745. NEXT (0);
  746. }
  747. /* tail-apply _:24
  748. *
  749. * Tail-apply the procedure in local slot 0 to the rest of the
  750. * arguments. This instruction is part of the implementation of
  751. * `apply', and is not generated by the compiler.
  752. */
  753. VM_DEFINE_OP (12, tail_apply, "tail-apply", OP1 (U8_X24))
  754. {
  755. int i, list_idx, list_len, nlocals;
  756. SCM list;
  757. VM_HANDLE_INTERRUPTS;
  758. nlocals = FRAME_LOCALS_COUNT ();
  759. // At a minimum, there should be apply, f, and the list.
  760. VM_ASSERT (nlocals >= 3, abort ());
  761. list_idx = nlocals - 1;
  762. list = LOCAL_REF (list_idx);
  763. list_len = scm_ilength (list);
  764. VM_ASSERT (list_len >= 0, vm_error_apply_to_non_list (list));
  765. nlocals = nlocals - 2 + list_len;
  766. ALLOC_FRAME (nlocals);
  767. for (i = 1; i < list_idx; i++)
  768. LOCAL_SET (i - 1, LOCAL_REF (i));
  769. /* Null out these slots, just in case there are less than 2 elements
  770. in the list. */
  771. LOCAL_SET (list_idx - 1, SCM_UNDEFINED);
  772. LOCAL_SET (list_idx, SCM_UNDEFINED);
  773. for (i = 0; i < list_len; i++, list = SCM_CDR (list))
  774. LOCAL_SET (list_idx - 1 + i, SCM_CAR (list));
  775. APPLY_HOOK ();
  776. if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
  777. goto apply;
  778. ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
  779. NEXT (0);
  780. }
  781. /* call/cc _:24
  782. *
  783. * Capture the current continuation, and tail-apply the procedure in
  784. * local slot 1 to it. This instruction is part of the implementation
  785. * of `call/cc', and is not generated by the compiler.
  786. */
  787. VM_DEFINE_OP (13, call_cc, "call/cc", OP1 (U8_X24))
  788. {
  789. SCM vm_cont, cont;
  790. scm_t_dynstack *dynstack;
  791. int first;
  792. VM_HANDLE_INTERRUPTS;
  793. SYNC_IP ();
  794. dynstack = scm_dynstack_capture_all (&current_thread->dynstack);
  795. vm_cont = scm_i_vm_capture_stack (vp->stack_base,
  796. SCM_FRAME_DYNAMIC_LINK (fp),
  797. SCM_FRAME_PREVIOUS_SP (fp),
  798. SCM_FRAME_RETURN_ADDRESS (fp),
  799. dynstack,
  800. 0);
  801. /* FIXME: Seems silly to capture the registers here, when they are
  802. already captured in the registers local, which here we are
  803. copying out to the heap; and likewise, the setjmp(&registers)
  804. code already has the non-local return handler. But oh
  805. well! */
  806. cont = scm_i_make_continuation (&first, vp, vm_cont);
  807. if (first)
  808. {
  809. LOCAL_SET (0, LOCAL_REF (1));
  810. LOCAL_SET (1, cont);
  811. RESET_FRAME (2);
  812. APPLY_HOOK ();
  813. if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
  814. goto apply;
  815. ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
  816. NEXT (0);
  817. }
  818. else
  819. {
  820. CACHE_REGISTER ();
  821. ABORT_CONTINUATION_HOOK ();
  822. NEXT (0);
  823. }
  824. }
  825. /* abort _:24
  826. *
  827. * Abort to a prompt handler. The tag is expected in r1, and the rest
  828. * of the values in the frame are returned to the prompt handler.
  829. * This corresponds to a tail application of abort-to-prompt.
  830. */
  831. VM_DEFINE_OP (14, abort, "abort", OP1 (U8_X24))
  832. {
  833. scm_t_uint32 nlocals = FRAME_LOCALS_COUNT ();
  834. ASSERT (nlocals >= 2);
  835. /* FIXME: Really we should capture the caller's registers. Until
  836. then, manually advance the IP so that when the prompt resumes,
  837. it continues with the next instruction. */
  838. ip++;
  839. SYNC_IP ();
  840. vm_abort (vp, LOCAL_REF (1), nlocals - 2, LOCAL_ADDRESS (2),
  841. SCM_EOL, LOCAL_ADDRESS (0), registers);
  842. /* vm_abort should not return */
  843. abort ();
  844. }
  845. /* builtin-ref dst:12 idx:12
  846. *
  847. * Load a builtin stub by index into DST.
  848. */
  849. VM_DEFINE_OP (15, builtin_ref, "builtin-ref", OP1 (U8_U12_U12) | OP_DST)
  850. {
  851. scm_t_uint16 dst, idx;
  852. UNPACK_12_12 (op, dst, idx);
  853. LOCAL_SET (dst, scm_vm_builtin_ref (idx));
  854. NEXT (1);
  855. }
  856. /*
  857. * Function prologues
  858. */
  859. /* br-if-nargs-ne expected:24 _:8 offset:24
  860. * br-if-nargs-lt expected:24 _:8 offset:24
  861. * br-if-nargs-gt expected:24 _:8 offset:24
  862. *
  863. * If the number of actual arguments is not equal, less than, or greater
  864. * than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to
  865. * the current instruction pointer.
  866. */
  867. VM_DEFINE_OP (16, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
  868. {
  869. BR_NARGS (!=);
  870. }
  871. VM_DEFINE_OP (17, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
  872. {
  873. BR_NARGS (<);
  874. }
  875. VM_DEFINE_OP (18, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
  876. {
  877. BR_NARGS (>);
  878. }
  879. /* assert-nargs-ee expected:24
  880. * assert-nargs-ge expected:24
  881. * assert-nargs-le expected:24
  882. *
  883. * If the number of actual arguments is not ==, >=, or <= EXPECTED,
  884. * respectively, signal an error.
  885. */
  886. VM_DEFINE_OP (19, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
  887. {
  888. scm_t_uint32 expected;
  889. UNPACK_24 (op, expected);
  890. VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
  891. vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
  892. NEXT (1);
  893. }
  894. VM_DEFINE_OP (20, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
  895. {
  896. scm_t_uint32 expected;
  897. UNPACK_24 (op, expected);
  898. VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
  899. vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
  900. NEXT (1);
  901. }
  902. VM_DEFINE_OP (21, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24))
  903. {
  904. scm_t_uint32 expected;
  905. UNPACK_24 (op, expected);
  906. VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
  907. vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
  908. NEXT (1);
  909. }
  910. /* alloc-frame nlocals:24
  911. *
  912. * Ensure that there is space on the stack for NLOCALS local variables,
  913. * setting them all to SCM_UNDEFINED, except those nargs values that
  914. * were passed as arguments and procedure.
  915. */
  916. VM_DEFINE_OP (22, alloc_frame, "alloc-frame", OP1 (U8_U24))
  917. {
  918. scm_t_uint32 nlocals, nargs;
  919. UNPACK_24 (op, nlocals);
  920. nargs = FRAME_LOCALS_COUNT ();
  921. ALLOC_FRAME (nlocals);
  922. while (nlocals-- > nargs)
  923. LOCAL_SET (nlocals, SCM_UNDEFINED);
  924. NEXT (1);
  925. }
  926. /* reset-frame nlocals:24
  927. *
  928. * Like alloc-frame, but doesn't check that the stack is big enough.
  929. * Used to reset the frame size to something less than the size that
  930. * was previously set via alloc-frame.
  931. */
  932. VM_DEFINE_OP (23, reset_frame, "reset-frame", OP1 (U8_U24))
  933. {
  934. scm_t_uint32 nlocals;
  935. UNPACK_24 (op, nlocals);
  936. RESET_FRAME (nlocals);
  937. NEXT (1);
  938. }
  939. /* assert-nargs-ee/locals expected:12 nlocals:12
  940. *
  941. * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The
  942. * number of locals reserved is EXPECTED + NLOCALS.
  943. */
  944. VM_DEFINE_OP (24, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12))
  945. {
  946. scm_t_uint16 expected, nlocals;
  947. UNPACK_12_12 (op, expected, nlocals);
  948. VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
  949. vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
  950. ALLOC_FRAME (expected + nlocals);
  951. while (nlocals--)
  952. LOCAL_SET (expected + nlocals, SCM_UNDEFINED);
  953. NEXT (1);
  954. }
  955. /* br-if-npos-gt nreq:24 _:8 npos:24 _:8 offset:24
  956. *
  957. * Find the first positional argument after NREQ. If it is greater
  958. * than NPOS, jump to OFFSET.
  959. *
  960. * This instruction is only emitted for functions with multiple
  961. * clauses, and an earlier clause has keywords and no rest arguments.
  962. * See "Case-lambda" in the manual, for more on how case-lambda
  963. * chooses the clause to apply.
  964. */
  965. VM_DEFINE_OP (25, br_if_npos_gt, "br-if-npos-gt", OP3 (U8_U24, X8_U24, X8_L24))
  966. {
  967. scm_t_uint32 nreq, npos;
  968. UNPACK_24 (op, nreq);
  969. UNPACK_24 (ip[1], npos);
  970. /* We can only have too many positionals if there are more
  971. arguments than NPOS. */
  972. if (FRAME_LOCALS_COUNT() > npos)
  973. {
  974. scm_t_uint32 n;
  975. for (n = nreq; n < npos; n++)
  976. if (scm_is_keyword (LOCAL_REF (n)))
  977. break;
  978. if (n == npos && !scm_is_keyword (LOCAL_REF (n)))
  979. {
  980. scm_t_int32 offset = ip[2];
  981. offset >>= 8; /* Sign-extending shift. */
  982. NEXT (offset);
  983. }
  984. }
  985. NEXT (3);
  986. }
  987. /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32
  988. *
  989. * flags := allow-other-keys:1 has-rest:1 _:6
  990. *
  991. * Find the last positional argument, and shuffle all the rest above
  992. * NTOTAL. Initialize the intervening locals to SCM_UNDEFINED. Then
  993. * load the constant at KW-OFFSET words from the current IP, and use it
  994. * to bind keyword arguments. If HAS-REST, collect all shuffled
  995. * arguments into a list, and store it in NREQ-AND-OPT. Finally, clear
  996. * the arguments that we shuffled up.
  997. *
  998. * A macro-mega-instruction.
  999. */
  1000. VM_DEFINE_OP (26, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24, N32))
  1001. {
  1002. scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n, nargs;
  1003. scm_t_int32 kw_offset;
  1004. scm_t_bits kw_bits;
  1005. SCM kw;
  1006. char allow_other_keys, has_rest;
  1007. UNPACK_24 (op, nreq);
  1008. allow_other_keys = ip[1] & 0x1;
  1009. has_rest = ip[1] & 0x2;
  1010. UNPACK_24 (ip[1], nreq_and_opt);
  1011. UNPACK_24 (ip[2], ntotal);
  1012. kw_offset = ip[3];
  1013. kw_bits = (scm_t_bits) (ip + kw_offset);
  1014. VM_ASSERT (!(kw_bits & 0x7), abort());
  1015. kw = SCM_PACK (kw_bits);
  1016. nargs = FRAME_LOCALS_COUNT ();
  1017. /* look in optionals for first keyword or last positional */
  1018. /* starting after the last required positional arg */
  1019. npositional = nreq;
  1020. while (/* while we have args */
  1021. npositional < nargs
  1022. /* and we still have positionals to fill */
  1023. && npositional < nreq_and_opt
  1024. /* and we haven't reached a keyword yet */
  1025. && !scm_is_keyword (LOCAL_REF (npositional)))
  1026. /* bind this optional arg (by leaving it in place) */
  1027. npositional++;
  1028. nkw = nargs - npositional;
  1029. /* shuffle non-positional arguments above ntotal */
  1030. ALLOC_FRAME (ntotal + nkw);
  1031. n = nkw;
  1032. while (n--)
  1033. LOCAL_SET (ntotal + n, LOCAL_REF (npositional + n));
  1034. /* and fill optionals & keyword args with SCM_UNDEFINED */
  1035. n = npositional;
  1036. while (n < ntotal)
  1037. LOCAL_SET (n++, SCM_UNDEFINED);
  1038. VM_ASSERT (has_rest || (nkw % 2) == 0,
  1039. vm_error_kwargs_length_not_even (SCM_FRAME_PROGRAM (fp)));
  1040. /* Now bind keywords, in the order given. */
  1041. for (n = 0; n < nkw; n++)
  1042. if (scm_is_keyword (LOCAL_REF (ntotal + n)))
  1043. {
  1044. SCM walk;
  1045. for (walk = kw; scm_is_pair (walk); walk = SCM_CDR (walk))
  1046. if (scm_is_eq (SCM_CAAR (walk), LOCAL_REF (ntotal + n)))
  1047. {
  1048. SCM si = SCM_CDAR (walk);
  1049. LOCAL_SET (SCM_I_INUMP (si) ? SCM_I_INUM (si) : scm_to_uint32 (si),
  1050. LOCAL_REF (ntotal + n + 1));
  1051. break;
  1052. }
  1053. VM_ASSERT (scm_is_pair (walk) || allow_other_keys,
  1054. vm_error_kwargs_unrecognized_keyword (SCM_FRAME_PROGRAM (fp),
  1055. LOCAL_REF (ntotal + n)));
  1056. n++;
  1057. }
  1058. else
  1059. VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (SCM_FRAME_PROGRAM (fp),
  1060. LOCAL_REF (ntotal + n)));
  1061. if (has_rest)
  1062. {
  1063. SCM rest = SCM_EOL;
  1064. n = nkw;
  1065. while (n--)
  1066. rest = scm_cons (LOCAL_REF (ntotal + n), rest);
  1067. LOCAL_SET (nreq_and_opt, rest);
  1068. }
  1069. RESET_FRAME (ntotal);
  1070. NEXT (4);
  1071. }
  1072. /* bind-rest dst:24
  1073. *
  1074. * Collect any arguments at or above DST into a list, and store that
  1075. * list at DST.
  1076. */
  1077. VM_DEFINE_OP (27, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
  1078. {
  1079. scm_t_uint32 dst, nargs;
  1080. SCM rest = SCM_EOL;
  1081. UNPACK_24 (op, dst);
  1082. nargs = FRAME_LOCALS_COUNT ();
  1083. if (nargs <= dst)
  1084. {
  1085. ALLOC_FRAME (dst + 1);
  1086. while (nargs < dst)
  1087. LOCAL_SET (nargs++, SCM_UNDEFINED);
  1088. }
  1089. else
  1090. {
  1091. while (nargs-- > dst)
  1092. {
  1093. rest = scm_cons (LOCAL_REF (nargs), rest);
  1094. LOCAL_SET (nargs, SCM_UNDEFINED);
  1095. }
  1096. RESET_FRAME (dst + 1);
  1097. }
  1098. LOCAL_SET (dst, rest);
  1099. NEXT (1);
  1100. }
  1101. /*
  1102. * Branching instructions
  1103. */
  1104. /* br offset:24
  1105. *
  1106. * Add OFFSET, a signed 24-bit number, to the current instruction
  1107. * pointer.
  1108. */
  1109. VM_DEFINE_OP (28, br, "br", OP1 (U8_L24))
  1110. {
  1111. scm_t_int32 offset = op;
  1112. offset >>= 8; /* Sign-extending shift. */
  1113. NEXT (offset);
  1114. }
  1115. /* br-if-true test:24 invert:1 _:7 offset:24
  1116. *
  1117. * If the value in TEST is true for the purposes of Scheme, add
  1118. * OFFSET, a signed 24-bit number, to the current instruction pointer.
  1119. */
  1120. VM_DEFINE_OP (29, br_if_true, "br-if-true", OP2 (U8_U24, B1_X7_L24))
  1121. {
  1122. BR_UNARY (x, scm_is_true (x));
  1123. }
  1124. /* br-if-null test:24 invert:1 _:7 offset:24
  1125. *
  1126. * If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
  1127. * signed 24-bit number, to the current instruction pointer.
  1128. */
  1129. VM_DEFINE_OP (30, br_if_null, "br-if-null", OP2 (U8_U24, B1_X7_L24))
  1130. {
  1131. BR_UNARY (x, scm_is_null (x));
  1132. }
  1133. /* br-if-nil test:24 invert:1 _:7 offset:24
  1134. *
  1135. * If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
  1136. * number, to the current instruction pointer.
  1137. */
  1138. VM_DEFINE_OP (31, br_if_nil, "br-if-nil", OP2 (U8_U24, B1_X7_L24))
  1139. {
  1140. BR_UNARY (x, scm_is_lisp_false (x));
  1141. }
  1142. /* br-if-pair test:24 invert:1 _:7 offset:24
  1143. *
  1144. * If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
  1145. * to the current instruction pointer.
  1146. */
  1147. VM_DEFINE_OP (32, br_if_pair, "br-if-pair", OP2 (U8_U24, B1_X7_L24))
  1148. {
  1149. BR_UNARY (x, scm_is_pair (x));
  1150. }
  1151. /* br-if-struct test:24 invert:1 _:7 offset:24
  1152. *
  1153. * If the value in TEST is a struct, add OFFSET, a signed 24-bit
  1154. * number, to the current instruction pointer.
  1155. */
  1156. VM_DEFINE_OP (33, br_if_struct, "br-if-struct", OP2 (U8_U24, B1_X7_L24))
  1157. {
  1158. BR_UNARY (x, SCM_STRUCTP (x));
  1159. }
  1160. /* br-if-char test:24 invert:1 _:7 offset:24
  1161. *
  1162. * If the value in TEST is a char, add OFFSET, a signed 24-bit number,
  1163. * to the current instruction pointer.
  1164. */
  1165. VM_DEFINE_OP (34, br_if_char, "br-if-char", OP2 (U8_U24, B1_X7_L24))
  1166. {
  1167. BR_UNARY (x, SCM_CHARP (x));
  1168. }
  1169. /* br-if-tc7 test:24 invert:1 tc7:7 offset:24
  1170. *
  1171. * If the value in TEST has the TC7 given in the second word, add
  1172. * OFFSET, a signed 24-bit number, to the current instruction pointer.
  1173. */
  1174. VM_DEFINE_OP (35, br_if_tc7, "br-if-tc7", OP2 (U8_U24, B1_U7_L24))
  1175. {
  1176. BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
  1177. }
  1178. /* br-if-eq a:12 b:12 invert:1 _:7 offset:24
  1179. *
  1180. * If the value in A is eq? to the value in B, add OFFSET, a signed
  1181. * 24-bit number, to the current instruction pointer.
  1182. */
  1183. VM_DEFINE_OP (36, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, B1_X7_L24))
  1184. {
  1185. BR_BINARY (x, y, scm_is_eq (x, y));
  1186. }
  1187. /* br-if-eqv a:12 b:12 invert:1 _:7 offset:24
  1188. *
  1189. * If the value in A is eqv? to the value in B, add OFFSET, a signed
  1190. * 24-bit number, to the current instruction pointer.
  1191. */
  1192. VM_DEFINE_OP (37, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, B1_X7_L24))
  1193. {
  1194. BR_BINARY (x, y,
  1195. scm_is_eq (x, y)
  1196. || (SCM_NIMP (x) && SCM_NIMP (y)
  1197. && scm_is_true (scm_eqv_p (x, y))));
  1198. }
  1199. // FIXME: remove, have compiler inline eqv test instead
  1200. /* br-if-equal a:12 b:12 invert:1 _:7 offset:24
  1201. *
  1202. * If the value in A is equal? to the value in B, add OFFSET, a signed
  1203. * 24-bit number, to the current instruction pointer.
  1204. */
  1205. // FIXME: Should sync_ip before calling out and cache_fp before coming
  1206. // back! Another reason to remove this opcode!
  1207. VM_DEFINE_OP (38, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, B1_X7_L24))
  1208. {
  1209. BR_BINARY (x, y,
  1210. scm_is_eq (x, y)
  1211. || (SCM_NIMP (x) && SCM_NIMP (y)
  1212. && scm_is_true (scm_equal_p (x, y))));
  1213. }
  1214. /* br-if-= a:12 b:12 invert:1 _:7 offset:24
  1215. *
  1216. * If the value in A is = to the value in B, add OFFSET, a signed
  1217. * 24-bit number, to the current instruction pointer.
  1218. */
  1219. VM_DEFINE_OP (39, br_if_ee, "br-if-=", OP2 (U8_U12_U12, B1_X7_L24))
  1220. {
  1221. BR_ARITHMETIC (==, scm_num_eq_p);
  1222. }
  1223. /* br-if-< a:12 b:12 invert:1 _:7 offset:24
  1224. *
  1225. * If the value in A is < to the value in B, add OFFSET, a signed
  1226. * 24-bit number, to the current instruction pointer.
  1227. */
  1228. VM_DEFINE_OP (40, br_if_lt, "br-if-<", OP2 (U8_U12_U12, B1_X7_L24))
  1229. {
  1230. BR_ARITHMETIC (<, scm_less_p);
  1231. }
  1232. /* br-if-<= a:12 b:12 invert:1 _:7 offset:24
  1233. *
  1234. * If the value in A is <= to the value in B, add OFFSET, a signed
  1235. * 24-bit number, to the current instruction pointer.
  1236. */
  1237. VM_DEFINE_OP (41, br_if_le, "br-if-<=", OP2 (U8_U12_U12, B1_X7_L24))
  1238. {
  1239. BR_ARITHMETIC (<=, scm_leq_p);
  1240. }
  1241. /*
  1242. * Lexical binding instructions
  1243. */
  1244. /* mov dst:12 src:12
  1245. *
  1246. * Copy a value from one local slot to another.
  1247. */
  1248. VM_DEFINE_OP (42, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
  1249. {
  1250. scm_t_uint16 dst;
  1251. scm_t_uint16 src;
  1252. UNPACK_12_12 (op, dst, src);
  1253. LOCAL_SET (dst, LOCAL_REF (src));
  1254. NEXT (1);
  1255. }
  1256. /* long-mov dst:24 _:8 src:24
  1257. *
  1258. * Copy a value from one local slot to another.
  1259. */
  1260. VM_DEFINE_OP (43, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
  1261. {
  1262. scm_t_uint32 dst;
  1263. scm_t_uint32 src;
  1264. UNPACK_24 (op, dst);
  1265. UNPACK_24 (ip[1], src);
  1266. LOCAL_SET (dst, LOCAL_REF (src));
  1267. NEXT (2);
  1268. }
  1269. /* box dst:12 src:12
  1270. *
  1271. * Create a new variable holding SRC, and place it in DST.
  1272. */
  1273. VM_DEFINE_OP (44, box, "box", OP1 (U8_U12_U12) | OP_DST)
  1274. {
  1275. scm_t_uint16 dst, src;
  1276. UNPACK_12_12 (op, dst, src);
  1277. LOCAL_SET (dst, scm_cell (scm_tc7_variable, SCM_UNPACK (LOCAL_REF (src))));
  1278. NEXT (1);
  1279. }
  1280. /* box-ref dst:12 src:12
  1281. *
  1282. * Unpack the variable at SRC into DST, asserting that the variable is
  1283. * actually bound.
  1284. */
  1285. VM_DEFINE_OP (45, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
  1286. {
  1287. scm_t_uint16 dst, src;
  1288. SCM var;
  1289. UNPACK_12_12 (op, dst, src);
  1290. var = LOCAL_REF (src);
  1291. VM_ASSERT (SCM_VARIABLEP (var),
  1292. vm_error_not_a_variable ("variable-ref", var));
  1293. VM_ASSERT (VARIABLE_BOUNDP (var),
  1294. vm_error_unbound (SCM_FRAME_PROGRAM (fp), var));
  1295. LOCAL_SET (dst, VARIABLE_REF (var));
  1296. NEXT (1);
  1297. }
  1298. /* box-set! dst:12 src:12
  1299. *
  1300. * Set the contents of the variable at DST to SET.
  1301. */
  1302. VM_DEFINE_OP (46, box_set, "box-set!", OP1 (U8_U12_U12))
  1303. {
  1304. scm_t_uint16 dst, src;
  1305. SCM var;
  1306. UNPACK_12_12 (op, dst, src);
  1307. var = LOCAL_REF (dst);
  1308. VM_ASSERT (SCM_VARIABLEP (var),
  1309. vm_error_not_a_variable ("variable-set!", var));
  1310. VARIABLE_SET (var, LOCAL_REF (src));
  1311. NEXT (1);
  1312. }
  1313. /* make-closure dst:24 offset:32 _:8 nfree:24
  1314. *
  1315. * Make a new closure, and write it to DST. The code for the closure
  1316. * will be found at OFFSET words from the current IP. OFFSET is a
  1317. * signed 32-bit integer. Space for NFREE free variables will be
  1318. * allocated.
  1319. */
  1320. VM_DEFINE_OP (47, make_closure, "make-closure", OP3 (U8_U24, L32, X8_U24) | OP_DST)
  1321. {
  1322. scm_t_uint32 dst, nfree, n;
  1323. scm_t_int32 offset;
  1324. SCM closure;
  1325. UNPACK_24 (op, dst);
  1326. offset = ip[1];
  1327. UNPACK_24 (ip[2], nfree);
  1328. // FIXME: Assert range of nfree?
  1329. closure = scm_words (scm_tc7_program | (nfree << 16), nfree + 2);
  1330. SCM_SET_CELL_WORD_1 (closure, ip + offset);
  1331. // FIXME: Elide these initializations?
  1332. for (n = 0; n < nfree; n++)
  1333. SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
  1334. LOCAL_SET (dst, closure);
  1335. NEXT (3);
  1336. }
  1337. /* free-ref dst:12 src:12 _:8 idx:24
  1338. *
  1339. * Load free variable IDX from the closure SRC into local slot DST.
  1340. */
  1341. VM_DEFINE_OP (48, free_ref, "free-ref", OP2 (U8_U12_U12, X8_U24) | OP_DST)
  1342. {
  1343. scm_t_uint16 dst, src;
  1344. scm_t_uint32 idx;
  1345. UNPACK_12_12 (op, dst, src);
  1346. UNPACK_24 (ip[1], idx);
  1347. /* CHECK_FREE_VARIABLE (src); */
  1348. LOCAL_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
  1349. NEXT (2);
  1350. }
  1351. /* free-set! dst:12 src:12 _:8 idx:24
  1352. *
  1353. * Set free variable IDX from the closure DST to SRC.
  1354. */
  1355. VM_DEFINE_OP (49, free_set, "free-set!", OP2 (U8_U12_U12, X8_U24))
  1356. {
  1357. scm_t_uint16 dst, src;
  1358. scm_t_uint32 idx;
  1359. UNPACK_12_12 (op, dst, src);
  1360. UNPACK_24 (ip[1], idx);
  1361. /* CHECK_FREE_VARIABLE (src); */
  1362. SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
  1363. NEXT (2);
  1364. }
  1365. /*
  1366. * Immediates and statically allocated non-immediates
  1367. */
  1368. /* make-short-immediate dst:8 low-bits:16
  1369. *
  1370. * Make an immediate whose low bits are LOW-BITS, and whose top bits are
  1371. * 0.
  1372. */
  1373. VM_DEFINE_OP (50, make_short_immediate, "make-short-immediate", OP1 (U8_U8_I16) | OP_DST)
  1374. {
  1375. scm_t_uint8 dst;
  1376. scm_t_bits val;
  1377. UNPACK_8_16 (op, dst, val);
  1378. LOCAL_SET (dst, SCM_PACK (val));
  1379. NEXT (1);
  1380. }
  1381. /* make-long-immediate dst:24 low-bits:32
  1382. *
  1383. * Make an immediate whose low bits are LOW-BITS, and whose top bits are
  1384. * 0.
  1385. */
  1386. VM_DEFINE_OP (51, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32))
  1387. {
  1388. scm_t_uint32 dst;
  1389. scm_t_bits val;
  1390. UNPACK_24 (op, dst);
  1391. val = ip[1];
  1392. LOCAL_SET (dst, SCM_PACK (val));
  1393. NEXT (2);
  1394. }
  1395. /* make-long-long-immediate dst:24 high-bits:32 low-bits:32
  1396. *
  1397. * Make an immediate with HIGH-BITS and LOW-BITS.
  1398. */
  1399. VM_DEFINE_OP (52, make_long_long_immediate, "make-long-long-immediate", OP3 (U8_U24, A32, B32) | OP_DST)
  1400. {
  1401. scm_t_uint32 dst;
  1402. scm_t_bits val;
  1403. UNPACK_24 (op, dst);
  1404. #if SIZEOF_SCM_T_BITS > 4
  1405. val = ip[1];
  1406. val <<= 32;
  1407. val |= ip[2];
  1408. #else
  1409. ASSERT (ip[1] == 0);
  1410. val = ip[2];
  1411. #endif
  1412. LOCAL_SET (dst, SCM_PACK (val));
  1413. NEXT (3);
  1414. }
  1415. /* make-non-immediate dst:24 offset:32
  1416. *
  1417. * Load a pointer to statically allocated memory into DST. The
  1418. * object's memory is will be found OFFSET 32-bit words away from the
  1419. * current instruction pointer. OFFSET is a signed value. The
  1420. * intention here is that the compiler would produce an object file
  1421. * containing the words of a non-immediate object, and this
  1422. * instruction creates a pointer to that memory, effectively
  1423. * resurrecting that object.
  1424. *
  1425. * Whether the object is mutable or immutable depends on where it was
  1426. * allocated by the compiler, and loaded by the loader.
  1427. */
  1428. VM_DEFINE_OP (53, make_non_immediate, "make-non-immediate", OP2 (U8_U24, N32) | OP_DST)
  1429. {
  1430. scm_t_uint32 dst;
  1431. scm_t_int32 offset;
  1432. scm_t_uint32* loc;
  1433. scm_t_bits unpacked;
  1434. UNPACK_24 (op, dst);
  1435. offset = ip[1];
  1436. loc = ip + offset;
  1437. unpacked = (scm_t_bits) loc;
  1438. VM_ASSERT (!(unpacked & 0x7), abort());
  1439. LOCAL_SET (dst, SCM_PACK (unpacked));
  1440. NEXT (2);
  1441. }
  1442. /* static-ref dst:24 offset:32
  1443. *
  1444. * Load a SCM value into DST. The SCM value will be fetched from
  1445. * memory, OFFSET 32-bit words away from the current instruction
  1446. * pointer. OFFSET is a signed value.
  1447. *
  1448. * The intention is for this instruction to be used to load constants
  1449. * that the compiler is unable to statically allocate, like symbols.
  1450. * These values would be initialized when the object file loads.
  1451. */
  1452. VM_DEFINE_OP (54, static_ref, "static-ref", OP2 (U8_U24, S32))
  1453. {
  1454. scm_t_uint32 dst;
  1455. scm_t_int32 offset;
  1456. scm_t_uint32* loc;
  1457. scm_t_uintptr loc_bits;
  1458. UNPACK_24 (op, dst);
  1459. offset = ip[1];
  1460. loc = ip + offset;
  1461. loc_bits = (scm_t_uintptr) loc;
  1462. VM_ASSERT (ALIGNED_P (loc, SCM), abort());
  1463. LOCAL_SET (dst, *((SCM *) loc_bits));
  1464. NEXT (2);
  1465. }
  1466. /* static-set! src:24 offset:32
  1467. *
  1468. * Store a SCM value into memory, OFFSET 32-bit words away from the
  1469. * current instruction pointer. OFFSET is a signed value.
  1470. */
  1471. VM_DEFINE_OP (55, static_set, "static-set!", OP2 (U8_U24, LO32))
  1472. {
  1473. scm_t_uint32 src;
  1474. scm_t_int32 offset;
  1475. scm_t_uint32* loc;
  1476. UNPACK_24 (op, src);
  1477. offset = ip[1];
  1478. loc = ip + offset;
  1479. VM_ASSERT (ALIGNED_P (loc, SCM), abort());
  1480. *((SCM *) loc) = LOCAL_REF (src);
  1481. NEXT (2);
  1482. }
  1483. /* static-patch! _:24 dst-offset:32 src-offset:32
  1484. *
  1485. * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
  1486. * are signed 32-bit values, indicating a memory address as a number
  1487. * of 32-bit words away from the current instruction pointer.
  1488. */
  1489. VM_DEFINE_OP (56, static_patch, "static-patch!", OP3 (U8_X24, LO32, L32))
  1490. {
  1491. scm_t_int32 dst_offset, src_offset;
  1492. void *src;
  1493. void** dst_loc;
  1494. dst_offset = ip[1];
  1495. src_offset = ip[2];
  1496. dst_loc = (void **) (ip + dst_offset);
  1497. src = ip + src_offset;
  1498. VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
  1499. *dst_loc = src;
  1500. NEXT (3);
  1501. }
  1502. /*
  1503. * Mutable top-level bindings
  1504. */
  1505. /* There are three slightly different ways to resolve toplevel
  1506. variables.
  1507. 1. A toplevel reference outside of a function. These need to be
  1508. looked up when the expression is evaluated -- no later, and no
  1509. before. They are looked up relative to the module that is
  1510. current when the expression is evaluated. For example:
  1511. (if (foo) a b)
  1512. The "resolve" instruction resolves the variable (box), and then
  1513. access is via box-ref or box-set!.
  1514. 2. A toplevel reference inside a function. These are looked up
  1515. relative to the module that was current when the function was
  1516. defined. Unlike code at the toplevel, which is usually run only
  1517. once, these bindings benefit from memoized lookup, in which the
  1518. variable resulting from the lookup is cached in the function.
  1519. (lambda () (if (foo) a b))
  1520. The toplevel-box instruction is equivalent to "resolve", but
  1521. caches the resulting variable in statically allocated memory.
  1522. 3. A reference to an identifier with respect to a particular
  1523. module. This can happen for primitive references, and
  1524. references residualized by macro expansions. These can always
  1525. be cached. Use module-box for these.
  1526. */
  1527. /* current-module dst:24
  1528. *
  1529. * Store the current module in DST.
  1530. */
  1531. VM_DEFINE_OP (57, current_module, "current-module", OP1 (U8_U24) | OP_DST)
  1532. {
  1533. scm_t_uint32 dst;
  1534. UNPACK_24 (op, dst);
  1535. SYNC_IP ();
  1536. LOCAL_SET (dst, scm_current_module ());
  1537. NEXT (1);
  1538. }
  1539. /* resolve dst:24 bound?:1 _:7 sym:24
  1540. *
  1541. * Resolve SYM in the current module, and place the resulting variable
  1542. * in DST.
  1543. */
  1544. VM_DEFINE_OP (58, resolve, "resolve", OP2 (U8_U24, B1_X7_U24) | OP_DST)
  1545. {
  1546. scm_t_uint32 dst;
  1547. scm_t_uint32 sym;
  1548. SCM var;
  1549. UNPACK_24 (op, dst);
  1550. UNPACK_24 (ip[1], sym);
  1551. SYNC_IP ();
  1552. var = scm_lookup (LOCAL_REF (sym));
  1553. CACHE_FP ();
  1554. if (ip[1] & 0x1)
  1555. VM_ASSERT (VARIABLE_BOUNDP (var),
  1556. vm_error_unbound (fp[0], LOCAL_REF (sym)));
  1557. LOCAL_SET (dst, var);
  1558. NEXT (2);
  1559. }
  1560. /* define! sym:12 val:12
  1561. *
  1562. * Look up a binding for SYM in the current module, creating it if
  1563. * necessary. Set its value to VAL.
  1564. */
  1565. VM_DEFINE_OP (59, define, "define!", OP1 (U8_U12_U12))
  1566. {
  1567. scm_t_uint16 sym, val;
  1568. UNPACK_12_12 (op, sym, val);
  1569. SYNC_IP ();
  1570. scm_define (LOCAL_REF (sym), LOCAL_REF (val));
  1571. CACHE_FP ();
  1572. NEXT (1);
  1573. }
  1574. /* toplevel-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
  1575. *
  1576. * Load a SCM value. The SCM value will be fetched from memory,
  1577. * VAR-OFFSET 32-bit words away from the current instruction pointer.
  1578. * VAR-OFFSET is a signed value. Up to here, toplevel-box is like
  1579. * static-ref.
  1580. *
  1581. * Then, if the loaded value is a variable, it is placed in DST, and control
  1582. * flow continues.
  1583. *
  1584. * Otherwise, we have to resolve the variable. In that case we load
  1585. * the module from MOD-OFFSET, just as we loaded the variable.
  1586. * Usually the module gets set when the closure is created. The name
  1587. * is an offset to a symbol.
  1588. *
  1589. * We use the module and the symbol to resolve the variable, placing it in
  1590. * DST, and caching the resolved variable so that we will hit the cache next
  1591. * time.
  1592. */
  1593. VM_DEFINE_OP (60, toplevel_box, "toplevel-box", OP5 (U8_U24, S32, S32, N32, B1_X31) | OP_DST)
  1594. {
  1595. scm_t_uint32 dst;
  1596. scm_t_int32 var_offset;
  1597. scm_t_uint32* var_loc_u32;
  1598. SCM *var_loc;
  1599. SCM var;
  1600. UNPACK_24 (op, dst);
  1601. var_offset = ip[1];
  1602. var_loc_u32 = ip + var_offset;
  1603. VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
  1604. var_loc = (SCM *) var_loc_u32;
  1605. var = *var_loc;
  1606. if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
  1607. {
  1608. SCM mod, sym;
  1609. scm_t_int32 mod_offset = ip[2]; /* signed */
  1610. scm_t_int32 sym_offset = ip[3]; /* signed */
  1611. scm_t_uint32 *mod_loc = ip + mod_offset;
  1612. scm_t_uint32 *sym_loc = ip + sym_offset;
  1613. SYNC_IP ();
  1614. VM_ASSERT (ALIGNED_P (mod_loc, SCM), abort());
  1615. VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
  1616. mod = *((SCM *) mod_loc);
  1617. sym = *((SCM *) sym_loc);
  1618. /* If the toplevel scope was captured before modules were
  1619. booted, use the root module. */
  1620. if (scm_is_false (mod))
  1621. mod = scm_the_root_module ();
  1622. var = scm_module_lookup (mod, sym);
  1623. CACHE_FP ();
  1624. if (ip[4] & 0x1)
  1625. VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
  1626. *var_loc = var;
  1627. }
  1628. LOCAL_SET (dst, var);
  1629. NEXT (5);
  1630. }
  1631. /* module-box dst:24 var-offset:32 mod-offset:32 sym-offset:32 bound?:1 _:31
  1632. *
  1633. * Like toplevel-box, except MOD-OFFSET points at the name of a module
  1634. * instead of the module itself.
  1635. */
  1636. VM_DEFINE_OP (61, module_box, "module-box", OP5 (U8_U24, S32, N32, N32, B1_X31) | OP_DST)
  1637. {
  1638. scm_t_uint32 dst;
  1639. scm_t_int32 var_offset;
  1640. scm_t_uint32* var_loc_u32;
  1641. SCM *var_loc;
  1642. SCM var;
  1643. UNPACK_24 (op, dst);
  1644. var_offset = ip[1];
  1645. var_loc_u32 = ip + var_offset;
  1646. VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort());
  1647. var_loc = (SCM *) var_loc_u32;
  1648. var = *var_loc;
  1649. if (SCM_UNLIKELY (!SCM_VARIABLEP (var)))
  1650. {
  1651. SCM modname, sym;
  1652. scm_t_int32 modname_offset = ip[2]; /* signed */
  1653. scm_t_int32 sym_offset = ip[3]; /* signed */
  1654. scm_t_uint32 *modname_words = ip + modname_offset;
  1655. scm_t_uint32 *sym_loc = ip + sym_offset;
  1656. SYNC_IP ();
  1657. VM_ASSERT (!(((scm_t_uintptr) modname_words) & 0x7), abort());
  1658. VM_ASSERT (ALIGNED_P (sym_loc, SCM), abort());
  1659. modname = SCM_PACK ((scm_t_bits) modname_words);
  1660. sym = *((SCM *) sym_loc);
  1661. if (!scm_module_system_booted_p)
  1662. {
  1663. #ifdef VM_ENABLE_PARANOID_ASSERTIONS
  1664. ASSERT
  1665. (scm_is_true
  1666. scm_equal_p (modname,
  1667. scm_list_2 (SCM_BOOL_T,
  1668. scm_from_utf8_symbol ("guile"))));
  1669. #endif
  1670. var = scm_lookup (sym);
  1671. }
  1672. else if (scm_is_true (SCM_CAR (modname)))
  1673. var = scm_public_lookup (SCM_CDR (modname), sym);
  1674. else
  1675. var = scm_private_lookup (SCM_CDR (modname), sym);
  1676. CACHE_FP ();
  1677. if (ip[4] & 0x1)
  1678. VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
  1679. *var_loc = var;
  1680. }
  1681. LOCAL_SET (dst, var);
  1682. NEXT (5);
  1683. }
  1684. /*
  1685. * The dynamic environment
  1686. */
  1687. /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24
  1688. *
  1689. * Push a new prompt on the dynamic stack, with a tag from TAG and a
  1690. * handler at HANDLER-OFFSET words from the current IP. The handler
  1691. * will expect a multiple-value return as if from a call with the
  1692. * procedure at PROC-SLOT.
  1693. */
  1694. VM_DEFINE_OP (62, prompt, "prompt", OP3 (U8_U24, B1_X7_U24, X8_L24))
  1695. {
  1696. scm_t_uint32 tag, proc_slot;
  1697. scm_t_int32 offset;
  1698. scm_t_uint8 escape_only_p;
  1699. scm_t_dynstack_prompt_flags flags;
  1700. UNPACK_24 (op, tag);
  1701. escape_only_p = ip[1] & 0x1;
  1702. UNPACK_24 (ip[1], proc_slot);
  1703. offset = ip[2];
  1704. offset >>= 8; /* Sign extension */
  1705. /* Push the prompt onto the dynamic stack. */
  1706. flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
  1707. scm_dynstack_push_prompt (&current_thread->dynstack, flags,
  1708. LOCAL_REF (tag),
  1709. fp - vp->stack_base,
  1710. LOCAL_ADDRESS (proc_slot) - vp->stack_base,
  1711. ip + offset,
  1712. registers);
  1713. NEXT (3);
  1714. }
  1715. /* wind winder:12 unwinder:12
  1716. *
  1717. * Push wind and unwind procedures onto the dynamic stack. Note that
  1718. * neither are actually called; the compiler should emit calls to wind
  1719. * and unwind for the normal dynamic-wind control flow. Also note that
  1720. * the compiler should have inserted checks that they wind and unwind
  1721. * procs are thunks, if it could not prove that to be the case.
  1722. */
  1723. VM_DEFINE_OP (63, wind, "wind", OP1 (U8_U12_U12))
  1724. {
  1725. scm_t_uint16 winder, unwinder;
  1726. UNPACK_12_12 (op, winder, unwinder);
  1727. scm_dynstack_push_dynwind (&current_thread->dynstack,
  1728. LOCAL_REF (winder), LOCAL_REF (unwinder));
  1729. NEXT (1);
  1730. }
  1731. /* unwind _:24
  1732. *
  1733. * A normal exit from the dynamic extent of an expression. Pop the top
  1734. * entry off of the dynamic stack.
  1735. */
  1736. VM_DEFINE_OP (64, unwind, "unwind", OP1 (U8_X24))
  1737. {
  1738. scm_dynstack_pop (&current_thread->dynstack);
  1739. NEXT (1);
  1740. }
  1741. /* push-fluid fluid:12 value:12
  1742. *
  1743. * Dynamically bind VALUE to FLUID.
  1744. */
  1745. VM_DEFINE_OP (65, push_fluid, "push-fluid", OP1 (U8_U12_U12))
  1746. {
  1747. scm_t_uint32 fluid, value;
  1748. UNPACK_12_12 (op, fluid, value);
  1749. scm_dynstack_push_fluid (&current_thread->dynstack,
  1750. LOCAL_REF (fluid), LOCAL_REF (value),
  1751. current_thread->dynamic_state);
  1752. NEXT (1);
  1753. }
  1754. /* pop-fluid _:24
  1755. *
  1756. * Leave the dynamic extent of a with-fluid* expression, restoring the
  1757. * fluid to its previous value.
  1758. */
  1759. VM_DEFINE_OP (66, pop_fluid, "pop-fluid", OP1 (U8_X24))
  1760. {
  1761. /* This function must not allocate. */
  1762. scm_dynstack_unwind_fluid (&current_thread->dynstack,
  1763. current_thread->dynamic_state);
  1764. NEXT (1);
  1765. }
  1766. /* fluid-ref dst:12 src:12
  1767. *
  1768. * Reference the fluid in SRC, and place the value in DST.
  1769. */
  1770. VM_DEFINE_OP (67, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
  1771. {
  1772. scm_t_uint16 dst, src;
  1773. size_t num;
  1774. SCM fluid, fluids;
  1775. UNPACK_12_12 (op, dst, src);
  1776. fluid = LOCAL_REF (src);
  1777. fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
  1778. if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
  1779. || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
  1780. {
  1781. /* Punt dynstate expansion and error handling to the C proc. */
  1782. SYNC_IP ();
  1783. LOCAL_SET (dst, scm_fluid_ref (fluid));
  1784. }
  1785. else
  1786. {
  1787. SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
  1788. if (scm_is_eq (val, SCM_UNDEFINED))
  1789. val = SCM_I_FLUID_DEFAULT (fluid);
  1790. VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
  1791. vm_error_unbound_fluid (SCM_FRAME_PROGRAM (fp), fluid));
  1792. LOCAL_SET (dst, val);
  1793. }
  1794. NEXT (1);
  1795. }
  1796. /* fluid-set fluid:12 val:12
  1797. *
  1798. * Set the value of the fluid in DST to the value in SRC.
  1799. */
  1800. VM_DEFINE_OP (68, fluid_set, "fluid-set", OP1 (U8_U12_U12))
  1801. {
  1802. scm_t_uint16 a, b;
  1803. size_t num;
  1804. SCM fluid, fluids;
  1805. UNPACK_12_12 (op, a, b);
  1806. fluid = LOCAL_REF (a);
  1807. fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
  1808. if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
  1809. || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
  1810. {
  1811. /* Punt dynstate expansion and error handling to the C proc. */
  1812. SYNC_IP ();
  1813. scm_fluid_set_x (fluid, LOCAL_REF (b));
  1814. }
  1815. else
  1816. SCM_SIMPLE_VECTOR_SET (fluids, num, LOCAL_REF (b));
  1817. NEXT (1);
  1818. }
  1819. /*
  1820. * Strings, symbols, and keywords
  1821. */
  1822. /* string-length dst:12 src:12
  1823. *
  1824. * Store the length of the string in SRC in DST.
  1825. */
  1826. VM_DEFINE_OP (69, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
  1827. {
  1828. ARGS1 (str);
  1829. if (SCM_LIKELY (scm_is_string (str)))
  1830. RETURN (SCM_I_MAKINUM (scm_i_string_length (str)));
  1831. else
  1832. {
  1833. SYNC_IP ();
  1834. RETURN (scm_string_length (str));
  1835. }
  1836. }
  1837. /* string-ref dst:8 src:8 idx:8
  1838. *
  1839. * Fetch the character at position IDX in the string in SRC, and store
  1840. * it in DST.
  1841. */
  1842. VM_DEFINE_OP (70, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  1843. {
  1844. scm_t_signed_bits i = 0;
  1845. ARGS2 (str, idx);
  1846. if (SCM_LIKELY (scm_is_string (str)
  1847. && SCM_I_INUMP (idx)
  1848. && ((i = SCM_I_INUM (idx)) >= 0)
  1849. && i < scm_i_string_length (str)))
  1850. RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, i)));
  1851. else
  1852. {
  1853. SYNC_IP ();
  1854. RETURN (scm_string_ref (str, idx));
  1855. }
  1856. }
  1857. /* No string-set! instruction, as there is no good fast path there. */
  1858. /* string->number dst:12 src:12
  1859. *
  1860. * Parse a string in SRC to a number, and store in DST.
  1861. */
  1862. VM_DEFINE_OP (71, string_to_number, "string->number", OP1 (U8_U12_U12) | OP_DST)
  1863. {
  1864. scm_t_uint16 dst, src;
  1865. UNPACK_12_12 (op, dst, src);
  1866. SYNC_IP ();
  1867. LOCAL_SET (dst,
  1868. scm_string_to_number (LOCAL_REF (src),
  1869. SCM_UNDEFINED /* radix = 10 */));
  1870. NEXT (1);
  1871. }
  1872. /* string->symbol dst:12 src:12
  1873. *
  1874. * Parse a string in SRC to a symbol, and store in DST.
  1875. */
  1876. VM_DEFINE_OP (72, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) | OP_DST)
  1877. {
  1878. scm_t_uint16 dst, src;
  1879. UNPACK_12_12 (op, dst, src);
  1880. SYNC_IP ();
  1881. LOCAL_SET (dst, scm_string_to_symbol (LOCAL_REF (src)));
  1882. NEXT (1);
  1883. }
  1884. /* symbol->keyword dst:12 src:12
  1885. *
  1886. * Make a keyword from the symbol in SRC, and store it in DST.
  1887. */
  1888. VM_DEFINE_OP (73, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST)
  1889. {
  1890. scm_t_uint16 dst, src;
  1891. UNPACK_12_12 (op, dst, src);
  1892. SYNC_IP ();
  1893. LOCAL_SET (dst, scm_symbol_to_keyword (LOCAL_REF (src)));
  1894. NEXT (1);
  1895. }
  1896. /*
  1897. * Pairs
  1898. */
  1899. /* cons dst:8 car:8 cdr:8
  1900. *
  1901. * Cons CAR and CDR, and store the result in DST.
  1902. */
  1903. VM_DEFINE_OP (74, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
  1904. {
  1905. ARGS2 (x, y);
  1906. RETURN (scm_cons (x, y));
  1907. }
  1908. /* car dst:12 src:12
  1909. *
  1910. * Place the car of SRC in DST.
  1911. */
  1912. VM_DEFINE_OP (75, car, "car", OP1 (U8_U12_U12) | OP_DST)
  1913. {
  1914. ARGS1 (x);
  1915. VM_VALIDATE_PAIR (x, "car");
  1916. RETURN (SCM_CAR (x));
  1917. }
  1918. /* cdr dst:12 src:12
  1919. *
  1920. * Place the cdr of SRC in DST.
  1921. */
  1922. VM_DEFINE_OP (76, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
  1923. {
  1924. ARGS1 (x);
  1925. VM_VALIDATE_PAIR (x, "cdr");
  1926. RETURN (SCM_CDR (x));
  1927. }
  1928. /* set-car! pair:12 car:12
  1929. *
  1930. * Set the car of DST to SRC.
  1931. */
  1932. VM_DEFINE_OP (77, set_car, "set-car!", OP1 (U8_U12_U12))
  1933. {
  1934. scm_t_uint16 a, b;
  1935. SCM x, y;
  1936. UNPACK_12_12 (op, a, b);
  1937. x = LOCAL_REF (a);
  1938. y = LOCAL_REF (b);
  1939. VM_VALIDATE_PAIR (x, "set-car!");
  1940. SCM_SETCAR (x, y);
  1941. NEXT (1);
  1942. }
  1943. /* set-cdr! pair:12 cdr:12
  1944. *
  1945. * Set the cdr of DST to SRC.
  1946. */
  1947. VM_DEFINE_OP (78, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
  1948. {
  1949. scm_t_uint16 a, b;
  1950. SCM x, y;
  1951. UNPACK_12_12 (op, a, b);
  1952. x = LOCAL_REF (a);
  1953. y = LOCAL_REF (b);
  1954. VM_VALIDATE_PAIR (x, "set-car!");
  1955. SCM_SETCDR (x, y);
  1956. NEXT (1);
  1957. }
  1958. /*
  1959. * Numeric operations
  1960. */
  1961. /* add dst:8 a:8 b:8
  1962. *
  1963. * Add A to B, and place the result in DST.
  1964. */
  1965. VM_DEFINE_OP (79, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
  1966. {
  1967. BINARY_INTEGER_OP (+, scm_sum);
  1968. }
  1969. /* add1 dst:12 src:12
  1970. *
  1971. * Add 1 to the value in SRC, and place the result in DST.
  1972. */
  1973. VM_DEFINE_OP (80, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
  1974. {
  1975. ARGS1 (x);
  1976. /* Check for overflow. We must avoid overflow in the signed
  1977. addition below, even if X is not an inum. */
  1978. if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) <= INUM_MAX - INUM_STEP))
  1979. {
  1980. SCM result;
  1981. /* Add 1 to the integer without untagging. */
  1982. result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) + INUM_STEP);
  1983. if (SCM_LIKELY (SCM_I_INUMP (result)))
  1984. RETURN (result);
  1985. }
  1986. RETURN_EXP (scm_sum (x, SCM_I_MAKINUM (1)));
  1987. }
  1988. /* sub dst:8 a:8 b:8
  1989. *
  1990. * Subtract B from A, and place the result in DST.
  1991. */
  1992. VM_DEFINE_OP (81, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
  1993. {
  1994. BINARY_INTEGER_OP (-, scm_difference);
  1995. }
  1996. /* sub1 dst:12 src:12
  1997. *
  1998. * Subtract 1 from SRC, and place the result in DST.
  1999. */
  2000. VM_DEFINE_OP (82, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
  2001. {
  2002. ARGS1 (x);
  2003. /* Check for overflow. We must avoid overflow in the signed
  2004. subtraction below, even if X is not an inum. */
  2005. if (SCM_LIKELY ((scm_t_signed_bits) SCM_UNPACK (x) >= INUM_MIN + INUM_STEP))
  2006. {
  2007. SCM result;
  2008. /* Substract 1 from the integer without untagging. */
  2009. result = SCM_PACK ((scm_t_signed_bits) SCM_UNPACK (x) - INUM_STEP);
  2010. if (SCM_LIKELY (SCM_I_INUMP (result)))
  2011. RETURN (result);
  2012. }
  2013. RETURN_EXP (scm_difference (x, SCM_I_MAKINUM (1)));
  2014. }
  2015. /* mul dst:8 a:8 b:8
  2016. *
  2017. * Multiply A and B, and place the result in DST.
  2018. */
  2019. VM_DEFINE_OP (83, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
  2020. {
  2021. ARGS2 (x, y);
  2022. RETURN_EXP (scm_product (x, y));
  2023. }
  2024. /* div dst:8 a:8 b:8
  2025. *
  2026. * Divide A by B, and place the result in DST.
  2027. */
  2028. VM_DEFINE_OP (84, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
  2029. {
  2030. ARGS2 (x, y);
  2031. RETURN_EXP (scm_divide (x, y));
  2032. }
  2033. /* quo dst:8 a:8 b:8
  2034. *
  2035. * Divide A by B, and place the quotient in DST.
  2036. */
  2037. VM_DEFINE_OP (85, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
  2038. {
  2039. ARGS2 (x, y);
  2040. RETURN_EXP (scm_quotient (x, y));
  2041. }
  2042. /* rem dst:8 a:8 b:8
  2043. *
  2044. * Divide A by B, and place the remainder in DST.
  2045. */
  2046. VM_DEFINE_OP (86, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
  2047. {
  2048. ARGS2 (x, y);
  2049. RETURN_EXP (scm_remainder (x, y));
  2050. }
  2051. /* mod dst:8 a:8 b:8
  2052. *
  2053. * Place the modulo of A by B in DST.
  2054. */
  2055. VM_DEFINE_OP (87, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
  2056. {
  2057. ARGS2 (x, y);
  2058. RETURN_EXP (scm_modulo (x, y));
  2059. }
  2060. /* ash dst:8 a:8 b:8
  2061. *
  2062. * Shift A arithmetically by B bits, and place the result in DST.
  2063. */
  2064. VM_DEFINE_OP (88, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
  2065. {
  2066. ARGS2 (x, y);
  2067. if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
  2068. {
  2069. if (SCM_I_INUM (y) < 0)
  2070. /* Right shift, will be a fixnum. */
  2071. RETURN (SCM_I_MAKINUM
  2072. (SCM_SRS (SCM_I_INUM (x),
  2073. (-SCM_I_INUM (y) <= SCM_I_FIXNUM_BIT-1)
  2074. ? -SCM_I_INUM (y) : SCM_I_FIXNUM_BIT-1)));
  2075. else
  2076. /* Left shift. See comments in scm_ash. */
  2077. {
  2078. scm_t_signed_bits nn, bits_to_shift;
  2079. nn = SCM_I_INUM (x);
  2080. bits_to_shift = SCM_I_INUM (y);
  2081. if (bits_to_shift < SCM_I_FIXNUM_BIT-1
  2082. && ((scm_t_bits)
  2083. (SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
  2084. <= 1))
  2085. RETURN (SCM_I_MAKINUM (nn << bits_to_shift));
  2086. /* fall through */
  2087. }
  2088. /* fall through */
  2089. }
  2090. RETURN_EXP (scm_ash (x, y));
  2091. }
  2092. /* logand dst:8 a:8 b:8
  2093. *
  2094. * Place the bitwise AND of A and B into DST.
  2095. */
  2096. VM_DEFINE_OP (89, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
  2097. {
  2098. ARGS2 (x, y);
  2099. if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
  2100. /* Compute bitwise AND without untagging */
  2101. RETURN (SCM_PACK (SCM_UNPACK (x) & SCM_UNPACK (y)));
  2102. RETURN_EXP (scm_logand (x, y));
  2103. }
  2104. /* logior dst:8 a:8 b:8
  2105. *
  2106. * Place the bitwise inclusive OR of A with B in DST.
  2107. */
  2108. VM_DEFINE_OP (90, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
  2109. {
  2110. ARGS2 (x, y);
  2111. if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
  2112. /* Compute bitwise OR without untagging */
  2113. RETURN (SCM_PACK (SCM_UNPACK (x) | SCM_UNPACK (y)));
  2114. RETURN_EXP (scm_logior (x, y));
  2115. }
  2116. /* logxor dst:8 a:8 b:8
  2117. *
  2118. * Place the bitwise exclusive OR of A with B in DST.
  2119. */
  2120. VM_DEFINE_OP (91, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
  2121. {
  2122. ARGS2 (x, y);
  2123. if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
  2124. RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y)));
  2125. RETURN_EXP (scm_logxor (x, y));
  2126. }
  2127. /* make-vector/immediate dst:8 length:8 init:8
  2128. *
  2129. * Make a short vector of known size and write it to DST. The vector
  2130. * will have space for LENGTH slots, an immediate value. They will be
  2131. * filled with the value in slot INIT.
  2132. */
  2133. VM_DEFINE_OP (92, make_vector_immediate, "make-vector/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
  2134. {
  2135. scm_t_uint8 dst, init;
  2136. scm_t_int32 length, n;
  2137. SCM val, vector;
  2138. UNPACK_8_8_8 (op, dst, length, init);
  2139. val = LOCAL_REF (init);
  2140. vector = scm_words (scm_tc7_vector | (length << 8), length + 1);
  2141. for (n = 0; n < length; n++)
  2142. SCM_SIMPLE_VECTOR_SET (vector, n, val);
  2143. LOCAL_SET (dst, vector);
  2144. NEXT (1);
  2145. }
  2146. /* vector-length dst:12 src:12
  2147. *
  2148. * Store the length of the vector in SRC in DST.
  2149. */
  2150. VM_DEFINE_OP (93, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
  2151. {
  2152. ARGS1 (vect);
  2153. if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
  2154. RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
  2155. else
  2156. {
  2157. SYNC_IP ();
  2158. RETURN (scm_vector_length (vect));
  2159. }
  2160. }
  2161. /* vector-ref dst:8 src:8 idx:8
  2162. *
  2163. * Fetch the item at position IDX in the vector in SRC, and store it
  2164. * in DST.
  2165. */
  2166. VM_DEFINE_OP (94, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2167. {
  2168. scm_t_signed_bits i = 0;
  2169. ARGS2 (vect, idx);
  2170. if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
  2171. && SCM_I_INUMP (idx)
  2172. && ((i = SCM_I_INUM (idx)) >= 0)
  2173. && i < SCM_I_VECTOR_LENGTH (vect)))
  2174. RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
  2175. else
  2176. {
  2177. SYNC_IP ();
  2178. RETURN (scm_vector_ref (vect, idx));
  2179. }
  2180. }
  2181. /* vector-ref/immediate dst:8 src:8 idx:8
  2182. *
  2183. * Fill DST with the item IDX elements into the vector at SRC. Useful
  2184. * for building data types using vectors.
  2185. */
  2186. VM_DEFINE_OP (95, vector_ref_immediate, "vector-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
  2187. {
  2188. scm_t_uint8 dst, src, idx;
  2189. SCM v;
  2190. UNPACK_8_8_8 (op, dst, src, idx);
  2191. v = LOCAL_REF (src);
  2192. if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v)
  2193. && idx < SCM_I_VECTOR_LENGTH (v)))
  2194. LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
  2195. else
  2196. LOCAL_SET (dst, scm_c_vector_ref (v, idx));
  2197. NEXT (1);
  2198. }
  2199. /* vector-set! dst:8 idx:8 src:8
  2200. *
  2201. * Store SRC into the vector DST at index IDX.
  2202. */
  2203. VM_DEFINE_OP (96, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
  2204. {
  2205. scm_t_uint8 dst, idx_var, src;
  2206. SCM vect, idx, val;
  2207. scm_t_signed_bits i = 0;
  2208. UNPACK_8_8_8 (op, dst, idx_var, src);
  2209. vect = LOCAL_REF (dst);
  2210. idx = LOCAL_REF (idx_var);
  2211. val = LOCAL_REF (src);
  2212. if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
  2213. && SCM_I_INUMP (idx)
  2214. && ((i = SCM_I_INUM (idx)) >= 0)
  2215. && i < SCM_I_VECTOR_LENGTH (vect)))
  2216. SCM_I_VECTOR_WELTS (vect)[i] = val;
  2217. else
  2218. {
  2219. SYNC_IP ();
  2220. scm_vector_set_x (vect, idx, val);
  2221. }
  2222. NEXT (1);
  2223. }
  2224. /* vector-set!/immediate dst:8 idx:8 src:8
  2225. *
  2226. * Store SRC into the vector DST at index IDX. Here IDX is an
  2227. * immediate value.
  2228. */
  2229. VM_DEFINE_OP (97, vector_set_immediate, "vector-set!/immediate", OP1 (U8_U8_U8_U8))
  2230. {
  2231. scm_t_uint8 dst, idx, src;
  2232. SCM vect, val;
  2233. UNPACK_8_8_8 (op, dst, idx, src);
  2234. vect = LOCAL_REF (dst);
  2235. val = LOCAL_REF (src);
  2236. if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
  2237. && idx < SCM_I_VECTOR_LENGTH (vect)))
  2238. SCM_I_VECTOR_WELTS (vect)[idx] = val;
  2239. else
  2240. {
  2241. SYNC_IP ();
  2242. scm_vector_set_x (vect, scm_from_uint8 (idx), val);
  2243. }
  2244. NEXT (1);
  2245. }
  2246. /*
  2247. * Structs and GOOPS
  2248. */
  2249. /* struct-vtable dst:12 src:12
  2250. *
  2251. * Store the vtable of SRC into DST.
  2252. */
  2253. VM_DEFINE_OP (98, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
  2254. {
  2255. ARGS1 (obj);
  2256. VM_VALIDATE_STRUCT (obj, "struct_vtable");
  2257. RETURN (SCM_STRUCT_VTABLE (obj));
  2258. }
  2259. /* allocate-struct/immediate dst:8 vtable:8 nfields:8
  2260. *
  2261. * Allocate a new struct with VTABLE, and place it in DST. The struct
  2262. * will be constructed with space for NFIELDS fields, which should
  2263. * correspond to the field count of the VTABLE.
  2264. */
  2265. VM_DEFINE_OP (99, allocate_struct_immediate, "allocate-struct/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
  2266. {
  2267. scm_t_uint8 dst, vtable, nfields;
  2268. SCM ret;
  2269. UNPACK_8_8_8 (op, dst, vtable, nfields);
  2270. SYNC_IP ();
  2271. ret = scm_allocate_struct (LOCAL_REF (vtable), SCM_I_MAKINUM (nfields));
  2272. LOCAL_SET (dst, ret);
  2273. NEXT (1);
  2274. }
  2275. /* struct-ref/immediate dst:8 src:8 idx:8
  2276. *
  2277. * Fetch the item at slot IDX in the struct in SRC, and store it
  2278. * in DST. IDX is an immediate unsigned 8-bit value.
  2279. */
  2280. VM_DEFINE_OP (100, struct_ref_immediate, "struct-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
  2281. {
  2282. scm_t_uint8 dst, src, idx;
  2283. SCM obj;
  2284. UNPACK_8_8_8 (op, dst, src, idx);
  2285. obj = LOCAL_REF (src);
  2286. if (SCM_LIKELY (SCM_STRUCTP (obj)
  2287. && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
  2288. SCM_VTABLE_FLAG_SIMPLE)
  2289. && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
  2290. scm_vtable_index_size)))
  2291. RETURN (SCM_STRUCT_SLOT_REF (obj, idx));
  2292. SYNC_IP ();
  2293. RETURN (scm_struct_ref (obj, SCM_I_MAKINUM (idx)));
  2294. }
  2295. /* struct-set!/immediate dst:8 idx:8 src:8
  2296. *
  2297. * Store SRC into the struct DST at slot IDX. IDX is an immediate
  2298. * unsigned 8-bit value.
  2299. */
  2300. VM_DEFINE_OP (101, struct_set_immediate, "struct-set!/immediate", OP1 (U8_U8_U8_U8))
  2301. {
  2302. scm_t_uint8 dst, idx, src;
  2303. SCM obj, val;
  2304. UNPACK_8_8_8 (op, dst, idx, src);
  2305. obj = LOCAL_REF (dst);
  2306. val = LOCAL_REF (src);
  2307. if (SCM_LIKELY (SCM_STRUCTP (obj)
  2308. && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
  2309. SCM_VTABLE_FLAG_SIMPLE)
  2310. && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
  2311. SCM_VTABLE_FLAG_SIMPLE_RW)
  2312. && idx < SCM_STRUCT_DATA_REF (SCM_STRUCT_VTABLE (obj),
  2313. scm_vtable_index_size)))
  2314. {
  2315. SCM_STRUCT_SLOT_SET (obj, idx, val);
  2316. NEXT (1);
  2317. }
  2318. SYNC_IP ();
  2319. scm_struct_set_x (obj, SCM_I_MAKINUM (idx), val);
  2320. NEXT (1);
  2321. }
  2322. /* class-of dst:12 type:12
  2323. *
  2324. * Store the vtable of SRC into DST.
  2325. */
  2326. VM_DEFINE_OP (102, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
  2327. {
  2328. ARGS1 (obj);
  2329. if (SCM_INSTANCEP (obj))
  2330. RETURN (SCM_CLASS_OF (obj));
  2331. SYNC_IP ();
  2332. RETURN (scm_class_of (obj));
  2333. }
  2334. VM_DEFINE_OP (103, unused_103, NULL, NOP)
  2335. VM_DEFINE_OP (104, unused_104, NULL, NOP)
  2336. goto op_unused_255;
  2337. /*
  2338. * Arrays, packed uniform arrays, and bytevectors.
  2339. */
  2340. /* load-typed-array dst:8 type:8 shape:8 offset:32 len:32
  2341. *
  2342. * Load the contiguous typed array located at OFFSET 32-bit words away
  2343. * from the instruction pointer, and store into DST. LEN is a byte
  2344. * length. OFFSET is signed.
  2345. */
  2346. VM_DEFINE_OP (105, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
  2347. {
  2348. scm_t_uint8 dst, type, shape;
  2349. scm_t_int32 offset;
  2350. scm_t_uint32 len;
  2351. UNPACK_8_8_8 (op, dst, type, shape);
  2352. offset = ip[1];
  2353. len = ip[2];
  2354. SYNC_IP ();
  2355. LOCAL_SET (dst, scm_from_contiguous_typed_array (LOCAL_REF (type),
  2356. LOCAL_REF (shape),
  2357. ip + offset, len));
  2358. NEXT (3);
  2359. }
  2360. /* make-array dst:12 type:12 _:8 fill:12 bounds:12
  2361. *
  2362. * Make a new array with TYPE, FILL, and BOUNDS, storing it in DST.
  2363. */
  2364. VM_DEFINE_OP (106, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST)
  2365. {
  2366. scm_t_uint16 dst, type, fill, bounds;
  2367. UNPACK_12_12 (op, dst, type);
  2368. UNPACK_12_12 (ip[1], fill, bounds);
  2369. SYNC_IP ();
  2370. LOCAL_SET (dst, scm_make_typed_array (LOCAL_REF (type), LOCAL_REF (fill),
  2371. LOCAL_REF (bounds)));
  2372. NEXT (2);
  2373. }
  2374. /* bv-u8-ref dst:8 src:8 idx:8
  2375. * bv-s8-ref dst:8 src:8 idx:8
  2376. * bv-u16-ref dst:8 src:8 idx:8
  2377. * bv-s16-ref dst:8 src:8 idx:8
  2378. * bv-u32-ref dst:8 src:8 idx:8
  2379. * bv-s32-ref dst:8 src:8 idx:8
  2380. * bv-u64-ref dst:8 src:8 idx:8
  2381. * bv-s64-ref dst:8 src:8 idx:8
  2382. * bv-f32-ref dst:8 src:8 idx:8
  2383. * bv-f64-ref dst:8 src:8 idx:8
  2384. *
  2385. * Fetch the item at byte offset IDX in the bytevector SRC, and store
  2386. * it in DST. All accesses use native endianness.
  2387. */
  2388. #define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
  2389. do { \
  2390. scm_t_signed_bits i; \
  2391. const scm_t_ ## type *int_ptr; \
  2392. ARGS2 (bv, idx); \
  2393. \
  2394. VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
  2395. i = SCM_I_INUM (idx); \
  2396. int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
  2397. \
  2398. if (SCM_LIKELY (SCM_I_INUMP (idx) \
  2399. && (i >= 0) \
  2400. && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
  2401. && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
  2402. RETURN (SCM_I_MAKINUM (*int_ptr)); \
  2403. else \
  2404. { \
  2405. SYNC_IP (); \
  2406. RETURN (scm_bytevector_ ## fn_stem ## _ref (bv, idx)); \
  2407. } \
  2408. } while (0)
  2409. #define BV_INT_REF(stem, type, size) \
  2410. do { \
  2411. scm_t_signed_bits i; \
  2412. const scm_t_ ## type *int_ptr; \
  2413. ARGS2 (bv, idx); \
  2414. \
  2415. VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
  2416. i = SCM_I_INUM (idx); \
  2417. int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
  2418. \
  2419. if (SCM_LIKELY (SCM_I_INUMP (idx) \
  2420. && (i >= 0) \
  2421. && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
  2422. && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
  2423. { \
  2424. scm_t_ ## type x = *int_ptr; \
  2425. if (SCM_FIXABLE (x)) \
  2426. RETURN (SCM_I_MAKINUM (x)); \
  2427. else \
  2428. { \
  2429. SYNC_IP (); \
  2430. RETURN (scm_from_ ## type (x)); \
  2431. } \
  2432. } \
  2433. else \
  2434. { \
  2435. SYNC_IP (); \
  2436. RETURN (scm_bytevector_ ## stem ## _native_ref (bv, idx)); \
  2437. } \
  2438. } while (0)
  2439. #define BV_FLOAT_REF(stem, fn_stem, type, size) \
  2440. do { \
  2441. scm_t_signed_bits i; \
  2442. const type *float_ptr; \
  2443. ARGS2 (bv, idx); \
  2444. \
  2445. VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-ref"); \
  2446. i = SCM_I_INUM (idx); \
  2447. float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
  2448. \
  2449. SYNC_IP (); \
  2450. if (SCM_LIKELY (SCM_I_INUMP (idx) \
  2451. && (i >= 0) \
  2452. && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
  2453. && (ALIGNED_P (float_ptr, type)))) \
  2454. RETURN (scm_from_double (*float_ptr)); \
  2455. else \
  2456. RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
  2457. } while (0)
  2458. VM_DEFINE_OP (107, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2459. BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
  2460. VM_DEFINE_OP (108, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2461. BV_FIXABLE_INT_REF (s8, s8, int8, 1);
  2462. VM_DEFINE_OP (109, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2463. BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
  2464. VM_DEFINE_OP (110, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2465. BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
  2466. VM_DEFINE_OP (111, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2467. #if SIZEOF_VOID_P > 4
  2468. BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
  2469. #else
  2470. BV_INT_REF (u32, uint32, 4);
  2471. #endif
  2472. VM_DEFINE_OP (112, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2473. #if SIZEOF_VOID_P > 4
  2474. BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
  2475. #else
  2476. BV_INT_REF (s32, int32, 4);
  2477. #endif
  2478. VM_DEFINE_OP (113, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2479. BV_INT_REF (u64, uint64, 8);
  2480. VM_DEFINE_OP (114, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2481. BV_INT_REF (s64, int64, 8);
  2482. VM_DEFINE_OP (115, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2483. BV_FLOAT_REF (f32, ieee_single, float, 4);
  2484. VM_DEFINE_OP (116, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
  2485. BV_FLOAT_REF (f64, ieee_double, double, 8);
  2486. /* bv-u8-set! dst:8 idx:8 src:8
  2487. * bv-s8-set! dst:8 idx:8 src:8
  2488. * bv-u16-set! dst:8 idx:8 src:8
  2489. * bv-s16-set! dst:8 idx:8 src:8
  2490. * bv-u32-set! dst:8 idx:8 src:8
  2491. * bv-s32-set! dst:8 idx:8 src:8
  2492. * bv-u64-set! dst:8 idx:8 src:8
  2493. * bv-s64-set! dst:8 idx:8 src:8
  2494. * bv-f32-set! dst:8 idx:8 src:8
  2495. * bv-f64-set! dst:8 idx:8 src:8
  2496. *
  2497. * Store SRC into the bytevector DST at byte offset IDX. Multibyte
  2498. * values are written using native endianness.
  2499. */
  2500. #define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
  2501. do { \
  2502. scm_t_uint8 dst, idx, src; \
  2503. scm_t_signed_bits i, j = 0; \
  2504. SCM bv, scm_idx, val; \
  2505. scm_t_ ## type *int_ptr; \
  2506. \
  2507. UNPACK_8_8_8 (op, dst, idx, src); \
  2508. bv = LOCAL_REF (dst); \
  2509. scm_idx = LOCAL_REF (idx); \
  2510. val = LOCAL_REF (src); \
  2511. VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
  2512. i = SCM_I_INUM (scm_idx); \
  2513. int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
  2514. \
  2515. if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
  2516. && (i >= 0) \
  2517. && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
  2518. && (ALIGNED_P (int_ptr, scm_t_ ## type)) \
  2519. && (SCM_I_INUMP (val)) \
  2520. && ((j = SCM_I_INUM (val)) >= min) \
  2521. && (j <= max))) \
  2522. *int_ptr = (scm_t_ ## type) j; \
  2523. else \
  2524. { \
  2525. SYNC_IP (); \
  2526. scm_bytevector_ ## fn_stem ## _set_x (bv, scm_idx, val); \
  2527. } \
  2528. NEXT (1); \
  2529. } while (0)
  2530. #define BV_INT_SET(stem, type, size) \
  2531. do { \
  2532. scm_t_uint8 dst, idx, src; \
  2533. scm_t_signed_bits i; \
  2534. SCM bv, scm_idx, val; \
  2535. scm_t_ ## type *int_ptr; \
  2536. \
  2537. UNPACK_8_8_8 (op, dst, idx, src); \
  2538. bv = LOCAL_REF (dst); \
  2539. scm_idx = LOCAL_REF (idx); \
  2540. val = LOCAL_REF (src); \
  2541. VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
  2542. i = SCM_I_INUM (scm_idx); \
  2543. int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
  2544. \
  2545. if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
  2546. && (i >= 0) \
  2547. && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
  2548. && (ALIGNED_P (int_ptr, scm_t_ ## type)))) \
  2549. *int_ptr = scm_to_ ## type (val); \
  2550. else \
  2551. { \
  2552. SYNC_IP (); \
  2553. scm_bytevector_ ## stem ## _native_set_x (bv, scm_idx, val); \
  2554. } \
  2555. NEXT (1); \
  2556. } while (0)
  2557. #define BV_FLOAT_SET(stem, fn_stem, type, size) \
  2558. do { \
  2559. scm_t_uint8 dst, idx, src; \
  2560. scm_t_signed_bits i; \
  2561. SCM bv, scm_idx, val; \
  2562. type *float_ptr; \
  2563. \
  2564. UNPACK_8_8_8 (op, dst, idx, src); \
  2565. bv = LOCAL_REF (dst); \
  2566. scm_idx = LOCAL_REF (idx); \
  2567. val = LOCAL_REF (src); \
  2568. VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set!"); \
  2569. i = SCM_I_INUM (scm_idx); \
  2570. float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
  2571. \
  2572. if (SCM_LIKELY (SCM_I_INUMP (scm_idx) \
  2573. && (i >= 0) \
  2574. && (i + size <= SCM_BYTEVECTOR_LENGTH (bv)) \
  2575. && (ALIGNED_P (float_ptr, type)))) \
  2576. *float_ptr = scm_to_double (val); \
  2577. else \
  2578. { \
  2579. SYNC_IP (); \
  2580. scm_bytevector_ ## fn_stem ## _native_set_x (bv, scm_idx, val); \
  2581. } \
  2582. NEXT (1); \
  2583. } while (0)
  2584. VM_DEFINE_OP (117, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
  2585. BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
  2586. VM_DEFINE_OP (118, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
  2587. BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
  2588. VM_DEFINE_OP (119, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
  2589. BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
  2590. VM_DEFINE_OP (120, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
  2591. BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2);
  2592. VM_DEFINE_OP (121, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
  2593. #if SIZEOF_VOID_P > 4
  2594. BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
  2595. #else
  2596. BV_INT_SET (u32, uint32, 4);
  2597. #endif
  2598. VM_DEFINE_OP (122, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
  2599. #if SIZEOF_VOID_P > 4
  2600. BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4);
  2601. #else
  2602. BV_INT_SET (s32, int32, 4);
  2603. #endif
  2604. VM_DEFINE_OP (123, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
  2605. BV_INT_SET (u64, uint64, 8);
  2606. VM_DEFINE_OP (124, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
  2607. BV_INT_SET (s64, int64, 8);
  2608. VM_DEFINE_OP (125, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
  2609. BV_FLOAT_SET (f32, ieee_single, float, 4);
  2610. VM_DEFINE_OP (126, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
  2611. BV_FLOAT_SET (f64, ieee_double, double, 8);
  2612. VM_DEFINE_OP (127, unused_127, NULL, NOP)
  2613. VM_DEFINE_OP (128, unused_128, NULL, NOP)
  2614. VM_DEFINE_OP (129, unused_129, NULL, NOP)
  2615. VM_DEFINE_OP (130, unused_130, NULL, NOP)
  2616. VM_DEFINE_OP (131, unused_131, NULL, NOP)
  2617. VM_DEFINE_OP (132, unused_132, NULL, NOP)
  2618. VM_DEFINE_OP (133, unused_133, NULL, NOP)
  2619. VM_DEFINE_OP (134, unused_134, NULL, NOP)
  2620. VM_DEFINE_OP (135, unused_135, NULL, NOP)
  2621. VM_DEFINE_OP (136, unused_136, NULL, NOP)
  2622. VM_DEFINE_OP (137, unused_137, NULL, NOP)
  2623. VM_DEFINE_OP (138, unused_138, NULL, NOP)
  2624. VM_DEFINE_OP (139, unused_139, NULL, NOP)
  2625. VM_DEFINE_OP (140, unused_140, NULL, NOP)
  2626. VM_DEFINE_OP (141, unused_141, NULL, NOP)
  2627. VM_DEFINE_OP (142, unused_142, NULL, NOP)
  2628. VM_DEFINE_OP (143, unused_143, NULL, NOP)
  2629. VM_DEFINE_OP (144, unused_144, NULL, NOP)
  2630. VM_DEFINE_OP (145, unused_145, NULL, NOP)
  2631. VM_DEFINE_OP (146, unused_146, NULL, NOP)
  2632. VM_DEFINE_OP (147, unused_147, NULL, NOP)
  2633. VM_DEFINE_OP (148, unused_148, NULL, NOP)
  2634. VM_DEFINE_OP (149, unused_149, NULL, NOP)
  2635. VM_DEFINE_OP (150, unused_150, NULL, NOP)
  2636. VM_DEFINE_OP (151, unused_151, NULL, NOP)
  2637. VM_DEFINE_OP (152, unused_152, NULL, NOP)
  2638. VM_DEFINE_OP (153, unused_153, NULL, NOP)
  2639. VM_DEFINE_OP (154, unused_154, NULL, NOP)
  2640. VM_DEFINE_OP (155, unused_155, NULL, NOP)
  2641. VM_DEFINE_OP (156, unused_156, NULL, NOP)
  2642. VM_DEFINE_OP (157, unused_157, NULL, NOP)
  2643. VM_DEFINE_OP (158, unused_158, NULL, NOP)
  2644. VM_DEFINE_OP (159, unused_159, NULL, NOP)
  2645. VM_DEFINE_OP (160, unused_160, NULL, NOP)
  2646. VM_DEFINE_OP (161, unused_161, NULL, NOP)
  2647. VM_DEFINE_OP (162, unused_162, NULL, NOP)
  2648. VM_DEFINE_OP (163, unused_163, NULL, NOP)
  2649. VM_DEFINE_OP (164, unused_164, NULL, NOP)
  2650. VM_DEFINE_OP (165, unused_165, NULL, NOP)
  2651. VM_DEFINE_OP (166, unused_166, NULL, NOP)
  2652. VM_DEFINE_OP (167, unused_167, NULL, NOP)
  2653. VM_DEFINE_OP (168, unused_168, NULL, NOP)
  2654. VM_DEFINE_OP (169, unused_169, NULL, NOP)
  2655. VM_DEFINE_OP (170, unused_170, NULL, NOP)
  2656. VM_DEFINE_OP (171, unused_171, NULL, NOP)
  2657. VM_DEFINE_OP (172, unused_172, NULL, NOP)
  2658. VM_DEFINE_OP (173, unused_173, NULL, NOP)
  2659. VM_DEFINE_OP (174, unused_174, NULL, NOP)
  2660. VM_DEFINE_OP (175, unused_175, NULL, NOP)
  2661. VM_DEFINE_OP (176, unused_176, NULL, NOP)
  2662. VM_DEFINE_OP (177, unused_177, NULL, NOP)
  2663. VM_DEFINE_OP (178, unused_178, NULL, NOP)
  2664. VM_DEFINE_OP (179, unused_179, NULL, NOP)
  2665. VM_DEFINE_OP (180, unused_180, NULL, NOP)
  2666. VM_DEFINE_OP (181, unused_181, NULL, NOP)
  2667. VM_DEFINE_OP (182, unused_182, NULL, NOP)
  2668. VM_DEFINE_OP (183, unused_183, NULL, NOP)
  2669. VM_DEFINE_OP (184, unused_184, NULL, NOP)
  2670. VM_DEFINE_OP (185, unused_185, NULL, NOP)
  2671. VM_DEFINE_OP (186, unused_186, NULL, NOP)
  2672. VM_DEFINE_OP (187, unused_187, NULL, NOP)
  2673. VM_DEFINE_OP (188, unused_188, NULL, NOP)
  2674. VM_DEFINE_OP (189, unused_189, NULL, NOP)
  2675. VM_DEFINE_OP (190, unused_190, NULL, NOP)
  2676. VM_DEFINE_OP (191, unused_191, NULL, NOP)
  2677. VM_DEFINE_OP (192, unused_192, NULL, NOP)
  2678. VM_DEFINE_OP (193, unused_193, NULL, NOP)
  2679. VM_DEFINE_OP (194, unused_194, NULL, NOP)
  2680. VM_DEFINE_OP (195, unused_195, NULL, NOP)
  2681. VM_DEFINE_OP (196, unused_196, NULL, NOP)
  2682. VM_DEFINE_OP (197, unused_197, NULL, NOP)
  2683. VM_DEFINE_OP (198, unused_198, NULL, NOP)
  2684. VM_DEFINE_OP (199, unused_199, NULL, NOP)
  2685. VM_DEFINE_OP (200, unused_200, NULL, NOP)
  2686. VM_DEFINE_OP (201, unused_201, NULL, NOP)
  2687. VM_DEFINE_OP (202, unused_202, NULL, NOP)
  2688. VM_DEFINE_OP (203, unused_203, NULL, NOP)
  2689. VM_DEFINE_OP (204, unused_204, NULL, NOP)
  2690. VM_DEFINE_OP (205, unused_205, NULL, NOP)
  2691. VM_DEFINE_OP (206, unused_206, NULL, NOP)
  2692. VM_DEFINE_OP (207, unused_207, NULL, NOP)
  2693. VM_DEFINE_OP (208, unused_208, NULL, NOP)
  2694. VM_DEFINE_OP (209, unused_209, NULL, NOP)
  2695. VM_DEFINE_OP (210, unused_210, NULL, NOP)
  2696. VM_DEFINE_OP (211, unused_211, NULL, NOP)
  2697. VM_DEFINE_OP (212, unused_212, NULL, NOP)
  2698. VM_DEFINE_OP (213, unused_213, NULL, NOP)
  2699. VM_DEFINE_OP (214, unused_214, NULL, NOP)
  2700. VM_DEFINE_OP (215, unused_215, NULL, NOP)
  2701. VM_DEFINE_OP (216, unused_216, NULL, NOP)
  2702. VM_DEFINE_OP (217, unused_217, NULL, NOP)
  2703. VM_DEFINE_OP (218, unused_218, NULL, NOP)
  2704. VM_DEFINE_OP (219, unused_219, NULL, NOP)
  2705. VM_DEFINE_OP (220, unused_220, NULL, NOP)
  2706. VM_DEFINE_OP (221, unused_221, NULL, NOP)
  2707. VM_DEFINE_OP (222, unused_222, NULL, NOP)
  2708. VM_DEFINE_OP (223, unused_223, NULL, NOP)
  2709. VM_DEFINE_OP (224, unused_224, NULL, NOP)
  2710. VM_DEFINE_OP (225, unused_225, NULL, NOP)
  2711. VM_DEFINE_OP (226, unused_226, NULL, NOP)
  2712. VM_DEFINE_OP (227, unused_227, NULL, NOP)
  2713. VM_DEFINE_OP (228, unused_228, NULL, NOP)
  2714. VM_DEFINE_OP (229, unused_229, NULL, NOP)
  2715. VM_DEFINE_OP (230, unused_230, NULL, NOP)
  2716. VM_DEFINE_OP (231, unused_231, NULL, NOP)
  2717. VM_DEFINE_OP (232, unused_232, NULL, NOP)
  2718. VM_DEFINE_OP (233, unused_233, NULL, NOP)
  2719. VM_DEFINE_OP (234, unused_234, NULL, NOP)
  2720. VM_DEFINE_OP (235, unused_235, NULL, NOP)
  2721. VM_DEFINE_OP (236, unused_236, NULL, NOP)
  2722. VM_DEFINE_OP (237, unused_237, NULL, NOP)
  2723. VM_DEFINE_OP (238, unused_238, NULL, NOP)
  2724. VM_DEFINE_OP (239, unused_239, NULL, NOP)
  2725. VM_DEFINE_OP (240, unused_240, NULL, NOP)
  2726. VM_DEFINE_OP (241, unused_241, NULL, NOP)
  2727. VM_DEFINE_OP (242, unused_242, NULL, NOP)
  2728. VM_DEFINE_OP (243, unused_243, NULL, NOP)
  2729. VM_DEFINE_OP (244, unused_244, NULL, NOP)
  2730. VM_DEFINE_OP (245, unused_245, NULL, NOP)
  2731. VM_DEFINE_OP (246, unused_246, NULL, NOP)
  2732. VM_DEFINE_OP (247, unused_247, NULL, NOP)
  2733. VM_DEFINE_OP (248, unused_248, NULL, NOP)
  2734. VM_DEFINE_OP (249, unused_249, NULL, NOP)
  2735. VM_DEFINE_OP (250, unused_250, NULL, NOP)
  2736. VM_DEFINE_OP (251, unused_251, NULL, NOP)
  2737. VM_DEFINE_OP (252, unused_252, NULL, NOP)
  2738. VM_DEFINE_OP (253, unused_253, NULL, NOP)
  2739. VM_DEFINE_OP (254, unused_254, NULL, NOP)
  2740. VM_DEFINE_OP (255, unused_255, NULL, NOP)
  2741. {
  2742. vm_error_bad_instruction (op);
  2743. abort (); /* never reached */
  2744. }
  2745. END_DISPATCH_SWITCH;
  2746. }
  2747. #undef ABORT_CONTINUATION_HOOK
  2748. #undef ALIGNED_P
  2749. #undef APPLY_HOOK
  2750. #undef ARGS1
  2751. #undef ARGS2
  2752. #undef BEGIN_DISPATCH_SWITCH
  2753. #undef BINARY_INTEGER_OP
  2754. #undef BR_ARITHMETIC
  2755. #undef BR_BINARY
  2756. #undef BR_NARGS
  2757. #undef BR_UNARY
  2758. #undef BV_FIXABLE_INT_REF
  2759. #undef BV_FIXABLE_INT_SET
  2760. #undef BV_FLOAT_REF
  2761. #undef BV_FLOAT_SET
  2762. #undef BV_INT_REF
  2763. #undef BV_INT_SET
  2764. #undef CACHE_REGISTER
  2765. #undef CHECK_OVERFLOW
  2766. #undef END_DISPATCH_SWITCH
  2767. #undef FREE_VARIABLE_REF
  2768. #undef INIT
  2769. #undef INUM_MAX
  2770. #undef INUM_MIN
  2771. #undef LOCAL_REF
  2772. #undef LOCAL_SET
  2773. #undef NEXT
  2774. #undef NEXT_HOOK
  2775. #undef NEXT_JUMP
  2776. #undef POP_CONTINUATION_HOOK
  2777. #undef PUSH_CONTINUATION_HOOK
  2778. #undef RETURN
  2779. #undef RETURN_ONE_VALUE
  2780. #undef RETURN_VALUE_LIST
  2781. #undef RUN_HOOK
  2782. #undef RUN_HOOK0
  2783. #undef RUN_HOOK1
  2784. #undef SYNC_IP
  2785. #undef UNPACK_8_8_8
  2786. #undef UNPACK_8_16
  2787. #undef UNPACK_16_8
  2788. #undef UNPACK_12_12
  2789. #undef UNPACK_24
  2790. #undef VARIABLE_BOUNDP
  2791. #undef VARIABLE_REF
  2792. #undef VARIABLE_SET
  2793. #undef VM_CHECK_FREE_VARIABLE
  2794. #undef VM_CHECK_OBJECT
  2795. #undef VM_CHECK_UNDERFLOW
  2796. #undef VM_DEFINE_OP
  2797. #undef VM_INSTRUCTION_TO_LABEL
  2798. #undef VM_USE_HOOKS
  2799. #undef VM_VALIDATE_BYTEVECTOR
  2800. #undef VM_VALIDATE_PAIR
  2801. #undef VM_VALIDATE_STRUCT
  2802. /*
  2803. (defun renumber-ops ()
  2804. "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
  2805. (interactive "")
  2806. (save-excursion
  2807. (let ((counter -1)) (goto-char (point-min))
  2808. (while (re-search-forward "^ *VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
  2809. (replace-match
  2810. (number-to-string (setq counter (1+ counter)))
  2811. t t nil 1)))))
  2812. (renumber-ops)
  2813. */
  2814. /*
  2815. Local Variables:
  2816. c-file-style: "gnu"
  2817. End:
  2818. */