;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.excosy)

;;;;;;
;;; Mathematics primitives

(def function interpret-primitive-application/add/native-integer+native-integer (machine ast)
  (bind ((arguments (arguments-of ast))
         (result-register (llvm/generate-new-register-name :result))
         (bit-size (word-bit-size-of (configuration-of machine))))
    (llvm/add machine (llvm/register machine result-register) (llvm/type machine :signed-integer bit-size)
              (interpret-ast machine (first arguments)) (interpret-ast machine (second arguments)))
    (llvm/register machine result-register)))

(def function interpret-primitive-application/subtract/native-integer+native-integer (machine ast)
  (bind ((arguments (arguments-of ast))
         (result-register (llvm/generate-new-register-name :result))
         (bit-size (word-bit-size-of (configuration-of machine))))
    (llvm/sub machine (llvm/register machine result-register) (llvm/type machine :signed-integer bit-size)
              (interpret-ast machine (first arguments)) (interpret-ast machine (second arguments)))
    (llvm/register machine result-register)))

(def function interpret-primitive-application/remainder/native-integer+native-integer (machine ast)
  (bind ((arguments (arguments-of ast))
         (result-register (llvm/generate-new-register-name :result))
         (bit-size (word-bit-size-of (configuration-of machine))))
    (llvm/srem machine (llvm/register machine result-register) (llvm/type machine :signed-integer bit-size)
               (interpret-ast machine (first arguments)) (interpret-ast machine (second arguments)))
    (llvm/register machine result-register)))

;;;;;;
;;; Comparison primitives

(def function interpret-primitive-application/=/native-integer+native-integer (machine ast)
  (bind ((arguments (arguments-of ast))
         (result-register (llvm/generate-new-register-name :result))
         (bit-size (word-bit-size-of (configuration-of machine))))
    (llvm/icmp machine (llvm/register machine result-register) :llvm/eq (llvm/type machine :signed-integer bit-size)
               (interpret-ast machine (first arguments)) (interpret-ast machine (second arguments)))
    ;; TODO: convert to boolean
    (llvm/register machine result-register)))

(def function interpret-primitive-application/</native-integer+native-integer (machine ast)
  (bind ((arguments (arguments-of ast))
         (result-register (llvm/generate-new-register-name :result))
         (bit-size (word-bit-size-of (configuration-of machine))))
    (llvm/icmp machine (llvm/register machine result-register) :llvm/lt (llvm/type machine :signed-integer bit-size)
               (interpret-ast machine (first arguments)) (interpret-ast machine (second arguments)))
    ;; TODO: convert to boolean
    (llvm/register machine result-register)))

(def function interpret-primitive-application/>/native-integer+native-integer (machine ast)
  (bind ((arguments (arguments-of ast))
         (result-register (llvm/generate-new-register-name :result))
         (bit-size (word-bit-size-of (configuration-of machine))))
    (llvm/icmp machine (llvm/register machine result-register) :llvm/lt (llvm/type machine :signed-integer bit-size)
               (interpret-ast machine (first arguments)) (interpret-ast machine (second arguments)))
    ;; TODO: convert to boolean
    (llvm/register machine result-register)))

;;;;;;
;;; IO primitives

(def function interpret-primitive-application/read-byte-from-standard-input (machine ast)
  (bind ((result-register (llvm/generate-new-register-name :result))
         (bit-size (word-bit-size-of (configuration-of machine)))
         (getchar "getchar"))
    (llvm/declare machine (llvm/type machine :signed-integer bit-size) getchar)
    (llvm/call machine (llvm/register machine result-register) (llvm/type machine :signed-integer bit-size) getchar)
    (llvm/register machine result-register)))

(def function interpret-primitive-application/write-byte-to-standard-output (machine ast)
  (bind ((result-register (llvm/generate-new-register-name :result))
         (argument (first (arguments-of ast)))
         (bit-size (word-bit-size-of (configuration-of machine)))
         (putchar "putchar"))
    (llvm/declare machine (llvm/type machine :signed-integer bit-size) putchar (llvm/type machine :signed-integer bit-size))
    (llvm/call machine nil nil putchar (interpret-ast machine argument) (llvm/type machine :signed-integer bit-size))
    (llvm/register machine result-register)))