;;; -*- Mode:LISP; Package:SIM; Base:10; Readtable:ZL -*-
(define-asm %reset-instruction-counter ()
  (alu (func instruction-counter) <- (constant 0) setl (garbage))
  (return-xct-next)
  (alu (func return) <- (constant 'nil) setl (garbage)))

(define-asm %halt ()
  (noop halt)
  (return-xct-next)
  (alu (func return) <- (constant 'nil) setl (garbage)))

(define-asm + ()
  (return-xct-next)
  (alu (func return) <- (active 0) add (active 1)))

;allocate-list-storage-default
;        ((m-s) dpb m-zero q-all-but-typed-pointer a-default-cons-area)
;allocate-list-storage-kernel
;        (jump-not-equal m-s a-active-cons-cache-area allocate-list-storage-uncached)
;        ((a-active-cons-cache-allocation-status q-r) add m-b a-active-cons-cache-allocation-status)
;        (jump-greater-than q-r a-list-allocation-threshold allocate-list-storage-cached-list-header)
;        ((m-3) output-selector-mask-25 add m-b a-active-cons-cache-free-pointer)
;        (jump-greater-than m-3 a-active-cons-cache-free-limit allocate-list-storage-uncached)
;        (popj-after-next
;          (m-t) a-active-cons-cache-free-pointer)
;       ((a-active-cons-cache-free-pointer) m-3)

(defconst *default-cons-area-allocation-status-global-number* #o7000)
(defconst *default-cons-area-cached-free-pointer-global-number* #o7001)
(defconst *default-cons-area-constant-2-global-number #o7002)
(defconst *default-cons-area-constant-16-global-number #o7002)
(defconst *default-cons-area-cached-free-pointer-limit-global-numer* #o7003)

(define-asm cons (car cdr)
  (alu (global *default-cons-area-allocation-status-global-number*) <-
       (global *default-cons-area-allocation-status-global-number*) sub
       (global *default-cons-area-constant-2-global-number*))
  (jump less-than cons-need-list-header)
  (alu (active 2) <- (global *defaut-cons-area-cached-free-pointer-global-number*) setl (garbage))
  (alu (garbage) <- (active 2) and (constant 1))
  (jump not-equal cons-need-list-header-already-have-active-2)
  (alu (active 3) <-
       (global *default-cons-area-cached-free-pointer-global-number*) add
       (global *default-cons-area-constant-2-global-number*))
  (alu (garbage) <- (active 3) sub (global *default-cons-area-cached-free-pointer-limit-global-number*))
  (jump greater-than cons-uncached)
  (alu (global *default-cons-area-cached-free-pointer-global-number*) <- (active 3) setl (garbage))
store-values
  (alu (func md) <- (active 0) setl (garbage))
  (alu (func vma-start-write) <- (active 2) setl (garbage))
  (alu (func md) <- (active 1) setl (garbage))
  (alu (func vma-start-write) <- (func vma) or (constant 1))
  (return-xct-next)
  (alu (func return) <- (active 2) or (constant #.(dpb dtp-list %%q-data-type 0)))

cons-need-list-header
  (alu (active 2) <- (global *default-cons-area-cached-free-pointer-global-number*) setl (garbage))
cons-need-list-header-already-have-active-2
  (alu (active 3) <- (global *default-cons-area-cached-free-pointer-global-number*) M+A+1
       (global *default-cons-area-constant-2-global-number*))
  (alu (garbage) <- (active 3) sub (global *default-cons-area-cached-free-pointer-limit-global-number*))
  (jump greater-or-equal cons-uncached)
  (alu (global *default-cons-area-cached-free-pointer-global-number*) <- (active 3) setl (garbage))
  (alu (func md) <- (global *default-cons-area-list-header-global-number*) setl (garbage))
  (alu (func vma-start-write) <- (active 2) setl (garbage))
  (alu (active 2) <- (active 2) add (constant 1))
  (jump-xct-next store-values)
 (alu (global *default-cons-area-allocation-status-global-number*) <-
      (global *default-cons-area-constant-16-global-number*) setl
      (garbage))

cons-uncached



  )
  

(define-asm cons (car cdr)
  (alu (func vma-start-read) <- (constant *free-pointer*) setl (garbage))
  (no-op)
  (alu (garbage) <- (func md) and (constant 1))
  (jump not-equal not-aligned)
  (alu (active 2) <- (func md) setl (garbage))
  (alu (func md) <- (active 0) setl (garbage))
  (alu (func vma-start-write) <- (active 2) setl (garbage))
  (alu (func md) <- (active 1) setl (garbage))
  (alu (func vma-start-write) <- (func vma) add (constant 1))
  (alu (func md) <- (func vma) add (constant 1))
  (alu (func vma-start-write) <- (constant *free-pointer*) setl (garbage))
  (return-xct-next)
 (alu (func return) <- (active 2) or (constant #.(dpb dtp-list %%q-data-type 0)))
  )

(define-asm car (cons)
  (alu (func vma-start-read) <- (active 0) setl (garbage))
  (return-xct-next)
 (alu (active 0) <- (func md) setl (garbage)))

(define-asm cdr (cons)
  (alu (func vma-start-read) <- (active 0) add (constant 1))
  (return-xct-next)
 (alu (active 0) <- (func md) setl (garbage)))

(define-asm = (A B)
  (alu (garbage) <- (active 0) sub (active 1))
  (jump equal yes)
  (return-xct-next)
  (alu (func return) <- (constant 'nil) setl (garbage))
yes
  (return-xct-next)
  (alu (func return) <- (constant 't) setl (garbage))
  )