* makefile and the compiler now signal an error if a primitive
is not associated with a location.
This commit is contained in:
		
							parent
							
								
									a146056491
								
							
						
					
					
						commit
						6dc380029c
					
				
							
								
								
									
										
											BIN
										
									
								
								src/ikarus.boot
								
								
								
								
							
							
						
						
									
										
											BIN
										
									
								
								src/ikarus.boot
								
								
								
								
							
										
											Binary file not shown.
										
									
								
							| 
						 | 
				
			
			@ -5,7 +5,7 @@
 | 
			
		|||
  (import 
 | 
			
		||||
    (only (ikarus system $codes) $code->closure)
 | 
			
		||||
    (only (ikarus system $records) $record-ref $record/rtd?)
 | 
			
		||||
    (except (ikarus) ;fasl-write
 | 
			
		||||
    (except (ikarus)
 | 
			
		||||
        compile-core-expr-to-port assembler-output
 | 
			
		||||
        current-primitive-locations eval-core)
 | 
			
		||||
    (ikarus intel-assembler)
 | 
			
		||||
| 
						 | 
				
			
			@ -3190,12 +3190,6 @@
 | 
			
		|||
      [(base-rtd)           (mem 44 pcr)]
 | 
			
		||||
      [else (error 'pcb-ref "invalid arg ~s" x)])))
 | 
			
		||||
 | 
			
		||||
(define do-warn
 | 
			
		||||
  (let ([ls '()])
 | 
			
		||||
    (lambda (x) 
 | 
			
		||||
      (unless (memq x ls)
 | 
			
		||||
        (printf "[ERR ~s] " x)
 | 
			
		||||
        (set! ls (cons x ls))))))
 | 
			
		||||
 | 
			
		||||
(define (primref-loc op)
 | 
			
		||||
  (unless (symbol? op) (error 'primref-loc "not a symbol ~s" op))
 | 
			
		||||
| 
						 | 
				
			
			@ -3207,9 +3201,7 @@
 | 
			
		|||
            "~s is not a valid location for ~s" x op))
 | 
			
		||||
       (mem (fx- disp-symbol-value symbol-tag) (obj x)))]
 | 
			
		||||
    [else
 | 
			
		||||
     (do-warn op)
 | 
			
		||||
     (mem (fx- disp-symbol-system-value symbol-tag)
 | 
			
		||||
          (obj op))]))
 | 
			
		||||
     (error 'compile "cannot find location of primitive ~s" op)]))
 | 
			
		||||
 | 
			
		||||
 | 
			
		||||
(define (generate-code x)
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -114,7 +114,6 @@
 | 
			
		|||
      [$arg-list (ikarus system $arg-list)]
 | 
			
		||||
      [$stack (ikarus system $stack)]
 | 
			
		||||
      [$junkyard (ikarus system $junkyard)]
 | 
			
		||||
      ;[$lists (ikarus system $lists)]
 | 
			
		||||
      ))
 | 
			
		||||
 | 
			
		||||
  (define ikarus-macros-map
 | 
			
		||||
| 
						 | 
				
			
			@ -718,7 +717,8 @@
 | 
			
		|||
                    (lambda (x)
 | 
			
		||||
                      (cond
 | 
			
		||||
                        [(assq x locs) => cdr]
 | 
			
		||||
                        [else #f]))])
 | 
			
		||||
                        [else 
 | 
			
		||||
                         (error 'bootstrap "no location for ~s" x)]))])
 | 
			
		||||
      (let ([p (open-output-file "ikarus.boot" 'replace)])
 | 
			
		||||
        (for-each 
 | 
			
		||||
          (lambda (x) (compile-core-expr-to-port x p))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue