(in-package "MESYSTEM")






; memory-funktionen

(defun get-byte (paddr offset)
  )

(defun get-hword (paddr offset)
  )

(defun get-word (paddr offset)
  )

(defun set-byte (paddr offset val)
  )

(defun set-hword (paddr offset val)
  )

(defun set-word (paddr offset pval)
  )

; unsichere Funktionen

; tag-opx bezieht sich auf die Bits 0 und 1

(defun tag-and (p tag-code)
  )

(defun tag-or (p tag-code)
  )

(defun tag-xor (p tag-code)
  )

(defun tag-eq (p tag-code)
  )

(defun tag-set (p tag-code)
  )

; addr-opx bezieht sich auf die Bits 2 bis 31
; (diese bits machen eine fixnum aus)

(defun addr-plus (p i)
  )

(defun addr-minus (p i)
  )

(defun addr-eq (p1 p2)
  )

(defun addr-set (p1 p2)
  )

(defun addr-eqi (p i)
  )

(defun addr-andi (p i)
  )

(defun addr-ori (p i)
  )

(defun addr-shiftl (p i)
  )

(defun addr-shiftr (p i)
  )

(defun addr-seti (p i)
  )




; neu zu definierende Kontrollstrukturen im Interpreter



; vergleichsfunktionen allgemein


(defun eq (x y)
  (and (addr-eq x y) (tag-eq x y)))

(defun null (x)
  (eq x nil))

(defun atom (x)
  (not (consp x)))

; logische funktionen

(defmacro or (&rest l)
  )

(defmacro and (&rest l)
  )


(defun not (x)
  (cond ((null x) t)
        (t nil)))



; die conses, lese und schreibfunktionen


(defun cons (x y)
  )

(defun car (x)
  (progn
    (if (null x)
        nil)
    (if (consp x)
        (get-word x 0)
      (error-fn-type "car" "CONS"))))

(defun cdr (x)
  (progn
    (if (null x)
        nil)
    (if (consp x)
        (get-word x 4)
      (error-fn-type "cdr" "CONS"))))

(defun set-car (x v)
  (progn 
    (if (consp x)
        (set-word x 0 v)
      (error-fn-type "set-car" "CONS"))))

(defun set-cdr (x v)
  (progn
    (if (consp x)
        (set-word x 4 v)
      (error-fn-type "set-cdr" "CONS"))))

; die conses, testfunktionen

(defun consp (x)
  (tag-eq x 1))

(defun listp (x)
  (or (null x) (consp x)))



; die strings, lesen und schreiben von zeichenpositionen

(defun make-string (n)
  )

(defun char (str i)
  )

(defun set-char (str i val)
  )


; die strings, testfunktionen

(defun stringp (x)
  )

; die strings, vergleichsfunktionen

(defun string< (x y)
  )

(defun string> (x y)
  )

(defun string= (x y)
  )

(defun string-cmp-code (x y)
  )




; die vectoren, lesen und schreiben von elementen


(defun make-vector (n)
  )

(defun svref (vect i)
  )

(defun set-svref (vect i val)
  )

; die vectoren, testfunktionen

(defun arrayp (x)
  )


; die atome


(defun make-symbol (str)
  (let ((p (%allocate-space 5)))
    (set-word p 0 *symbol-mark*)
    (set-tag p 0 *symbol-mark-tag*)
    (set-word p 4 str)
    (set-word p 8 nil)
    (set-word p 12 nil)
    (set-word p 16 nil)))

(defun intern (str)
  )

; die atom attribute, lesen

(defun symbol-name (sym)
  (get-word sym 4))

(defun symbol-value (sym)
  (get-word sym 8))

(defun symbol-function (sym)
  (get-word-sym 12))

(defun symbol-plist (sym)
  (get-word-sym 16))

; die atom attribute, schreiben

(defun set-symbol-value (sym val)
  (set-word sym 8 val))

(defun set-symbol-function (sym val)
  (set-word sym 12 val))

(defun set-symbol-plist (sym val)
  (set-word sym 16 val))


; die atome, testfunktion

(defun symbolp (x)
  )




; die chars

(defun char-code (c)
  (if (characterp c)
      (tag-set (addr-shiftr c 14) 0)
    (error-fn-type "char-code" "CHARACTER")))

(defun code-char (x)
  (if (numberp x)
      (tag-set (addr-ori (addr-shiftl x 14) 1) 2))
  (error-fn-type "code-char" "FIXNUM"))

(defun characterp (x)
  (and (tag-eq x 2) (addr-eqi (addr-andi x 255) 1)))


; die (fix)nums

(defun %+ (x y)
  (if (and (numberp x) (numberp y))
      (iplus x y)
    (error-fn-type "+" "FIXNUM")))


(defun %- (x y)
  (if (and (numberp x) (numberp y))
      (iminus x y)
    (error-fn-type "-" "FIXNUM")))


(defun %* (x y)
  (if (and (numberp x) (numberp y))
      (itimes x y)
    (error-fn-type "*" "FIXNUM")))


(defun %divrem (x y)
  (if (and (numberp x) (numberp y))
      (idivrem x y)
    (error-fn-type "divrem" "FIXNUM")))


(defun %numberp (x)
  (tag-eq x 0))

(defun %= (x y)
  (if (and (numberp x) (numberp y))
      (addr-eq x y)
    (error-fn-type "=" "FIXNUM")))

(defun %> (x y)
  (if (and (numberp x) (numberp y))
      (igreater x y)
    (error-fn-type ">" "FIXNUM")))


(defun %< (x y)
  (if (and (numberp x) (numberp y))
      (iless x y)
    (error-fn-type "<" "FIXNUM")))


(defun %<= (x y)
  (if (and (numberp x) (numberp y))
      (ilesseq x y)
    (error-fn-type "<=" "FIXNUM")))


(defun %>= (x y)
  (if (and (numberp x) (numberp y))
      (igreatereq x y)
    (error-fn-type ">=" "FIXNUM")))


; die closures

(defun make-closure (templ vect)
  )

(defun closure-ref (cl i)
  )

(defun closure-p (x)
  )


; die templates

(defun make-template (l c)
  )

(defun templ-ref-l (t i)
  )

(defun templ-ref-c (t i)
  )

(defun set-templ-ref-l (t i val)
  )

(defun set-templ-ref-c (t i v-high v-low)
  )


(defun template-p (x)
  )





; die translatoren

(defun char-cl-to-me (char)
  )

(defun fixnum-cl-to-me (num)
  )

(defun symbol-cl-to-me (sym)
  )

(defun string-cl-to-me (str)
  )

(defun closure-cl-to-me (clos)
  )

(defun template-cl-to-me (templ)
  )


(defun log-me-to-cl (str)
  )


; allgemeiner heap allokator. ruft inkrementellen garbage collector auf

(defun %allocate-space (n)
  )





; system-erzeugung




(defun create-nil (str)
  (let ((nil-add (make-symbol str)))
    (setf-symbol-value nil-add nil-add)
    (setf-symbol-function nil-add nil-add)
    (setf-symbol-plist nil-add nil-add)
    nil-add))


(defvar nil (create-nil (string-cl-to-me "nil")))


(intern (string-cl-to-me "t"))

(intern (string-cl-to-me "quote"))
(intern (string-cl-to-me "function"))
(intern (string-cl-to-me "read-error"))
(intern (string-cl-to-me "next"))
(intern (string-cl-to-me "same"))
(intern (string-cl-to-me "peek"))

(mapcar #'(lambda (z) (intern (string-cl-to-me z)))
     '("cond" "labels" "let" "setq" "progn" "do" "do-until" "funcall" "funarg" "car" "cdr" "cons" "eq" "defun" "labels" "let"
              "+" "-" "*" "divrem" ">" "<" "=" ">=" "<=" "null" "atom"))