arch.scm 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604
  1. ; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
  2. ; Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees. See file COPYING.
  3. ; This is file arch.scm.
  4. ;;;; Architecture description
  5. (define architecture-version "Vanilla 34")
  6. ; Things that the VM and the runtime system both need to know.
  7. (define bits-used-per-byte bits-per-byte)
  8. (define byte-limit (expt 2 bits-used-per-byte))
  9. (define two-byte-limit (* byte-limit byte-limit))
  10. ; Bytecodes: for compiler and interpreter
  11. ; Instruction specification is
  12. ; (op . args)
  13. ; OP may be a name or a list of names
  14. ; ARGS are
  15. ; byte - A byte used for some random purpose
  16. ; two-bytes - ditto, but two bytes
  17. ; nargs - number of arguments on the stack
  18. ; two-byte-nargs - ditto, but two bytes
  19. ; stack-index - A one-byte index into the stack
  20. ; two-byte-stack-index - ditto, but two bytes
  21. ; index - A index into some stob
  22. ; two-byte-index - ditto, but two bytes
  23. ; literal - a one-byte value
  24. ; offset - two bytes giving an offset into the current instruction stream
  25. ; offset- - same thing, negative offset
  26. ; stob - a byte specifying a type for a stored object
  27. ; env-data - environment specification with one-byte values
  28. ; big-env-data - environment specification with two-byte values
  29. ; moves-data - specification of stack shuffle moves
  30. ; big-moves-data - specification of stack shuffle moves
  31. ; cont-data - cont-data specification
  32. ; protocol - protocol specification
  33. ; 0 1 2 ... - the number of non-instruction-stream arguments (some
  34. ; instructions take a variable number of arguments; the first
  35. ; number is the argument count implemented by the VM)
  36. ; + - any number of additional arguments are allowed
  37. (define-syntax define-instruction-set
  38. (lambda (form rename compare)
  39. (let ((data (do ((data (reverse (cdr form)) (cdr data))
  40. (new '() (let ((next (car data)))
  41. (if (pair? (car next))
  42. (append (map (lambda (op)
  43. (cons op (cdr next)))
  44. (car next))
  45. new)
  46. (cons next new)))))
  47. ((null? data) new))))
  48. `(begin (define-enumeration op
  49. ,(map car data))
  50. (define opcode-arg-specs
  51. '#(,@(map cdr data)))))))
  52. ; Instructions marked *EXP* are experimental and are not normally used by
  53. ; byte-code compiler.
  54. (define-instruction-set
  55. (protocol protocol) ; first opcode in a procedure, never actually
  56. ; executed
  57. (integer-literal literal) ; optimization for one-byte integers (also
  58. ; used in the closed-compiled +, *)
  59. (push+integer-literal literal) ; preceded by a push
  60. (integer-literal+push literal) ; followed by a push
  61. (global two-byte-stack-index two-byte-index) ; first is template, second within template
  62. (set-global! two-byte-stack-index two-byte-index 1) ; first is template, second within template
  63. (make-flat-env env-data) ; make new environment from env-data
  64. (make-big-flat-env big-env-data) ; same, but with two-byte size and offsets
  65. ; the following four emitted from the byte-code optimizer, for the
  66. ; benefit of the native-code compiler
  67. (env-set! stack-index index 1) ; set environment slot
  68. (big-env-set! two-byte-stack-index two-byte-index 1)
  69. (template-ref stack-index index) ; same thing as stack-indirect
  70. (big-template-ref two-byte-stack-index two-byte-index) ; same thing as stack-indirect
  71. (make-flat-closure two-bytes) ; create flat closure
  72. (push 1) ; push *val* onto stack
  73. (push-false) ; a common combination
  74. (pop) ; pop top of stack into *val*
  75. (pop-n two-bytes) ; remove the top N values from the stack
  76. ; leaving *val* unchanged
  77. (push-n two-bytes) ; allocate space for N values on stack
  78. ; leaving *val* unchanged
  79. (stack-ref stack-index) ; index'th element of stack into *val*
  80. (push+stack-ref stack-index) ; preceded by a push
  81. (stack-ref+push stack-index) ; followed by a push
  82. (big-stack-ref two-byte-stack-index)
  83. (stack-set! stack-index 1) ; *val* to index'th element of stack
  84. (big-stack-set! two-byte-stack-index 1)
  85. (stack-indirect stack-index index) ; first is index into stack, second is index
  86. ; into what you find there
  87. (push+stack-indirect stack-index index) ; preceded by a push
  88. (stack-indirect+push stack-index index) ; followed by a push
  89. (big-stack-indirect two-byte-stack-index two-byte-index)
  90. (stack-shuffle! moves-data) ; shuffle stack elements around
  91. (big-stack-shuffle! big-moves-data) ; shuffle stack elements around with two-byte offsets
  92. (current-cont) ; copy *cont* to *val*, use WITH-CONTINUATION
  93. ; to use copied continuation
  94. (cont-data cont-data) ; continuation data; never executed
  95. ;; Different ways to call procedures
  96. (call offset nargs 1 +) ; last argument is the procedure to call,
  97. ; offset is to return pointer
  98. (tail-call nargs 1 +) ; same, no return pointer, moves arguments
  99. (big-call offset two-byte-nargs 1 +) ; ditto, nargs counts are two bytes
  100. (poll)
  101. (apply offset two-byte-nargs 2 +) ; last argument is procedure to call, second to
  102. ; last is a list of additional arguments, next
  103. ; two bytes are the number of stack arguments
  104. (closed-apply 2 +) ; arguments are as for Scheme's APPLY, with
  105. ; the number of non-list arguments pushed on
  106. ; the top of the stack
  107. (with-continuation 2) ; first arg is cont, second is procedure
  108. ;; Three different ways to return from calls
  109. (return 1) ; return one value
  110. (values two-bytes +) ; values are on stack, count is next two bytes
  111. (closed-values +) ; values are on stack, count is pushed on stack
  112. ;; Six different ways to jump
  113. (goto-template two-byte-index) ; jump to another template (*EXP*)
  114. ; does not poll for interrupts
  115. (call-template offset two-byte-stack-index two-byte-index nargs)
  116. ; call a template instead of a procedure
  117. ; nargs is needed for interrupt handling
  118. (jump-if-false offset 1) ; boolean in *val*
  119. (jump offset)
  120. (jump-back offset-) ; same, but subtract the offset
  121. (computed-goto byte offset 1) ; jump using delta specified by *val*
  122. ; defaults to instruction after deltas (*EXP*)
  123. ;; For the closed-compiled definitions of n-ary arithmetic functions.
  124. ;; The opcode sequences used are:
  125. ;; binary-reduce1 binary-op binary-reduce2 return
  126. ;; and
  127. ;; binary-reduce1 binary-op binary-comparison-reduce2 return
  128. ((binary-reduce1 binary-reduce2 binary-comparison-reduce2))
  129. ;; Scalar primitives
  130. (eq? 2)
  131. ((number? integer? rational? real? complex? exact?) 1)
  132. ((exact->inexact inexact->exact) 1)
  133. ((+ *) 2 0 1 +)
  134. ((- /) 2 1)
  135. ((= < > <= >=) 2 +)
  136. ((quotient remainder) 2)
  137. ((floor numerator denominator
  138. real-part imag-part
  139. exp log sin cos tan asin acos sqrt
  140. angle magnitude)
  141. 1)
  142. (atan1 1)
  143. (atan2 2)
  144. ((make-polar make-rectangular) 2)
  145. (bitwise-not 1)
  146. (bit-count 1)
  147. ((bitwise-and bitwise-ior bitwise-xor) 2)
  148. (arithmetic-shift 2)
  149. (char? 1)
  150. ((char=? char<?) 2)
  151. ((char->scalar-value scalar-value->char scalar-value?) 1)
  152. (eof-object? 1)
  153. ;; Data manipulation
  154. (stored-object-has-type? stob 1)
  155. (stored-object-length stob 1)
  156. (make-stored-object byte stob)
  157. (closed-make-stored-object stob) ; size pushed on stack
  158. (stored-object-ref stob index 1)
  159. (stored-object-set! stob index byte 2) ; byte = 0
  160. ; means not to log in the proposal
  161. (make-vector-object stob 2) ; size + init
  162. ; If the byte = 0 then do not log in the current proposal
  163. (stored-object-indexed-ref stob byte 2) ; vector + offset
  164. (stored-object-indexed-set! stob byte 3) ; vector + offset + value
  165. (make-double)
  166. (make-byte-vector 2)
  167. (byte-vector-length 1)
  168. (byte-vector-ref 2)
  169. (byte-vector-set! 3)
  170. (make-string 2)
  171. (string-length 1)
  172. (string-ref 2)
  173. (string-set! 3)
  174. (copy-string-chars! 5)
  175. (intern 1)
  176. (location-defined? 1)
  177. (set-location-defined?! 2)
  178. ((immutable? make-immutable!) 1)
  179. ;; channels (unbuffered, non-blocking I/O)
  180. (open-channel 4)
  181. (close-channel 1)
  182. (channel-maybe-read 5)
  183. (channel-maybe-write 4)
  184. (channel-parameter 1)
  185. (channel-ready? 1)
  186. (channel-abort 1) ; stop channel operation
  187. (open-channels-list) ; return a list of the open channels
  188. ;; weak-pointers
  189. (make-weak-pointer 1)
  190. ;; Optimistic concurrency
  191. (current-proposal)
  192. (set-current-proposal! 1)
  193. (maybe-commit)
  194. (stored-object-logging-ref stob index 1)
  195. (copy-bytes! byte 5) ; byte = 0 -> don't log
  196. (byte-vector-logging-ref 2)
  197. (byte-vector-logging-set! 3)
  198. ;; Misc
  199. ((unassigned unspecific))
  200. (trap 1) ; raise exception
  201. (false) ; return #f (for bootstrapping)
  202. (eof-object) ; hard to get otherwise
  203. (write-image-low 4)
  204. (collect)
  205. (string-hash 1) ; used by the static linker for the initial table
  206. (add-finalizer! 2)
  207. (memory-status 2)
  208. (find-all 1) ; makes a vector of all objects of a given type
  209. (find-all-records 1) ; makes a vector of all records of a given type
  210. (current-thread)
  211. (set-current-thread! 1)
  212. (session-data) ; session specific data
  213. (set-session-data! 1)
  214. (set-exception-handlers! 1)
  215. (return-from-exception 1)
  216. (return-from-native-exception 1)
  217. (set-interrupt-handlers! 1)
  218. (set-enabled-interrupts! 1)
  219. (resume-interrupted-opcode-to-byte-code)
  220. (resume-interrupted-call-to-native-code)
  221. (resume-native-poll)
  222. (schedule-interrupt 1)
  223. (wait 2) ; do nothing until something happens
  224. (call-external-value 1 +)
  225. (lookup-shared-binding 2)
  226. (undefine-shared-binding 2)
  227. (find-undefined-imported-bindings)
  228. (time 2)
  229. (system-parameter 1)
  230. (vm-extension 2) ; access to extensions of the virtual machine
  231. (return-from-callback 2) ; return from an callback
  232. ;; Unnecessary primitives
  233. (string=? 2)
  234. (reverse-list->string 2)
  235. (assq 2)
  236. (unassigned-check 1)
  237. ; If the byte = 0 then do not log in the current proposal
  238. (checked-record-ref index 3)
  239. (checked-record-set! index 4)
  240. (encode-char 5)
  241. (encode-char! 5)
  242. (decode-char 4)
  243. (decode-char! 4)
  244. ;; ports (buffered I/O) - these are all unnecessary
  245. ;; byte = 0 -> port is supplied
  246. ;; = 1 -> get port from dynamic environment
  247. ((read-byte peek-byte) byte 1 0)
  248. (write-byte byte 2 1)
  249. ((read-char peek-char) byte 1 0)
  250. (write-char byte 2 1)
  251. (os-error-message 1)
  252. ;; For writing informative messages when debugging
  253. (message 1)
  254. )
  255. (define-enumeration interrupt
  256. (alarm ; order matters - higher priority first
  257. keyboard
  258. ;; "Major" means the collector made a maximal effort to reclaim
  259. ;; memory; everything else is "minor".
  260. post-minor-gc post-major-gc ; handler is passed a list of finalizers
  261. i/o-completion ; handler is passed channel, error flag and status
  262. os-signal
  263. external-event ; handler is passed event type uid
  264. ))
  265. ; Possible problems
  266. (define-enumeration exception
  267. (unassigned-local
  268. undefined-global
  269. unbound-global
  270. bad-procedure
  271. wrong-number-of-arguments
  272. wrong-type-argument
  273. arithmetic-overflow
  274. index-out-of-range
  275. heap-overflow
  276. out-of-memory
  277. cannot-open-channel
  278. channel-os-index-already-in-use
  279. closed-channel
  280. buffer-full/empty
  281. unimplemented-instruction
  282. trap
  283. proceeding-after-exception
  284. bad-option
  285. unbound-external-name
  286. too-many-arguments-to-external-procedure
  287. too-many-arguments-in-callback
  288. callback-return-uncovered
  289. extension-exception
  290. extension-return-error
  291. os-error
  292. gc-protection-mismatch
  293. no-current-proposal
  294. native-code-not-supported
  295. illegal-exception-return
  296. ))
  297. ; Used by (READ-BYTE) and (WRITE-BYTE) to get the appropriate ports from
  298. ; the fluid environment.
  299. (define-enumeration current-port-marker
  300. (current-input-port
  301. current-output-port))
  302. ;----------------
  303. ; Call and return protocols
  304. ;
  305. ; Protocols 0..maximum-stack-args are just the number of arguments sitting on
  306. ; the stack.
  307. (define maximum-stack-args 63)
  308. (define *last-protocol* maximum-stack-args)
  309. (define (next-protocol)
  310. (set! *last-protocol* (+ *last-protocol* 1))
  311. *last-protocol*)
  312. ; The next two bytes gives the expected number of arguments.
  313. (define two-byte-nargs-protocol (next-protocol))
  314. ; Used for all n-ary procedures. The next two bytes gives the minimum
  315. ; number of arguments.
  316. (define two-byte-nargs+list-protocol (next-protocol))
  317. ; Drop any and all arguments on the floor. The compiler doesn't use this
  318. ; for procedures, but does generate it for continuations.
  319. (define ignore-values-protocol (next-protocol))
  320. ; Real protocol is at the end of the code vector, along with the required
  321. ; stack size:
  322. ; ... real-protocol stack-size0 stack-size1
  323. ; This stuff has to be at the end of the code vector because the necessary stack
  324. ; size is not determined until after the code vector has been assembled.
  325. (define big-stack-protocol (next-protocol))
  326. ; The rest are used only for the definitions of various Scheme primitives.
  327. ; For VECTOR, RECORD, VALUES, EXTERNAL-CALL, APPLY
  328. ; Next byte is the minimum number of arguments (1 for EXT-CALL, 2 for APPLY,
  329. ; 0 for the rest).
  330. ; Stack = arg0 arg1 ... argN rest-list N+1 total-arg-count
  331. ; The first two arguments are always on the stack.
  332. (define args+nargs-protocol (next-protocol))
  333. ; Followed by four bytes: the offsets of code for the 3+, 0, 1, and 2 arg cases.
  334. ; A zero indicates that the primitive doesn't accept that number of arguments.
  335. ; If there are fewer than three arguments they are all on the stack. In the
  336. ; 3+ case the setup is the same as args+nargs above (it's first so that it can
  337. ; share code in the VM with args+nargs).
  338. (define nary-dispatch-protocol (next-protocol))
  339. ; The following is used to mark continuations created for the first argument
  340. ; to CALL-WITH-VALUES when the second argument is not a LAMBDA expression.
  341. ; The continuation contains a single value, the procedure to be called on the
  342. ; values returned by the first argument.
  343. (define call-with-values-protocol (next-protocol))
  344. ; Used to mark the continuation at the bottom of the stack cash.
  345. (define bottom-of-stack-protocol (next-protocol))
  346. ; Native protocols are the same, except with the high bit set.
  347. (define native-protocol-mask #x80)
  348. ; The maximum number of arguments that can be passed to EXTERNAL-CALL.
  349. ; This is determined by the C procedure `external_call()'.
  350. (define maximum-external-call-args 12)
  351. ;----------------
  352. ; The number of stack slots available to each procedure by default.
  353. ; Procedures that need more than this must use one of the two-byte-nargs
  354. ; protocols. All of these are given in terms of descriptors.
  355. (define default-stack-space 64)
  356. (define continuation-stack-size 4) ; header + continuation + pc + code
  357. (define available-stack-space 8000) ; how much stack space is available for
  358. ; any one procedure
  359. ; The number of values that the VM adds to continuations.
  360. (define continuation-cells 3)
  361. ; Offsets of saved registers in continuations
  362. (define continuation-pc-index 0)
  363. (define continuation-code-index 1)
  364. (define continuation-cont-index 2)
  365. ; Offsets in the CONT-DATA instruction
  366. ; -1 -2 frame size
  367. (define gc-mask-size-offset -3) ; -3 gc mask size
  368. ; -4 -5 offset
  369. ; -6 -7 template
  370. (define gc-mask-offset -8) ; -8 ... mask (low bytes first)
  371. ; The number of additional values that the VM adds to exception continuations.
  372. (define exception-continuation-cells 5)
  373. ; Offsets of saved registers in exception continuations. Size must come
  374. ; first because the VM expects it there.
  375. (define exception-cont-size-index (+ continuation-cells 0))
  376. (define exception-cont-pc-index (+ continuation-cells 1))
  377. (define exception-cont-code-index (+ continuation-cells 2))
  378. (define exception-cont-exception-index (+ continuation-cells 3))
  379. (define exception-cont-instruction-size-index (+ continuation-cells 4))
  380. ;----------------
  381. ; Options for op/time
  382. (define-enumeration time-option
  383. (run-time
  384. real-time
  385. cheap-time ; cheap (no system call) access to the polling clock
  386. gc-run-time
  387. ;current-time
  388. ))
  389. ; Options for op/memory-status
  390. (define-enumeration memory-status-option
  391. (available
  392. heap-size
  393. max-heap-size
  394. stack-size
  395. gc-count
  396. expand-heap!
  397. pointer-hash
  398. ))
  399. ; The two types of special channels cannot be used for normal I/O.
  400. (define-enumeration channel-status-option
  401. (closed
  402. input
  403. output
  404. special-input ; socket accept, ???
  405. special-output ; ???
  406. ))
  407. ; Indicies into a port's status word
  408. (define-enumeration port-status-options
  409. (input
  410. output
  411. open-for-input
  412. open-for-output
  413. ))
  414. ; Parameters that configure a channel
  415. (define-enumeration channel-parameter-option
  416. (buffer-size crlf?))
  417. ; Built-in text encodings
  418. (define-enumeration text-encoding-option
  419. (us-ascii
  420. latin-1
  421. utf-8
  422. utf-16le utf-16be
  423. utf-32le utf-32be))
  424. ; Options for op/system-parameter
  425. (define-enumeration system-parameter-option
  426. (host-architecture
  427. os-string-encoding))
  428. (define-enumeration stob
  429. (;; D-vector types (traced by GC)
  430. pair
  431. symbol
  432. vector
  433. closure
  434. location
  435. cell
  436. channel
  437. port
  438. ratnum
  439. record
  440. continuation
  441. extended-number
  442. template
  443. weak-pointer
  444. shared-binding
  445. unused-d-header1
  446. ;; B-vector types (not traced by GC)
  447. string ; = least b-vector type
  448. byte-vector
  449. double ; double precision floating point
  450. bignum
  451. ))
  452. ; This is here to try to ensure that it is changed when STOB changes.
  453. (define least-b-vector-type (enum stob string))
  454. ; (stob predicate constructor . (accessor modifier)*)
  455. ; If nothing else, the run-time system and the VM need to agree on
  456. ; which slot of a pair is the car and which is the cdr.
  457. (define stob-data
  458. '((pair pair? cons
  459. (car set-car!) (cdr set-cdr!))
  460. (symbol symbol? #f ; RTS calls op/intern/string->symbol
  461. (symbol->string))
  462. (location location? make-location
  463. (location-id set-location-id!)
  464. (contents set-contents!))
  465. (cell cell? make-cell
  466. (cell-ref cell-set!))
  467. (closure closure? make-closure
  468. (closure-template) (closure-env))
  469. (weak-pointer weak-pointer? #f ; make-weak-pointer is an op
  470. (weak-pointer-ref))
  471. (shared-binding shared-binding? make-shared-binding
  472. (shared-binding-name)
  473. (shared-binding-is-import?)
  474. (shared-binding-ref shared-binding-set!))
  475. (port port? make-port
  476. (port-handler)
  477. ;; either an integer from the TEXT-ENCODING-OPTION for encodings
  478. ;; handled by the VM, or a :TEXT-CODEC object for things handled
  479. ;; purely by the RTS
  480. (port-text-codec-spec set-port-text-codec-spec!)
  481. (port-crlf? set-port-crlf?!)
  482. (port-status set-port-status!)
  483. (port-lock set-port-lock!) ; used for buffer timestamps
  484. (port-data set-port-data!)
  485. (port-buffer set-port-buffer!)
  486. (port-index set-port-index!)
  487. (port-limit set-port-limit!)
  488. ;; for CR/LF handling
  489. (port-pending-cr? set-port-pending-cr?!)
  490. (port-pending-eof? set-port-pending-eof?!))
  491. (channel channel? #f
  492. (channel-status)
  493. (channel-id)
  494. (channel-os-index)
  495. (channel-close-silently?))
  496. ))