Cells as stob (from S48 0.57).
This commit is contained in:
		
							parent
							
								
									6f083d7205
								
							
						
					
					
						commit
						06b68b7c5e
					
				|  | @ -223,20 +223,6 @@ | |||
|             (apply define-data-struct-primitives stuff)) | ||||
|           stob-data) | ||||
| 
 | ||||
| ; For flat environments | ||||
| 
 | ||||
| (let ((:value (sexp->type ':value #t)) | ||||
|       (:vector (sexp->type ':vector #t))) | ||||
|   (define-simple-primitive 'make-cell | ||||
|     (proc (:value) :vector) | ||||
|     (instruction (enum op make-stored-object) 1 (enum stob vector))) | ||||
|   (define-simple-primitive 'cell-ref | ||||
|     (proc (:vector) :value) | ||||
|     (instruction (enum op stored-object-ref) (enum stob vector) 0)) | ||||
|   (define-simple-primitive 'cell-set! | ||||
|     (proc (:vector :value) unspecific-type) | ||||
|     (instruction (enum op stored-object-set!) (enum stob vector) 0))) | ||||
| 
 | ||||
| ; Define primitives for vector-like stored objects. | ||||
| 
 | ||||
| (define (define-vector-primitives name element-type make length ref set!) | ||||
|  |  | |||
|  | @ -112,6 +112,12 @@ | |||
| 	  ((bitwise-and bitwise-ior bitwise-xor) | ||||
| 	   (proc (&rest :exact-integer) :exact-integer)))) | ||||
| 
 | ||||
| (define-interface cells-interface | ||||
|   (export cell? | ||||
| 	  make-cell | ||||
| 	  cell-ref | ||||
| 	  cell-set!)) | ||||
| 
 | ||||
| (define-interface locations-interface | ||||
|   (export location? | ||||
| 	  location-defined? | ||||
|  |  | |||
|  | @ -18,6 +18,7 @@ | |||
| 		    (vm-exposure vm-exposure-interface) | ||||
| 		    (ascii ascii-interface) | ||||
| 		    (locations locations-interface) | ||||
| 		    (cells cells-interface) | ||||
| 		    (low-channels low-channels-interface) | ||||
| 		    (ports ports-interface) | ||||
| 		    (shared-bindings shared-bindings-interface) | ||||
|  |  | |||
|  | @ -234,6 +234,7 @@ | |||
|   (export ((ascii | ||||
| 	    bitwise | ||||
| 	    byte-vectors | ||||
| 	    cells | ||||
| 	    code-vectors | ||||
| 	    features | ||||
| 	    ;; records  - lose | ||||
|  |  | |||
|  | @ -398,6 +398,7 @@ | |||
|    vector | ||||
|    closure | ||||
|    location | ||||
|    cell | ||||
|    channel | ||||
|    port | ||||
|    ratnum | ||||
|  | @ -432,6 +433,8 @@ | |||
|     (location location? make-location | ||||
|       (location-id set-location-id!) | ||||
|       (contents set-contents!)) | ||||
|     (cell cell? make-cell | ||||
|       (cell-ref cell-set!)) | ||||
|     (closure closure? make-closure | ||||
|       (closure-template) (closure-env)) | ||||
|     (weak-pointer weak-pointer? make-weak-pointer | ||||
|  |  | |||
|  | @ -248,6 +248,7 @@ | |||
| 	  vm-symbol-next vm-set-symbol-next! | ||||
| 	  closure? closure-size make-closure closure-template closure-env | ||||
| 	  location? location-size make-location contents set-contents! location-id | ||||
|   	  cell? cell-size make-cell cell-ref cell-set! | ||||
| 	  weak-pointer? weak-pointer-size make-weak-pointer weak-pointer-ref | ||||
| 
 | ||||
| 	  shared-binding? shared-binding-size make-shared-binding | ||||
|  |  | |||
|  | @ -22,6 +22,7 @@ | |||
|   (symbol-next set-symbol-next!))       		; hidden from RTS | ||||
| (define-shared-primitive-data-type closure #f #t) | ||||
| (define-shared-primitive-data-type location) | ||||
| (define-shared-primitive-data-type cell) | ||||
| (define-shared-primitive-data-type weak-pointer) | ||||
| (define-shared-primitive-data-type shared-binding #f #f | ||||
|   #f | ||||
|  |  | |||
		Loading…
	
		Reference in New Issue
	
	 mainzelm
						mainzelm