;; ---- 1996 Scheme Workshop -- Compiling Scheme

;; -- cg-help.ss

;; ---- Tagging

; All values are tagged in their lower three bits.

(define number-tag  #b000)
(define immed-tag   #b001)
(define pair-tag    #b010)
(define string-tag  #b011)
(define symbol-tag  #b100)
(define vector-tag  #b101)
(define closure-tag #b110)

(define mask	    #b111)

(define tag-len 3)

; Numbers are represented in two's complement form.  Since three bits
; are used by the tag, our range is -2^28 to 2^28-1

; ``immediates'' have eight bits for tag information.  The uppper bits
; are used for the actual data.  For a character that means the ascii
; representation.  #t sets bit nine to 1, #f sets bit nine to 0.

(define bool-tag #b00000001)
(define null-tag #b00001001)
(define char-tag #b00010001)

(define imm-mask #b11111111)

(define imm-tag-len 8)

;; In order not to scatter `4's around the code, the symbolic constant
;; ws stands for ``word size''

(define ws 4)

;; ---- literal encoding

(define encode
  (let ([numtop (expt 2 29)])
    (lambda (obj)
      (cond
	[(number? obj)
	 (cond
	   [(and (<= 0 obj) (< obj numtop))
	    (* obj (+ mask 1))]
	   [(and (<= (- numtop) obj) (< obj 0))
	    (* (+ numtop obj) (+ mask 1))]
	   [else
	     (error 'encode "~s is out of range" obj)])]
	[(boolean? obj)
	 (+ (* (if obj 1 0) (+ imm-mask 1)) bool-tag)]
	[(null? obj) null-tag]
	[(char? obj)
	 (let ([val (char->integer obj)])
	   (+ (* val (+ imm-mask 1)) char-tag))]
	[else
	  (error 'encode "~s not encodable" obj)]))))

;; ---- Output format

;; The output of the code generator is a list whose car is the symbol
;; `instructions'.  The procedure instructions, below, handles the
;; flattening of the list so nobody ever has to write the word
;; ``append'' in their code.

(define instructions
  (lambda args
    (cons 'instructions
      (let loop ([ls args])
	(if (null? ls)
	    '()
	    (if (eq? (caar ls) 'instructions)
		(append (cdar ls)
		  (loop (cdr ls)))
		(cons (car ls)
		  (loop (cdr ls)))))))))