; altair.lsp
(setq MAX_MEMORY 65536)
(setq ginstrflush 0)
(DEFUN nl () (string (code-char 10)))
(DEFUN cr () (string (code-char 13)))
(DEFUN quality (apart bpart)
    (eval (read-from-string (CONCATENATE'STRING apart "_" bpart)))
)
(DEFUN is-quality (apart bpart) 
    (boundp (read-from-string (CONCATENATE'STRING apart "_" bpart)))
)
(DEFUN set-quality (apart bpart val)
    (set (read-from-string (CONCATENATE'STRING apart "_" bpart)) val)
)
(DEFUN [] (ary i) (car (nthcdr i ary)))
(DEFUN []= (ary i v) (setf (car (nthcdr i ary)) v))
(DEFUN ltoa (v b) (write-to-string v :base b))
(DEFUN chr (v) (string (code-char v)))
(DEFUN asc (v) (char-code v))
(DEFUN div (a b) (floor (/ a b)))
(DEFUN oct-to-str (v len)
    (setq _oct-to-str_ret (write-to-string v :base 8))
    (loop while (< (length _oct-to-str_ret) len) do (setq _oct-to-str_ret (CONCATENATE'STRING "0" _oct-to-str_ret)))
    _oct-to-str_ret
)
(DEFUN hex (v)
    (setq _hex_ret 0 _hex_i 0)
    (loop while (< _hex_i (length v)) do
        (setq ch (asc (char v _hex_i)))
        (cond
            ((and (>= ch 48) (<= ch 57))
                (setq _hex_ret (* _hex_ret 16))
                (setq _hex_ret (+ _hex_ret (- ch 48)))
                (setq _hex_i (+ _hex_i 1))
            )
            ((and (>= ch 65) (<= ch 70))
                (setq _hex_ret (* _hex_ret 16))
                (setq _hex_ret (+ _hex_ret (- ch 55)))
                (setq _hex_i (+ _hex_i 1))
            )
            ((and (>= ch 97) (<= ch 102))
                (setq _hex_ret (* _hex_ret 16))
                (setq _hex_ret (+ _hex_ret (- ch 87)))
                (setq _hex_i (+ _hex_i 1))
            )
            (t (setq _hex_i (length v)))
        )
    )
    _hex_ret
)
(DEFUN comment (pc comstr)
    (set-quality "comment" (ltoa pc 10) comstr)
)
(DEFUN reg (name) 
    (quality "areg" name)
)
(DEFUN set-reg (name val)
    (set-quality "areg" name (mod val 256))
)
(DEFUN set-mem (addr data)
    (setf (aref gmemory (logand 65535 addr)) data)
)
(DEFUN myputs (str) (format t str))
(defvar pc 0)
(defvar sp 0)
(defvar gcinstr 0)
(defvar fflushneeded nil)
(defvar gfcharprinted nil)
(defvar fexecution nil)
(defvar alasttopstatus '(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1))
(defvar alastbotstatus '(-1 -1))
(defvar alastsense '(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1))
(defvar alastaddr '(-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1))
(defvar alastdata '(-1 -1 -1 -1 -1 -1 -1 -1))
(defvar gmemory (make-array '(65536)))
(defvar acachebmps (make-list 10))
(myputs (CONCATENATE'STRING "Fo 0 88 3" (nl) "Fo 2 128 3" (nl) "Fo 1 128 3" (nl) "Fo 3 128 3" (nl)))
(defvar gfnotexit t)
(defvar gfverbose nil)
(defvar ginputbuffer nil)
(setq LEDstr "21a6b9a8b7a5B5a6B4a5bC5b3a5bDC5bA4bc3dc5bA4bCdC5bA5b3c6b3a6B4a6B5a5B7a8b9a5b22a")
(setq centerSWstr "41a15b8Ab5c6daCb8AbC3d5cD3cb7AbCd3c5eCdCb7Abcdc8fEcDcb6Abcdc11fecDb11abcdc13fecdcb5Abcdc7FCdb9abcdc15fecdcb8abcdc8Fecdb7abcdc8f3e6fecdcb6abcdc8f3de5fecdcb5abCdc7fcdcDe4fecdCb4abcdc7fcb3cDe3fEcdcb3abCdc6fc3b3cDeFEcdCbAbCdc6f4b3cDeFEcdCb3abcdc6f5bc3deFEcdCb3abCdc6fcBc3de3fEcdcb5abcdc7f5de4f3eCb6abdc7fe3de5fEcdb7abcdc7f3e6fecdcb8abdc15fEcdb9abcdc7Fecdcb5Abdc13fEcdb11abcdc11fEcdcb6Abcdc9fEcDb13abCdC7eCdCb7AbCD7cDCb15ab4c7d4cb8A15b40a")
(setq downSWstr "41a15b8Ab5c6daCb8AbC3d5cD3cb7AbCd3c5eCdCb7Abcdc8fEcDcb6Abcdc11fecDb11abcdc13fecdcb5Abcdc7FCdb9abcdc15fecdcb8abcdc8Fecdb7abcdc17fecdcb6abcdc17fecdcb5abCdc8fede6fecdCb4abcdc8fe3de5fEcdcb3abCdc7fEdcde5fEcdCbAbCdc7fedCdE4fEcdCb3abcdc7fedbcDe4fEcdCb3abCdc6fDbcDe4fEcdcb5abcdc7fdBcd5f3eCb6abdc7fdcbcd5fEcdb7abcdc6fdBC5fecdcb8abdc5fdc3bc4fEcdb9abcdc5fc3bc4fecdcb5Abdc5fc3bc3fEcdb11abcdc4fcBCFEcdcb6Abcdc4f3cFEcDb13abCdC7eCdCb7AbCD7cDCb15ab4c7d4cb8A15b40a")
(setq upSWstr "6AdC3bcd21a3bdc5bcd3b8Ab3cdc5bdaCb8AbCDc5bD3cb7AbCdcdc5bdcdCb7AbcdceDc3bcdecDcb6Abcdc3edc3bcFecDb11abcdc4edc3bc3eecdcb5Abcdc5eCBc4eCdb9abcdc6ed3bc4eecdcb8abcdc6ed3bd5eecdb7abcdc7edcbcd5eecdcb6abcdc7edBcd5eecdcb5abCdc7edBc6eecdCb4abcdc8eDbce5eEcdcb3abCdc7eeDCe5eEcdCbAbCdc7eEdcde5eEcdCb3abcdc7e3ede6eEcdCb3abCdc7e4e6eEcdcb5abcdc17e3eCb6abdc17eEcdb7abcdc8Fecdcb8abdc15eEcdb9abcdc7Fecdcb5Abdc13eEcdb11abcdc11eEcdcb6Abcdc9eEcDb13abCdC7eCdCb7AbCD7cDCb15ab4c7d4cb8A15b40a")

(set-reg "A" 0) (set-reg "B" 0) (set-reg "C" 0) (set-reg "D" 0) (set-reg "E" 0) (set-reg "H" 0) (set-reg "L" 0) (set-reg "S" 0) (set-reg "P" 0)
(dotimes (i MAX_MEMORY) (setf (aref gmemory i) 0))
(setq pc 0 ginputbuffer "")
(DEFUN init ()
    (setq _init_stream (open "basic.lst"))
    (setq _init_line (read-line _init_stream nil))
    (loop while _init_line
        do
        (setq _init_len (length _init_line))
        (cond
            ((and (>= _init_len 8) (string= (char _init_line 4) ":"))
                (setq pc (hex (subseq _init_line 0 4)) _init_i 6)
                (setq commentpc pc)
                (loop while (and (< _init_i _init_len) (> (asc (char _init_line _init_i)) 32)) do
                    (setq _init_val (hex (subseq _init_line _init_i (+ _init_i 2))))
                    (set-mem pc _init_val)
                    (setq pc (+ pc 1) _init_i (+ _init_i 2))
                )
                (loop while (and (< _init_i _init_len) (not (string= (char _init_line _init_i) (chr 9)))) do (setq _init_i (+ _init_i 1)))
                (cond ((and (< _init_i _init_len) (string= (char _init_line _init_i) (chr 9))) (comment commentpc (subseq _init_line _init_i _init_len))))
            )
        )
        (setq _init_line (read-line _init_stream nil))
    )
    (close _init_stream)
)
(init)
(setq pc 0)
(defvar ipc 0)
(defvar topsw (+ 128 32 2))
(defvar botsw 0)
(DEFUN mem (addr) (aref gmemory (logand 65535 addr)))
(DEFUN pc++ () (setq pc (logand 65535 (+ pc 1))))
(DEFUN pc+2 () (setq pc (logand 65535 (+ pc 2))))
(DEFUN pc+3 () (setq pc (logand 65535 (+ pc 3))))
(DEFUN spc++ () (setq sp (logand 65535 (+ sp 1))))
(DEFUN sp-- () (setq sp (logand 65535 (+ sp 65535))))
(DEFUN stdinQUERY_REMOTE () (myputs (CONCATENATE'STRING "Rz 1600 658" (nl))))
(DEFUN pop8 () (setq sp (pairs "S" "P") _pop8_val (mem sp)) (spc++) (set-pairs "S" "P" sp) _pop8_val)
(DEFUN push8 (val)
    (setq sp (pairs "S" "P"))
    (sp--)
    (set-mem sp (logand val 255))
    (set-pairs "S" "P" sp)
)
(DEFUN push16 (val) (push8 (div val 256)) (push8 (mod val 256)))
(DEFUN d8 () (oct-to-str (mem (+ pc 1)) 3))
(DEFUN d16 () (CONCATENATE'STRING (oct-to-str (mem (+ pc 2)) 3) ":" (oct-to-str (mem (+ pc 1)) 3)))
(DEFUN set-pairs (r1 r2 val) (set-reg r1 (div val 256)) (set-reg r2 (mod val 256)))
(DEFUN pairs (r1 r2) (+ (* 256 (reg r1)) (reg r2)))
(defvar step-instr '(
 (pc++) (LXI "B" "C") (STAX "B" "C") (INX "B" "C") (INR "B") (DCR "B") (MVI "B") (RLC) (pc++) (DAD "B" "C") (LDAX "B" "C") (DCX "B" "C") (INR "C") (DCR "C") (MVI "C") (RRC)
 (pc++) (LXI "D" "E") (STAX "D" "E") (INX "D" "E") (INR "D") (DCR "D") (MVI "D") (RAL) (pc++) (DAD "D" "E") (LDAX "D" "E") (DCX "D" "E") (INR "E") (DCR "E") (MVI "E") (RAR)
 (pc++) (LXI "H" "L") (SHLD) (INX "H" "L") (INR "H") (DCR "H") (MVI "H") (DAA) (pc++) (DAD "H" "L") (LHLD) (DCX "H" "L") (INR "L") (DCR "L") (MVI "L") (CMA)
 (pc++) (LXI "S" "P") (STA) (INX "S" "P") (INRM) (DCRM) (MVIM) (STC) (pc++) (DAD "S" "P") (LDA) (DCX "S" "P") (INR "A") (DCR "A") (MVI "A") (CMC)
 (MOV "B" "B") (MOV "B" "C") (MOV "B" "D") (MOV "B" "E") (MOV "B" "H") (MOV "B" "L") (MOV "B" "m") (MOV "B" "A")
 (MOV "C" "B") (MOV "C" "C") (MOV "C" "D") (MOV "C" "E") (MOV "C" "H") (MOV "C" "L") (MOV "C" "m") (MOV "C" "A")
 (MOV "D" "B") (MOV "D" "C") (MOV "D" "D") (MOV "D" "E") (MOV "D" "H") (MOV "D" "L") (MOV "D" "m") (MOV "D" "A")
 (MOV "E" "B") (MOV "E" "C") (MOV "E" "D") (MOV "E" "E") (MOV "E" "H") (MOV "E" "L") (MOV "E" "m") (MOV "E" "A")
 (MOV "H" "B") (MOV "H" "C") (MOV "H" "D") (MOV "H" "E") (MOV "H" "H") (MOV "H" "L") (MOV "H" "m") (MOV "H" "A")
 (MOV "L" "B") (MOV "L" "C") (MOV "L" "D") (MOV "L" "E") (MOV "L" "H") (MOV "L" "L") (MOV "L" "m") (MOV "L" "A")
 (MOV "m" "B") (MOV "m" "C") (MOV "m" "D") (MOV "m" "E") (MOV "m" "H") (MOV "m" "L") (HLT) (MOV "m" "A")
 (MOV "A" "B") (MOV "A" "C") (MOV "A" "D") (MOV "A" "E") (MOV "A" "H") (MOV "A" "L") (MOV "A" "m") (MOV "A" "A")
 (ADD "B") (ADD "C") (ADD "D") (ADD "E") (ADD "H") (ADD "L") (ADD "m") (ADD "A") (ADC "B") (ADC "C") (ADC "D") (ADC "E") (ADC "H") (ADC "L") (ADC "m") (ADC "A")
 (SUB "B") (SUB "C") (SUB "D") (SUB "E") (SUB "H") (SUB "L") (SUB "m") (SUB "A") (SBB "B") (SBB "C") (SBB "D") (SBB "E") (SBB "H") (SBB "L") (SBB "m") (SBB "A")
 (ANA "B") (ANA "C") (ANA "D") (ANA "E") (ANA "H") (ANA "L") (ANA "m") (ANA "A") (XRA "B") (XRA "C") (XRA "D") (XRA "E") (XRA "H") (XRA "L") (XRA "m") (XRA "A")
 (ORA "B") (ORA "C") (ORA "D") (ORA "E") (ORA "H") (ORA "L") (ORA "m") (ORA "A") (CMPA "B") (CMPA "C") (CMPA "D") (CMPA "E") (CMPA "H") (CMPA "L") (CMPA "m") (CMPA "A")
 (R "Z" 0) (MYPOP "B" "C") (J "Z" 0) (J t 1) (C "Z" 0) (MYPUSH "B" "C") (ADI) (RST 0) (R "Z" 1) (R t 1) (J "Z" 1) (J t 1) (C "Z" 1) (C t 1) (ACI) (RST 1)
 (R "C" 0) (MYPOP "D" "E") (J "C" 0) (OUT) (C "C" 0) (MYPUSH "D" "E") (SUI) (RST 2) (R "C" 1) (R t 1) (J "C" 1) (IN) (C "C" 1) (C t 1) (SBI) (RST 3)
 (R "P" 0) (MYPOP "H" "L") (J "P" 0) (XTHL) (C "P" 0) (MYPUSH "H" "L") (ANI) (RST 4) (R "P" 1) (PCHL) (J "P" 1) (XCHG) (C "P" 1) (C t 1) (XRI) (RST 5)
 (R "S" 0) (POPPSW) (J "S" 0) (DI) (C "S" 0) (PUSHPSW) (ORI) (RST 6) (R "S" 1) (SPHL) (J "S" 1) (EI) (C "S" 1) (C t 1) (CPI) (RST 7))
)
(setq showinstr '(
    "NOP" (CONCATENATE'STRING "LXI BC," (d16)) "STAX [BC]<=A" "INX BC" "INR B" "DCR B" (CONCATENATE'STRING "MVI B," (d8)) "RLC" "*NOP" "DAD BC" "LDAX B" "DCX BC" "INR C" "DCR C" (CONCATENATE'STRING "MVI C," (d8)) "RRC"
    "*NOP" (CONCATENATE'STRING "LXI DE," (d16)) "STAX [DE]<=A" "INX DE" "INR D" "DCR D" (CONCATENATE'STRING "MVI D," (d8)) "RAL" "*NOP" "DAD DE" "LDAX D" "DCX DE" "INR E" "DCR E" (CONCATENATE'STRING "MVI E," (d8)) "RAR"
    "*NOP" (CONCATENATE'STRING "LXI HL," (d16)) (CONCATENATE'STRING "SHLD " (d16)) "INX HL" "INR H" "DCR H" (CONCATENATE'STRING "MVI H," (d8)) "DAA" "*NOP" "DAD HL" (CONCATENATE'STRING "LHLD HL" (d16)) "DCX HL" "INR L" "DCR L" (CONCATENATE'STRING "MVI L," (d8)) "CMA"
    "*NOP" (CONCATENATE'STRING "LXI SP," (d16)) "STA" "INX SP" "INR [HL]" "DCR [HL]" (CONCATENATE'STRING "MVI [HL]," (d8)) "STC" "*NOP" "DAD SP" "LDA" "DCX SP" "INR A" "DCR A" (CONCATENATE'STRING "MVI A," (d8)) "CMC"
    "MOV B,B" "MOV B,C" "MOV B,D" "MOV B,E" "MOV B,H" "MOV B,L" "MOV B,M" "MOV B,A" "MOV C,B" "MOV C,C" "MOV C,D" "MOV C,E" "MOV C,H" "MOV C,L" "MOV C,M" "MOV C,A"
    "MOV D,B" "MOV D,C" "MOV D,D" "MOV D,E" "MOV D,H" "MOV D,L" "MOV D,M" "MOV D,A" "MOV E,B" "MOV E,C" "MOV E,D" "MOV E,E" "MOV E,H" "MOV E,L" "MOV E,M" "MOV E,A"
    "MOV H,B" "MOV H,C" "MOV H,D" "MOV H,E" "MOV H,H" "MOV H,L" "MOV H,M" "MOV H,A" "MOV L,B" "MOV L,C" "MOV L,D" "MOV L,E" "MOV L,H" "MOV L,L" "MOV L,M" "MOV L,A"
    "MOV M,B" "MOV M,C" "MOV M,D" "MOV M,E" "MOV M,H" "MOV M,L" "HLT" "MOV M,A" "MOV A,B" "MOV A,C" "MOV A,D" "MOV A,E" "MOV A,H" "MOV A,L" "MOV A,M" "MOV A,A"
    "ADD B" "ADD C" "ADD D" "ADD E" "ADD H" "ADD L" "ADD M" "ADD A" "ADC B" "ADC C" "ADC D" "ADC E" "ADC H" "ADC L" "ADC M" "ADC A"
    "SUB B" "SUB C" "SUB D" "SUB E" "SUB H" "SUB L" "SUB M" "SUB A" "SBB B" "SBB C" "SBB D" "SBB E" "SBB H" "SBB L" "SBB M" "SBB A"
    "ANA B" "ANA C" "ANA D" "ANA E" "ANA H" "ANA L" "ANA M" "ANA A" "XRA B" "XRA C" "XRA D" "XRA E" "XRA H" "XRA L" "XRA M" "XRA A"
    "ORA B" "ORA C" "ORA D" "ORA E" "ORA H" "ORA L" "ORA M" "ORA A" "CMP B" "CMP C" "CMP D" "CMP E" "CMP H" "CMP L" "CMP M" "CMP A"
    "RNZ" "POP B" (CONCATENATE'STRING "JNZ " (d16)) (CONCATENATE'STRING "JMP " (d16)) (CONCATENATE'STRING "CNZ " (d16)) "PUSH B" (CONCATENATE'STRING "ADI " (d8)) "RST $0" "RZ" "RET" (CONCATENATE'STRING "JZ " (d16)) (CONCATENATE'STRING "*JMP " (d16)) (CONCATENATE'STRING "CZ " (d16)) (CONCATENATE'STRING "CALL " (d16)) (CONCATENATE'STRING "ACI " (d8)) "RST $1"
    "RNC" "POP D" (CONCATENATE'STRING "JNC " (d16)) (CONCATENATE'STRING "OUT " (d8)) (CONCATENATE'STRING "CNC " (d16)) "PUSH D" (CONCATENATE'STRING "SUI " (d8)) "RST $2" "RC" "*RET" (CONCATENATE'STRING "JC " (d16)) (CONCATENATE'STRING "IN " (d8)) (CONCATENATE'STRING "CC " (d16)) (CONCATENATE'STRING "*CALL " (d16)) (CONCATENATE'STRING "SBI " (d8)) "RST $3"
    "RPO" "POP H" (CONCATENATE'STRING "JPO " (d16)) "XTHL" (CONCATENATE'STRING "CPO " (d16)) "PUSH H" (CONCATENATE'STRING "ANI " (d8)) "RST $4" "RPE" "PCHL" (CONCATENATE'STRING "JPE " (d16)) "XCHG" (CONCATENATE'STRING "CPE " (d16)) (CONCATENATE'STRING "*CALL " (d16)) (CONCATENATE'STRING "XRI " (d8)) "RST $5"
    "RP" "POP PSW" (CONCATENATE'STRING "JP " (d16)) "DI" (CONCATENATE'STRING "CP " (d16)) "PUSH PSW" (CONCATENATE'STRING "ORI " (d8)) "RST $6" "RM" "SPHL" (CONCATENATE'STRING "JM " (d16)) "EI" (CONCATENATE'STRING "CM " (d16)) (CONCATENATE'STRING "*CALL " (d16)) (CONCATENATE'STRING "CPI " (d8)) "RST $7")
)
(DEFUN LXI (r1 r2)
    (set-reg r2 (mem (+ pc 1)))
    (set-reg r1 (mem (+ pc 2)))
    (pc+3)
)
(DEFUN STAX (r1 r2)
    (set-mem (pairs r1 r2) (reg "A"))
    (pc++)
)
(DEFUN INX (r1 r2)
    (set-pairs r1 r2 (+ (pairs r1 r2) 1))
    (pc++)
)
(DEFUN INR (r)
    (set-reg r (setflags8 "SZAP" (reg r) (+ (reg r) 1)))
    (pc++)
)
(DEFUN DCR (r)
    (set-reg r (setflags8 "SZAP" (reg r) (+ (reg r) 255)))
    (pc++)
)
(DEFUN MVI (r)
    (set-reg r (mem (+ pc 1)))
    (pc+2)
)
(DEFUN RLC ()
    (setq _RLC_tmp (reg "A"))
    (set-flag "C" (div _RLC_tmp 128))
    (set-reg "A" (+ (* 2 (reg "A")) (flag "C")))
    (pc++)
)
(DEFUN RRC ()
    (setq _RRC_tmp (reg "A"))
    (set-flag "C" (mod _RRC_tmp 2))
    (set-reg "A" (+ (div (reg "A") 2) (* 128 (flag "C"))))
    (pc++)
)
(DEFUN RAL ()
    (setq _RAL_tmp (flag "C"))
    (set-flag "C" (div (reg "A") 128))
    (set-reg "A" (logior (* (reg "A") 2) _RAL_tmp))
    (pc++)
)
(DEFUN RAR ()
    (setq _RAR_tmp (* 128 (flag "C")))
    (set-flag "C" (mod (reg "A") 2))
    (set-reg "A" (logior (div (reg "A") 2) _RAR_tmp))
    (pc++)
)
(DEFUN DAD (r1 r2)
    (setq _DAD_hl (pairs "H" "L") _DAD_xy (pairs r1 r2))
    (set-pairs "H" "L" (setflags16 "C" _DAD_hl (+ _DAD_hl _DAD_xy)))
    (pc++)
)
(DEFUN DAA ()
    (setq _DAA_lnib (mod (reg "A") 16) _DAA_unib (div (reg "A") 16)) 
    (cond
        ((or (> _DAA_lnib 9) (= 1 (flag "A"))) (setq _DAA_lnib (+ _DAA_lnib 6)))
        (t (set-flag "A" 0))
    )
    (cond
        ((> _DAA_lnib 15)
            (setq _DAA_unib (+ _DAA_unib 1) _DAA_lnib (mod _DAA_lnib 16))
        )
    )
    (cond
        ((or (> _DAA_unib 9) (= 1 (flag "A"))) (setq _DAA_unib (+ _DAA_unib 6)))
        (t (set-flag "C" 0))
    )
    (cond
        ((> _DAA_unib 15)
            (set-flag "C" 1)
            (setq _DAA_unib (mod _DAA_unib 16))
        )
    )
    (set-reg "A" (+ (* 16 _DAA_unib) _DAA_lnib))
    (pc++)
)
(DEFUN LDAX (r1 r2)
    (set-reg "A" (mem (pairs r1 r2)))
    (pc++)
)
(DEFUN DCX (r1 r2)
    (set-pairs r1 r2 (+ (pairs r1 r2) 65535))
    (pc++)
)
(DEFUN SHLD ()
    (setq _shld_adr (+ (* 256 (mem (+ pc 2))) (mem (+ pc 1))))
    (set-mem _shld_adr (reg "L"))
    (setq _shld_adr (logand 65535 (+ _shld_adr 1)))
    (set-mem _shld_adr (reg "H"))
    (pc+3)
)
(DEFUN LHLD ()
    (setq _LHLD_adr (+ (* 256 (mem (+ pc 2))) (mem (+ pc 1))))
    (set-reg "L" (mem _LHLD_adr))
    (setq _LHLD_adr (logand 65535 (+ _LHLD_adr 1)))
    (set-reg "H" (mem _LHLD_adr))
    (pc+3)
)
(DEFUN STA ()
    (setq _STA_adr (+ (* 256 (mem (+ pc 2))) (mem (+ pc 1))))
    (set-mem _STA_adr (reg "A"))
    (pc+3)
)
(DEFUN LDA ()
    (setq _LDA_adr (+ (* 256 (mem (+ pc 2))) (mem (+ pc 1))))
    (set-reg "A" (mem _LDA_adr))
    (pc+3)
)
(DEFUN INRM ()
    (setq _INRM_adr (pairs "H" "L"))
    (set-mem _INRM_adr (setflags8 "SZAP" (mem _INRM_adr) (+ (mem _INRM_adr) 1)))
    (pc++)
)
(DEFUN DCRM ()
    (setq _DCRM_adr (pairs "H" "L"))
    (set-mem _DCRM_adr (setflags8 "SZAP" (mem _DCRM_adr) (+ (mem _DCRM_adr) 255)))
    (pc++)
)
(DEFUN MVIM ()
    (setq _MVIM_adr (pairs "H" "L"))
    (set-mem _MVIM_adr (mem (+ pc 1)))
    (pc+2)
)
(DEFUN CMA ()
    (set-reg "A" (- 255 (reg "A")))
    (pc++)
)
(DEFUN CMC ()
    (set-flag "C" (- 1 (flag "C")))
    (pc++)
)
(DEFUN HLT ()
    (aftertesting fexecution nil)
    (pc++)
)
(DEFUN STC ()
    (set-flag "C" 1)
    (pc++)
)
(DEFUN MOV (dest src)
    (cond
        ((string= src "m") (setq _MOV_src (mem (pairs "H" "L"))))
        (t (setq _MOV_src (reg src)))
    )
    (cond
        ((string= dest "m") (set-mem (pairs "H" "L") _MOV_src))
        (t (set-reg dest _MOV_src))
    )
    (pc++)
)
(DEFUN RET ()
    (setq sp (pairs "S" "P"))
    (setq pc (mem sp))
    (setq sp (+ sp 1))
    (setq pc (logand 65535 (+ (* 256 (mem sp)) pc)))
    (setq sp (+ sp 1))
    (set-pairs "S" "P" sp)
)
(DEFUN JMP ()
   (setq pc (+ (* 256 (mem (+ 2 pc))) (mem (+ 1 pc))))
)
(DEFUN CALL ()
    (push16 (+ 3 pc))
    (JMP)
)
(DEFUN R (test tc)
    (cond
        ((= (flag test) tc) (RET))
        (t (pc++))
    )
)
(DEFUN J (test tc)
    (cond
        ((= (flag test) tc) (JMP))
        (t (pc+3))
    )
)
(DEFUN C (test tc)
    (cond
        ((= (flag test) tc) (CALL))
        (t (pc+3))
    )
)
;Optimize the following
(DEFUN ADI ()
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (+ (mem (+ pc 1)) (reg "A"))))
    (pc+2)
)
(DEFUN SUI ()
    (set-reg "A" (setflags8 "SZAP-" (reg "A") (+ (- 255 (mem (+ pc 1))) (reg "A") 1)))
    (pc+2)
)
(DEFUN ACI ()
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (+ (mem (+ pc 1)) (reg "A") (flag "C"))))
    (pc+2)
)
(DEFUN SBI ()
    (set-reg "A" (setflags8 "SZAP-" (reg "A") (+ (- 255 (mem (+ pc 1))) (- 1 (flag "C")) (reg "A"))))
    (pc+2)
)
(DEFUN ADD (src)
    (cond
        ((string= src "m") (setq src (mem (pairs "H" "L"))))
        (t (setq src (reg src)))
    )
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (+ (reg "A") src)))
    (pc++)
)
(DEFUN ADC (src)
    (cond
        ((string= src "m") (setq src (mem (pairs "H" "L"))))
        (t (setq src (reg src)))
    )
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (+ (reg "A") src (flag "C"))))
    (pc++)
)
(DEFUN SUB (src)
    (cond
        ((string= src "m") (setq src (mem (pairs "H" "L"))))
        (t (setq src (reg src)))
    )
    (set-reg "A" (setflags8 "SZAP-" (reg "A") (+ (reg "A") (- 255 src) 1)))
    (pc++)
)
(DEFUN SBB (src)
    (cond
        ((string= src "m") (setq src (mem (pairs "H" "L"))))
        (t (setq src (reg src)))
    )
    (set-reg "A" (setflags8 "SZAP-" (reg "A") (+ (reg "A") (- 255 src) (- 1 (flag "C")))))
    (pc++)
)
(DEFUN ANA (src)
    (cond
        ((string= src "m") (setq src (mem (pairs "H" "L"))))
        (t (setq src (reg src)))
    )
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (logand (reg "A") src)))
    (pc++)
)
(DEFUN XRA (src)
    (cond
        ((string= src "m") (setq src (mem (pairs "H" "L"))))
        (t (setq src (reg src)))
    )
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (logxor (reg "A") src)))
    (pc++)
)
(DEFUN ORA (src)
    (cond
        ((string= src "m") (setq src (mem (pairs "H" "L"))))
        (t (setq src (reg src)))
    )
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (logior (reg "A") src)))
    (pc++)
)
(DEFUN ANI ()
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (logand (reg "A") (mem (+ 1 pc)))))
    (pc+2)
)
(DEFUN ORI ()
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (logior (reg "A") (mem (+ 1 pc)))))
    (pc+2)
)
(DEFUN XRI ()
    (set-reg "A" (setflags8 "SZAPC" (reg "A") (logxor (reg "A") (mem (+ 1 pc)))))
    (pc+2)
)
(DEFUN CPI ()
    (setflags8 "SZAP-" (reg "A") (+ (reg "A") (- 255 (mem (+ 1 pc))) 1))
    (pc+2)
)
(DEFUN CMPA (src)
    (cond
        ((string= src "m") (setq src (mem (pairs "H" "L"))))
        (t (setq src (reg src)))
    )
    (setflags8 "SZAP-" (reg "A") (+ (reg "A") (- 255 src) 1))
    (pc++)
)
(DEFUN MYPUSH (r1 r2)
    (push8 (reg r1))
    (cond
        (r2 (push8 (reg r2)))
    )
    (pc++)
)
(DEFUN MYPOP (r1 r2)
    (cond
        (r2 (set-reg r2 (pop8)))
    )
    (set-reg r1 (pop8))
    (pc++)
)
(DEFUN RST (x)
    (push16 (+ 1 pc))
    (setq pc (* 8 x))
)
(DEFUN DI () (pc++))
(DEFUN EI () (pc++))
(DEFUN OUT () (setq _OUT_port (mem (+ pc 1)))
    (cond ((or (= _OUT_port 17) (= _OUT_port 19) (= _OUT_port 1))
        (setq _OUT_ch (reg "A"))
        (cond
            ((= _OUT_ch 10) (setq gychar (+ 1 gychar) gxchar 0))
            ((= _OUT_ch 13) (setq gxchar 0))
            ((>= _OUT_ch 32)
                (cond
                    ((> (+ (* gxchar dpx) x1paper) x2paper)
                        (setq gxchar 0 gychar (+ 1 gychar))
                    )
                )
                (cond
                    ((>= (+ (* (- gychar 0) dpy) y1paper) y2paper)
                        (setq gxchar 0 gychar 0)
                        (drawpaper)
                    )
                )
                (myputs (CONCATENATE'STRING "F 3 0" (nl) "L$ 3 " (ltoa (+ x1paper (* gxchar dpx)) 10)
                            " " (ltoa (+ (* (+ 1 gychar) dpy) y1paper) 10) (chr 34) (chr (logand 127 _OUT_ch)) (chr 34) (nl)))
                (myputs (CONCATENATE'STRING "Z " (nl)))
                (setq gxchar (+ 1 gxchar))
            )
        )
        (setq gfcharprinted t))
    )
    (pc+2)
)
(DEFUN IN () (setq _IN_port (mem (+ pc 1)))
    (cond
        ((= _IN_port 0)
            (cond
                ((not gfcharprinted)
                    (set-reg "A" 0) (cond ((= (length ginputbuffer) 0) (set-reg "A" 1)))
                )
                (t
                    (set-reg "A" 128)
                    (cond ((= (length ginputbuffer) 0) (set-reg "A" 129)))
                    (setq gfcharprinted nil)
                )
            )
        )
        ((or (= _IN_port 18) (= _IN_port 20))
            (cond
                ((not gfcharprinted)
                    (set-reg "A" 2) (cond ((= (length ginputbuffer) 0) (set-reg "A" 3)))
                )
                (t (set-reg "A" 0) (setq gfcharprinted nil))))
        ((or (= _IN_port 1) (= _IN_port 19) (= _IN_port 17))
            (cond
                ((= (length ginputbuffer) 1)
                    (setq _IN_ch (asc (char ginputbuffer 0)))
                    (cond ((= _IN_ch 127) (setq _IN_ch 255)))
                    (set-reg "A" _IN_ch)
                    (setq ginputbuffer "")
                )
                ((> (length ginputbuffer) 0)
                    (setq _IN_ch (asc (char ginputbuffer 0)))
                    (cond ((= _IN_ch 127) (setq _IN_ch 255)))
                    (set-reg "A" _IN_ch)
                    (setq ginputbuffer (subseq ginputbuffer 1 (- (length ginputbuffer) 1)))
                )
                (t (set-reg "A" 0))
            )
        )
        ((= _IN_port 255) (set-reg "A" (mod ipc 256)))
    )
    (pc+2)
)
(DEFUN XTHL ()
    (setq sp (pairs "S" "P") _XTHL_tmp (reg "L"))
    (set-reg "L" (mem sp))
    (set-mem sp _XTHL_tmp)
    (spc++)
    (setq _XTHL_tmp (reg "H"))
    (set-reg "H" (mem sp))
    (set-mem sp _XTHL_tmp)
    (pc++)
)
(DEFUN XCHG () (setq _XCHG_tmp (reg "L")) (set-reg "L" (reg "E")) (set-reg "E" _XCHG_tmp) (setq _XCHG_tmp (reg "H")) (set-reg "H" (reg "D")) (set-reg "D" _XCHG_tmp) (pc++))
(DEFUN PCHL () (setq pc (pairs "H" "L")))
(DEFUN SPHL () (set-reg "S" (reg "H")) (set-reg "P" (reg "L")) (pc++))
(DEFUN PUSHPSW ()
    (setq sp (pairs "S" "P"))
    (sp--)
    (set-mem sp (reg "A"))
    (sp--)
    (setq _PUSHPSW_tmp (flag "S") _PUSHPSW_tmp (* 2 _PUSHPSW_tmp))
    (setq _PUSHPSW_tmp (+ _PUSHPSW_tmp (flag "Z")) _PUSHPSW_tmp (* 4 _PUSHPSW_tmp))
    (setq _PUSHPSW_tmp (+ _PUSHPSW_tmp (flag "A")) _PUSHPSW_tmp (* 4 _PUSHPSW_tmp))
    (setq _PUSHPSW_tmp (+ _PUSHPSW_tmp (flag "P")) _PUSHPSW_tmp (* 2 _PUSHPSW_tmp))
    (setq _PUSHPSW_tmp (+ _PUSHPSW_tmp 1) _PUSHPSW_tmp (* 2 _PUSHPSW_tmp))
    (setq _PUSHPSW_tmp (+ _PUSHPSW_tmp (flag "C")))
    (set-mem sp _PUSHPSW_tmp)
    (set-pairs "S" "P" sp)
    (pc++)
)
(DEFUN POPPSW ()
    (setq sp (pairs "S" "P"))
    (setq _POPPSW_tmp (mem sp))
    (set-flag "C" (mod _POPPSW_tmp 2))
    (setq _POPPSW_tmp (div _POPPSW_tmp 4))
    (set-flag "P" (mod _POPPSW_tmp 2))
    (setq _POPPSW_tmp (div _POPPSW_tmp 4))
    (set-flag "A" (mod _POPPSW_tmp 2))
    (setq _POPPSW_tmp (div _POPPSW_tmp 4))
    (set-flag "Z" (mod _POPPSW_tmp 2))
    (setq _POPPSW_tmp (div _POPPSW_tmp 2))
    (set-flag "S" (mod _POPPSW_tmp 2))
    (spc++)
    (set-reg "A" (mem sp))
    (spc++)
    (set-pairs "S" "P" sp)
    (pc++)
)
(DEFUN flag (name)
    (cond
        ((stringp name) (quality "aflag" name))
        (t 1)
    )
)
(DEFUN set-flag (name val) (set-quality "aflag" name val))
(set-flag "S" 0) (set-flag "Z" 0) (set-flag "A" 0) (set-flag "P" 0) (set-flag "C" 0) ; Initializers
(setq dpy 128 dpx (div (+ 1 (* 3 dpy)) 5) y1paper 128 y2paper (+ y1paper (* dpy 30)) x2paper 9900 x1paper (- x2paper (* 66 dpx)) senseSWy 3050 centerSWy 3580 gxchar 0 gychar 0)
(setq LXIreg "BCDEHLSs" MOVreg "BCDEHLmA" abottext (list "HLDA" "WAIT") atoptext (list "INT" "WO" "STACK" "HLTA" "OUT" "MI" "INP" "MEMR" "PROT" "INTR"))
(setq acentertext (list '("Aux 1." "") '("Aux 2." "") '("Protect" "Unprotect") '("Reset" "Clr") '("Deposit" "Next") '("Examine" "Next") '("Single" "Step") '("Stop" "Run") '("On" "Off")))
(DEFUN senseSWx (i) (- 4619 (+ (* (div i 3) 759) (* (mod i 3) 221))))
(DEFUN centerSWx (i) (- 4447 (* i 442)))
(DEFUN stdindrawapp () 
    (myputs (CONCATENATE'STRING "B 2 7829367" (nl) "B 0 7829367" (nl) "B 1 7829367" (nl) "B 3 14731686" (nl)))
    (drawpanel)
    (myputs (CONCATENATE'STRING "F 0 16777215" (nl)))
    (setq fflushneeded t)
    (drawdatatexts)
    (drawaddresstexts)
    (drawsensetexts)
    (drawcentertexts)
    (drawtoptexts)
    (drawbottexts)
    (drawdataLEDs (mem pc))
    (drawtopstatusLEDs topsw)
    (drawbotstatusLEDs botsw)
    (drawaddressLEDs pc)
    (drawcenterSWs)
    (drawsenseSWs ipc)
    (drawregisters)
    (drawpaper)
    (myputs (CONCATENATE'STRING "F 1 0" (nl) "L$ 1 1000 300 " (chr 34) "clisp cloud app transparent shell stdinout" (chr 34) (nl)))
    (myputs (CONCATENATE'STRING "Z " (nl)))
)
(DEFUN drawpaper ()
    (myputs (CONCATENATE'STRING "F 2 14731686" (nl) "FR 2 " (ltoa x1paper 10) " " (ltoa y1paper 10) " " (ltoa x2paper 10) " " (ltoa y2paper 10) (nl) "F 2 0" (nl)))
)
(DEFUN drawregisterbox (x1 y1 x2 y2)
    (myputs (CONCATENATE'STRING "F 0 3342336" (nl) "R 0 " (ltoa (- x1 20) 10) " " (ltoa (- y1 20) 10) " " (ltoa x2 10) " " (ltoa y2 10) (nl)))
    (myputs (CONCATENATE'STRING "F 0 7829367" (nl) "FR 0 " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) (nl) "F 2 5570560" (nl)))
)
(DEFUN drawregisterA (y)
    (drawregisterbox 530 (floor (* (- y 2.0) 44.2)) 1061 (floor (* y 44.7))) 
    (myputs (CONCATENATE'STRING "L$ 2 530 " (ltoa (floor (* y 44.2)) 10) " " (chr 34) "A:" (oct-to-str (reg "A") 3) (chr 34) (nl)))
)
(DEFUN drawregisterpair (y hi low)
    (drawregisterbox 530 (floor (- (* (+ y 0.5) 44.2) 110.5)) 1697 (floor (* (+ y 0.5) 44.2)))
    (myputs (CONCATENATE'STRING "L$ 2 530 " (ltoa (floor (* y 44.2)) 10) " " (chr 34)  hi ":" (oct-to-str (reg hi) 3) " " low ":" (oct-to-str (reg low) 3) (chr 34) (nl)))
)
(DEFUN drawregistersnp (y label val)
    (drawregisterbox 530 (floor (* (- y 2.0) 44.2)) 1697 (floor (* y 44.7)))
    (myputs (CONCATENATE'STRING "L$ 2 530 " (ltoa (floor (* y 44.2)) 10) " " (chr 34) label ":" (oct-to-str (div val 256) 3) ":" (oct-to-str (mod val 256) 3) (chr 34) (nl)))
)
(DEFUN drawregisterFlags ()
    (drawregisterbox 1238 433 3996 544)
    (myputs (CONCATENATE'STRING "L$ 2 1238 530 " (chr 34) "Flags:" (cond ((= (flag "S") 1) "N-") (t "P+")) ":"
        (cond
            ((= (flag "Z") 1) " Z")
            (t "NZ")
        )
        ":0:"
        (cond
            ((= (flag "A") 1) "AC")
            (t "NA")
        )
        ":0:"
        (cond
            ((= (flag "P") 1) "PE")
            (t "PO")
        )
        ":1:"
        (cond
            ((= (flag "C") 1) "CY")
            (t "NC")
        )
        (chr 34)
        (nl))
    )
)
(DEFUN drawregisters ()
    (drawregisterA 11.80)
    (drawregisterFlags)
    (drawregisterpair (+ 11.80 3.15) "B" "C")
    (drawregisterpair (+ 11.80 (* 2 3.15)) "D" "E")
    (drawregisterpair (+ 11.80 (* 3 3.15)) "H" "L")
    (drawregistersnp (+ 11.80 (* 4 3.15)) "SP" (+ (* (reg "S") 256) (reg "P")))
    (drawregistersnp (+ 11.80 (* 5 3.15)) "PC" pc)
    (show pc)
    (myputs (CONCATENATE'STRING "Z " (nl)))
)

(DEFUN cacheupswitch (x1 y1 x2 y2)
    (cond
        (([] acachebmps 0)
            (myputs (CONCATENATE'STRING "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 0" (nl)))
        )
        (t
            (myputs (CONCATENATE'STRING "Ga " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 0"
                (chr 34) "32 32 =a777=bfff=cbbb=d555=e111=f000 " upSWstr (chr 34) (nl)))
            ([]= acachebmps 0 0)
        )
    )
)

(DEFUN cachedownswitch (x1 y1 x2 y2)
    (cond
        (([] acachebmps 1)
            (myputs (CONCATENATE'STRING "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 1" (nl)))
        )
        (t
            (myputs (CONCATENATE'STRING "Ga " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 1"
        (chr 34) "32 32 =a777=bfff=cbbb=d555=e111=f000 " downSWstr (chr 34) (nl)))
            ([]= acachebmps 1 1)
        )
    )
)

(DEFUN cachecenterswitch (x1 y1 x2 y2)
    (cond
        (([] acachebmps 2)
            (myputs (CONCATENATE'STRING "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 2" (nl)))
        )
        (t
            (myputs (CONCATENATE'STRING "Ga " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 2"
        (chr 34) "32 32 =a777=bfff=cbbb=d555=e111=f000 " centerSWstr (chr 34) (nl)))
            ([]= acachebmps 2 2)
        )
    )
)

(DEFUN cacheledon (x1 y1 x2 y2)
    (cond
        (([] acachebmps 3)
            (myputs (CONCATENATE'STRING "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 3" (nl)))
        )
        (t
            (myputs (CONCATENATE'STRING "Ga " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 3"
        (chr 34) "16 16 =a777=bf00=cf22=df77 " LEDstr (chr 34) (nl)))
            ([]= acachebmps 3 3)
        )
    )
)

(DEFUN cacheledoff (x1 y1 x2 y2)
    (cond
        (([] acachebmps 4)
            (myputs (CONCATENATE'STRING "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 4" (nl)))
        )
        (t
            (myputs (CONCATENATE'STRING "Ga " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 4"
        (chr 34) "16 16 =a777=b300=c422=d533 " LEDstr (chr 34) (nl)))
            ([]= acachebmps 4 4)
        )
    )
)

(DEFUN dispop (opstr instr)
    (drawregisterbox 530 1282 2228 1437)
    (myputs (CONCATENATE'STRING "L$ 2 530 1414 " (chr 34) opstr (chr 34) (nl)))
)

(DEFUN examine ()
    (drawcenterSW (centerSWx 5) centerSWy +1)
    (setq pc ipc)
    (drawaddressLEDs pc)
    (drawdataLEDs (mem pc))
    (drawcenterSW (centerSWx 5) centerSWy 0)
    (drawregisters)
)
(DEFUN examinenext ()
    (drawcenterSW (centerSWx 5) centerSWy -1)
    (pc++)
    (drawaddressLEDs pc)
    (drawdataLEDs (mem pc))
    (drawcenterSW (centerSWx 5) centerSWy 0)
    (drawregisters)
)
(DEFUN deposit ()
    (drawcenterSW (centerSWx 4) centerSWy +1)
    (set-mem pc (mod ipc 256))
    (drawaddressLEDs pc)
    (drawdataLEDs (mem pc))
    (drawcenterSW (centerSWx 4) centerSWy 0)
    (drawregisters)
)
(DEFUN depositnext ()
    (drawcenterSW (centerSWx 4) centerSWy -1)
    (pc++)
    (set-mem pc (mod ipc 256))
    (drawaddressLEDs pc)
    (drawdataLEDs (mem pc))
    (drawcenterSW (centerSWx 4) centerSWy 0)
    (drawregisters)
)
(DEFUN drawcenterSW (x y upcenterdown)
    (cond
        ((= upcenterdown 1) (cacheupswitch x y (+ x 155) (+ y 155)))
        ((= upcenterdown -1) (cachedownswitch x y (+ x 155) (+ y 155)))
        (t (cachecenterswitch x y (+ x 155) (+ y 155)))
    )
)
(DEFUN drawSW (x y onoff)
    (cond
        ((= onoff 0) (cachedownswitch x y (+ x 155) (+ y 155)))
        (t (cacheupswitch x y (+ x 155) (+ y 155)))
    )
)
(DEFUN drawLED (x y onoff)
    (cond
        ((= onoff 0) (cacheledoff x y (+ x 155) (+ y 155)))
        (t (cacheledon x y (+ x 155) (+ y 155)))
    )
)
(DEFUN drawtopstatusLEDs (topstatus)
    (setq _drawtopstatusLEDs_y 1989 _drawtopstatusLEDs_x 2361 _drawtopstatusLEDs_i 0)
    (loop while (< _drawtopstatusLEDs_i 10) do
        (setq _drawtopstatusLEDs_bit (mod topstatus 2))
        (cond
            ((not (= _drawtopstatusLEDs_bit ([] alasttopstatus _drawtopstatusLEDs_i))) (drawLED (- _drawtopstatusLEDs_x (* _drawtopstatusLEDs_i 221)) _drawtopstatusLEDs_y _drawtopstatusLEDs_bit) ([]= alasttopstatus _drawtopstatusLEDs_i _drawtopstatusLEDs_bit)
            )
        )
        (setq topstatus (div topstatus 2))
        (setq _drawtopstatusLEDs_i (+ _drawtopstatusLEDs_i 1))
    )
)
(DEFUN drawbotstatusLEDs (botstatus)
    (setq _drawbotstatusLEDs_i 0)
    (loop while (< _drawbotstatusLEDs_i 2) do
        (setq _drawbotstatusLEDs_bit (mod botstatus 2))
        (cond
            ((not (= _drawbotstatusLEDs_bit ([] alastbotstatus _drawbotstatusLEDs_i)))
                (drawLED (- 593 (* _drawbotstatusLEDs_i 221)) 2519 _drawbotstatusLEDs_bit)
                ([]= alastbotstatus _drawbotstatusLEDs_i _drawbotstatusLEDs_bit)
            )
        )
        (setq botstatus (div botstatus 2) _drawbotstatusLEDs_i (+ _drawbotstatusLEDs_i 1))
    )
)
(DEFUN drawaddresstexts ()
    (setq _drawaddresstexts_i 0)
    (loop while (< _drawaddresstexts_i 16) do
        (myputs (CONCATENATE'STRING "C$ 0 " (ltoa (- 4696 (+ (* (div _drawaddresstexts_i 3) 759) (* (mod _drawaddresstexts_i 3) 221))) 10) " 2458 " (chr 34) "A" (ltoa _drawaddresstexts_i 10) (chr 34) (nl)))
        (setq _drawaddresstexts_i (+ _drawaddresstexts_i 1))
    )
    (setq fflushneeded t)
)
(DEFUN drawsensetexts ()
    (setq _drawsensetexts_i 0)
    (loop while (< _drawsensetexts_i 16) do
        (myputs (CONCATENATE'STRING "C$ 0 " (ltoa (- 4696 (+ (* (div _drawsensetexts_i 3) 759) (* (mod _drawsensetexts_i 3) 221))) 10) " 2989 " (chr 34) (ltoa _drawsensetexts_i 10) (chr 34) (nl)))
        (setq _drawsensetexts_i (+ _drawsensetexts_i 1))
    )
    (setq fflushneeded t)
)
(DEFUN drawtoptexts ()
    (setq _drawtoptexts_i 0)
    (loop while (< _drawtoptexts_i 10) do
        (myputs (CONCATENATE'STRING "C$ 0 " (ltoa (- 2433 (* _drawtoptexts_i 221)) 10) " 1928 " (chr 34) ([] atoptext _drawtoptexts_i) (chr 34) (nl)))
        (setq _drawtoptexts_i (+ _drawtoptexts_i 1))
    )
    (setq fflushneeded t)
)
(DEFUN drawbottexts ()
    (setq _drawbottexts_i 0)
    (loop while (< _drawbottexts_i 2) do
        (myputs (CONCATENATE'STRING "C$ 0 " (ltoa (- 665 (* _drawbottexts_i 221)) 10) " 2458 " (chr 34) ([] abottext _drawbottexts_i) (chr 34) (nl)))
        (setq _drawbottexts_i (+ _drawbottexts_i 1))
    )
    (setq fflushneeded t)
)
(DEFUN drawdatatexts ()
    (setq _drawdatatexts_i 0)
    (loop while (< _drawdatatexts_i 8) do
        (myputs (CONCATENATE'STRING "C$ 0 " (ltoa (- 4696 (+ (* (div _drawdatatexts_i 3) 759) (* (mod _drawdatatexts_i 3) 221))) 10) " 1928 " (chr 34) "D" (ltoa _drawdatatexts_i 10) (chr 34) (nl)))
        (setq _drawdatatexts_i (+ _drawdatatexts_i 1))
    )
    (setq fflushneeded t)
)
(DEFUN drawdataLEDs (data)
    (setq _drawdataLEDs_i 0)
    (loop while (< _drawdataLEDs_i 8) do
        (setq _drawdataLEDs_bit (mod data 2))
        (cond
            ((not (= _drawdataLEDs_bit ([] alastdata _drawdataLEDs_i)))
                (drawLED (- 4619 (+ (* (div _drawdataLEDs_i 3) 759) (* (mod _drawdataLEDs_i 3) 221))) 1989 _drawdataLEDs_bit)
                ([]= alastdata _drawdataLEDs_i _drawdataLEDs_bit)
            )
        )
        (setq _drawdataLEDs_i (+ _drawdataLEDs_i 1))
        (setq data (div data 2))
    )
)
(DEFUN drawaddressLEDs (addr)
    (setq _drawaddressLEDs_i 0)
    (loop while (< _drawaddressLEDs_i 16) do
        (setq _drawaddressLEDs_bit (mod addr 2))
        (cond
            ((not (= _drawaddressLEDs_bit ([] alastaddr _drawaddressLEDs_i)))
                (drawLED (- 4619 (+ (* (div _drawaddressLEDs_i 3) 759) (* (mod _drawaddressLEDs_i 3) 221))) 2519 _drawaddressLEDs_bit)
                ([]= alastaddr _drawaddressLEDs_i _drawaddressLEDs_bit)
            )
        )
        (setq _drawaddressLEDs_i (+ _drawaddressLEDs_i 1))
        (setq addr (div addr 2))
    )
)
(DEFUN drawsenseSWs (sense)
    (setq _drawsenseSWs_i 0)
    (loop while (< _drawsenseSWs_i 16) do
        (setq _drawsenseSWs_bit (mod sense 2))
        (cond
            ((not (= _drawsenseSWs_bit ([] alastsense _drawsenseSWs_i)))
                (drawSW (senseSWx _drawsenseSWs_i) senseSWy _drawsenseSWs_bit)
                ([]= alastsense _drawsenseSWs_i _drawsenseSWs_bit)
            )
        )
        (setq _drawsenseSWs_i (+ _drawsenseSWs_i 1) sense (div sense 2))
    )
)
(DEFUN drawcenterSWs ()
    (setq _drawcenterSWs_i 0)
    (loop while (< _drawcenterSWs_i 9) do
        (drawcenterSW (centerSWx _drawcenterSWs_i) centerSWy 0)
        (setq _drawcenterSWs_i (+ _drawcenterSWs_i 1))
    )
    (drawcenterSW (centerSWx 8) centerSWy 1)
)
(DEFUN drawcentertexts ()
    (setq _drawcentertexts_i 0)
    (loop while (< _drawcentertexts_i 9) do
        (cond
            ((> (length (car ([] acentertext _drawcentertexts_i))) 0)
                (myputs (CONCATENATE'STRING "C$ 0 " (ltoa (- 4519 (* _drawcentertexts_i 442)) 10) " 3519 " (chr 34) (car ([] acentertext _drawcentertexts_i)) (chr 34) (nl)))
                (setq fflushneeded t)
            )
       )
       (cond
           ((> (length (CADR ([] acentertext _drawcentertexts_i))) 0)
               (myputs (CONCATENATE'STRING "C$ 0 " (ltoa (- 4519 (* _drawcentertexts_i 442)) 10) " 3773 " (chr 34) (CADR ([] acentertext _drawcentertexts_i)) (chr 34) (nl)))
               (setq fflushneeded t)
           )
       )
       (setq _drawcentertexts_i (+ _drawcentertexts_i 1))
    )
)
(DEFUN drawpanel ()
    (myputs (CONCATENATE'STRING "F 0 723967" (nl) "FR 0 0 0 10000 4108" (nl) "F 0 7829367" (nl) "FR 0 106 106 9894 4002" (nl)))
    (setq _drawpanel_i 0)
    (loop while (< _drawpanel_i 16) do
        ([]= alastsense _drawpanel_i -1)
        ([]= alastaddr _drawpanel_i -1)
        (setq _drawpanel_i (+ _drawpanel_i 1))
    )
    (setq _drawpanel_i 0)
    (loop while (< _drawpanel_i 8) do
        ([]= alastdata _drawpanel_i -1)
        (setq _drawpanel_i (+ _drawpanel_i 1))
    )
    (setq _drawpanel_i 0)
    (loop while (< _drawpanel_i 2) do
        ([]= alastbotstatus _drawpanel_i -1)
        (setq _drawpanel_i (+ _drawpanel_i 1))
    )
    (setq _drawpanel_i 0)
    (loop while (< _drawpanel_i 10) do
        ([]= alasttopstatus _drawpanel_i -1)
        (setq _drawpanel_i (+ _drawpanel_i 1))
    )
)
(DEFUN show (pc)
    (setq _show_instr (mem pc))
    (dispop (eval (car (nthcdr _show_instr showinstr))) _show_instr)
)
(DEFUN mystep () (eval (car (nthcdr (mem pc) step-instr))))
(DEFUN setflags16 (flagstr preval postval)
    (setq _setflags16_len (length flagstr))
    (cond ((< postval 0) (setq postval (+ 65536 postval))))
    (setq _setflags16_i 0)
    (loop while (< _setflags16_i _setflags16_len) do
        (setq _setflags16_iflag (char flagstr _setflags16_i))
        (cond
            ((string= _setflags16_iflag "S")
                (cond
                    ((= (logand 32768 postval) 0) (set-flag "S" 0))
                    (t (set-flag "S" 1))
                )
            )
            ((string= _setflags16_iflag "C")
                (cond
                    ((= (logand 65536 postval) 0) (set-flag "C" 0))
                    (t (set-flag "C" 1))
                )
            )
            ((string= _setflags16_iflag "Z")
                (cond
                    ((= (logand 65535 postval) 0) (set-flag "Z" 1))
                    (t (set-flag "Z" 0))
                )
            )
            ((string= _setflags16_iflag "P")
                (setq _setflags16_p 0 _setflags16_ip 1)
                (loop while (<= _setflags16_ip 65536) do
                    (cond
                        ((> (logand _setflags16_ip postval) 0) (setq _setflags16_p (+ _setflags16_p 1)))
                    )
                    (setq ip (* _setflags16_2 ip))
                )
                (set-flag "P" (- 1 (mod _setflags16_p 2)))
            )
        )
        (setq _setflags16_i (+ _setflags16_i 1))
    )
    (logand 65535 postval)
)
(DEFUN setflags8 (flagstr preval postval)
    (setq _setflags8_len (length flagstr))
    (cond ((< postval 0) (setq postval (+ 4096 postval))))
    (setq _setflags8_i 0)
    (loop while (< _setflags8_i _setflags8_len) do
            (setq _setflags8_iflag (char flagstr _setflags8_i))
            (cond
                ((string= _setflags8_iflag "S")
                    (cond
                        ((= (logand 128 postval) 0) (set-flag "S" 0))
                        (t (set-flag "S" 1))
                    )
                )
                ((string= _setflags8_iflag "A")
                    (cond
                        ((= (logand 16 postval) (logand 16 preval)) (set-flag "A" 0))
                        (t (set-flag "A" 1))
                    )
                )
                ((string= _setflags8_iflag "C")
                    (cond
                        ((= (logand 256 postval) 0) (set-flag "C" 0))
                        (t (set-flag "C" 1))
                    )
                )
                ((string= _setflags8_iflag "-")
                    (cond
                        ((= (logand 256 postval) 0) (set-flag "C" 1))
                        (t (set-flag "C" 0))
                    ))
                ((string= _setflags8_iflag "Z")
                    (cond
                        ((= (logand 255 postval) 0) (set-flag "Z" 1))
                        (t (set-flag "Z" 0))
                    )
                )
                ((string= _setflags8_iflag "P")
                    (setq _setflags8_p 0 _setflags8_ip 1)
                    (loop while (<= _setflags8_ip 256) do
                        (cond
                            ((> (logand _setflags8_ip postval) 0) (setq _setflags8_p (+ _setflags8_p 1)))
                        )
                        (setq _setflags8_ip (* 2 _setflags8_ip))
                    )
                    (set-flag "P" (- 1 (mod _setflags8_p 2)))
                )
            )
        (setq _setflags8_i (+ _setflags8_i 1))
    )
    (logand 255 postval)
)
(DEFUN OFF ()
    (drawdataLEDs (mem pc))
    (drawtopstatusLEDs topsw)
    (drawbotstatusLEDs botsw)
    (drawaddressLEDs pc)
    (drawsenseSWs ipc)
    (myputs (CONCATENATE'STRING "O 0 0 0" (nl)))
    (setq fflushneeded t gfnotexit nil fnotdone nil)
)
(DEFUN exe (loops)
    (setq _exe_fio nil)
    (loop while (and fexecution (> loops 0)) do
        (cond ((= (mem pc) 211) (setq _exe_fio t)))
        (mystep)
        (setq ginstrflush (+ ginstrflush 1))
        (cond
            ((or (and (= (mem pc) 219)) (> ginstrflush 117) gfverbose)
                (setq _exe_fio t)
                (setq ginstrflush 0)
            )
        )
        (setq loops (- loops 1))
    )
    (cond (_exe_fio (drawdataLEDs (mem pc)) (drawaddressLEDs pc) (drawregisters) (myputs (CONCATENATE'STRING "Z " (nl)))))
)
(DEFUN main-loop ()
    (setq line (cr))
    (loop while gfnotexit
        do
        (setq line (read-char-no-hang))
        (cond (line (setq line (CONCATENATE'STRING (string line) (read-line nil nil nil)))))
        (cond
            ((string= line "drawapp")
                (stdindrawapp)
            )
            ((string= line "QUERY_REMOTE")
                (stdinQUERY_REMOTE)
            )
            (line
                (setq line (eval (read-from-string (CONCATENATE'STRING "(list " line ")"))))
                (setq button (car line) x (CADR line) y (CADDR line))
                (cond 
                    ((= x -2)
                        (cond
                            ((> button 0)
                                (cond
                                    ((stringp ginputbuffer)
                                        (setq ginputbuffer (CONCATENATE'STRING ginputbuffer (chr button)))
                                    )
                                    (t
                                        (setq ginputbuffer (chr button))
                                    )
                                )
                            )
                        )
                    )
                    ((= -4 x) (myputs (CONCATENATE'STRING "Rz " (format nil "~D" button) " " (format nil "~D" y) "~%")))
                    ((= -5 x) (myputs (CONCATENATE'STRING "Mv " (format nil "~D" button) " " (format nil "~D" y) "~%")))
                    ((= x -98) (sleep (/ y 2000)))
                    ((= button 3) (OFF))
                    ((and (> x 0) (> y (- senseSWy 358)) (< y (+ senseSWy 358)))
                        (setq i2 1 fnotdone t i 0)
                        (loop while  (and fnotdone (< i 16)) do
                                (cond ((and (> x (senseSWx i)) (< x (+ (senseSWx i) 221)))
                                (cond ((< y senseSWy) (setq ipc (logior ipc i2) fnotdone nil))
                                        ((and (> y senseSWy) (< y (+ senseSWy 358))) (setq ipc (logand ipc (lognot i2)) fnotdone nil)))))
                            (setq i2 (* i2 2) i (+ i 1)))
                            (cond
                                ((not fnotdone)
                                    (drawsenseSWs ipc)
                                    (myputs (CONCATENATE'STRING "Z " (nl)))
                                )
                            )
                    )
                    ((and (> y (- centerSWy 358)) (< y (+ centerSWy 358)))
                        (setq i2 1 fnotdone t i 0)
                        (loop while (and fnotdone (< i 9)) do
                            (cond ((and (> x (centerSWx i)) (< x (+ (centerSWx i) 221))) (cond ((< y centerSWy) (cond
                                        ((= i 5) (examine)) ((= i 4) (deposit))
                                        ((= i 6) (mystep) (drawdataLEDs (mem pc)) (drawaddressLEDs pc) (drawregisters))
                                        ((= i 7) (setq fexecution nil))) (setq fnotdone nil))
                                    ((and (> y centerSWy) (< y (+ centerSWy 358))) (cond
                                                ((= i 5) (examinenext)) ((= i 4) (depositnext))
                                                ((= i 6) (mystep) (drawdataLEDs (mem pc)) (drawaddressLEDs pc) (drawregisters))
                                                ((= i 7) (setq fexecution t) (mystep) (drawdataLEDs (mem pc)) (drawaddressLEDs pc) (drawregisters))
                                                ((= i 8) (OFF))) (setq fnotdone nil))) (setq fnotdone nil))
                            )
                            (setq i2 (* i2 2) i (+ i 1))
                        )
                        (cond
                            ((not fnotdone)
                                (drawsenseSWs ipc)
                                (myputs (CONCATENATE'STRING "Z " (nl)))
                            )
                        )
                    )
                )
            )
            (fexecution (exe 3000) (myputs (CONCATENATE'STRING "Z " (nl))))
        )
        (cond (fexecution (exe 100) (myputs (CONCATENATE'STRING "Z " (nl)))))
    )
    (exit 0)
)
(main-loop)
(exit 0)