; altair.lsp
(setq acachebmps (array 10) ginstrflush 0)
(de [] (ary i) (car (cndr i ary)))
(de []= (ary i v) (rplaca (cndr i ary) v))
(de pc++ () (setq pc (& 65535 (+ pc 1)))) (de pc+2 () (setq pc (& 65535 (+ pc 2)))) (de pc+3 () (setq pc (& 65535 (+ pc 3))))
(de spc++ () (setq sp (& 65535 (+ sp 1)))) (de sp-- () (setq sp (& 65535 (+ sp 65535))))
(de myputstderr (str) (write 2 str (strlen str))) (de myputs (str) (write 1 str (strlen str)))
(de comment (pc comstr) (quality "comment" (ltoa pc 10) comstr))
(de "stdin.QUERY_REMOTE" (line) (myputs "Rz 1280 528\n") (setq fflushneeded t))
(de pop8 (val sp) (setq sp (pairs "S" "P") val (mem sp)) (spc++) (pairs "S" "P" sp) val)
(de push8 (val sp) (setq sp (pairs "S" "P")) (sp--) (mem sp (& val 255)) (pairs "S" "P" sp))
(de push16 (val sp) (push8 (/ val 256)) (push8 (% val 256)))
(de d8 () (oct (mem (+ pc 1)) 3)) (de d16 () (strcat (oct (mem (+ pc 2)) 3) ":" (oct (mem (+ pc 1)) 3)))
(de pairs (r1 r2 val) (cond ((nilp val) (+ (* 256 (reg r1)) (reg r2))) (t (reg r1 (/ val 256)) (reg r2 (% val 256)))))
(qsetq 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) (POP "B" "C") (J "Z" 0) (J t 1) (C "Z" 0) (PUSH "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) (POP "D" "E") (J "C" 0) (OUT) (C "C" 0) (PUSH "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) (POP "H" "L") (J "P" 0) (XTHL) (C "P" 0) (PUSH "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)))
(qsetq showinstr (
    "NOP" (strcat "LXI BC," (d16)) "STAX [BC]<=A" "INX BC" "INR B" "DCR B" (strcat "MVI B," (d8)) "RLC" "*NOP" "DAD BC" "LDAX B" "DCX BC" "INR C" "DCR C" (strcat "MVI C," (d8)) "RRC"
    "*NOP" (strcat "LXI DE," (d16)) "STAX [DE]<=A" "INX DE" "INR D" "DCR D" (strcat "MVI D," (d8)) "RAL" "*NOP" "DAD DE" "LDAX D" "DCX DE" "INR E" "DCR E" (strcat "MVI E," (d8)) "RAR"
    "*NOP" (strcat "LXI HL," (d16)) (strcat "SHLD " (d16)) "INX HL" "INR H" "DCR H" (strcat "MVI H," (d8)) "DAA" "*NOP" "DAD HL" (strcat "LHLD HL" (d16)) "DCX HL" "INR L" "DCR L" (strcat "MVI L," (d8)) "CMA"
    "*NOP" (strcat "LXI SP," (d16)) "STA" "INX SP" "INR [HL]" "DCR [HL]" (strcat "MVI [HL]," (d8)) "STC" "*NOP" "DAD SP" "LDA" "DCX SP" "INR A" "DCR A" (strcat "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" (strcat "JNZ " (d16)) (strcat "JMP " (d16)) (strcat "CNZ " (d16)) "PUSH B" (strcat "ADI " (d8)) "RST $0" "RZ" "RET" (strcat "JZ " (d16)) (strcat "*JMP " (d16)) (strcat "CZ " (d16)) (strcat "CALL " (d16)) (strcat "ACI " (d8)) "RST $1"
    "RNC" "POP D" (strcat "JNC " (d16)) (strcat "OUT " (d8)) (strcat "CNC " (d16)) "PUSH D" (strcat "SUI " (d8)) "RST $2" "RC" "*RET" (strcat "JC " (d16)) (strcat "IN " (d8)) (strcat "CC " (d16)) (strcat "*CALL " (d16)) (strcat "SBI " (d8)) "RST $3"
    "RPO" "POP H" (strcat "JPO " (d16)) "XTHL" (strcat "CPO " (d16)) "PUSH H" (strcat "ANI " (d8)) "RST $4" "RPE" "PCHL" (strcat "JPE " (d16)) "XCHG" (strcat "CPE " (d16)) (strcat "*CALL " (d16)) (strcat "XRI " (d8)) "RST $5"
    "RP" "POP PSW" (strcat "JP " (d16)) "DI" (strcat "CP " (d16)) "PUSH PSW" (strcat "ORI " (d8)) "RST $6" "RM" "SPHL" (strcat "JM " (d16)) "EI" (strcat "CM " (d16)) (strcat "*CALL " (d16)) (strcat "CPI " (d8)) "RST $7"))
(de LXI (r1 r2) (reg r2 (mem (+ pc 1))) (reg r1 (mem (+ pc 2))) (pc+3)) (de STAX (r1 r2) (mem (pairs r1 r2) (reg "A")) (pc++))
(de INX (r1 r2 tmp) (pairs r1 r2 (+ (pairs r1 r2) 1) (pc++))) (de INR (r) (reg r (setflags8 "SZAP" (reg r) (+ (reg r) 1))) (pc++))
(de DCR (r) (reg r (setflags8 "SZAP" (reg r) (+ (reg r) 255))) (pc++)) (de MVI (r) (reg r (mem (+ pc 1))) (pc+2))
(de RLC (tmp) (setq tmp (reg "A")) (flag "C" (/ tmp 128)) (reg "A" (+ (* 2 (reg "A")) (flag "C"))) (pc++))
(de RRC (tmp) (setq tmp (reg "A")) (flag "C" (% tmp 2)) (reg "A" (+ (/ (reg "A") 2) (* 128 (flag "C")))) (pc++))
(de RAL (tmp) (setq tmp (flag "C")) (flag "C" (/ (reg "A") 128)) (reg "A" (| (* (reg "A") 2) tmp)) (pc++))
(de RAR (tmp) (setq tmp (* 128 (flag "C"))) (flag "C" (% (reg "A") 2)) (reg "A" (| (/ (reg "A") 2) tmp)) (pc++))
(de DAD (r1 r2 hl xy) (setq hl (pairs "H" "L") xy (pairs r1 r2)) (pairs "H" "L" (setflags16 "C" hl (+ hl xy))) (pc++))
(de DAA (lnib unib)
    (setq lnib (% (reg "A") 16) unib (/ (reg "A") 16)) 
    (cond
        ((|| (> lnib 9) (eqv 1 (flag "A"))) (setq lnib (+ lnib 6)))
        (t  (flag "A" 0))
    )
    (cond
        ((> lnib 15) (setq unib (+ unib 1) lnib (% lnib 16)))
    )
    (cond
        ((|| (> unib 9) (eqv 1 (flag "A"))) (setq unib (+ unib 6)))
        (t  (flag "C" 0))
    )
    (cond
        ((> unib 15)
            (flag "C" 1)
            (setq unib (% unib 16))
        )
    )
    (reg "A" (+ (* 16 unib) lnib)) (pc++)
)
(de LDAX (r1 r2) (reg "A" (mem (pairs r1 r2))) (pc++)) (de DCX (r1 r2) (pairs r1 r2 (+ (pairs r1 r2) 65535)) (pc++))
(de SHLD (adr) (setq adr (+ (* 256 (mem (+ pc 2))) (mem (+ pc 1)))) (mem adr (reg "L")) (setq adr (& 65535 (+ adr 1))) (mem adr (reg "H")) (pc+3))
(de LHLD (adr) (setq adr (+ (* 256 (mem (+ pc 2))) (mem (+ pc 1)))) (reg "L" (mem adr)) (setq adr (& 65535 (+ adr 1))) (reg "H" (mem adr)) (pc+3))
(de STA (adr) (setq adr (+ (* 256 (mem (+ pc 2))) (mem (+ pc 1)))) (mem adr (reg "A")) (pc+3))
(de LDA (adr) (setq adr (+ (* 256 (mem (+ pc 2))) (mem (+ pc 1)))) (reg "A" (mem adr)) (pc+3))
(de INRM (adr) (setq adr (pairs "H" "L")) (mem adr (setflags8 "SZAP" (mem adr) (+ (mem adr) 1))) (pc++))
(de DCRM (adr) (setq adr (pairs "H" "L")) (mem adr (setflags8 "SZAP" (mem adr) (+ (mem adr) 255))) (pc++))
(de MVIM (adr) (setq adr (pairs "H" "L")) (mem adr (mem (+ pc 1))) (pc+2))
(de CMA () (reg "A" (- 255 (reg "A"))) (pc++)) (de CMC () (flag "C" (- 1 (flag "C"))) (pc++)) (de HLT () (aftertesting fexecution nil) (pc++))
(de STC () (flag "C" 1) (pc++))
(de MOV (dest src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (cond ((eqv dest "m") (mem (pairs "H" "L") src)) (t (reg dest src))) (pc++))
(de RET (sp) (setq sp (pairs "S" "P") pc (mem sp) sp (+ sp 1) pc (& 65535 (+ (* 256 (mem sp)) pc)) sp (+ sp 1)) (pairs "S" "P" sp))
(de JMP ()
    (setq pc (+ (* 256 (mem (+ 2 pc))) (mem (+ 1 pc))))
)
(de CALL () (push16 (+ 3 pc)) (JMP))
(de R (test tc) (cond ((eqv (flag test) tc) (RET)) (t (pc++))))
(de J (test tc) (cond ((eqv (flag test) tc) (JMP)) (t (pc+3))))
(de C (test tc) (cond ((eqv (flag test) tc) (CALL)) (t (pc+3))))
;Optimize the following
(de ADI (src) (reg "A" (setflags8 "SZAPC" (reg "A") (+ (mem (+ pc 1)) (reg "A")))) (pc+2))
(de SUI (src) (reg "A" (setflags8 "SZAP-" (reg "A") (+ (- 255 (mem (+ pc 1))) (reg "A") 1))) (pc+2))
(de ACI (src) (reg "A" (setflags8 "SZAPC" (reg "A") (+ (mem (+ pc 1)) (reg "A") (flag "C")))) (pc+2))
(de SBI (src) (reg "A" (setflags8 "SZAP-" (reg "A") (+ (- 255 (mem (+ pc 1))) (- 1 (flag "C")) (reg "A")))) (pc+2))
(de ADD (src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (reg "A" (setflags8 "SZAPC" (reg "A") (+ (reg "A") src))) (pc++))
(de ADC (src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (reg "A" (setflags8 "SZAPC" (reg "A") (+ (reg "A") src (flag "C")))) (pc++))
(de SUB (src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (reg "A" (setflags8 "SZAP-" (reg "A") (+ (reg "A") (- 255 src) 1))) (pc++))
(de SBB (src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (reg "A" (setflags8 "SZAP-" (reg "A") (+ (reg "A") (- 255 src) (- 1 (flag "C"))))) (pc++))
(de ANA (src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (reg "A" (setflags8 "SZAPC" (reg "A") (& (reg "A") src))) (pc++))
(de XRA (src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (reg "A" (setflags8 "SZAPC" (reg "A") (^ (reg "A") src))) (pc++))
(de ORA (src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (reg "A" (setflags8 "SZAPC" (reg "A") (| (reg "A") src))) (pc++))
(de ANI () (reg "A" (setflags8 "SZAPC" (reg "A") (& (reg "A") (mem (+ 1 pc))))) (pc+2))
(de ORI () (reg "A" (setflags8 "SZAPC" (reg "A") (| (reg "A") (mem (+ 1 pc))))) (pc+2))
(de XRI () (reg "A" (setflags8 "SZAPC" (reg "A") (^ (reg "A") (mem (+ 1 pc))))) (pc+2))
(de CPI ()
    (setflags8 "SZAP-" (reg "A") (+ (reg "A") (- 255 (mem (+ 1 pc))) 1))
    (pc+2)
)
(de CMPA (src) (cond ((eqv src "m") (setq src (mem (pairs "H" "L")))) (t (setq src (reg src)))) (setflags8 "SZAP-" (reg "A") (+ (reg "A") (- 255 src) 1)) (pc++))
(de PUSH (r1 r2) (push8 (reg r1)) (cond (r2 (push8 (reg r2)))) (pc++))
(de POP (r1 r2) (cond (r2 (reg r2 (pop8)))) (reg r1 (pop8)) (pc++))
(de RST (x) (push16 (+ 1 pc)) (setq pc (* 8 x))) (de DI () (pc++)) (de EI () (pc++))
(de OUT (port ch) (setq port (mem (+ pc 1)))
    (cond ((|| (eqv port 17) (eqv port 19) (eqv port 1))
        (setq ch (reg "A"))
        (cond
            ((eqv ch 10) (setq gychar (+ 1 gychar) gxchar 0) (cond (gfttystderr (myputstderr (chr (& 127 ch))))))
            ((eqv ch 13) (setq gxchar 0) (cond (gfttystderr (myputstderr (chr (& 127 ch))))))
            ((>= 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 (strcat "F 3 0\nL$ 3 " (ltoa (+ x1paper (* gxchar dpx)) 10) " " (ltoa (+ (* (+ 1 gychar) dpy) y1paper) 10) "\"" (chr (& 127 ch)) "\"\nZ \n"))
                (cond (gfttystderr (myputstderr (chr (& 127 ch)))))
                (setq gxchar (+ 1 gxchar))
            )
        )
        (setq gfcharprinted t)
    ))
    (pc+2)
)
(de IN (port ch) (setq port (mem (+ pc 1)))
    (cond
        ((eqv port 0)
            (cond
                ((nilp gfcharprinted)
                    (reg "A" 0) (cond ((eqv (strlen ginputbuffer) 0) (reg "A" 1)))
                )
                (t
                    (reg "A" 128)
                    (cond ((eqv (strlen ginputbuffer) 0) (reg "A" 129)))
                    (setq gfcharprinted nil)
                )
            )
        )
        ((|| (eqv port 18) (eqv port 20))
            (cond
                ((nilp gfcharprinted) (reg "A" 2)
                    (cond ((eqv (strlen ginputbuffer) 0) (reg "A" 3)))
                )
                (t (reg "A" 0) (setq gfcharprinted nil)
                )
            )
        )
        ((|| (eqv port 1) (eqv port 19) (eqv port 17))
            (cond
                ((eqv (strlen ginputbuffer) 1)
                    (setq ch (asc (strsub ginputbuffer 0 1)))
                    (cond ((eqv ch 127) (setq ch 255)))
                    (reg "A" ch)
                    (setq ginputbuffer "")
                )
                ((> (strlen ginputbuffer) 0)
                    (setq ch (asc (strsub ginputbuffer 0 1)))
                    (cond ((eqv ch 127) (setq ch 255)))
                    (reg "A" ch)
                    (setq ginputbuffer (strsub ginputbuffer 1 1024))
                )
                (t (reg "A" 0))
            )
            (myputs "Z \n")
        )
        ((eqv port 255) (reg "A" (% ipc 256)) (myputs "Z \n"))
    )
    (pc+2)
)
(de XTHL (sp tmp) (setq sp (pairs "S" "P") tmp (reg "L")) (reg "L" (mem sp)) (mem sp tmp) (spc++) (setq tmp (reg "H")) (reg "H" (mem sp)) (mem sp tmp) (pc++))
(de XCHG (tmp) (setq tmp (reg "L")) (reg "L" (reg "E")) (reg "E" tmp) (setq tmp (reg "H")) (reg "H" (reg "D")) (reg "D" tmp) (pc++))
(de PCHL () (setq pc (pairs "H" "L"))) (de SPHL () (reg "S" (reg "H")) (reg "P" (reg "L")) (pc++))
(de PUSHPSW (sp tmp) (setq sp (pairs "S" "P")) (sp--) (mem sp (reg "A")) (sp--) (setq tmp (flag "S") tmp (* 2 tmp))
    (setq tmp (+ tmp (flag "Z")) tmp (* 4 tmp)) (setq tmp (+ tmp (flag "A")) tmp (* 4 tmp)) (setq tmp (+ tmp (flag "P")) tmp (* 2 tmp))
    (setq tmp (+ tmp 1) tmp (* 2 tmp)) (setq tmp (+ tmp (flag "C"))) (mem sp tmp) (pairs "S" "P" sp) (pc++))
(de POPPSW (sp tmp) (setq sp (pairs "S" "P")) (setq tmp (mem sp)) (flag "C" (% tmp 2)) (setq tmp (/ tmp 4)) (flag "P" (% tmp 2))
    (setq tmp (/ tmp 4)) (flag "A" (% tmp 2)) (setq tmp (/ tmp 4)) (flag "Z" (% tmp 2)) (setq tmp (/ tmp 2)) (flag "S" (% tmp 2))
    (spc++) (reg "A" (mem sp)) (spc++) (pairs "S" "P" sp) (pc++))
(de oct (val d str) (setq str (ltoa val 8)) (while (< (strlen str) d) (setq str (strcat "0" str))) str)
(de hex (val d str) (setq str (ltoa val 16)) (while (< (strlen str) d) (setq str (strcat "0" str))) str)
(de mem (addr data) (cond ((nilp data) (deref (+ gmemory (& 65535 addr)) 1)) (t (iasgn (+ gmemory (& 65535 addr)) 1 data))))
(de colon (high low) (+ (* 256 (strtol high 8)) (strtol low 8)))
(de reg (name val) (cond (val (quality "areg" name (% val 256))) (t (quality "areg" name))))
(de flag (name val) (cond ((eqv name t) 1) (val (quality "aflag" name val)) (t (quality "aflag" name))))
(flag "S" 0) (flag "Z" 0) (flag "A" 0) (flag "P" 0) (flag "C" 0) 
(setq dpy 128 dpx (/ (+ 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")))
(de senseSWx (i) (- 4619 (+ (* (/ i 3) 759) (* (% i 3) 221)))) (de centerSWx (i x) (- 4447 (* i 442)))
(setq LEDstr "21a6b9a8b7a5B5a6B4a5bC5b3a5bDC5bA4bc3dc5bA4bCdC5bA5b3c6b3a6B4a6B5a5B7a8b9a5b22a")
(setq centerSWstr "41a15b8Ab5c6daCb8AbC3d5cD3cb7AbCd3c5eCdCb7Abcdc8fEcDcb6Abcdc11fecDb11abcdc13fecdcb5Abcdc7FCdb9abcdc15fecdcb8abcdc8Fecdb7abcdc8f3e6fecdcb6abcdc8f3de5fecdcb5abCdc7fcdcDe4fecdCb4abcdc7fcb3cDe3fEcdcb3abCdc6fc3b3cDeFEcdCbAbCdc6f4b3cDeFEcdCb3abcdc6f5bc3deFEcdCb3abCdc6fcBc3de3fEcdcb5abcdc7f5de4f3eCb6abdc7fe3de5fEcdb7abcdc7f3e6fecdcb8abdc15fEcdb9abcdc7Fecdcb5Abdc13fEcdb11abcdc11fEcdcb6Abcdc9fEcDb13abCdC7eCdCb7AbCD7cDCb15ab4c7d4cb8A15b40a")
(setq downSWstr "41a15b8Ab5c6daCb8AbC3d5cD3cb7AbCd3c5eCdCb7Abcdc8fEcDcb6Abcdc11fecDb11abcdc13fecdcb5Abcdc7FCdb9abcdc15fecdcb8abcdc8Fecdb7abcdc17fecdcb6abcdc17fecdcb5abCdc8fede6fecdCb4abcdc8fe3de5fEcdcb3abCdc7fEdcde5fEcdCbAbCdc7fedCdE4fEcdCb3abcdc7fedbcDe4fEcdCb3abCdc6fDbcDe4fEcdcb5abcdc7fdBcd5f3eCb6abdc7fdcbcd5fEcdb7abcdc6fdBC5fecdcb8abdc5fdc3bc4fEcdb9abcdc5fc3bc4fecdcb5Abdc5fc3bc3fEcdb11abcdc4fcBCFEcdcb6Abcdc4f3cFEcDb13abCdC7eCdCb7AbCD7cDCb15ab4c7d4cb8A15b40a")
(setq upSWstr "6AdC3bcd21a3bdc5bcd3b8Ab3cdc5bdaCb8AbCDc5bD3cb7AbCdcdc5bdcdCb7AbcdceDc3bcdecDcb6Abcdc3edc3bcFecDb11abcdc4edc3bc3eecdcb5Abcdc5eCBc4eCdb9abcdc6ed3bc4eecdcb8abcdc6ed3bd5eecdb7abcdc7edcbcd5eecdcb6abcdc7edBcd5eecdcb5abCdc7edBc6eecdCb4abcdc8eDbce5eEcdcb3abCdc7eeDCe5eEcdCbAbCdc7eEdcde5eEcdCb3abcdc7e3ede6eEcdCb3abCdc7e4e6eEcdcb5abcdc17e3eCb6abdc17eEcdb7abcdc8Fecdcb8abdc15eEcdb9abcdc7Fecdcb5Abdc13eEcdb11abcdc11eEcdcb6Abcdc9eEcDb13abCdC7eCdCb7AbCD7cDCb15ab4c7d4cb8A15b40a")

(de init (i)
    (qsetq gcount 0)
    (qsetq alasttopstatus (-1 -1 -1 -1 -1 -1 -1 -1 -1 -1) alastbotstatus (-1 -1) alastsense (-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1))
    (qsetq alastaddr (-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1) alastdata (-1 -1 -1 -1 -1 -1 -1 -1))
    (initlock gstdinlock) (setq gstdinstream (sfopen '"stdin" '"w"))
    (myputs (strcat "Fo 0 88 3\nFo 2 128 3\nFo 1 128 3\nFo 3 128 3\n"))
    (setq fflushneeded t gfverbosestderr nil gfttystderr nil gfnotexit t gfverbose t)
    (reg "A" 0) (reg "B" 0) (reg "C" 0) (reg "D" 0) (reg "E" 0) (reg "H" 0) (reg "L" 0) (reg "S" 0) (reg "P" 0) (setq gmemory (new 65536))
    (setq pc 0)
    (memset gmemory 0 65536)
    (cond
        (nil
            (setq stream (fopen "monitor.oct" "r"))
            (while (setq line (fgets stream))
                (setq i 0 len (strlen line))
                (while (< i len)
                    (setq ch (asc (strsub len i 1)))
                    (cond
                        ((&& fnum (eqv ch 32)) (mem pc val) (setq pc (+ pc 1) val 0 fnum nil))
                        ((&& (>= ch 48) (<= ch 55)) (setq val (+ (* val 8) (- ch 48)) fnum t))
                        ((&& unum (eqv ch 58)) (setq pc (+ (* 256 unum) val) unum nil val 0 funum nil))
                        ((eqv ch 58) (setq unum val val 0 funum nil))
                    )
                    (setq i (+ i 1))
                )
                (cond (unum (setq pc unum)))
            )
            (fclose stream)
            (setq pc (colon "030" "135"))
        )
        (t
            (setq pc 0 ginputbuffer "")
            (setq stream (fopen "basic.lst" "r"))
            (while (setq line (fgets stream))
                (setq len (strlen line))
                (cond ((&& (>= len 8) (strcmp (strsub line 4 1) ":"))
                    (setq pc (strtol (strsub line 0 4) 16) i 6 commentpc pc)
                    (while (> (asc (strsub line i 1)) 32)
                        (setq val (strtol (strsub line i 2) 16))
                        (mem pc val) (setq pc (+ pc 1) i (+ i 2)))
                    (while (&& (< i len) (nilp (strcmp (strsub line i 1) "\t"))) (setq i (+ i 1)))
                    (cond ((&& (< i len) (strcmp (strsub line i 1) "\t")) (comment commentpc (strsub line i (- len i))))))))
            (fclose stream)
            (setq pc 0)
        )
    )
    (setq ipc 0 topsw (+ 128 32 2) botsw 0)
)
(de "stdin.drawapp" ()
    (myputs "F 0 16777215\nF 3 0\n") (setq fflushneeded t) 
    (myputs "B 2 7829367\nB 0 7829367\nB 1 7829367\nB 3 14731686\n")
    (drawpanel)
    (myputs "F 0 16777215\n")
    (setq fflushneeded t)
    (drawdatatexts) (drawaddresstexts) (drawsensetexts)
        (drawcentertexts) (drawtoptexts) (drawbottexts) (drawdataLEDs (mem pc)) (drawtopstatusLEDs topsw) (drawbotstatusLEDs botsw) (drawaddressLEDs pc)
        (drawcenterSWs) (drawsenseSWs ipc) (drawregisters) (drawpaper)
    (myputs "F 1 0\nL$ 1 1000 300 \"lisp cloud app transparent shell stdinout\"\nZ \n" )
)
(de drawpaper () (myputs (strcat "F 2 14731686\nFR 2 " (ltoa x1paper 10) " " (ltoa y1paper 10) " " (ltoa x2paper 10) " " (ltoa y2paper 10) "\nF 2 0\n")))
(de drawregisterbox (x1 y1 x2 y2) (myputs "F 0 3342336\n") (myputs (strcat "R 0 " (ltoa (- x1 20) 10) " " (ltoa (- y1 20) 10) " " (ltoa x2 10) " " (ltoa y2 10) "\n"))
    (myputs "F 0 7829367\n") (myputs (strcat "FR 0 " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) "\n")) (myputs "F 2 5570560\n"))
(de drawregisterA (y) (drawregisterbox 530 (int (* (- y 2.0) 44.2)) 1061 (int (* y 44.7))) (cond (gfverbosestderr (myputstderr (strcat "A:" (oct (reg "A") 3)))))
    (myputs (strcat "L$ 2 530 " (ltoa (int (* y 44.2)) 10) " \"A:" (oct (reg "A") 3) "\"\n")))
(de drawregisterpair (y hi low) (drawregisterbox 530 (int (- (* (+ y 0.5) 44.2) 110.5)) 1697 (int (* (+ y 0.5) 44.2)))
    (cond (gfverbosestderr (myputstderr (strcat " " hi ":" (oct (reg hi) 3) " " low ":" (oct (reg low) 3)))))
    (myputs (strcat "L$ 2 530 " (ltoa (int (* y 44.2)) 10) " \"" hi ":" (oct (reg hi) 3) " " low ":" (oct (reg low) 3) "\"\n")))
(de drawregistersnp (y label val) (drawregisterbox 530 (int (* (- y 2.0) 44.2)) 1697 (int (* y 44.7)))
    (cond (gfverbosestderr (myputstderr (strcat " " label ":" (oct (/ val 256) 3) ":" (oct (% val 256) 3)))))
    (myputs (strcat "L$ 2 530 " (ltoa (int (* y 44.2)) 10) " \"" label ":" (oct (/ val 256) 3) ":" (oct (% val 256) 3) "\"\n")))
(de drawregisterFlags () (drawregisterbox 1238 433 3996 544) (myputs (strcat "L$ 2 1238 530 \"Flags:" (cond ((eqv (flag "S") 1) "N-") (t "P+")) ":"
        (cond ((eqv (flag "Z") 1) " Z") (t "NZ")) ":0:" (cond ((eqv (flag "A") 1) "AC") (t "NA")) ":0:"
        (cond ((eqv (flag "P") 1) "PE") (t "PO")) ":1:" (cond ((eqv (flag "C") 1) "CY") (t "NC")) "\"\n"))
    (cond (gfverbosestderr (myputstderr (strcat " Flags:" (cond ((eqv (flag "S") 1) "N-") (t "P+")) ":"
        (cond ((eqv (flag "Z") 1) "Z") (t "NZ")) ":0:" (cond ((eqv (flag "A") 1) "AC") (t "NA")) ":0:"
        (cond ((eqv (flag "P") 1) "PE") (t "PO")) ":1:" (cond ((eqv (flag "C") 1) "CY") (t "NC")))))))
(de drawregisters () (drawregisterA 11.80) (drawregisterFlags 11.80) (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))
(de dispop (opstr instr) (drawregisterbox 530 1282 2228 1437) (myputs (strcat "L$ 2 530 1414 \"" opstr "\"\n")) (cond (gfverbosestderr (myputstderr (strcat "\n " opstr "\n")))))

(de cacheupswitch (x1 y1 x2 y2)
    (cond
        (([] acachebmps 0)
            (myputs (strcat "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 0" "\n"))
        )
        (t
            (myputs (strcat "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) "\n"))
            ([]= acachebmps 0 0)
        )
    )
)

(de cachedownswitch (x1 y1 x2 y2)
    (cond
        (([] acachebmps 1)
            (myputs (strcat "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 1" "\n"))
        )
        (t
            (myputs (strcat "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) "\n"))
            ([]= acachebmps 1 1)
        )
    )
)

(de cachecenterswitch (x1 y1 x2 y2)
    (cond
        (([] acachebmps 2)
            (myputs (strcat "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 2" "\n"))
        )
        (t
            (myputs (strcat "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) "\n"))
            ([]= acachebmps 2 2)
        )
    )
)

(de cacheledon (x1 y1 x2 y2)
    (cond
        (([] acachebmps 3)
            (myputs (strcat "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 3" "\n"))
        )
        (t
            (myputs (strcat "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) "\n"))
            ([]= acachebmps 3 3)
        )
    )
)

(de cacheledoff (x1 y1 x2 y2)
    (cond
        (([] acachebmps 4)
            (myputs (strcat "Gl " (ltoa x1 10) " " (ltoa y1 10) " " (ltoa x2 10) " " (ltoa y2 10) " 4" "\n"))
        )
        (t
            (myputs (strcat "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) "\n"))
            ([]= acachebmps 4 4)
        )
    )
)

(de examine () (drawcenterSW (centerSWx 5) centerSWy +1) (setq pc ipc) (drawaddressLEDs pc) (drawdataLEDs (mem pc)) (drawcenterSW (centerSWx 5) centerSWy 0) (drawregisters))
(de examinenext () (drawcenterSW (centerSWx 5) centerSWy -1) (pc++) (drawaddressLEDs pc) (drawdataLEDs (mem pc)) (drawcenterSW (centerSWx 5) centerSWy 0) (drawregisters))
(de deposit () (drawcenterSW (centerSWx 4) centerSWy +1) (mem pc (% ipc 256)) (drawaddressLEDs pc) (drawdataLEDs (mem pc)) (drawcenterSW (centerSWx 4) centerSWy 0) (drawregisters))
(de depositnext () (drawcenterSW (centerSWx 4) centerSWy -1) (pc++) (mem pc (% ipc 256)) (drawaddressLEDs pc) (drawdataLEDs (mem pc)) (drawcenterSW (centerSWx 4) centerSWy 0) (drawregisters))
(de drawcenterSW (x y upcenterdown) 
    (cond
        ((eqv upcenterdown 1) (cacheupswitch x y (+ x 155) (+ y 155)))
        ((eqv upcenterdown -1) (cachedownswitch x y (+ x 155) (+ y 155)))
        (t (cachecenterswitch x y (+ x 155) (+ y 155)))
    )
)
(de drawSW (x y onoff)
    (cond
        ((eqv onoff 0) (cachedownswitch x y (+ x 155) (+ y 155)))
        (t (cachupswitch x y (+ x 155) (+ y 155)))
    )
)
(de drawLED (x y onoff)
    (cond
        ((eqv onoff 1) (cacheledon x y (+ x 155) (+ y 155)))
        (t (cacheledoff x y (+ x 155) (+ y 155)))
    )
)
(de drawtopstatusLEDs (topstatus x y i bit) (setq y 1989 x 2361 i 0)
    (while (< i 10) (setq bit (% topstatus 2)) (cond ((nilp (eqv bit ([] alasttopstatus i))) (drawLED (- x (* i 221)) y bit) ([]= alasttopstatus i bit))) (setq topstatus (/ topstatus 2))
       (setq i (+ i 1))))
(de drawbotstatusLEDs (botstatus x y i bit) (setq i 0) (while (< i 2) (setq bit (% botstatus 2))
       (cond ((nilp (eqv bit ([] alastbotstatus i))) (drawLED (- 593 (* i 221)) 2519 bit) ([]= alastbotstatus i bit))) (setq botstatus (/ botstatus 2) i (+ i 1))))
(de drawaddresstexts (i bit) (setq i 0) (while (< i 16)
      (myputs (strcat "C$ 0 " (ltoa (- 4696 (+ (* (/ i 3) 759) (* (% i 3) 221))) 10) " 2458\"A" (ltoa i 10) "\"\n")) (setq i (+ i 1))) (setq fflushneeded t))
(de drawsensetexts (i bit) (setq i 0) (while (< i 16)
      (myputs (strcat "C$ 0 " (ltoa (- 4696 (+ (* (/ i 3) 759) (* (% i 3) 221))) 10) " 2989\"" (ltoa i 10) "\"\n")) (setq i (+ i 1))) (setq fflushneeded t))
(de drawtoptexts (i bit) (setq i 0) (while (< i 10)
        (myputs (strcat "C$ 0 " (ltoa (- 2433 (* i 221)) 10) " 1928\"" ([] atoptext i) "\"\n")) (setq i (+ i 1))) (setq fflushneeded t))
(de drawbottexts (i bit) (setq i 0)
   (while (< i 2) (myputs (strcat "C$ 0 " (ltoa (- 665 (* i 221)) 10) " 2458\"" ([] abottext i) "\"\n")) (setq i (+ i 1))) (setq fflushneeded t))
(de drawdatatexts (i bit)
   (setq i 0)
   (while (< i  8)
       (myputs (strcat "C$ 0 " (ltoa (- 4696 (+ (* (/ i 3) 759) (* (% i 3) 221))) 10) " 1928\"D" (ltoa i 10) "\"\n"))
       (setq i (+ i 1))
   )
   (setq fflushneeded t)
)
(de drawdataLEDs (data i bit)
    (setq i 0)
    (while (< i 8)
        (setq bit (% data 2))
        (cond
            ((nilp (eqv bit ([] alastdata i)))
                (drawLED (- 4619 (+ (* (/ i 3) 759) (* (% i 3) 221))) 1989 bit)
                ([]= alastdata i bit)
            )
        )
        (setq i (+ i 1) data (/ data 2))
    )
)
(de drawaddressLEDs (addr i bit)
    (setq i 0)
    (while (< i 16)
        (setq bit (% addr 2))
        (cond
            ((nilp (eqv bit ([] alastaddr i)))
                (drawLED (- 4619 (+ (* (/ i 3) 759) (* (% i 3) 221))) 2519 bit)
                ([]= alastaddr i bit)
            )
            (t
                (drawLED (- 4619 (+ (* (/ i 3) 759) (* (% i 3) 221))) 2519 bit)
            )
        )
        (setq i (+ i 1) addr (/ addr 2))
    )
)
(de drawsenseSWs (sense i bit) (setq i 0)
   (while (< i 16) (setq bit (% sense 2))
       (cond ((nilp (eqv bit ([] alastsense i))) (drawSW (senseSWx i) senseSWy bit) ([]= alastsense i bit))) (setq i (+ i 1) sense (/ sense 2))))
(de drawcenterSWs (data i bit) (setq i 0)
   (while (< i 9) (drawcenterSW (centerSWx i) centerSWy 0) (setq i (+ i 1))) (drawcenterSW (centerSWx 8) centerSWy 1))
(de drawcentertexts (x y i) (setq i 0)
    (while (< i 9) (cond ((> (strlen (car ([] acentertext i))) 0) (myputs (strcat "C$ 0 " (ltoa (- 4519 (* i 442)) 10) " 3519\"" (car ([] acentertext i)) "\"\n")) (setq fflushneeded t)))
       (cond ((> (strlen (CADR ([] acentertext i))) 0) (myputs (strcat "C$ 0 " (ltoa (- 4519 (* i 442)) 10) " 3773\"" (CADR ([] acentertext i)) "\"\n")) (setq fflushneeded t))) (setq i (+ i 1))))
(de drawpanel (i)
    (myputs "F 0 723967\nFR 0 0 0 10000 4108\nF 0 7829367\nFR 0 106 106 9894 4002\n")
    (setq i 0) (while (< i 16) ([]= alastsense i -1) ([]= alastaddr[i] -1) (setq i (+ i 1)))
    (setq i 0) (while (< i 8) ([]= alastdata i -1) (setq i (+ i 1)))
    (setq i 0) (while (< i 2) ([]= alastbotstatus i -1) (setq i (+ i 1)))
    (setq i 0) (while (< i 10) ([]= alasttopstatus i -1) (setq i (+ i 1))))
(de show (pc instr)
    (cond ((&& gfverbosestderr (is_quality "comment" (ltoa pc 10))) (myputstderr (quality "comment" (ltoa pc 10)))))
    (setq instr (mem pc)) (dispop (eval (car (cndr instr showinstr))) instr))
(de step () (eval (car (cndr (mem pc) step-instr))))
(de setflags16 (flagstr preval postval len i iflag p ip) (setq len (strlen flagstr)) (cond ((< postval 0) (setq postval (+ 65536 postval))))
    (setq i 0) (while (< i len) (setq iflag (strsub flagstr i 1)) (cond
            ((eqv iflag "S") (cond ((eqv (& 32768 postval) 0) (flag "S" 0)) (t (flag "S" 1))))
            ((eqv iflag "C") (cond ((eqv (& 65536 postval) 0) (flag "C" 0)) (t (flag "C" 1))))
            ((eqv iflag "Z") (cond ((eqv (& 65535 postval) 0) (flag "Z" 1)) (t (flag "Z" 0))))
            ((eqv iflag "P") (setq p 0 ip 1) (while (<= ip 65536) (cond ((> (& ip postval) 0) (setq p (+ p 1)))) (setq ip (* 2 ip))) (flag "P" (- 1 (% p 2)))))
        (setq i (+ i 1))) (& 65535 postval))
(de setflags8 (flagstr preval postval len i iflag p ip) (setq len (strlen flagstr)) (cond ((< postval 0) (setq postval (+ 4096 postval))))
    (setq i 0) (while (< i len) (setq iflag (strsub flagstr i 1)) (cond
            ((eqv iflag "S") (cond ((eqv (& 128 postval) 0) (flag "S" 0)) (t (flag "S" 1))))
            ((eqv iflag "A") (cond ((eqv (& 16 postval) (& 16 preval)) (flag "A" 0)) (t (flag "A" 1))))
            ((eqv iflag "C") (cond ((eqv (& 256 postval) 0) (flag "C" 0)) (t (flag "C" 1))))
            ((eqv iflag "-") (cond ((eqv (& 256 postval) 0) (flag "C" 1)) (t (flag "C" 0))))
            ((eqv iflag "Z") (cond ((eqv (& 255 postval) 0) (flag "Z" 1)) (t (flag "Z" 0))))
            ((eqv iflag "P") (setq p 0 ip 1) (while (<= ip 256) (cond ((> (& ip postval) 0) (setq p (+ p 1)))) (setq ip (* 2 ip))) (flag "P" (- 1 (% p 2)))))
        (setq i (+ i 1))) (& 255 postval))
(de OFF () (drawdataLEDs (mem pc)) (drawtopstatusLEDs topsw) (drawbotstatusLEDs botsw) (drawaddressLEDs pc) (drawsenseSWs ipc)
    (myputs "O 0 0 0\n") (setq fflushneeded t gfnotexit nil fnotdone nil))
(de exe (loops fio)
    (while (&& fexecution (> loops 0))
        (cond ((eqv (mem pc) 211) (setq fio t)))
        (step)
        (setq ginstrflush (+ ginstrflush 1))
        (cond
            ((|| (eqv (mem pc) 219) gfverbose (> ginstrflush 117))
                (setq fio t)
                (setq ginstrflush 0)
            )
        )
        (setq loops (- loops 1))
    )
    (cond
        (fio
            (drawdataLEDs (mem pc)) (drawaddressLEDs pc) (drawregisters)
            (myputs "Z \n") (fflush stdout)
        )
    )
)
(de main-loop (i i2 x y lines line button sz)
    (while gfnotexit
        (cond
            ((&& (nilp lines) (> (sfsize gstdinstream) 0))
                (waitlock gstdinlock 1024)
                (setq sz (sfsize gstdinstream))
                (cond
                    ((eqv (deref (+ (sfbuffer gstdinstream) sz -1) 1) 10)
                        (setq lines (strtok (strsub (ptr_to_string (sfbuffer gstdinstream)) 0 sz) "\n")) (sfclose_and_delete gstdinstream '"stdin")
                        (setq gstdinstream (sfopen '"stdin" '"w"))
                    )
                )
                (unlock gstdinlock)
                (yield)
            )
        )
        (cond
            (lines
                (setq line (strtok (car lines) " \t") lines (cdr lines))
            )
            (t
                (setq line nil)
            )
        )
        (cond
            ((eqv (car line) "drawapp")
                ("stdin.drawapp")
            )
            ((eqv (car line) "QUERY_REMOTE")
                ("stdin.QUERY_REMOTE")
            )
            (line
                (setq button (strtol (car line) 10) x (strtol (CADR line) 10) y (strtol (CADDR line) 10))
                (cond 
                    ((eqv x -2) (cond ((> button 0) (setq ginputbuffer (strcat ginputbuffer (chr button))))))
                    ((eqv x -98) (fputs (strcat "watermark " (ltoa (* 4 y) 10) "\n") stderr) (fflush stderr) (usleep (* 4000 y)))
                    ((eqv button 3) (OFF))
                    ((&& (> x 0) (> y (- senseSWy 358)) (< y (+ senseSWy 358)))
                        (setq i2 1 fnotdone t i 0)
                        (while (&& fnotdone (< i 16)) (cond ((&& (> x (senseSWx i)) (< x (+ (senseSWx i) 221)))
                                (cond ((< y senseSWy) (setq ipc (| ipc i2) fnotdone nil))
                                        ((&& (> y senseSWy) (< y (+ senseSWy 358))) (setq ipc (& ipc (~ i2)) fnotdone nil)))))
                            (setq i2 (* i2 2) i (+ i 1))) (cond ((nilp fnotdone) (drawsenseSWs ipc) (myputs "Z \n")))
                    )
                    ((&& (> y (- centerSWy 358)) (< y (+ centerSWy 358)))
                        (setq i2 1 fnotdone t i 0)
                        (while (&& fnotdone (< i 9))
                            (cond ((&& (> x (centerSWx i)) (< x (+ (centerSWx i) 221))) (cond ((< y centerSWy) (cond
                                        ((eqv i 5) (examine)) ((eqv i 4) (deposit))
                                        ((eqv i 6) (step) (drawdataLEDs (mem pc)) (drawaddressLEDs pc) (drawregisters))
                                        ((eqv i 7) (setq fexecution nil))) (setq fnotdone nil))
                                    ((&& (> y centerSWy) (< y (+ centerSWy 358))) (cond
                                                ((eqv i 5) (examinenext)) ((eqv i 4) (depositnext))
                                                ((eqv i 6) (step) (drawdataLEDs (mem pc)) (drawaddressLEDs pc) (drawregisters))
                                                ((eqv i 7) (setq fexecution t) (step) (drawdataLEDs (mem pc)) (drawaddressLEDs pc) (drawregisters))
                                                ((eqv i 8) (OFF))) (setq fnotdone nil))) (setq fnotdone nil))
                            )
                            (setq i2 (* i2 2) i (+ i 1))
                        )
                        (cond
                            ((nilp fnotdone)
                                (drawsenseSWs ipc)
                                (myputs "Z \n")
                            )
                        )
                    )
                )
            )
            (fexecution (exe 3000) (myputs "X \n"))
        )
        (cond (fexecution (exe 200) (myputs "Z \n")))
    )
    (exit 0)
)
(setq READLOOPWAIT 40000)
(setq READLOOPWAIT 4000)
(de stdin-read-loop (ret lfnotexit)
    (setq lfnotexit t)
    (while (&& gfnotexit lfnotexit)
        (setq ret (fgetsraw stdin))
        (cond
            (ret
                (waitlock gstdinlock 1024)
                (sfputs ret gstdinstream)
                (unlock gstdinlock 1024)
                (cond ((strncmp ret "3 3 3" 5) (setq lfnotexit 0) (fclose stdin) (close 0)))
                (yield)
            )
            (t (usleep READLOOPWAIT) (yield))
        )
    )
    (exit 0)
)
(init)
(process stdin-read-loop)
(yield)
(main-loop)
(yield)