vm-engine.c 97 KB

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