vm-engine.c 95 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407
  1. /* Copyright 2001,2009-2015,2017-2019
  2. Free Software Foundation, Inc.
  3. This file is part of Guile.
  4. Guile is free software: you can redistribute it and/or modify it
  5. under the terms of the GNU Lesser General Public License as published
  6. by the Free Software Foundation, either version 3 of the License, or
  7. (at your option) any later version.
  8. Guile is distributed in the hope that it will be useful, but WITHOUT
  9. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  10. FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
  11. License for more details.
  12. You should have received a copy of the GNU Lesser General Public
  13. License along with Guile. If not, see
  14. <https://www.gnu.org/licenses/>. */
  15. /* This file is included in vm.c multiple times. */
  16. #define UNPACK_8_8_8(op,a,b,c) \
  17. do \
  18. { \
  19. a = (op >> 8) & 0xff; \
  20. b = (op >> 16) & 0xff; \
  21. c = op >> 24; \
  22. } \
  23. while (0)
  24. #define UNPACK_8_16(op,a,b) \
  25. do \
  26. { \
  27. a = (op >> 8) & 0xff; \
  28. b = op >> 16; \
  29. } \
  30. while (0)
  31. #define UNPACK_12_12(op,a,b) \
  32. do \
  33. { \
  34. a = (op >> 8) & 0xfff; \
  35. b = op >> 20; \
  36. } \
  37. while (0)
  38. #define UNPACK_24(op,a) \
  39. do \
  40. { \
  41. a = op >> 8; \
  42. } \
  43. while (0)
  44. #define UNPACK_8_24(op,a,b) \
  45. do \
  46. { \
  47. a = op & 0xff; \
  48. b = op >> 8; \
  49. } \
  50. while (0)
  51. #define UNPACK_16_16(op,a,b) \
  52. do \
  53. { \
  54. a = op & 0xffff; \
  55. b = op >> 16; \
  56. } \
  57. while (0)
  58. /* Assign some registers by hand. There used to be a bigger list here,
  59. but it was never tested, and in the case of x86-32, was a source of
  60. compilation failures. It can be revived if it's useful, but my naive
  61. hope is that simply annotating the locals with "register" will be a
  62. sufficient hint to the compiler. */
  63. #ifdef __GNUC__
  64. # if defined __x86_64__
  65. /* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
  66. well. Tell it to keep the jump table in a r12, which is
  67. callee-saved. */
  68. # define JT_REG asm ("r12")
  69. # endif
  70. #endif
  71. #ifndef IP_REG
  72. # define IP_REG
  73. #endif
  74. #ifndef FP_REG
  75. # define FP_REG
  76. #endif
  77. #ifndef JT_REG
  78. # define JT_REG
  79. #endif
  80. #define VP (&thread->vm)
  81. #define VM_ASSERT(condition, handler) \
  82. do { \
  83. if (SCM_UNLIKELY (!(condition))) \
  84. { \
  85. SYNC_IP(); \
  86. handler; \
  87. } \
  88. } while (0)
  89. #ifdef VM_ENABLE_ASSERTIONS
  90. # define ASSERT(condition) VM_ASSERT (condition, abort())
  91. #else
  92. # define ASSERT(condition)
  93. #endif
  94. #if VM_USE_HOOKS
  95. #define RUN_HOOK(h) \
  96. do { \
  97. if (SCM_UNLIKELY (VP->h##_hook_enabled)) \
  98. { \
  99. SYNC_IP (); \
  100. invoke_##h##_hook (thread); \
  101. CACHE_SP (); \
  102. } \
  103. } while (0)
  104. #else
  105. #define RUN_HOOK(h)
  106. #endif
  107. #define APPLY_HOOK() RUN_HOOK (apply)
  108. #define RETURN_HOOK() RUN_HOOK (return)
  109. #define NEXT_HOOK() RUN_HOOK (next)
  110. #define ABORT_HOOK() RUN_HOOK (abort)
  111. /* Virtual Machine
  112. The VM has three state bits: the instruction pointer (IP), the frame
  113. pointer (FP), and the stack pointer (SP). We cache the IP in a
  114. machine register, local to the VM, because it is used extensively by
  115. the VM. We do the same for SP. The FP is used more by code outside
  116. the VM than by the VM itself, we don't bother caching it locally.
  117. Keeping VP->ip in sync with the local IP would be a big lose, as it
  118. is updated so often. Instead of updating VP->ip all the time, we
  119. call SYNC_IP whenever we would need to know the IP of the top frame.
  120. In practice, we need to SYNC_IP whenever we call out of the VM to a
  121. function that would like to walk the stack, perhaps as the result of
  122. an exception. On the other hand, we do always keep VP->sp in sync
  123. with the local SP.
  124. One more thing. We allow the stack to move, when it expands.
  125. Therefore if you call out to a C procedure that could call Scheme
  126. code, or otherwise push anything on the stack, you will need to
  127. CACHE_SP afterwards to restore the possibly-changed stack pointer. */
  128. #define SYNC_IP() VP->ip = (ip)
  129. #define CACHE_SP() sp = VP->sp
  130. #define CACHE_REGISTER() \
  131. do { \
  132. ip = VP->ip; \
  133. CACHE_SP (); \
  134. } while (0)
  135. #define CALL_INTRINSIC(x, args) \
  136. (((struct scm_vm_intrinsics *) (void*) intrinsics)->x args)
  137. /* Reserve stack space for a frame. Will check that there is sufficient
  138. stack space for N locals, including the procedure. Invoke after
  139. preparing the new frame and setting the fp and ip.
  140. If there is not enough space for this frame, we try to expand the
  141. stack, possibly relocating it somewhere else in the address space.
  142. Because of the possible relocation, no pointer into the stack besides
  143. FP is valid across an ALLOC_FRAME call. Be careful! */
  144. #define ALLOC_FRAME(n) \
  145. do { \
  146. sp = VP->fp - (n); \
  147. if (sp < VP->sp_min_since_gc) \
  148. { \
  149. if (SCM_UNLIKELY (sp < VP->stack_limit)) \
  150. { \
  151. SYNC_IP (); \
  152. CALL_INTRINSIC (expand_stack, (thread, sp)); \
  153. CACHE_SP (); \
  154. } \
  155. else \
  156. VP->sp_min_since_gc = VP->sp = sp; \
  157. } \
  158. else \
  159. VP->sp = sp; \
  160. } while (0)
  161. /* Reset the current frame to hold N locals. Used when we know that no
  162. stack expansion is needed. Note that in some cases this may lower
  163. SP, e.g. after a return but where there are more locals below, but we
  164. know it was preceded by an alloc-frame in that case, so no stack need
  165. be allocated.
  166. As an optimization, we don't update sp_min_since_gc in this case; the
  167. principal place stacks are expanded is in ALLOC_FRAME. it doesn't
  168. need to strictly be the min since GC, as it's just an optimization to
  169. prevent passing too-large of a range to madvise. */
  170. #define RESET_FRAME(n) \
  171. do { \
  172. VP->sp = sp = VP->fp - (n); \
  173. } while (0)
  174. /* Compute the number of locals in the frame. At a call, this is equal
  175. to the number of actual arguments when a function is first called,
  176. plus one for the function. */
  177. #define FRAME_LOCALS_COUNT() (VP->fp - sp)
  178. #define FRAME_LOCALS_COUNT_FROM(slot) (FRAME_LOCALS_COUNT () - slot)
  179. #ifdef HAVE_LABELS_AS_VALUES
  180. # define BEGIN_DISPATCH_SWITCH /* */
  181. # define END_DISPATCH_SWITCH /* */
  182. # define NEXT(n) \
  183. do \
  184. { \
  185. ip += n; \
  186. NEXT_HOOK (); \
  187. op = *ip; \
  188. goto *jump_table[op & 0xff]; \
  189. } \
  190. while (0)
  191. # define VM_DEFINE_OP(opcode, tag, name, meta) \
  192. op_##tag:
  193. #else
  194. # define BEGIN_DISPATCH_SWITCH \
  195. vm_start: \
  196. NEXT_HOOK (); \
  197. op = *ip; \
  198. switch (op & 0xff) \
  199. {
  200. # define END_DISPATCH_SWITCH \
  201. }
  202. # define NEXT(n) \
  203. do \
  204. { \
  205. ip += n; \
  206. goto vm_start; \
  207. } \
  208. while (0)
  209. # define VM_DEFINE_OP(opcode, tag, name, meta) \
  210. op_##tag: \
  211. case opcode:
  212. #endif
  213. #define FP_SLOT(i) SCM_FRAME_SLOT (VP->fp, i)
  214. #define FP_REF(i) SCM_FRAME_LOCAL (VP->fp, i)
  215. #define FP_SET(i,o) SCM_FRAME_LOCAL (VP->fp, i) = o
  216. #define SP_REF_SLOT(i) (sp[i])
  217. #define SP_SET_SLOT(i,o) (sp[i] = o)
  218. #define SP_REF(i) (sp[i].as_scm)
  219. #define SP_SET(i,o) (sp[i].as_scm = o)
  220. #define SP_REF_F64(i) (sp[i].as_f64)
  221. #define SP_SET_F64(i,o) (sp[i].as_f64 = o)
  222. #define SP_REF_U64(i) (sp[i].as_u64)
  223. #define SP_SET_U64(i,o) (sp[i].as_u64 = o)
  224. #define SP_REF_S64(i) (sp[i].as_s64)
  225. #define SP_SET_S64(i,o) (sp[i].as_s64 = o)
  226. #define SP_REF_PTR(i) (sp[i].as_ptr)
  227. #define SP_SET_PTR(i,o) (sp[i].as_ptr = o)
  228. /* Return true (non-zero) if PTR has suitable alignment for TYPE. */
  229. #define ALIGNED_P(ptr, type) \
  230. ((uintptr_t) (ptr) % alignof_type (type) == 0)
  231. static SCM
  232. VM_NAME (scm_thread *thread)
  233. {
  234. /* Instruction pointer: A pointer to the opcode that is currently
  235. running. */
  236. register uint32_t *ip IP_REG;
  237. /* Stack pointer: A pointer to the hot end of the stack, off of which
  238. we index arguments and local variables. Pushed at function calls,
  239. popped on returns. */
  240. register union scm_vm_stack_element *sp FP_REG;
  241. /* Current opcode: A cache of *ip. */
  242. register uint32_t op;
  243. void **intrinsics = (void**) &scm_vm_intrinsics;
  244. #ifdef HAVE_LABELS_AS_VALUES
  245. static const void *jump_table_[256] = {
  246. #define LABEL_ADDR(opcode, tag, name, meta) &&op_##tag,
  247. FOR_EACH_VM_OPERATION(LABEL_ADDR)
  248. #undef LABEL_ADDR
  249. };
  250. register const void **jump_table JT_REG;
  251. /* Attempt to keep JUMP_TABLE_POINTER in a register. This saves one
  252. load instruction at each instruction dispatch. */
  253. jump_table = jump_table_;
  254. #endif
  255. /* Load VM registers. */
  256. CACHE_REGISTER ();
  257. /* Start processing! */
  258. NEXT (0);
  259. BEGIN_DISPATCH_SWITCH;
  260. /* halt _:24
  261. *
  262. * Bring the VM to a halt, returning all the values from the stack.
  263. */
  264. VM_DEFINE_OP (0, halt, "halt", OP1 (X32))
  265. {
  266. size_t frame_size = 3;
  267. /* Empty frame, then values. */
  268. size_t first_value = frame_size;
  269. uint32_t nvals = FRAME_LOCALS_COUNT_FROM (first_value);
  270. union scm_vm_stack_element *fp;
  271. SCM ret;
  272. if (nvals == 1)
  273. ret = FP_REF (first_value);
  274. else
  275. {
  276. uint32_t n;
  277. SYNC_IP ();
  278. VM_ASSERT (nvals <= (UINTPTR_MAX >> 12), abort ());
  279. ret = scm_words ((nvals << 12) | scm_tc11_values, nvals + 1);
  280. for (n = 0; n < nvals; n++)
  281. SCM_SET_CELL_OBJECT (ret, n+1, FP_REF (first_value + n));
  282. }
  283. fp = VP->fp;
  284. VP->fp = SCM_FRAME_DYNAMIC_LINK (fp);
  285. VP->ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (fp);
  286. VP->sp = SCM_FRAME_PREVIOUS_SP (fp);
  287. return ret;
  288. }
  289. /* instrument-entry _:24 data:32
  290. *
  291. * Increase execution counter for this function and potentially tier
  292. * up to the next JIT level. DATA is an offset to a structure
  293. * recording execution counts and the next-level JIT code
  294. * corresponding to this function. Also run the apply hook.
  295. */
  296. VM_DEFINE_OP (1, instrument_entry, "instrument-entry", OP2 (X32, N32))
  297. {
  298. #if ENABLE_JIT
  299. if (!VP->disable_mcode)
  300. {
  301. struct scm_jit_function_data *data;
  302. int32_t data_offset = ip[1];
  303. data = (struct scm_jit_function_data *) (ip + data_offset);
  304. if (data->mcode)
  305. {
  306. SYNC_IP ();
  307. scm_jit_enter_mcode (thread, data->mcode);
  308. CACHE_REGISTER ();
  309. NEXT (0);
  310. }
  311. if (data->counter >= scm_jit_counter_threshold)
  312. {
  313. const uint8_t *mcode;
  314. SYNC_IP ();
  315. mcode = scm_jit_compute_mcode (thread, data);
  316. if (mcode)
  317. {
  318. scm_jit_enter_mcode (thread, mcode);
  319. CACHE_REGISTER ();
  320. NEXT (0);
  321. }
  322. }
  323. else
  324. data->counter += SCM_JIT_COUNTER_ENTRY_INCREMENT;
  325. }
  326. #endif
  327. APPLY_HOOK ();
  328. NEXT (2);
  329. }
  330. /* instrument-loop _:24 data:32
  331. *
  332. * Increase execution counter for this function and potentially tier
  333. * up to the next JIT level. DATA is an offset to a structure
  334. * recording execution counts and the next-level JIT code
  335. * corresponding to this function.
  336. */
  337. VM_DEFINE_OP (2, instrument_loop, "instrument-loop", OP2 (X32, N32))
  338. {
  339. #if ENABLE_JIT
  340. if (!VP->disable_mcode)
  341. {
  342. int32_t data_offset = ip[1];
  343. struct scm_jit_function_data *data;
  344. data = (struct scm_jit_function_data *) (ip + data_offset);
  345. if (data->counter >= scm_jit_counter_threshold)
  346. {
  347. const uint8_t *mcode;
  348. SYNC_IP ();
  349. mcode = scm_jit_compute_mcode (thread, data);
  350. if (mcode)
  351. {
  352. scm_jit_enter_mcode (thread, mcode);
  353. CACHE_REGISTER ();
  354. NEXT (0);
  355. }
  356. }
  357. else
  358. data->counter += SCM_JIT_COUNTER_LOOP_INCREMENT;
  359. }
  360. #endif
  361. NEXT (2);
  362. }
  363. /* call proc:24 _:8 nlocals:24
  364. *
  365. * Call a procedure. PROC is the local corresponding to a procedure.
  366. * The three values below PROC will be overwritten by the saved call
  367. * frame data. The new frame will have space for NLOCALS locals: one
  368. * for the procedure, and the rest for the arguments which should
  369. * already have been pushed on.
  370. *
  371. * When the call returns, execution proceeds with the next
  372. * instruction. There may be any number of values on the return
  373. * stack; the precise number can be had by subtracting the address of
  374. * slot PROC-1 from the post-call SP.
  375. */
  376. VM_DEFINE_OP (3, call, "call", OP2 (X8_F24, X8_C24))
  377. {
  378. uint32_t proc, nlocals;
  379. union scm_vm_stack_element *old_fp, *new_fp;
  380. UNPACK_24 (op, proc);
  381. UNPACK_24 (ip[1], nlocals);
  382. old_fp = VP->fp;
  383. new_fp = SCM_FRAME_SLOT (old_fp, proc - 1);
  384. SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp);
  385. SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (new_fp, ip + 2);
  386. SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (new_fp, 0);
  387. VP->fp = new_fp;
  388. RESET_FRAME (nlocals);
  389. ip = CALL_INTRINSIC (get_callee_vcode, (thread));
  390. CACHE_SP ();
  391. NEXT (0);
  392. }
  393. /* call-label proc:24 _:8 nlocals:24 label:32
  394. *
  395. * Call a procedure in the same compilation unit.
  396. *
  397. * This instruction is just like "call", except that instead of
  398. * dereferencing PROC to find the call target, the call target is
  399. * known to be at LABEL, a signed 32-bit offset in 32-bit units from
  400. * the current IP. Since PROC is not used to compute the callee code,
  401. * it may be some other representation of the closure.
  402. */
  403. VM_DEFINE_OP (4, call_label, "call-label", OP3 (X8_F24, X8_C24, L32))
  404. {
  405. uint32_t proc, nlocals;
  406. int32_t label;
  407. union scm_vm_stack_element *old_fp, *new_fp;
  408. UNPACK_24 (op, proc);
  409. UNPACK_24 (ip[1], nlocals);
  410. label = ip[2];
  411. old_fp = VP->fp;
  412. new_fp = SCM_FRAME_SLOT (old_fp, proc - 1);
  413. SCM_FRAME_SET_DYNAMIC_LINK (new_fp, old_fp);
  414. SCM_FRAME_SET_VIRTUAL_RETURN_ADDRESS (new_fp, ip + 3);
  415. SCM_FRAME_SET_MACHINE_RETURN_ADDRESS (new_fp, 0);
  416. VP->fp = new_fp;
  417. RESET_FRAME (nlocals);
  418. ip += label;
  419. NEXT (0);
  420. }
  421. /* tail-call _:24
  422. *
  423. * Tail-call the procedure in slot 0 with the arguments in the current
  424. * stack frame. Requires that the procedure and all of the arguments
  425. * have already been shuffled into position.
  426. */
  427. VM_DEFINE_OP (5, tail_call, "tail-call", OP1 (X32))
  428. {
  429. ip = CALL_INTRINSIC (get_callee_vcode, (thread));
  430. CACHE_SP ();
  431. NEXT (0);
  432. }
  433. /* tail-call-label _:24 label:32
  434. *
  435. * Tail-call a known procedure. As call is to call-label, tail-call
  436. * is to tail-call-label.
  437. */
  438. VM_DEFINE_OP (6, tail_call_label, "tail-call-label", OP2 (X32, L32))
  439. {
  440. int32_t label;
  441. label = ip[1];
  442. ip += label;
  443. NEXT (0);
  444. }
  445. /* return-values _:24
  446. *
  447. * Return all values from a call frame.
  448. */
  449. VM_DEFINE_OP (7, return_values, "return-values", OP1 (X32))
  450. {
  451. union scm_vm_stack_element *old_fp;
  452. uint8_t *mcode;
  453. RETURN_HOOK ();
  454. old_fp = VP->fp;
  455. VP->fp = SCM_FRAME_DYNAMIC_LINK (old_fp);
  456. #if ENABLE_JIT
  457. if (!VP->disable_mcode)
  458. {
  459. mcode = SCM_FRAME_MACHINE_RETURN_ADDRESS (old_fp);
  460. if (mcode)
  461. {
  462. scm_jit_enter_mcode (thread, mcode);
  463. CACHE_REGISTER ();
  464. NEXT (0);
  465. }
  466. }
  467. #endif
  468. ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (old_fp);
  469. NEXT (0);
  470. }
  471. /* receive dst:12 proc:12 _:8 nlocals:24
  472. *
  473. * Receive a single return value from a call whose procedure was in
  474. * PROC, asserting that the call actually returned at least one
  475. * value. Afterwards, resets the frame to NLOCALS locals.
  476. */
  477. VM_DEFINE_OP (8, receive, "receive", DOP2 (X8_F12_F12, X8_C24))
  478. {
  479. uint16_t dst, proc;
  480. uint32_t nlocals;
  481. UNPACK_12_12 (op, dst, proc);
  482. UNPACK_24 (ip[1], nlocals);
  483. VM_ASSERT (FRAME_LOCALS_COUNT () > proc,
  484. CALL_INTRINSIC (error_no_values, ()));
  485. FP_SET (dst, FP_REF (proc));
  486. RESET_FRAME (nlocals);
  487. NEXT (2);
  488. }
  489. /* receive-values proc:24 allow-extra?:1 _:7 nvalues:24
  490. *
  491. * Receive a return of multiple values from a call whose procedure was
  492. * in PROC. If fewer than NVALUES values were returned, signal an
  493. * error. Unless ALLOW-EXTRA? is true, require that the number of
  494. * return values equals NVALUES exactly. After receive-values has
  495. * run, the values can be copied down via `mov'.
  496. */
  497. VM_DEFINE_OP (9, receive_values, "receive-values", OP2 (X8_F24, B1_X7_C24))
  498. {
  499. uint32_t proc, nvalues;
  500. UNPACK_24 (op, proc);
  501. UNPACK_24 (ip[1], nvalues);
  502. if (ip[1] & 0x1)
  503. VM_ASSERT (FRAME_LOCALS_COUNT () >= proc + nvalues,
  504. CALL_INTRINSIC (error_not_enough_values, ()));
  505. else
  506. VM_ASSERT (FRAME_LOCALS_COUNT () == proc + nvalues,
  507. CALL_INTRINSIC (error_wrong_number_of_values, (nvalues)));
  508. NEXT (2);
  509. }
  510. /* assert-nargs-ee expected:24
  511. * assert-nargs-ge expected:24
  512. * assert-nargs-le expected:24
  513. *
  514. * If the number of actual arguments is not ==, >=, or <= EXPECTED,
  515. * respectively, signal an error.
  516. */
  517. VM_DEFINE_OP (10, assert_nargs_ee, "assert-nargs-ee", OP1 (X8_C24))
  518. {
  519. uint32_t expected;
  520. UNPACK_24 (op, expected);
  521. VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
  522. CALL_INTRINSIC (error_wrong_num_args, (thread)));
  523. NEXT (1);
  524. }
  525. VM_DEFINE_OP (11, assert_nargs_ge, "assert-nargs-ge", OP1 (X8_C24))
  526. {
  527. uint32_t expected;
  528. UNPACK_24 (op, expected);
  529. VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
  530. CALL_INTRINSIC (error_wrong_num_args, (thread)));
  531. NEXT (1);
  532. }
  533. VM_DEFINE_OP (12, assert_nargs_le, "assert-nargs-le", OP1 (X8_C24))
  534. {
  535. uint32_t expected;
  536. UNPACK_24 (op, expected);
  537. VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
  538. CALL_INTRINSIC (error_wrong_num_args, (thread)));
  539. NEXT (1);
  540. }
  541. /* assert-nargs-ee/locals expected:12 nlocals:12
  542. *
  543. * Equivalent to a sequence of assert-nargs-ee and reserve-locals. The
  544. * number of locals reserved is EXPECTED + NLOCALS.
  545. */
  546. VM_DEFINE_OP (13, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (X8_C12_C12))
  547. {
  548. uint16_t expected, nlocals;
  549. UNPACK_12_12 (op, expected, nlocals);
  550. VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
  551. CALL_INTRINSIC (error_wrong_num_args, (thread)));
  552. ALLOC_FRAME (expected + nlocals);
  553. while (nlocals--)
  554. SP_SET (nlocals, SCM_UNDEFINED);
  555. NEXT (1);
  556. }
  557. /* arguments<=? expected:24
  558. *
  559. * Set the LESS_THAN, EQUAL, or NONE comparison result values if the
  560. * number of arguments is respectively less than, equal to, or greater
  561. * than EXPECTED.
  562. */
  563. VM_DEFINE_OP (14, check_arguments, "arguments<=?", OP1 (X8_C24))
  564. {
  565. uint8_t compare_result;
  566. uint32_t expected;
  567. ptrdiff_t nargs;
  568. UNPACK_24 (op, expected);
  569. nargs = FRAME_LOCALS_COUNT ();
  570. if (nargs < (ptrdiff_t) expected)
  571. compare_result = SCM_F_COMPARE_LESS_THAN;
  572. else if (nargs == (ptrdiff_t) expected)
  573. compare_result = SCM_F_COMPARE_EQUAL;
  574. else
  575. compare_result = SCM_F_COMPARE_NONE;
  576. VP->compare_result = compare_result;
  577. NEXT (1);
  578. }
  579. /* positional-arguments<=? nreq:24 _:8 expected:24
  580. *
  581. * Set the LESS_THAN, EQUAL, or NONE comparison result values if the
  582. * number of positional arguments is less than, equal to, or greater
  583. * than EXPECTED. The first NREQ arguments are positional arguments,
  584. * as are the subsequent arguments that are not keywords.
  585. */
  586. VM_DEFINE_OP (15, check_positional_arguments, "positional-arguments<=?", OP2 (X8_C24, X8_C24))
  587. {
  588. uint8_t compare_result;
  589. uint32_t nreq, expected;
  590. ptrdiff_t nargs, npos;
  591. UNPACK_24 (op, nreq);
  592. UNPACK_24 (ip[1], expected);
  593. nargs = FRAME_LOCALS_COUNT ();
  594. /* Precondition: at least NREQ arguments. */
  595. for (npos = nreq; npos < nargs && npos <= expected; npos++)
  596. if (scm_is_keyword (FP_REF (npos)))
  597. break;
  598. if (npos < (ptrdiff_t) expected)
  599. compare_result = SCM_F_COMPARE_LESS_THAN;
  600. else if (npos == (ptrdiff_t) expected)
  601. compare_result = SCM_F_COMPARE_EQUAL;
  602. else
  603. compare_result = SCM_F_COMPARE_NONE;
  604. VP->compare_result = compare_result;
  605. NEXT (2);
  606. }
  607. /* bind-kwargs nreq:24 flags:8 nreq-and-opt:24 _:8 ntotal:24 kw-offset:32
  608. *
  609. * flags := allow-other-keys:1 has-rest:1 _:6
  610. *
  611. * Find the last positional argument, and shuffle all the rest above
  612. * NTOTAL. Initialize the intervening locals to SCM_UNDEFINED. Then
  613. * load the constant at KW-OFFSET words from the current IP, and use it
  614. * to bind keyword arguments. If HAS-REST, collect all shuffled
  615. * arguments into a list, and store it in NREQ-AND-OPT. Finally, clear
  616. * the arguments that we shuffled up.
  617. *
  618. * A macro-mega-instruction.
  619. */
  620. VM_DEFINE_OP (16, bind_kwargs, "bind-kwargs", OP4 (X8_C24, C8_C24, X8_C24, N32))
  621. {
  622. uint32_t nreq, nreq_and_opt, ntotal, npositional;
  623. int32_t kw_offset;
  624. scm_t_bits kw_bits;
  625. SCM kw;
  626. uint8_t allow_other_keys, has_rest;
  627. UNPACK_24 (op, nreq);
  628. allow_other_keys = ip[1] & 0x1;
  629. has_rest = ip[1] & 0x2;
  630. UNPACK_24 (ip[1], nreq_and_opt);
  631. UNPACK_24 (ip[2], ntotal);
  632. kw_offset = ip[3];
  633. kw_bits = (scm_t_bits) (ip + kw_offset);
  634. VM_ASSERT (!(kw_bits & 0x7), abort());
  635. kw = SCM_PACK (kw_bits);
  636. /* Note that if nopt == 0 then npositional = nreq. */
  637. npositional = CALL_INTRINSIC (compute_kwargs_npositional,
  638. (thread, nreq, nreq_and_opt - nreq));
  639. SYNC_IP ();
  640. CALL_INTRINSIC (bind_kwargs,
  641. (thread, npositional, ntotal, kw, !has_rest,
  642. allow_other_keys));
  643. CACHE_SP ();
  644. if (has_rest)
  645. FP_SET (nreq_and_opt, CALL_INTRINSIC (cons_rest, (thread, ntotal)));
  646. RESET_FRAME (ntotal);
  647. NEXT (4);
  648. }
  649. /* bind-rest dst:24
  650. *
  651. * Collect any arguments at or above DST into a list, and store that
  652. * list at DST.
  653. */
  654. VM_DEFINE_OP (17, bind_rest, "bind-rest", DOP1 (X8_F24))
  655. {
  656. uint32_t dst, nargs;
  657. SCM rest = SCM_EOL;
  658. UNPACK_24 (op, dst);
  659. nargs = FRAME_LOCALS_COUNT ();
  660. if (nargs <= dst)
  661. {
  662. ALLOC_FRAME (dst + 1);
  663. while (nargs < dst)
  664. FP_SET (nargs++, SCM_UNDEFINED);
  665. }
  666. else
  667. {
  668. SYNC_IP ();
  669. rest = CALL_INTRINSIC (cons_rest, (thread, dst));
  670. RESET_FRAME (dst + 1);
  671. }
  672. FP_SET (dst, rest);
  673. NEXT (1);
  674. }
  675. /* alloc-frame nlocals:24
  676. *
  677. * Ensure that there is space on the stack for NLOCALS local variables.
  678. * setting any new stack slots to SCM_UNDEFINED.
  679. */
  680. VM_DEFINE_OP (18, alloc_frame, "alloc-frame", OP1 (X8_C24))
  681. {
  682. uint32_t nlocals, nargs;
  683. UNPACK_24 (op, nlocals);
  684. nargs = FRAME_LOCALS_COUNT ();
  685. ALLOC_FRAME (nlocals);
  686. while (nlocals-- > nargs)
  687. FP_SET (nlocals, SCM_UNDEFINED);
  688. NEXT (1);
  689. }
  690. /* reset-frame nlocals:24
  691. *
  692. * Like alloc-frame, but doesn't check that the stack is big enough,
  693. * and doesn't reset stack slots to SCM_UNDEFINED. Used to reset the
  694. * frame size to something less than the size that was previously set
  695. * via alloc-frame.
  696. */
  697. VM_DEFINE_OP (19, reset_frame, "reset-frame", OP1 (X8_C24))
  698. {
  699. uint32_t nlocals;
  700. UNPACK_24 (op, nlocals);
  701. RESET_FRAME (nlocals);
  702. NEXT (1);
  703. }
  704. /* mov dst:12 src:12
  705. *
  706. * Copy a value from one local slot to another.
  707. */
  708. VM_DEFINE_OP (20, mov, "mov", DOP1 (X8_S12_S12))
  709. {
  710. uint16_t dst;
  711. uint16_t src;
  712. UNPACK_12_12 (op, dst, src);
  713. /* FIXME: The compiler currently emits "mov" for SCM, F64, U64,
  714. and S64 variables. However SCM values are the usual case, and
  715. on a 32-bit machine it might be cheaper to move a SCM than to
  716. move a 64-bit number. */
  717. SP_SET_SLOT (dst, SP_REF_SLOT (src));
  718. NEXT (1);
  719. }
  720. /* long-mov dst:24 _:8 src:24
  721. *
  722. * Copy a value from one local slot to another.
  723. */
  724. VM_DEFINE_OP (21, long_mov, "long-mov", DOP2 (X8_S24, X8_S24))
  725. {
  726. uint32_t dst;
  727. uint32_t src;
  728. UNPACK_24 (op, dst);
  729. UNPACK_24 (ip[1], src);
  730. /* FIXME: The compiler currently emits "long-mov" for SCM, F64,
  731. U64, and S64 variables. However SCM values are the usual case,
  732. and on a 32-bit machine it might be cheaper to move a SCM than
  733. to move a 64-bit number. */
  734. SP_SET_SLOT (dst, SP_REF_SLOT (src));
  735. NEXT (2);
  736. }
  737. /* long-fmov dst:24 _:8 src:24
  738. *
  739. * Copy a value from one local slot to another. Slot indexes are
  740. * relative to the FP.
  741. */
  742. VM_DEFINE_OP (22, long_fmov, "long-fmov", DOP2 (X8_F24, X8_F24))
  743. {
  744. uint32_t dst;
  745. uint32_t src;
  746. UNPACK_24 (op, dst);
  747. UNPACK_24 (ip[1], src);
  748. FP_SET (dst, FP_REF (src));
  749. NEXT (2);
  750. }
  751. /* push src:24
  752. *
  753. * Push SRC onto the stack.
  754. */
  755. VM_DEFINE_OP (23, push, "push", OP1 (X8_S24))
  756. {
  757. uint32_t src;
  758. union scm_vm_stack_element val;
  759. /* FIXME: The compiler currently emits "push" for SCM, F64, U64,
  760. and S64 variables. However SCM values are the usual case, and
  761. on a 32-bit machine it might be cheaper to move a SCM than to
  762. move a 64-bit number. */
  763. UNPACK_24 (op, src);
  764. val = SP_REF_SLOT (src);
  765. ALLOC_FRAME (FRAME_LOCALS_COUNT () + 1);
  766. SP_SET_SLOT (0, val);
  767. NEXT (1);
  768. }
  769. /* pop dst:24
  770. *
  771. * Pop the stack, storing to DST.
  772. */
  773. VM_DEFINE_OP (24, pop, "pop", DOP1 (X8_S24))
  774. {
  775. uint32_t dst;
  776. union scm_vm_stack_element val;
  777. /* FIXME: The compiler currently emits "pop" for SCM, F64, U64,
  778. and S64 variables. However SCM values are the usual case, and
  779. on a 32-bit machine it might be cheaper to move a SCM than to
  780. move a 64-bit number. */
  781. UNPACK_24 (op, dst);
  782. val = SP_REF_SLOT (0);
  783. VP->sp = sp = sp + 1;
  784. SP_SET_SLOT (dst, val);
  785. NEXT (1);
  786. }
  787. /* drop count:24
  788. *
  789. * Drop some number of values from the stack.
  790. */
  791. VM_DEFINE_OP (25, drop, "drop", OP1 (X8_C24))
  792. {
  793. uint32_t count;
  794. UNPACK_24 (op, count);
  795. VP->sp = sp = sp + count;
  796. NEXT (1);
  797. }
  798. /* shuffle-down from:12 to:12
  799. *
  800. * Shuffle down values from FROM to TO, reducing the frame size by
  801. * (FROM-TO) slots. Part of the internal implementation of
  802. * call-with-values, values, and apply.
  803. */
  804. VM_DEFINE_OP (26, shuffle_down, "shuffle-down", OP1 (X8_F12_F12))
  805. {
  806. uint32_t n, from, to, nlocals;
  807. UNPACK_12_12 (op, from, to);
  808. VM_ASSERT (from > to, abort ());
  809. nlocals = FRAME_LOCALS_COUNT ();
  810. for (n = 0; from + n < nlocals; n++)
  811. FP_SET (to + n, FP_REF (from + n));
  812. RESET_FRAME (to + n);
  813. NEXT (1);
  814. }
  815. /* expand-apply-argument _:24
  816. *
  817. * Take the last local in a frame and expand it out onto the stack, as
  818. * for the last argument to "apply".
  819. */
  820. VM_DEFINE_OP (27, expand_apply_argument, "expand-apply-argument", OP1 (X32))
  821. {
  822. SYNC_IP ();
  823. CALL_INTRINSIC (expand_apply_argument, (thread));
  824. CACHE_SP ();
  825. NEXT (1);
  826. }
  827. /* subr-call idx:24
  828. *
  829. * Call a subr, passing all locals in this frame as arguments, and
  830. * storing the results on the stack, ready to be returned. This
  831. * instruction is part of the trampolines created in gsubr.c, and is
  832. * not generated by the compiler.
  833. */
  834. VM_DEFINE_OP (28, subr_call, "subr-call", OP1 (X8_C24))
  835. {
  836. SCM ret;
  837. uint32_t idx;
  838. UNPACK_24 (op, idx);
  839. SYNC_IP ();
  840. ret = scm_apply_subr (sp, idx, FRAME_LOCALS_COUNT ());
  841. if (SCM_UNLIKELY (scm_is_values (ret)))
  842. {
  843. CALL_INTRINSIC (unpack_values_object, (thread, ret));
  844. CACHE_SP ();
  845. NEXT (1);
  846. }
  847. else
  848. {
  849. RESET_FRAME (1);
  850. SP_SET (0, ret);
  851. NEXT (1);
  852. }
  853. }
  854. /* foreign-call cif-idx:12 ptr-idx:12
  855. *
  856. * Call a foreign function. Fetch the CIF and foreign pointer from
  857. * the CIF-IDX and PTR-IDX closure slots of the callee. Arguments are
  858. * taken from the stack, and results placed on the stack, ready to be
  859. * returned. This instruction is part of the trampolines created by
  860. * the FFI, and is not generated by the compiler.
  861. */
  862. VM_DEFINE_OP (29, foreign_call, "foreign-call", OP1 (X8_C12_C12))
  863. {
  864. uint16_t cif_idx, ptr_idx;
  865. SCM closure, cif, pointer;
  866. UNPACK_12_12 (op, cif_idx, ptr_idx);
  867. closure = FP_REF (0);
  868. cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
  869. pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
  870. SYNC_IP ();
  871. CALL_INTRINSIC (foreign_call, (thread, cif, pointer));
  872. CACHE_SP ();
  873. NEXT (1);
  874. }
  875. /* continuation-call contregs:24
  876. *
  877. * Return to a continuation, nonlocally. The arguments to the
  878. * continuation are taken from the stack. CONTREGS is a free variable
  879. * containing the reified continuation. This instruction is part of
  880. * the implementation of undelimited continuations, and is not
  881. * generated by the compiler.
  882. */
  883. VM_DEFINE_OP (30, continuation_call, "continuation-call", OP1 (X8_C24))
  884. {
  885. SCM contregs;
  886. uint32_t contregs_idx;
  887. UNPACK_24 (op, contregs_idx);
  888. contregs =
  889. SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), contregs_idx);
  890. SYNC_IP ();
  891. CALL_INTRINSIC (reinstate_continuation_x, (thread, contregs));
  892. /* no NEXT */
  893. abort ();
  894. }
  895. /* compose-continuation cont:24
  896. *
  897. * Compose a partial continuation with the current continuation. The
  898. * arguments to the continuation are taken from the stack. CONT is a
  899. * free variable containing the reified continuation. This
  900. * instruction is part of the implementation of partial continuations,
  901. * and is not generated by the compiler.
  902. */
  903. VM_DEFINE_OP (31, compose_continuation, "compose-continuation", OP1 (X8_C24))
  904. {
  905. SCM vmcont;
  906. uint32_t cont_idx;
  907. uint8_t *mcode;
  908. UNPACK_24 (op, cont_idx);
  909. vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (FP_REF (0), cont_idx);
  910. SYNC_IP ();
  911. mcode = CALL_INTRINSIC (compose_continuation, (thread, vmcont));
  912. #if ENABLE_JIT
  913. if (mcode && !VP->disable_mcode)
  914. {
  915. scm_jit_enter_mcode (thread, mcode);
  916. CACHE_REGISTER ();
  917. NEXT (0);
  918. }
  919. else
  920. #endif
  921. {
  922. CACHE_REGISTER ();
  923. NEXT (0);
  924. }
  925. }
  926. /* capture-continuation dst:24
  927. *
  928. * Capture the current continuation. This instruction is part of the
  929. * implementation of `call/cc', and is not generated by the compiler.
  930. */
  931. VM_DEFINE_OP (32, capture_continuation, "capture-continuation", DOP1 (X8_S24))
  932. {
  933. uint32_t dst;
  934. UNPACK_24 (op, dst);
  935. SYNC_IP ();
  936. SP_SET (dst, CALL_INTRINSIC (capture_continuation, (thread)));
  937. NEXT (1);
  938. }
  939. /* abort _:24
  940. *
  941. * Abort to a prompt handler. The tag is expected in r1, and the rest
  942. * of the values in the frame are returned to the prompt handler.
  943. * This corresponds to a tail application of abort-to-prompt.
  944. */
  945. VM_DEFINE_OP (33, abort, "abort", OP1 (X32))
  946. {
  947. uint8_t *mcode = NULL;
  948. /* FIXME: Really we should capture the caller's registers. Until
  949. then, manually advance the IP so that when the prompt resumes,
  950. it continues with the next instruction. */
  951. ip++;
  952. SYNC_IP ();
  953. mcode = CALL_INTRINSIC (abort_to_prompt, (thread, mcode));
  954. /* If abort_to_prompt returned, that means there were no
  955. intervening C frames to jump over, so we just continue
  956. directly. */
  957. CACHE_REGISTER ();
  958. ABORT_HOOK ();
  959. #if ENABLE_JIT
  960. if (mcode && !VP->disable_mcode)
  961. {
  962. scm_jit_enter_mcode (thread, mcode);
  963. CACHE_REGISTER ();
  964. }
  965. #endif
  966. NEXT (0);
  967. }
  968. /* prompt tag:24 escape-only?:1 _:7 proc-slot:24 _:8 handler-offset:24
  969. *
  970. * Push a new prompt on the dynamic stack, with a tag from TAG and a
  971. * handler at HANDLER-OFFSET words from the current IP. The handler
  972. * will expect a multiple-value return as if from a call with the
  973. * procedure at PROC-SLOT.
  974. */
  975. VM_DEFINE_OP (34, prompt, "prompt", OP3 (X8_S24, B1_X7_F24, X8_L24))
  976. {
  977. uint32_t tag, proc_slot;
  978. int32_t offset;
  979. uint8_t escape_only_p;
  980. uint8_t *mra = NULL;
  981. UNPACK_24 (op, tag);
  982. escape_only_p = ip[1] & 0x1;
  983. UNPACK_24 (ip[1], proc_slot);
  984. offset = ip[2];
  985. offset >>= 8; /* Sign extension */
  986. /* Push the prompt onto the dynamic stack. */
  987. SYNC_IP ();
  988. CALL_INTRINSIC (push_prompt, (thread, escape_only_p, SP_REF (tag),
  989. VP->fp - proc_slot, ip + offset, mra));
  990. NEXT (3);
  991. }
  992. /* builtin-ref dst:12 idx:12
  993. *
  994. * Load a builtin stub by index into DST.
  995. */
  996. VM_DEFINE_OP (35, builtin_ref, "builtin-ref", DOP1 (X8_S12_C12))
  997. {
  998. uint16_t dst, idx;
  999. UNPACK_12_12 (op, dst, idx);
  1000. SP_SET (dst, scm_vm_builtin_ref (idx));
  1001. NEXT (1);
  1002. }
  1003. /* throw key:12 args:12
  1004. *
  1005. * Throw to KEY and ARGS. ARGS should be a list.
  1006. */
  1007. VM_DEFINE_OP (36, throw, "throw", OP1 (X8_S12_S12))
  1008. {
  1009. uint16_t a, b;
  1010. SCM key, args;
  1011. UNPACK_12_12 (op, a, b);
  1012. key = SP_REF (a);
  1013. args = SP_REF (b);
  1014. SYNC_IP ();
  1015. CALL_INTRINSIC (throw_, (key, args));
  1016. abort (); /* never reached */
  1017. }
  1018. /* throw/value val:24 key-subr-and-message:32
  1019. *
  1020. * Raise an error, indicating VAL as the bad value.
  1021. * KEY-SUBR-AND-MESSAGE should be a vector, where the first element is
  1022. * the symbol to which to throw, the second is the procedure in which
  1023. * to signal the error (a string) or #f, and the third is a format
  1024. * string for the message, with one template.
  1025. */
  1026. VM_DEFINE_OP (37, throw_value, "throw/value", OP2 (X8_S24, N32))
  1027. {
  1028. uint32_t a;
  1029. int32_t offset;
  1030. scm_t_bits key_subr_and_message_bits;
  1031. SCM val, key_subr_and_message;
  1032. UNPACK_24 (op, a);
  1033. val = SP_REF (a);
  1034. offset = ip[1];
  1035. key_subr_and_message_bits = (scm_t_bits) (ip + offset);
  1036. VM_ASSERT (!(key_subr_and_message_bits & 0x7), abort());
  1037. key_subr_and_message = SCM_PACK (key_subr_and_message_bits);
  1038. SYNC_IP ();
  1039. CALL_INTRINSIC (throw_with_value, (val, key_subr_and_message));
  1040. abort (); /* never reached */
  1041. }
  1042. /* throw/value+data val:24 key-subr-and-message:32
  1043. *
  1044. * Raise an error, indicating VAL as the bad value.
  1045. * KEY-SUBR-AND-MESSAGE should be a vector, where the first element is
  1046. * the symbol to which to throw, the second is the procedure in which
  1047. * to signal the error (a string) or #f, and the third is a format
  1048. * string for the message, with one template.
  1049. */
  1050. VM_DEFINE_OP (38, throw_value_and_data, "throw/value+data", OP2 (X8_S24, N32))
  1051. {
  1052. uint32_t a;
  1053. int32_t offset;
  1054. scm_t_bits key_subr_and_message_bits;
  1055. SCM val, key_subr_and_message;
  1056. UNPACK_24 (op, a);
  1057. val = SP_REF (a);
  1058. offset = ip[1];
  1059. key_subr_and_message_bits = (scm_t_bits) (ip + offset);
  1060. VM_ASSERT (!(key_subr_and_message_bits & 0x7), abort());
  1061. key_subr_and_message = SCM_PACK (key_subr_and_message_bits);
  1062. SYNC_IP ();
  1063. CALL_INTRINSIC (throw_with_value_and_data, (val, key_subr_and_message));
  1064. abort (); /* never reached */
  1065. }
  1066. /* handle-interrupts _:24
  1067. *
  1068. * Handle pending interrupts.
  1069. */
  1070. VM_DEFINE_OP (39, handle_interrupts, "handle-interrupts", OP1 (X32))
  1071. {
  1072. if (SCM_LIKELY (scm_is_null
  1073. (scm_atomic_ref_scm (&thread->pending_asyncs))))
  1074. NEXT (1);
  1075. if (thread->block_asyncs > 0)
  1076. NEXT (1);
  1077. SYNC_IP ();
  1078. CALL_INTRINSIC (push_interrupt_frame, (thread, 0));
  1079. CACHE_SP ();
  1080. ip = scm_vm_intrinsics.handle_interrupt_code;
  1081. NEXT (0);
  1082. }
  1083. /* return-from-interrupt _:24
  1084. *
  1085. * Return from handling an interrupt, discarding any return values and
  1086. * stripping away the interrupt frame.
  1087. */
  1088. VM_DEFINE_OP (40, return_from_interrupt, "return-from-interrupt", OP1 (X32))
  1089. {
  1090. union scm_vm_stack_element *fp = VP->fp;
  1091. ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (fp);
  1092. VP->fp = SCM_FRAME_DYNAMIC_LINK (fp);
  1093. VP->sp = sp = SCM_FRAME_PREVIOUS_SP (fp);
  1094. NEXT (0);
  1095. }
  1096. /* call-thread _:24 IDX:32
  1097. *
  1098. * Call the void-returning instrinsic with index IDX, passing the
  1099. * current scm_thread* as the argument.
  1100. */
  1101. VM_DEFINE_OP (41, call_thread, "call-thread", OP2 (X32, C32))
  1102. {
  1103. scm_t_thread_intrinsic intrinsic;
  1104. intrinsic = intrinsics[ip[1]];
  1105. SYNC_IP ();
  1106. intrinsic (thread);
  1107. CACHE_SP ();
  1108. NEXT (2);
  1109. }
  1110. /* call-thread-scm a:24 IDX:32
  1111. *
  1112. * Call the void-returning instrinsic with index IDX, passing the
  1113. * current scm_thread* and the SCM local A as arguments.
  1114. */
  1115. VM_DEFINE_OP (42, call_thread_scm, "call-thread-scm", OP2 (X8_S24, C32))
  1116. {
  1117. uint32_t a;
  1118. scm_t_thread_scm_intrinsic intrinsic;
  1119. UNPACK_24 (op, a);
  1120. intrinsic = intrinsics[ip[1]];
  1121. SYNC_IP ();
  1122. intrinsic (thread, SP_REF (a));
  1123. CACHE_SP ();
  1124. NEXT (2);
  1125. }
  1126. /* call-thread-scm-scm a:12 b:12 IDX:32
  1127. *
  1128. * Call the void-returning instrinsic with index IDX, passing the
  1129. * current scm_thread* and the SCM locals A and B as arguments.
  1130. */
  1131. VM_DEFINE_OP (43, call_thread_scm_scm, "call-thread-scm-scm", OP2 (X8_S12_S12, C32))
  1132. {
  1133. uint16_t a, b;
  1134. scm_t_thread_scm_scm_intrinsic intrinsic;
  1135. UNPACK_12_12 (op, a, b);
  1136. intrinsic = intrinsics[ip[1]];
  1137. SYNC_IP ();
  1138. intrinsic (thread, SP_REF (a), SP_REF (b));
  1139. CACHE_SP ();
  1140. NEXT (2);
  1141. }
  1142. /* call-scm-sz-u32 a:8 b:8 c:8 IDX:32
  1143. *
  1144. * Call the void-returning instrinsic with index IDX, passing the
  1145. * locals A, B, and C as arguments. A is a SCM value, while B and C
  1146. * are raw u64 values which fit into size_t and uint32_t types,
  1147. * respectively.
  1148. */
  1149. VM_DEFINE_OP (44, call_scm_sz_u32, "call-scm-sz-u32", OP2 (X8_S8_S8_S8, C32))
  1150. {
  1151. uint8_t a, b, c;
  1152. scm_t_scm_sz_u32_intrinsic intrinsic;
  1153. UNPACK_8_8_8 (op, a, b, c);
  1154. intrinsic = intrinsics[ip[1]];
  1155. SYNC_IP ();
  1156. intrinsic (SP_REF (a), SP_REF_U64 (b), SP_REF_U64 (c));
  1157. CACHE_SP ();
  1158. NEXT (2);
  1159. }
  1160. /* call-scm<-thread dst:24 IDX:32
  1161. *
  1162. * Call the SCM-returning instrinsic with index IDX, passing the
  1163. * current scm_thread* as argument. Place the SCM result in DST.
  1164. */
  1165. VM_DEFINE_OP (45, call_scm_from_thread, "call-scm<-thread", DOP2 (X8_S24, C32))
  1166. {
  1167. uint32_t dst;
  1168. scm_t_scm_from_thread_intrinsic intrinsic;
  1169. SCM res;
  1170. UNPACK_24 (op, dst);
  1171. intrinsic = intrinsics[ip[1]];
  1172. SYNC_IP ();
  1173. res = intrinsic (thread);
  1174. CACHE_SP ();
  1175. SP_SET (dst, res);
  1176. NEXT (2);
  1177. }
  1178. /* call-s64<-scm dst:12 a:12 IDX:32
  1179. *
  1180. * Call the int64_t-returning instrinsic with index IDX, passing the
  1181. * SCM local A as argument. Place the s64 result in DST.
  1182. */
  1183. VM_DEFINE_OP (46, call_s64_from_scm, "call-s64<-scm", DOP2 (X8_S12_S12, C32))
  1184. {
  1185. uint16_t dst, src;
  1186. scm_t_s64_from_scm_intrinsic intrinsic;
  1187. UNPACK_12_12 (op, dst, src);
  1188. intrinsic = intrinsics[ip[1]];
  1189. SYNC_IP ();
  1190. #if INDIRECT_INT64_INTRINSICS
  1191. intrinsic (& SP_REF_S64 (dst), SP_REF (src));
  1192. #else
  1193. {
  1194. int64_t res = intrinsic (SP_REF (src));
  1195. SP_SET_S64 (dst, res);
  1196. }
  1197. #endif
  1198. /* No CACHE_SP () after the intrinsic, as the indirect variants
  1199. have an out argument that points at the stack; stack relocation
  1200. during this kind of intrinsic is not supported! */
  1201. NEXT (2);
  1202. }
  1203. /* call-scm<-u64 dst:12 a:12 IDX:32
  1204. *
  1205. * Call the SCM-returning instrinsic with index IDX, passing the
  1206. * uint64_t local A as argument. Place the SCM result in DST.
  1207. */
  1208. VM_DEFINE_OP (47, call_scm_from_u64, "call-scm<-u64", DOP2 (X8_S12_S12, C32))
  1209. {
  1210. uint16_t dst, src;
  1211. SCM res;
  1212. scm_t_scm_from_u64_intrinsic intrinsic;
  1213. UNPACK_12_12 (op, dst, src);
  1214. intrinsic = intrinsics[ip[1]];
  1215. SYNC_IP ();
  1216. #if INDIRECT_INT64_INTRINSICS
  1217. res = intrinsic (& SP_REF_U64 (src));
  1218. #else
  1219. res = intrinsic (SP_REF_U64 (src));
  1220. #endif
  1221. SP_SET (dst, res);
  1222. /* No CACHE_SP () after the intrinsic, as the indirect variants
  1223. pass stack pointers directly; stack relocation during this kind
  1224. of intrinsic is not supported! */
  1225. NEXT (2);
  1226. }
  1227. /* call-scm<-s64 dst:12 a:12 IDX:32
  1228. *
  1229. * Call the SCM-returning instrinsic with index IDX, passing the
  1230. * int64_t local A as argument. Place the SCM result in DST.
  1231. */
  1232. VM_DEFINE_OP (48, call_scm_from_s64, "call-scm<-s64", DOP2 (X8_S12_S12, C32))
  1233. {
  1234. uint16_t dst, src;
  1235. SCM res;
  1236. scm_t_scm_from_s64_intrinsic intrinsic;
  1237. UNPACK_12_12 (op, dst, src);
  1238. intrinsic = intrinsics[ip[1]];
  1239. SYNC_IP ();
  1240. #if INDIRECT_INT64_INTRINSICS
  1241. res = intrinsic (& SP_REF_S64 (src));
  1242. #else
  1243. res = intrinsic (SP_REF_S64 (src));
  1244. #endif
  1245. CACHE_SP ();
  1246. SP_SET (dst, res);
  1247. NEXT (2);
  1248. }
  1249. /* call-scm<-scm dst:12 a:12 IDX:32
  1250. *
  1251. * Call the SCM-returning instrinsic with index IDX, passing the SCM
  1252. * local A as argument. Place the SCM result in DST.
  1253. */
  1254. VM_DEFINE_OP (49, call_scm_from_scm, "call-scm<-scm", DOP2 (X8_S12_S12, C32))
  1255. {
  1256. uint16_t dst, src;
  1257. SCM res;
  1258. scm_t_scm_from_scm_intrinsic intrinsic;
  1259. UNPACK_12_12 (op, dst, src);
  1260. intrinsic = intrinsics[ip[1]];
  1261. SYNC_IP ();
  1262. res = intrinsic (SP_REF (src));
  1263. CACHE_SP ();
  1264. SP_SET (dst, res);
  1265. NEXT (2);
  1266. }
  1267. /* call-f64<-scm dst:12 a:12 IDX:32
  1268. *
  1269. * Call the double-returning instrinsic with index IDX, passing the
  1270. * SCM local A as argument. Place the f64 result in DST.
  1271. */
  1272. VM_DEFINE_OP (50, call_f64_from_scm, "call-f64<-scm", DOP2 (X8_S12_S12, C32))
  1273. {
  1274. uint16_t dst, src;
  1275. double res;
  1276. scm_t_f64_from_scm_intrinsic intrinsic;
  1277. UNPACK_12_12 (op, dst, src);
  1278. intrinsic = intrinsics[ip[1]];
  1279. SYNC_IP ();
  1280. res = intrinsic (SP_REF (src));
  1281. CACHE_SP ();
  1282. SP_SET_F64 (dst, res);
  1283. NEXT (2);
  1284. }
  1285. /* call-u64<-scm dst:12 a:12 IDX:32
  1286. *
  1287. * Call the uint64_t-returning instrinsic with index IDX, passing the
  1288. * SCM local A as argument. Place the u64 result in DST.
  1289. */
  1290. VM_DEFINE_OP (51, call_u64_from_scm, "call-u64<-scm", DOP2 (X8_S12_S12, C32))
  1291. {
  1292. uint16_t dst, src;
  1293. scm_t_u64_from_scm_intrinsic intrinsic;
  1294. UNPACK_12_12 (op, dst, src);
  1295. intrinsic = intrinsics[ip[1]];
  1296. SYNC_IP ();
  1297. #if INDIRECT_INT64_INTRINSICS
  1298. intrinsic (& SP_REF_U64 (dst), SP_REF (src));
  1299. #else
  1300. {
  1301. uint64_t res = intrinsic (SP_REF (src));
  1302. SP_SET_U64 (dst, res);
  1303. }
  1304. #endif
  1305. /* No CACHE_SP () after the intrinsic, as the indirect variants
  1306. have an out argument that points at the stack; stack relocation
  1307. during this kind of intrinsic is not supported! */
  1308. NEXT (2);
  1309. }
  1310. /* call-scm<-scm-scm dst:8 a:8 b:8 IDX:32
  1311. *
  1312. * Call the SCM-returning instrinsic with index IDX, passing the SCM
  1313. * locals A and B as arguments. Place the SCM result in DST.
  1314. */
  1315. VM_DEFINE_OP (52, call_scm_from_scm_scm, "call-scm<-scm-scm", DOP2 (X8_S8_S8_S8, C32))
  1316. {
  1317. uint8_t dst, a, b;
  1318. SCM res;
  1319. scm_t_scm_from_scm_scm_intrinsic intrinsic;
  1320. UNPACK_8_8_8 (op, dst, a, b);
  1321. intrinsic = intrinsics[ip[1]];
  1322. SYNC_IP ();
  1323. res = intrinsic (SP_REF (a), SP_REF (b));
  1324. CACHE_SP ();
  1325. SP_SET (dst, res);
  1326. NEXT (2);
  1327. }
  1328. /* call-scm<-scm-uimm dst:8 a:8 b:8 IDX:32
  1329. *
  1330. * Call the SCM-returning instrinsic with index IDX, passing the SCM
  1331. * local A and the uint8_t immediate B as arguments. Place the SCM
  1332. * result in DST.
  1333. */
  1334. VM_DEFINE_OP (53, call_scm_from_scm_uimm, "call-scm<-scm-uimm", DOP2 (X8_S8_S8_C8, C32))
  1335. {
  1336. uint8_t dst, a, b;
  1337. SCM res;
  1338. scm_t_scm_from_scm_uimm_intrinsic intrinsic;
  1339. UNPACK_8_8_8 (op, dst, a, b);
  1340. intrinsic = intrinsics[ip[1]];
  1341. SYNC_IP ();
  1342. res = intrinsic (SP_REF (a), b);
  1343. CACHE_SP ();
  1344. SP_SET (dst, res);
  1345. NEXT (2);
  1346. }
  1347. /* call-scm<-thread-scm dst:12 a:12 IDX:32
  1348. *
  1349. * Call the SCM-returning instrinsic with index IDX, passing the
  1350. * current scm_thread* and SCM local A as arguments. Place the SCM
  1351. * result in DST.
  1352. */
  1353. VM_DEFINE_OP (54, call_scm_from_thread_scm, "call-scm<-thread-scm", DOP2 (X8_S12_S12, C32))
  1354. {
  1355. uint16_t dst, src;
  1356. scm_t_scm_from_thread_scm_intrinsic intrinsic;
  1357. SCM res;
  1358. UNPACK_12_12 (op, dst, src);
  1359. intrinsic = intrinsics[ip[1]];
  1360. SYNC_IP ();
  1361. res = intrinsic (thread, SP_REF (src));
  1362. CACHE_SP ();
  1363. SP_SET (dst, res);
  1364. NEXT (2);
  1365. }
  1366. /* call-scm<-scm-u64 dst:8 a:8 b:8 IDX:32
  1367. *
  1368. * Call the SCM-returning instrinsic with index IDX, passing SCM local
  1369. * A and u64 local B as arguments. Place the SCM result in DST.
  1370. */
  1371. VM_DEFINE_OP (55, call_scm_from_scm_u64, "call-scm<-scm-u64", DOP2 (X8_S8_S8_S8, C32))
  1372. {
  1373. uint8_t dst, a, b;
  1374. SCM res;
  1375. scm_t_scm_from_scm_u64_intrinsic intrinsic;
  1376. UNPACK_8_8_8 (op, dst, a, b);
  1377. intrinsic = intrinsics[ip[1]];
  1378. SYNC_IP ();
  1379. #if INDIRECT_INT64_INTRINSICS
  1380. res = intrinsic (SP_REF (a), & SP_REF_U64 (b));
  1381. #else
  1382. res = intrinsic (SP_REF (a), SP_REF_U64 (b));
  1383. #endif
  1384. CACHE_SP ();
  1385. SP_SET (dst, res);
  1386. NEXT (2);
  1387. }
  1388. /* make-short-immediate dst:8 low-bits:16
  1389. *
  1390. * Make an immediate whose low bits are LOW-BITS, and whose top bits are
  1391. * 0.
  1392. */
  1393. VM_DEFINE_OP (56, make_short_immediate, "make-short-immediate", DOP1 (X8_S8_I16))
  1394. {
  1395. uint8_t dst;
  1396. scm_t_bits val;
  1397. UNPACK_8_16 (op, dst, val);
  1398. SP_SET (dst, SCM_PACK (val));
  1399. NEXT (1);
  1400. }
  1401. /* make-long-immediate dst:24 low-bits:32
  1402. *
  1403. * Make an immediate whose low bits are LOW-BITS, and whose top bits are
  1404. * 0.
  1405. */
  1406. VM_DEFINE_OP (57, make_long_immediate, "make-long-immediate", DOP2 (X8_S24, I32))
  1407. {
  1408. uint32_t dst;
  1409. scm_t_bits val;
  1410. UNPACK_24 (op, dst);
  1411. val = ip[1];
  1412. SP_SET (dst, SCM_PACK (val));
  1413. NEXT (2);
  1414. }
  1415. /* make-long-long-immediate dst:24 high-bits:32 low-bits:32
  1416. *
  1417. * Make an immediate with HIGH-BITS and LOW-BITS.
  1418. */
  1419. VM_DEFINE_OP (58, make_long_long_immediate, "make-long-long-immediate", DOP3 (X8_S24, A32, B32))
  1420. {
  1421. uint32_t dst;
  1422. scm_t_bits val;
  1423. UNPACK_24 (op, dst);
  1424. #if SIZEOF_UINTPTR_T > 4
  1425. val = ip[1];
  1426. val <<= 32;
  1427. val |= ip[2];
  1428. #else
  1429. ASSERT (ip[1] == 0);
  1430. val = ip[2];
  1431. #endif
  1432. SP_SET (dst, SCM_PACK (val));
  1433. NEXT (3);
  1434. }
  1435. /* make-non-immediate dst:24 offset:32
  1436. *
  1437. * Load a pointer to statically allocated memory into DST. The
  1438. * object's memory is will be found OFFSET 32-bit words away from the
  1439. * current instruction pointer. OFFSET is a signed value. The
  1440. * intention here is that the compiler would produce an object file
  1441. * containing the words of a non-immediate object, and this
  1442. * instruction creates a pointer to that memory, effectively
  1443. * resurrecting that object.
  1444. *
  1445. * Whether the object is mutable or immutable depends on where it was
  1446. * allocated by the compiler, and loaded by the loader.
  1447. */
  1448. VM_DEFINE_OP (59, make_non_immediate, "make-non-immediate", DOP2 (X8_S24, N32))
  1449. {
  1450. uint32_t dst;
  1451. int32_t offset;
  1452. uint32_t* loc;
  1453. scm_t_bits unpacked;
  1454. UNPACK_24 (op, dst);
  1455. offset = ip[1];
  1456. loc = ip + offset;
  1457. unpacked = (scm_t_bits) loc;
  1458. VM_ASSERT (!(unpacked & 0x7), abort());
  1459. SP_SET (dst, SCM_PACK (unpacked));
  1460. NEXT (2);
  1461. }
  1462. /* load-label dst:24 offset:32
  1463. *
  1464. * Load a label OFFSET words away from the current IP and write it to
  1465. * DST. OFFSET is a signed 32-bit integer.
  1466. */
  1467. VM_DEFINE_OP (60, load_label, "load-label", DOP2 (X8_S24, L32))
  1468. {
  1469. uint32_t dst;
  1470. int32_t offset;
  1471. UNPACK_24 (op, dst);
  1472. offset = ip[1];
  1473. SP_SET_U64 (dst, (uintptr_t) (ip + offset));
  1474. NEXT (2);
  1475. }
  1476. /* load-f64 dst:24 high-bits:32 low-bits:32
  1477. *
  1478. * Make a double-precision floating-point value with HIGH-BITS and
  1479. * LOW-BITS.
  1480. */
  1481. VM_DEFINE_OP (61, load_f64, "load-f64", DOP3 (X8_S24, AF32, BF32))
  1482. {
  1483. uint32_t dst;
  1484. uint64_t val;
  1485. UNPACK_24 (op, dst);
  1486. val = ip[1];
  1487. val <<= 32;
  1488. val |= ip[2];
  1489. SP_SET_U64 (dst, val);
  1490. NEXT (3);
  1491. }
  1492. /* load-u64 dst:24 high-bits:32 low-bits:32
  1493. *
  1494. * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS.
  1495. */
  1496. VM_DEFINE_OP (62, load_u64, "load-u64", DOP3 (X8_S24, AU32, BU32))
  1497. {
  1498. uint32_t dst;
  1499. uint64_t val;
  1500. UNPACK_24 (op, dst);
  1501. val = ip[1];
  1502. val <<= 32;
  1503. val |= ip[2];
  1504. SP_SET_U64 (dst, val);
  1505. NEXT (3);
  1506. }
  1507. /* load-s64 dst:24 high-bits:32 low-bits:32
  1508. *
  1509. * Make an unsigned 64-bit integer with HIGH-BITS and LOW-BITS.
  1510. */
  1511. VM_DEFINE_OP (63, load_s64, "load-s64", DOP3 (X8_S24, AS32, BS32))
  1512. {
  1513. uint32_t dst;
  1514. uint64_t val;
  1515. UNPACK_24 (op, dst);
  1516. val = ip[1];
  1517. val <<= 32;
  1518. val |= ip[2];
  1519. SP_SET_U64 (dst, val);
  1520. NEXT (3);
  1521. }
  1522. /* current-thread dst:24
  1523. *
  1524. * Write the current thread into DST.
  1525. */
  1526. VM_DEFINE_OP (64, current_thread, "current-thread", DOP1 (X8_S24))
  1527. {
  1528. uint32_t dst;
  1529. UNPACK_24 (op, dst);
  1530. SP_SET (dst, thread->handle);
  1531. NEXT (1);
  1532. }
  1533. /* allocate-words dst:12 count:12
  1534. *
  1535. * Allocate a fresh GC-traced object consisting of COUNT words and
  1536. * store it into DST. COUNT is a u64 local.
  1537. */
  1538. VM_DEFINE_OP (65, allocate_words, "allocate-words", DOP1 (X8_S12_S12))
  1539. {
  1540. uint16_t dst, size;
  1541. UNPACK_12_12 (op, dst, size);
  1542. SYNC_IP ();
  1543. SP_SET (dst, CALL_INTRINSIC (allocate_words, (thread, SP_REF_U64 (size))));
  1544. NEXT (1);
  1545. }
  1546. /* allocate-words/immediate dst:12 count:12
  1547. *
  1548. * Allocate a fresh GC-traced object consisting of COUNT words and
  1549. * store it into DST. COUNT is an immediate.
  1550. */
  1551. VM_DEFINE_OP (66, allocate_words_immediate, "allocate-words/immediate", DOP1 (X8_S12_C12))
  1552. {
  1553. uint16_t dst, size;
  1554. UNPACK_12_12 (op, dst, size);
  1555. SYNC_IP ();
  1556. SP_SET (dst, CALL_INTRINSIC (allocate_words, (thread, size)));
  1557. NEXT (1);
  1558. }
  1559. /* scm-ref dst:8 obj:8 idx:8
  1560. *
  1561. * Load the SCM object at word offset IDX from local OBJ, and store it
  1562. * to DST.
  1563. */
  1564. VM_DEFINE_OP (67, scm_ref, "scm-ref", DOP1 (X8_S8_S8_S8))
  1565. {
  1566. uint8_t dst, obj, idx;
  1567. UNPACK_8_8_8 (op, dst, obj, idx);
  1568. SP_SET (dst, SCM_CELL_OBJECT (SP_REF (obj), SP_REF_U64 (idx)));
  1569. NEXT (1);
  1570. }
  1571. /* scm-set! obj:8 idx:8 val:8
  1572. *
  1573. * Store the SCM local VAL into object OBJ at word offset IDX.
  1574. */
  1575. VM_DEFINE_OP (68, scm_set, "scm-set!", OP1 (X8_S8_S8_S8))
  1576. {
  1577. uint8_t obj, idx, val;
  1578. UNPACK_8_8_8 (op, obj, idx, val);
  1579. SCM_SET_CELL_OBJECT (SP_REF (obj), SP_REF_U64 (idx), SP_REF (val));
  1580. NEXT (1);
  1581. }
  1582. /* scm-ref/tag dst:8 obj:8 tag:8
  1583. *
  1584. * Load the first word of OBJ, subtract the immediate TAG, and store
  1585. * the resulting SCM to DST.
  1586. */
  1587. VM_DEFINE_OP (69, scm_ref_tag, "scm-ref/tag", DOP1 (X8_S8_S8_C8))
  1588. {
  1589. uint8_t dst, obj, tag;
  1590. UNPACK_8_8_8 (op, dst, obj, tag);
  1591. SP_SET (dst, SCM_PACK (SCM_CELL_WORD_0 (SP_REF (obj)) - tag));
  1592. NEXT (1);
  1593. }
  1594. /* scm-set!/tag obj:8 tag:8 val:8
  1595. *
  1596. * Set the first word of OBJ to the SCM value VAL plus the immediate
  1597. * value TAG.
  1598. */
  1599. VM_DEFINE_OP (70, scm_set_tag, "scm-set!/tag", OP1 (X8_S8_C8_S8))
  1600. {
  1601. uint8_t obj, tag, val;
  1602. UNPACK_8_8_8 (op, obj, tag, val);
  1603. SCM_SET_CELL_WORD_0 (SP_REF (obj), SCM_UNPACK (SP_REF (val)) + tag);
  1604. NEXT (1);
  1605. }
  1606. /* scm-ref/immediate dst:8 obj:8 idx:8
  1607. *
  1608. * Load the SCM object at word offset IDX from local OBJ, and store it
  1609. * to DST. IDX is a uint8_t immediate.
  1610. */
  1611. VM_DEFINE_OP (71, scm_ref_immediate, "scm-ref/immediate", DOP1 (X8_S8_S8_C8))
  1612. {
  1613. uint8_t dst, obj, idx;
  1614. UNPACK_8_8_8 (op, dst, obj, idx);
  1615. SP_SET (dst, SCM_CELL_OBJECT (SP_REF (obj), idx));
  1616. NEXT (1);
  1617. }
  1618. /* scm-set!/immediate obj:8 idx:8 val:8
  1619. *
  1620. * Store the SCM local VAL into object OBJ at word offset IDX. IDX is
  1621. * a uint8_t immediate.
  1622. */
  1623. VM_DEFINE_OP (72, scm_set_immediate, "scm-set!/immediate", OP1 (X8_S8_C8_S8))
  1624. {
  1625. uint8_t obj, idx, val;
  1626. UNPACK_8_8_8 (op, obj, idx, val);
  1627. SCM_SET_CELL_OBJECT (SP_REF (obj), idx, SP_REF (val));
  1628. NEXT (1);
  1629. }
  1630. /* word-ref dst:8 obj:8 idx:8
  1631. *
  1632. * Load the word at offset IDX from local OBJ, and store it to u64
  1633. * DST.
  1634. */
  1635. VM_DEFINE_OP (73, word_ref, "word-ref", DOP1 (X8_S8_S8_S8))
  1636. {
  1637. uint8_t dst, obj, idx;
  1638. UNPACK_8_8_8 (op, dst, obj, idx);
  1639. SP_SET_U64 (dst, SCM_CELL_WORD (SP_REF (obj), SP_REF_U64 (idx)));
  1640. NEXT (1);
  1641. }
  1642. /* word-set! obj:8 idx:8 val:8
  1643. *
  1644. * Store the u64 local VAL into object OBJ at word offset IDX.
  1645. */
  1646. VM_DEFINE_OP (74, word_set, "word-set!", OP1 (X8_S8_S8_S8))
  1647. {
  1648. uint8_t obj, idx, val;
  1649. UNPACK_8_8_8 (op, obj, idx, val);
  1650. SCM_SET_CELL_WORD (SP_REF (obj), SP_REF_U64 (idx), SP_REF_U64 (val));
  1651. NEXT (1);
  1652. }
  1653. /* word-ref/immediate dst:8 obj:8 idx:8
  1654. *
  1655. * Load the word at offset IDX from local OBJ, and store it to u64
  1656. * DST. IDX is a uint8_t immediate.
  1657. */
  1658. VM_DEFINE_OP (75, word_ref_immediate, "word-ref/immediate", DOP1 (X8_S8_S8_C8))
  1659. {
  1660. uint8_t dst, obj, idx;
  1661. UNPACK_8_8_8 (op, dst, obj, idx);
  1662. SP_SET_U64 (dst, SCM_CELL_WORD (SP_REF (obj), idx));
  1663. NEXT (1);
  1664. }
  1665. /* word-set!/immediate obj:8 idx:8 val:8
  1666. *
  1667. * Store the u64 local VAL into object OBJ at word offset IDX. IDX is
  1668. * a uint8_t immediate.
  1669. */
  1670. VM_DEFINE_OP (76, word_set_immediate, "word-set!/immediate", OP1 (X8_S8_C8_S8))
  1671. {
  1672. uint8_t obj, idx, val;
  1673. UNPACK_8_8_8 (op, obj, idx, val);
  1674. SCM_SET_CELL_WORD (SP_REF (obj), idx, SP_REF_U64 (val));
  1675. NEXT (1);
  1676. }
  1677. /* pointer-ref/immediate dst:8 obj:8 idx:8
  1678. *
  1679. * Load the pointer at offset IDX from local OBJ, and store it to DST.
  1680. * IDX is a uint8_t immediate.
  1681. */
  1682. VM_DEFINE_OP (77, pointer_ref_immediate, "pointer-ref/immediate", DOP1 (X8_S8_S8_C8))
  1683. {
  1684. uint8_t dst, obj, idx;
  1685. UNPACK_8_8_8 (op, dst, obj, idx);
  1686. SP_SET_PTR (dst, (void*) SCM_CELL_WORD (SP_REF (obj), idx));
  1687. NEXT (1);
  1688. }
  1689. /* pointer-set!/immediate obj:8 idx:8 val:8
  1690. *
  1691. * Store the pointer local VAL into object OBJ at offset IDX. IDX is
  1692. * a uint8_t immediate.
  1693. */
  1694. VM_DEFINE_OP (78, pointer_set_immediate, "pointer-set!/immediate", OP1 (X8_S8_C8_S8))
  1695. {
  1696. uint8_t obj, idx, val;
  1697. UNPACK_8_8_8 (op, obj, idx, val);
  1698. SCM_SET_CELL_WORD (SP_REF (obj), idx, (uintptr_t) SP_REF_PTR (val));
  1699. NEXT (1);
  1700. }
  1701. /* tail-pointer-ref/immediate dst:8 obj:8 idx:8
  1702. *
  1703. * Compute the address of word offset IDX from local OBJ, and store it
  1704. * to DST. IDX is a uint8_t immediate.
  1705. */
  1706. VM_DEFINE_OP (79, tail_pointer_ref_immediate, "tail-pointer-ref/immediate", DOP1 (X8_S8_S8_C8))
  1707. {
  1708. uint8_t dst, obj, idx;
  1709. UNPACK_8_8_8 (op, dst, obj, idx);
  1710. SP_SET_PTR (dst, ((scm_t_bits *) SCM2PTR (SP_REF (obj))) + idx);
  1711. NEXT (1);
  1712. }
  1713. /* atomic-scm-ref/immediate dst:8 obj:8 idx:8
  1714. *
  1715. * Atomically reference the SCM object at word offset IDX from local
  1716. * OBJ, and store it to DST, using the sequential consistency memory
  1717. * model. IDX is a uint8_t immediate.
  1718. */
  1719. VM_DEFINE_OP (80, atomic_scm_ref_immediate, "atomic-scm-ref/immediate", DOP1 (X8_S8_S8_C8))
  1720. {
  1721. uint8_t dst, obj, offset;
  1722. SCM *loc;
  1723. UNPACK_8_8_8 (op, dst, obj, offset);
  1724. loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset);
  1725. SP_SET (dst, scm_atomic_ref_scm (loc));
  1726. NEXT (1);
  1727. }
  1728. /* atomic-scm-set!/immediate obj:8 idx:8 val:8
  1729. *
  1730. * Atomically store the SCM local VAL into object OBJ at word offset
  1731. * IDX, using the sequentially consistent memory model. IDX is a
  1732. * uint8_t immediate.
  1733. */
  1734. VM_DEFINE_OP (81, atomic_scm_set_immediate, "atomic-scm-set!/immediate", OP1 (X8_S8_C8_S8))
  1735. {
  1736. uint8_t obj, offset, val;
  1737. SCM *loc;
  1738. UNPACK_8_8_8 (op, obj, offset, val);
  1739. loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset);
  1740. scm_atomic_set_scm (loc, SP_REF (val));
  1741. NEXT (1);
  1742. }
  1743. /* atomic-scm-swap!/immediate dst:24 _:8 obj:24 idx:8 val:24
  1744. *
  1745. * Atomically swap the SCM value stored in object OBJ at word offset
  1746. * IDX with VAL, using the sequentially consistent memory model. IDX
  1747. * is a uint8_t immediate. Return the previous value to DST.
  1748. */
  1749. VM_DEFINE_OP (82, atomic_scm_swap_immediate, "atomic-scm-swap!/immediate", DOP3 (X8_S24, X8_S24, C8_S24))
  1750. {
  1751. uint32_t dst, obj, val;
  1752. uint8_t offset;
  1753. SCM *loc;
  1754. UNPACK_24 (op, dst);
  1755. UNPACK_24 (ip[1], obj);
  1756. UNPACK_8_24 (ip[2], offset, val);
  1757. loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset);
  1758. SP_SET (dst, scm_atomic_swap_scm (loc, SP_REF (val)));
  1759. NEXT (3);
  1760. }
  1761. /* atomic-scm-compare-and-swap!/immediate dst:24 _:8 obj:24 idx:8 expected:24 _:8 desired:24
  1762. *
  1763. * Atomically swap the SCM value stored in object OBJ at word offset
  1764. * IDX with DESIRED, if and only if the value that was there was
  1765. * EXPECTED, using the sequentially consistent memory model. IDX is a
  1766. * uint8_t immediate. Return the value that was stored at IDX from
  1767. * OBJ in DST.
  1768. */
  1769. VM_DEFINE_OP (83, atomic_scm_compare_and_swap_immediate, "atomic-scm-compare-and-swap!/immediate", DOP4 (X8_S24, X8_S24, C8_S24, X8_S24))
  1770. {
  1771. uint32_t dst, obj, expected, desired;
  1772. uint8_t offset;
  1773. SCM *loc;
  1774. SCM got;
  1775. UNPACK_24 (op, dst);
  1776. UNPACK_24 (ip[1], obj);
  1777. UNPACK_8_24 (ip[2], offset, expected);
  1778. UNPACK_24 (ip[3], desired);
  1779. loc = SCM_CELL_OBJECT_LOC (SP_REF (obj), offset);
  1780. got = scm_atomic_compare_and_swap_scm (loc, SP_REF (expected),
  1781. SP_REF (desired));
  1782. SP_SET (dst, got);
  1783. NEXT (4);
  1784. }
  1785. /* static-ref dst:24 offset:32
  1786. *
  1787. * Load a SCM value into DST. The SCM value will be fetched from
  1788. * memory, OFFSET 32-bit words away from the current instruction
  1789. * pointer. OFFSET is a signed value.
  1790. *
  1791. * The intention is for this instruction to be used to load constants
  1792. * that the compiler is unable to statically allocate, like symbols.
  1793. * These values would be initialized when the object file loads.
  1794. */
  1795. VM_DEFINE_OP (84, static_ref, "static-ref", DOP2 (X8_S24, R32))
  1796. {
  1797. uint32_t dst;
  1798. int32_t offset;
  1799. uint32_t* loc;
  1800. uintptr_t loc_bits;
  1801. UNPACK_24 (op, dst);
  1802. offset = ip[1];
  1803. loc = ip + offset;
  1804. loc_bits = (uintptr_t) loc;
  1805. VM_ASSERT (ALIGNED_P (loc, SCM), abort());
  1806. SP_SET (dst, *((SCM *) loc_bits));
  1807. NEXT (2);
  1808. }
  1809. /* static-set! src:24 offset:32
  1810. *
  1811. * Store a SCM value into memory, OFFSET 32-bit words away from the
  1812. * current instruction pointer. OFFSET is a signed value.
  1813. */
  1814. VM_DEFINE_OP (85, static_set, "static-set!", OP2 (X8_S24, LO32))
  1815. {
  1816. uint32_t src;
  1817. int32_t offset;
  1818. uint32_t* loc;
  1819. UNPACK_24 (op, src);
  1820. offset = ip[1];
  1821. loc = ip + offset;
  1822. VM_ASSERT (ALIGNED_P (loc, SCM), abort());
  1823. *((SCM *) loc) = SP_REF (src);
  1824. NEXT (2);
  1825. }
  1826. /* static-patch! _:24 dst-offset:32 src-offset:32
  1827. *
  1828. * Patch a pointer at DST-OFFSET to point to SRC-OFFSET. Both offsets
  1829. * are signed 32-bit values, indicating a memory address as a number
  1830. * of 32-bit words away from the current instruction pointer.
  1831. */
  1832. VM_DEFINE_OP (86, static_patch, "static-patch!", OP3 (X32, LO32, L32))
  1833. {
  1834. int32_t dst_offset, src_offset;
  1835. void *src;
  1836. void** dst_loc;
  1837. dst_offset = ip[1];
  1838. src_offset = ip[2];
  1839. dst_loc = (void **) (ip + dst_offset);
  1840. src = ip + src_offset;
  1841. VM_ASSERT (ALIGNED_P (dst_loc, void*), abort());
  1842. *dst_loc = src;
  1843. NEXT (3);
  1844. }
  1845. /* tag-char dst:12 src:12
  1846. *
  1847. * Make a SCM character whose integer value is the u64 in SRC, and
  1848. * store it in DST.
  1849. */
  1850. VM_DEFINE_OP (87, tag_char, "tag-char", DOP1 (X8_S12_S12))
  1851. {
  1852. uint16_t dst, src;
  1853. UNPACK_12_12 (op, dst, src);
  1854. SP_SET (dst,
  1855. SCM_MAKE_ITAG8 ((scm_t_bits) (scm_t_wchar) SP_REF_U64 (src),
  1856. scm_tc8_char));
  1857. NEXT (1);
  1858. }
  1859. /* untag-char dst:12 src:12
  1860. *
  1861. * Extract the integer value from the SCM character SRC, and store the
  1862. * resulting u64 in DST.
  1863. */
  1864. VM_DEFINE_OP (88, untag_char, "untag-char", DOP1 (X8_S12_S12))
  1865. {
  1866. uint16_t dst, src;
  1867. UNPACK_12_12 (op, dst, src);
  1868. SP_SET_U64 (dst, SCM_CHAR (SP_REF (src)));
  1869. NEXT (1);
  1870. }
  1871. /* tag-fixnum dst:12 src:12
  1872. *
  1873. * Make a SCM integer whose value is the s64 in SRC, and store it in
  1874. * DST.
  1875. */
  1876. VM_DEFINE_OP (89, tag_fixnum, "tag-fixnum", DOP1 (X8_S12_S12))
  1877. {
  1878. uint16_t dst, src;
  1879. UNPACK_12_12 (op, dst, src);
  1880. SP_SET (dst, SCM_I_MAKINUM (SP_REF_S64 (src)));
  1881. NEXT (1);
  1882. }
  1883. /* untag-fixnum dst:12 src:12
  1884. *
  1885. * Extract the integer value from the SCM integer SRC, and store the
  1886. * resulting s64 in DST.
  1887. */
  1888. VM_DEFINE_OP (90, untag_fixnum, "untag-fixnum", DOP1 (X8_S12_S12))
  1889. {
  1890. uint16_t dst, src;
  1891. UNPACK_12_12 (op, dst, src);
  1892. SP_SET_S64 (dst, SCM_I_INUM (SP_REF (src)));
  1893. NEXT (1);
  1894. }
  1895. /* uadd dst:8 a:8 b:8
  1896. *
  1897. * Add A to B, and place the result in DST. The operands and the
  1898. * result are unboxed unsigned 64-bit integers. Overflow will wrap
  1899. * around.
  1900. */
  1901. VM_DEFINE_OP (91, uadd, "uadd", DOP1 (X8_S8_S8_S8))
  1902. {
  1903. uint8_t dst, a, b;
  1904. UNPACK_8_8_8 (op, dst, a, b);
  1905. SP_SET_U64 (dst, SP_REF_U64 (a) + SP_REF_U64 (b));
  1906. NEXT (1);
  1907. }
  1908. /* usub dst:8 a:8 b:8
  1909. *
  1910. * Subtract B from A, and place the result in DST. The operands and
  1911. * the result are unboxed unsigned 64-bit integers. Overflow will
  1912. * wrap around.
  1913. */
  1914. VM_DEFINE_OP (92, usub, "usub", DOP1 (X8_S8_S8_S8))
  1915. {
  1916. uint8_t dst, a, b;
  1917. UNPACK_8_8_8 (op, dst, a, b);
  1918. SP_SET_U64 (dst, SP_REF_U64 (a) - SP_REF_U64 (b));
  1919. NEXT (1);
  1920. }
  1921. /* umul dst:8 a:8 b:8
  1922. *
  1923. * Multiply A and B, and place the result in DST. The operands and
  1924. * the result are unboxed unsigned 64-bit integers. Overflow will
  1925. * wrap around.
  1926. */
  1927. VM_DEFINE_OP (93, umul, "umul", DOP1 (X8_S8_S8_S8))
  1928. {
  1929. uint8_t dst, a, b;
  1930. UNPACK_8_8_8 (op, dst, a, b);
  1931. SP_SET_U64 (dst, SP_REF_U64 (a) * SP_REF_U64 (b));
  1932. NEXT (1);
  1933. }
  1934. /* uadd/immediate dst:8 src:8 imm:8
  1935. *
  1936. * Add the unsigned 64-bit value from SRC with the unsigned 8-bit
  1937. * value IMM and place the raw unsigned 64-bit result in DST.
  1938. * Overflow will wrap around.
  1939. */
  1940. VM_DEFINE_OP (94, uadd_immediate, "uadd/immediate", DOP1 (X8_S8_S8_C8))
  1941. {
  1942. uint8_t dst, src, imm;
  1943. uint64_t x;
  1944. UNPACK_8_8_8 (op, dst, src, imm);
  1945. x = SP_REF_U64 (src);
  1946. SP_SET_U64 (dst, x + (uint64_t) imm);
  1947. NEXT (1);
  1948. }
  1949. /* usub/immediate dst:8 src:8 imm:8
  1950. *
  1951. * Subtract the unsigned 8-bit value IMM from the unsigned 64-bit
  1952. * value in SRC and place the raw unsigned 64-bit result in DST.
  1953. * Overflow will wrap around.
  1954. */
  1955. VM_DEFINE_OP (95, usub_immediate, "usub/immediate", DOP1 (X8_S8_S8_C8))
  1956. {
  1957. uint8_t dst, src, imm;
  1958. uint64_t x;
  1959. UNPACK_8_8_8 (op, dst, src, imm);
  1960. x = SP_REF_U64 (src);
  1961. SP_SET_U64 (dst, x - (uint64_t) imm);
  1962. NEXT (1);
  1963. }
  1964. /* umul/immediate dst:8 src:8 imm:8
  1965. *
  1966. * Multiply the unsigned 64-bit value from SRC by the unsigned 8-bit
  1967. * value IMM and place the raw unsigned 64-bit result in DST.
  1968. * Overflow will wrap around.
  1969. */
  1970. VM_DEFINE_OP (96, umul_immediate, "umul/immediate", DOP1 (X8_S8_S8_C8))
  1971. {
  1972. uint8_t dst, src, imm;
  1973. uint64_t x;
  1974. UNPACK_8_8_8 (op, dst, src, imm);
  1975. x = SP_REF_U64 (src);
  1976. SP_SET_U64 (dst, x * (uint64_t) imm);
  1977. NEXT (1);
  1978. }
  1979. /* ulogand dst:8 a:8 b:8
  1980. *
  1981. * Place the bitwise AND of the u64 values in A and B into DST.
  1982. */
  1983. VM_DEFINE_OP (97, ulogand, "ulogand", DOP1 (X8_S8_S8_S8))
  1984. {
  1985. uint8_t dst, a, b;
  1986. UNPACK_8_8_8 (op, dst, a, b);
  1987. SP_SET_U64 (dst, SP_REF_U64 (a) & SP_REF_U64 (b));
  1988. NEXT (1);
  1989. }
  1990. /* ulogior dst:8 a:8 b:8
  1991. *
  1992. * Place the bitwise inclusive OR of the u64 values in A and B into
  1993. * DST.
  1994. */
  1995. VM_DEFINE_OP (98, ulogior, "ulogior", DOP1 (X8_S8_S8_S8))
  1996. {
  1997. uint8_t dst, a, b;
  1998. UNPACK_8_8_8 (op, dst, a, b);
  1999. SP_SET_U64 (dst, SP_REF_U64 (a) | SP_REF_U64 (b));
  2000. NEXT (1);
  2001. }
  2002. /* ulogsub dst:8 a:8 b:8
  2003. *
  2004. * Place the (A & ~B) of the u64 values A and B into DST.
  2005. */
  2006. VM_DEFINE_OP (99, ulogsub, "ulogsub", DOP1 (X8_S8_S8_S8))
  2007. {
  2008. uint8_t dst, a, b;
  2009. UNPACK_8_8_8 (op, dst, a, b);
  2010. SP_SET_U64 (dst, SP_REF_U64 (a) & ~SP_REF_U64 (b));
  2011. NEXT (1);
  2012. }
  2013. /* ulogxor dst:8 a:8 b:8
  2014. *
  2015. * Place the bitwise exclusive OR of the u64 values in A and B into
  2016. * DST.
  2017. */
  2018. VM_DEFINE_OP (100, ulogxor, "ulogxor", DOP1 (X8_S8_S8_S8))
  2019. {
  2020. uint8_t dst, a, b;
  2021. UNPACK_8_8_8 (op, dst, a, b);
  2022. SP_SET_U64 (dst, SP_REF_U64 (a) ^ SP_REF_U64 (b));
  2023. NEXT (1);
  2024. }
  2025. /* ursh dst:8 a:8 b:8
  2026. *
  2027. * Shift the u64 value in A right by B bits, and place the result in
  2028. * DST. Only the lower 6 bits of B are used.
  2029. */
  2030. VM_DEFINE_OP (101, ursh, "ursh", DOP1 (X8_S8_S8_S8))
  2031. {
  2032. uint8_t dst, a, b;
  2033. UNPACK_8_8_8 (op, dst, a, b);
  2034. SP_SET_U64 (dst, SP_REF_U64 (a) >> (SP_REF_U64 (b) & 63));
  2035. NEXT (1);
  2036. }
  2037. /* srsh dst:8 a:8 b:8
  2038. *
  2039. * Shift the s64 value in A right by B bits, and place the result in
  2040. * DST. Only the lower 6 bits of B are used.
  2041. */
  2042. VM_DEFINE_OP (102, srsh, "srsh", DOP1 (X8_S8_S8_S8))
  2043. {
  2044. uint8_t dst, a, b;
  2045. UNPACK_8_8_8 (op, dst, a, b);
  2046. SP_SET_S64 (dst, SCM_SRS (SP_REF_S64 (a), (SP_REF_U64 (b) & 63)));
  2047. NEXT (1);
  2048. }
  2049. /* ulsh dst:8 a:8 b:8
  2050. *
  2051. * Shift the u64 value in A left by B bits, and place the result in
  2052. * DST. Only the lower 6 bits of B are used.
  2053. */
  2054. VM_DEFINE_OP (103, ulsh, "ulsh", DOP1 (X8_S8_S8_S8))
  2055. {
  2056. uint8_t dst, a, b;
  2057. UNPACK_8_8_8 (op, dst, a, b);
  2058. SP_SET_U64 (dst, SP_REF_U64 (a) << (SP_REF_U64 (b) & 63));
  2059. NEXT (1);
  2060. }
  2061. /* ursh/immediate dst:8 a:8 b:8
  2062. *
  2063. * Shift the u64 value in A right by the immediate B bits, and place
  2064. * the result in DST. Only the lower 6 bits of B are used.
  2065. */
  2066. VM_DEFINE_OP (104, ursh_immediate, "ursh/immediate", DOP1 (X8_S8_S8_C8))
  2067. {
  2068. uint8_t dst, a, b;
  2069. UNPACK_8_8_8 (op, dst, a, b);
  2070. SP_SET_U64 (dst, SP_REF_U64 (a) >> (b & 63));
  2071. NEXT (1);
  2072. }
  2073. /* srsh/immediate dst:8 a:8 b:8
  2074. *
  2075. * Shift the s64 value in A right by the immediate B bits, and place
  2076. * the result in DST. Only the lower 6 bits of B are used.
  2077. */
  2078. VM_DEFINE_OP (105, srsh_immediate, "srsh/immediate", DOP1 (X8_S8_S8_C8))
  2079. {
  2080. uint8_t dst, a, b;
  2081. UNPACK_8_8_8 (op, dst, a, b);
  2082. SP_SET_S64 (dst, SCM_SRS (SP_REF_S64 (a), b & 63));
  2083. NEXT (1);
  2084. }
  2085. /* ulsh/immediate dst:8 a:8 b:8
  2086. *
  2087. * Shift the u64 value in A left by the immediate B bits, and place
  2088. * the result in DST. Only the lower 6 bits of B are used.
  2089. */
  2090. VM_DEFINE_OP (106, ulsh_immediate, "ulsh/immediate", DOP1 (X8_S8_S8_C8))
  2091. {
  2092. uint8_t dst, a, b;
  2093. UNPACK_8_8_8 (op, dst, a, b);
  2094. SP_SET_U64 (dst, SP_REF_U64 (a) << (b & 63));
  2095. NEXT (1);
  2096. }
  2097. /* fadd dst:8 a:8 b:8
  2098. *
  2099. * Add A to B, and place the result in DST. The operands and the
  2100. * result are unboxed double-precision floating-point numbers.
  2101. */
  2102. VM_DEFINE_OP (107, fadd, "fadd", DOP1 (X8_S8_S8_S8))
  2103. {
  2104. uint8_t dst, a, b;
  2105. UNPACK_8_8_8 (op, dst, a, b);
  2106. SP_SET_F64 (dst, SP_REF_F64 (a) + SP_REF_F64 (b));
  2107. NEXT (1);
  2108. }
  2109. /* fsub dst:8 a:8 b:8
  2110. *
  2111. * Subtract B from A, and place the result in DST. The operands and
  2112. * the result are unboxed double-precision floating-point numbers.
  2113. */
  2114. VM_DEFINE_OP (108, fsub, "fsub", DOP1 (X8_S8_S8_S8))
  2115. {
  2116. uint8_t dst, a, b;
  2117. UNPACK_8_8_8 (op, dst, a, b);
  2118. SP_SET_F64 (dst, SP_REF_F64 (a) - SP_REF_F64 (b));
  2119. NEXT (1);
  2120. }
  2121. /* fmul dst:8 a:8 b:8
  2122. *
  2123. * Multiply A and B, and place the result in DST. The operands and
  2124. * the result are unboxed double-precision floating-point numbers.
  2125. */
  2126. VM_DEFINE_OP (109, fmul, "fmul", DOP1 (X8_S8_S8_S8))
  2127. {
  2128. uint8_t dst, a, b;
  2129. UNPACK_8_8_8 (op, dst, a, b);
  2130. SP_SET_F64 (dst, SP_REF_F64 (a) * SP_REF_F64 (b));
  2131. NEXT (1);
  2132. }
  2133. /* fdiv dst:8 a:8 b:8
  2134. *
  2135. * Divide A by B, and place the result in DST. The operands and the
  2136. * result are unboxed double-precision floating-point numbers.
  2137. */
  2138. VM_DEFINE_OP (110, fdiv, "fdiv", DOP1 (X8_S8_S8_S8))
  2139. {
  2140. uint8_t dst, a, b;
  2141. UNPACK_8_8_8 (op, dst, a, b);
  2142. SP_SET_F64 (dst, SP_REF_F64 (a) / SP_REF_F64 (b));
  2143. NEXT (1);
  2144. }
  2145. /* u64=? a:12 b:12
  2146. *
  2147. * Set the comparison result to EQUAL if the u64 values A and B are
  2148. * the same, or NONE otherwise.
  2149. */
  2150. VM_DEFINE_OP (111, u64_numerically_equal, "u64=?", OP1 (X8_S12_S12))
  2151. {
  2152. uint16_t a, b;
  2153. uint64_t x, y;
  2154. UNPACK_12_12 (op, a, b);
  2155. x = SP_REF_U64 (a);
  2156. y = SP_REF_U64 (b);
  2157. VP->compare_result = x == y ? SCM_F_COMPARE_EQUAL : SCM_F_COMPARE_NONE;
  2158. NEXT (1);
  2159. }
  2160. /* u64<? a:12 b:12
  2161. *
  2162. * Set the comparison result to LESS_THAN if the u64 value A is less
  2163. * than the u64 value B are the same, or NONE otherwise.
  2164. */
  2165. VM_DEFINE_OP (112, u64_less, "u64<?", OP1 (X8_S12_S12))
  2166. {
  2167. uint16_t a, b;
  2168. uint64_t x, y;
  2169. UNPACK_12_12 (op, a, b);
  2170. x = SP_REF_U64 (a);
  2171. y = SP_REF_U64 (b);
  2172. VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
  2173. NEXT (1);
  2174. }
  2175. /* s64<? a:12 b:12
  2176. *
  2177. * Set the comparison result to LESS_THAN if the s64 value A is less
  2178. * than the s64 value B are the same, or NONE otherwise.
  2179. */
  2180. VM_DEFINE_OP (113, s64_less, "s64<?", OP1 (X8_S12_S12))
  2181. {
  2182. uint16_t a, b;
  2183. int64_t x, y;
  2184. UNPACK_12_12 (op, a, b);
  2185. x = SP_REF_S64 (a);
  2186. y = SP_REF_S64 (b);
  2187. VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
  2188. NEXT (1);
  2189. }
  2190. /* s64-imm=? a:12 b:12
  2191. *
  2192. * Set the comparison result to EQUAL if the s64 value A is equal to
  2193. * the immediate s64 value B, or NONE otherwise.
  2194. */
  2195. VM_DEFINE_OP (114, s64_imm_numerically_equal, "s64-imm=?", OP1 (X8_S12_Z12))
  2196. {
  2197. uint16_t a;
  2198. int64_t x, y;
  2199. a = (op >> 8) & 0xfff;
  2200. x = SP_REF_S64 (a);
  2201. y = ((int32_t) op) >> 20; /* Sign extension. */
  2202. VP->compare_result = x == y ? SCM_F_COMPARE_EQUAL : SCM_F_COMPARE_NONE;
  2203. NEXT (1);
  2204. }
  2205. /* u64-imm<? a:12 b:12
  2206. *
  2207. * Set the comparison result to LESS_THAN if the u64 value A is less
  2208. * than the immediate u64 value B, or NONE otherwise.
  2209. */
  2210. VM_DEFINE_OP (115, u64_imm_less, "u64-imm<?", OP1 (X8_S12_C12))
  2211. {
  2212. uint16_t a;
  2213. uint64_t x, y;
  2214. UNPACK_12_12 (op, a, y);
  2215. x = SP_REF_U64 (a);
  2216. VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
  2217. NEXT (1);
  2218. }
  2219. /* imm-u64<? a:12 b:12
  2220. *
  2221. * Set the comparison result to LESS_THAN if the u64 immediate B is
  2222. * less than the u64 value A, or NONE otherwise.
  2223. */
  2224. VM_DEFINE_OP (116, imm_u64_less, "imm-u64<?", OP1 (X8_S12_C12))
  2225. {
  2226. uint16_t a;
  2227. uint64_t x, y;
  2228. UNPACK_12_12 (op, a, x);
  2229. y = SP_REF_U64 (a);
  2230. VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
  2231. NEXT (1);
  2232. }
  2233. /* s64-imm<? a:12 b:12
  2234. *
  2235. * Set the comparison result to LESS_THAN if the s64 value A is less
  2236. * than the immediate s64 value B, or NONE otherwise.
  2237. */
  2238. VM_DEFINE_OP (117, s64_imm_less, "s64-imm<?", OP1 (X8_S12_Z12))
  2239. {
  2240. uint16_t a;
  2241. int64_t x, y;
  2242. a = (op >> 8) & 0xfff;
  2243. x = SP_REF_S64 (a);
  2244. y = ((int32_t) op) >> 20; /* Sign extension. */
  2245. VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
  2246. NEXT (1);
  2247. }
  2248. /* imm-s64<? a:12 b:12
  2249. *
  2250. * Set the comparison result to LESS_THAN if the s64 immediate B is
  2251. * less than the s64 value A, or NONE otherwise.
  2252. */
  2253. VM_DEFINE_OP (118, imm_s64_less, "imm-s64<?", OP1 (X8_S12_Z12))
  2254. {
  2255. uint16_t a;
  2256. int64_t x, y;
  2257. a = (op >> 8) & 0xfff;
  2258. y = SP_REF_S64 (a);
  2259. x = ((int32_t) op) >> 20; /* Sign extension. */
  2260. VP->compare_result = x < y ? SCM_F_COMPARE_LESS_THAN : SCM_F_COMPARE_NONE;
  2261. NEXT (1);
  2262. }
  2263. /* f64=? a:12 b:12
  2264. *
  2265. * Set the comparison result to EQUAL if the f64 value A is equal to
  2266. * the f64 value B, or NONE otherwise.
  2267. */
  2268. VM_DEFINE_OP (119, f64_numerically_equal, "f64=?", OP1 (X8_S12_S12))
  2269. {
  2270. uint16_t a, b;
  2271. double x, y;
  2272. UNPACK_12_12 (op, a, b);
  2273. x = SP_REF_F64 (a);
  2274. y = SP_REF_F64 (b);
  2275. if (x == y)
  2276. VP->compare_result = SCM_F_COMPARE_EQUAL;
  2277. else
  2278. /* This is also the case for NaN. */
  2279. VP->compare_result = SCM_F_COMPARE_NONE;
  2280. NEXT (1);
  2281. }
  2282. /* f64<? a:12 b:12
  2283. *
  2284. * Set the comparison result to LESS_THAN if the f64 value A is less
  2285. * than the f64 value B, NONE if A is greater than or equal to B, or
  2286. * INVALID otherwise.
  2287. */
  2288. VM_DEFINE_OP (120, f64_less, "f64<?", OP1 (X8_S12_S12))
  2289. {
  2290. uint16_t a, b;
  2291. double x, y;
  2292. UNPACK_12_12 (op, a, b);
  2293. x = SP_REF_F64 (a);
  2294. y = SP_REF_F64 (b);
  2295. if (x < y)
  2296. VP->compare_result = SCM_F_COMPARE_LESS_THAN;
  2297. else if (x >= y)
  2298. VP->compare_result = SCM_F_COMPARE_NONE;
  2299. else
  2300. /* NaN. */
  2301. VP->compare_result = SCM_F_COMPARE_INVALID;
  2302. NEXT (1);
  2303. }
  2304. /* =? a:12 b:12
  2305. *
  2306. * Set the comparison result to EQUAL if the SCM values A and B are
  2307. * numerically equal, in the sense of "=". Set to NONE otherwise.
  2308. */
  2309. VM_DEFINE_OP (121, numerically_equal, "=?", OP1 (X8_S12_S12))
  2310. {
  2311. uint16_t a, b;
  2312. SCM x, y;
  2313. UNPACK_12_12 (op, a, b);
  2314. x = SP_REF (a);
  2315. y = SP_REF (b);
  2316. SYNC_IP ();
  2317. if (CALL_INTRINSIC (numerically_equal_p, (x, y)))
  2318. VP->compare_result = SCM_F_COMPARE_EQUAL;
  2319. else
  2320. VP->compare_result = SCM_F_COMPARE_NONE;
  2321. CACHE_SP ();
  2322. NEXT (1);
  2323. }
  2324. /* heap-numbers-equal? a:12 b:12
  2325. *
  2326. * Set the comparison result to EQUAL if the SCM values A and B are
  2327. * numerically equal, in the sense of "=". Set to NONE otherwise. It
  2328. * is known that both A and B are heap numbers.
  2329. */
  2330. VM_DEFINE_OP (122, heap_numbers_equal, "heap-numbers-equal?", OP1 (X8_S12_S12))
  2331. {
  2332. uint16_t a, b;
  2333. SCM x, y;
  2334. UNPACK_12_12 (op, a, b);
  2335. x = SP_REF (a);
  2336. y = SP_REF (b);
  2337. SYNC_IP ();
  2338. if (CALL_INTRINSIC (heap_numbers_equal_p, (x, y)))
  2339. VP->compare_result = SCM_F_COMPARE_EQUAL;
  2340. else
  2341. VP->compare_result = SCM_F_COMPARE_NONE;
  2342. CACHE_SP ();
  2343. NEXT (1);
  2344. }
  2345. /* <? a:12 b:12
  2346. *
  2347. * Set the comparison result to LESS_THAN if the SCM value A is less
  2348. * than the SCM value B, NONE if A is greater than or equal to B, or
  2349. * INVALID otherwise.
  2350. */
  2351. VM_DEFINE_OP (123, less, "<?", OP1 (X8_S12_S12))
  2352. {
  2353. uint16_t a, b;
  2354. SCM x, y;
  2355. UNPACK_12_12 (op, a, b);
  2356. x = SP_REF (a);
  2357. y = SP_REF (b);
  2358. SYNC_IP ();
  2359. VP->compare_result = CALL_INTRINSIC (less_p, (x, y));
  2360. CACHE_SP ();
  2361. NEXT (1);
  2362. }
  2363. /* immediate-tag=? obj:24 mask:16 tag:16
  2364. *
  2365. * Set the comparison result to EQUAL if the result of a bitwise AND
  2366. * between the bits of SCM value A and the immediate MASK is TAG, or
  2367. * NONE otherwise.
  2368. */
  2369. VM_DEFINE_OP (124, immediate_tag_equals, "immediate-tag=?", OP2 (X8_S24, C16_C16))
  2370. {
  2371. uint32_t a;
  2372. uint16_t mask, expected;
  2373. SCM x;
  2374. UNPACK_24 (op, a);
  2375. UNPACK_16_16 (ip[1], mask, expected);
  2376. x = SP_REF (a);
  2377. if ((SCM_UNPACK (x) & mask) == expected)
  2378. VP->compare_result = SCM_F_COMPARE_EQUAL;
  2379. else
  2380. VP->compare_result = SCM_F_COMPARE_NONE;
  2381. NEXT (2);
  2382. }
  2383. /* heap-tag=? obj:24 mask:16 tag:16
  2384. *
  2385. * Set the comparison result to EQUAL if the result of a bitwise AND
  2386. * between the first word of SCM value A and the immediate MASK is
  2387. * TAG, or NONE otherwise.
  2388. */
  2389. VM_DEFINE_OP (125, heap_tag_equals, "heap-tag=?", OP2 (X8_S24, C16_C16))
  2390. {
  2391. uint32_t a;
  2392. uint16_t mask, expected;
  2393. SCM x;
  2394. UNPACK_24 (op, a);
  2395. UNPACK_16_16 (ip[1], mask, expected);
  2396. x = SP_REF (a);
  2397. if ((SCM_CELL_TYPE (x) & mask) == expected)
  2398. VP->compare_result = SCM_F_COMPARE_EQUAL;
  2399. else
  2400. VP->compare_result = SCM_F_COMPARE_NONE;
  2401. NEXT (2);
  2402. }
  2403. /* eq? a:12 b:12
  2404. *
  2405. * Set the comparison result to EQUAL if the SCM values A and B are
  2406. * eq?, or NONE otherwise.
  2407. */
  2408. VM_DEFINE_OP (126, eq, "eq?", OP1 (X8_S12_S12))
  2409. {
  2410. uint16_t a, b;
  2411. SCM x, y;
  2412. UNPACK_12_12 (op, a, b);
  2413. x = SP_REF (a);
  2414. y = SP_REF (b);
  2415. if (scm_is_eq (x, y))
  2416. VP->compare_result = SCM_F_COMPARE_EQUAL;
  2417. else
  2418. VP->compare_result = SCM_F_COMPARE_NONE;
  2419. NEXT (1);
  2420. }
  2421. /* j offset:24
  2422. *
  2423. * Add OFFSET, a signed 24-bit number, to the current instruction
  2424. * pointer.
  2425. */
  2426. VM_DEFINE_OP (127, j, "j", OP1 (X8_L24))
  2427. {
  2428. int32_t offset = op;
  2429. offset >>= 8; /* Sign-extending shift. */
  2430. NEXT (offset);
  2431. }
  2432. /* jl offset:24
  2433. *
  2434. * If the last comparison result is equal to SCM_F_COMPARE_LESS_THAN, add
  2435. * OFFSET, a signed 24-bit number, to the current instruction pointer.
  2436. */
  2437. VM_DEFINE_OP (128, jl, "jl", OP1 (X8_L24))
  2438. {
  2439. if (VP->compare_result == SCM_F_COMPARE_LESS_THAN)
  2440. {
  2441. int32_t offset = op;
  2442. offset >>= 8; /* Sign-extending shift. */
  2443. NEXT (offset);
  2444. }
  2445. else
  2446. NEXT (1);
  2447. }
  2448. /* je offset:24
  2449. *
  2450. * If the last comparison result was EQUAL, then add OFFSET, a signed
  2451. * 24-bit number, to the current instruction pointer.
  2452. */
  2453. VM_DEFINE_OP (129, je, "je", OP1 (X8_L24))
  2454. {
  2455. if (VP->compare_result == SCM_F_COMPARE_EQUAL)
  2456. {
  2457. int32_t offset = op;
  2458. offset >>= 8; /* Sign-extending shift. */
  2459. NEXT (offset);
  2460. }
  2461. else
  2462. NEXT (1);
  2463. }
  2464. /* jnl offset:24
  2465. *
  2466. * If the last comparison result was not LESS_THAN, then add OFFSET, a
  2467. * signed 24-bit number, to the current instruction pointer.
  2468. */
  2469. VM_DEFINE_OP (130, jnl, "jnl", OP1 (X8_L24))
  2470. {
  2471. if (VP->compare_result != SCM_F_COMPARE_LESS_THAN)
  2472. {
  2473. int32_t offset = op;
  2474. offset >>= 8; /* Sign-extending shift. */
  2475. NEXT (offset);
  2476. }
  2477. else
  2478. NEXT (1);
  2479. }
  2480. /* jne offset:24
  2481. *
  2482. * If the last comparison result was not EQUAL, then add OFFSET, a
  2483. * signed 24-bit number, to the current instruction pointer.
  2484. */
  2485. VM_DEFINE_OP (131, jne, "jne", OP1 (X8_L24))
  2486. {
  2487. if (VP->compare_result != SCM_F_COMPARE_EQUAL)
  2488. {
  2489. int32_t offset = op;
  2490. offset >>= 8; /* Sign-extending shift. */
  2491. NEXT (offset);
  2492. }
  2493. else
  2494. NEXT (1);
  2495. }
  2496. /* jge offset:24
  2497. *
  2498. * If the last comparison result was NONE, then add OFFSET, a signed
  2499. * 24-bit number, to the current instruction pointer.
  2500. *
  2501. * This is intended for use after a "<?" comparison, and is different
  2502. * from "jnl" in the way it handles not-a-number (NaN) values: "<?"
  2503. * sets INVALID instead of NONE if either value is a NaN. For exact
  2504. * numbers, "jge" is the same as "jnl".
  2505. */
  2506. VM_DEFINE_OP (132, jge, "jge", OP1 (X8_L24))
  2507. {
  2508. if (VP->compare_result == SCM_F_COMPARE_NONE)
  2509. {
  2510. int32_t offset = op;
  2511. offset >>= 8; /* Sign-extending shift. */
  2512. NEXT (offset);
  2513. }
  2514. else
  2515. NEXT (1);
  2516. }
  2517. /* jnge offset:24
  2518. *
  2519. * If the last comparison result was not NONE, then add OFFSET, a
  2520. * signed 24-bit number, to the current instruction pointer.
  2521. *
  2522. * This is intended for use after a "<?" comparison, and is different
  2523. * from "jl" in the way it handles not-a-number (NaN) values: "<?"
  2524. * sets INVALID instead of NONE if either value is a NaN. For exact
  2525. * numbers, "jnge" is the same as "jl".
  2526. */
  2527. VM_DEFINE_OP (133, jnge, "jnge", OP1 (X8_L24))
  2528. {
  2529. if (VP->compare_result != SCM_F_COMPARE_NONE)
  2530. {
  2531. int32_t offset = op;
  2532. offset >>= 8; /* Sign-extending shift. */
  2533. NEXT (offset);
  2534. }
  2535. else
  2536. NEXT (1);
  2537. }
  2538. #define PTR_REF(type, slot) \
  2539. do { \
  2540. uint8_t dst, a, b; \
  2541. char *ptr; \
  2542. size_t idx; \
  2543. type val; \
  2544. UNPACK_8_8_8 (op, dst, a, b); \
  2545. ptr = SP_REF_PTR (a); \
  2546. idx = SP_REF_U64 (b); \
  2547. memcpy (&val, ptr + idx, sizeof (val)); \
  2548. SP_SET_ ## slot (dst, val); \
  2549. NEXT (1); \
  2550. } while (0)
  2551. #define PTR_SET(type, slot) \
  2552. do { \
  2553. uint8_t a, b, c; \
  2554. char *ptr; \
  2555. size_t idx; \
  2556. type val; \
  2557. UNPACK_8_8_8 (op, a, b, c); \
  2558. ptr = SP_REF_PTR (a); \
  2559. idx = SP_REF_U64 (b); \
  2560. val = SP_REF_ ## slot (c); \
  2561. memcpy (ptr + idx, &val, sizeof (val)); \
  2562. NEXT (1); \
  2563. } while (0)
  2564. /* u8-ref dst:8 ptr:8 idx:8
  2565. *
  2566. * Load the u8 at byte offset IDX from pointer PTR, and store it to
  2567. * u64 DST.
  2568. */
  2569. VM_DEFINE_OP (134, u8_ref, "u8-ref", DOP1 (X8_S8_S8_S8))
  2570. PTR_REF (uint8_t, U64);
  2571. /* u16-ref dst:8 ptr:8 idx:8
  2572. *
  2573. * Load the u16 at byte offset IDX from pointer PTR, and store it to
  2574. * u64 DST.
  2575. */
  2576. VM_DEFINE_OP (135, u16_ref, "u16-ref", DOP1 (X8_S8_S8_S8))
  2577. PTR_REF (uint16_t, U64);
  2578. /* u32-ref dst:8 ptr:8 idx:8
  2579. *
  2580. * Load the u32 at byte offset IDX from pointer PTR, and store it to
  2581. * u64 DST.
  2582. */
  2583. VM_DEFINE_OP (136, u32_ref, "u32-ref", DOP1 (X8_S8_S8_S8))
  2584. PTR_REF (uint32_t, U64);
  2585. /* u64-ref dst:8 ptr:8 idx:8
  2586. *
  2587. * Load the u64 at byte offset IDX from pointer PTR, and store it to
  2588. * u64 DST.
  2589. */
  2590. VM_DEFINE_OP (137, u64_ref, "u64-ref", DOP1 (X8_S8_S8_S8))
  2591. PTR_REF (uint64_t, U64);
  2592. /* u8-set! ptr:8 idx:8 val:8
  2593. *
  2594. * Store the u64 value VAL into the u8 at byte offset IDX from pointer
  2595. * PTR.
  2596. */
  2597. VM_DEFINE_OP (138, u8_set, "u8-set!", OP1 (X8_S8_S8_S8))
  2598. PTR_SET (uint8_t, U64);
  2599. /* u16-set! ptr:8 idx:8 val:8
  2600. *
  2601. * Store the u64 value VAL into the u16 at byte offset IDX from
  2602. * pointer PTR.
  2603. */
  2604. VM_DEFINE_OP (139, u16_set, "u16-set!", OP1 (X8_S8_S8_S8))
  2605. PTR_SET (uint16_t, U64);
  2606. /* u32-set! ptr:8 idx:8 val:8
  2607. *
  2608. * Store the u64 value VAL into the u32 at byte offset IDX from
  2609. * pointer PTR.
  2610. */
  2611. VM_DEFINE_OP (140, u32_set, "u32-set!", OP1 (X8_S8_S8_S8))
  2612. PTR_SET (uint32_t, U64);
  2613. /* u64-set! ptr:8 idx:8 val:8
  2614. *
  2615. * Store the u64 value VAL into the u64 at byte offset IDX from
  2616. * pointer PTR.
  2617. */
  2618. VM_DEFINE_OP (141, u64_set, "u64-set!", OP1 (X8_S8_S8_S8))
  2619. PTR_SET (uint64_t, U64);
  2620. /* s8-ref dst:8 ptr:8 idx:8
  2621. *
  2622. * Load the s8 at byte offset IDX from pointer PTR, and store it to
  2623. * s64 DST.
  2624. */
  2625. VM_DEFINE_OP (142, s8_ref, "s8-ref", DOP1 (X8_S8_S8_S8))
  2626. PTR_REF (int8_t, S64);
  2627. /* s16-ref dst:8 ptr:8 idx:8
  2628. *
  2629. * Load the s16 at byte offset IDX from pointer PTR, and store it to
  2630. * s64 DST.
  2631. */
  2632. VM_DEFINE_OP (143, s16_ref, "s16-ref", DOP1 (X8_S8_S8_S8))
  2633. PTR_REF (int16_t, S64);
  2634. /* s32-ref dst:8 ptr:8 idx:8
  2635. *
  2636. * Load the s32 at byte offset IDX from pointer PTR, and store it to
  2637. * s64 DST.
  2638. */
  2639. VM_DEFINE_OP (144, s32_ref, "s32-ref", DOP1 (X8_S8_S8_S8))
  2640. PTR_REF (int32_t, S64);
  2641. /* s64-ref dst:8 ptr:8 idx:8
  2642. *
  2643. * Load the s64 at byte offset IDX from pointer PTR, and store it to
  2644. * s64 DST.
  2645. */
  2646. VM_DEFINE_OP (145, s64_ref, "s64-ref", DOP1 (X8_S8_S8_S8))
  2647. PTR_REF (int64_t, S64);
  2648. /* s8-set! ptr:8 idx:8 val:8
  2649. *
  2650. * Store the s64 value VAL into the s8 at byte offset IDX from pointer
  2651. * PTR.
  2652. */
  2653. VM_DEFINE_OP (146, s8_set, "s8-set!", OP1 (X8_S8_S8_S8))
  2654. PTR_SET (int8_t, S64);
  2655. /* s16-set! ptr:8 idx:8 val:8
  2656. *
  2657. * Store the s64 value VAL into the s16 at byte offset IDX from
  2658. * pointer PTR.
  2659. */
  2660. VM_DEFINE_OP (147, s16_set, "s16-set!", OP1 (X8_S8_S8_S8))
  2661. PTR_SET (int16_t, S64);
  2662. /* s32-set! ptr:8 idx:8 val:8
  2663. *
  2664. * Store the s64 value VAL into the s32 at byte offset IDX from
  2665. * pointer PTR.
  2666. */
  2667. VM_DEFINE_OP (148, s32_set, "s32-set!", OP1 (X8_S8_S8_S8))
  2668. PTR_SET (int32_t, S64);
  2669. /* s64-set! ptr:8 idx:8 val:8
  2670. *
  2671. * Store the s64 value VAL into the s64 at byte offset IDX from
  2672. * pointer PTR.
  2673. */
  2674. VM_DEFINE_OP (149, s64_set, "s64-set!", OP1 (X8_S8_S8_S8))
  2675. PTR_SET (int64_t, S64);
  2676. /* f32-ref dst:8 ptr:8 idx:8
  2677. *
  2678. * Load the f32 at byte offset IDX from pointer PTR, and store it to
  2679. * f64 DST.
  2680. */
  2681. VM_DEFINE_OP (150, f32_ref, "f32-ref", DOP1 (X8_S8_S8_S8))
  2682. PTR_REF (float, F64);
  2683. /* f64-ref dst:8 ptr:8 idx:8
  2684. *
  2685. * Load the f64 at byte offset IDX from pointer PTR, and store it to
  2686. * f64 DST.
  2687. */
  2688. VM_DEFINE_OP (151, f64_ref, "f64-ref", DOP1 (X8_S8_S8_S8))
  2689. PTR_REF (double, F64);
  2690. /* f32-set! ptr:8 idx:8 val:8
  2691. *
  2692. * Store the f64 value VAL into the f32 at byte offset IDX from
  2693. * pointer PTR.
  2694. */
  2695. VM_DEFINE_OP (152, f32_set, "f32-set!", OP1 (X8_S8_S8_S8))
  2696. PTR_SET (float, F64);
  2697. /* s64-set! ptr:8 idx:8 val:8
  2698. *
  2699. * Store the f64 value VAL into the f8 at byte offset IDX from pointer
  2700. * PTR.
  2701. */
  2702. VM_DEFINE_OP (153, f64_set, "f64-set!", OP1 (X8_S8_S8_S8))
  2703. PTR_SET (double, F64);
  2704. /* call-scm<-f64 dst:12 a:12 IDX:32
  2705. *
  2706. * Call the SCM-returning instrinsic with index IDX, passing the
  2707. * f64 local A as argument. Place the SCM result in DST.
  2708. */
  2709. VM_DEFINE_OP (154, call_scm_from_f64, "call-scm<-f64", DOP2 (X8_S12_S12, C32))
  2710. {
  2711. uint16_t dst, src;
  2712. SCM res;
  2713. scm_t_scm_from_f64_intrinsic intrinsic;
  2714. UNPACK_12_12 (op, dst, src);
  2715. intrinsic = intrinsics[ip[1]];
  2716. SYNC_IP ();
  2717. res = intrinsic (SP_REF_F64 (src));
  2718. SP_SET (dst, res);
  2719. /* No CACHE_SP () after the intrinsic, as the indirect variants
  2720. pass stack pointers directly; stack relocation during this kind
  2721. of intrinsic is not supported! */
  2722. NEXT (2);
  2723. }
  2724. VM_DEFINE_OP (155, unused_155, NULL, NOP)
  2725. VM_DEFINE_OP (156, unused_156, NULL, NOP)
  2726. VM_DEFINE_OP (157, unused_157, NULL, NOP)
  2727. VM_DEFINE_OP (158, unused_158, NULL, NOP)
  2728. VM_DEFINE_OP (159, unused_159, NULL, NOP)
  2729. VM_DEFINE_OP (160, unused_160, NULL, NOP)
  2730. VM_DEFINE_OP (161, unused_161, NULL, NOP)
  2731. VM_DEFINE_OP (162, unused_162, NULL, NOP)
  2732. VM_DEFINE_OP (163, unused_163, NULL, NOP)
  2733. VM_DEFINE_OP (164, unused_164, NULL, NOP)
  2734. VM_DEFINE_OP (165, unused_165, NULL, NOP)
  2735. VM_DEFINE_OP (166, unused_166, NULL, NOP)
  2736. VM_DEFINE_OP (167, unused_167, NULL, NOP)
  2737. VM_DEFINE_OP (168, unused_168, NULL, NOP)
  2738. VM_DEFINE_OP (169, unused_169, NULL, NOP)
  2739. VM_DEFINE_OP (170, unused_170, NULL, NOP)
  2740. VM_DEFINE_OP (171, unused_171, NULL, NOP)
  2741. VM_DEFINE_OP (172, unused_172, NULL, NOP)
  2742. VM_DEFINE_OP (173, unused_173, NULL, NOP)
  2743. VM_DEFINE_OP (174, unused_174, NULL, NOP)
  2744. VM_DEFINE_OP (175, unused_175, NULL, NOP)
  2745. VM_DEFINE_OP (176, unused_176, NULL, NOP)
  2746. VM_DEFINE_OP (177, unused_177, NULL, NOP)
  2747. VM_DEFINE_OP (178, unused_178, NULL, NOP)
  2748. VM_DEFINE_OP (179, unused_179, NULL, NOP)
  2749. VM_DEFINE_OP (180, unused_180, NULL, NOP)
  2750. VM_DEFINE_OP (181, unused_181, NULL, NOP)
  2751. VM_DEFINE_OP (182, unused_182, NULL, NOP)
  2752. VM_DEFINE_OP (183, unused_183, NULL, NOP)
  2753. VM_DEFINE_OP (184, unused_184, NULL, NOP)
  2754. VM_DEFINE_OP (185, unused_185, NULL, NOP)
  2755. VM_DEFINE_OP (186, unused_186, NULL, NOP)
  2756. VM_DEFINE_OP (187, unused_187, NULL, NOP)
  2757. VM_DEFINE_OP (188, unused_188, NULL, NOP)
  2758. VM_DEFINE_OP (189, unused_189, NULL, NOP)
  2759. VM_DEFINE_OP (190, unused_190, NULL, NOP)
  2760. VM_DEFINE_OP (191, unused_191, NULL, NOP)
  2761. VM_DEFINE_OP (192, unused_192, NULL, NOP)
  2762. VM_DEFINE_OP (193, unused_193, NULL, NOP)
  2763. VM_DEFINE_OP (194, unused_194, NULL, NOP)
  2764. VM_DEFINE_OP (195, unused_195, NULL, NOP)
  2765. VM_DEFINE_OP (196, unused_196, NULL, NOP)
  2766. VM_DEFINE_OP (197, unused_197, NULL, NOP)
  2767. VM_DEFINE_OP (198, unused_198, NULL, NOP)
  2768. VM_DEFINE_OP (199, unused_199, NULL, NOP)
  2769. VM_DEFINE_OP (200, unused_200, NULL, NOP)
  2770. VM_DEFINE_OP (201, unused_201, NULL, NOP)
  2771. VM_DEFINE_OP (202, unused_202, NULL, NOP)
  2772. VM_DEFINE_OP (203, unused_203, NULL, NOP)
  2773. VM_DEFINE_OP (204, unused_204, NULL, NOP)
  2774. VM_DEFINE_OP (205, unused_205, NULL, NOP)
  2775. VM_DEFINE_OP (206, unused_206, NULL, NOP)
  2776. VM_DEFINE_OP (207, unused_207, NULL, NOP)
  2777. VM_DEFINE_OP (208, unused_208, NULL, NOP)
  2778. VM_DEFINE_OP (209, unused_209, NULL, NOP)
  2779. VM_DEFINE_OP (210, unused_210, NULL, NOP)
  2780. VM_DEFINE_OP (211, unused_211, NULL, NOP)
  2781. VM_DEFINE_OP (212, unused_212, NULL, NOP)
  2782. VM_DEFINE_OP (213, unused_213, NULL, NOP)
  2783. VM_DEFINE_OP (214, unused_214, NULL, NOP)
  2784. VM_DEFINE_OP (215, unused_215, NULL, NOP)
  2785. VM_DEFINE_OP (216, unused_216, NULL, NOP)
  2786. VM_DEFINE_OP (217, unused_217, NULL, NOP)
  2787. VM_DEFINE_OP (218, unused_218, NULL, NOP)
  2788. VM_DEFINE_OP (219, unused_219, NULL, NOP)
  2789. VM_DEFINE_OP (220, unused_220, NULL, NOP)
  2790. VM_DEFINE_OP (221, unused_221, NULL, NOP)
  2791. VM_DEFINE_OP (222, unused_222, NULL, NOP)
  2792. VM_DEFINE_OP (223, unused_223, NULL, NOP)
  2793. VM_DEFINE_OP (224, unused_224, NULL, NOP)
  2794. VM_DEFINE_OP (225, unused_225, NULL, NOP)
  2795. VM_DEFINE_OP (226, unused_226, NULL, NOP)
  2796. VM_DEFINE_OP (227, unused_227, NULL, NOP)
  2797. VM_DEFINE_OP (228, unused_228, NULL, NOP)
  2798. VM_DEFINE_OP (229, unused_229, NULL, NOP)
  2799. VM_DEFINE_OP (230, unused_230, NULL, NOP)
  2800. VM_DEFINE_OP (231, unused_231, NULL, NOP)
  2801. VM_DEFINE_OP (232, unused_232, NULL, NOP)
  2802. VM_DEFINE_OP (233, unused_233, NULL, NOP)
  2803. VM_DEFINE_OP (234, unused_234, NULL, NOP)
  2804. VM_DEFINE_OP (235, unused_235, NULL, NOP)
  2805. VM_DEFINE_OP (236, unused_236, NULL, NOP)
  2806. VM_DEFINE_OP (237, unused_237, NULL, NOP)
  2807. VM_DEFINE_OP (238, unused_238, NULL, NOP)
  2808. VM_DEFINE_OP (239, unused_239, NULL, NOP)
  2809. VM_DEFINE_OP (240, unused_240, NULL, NOP)
  2810. VM_DEFINE_OP (241, unused_241, NULL, NOP)
  2811. VM_DEFINE_OP (242, unused_242, NULL, NOP)
  2812. VM_DEFINE_OP (243, unused_243, NULL, NOP)
  2813. VM_DEFINE_OP (244, unused_244, NULL, NOP)
  2814. VM_DEFINE_OP (245, unused_245, NULL, NOP)
  2815. VM_DEFINE_OP (246, unused_246, NULL, NOP)
  2816. VM_DEFINE_OP (247, unused_247, NULL, NOP)
  2817. VM_DEFINE_OP (248, unused_248, NULL, NOP)
  2818. VM_DEFINE_OP (249, unused_249, NULL, NOP)
  2819. VM_DEFINE_OP (250, unused_250, NULL, NOP)
  2820. VM_DEFINE_OP (251, unused_251, NULL, NOP)
  2821. VM_DEFINE_OP (252, unused_252, NULL, NOP)
  2822. VM_DEFINE_OP (253, unused_253, NULL, NOP)
  2823. VM_DEFINE_OP (254, unused_254, NULL, NOP)
  2824. VM_DEFINE_OP (255, unused_255, NULL, NOP)
  2825. {
  2826. vm_error_bad_instruction (op);
  2827. abort (); /* never reached */
  2828. }
  2829. END_DISPATCH_SWITCH;
  2830. }
  2831. #undef ABORT_HOOK
  2832. #undef ALIGNED_P
  2833. #undef APPLY_HOOK
  2834. #undef BEGIN_DISPATCH_SWITCH
  2835. #undef CACHE_REGISTER
  2836. #undef END_DISPATCH_SWITCH
  2837. #undef FP_REF
  2838. #undef FP_SET
  2839. #undef FP_SLOT
  2840. #undef SP_REF
  2841. #undef SP_SET
  2842. #undef NEXT
  2843. #undef NEXT_HOOK
  2844. #undef RETURN_HOOK
  2845. #undef RUN_HOOK
  2846. #undef SYNC_IP
  2847. #undef UNPACK_8_8_8
  2848. #undef UNPACK_8_16
  2849. #undef UNPACK_12_12
  2850. #undef UNPACK_24
  2851. #undef VM_DEFINE_OP
  2852. #undef VM_INSTRUCTION_TO_LABEL
  2853. #undef VM_USE_HOOKS
  2854. #undef VP
  2855. /*
  2856. (defun renumber-ops ()
  2857. "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
  2858. (interactive "")
  2859. (save-excursion
  2860. (let ((counter -1)) (goto-char (point-min))
  2861. (while (re-search-forward "^ *VM_DEFINE_[^ ]+ (\\([^,]+\\)," (point-max) t)
  2862. (replace-match
  2863. (number-to-string (setq counter (1+ counter)))
  2864. t t nil 1)))))
  2865. (renumber-ops)
  2866. */