<commit_before>;;; Assembler

(defmarco (emit-without-flushing template . args)
  (quasiquote (format t (unquote (string-concat template "~%"))
                      (unquote-splicing args))))

(defmarco (emit out template . args)
  (quasiquote (begin
    (flush-asm-output (unquote out))
    (emit-without-flushing (unquote template) (unquote-splicing args)))))

(defmarco (emit-comment out template . args)
  (quasiquote
    (let* ((*print-pretty* false))
      (format t (unquote (string-concat "# " template "~%"))
              (unquote-splicing args)))))

(define (emit-literal out lit)
  (emit out ".quad ~A" lit))

(define label-counter 0)

(define (gen-label)
  (format nil ".L~D" (incf label-counter)))

(define (emit-data out label scale)
  (emit out ".data")
  (emit out ".align ~D" (ash 1 scale))
  (emit-label out label))

;;; Machine definition

(defconstant value-scale 3)
(defconstant value-size (ash 1 value-scale))

;;; Value representation

(define (low-bits-mask bits) (1- (ash 1 bits)))

;;; number-tag must be all zeros
(defconstant number-tag #b000)
(defconstant number-tag-bits 3)

(defconstant function-tag #b001)
(defconstant function-tag-bits 3)

(defconstant box-tag #b010)
(defconstant box-tag-bits 3)

(defconstant pair-tag #b011)
(defconstant pair-tag-bits 3)

(defconstant vector-tag #b100)
(defconstant vector-tag-bits 3)

(defconstant string-tag #b101)
(defconstant string-tag-bits 3)

(defconstant atom-tag #b111)
(defconstant atom-tag-bits 3)

(defconstant char-scale 0)

(defconstant function-size (* 2 value-size))
(defconstant box-size value-size)
(defconstant pair-size (* 2 value-size))

(define (fixnum-representation n) (ash n number-tag-bits))

(defconstant false-representation #b111)
(defconstant unspecified-representation #b10111)
(defconstant lowest-symbol-representation #b100000000111)

(defconstant simple-representations 
  ;; The quotes here are significant for CL compatibility
  (list (cons 'false false-representation)
        (cons 'true #b1111)
        (cons 'unspecified unspecified-representation)
        (cons () #b11111)))

;;; Registers

(define register-operands ())

(defmarco (define-register name . variants)
  (quasiquote (definitions
    (define (unquote name) (quote (unquote name)))
    (set! register-operands (acons (unquote name) (quote (unquote variants))
                                   register-operands)))))

(define-register %a "%al" "%ax" "%eax" "%rax")
(define-register %b "%bl" "%bx" "%ebx" "%rbx")
(define-register %c "%cl" "%cx" "%ecx" "%rcx")
(define-register %d "%dl" "%dx" "%edx" "%rdx")
(define-register %si "%sil" "%si" "%esi" "%rsi")
(define-register %di "%dil" "%di" "%edi" "%rdi")
(define-register %sp "%spl" "%sp" "%esp" "%rsp")
(define-register %bp "%bpl" "%bp" "%ebp" "%rbp")

(defmarco (define-extended-registers)
  (cons 'definitions
        (mapfor (n '(8 9 10 11 12 13 14 15))
          (list* 'define-register
                 (subject-language-intern (format nil "%r~D" n))
                 (mapfor (tmpl '("%r~Dl" "%r~Dw" "%r~Dd" "%r~D"))
                   (format nil tmpl n))))))

(define-extended-registers)

;;; Use RBX as the allocation pointer, since there are no relevant
;;; instructions that clobber it implicitly.
(define %alloc %r14)

(define general-registers (list %a %b %c %d %si %di))
(define general-register-count (length general-registers))

(define %func %r15)
(define %funcres (first general-registers))

;;; %nargs is use to pass the number of arguments to functions.  We
;;; reuse one of the general-registers for this, which means we have
;;; to be really careful about invoking the operators that use it
;;; (check-arg-count, arg-count).
(define %nargs (last-elem general-registers))

(define (move-regs-to-front regs all-regs)
  (append regs (filterfor (reg all-regs) (not (member? reg regs)))))

;;; Address modes

(define (immediate x)
  (if (number? x) x (format nil "$~A" x)))

(define (dispmem correction offset reg . reg2)
  (if (null reg2)
      (format nil "~A(~A)" (- offset correction) (value-sized reg))
      (format nil "~A(~A,~A)" (- offset correction) (value-sized reg)
              (value-sized (first reg2)))))

(define (mem reg)
  (format nil "(~A)" (value-sized reg)))

(define (register? reg)
  (symbol? reg))

(define (insn-operand operand scale)
  (cond ((symbol? operand)
         (elt (cdr (assoc operand register-operands)) scale))
        ((string? operand) operand)
        ((number? operand) (format nil "$~D" operand))
        (true (error "strange operand ~S" operand))))

(define (value-sized operand)
  (insn-operand operand value-scale))

;;; Condition codes

(define (negate-cc cc)
  (if (eq (string-ref cc 0) #\n)
      (substring cc 1 (1- (string-length cc)))
      (string-concat "n" cc)))

;;; Instructions

(define (insn-size-suffix scale)
  (elt '("b" "w" "l" "q") scale))

(defconstant value-insn-size-suffix (insn-size-suffix value-scale))

(defmarco (define-insn-2 name insn)
  (quasiquote
    (define ((unquote name) out src dest . scale)
      (emit-insn-2 out (unquote insn) src dest scale))))

(define (emit-insn-2 out insn src dest scale)
  (set! scale (if (null? scale) value-scale (car scale)))
  (emit out "~A~A ~A, ~A" insn (insn-size-suffix scale)
        (insn-operand src scale) (insn-operand dest scale)))

(define-insn-2 emit-lea "lea")
(define-insn-2 emit-add "add")
(define-insn-2 emit-sub "sub")
(define-insn-2 emit-imul "imul")
(define-insn-2 emit-and "and")
(define-insn-2 emit-or "or")
(define-insn-2 emit-xor "xor")
(define-insn-2 emit-cmp "cmp")
(define-insn-2 emit-shl "shl")
(define-insn-2 emit-sar "sar")
<commit_msg>Fix an eq<commit_after>;;; Assembler

(defmarco (emit-without-flushing template . args)
  (quasiquote (format t (unquote (string-concat template "~%"))
                      (unquote-splicing args))))

(defmarco (emit out template . args)
  (quasiquote (begin
    (flush-asm-output (unquote out))
    (emit-without-flushing (unquote template) (unquote-splicing args)))))

(defmarco (emit-comment out template . args)
  (quasiquote
    (let* ((*print-pretty* false))
      (format t (unquote (string-concat "# " template "~%"))
              (unquote-splicing args)))))

(define (emit-literal out lit)
  (emit out ".quad ~A" lit))

(define label-counter 0)

(define (gen-label)
  (format nil ".L~D" (incf label-counter)))

(define (emit-data out label scale)
  (emit out ".data")
  (emit out ".align ~D" (ash 1 scale))
  (emit-label out label))

;;; Machine definition

(defconstant value-scale 3)
(defconstant value-size (ash 1 value-scale))

;;; Value representation

(define (low-bits-mask bits) (1- (ash 1 bits)))

;;; number-tag must be all zeros
(defconstant number-tag #b000)
(defconstant number-tag-bits 3)

(defconstant function-tag #b001)
(defconstant function-tag-bits 3)

(defconstant box-tag #b010)
(defconstant box-tag-bits 3)

(defconstant pair-tag #b011)
(defconstant pair-tag-bits 3)

(defconstant vector-tag #b100)
(defconstant vector-tag-bits 3)

(defconstant string-tag #b101)
(defconstant string-tag-bits 3)

(defconstant atom-tag #b111)
(defconstant atom-tag-bits 3)

(defconstant char-scale 0)

(defconstant function-size (* 2 value-size))
(defconstant box-size value-size)
(defconstant pair-size (* 2 value-size))

(define (fixnum-representation n) (ash n number-tag-bits))

(defconstant false-representation #b111)
(defconstant unspecified-representation #b10111)
(defconstant lowest-symbol-representation #b100000000111)

(defconstant simple-representations 
  ;; The quotes here are significant for CL compatibility
  (list (cons 'false false-representation)
        (cons 'true #b1111)
        (cons 'unspecified unspecified-representation)
        (cons () #b11111)))

;;; Registers

(define register-operands ())

(defmarco (define-register name . variants)
  (quasiquote (definitions
    (define (unquote name) (quote (unquote name)))
    (set! register-operands (acons (unquote name) (quote (unquote variants))
                                   register-operands)))))

(define-register %a "%al" "%ax" "%eax" "%rax")
(define-register %b "%bl" "%bx" "%ebx" "%rbx")
(define-register %c "%cl" "%cx" "%ecx" "%rcx")
(define-register %d "%dl" "%dx" "%edx" "%rdx")
(define-register %si "%sil" "%si" "%esi" "%rsi")
(define-register %di "%dil" "%di" "%edi" "%rdi")
(define-register %sp "%spl" "%sp" "%esp" "%rsp")
(define-register %bp "%bpl" "%bp" "%ebp" "%rbp")

(defmarco (define-extended-registers)
  (cons 'definitions
        (mapfor (n '(8 9 10 11 12 13 14 15))
          (list* 'define-register
                 (subject-language-intern (format nil "%r~D" n))
                 (mapfor (tmpl '("%r~Dl" "%r~Dw" "%r~Dd" "%r~D"))
                   (format nil tmpl n))))))

(define-extended-registers)

;;; Use RBX as the allocation pointer, since there are no relevant
;;; instructions that clobber it implicitly.
(define %alloc %r14)

(define general-registers (list %a %b %c %d %si %di))
(define general-register-count (length general-registers))

(define %func %r15)
(define %funcres (first general-registers))

;;; %nargs is use to pass the number of arguments to functions.  We
;;; reuse one of the general-registers for this, which means we have
;;; to be really careful about invoking the operators that use it
;;; (check-arg-count, arg-count).
(define %nargs (last-elem general-registers))

(define (move-regs-to-front regs all-regs)
  (append regs (filterfor (reg all-regs) (not (member? reg regs)))))

;;; Address modes

(define (immediate x)
  (if (number? x) x (format nil "$~A" x)))

(define (dispmem correction offset reg . reg2)
  (if (null reg2)
      (format nil "~A(~A)" (- offset correction) (value-sized reg))
      (format nil "~A(~A,~A)" (- offset correction) (value-sized reg)
              (value-sized (first reg2)))))

(define (mem reg)
  (format nil "(~A)" (value-sized reg)))

(define (register? reg)
  (symbol? reg))

(define (insn-operand operand scale)
  (cond ((symbol? operand)
         (elt (cdr (assoc operand register-operands)) scale))
        ((string? operand) operand)
        ((number? operand) (format nil "$~D" operand))
        (true (error "strange operand ~S" operand))))

(define (value-sized operand)
  (insn-operand operand value-scale))

;;; Condition codes

(define (negate-cc cc)
  (if (eq? (string-ref cc 0) #\n)
      (substring cc 1 (1- (string-length cc)))
      (string-concat "n" cc)))

;;; Instructions

(define (insn-size-suffix scale)
  (elt '("b" "w" "l" "q") scale))

(defconstant value-insn-size-suffix (insn-size-suffix value-scale))

(defmarco (define-insn-2 name insn)
  (quasiquote
    (define ((unquote name) out src dest . scale)
      (emit-insn-2 out (unquote insn) src dest scale))))

(define (emit-insn-2 out insn src dest scale)
  (set! scale (if (null? scale) value-scale (car scale)))
  (emit out "~A~A ~A, ~A" insn (insn-size-suffix scale)
        (insn-operand src scale) (insn-operand dest scale)))

(define-insn-2 emit-lea "lea")
(define-insn-2 emit-add "add")
(define-insn-2 emit-sub "sub")
(define-insn-2 emit-imul "imul")
(define-insn-2 emit-and "and")
(define-insn-2 emit-or "or")
(define-insn-2 emit-xor "xor")
(define-insn-2 emit-cmp "cmp")
(define-insn-2 emit-shl "shl")
(define-insn-2 emit-sar "sar")

{'fraction_non_alphanumeric': 0.16579158138293137, 'fraction_numerical': 0.01833229509655602, 'mean_word_length': 3.751797040169133, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 2, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '160393', 'n_tokens_mistral': 4074, 'n_tokens_neox': 3921, 'n_words': 1188}