⍝    crc's _ _
⍝         (_) | ___
⍝         | | |/ _ \  a tiny virtual computer
⍝         | | | (_) | 64kw RAM, 32-bit, Dual Stack, MISC
⍝         |_|_|\___/  ilo.apl (c) charles childers
⍝
⍝ ilo.apl -- ilo virtual machine for APL (tested w/GNU APL 1.8)
⍝ Run: apl -s -f ilo.apl -- [IMAGE [BLOCKS]]

⎕IO←0
MEM←65536 ⋄ DSMAX←32 ⋄ RSMAX←256 ⋄ MOD32←4294967296

∇ Z←WRAP X;U
 U←MOD32|X
 Z←U-MOD32×U≥2147483648
∇

∇ Z←X BITAND Y
 Z←WRAP X ⊤∧ Y
∇

∇ Z←X BITOR Y
 Z←WRAP X ⊤∨ Y
∇

∇ Z←X BITXOR Y
 Z←WRAP X ⊤≠ Y
∇

∇ Z←DECODE B;N
 N←(4÷⍨≢B)4⍴B
 Z←WRAP (256 256 256 256⊥⍉⌽N)
∇

∇ B←ENCODE C;U
 U←MOD32|C
 B←,⍉⊖256 256 256 256⊤U
∇

∇ LOADIMAGE P;B;C;H;Z
 H←⎕FIO[3] P
 B←(MEM×4)(⎕FIO[6])H
 Z←⎕FIO[4] H
 C←DECODE B
 M←C,(MEM-≢C)⍴0
∇

∇ SAVEIMAGE P;H;Z
 H←'wb'(⎕FIO[3])P
 Z←(ENCODE M)(⎕FIO[7])H
 Z←⎕FIO[4] H
∇

∇ READBLOCK B;H;V;O;Z
 O←B×4096
 H←⎕FIO[3] BLOCKPATH
 Z←O(⎕FIO[13])H
 V←4096(⎕FIO[6])H
 Z←⎕FIO[4] H
 M[BUF+⍳1024]←DECODE V
∇

∇ WRITEBLOCK B;H;O;Z
 O←B×4096
 H←'r+b'(⎕FIO[3])BLOCKPATH
 Z←O(⎕FIO[13])H
 Z←(ENCODE M[BUF+⍳1024])(⎕FIO[7])H
 Z←⎕FIO[4] H
∇

∇ PUSH X
 →(DSMAX≤≢D)⍴FULL
 D←D,WRAP X
 →END
FULL: ⎕←'ilo: data stack overflow'
 ⎕OFF
END:
∇

∇ Z←POP
 →(0=≢D)⍴EMPTY
 Z←⊃¯1↑D
 D←¯1↓D
 →END
EMPTY: ⎕←'ilo: data stack underflow'
 ⎕OFF
END:
∇

∇ RPUSH X
 →(RSMAX≤≢R)⍴FULL
 R←R,WRAP X
 →END
FULL: ⎕←'ilo: address stack overflow'
 ⎕OFF
END:
∇

∇ Z←RPOP
 →(0=≢R)⍴EMPTY
 Z←⊃¯1↑R
 R←¯1↓R
 →END
EMPTY: ⎕←'ilo: address stack underflow'
 ⎕OFF
END:
∇

∇ IODEV X;C;W
 →X⊃OUT IN READ WRITE SAVE RESET HALT QUERY
OUT: C←(⎕UCS 256|POP)(⎕FIO[23])1 ⋄ →0
IN: C←⎕FIO[9] 0 ⋄ →(¯1=C)⍴EOF ⋄ W←(⎕UCS 256|C)(⎕FIO[23])1 ⋄ PUSH C ⋄ →0
EOF: PUSH ¯1 ⋄ →0
READ: BUF←POP ⋄ READBLOCK POP ⋄ →0
WRITE: BUF←POP ⋄ WRITEBLOCK POP ⋄ →0
SAVE: SAVEIMAGE IMAGEPATH ⋄ →0
RESET: D←⍬ ⋄ R←⍬ ⋄ LOADIMAGE IMAGEPATH ⋄ IP←¯1 ⋄ →0
HALT: RUN←0 ⋄ →0
QUERY: PUSH ≢D ⋄ PUSH ≢R ⋄ →0
∇

∇ STEP OP;A;B;C;T;S;L;Q
 →OP⊃END LI DU DR SW PU PO JU CA CC CJ RE EQ NE LT GT FE ST AD SU MU DI AN OR XO SL SR CP CY IO
LI: PUSH M[IP←IP+1] ⋄ →0
DU: PUSH ⊃¯1↑D ⋄ →0
DR: A←POP ⋄ →0
SW: A←POP ⋄ B←POP ⋄ PUSH A ⋄ PUSH B ⋄ →0
PU: RPUSH POP ⋄ →0
PO: PUSH RPOP ⋄ →0
JU: IP←POP-1 ⋄ →0
CA: T←POP ⋄ RPUSH IP ⋄ IP←T-1 ⋄ →0
CC: T←POP ⋄ A←POP ⋄ →(0=A)⍴END ⋄ RPUSH IP ⋄ IP←T-1 ⋄ →0
CJ: T←POP ⋄ A←POP ⋄ →(0=A)⍴END ⋄ IP←T-1 ⋄ →0
RE: IP←RPOP ⋄ →0
EQ: B←POP ⋄ PUSH ¯1×(POP)=B ⋄ →0
NE: B←POP ⋄ PUSH ¯1×(POP)≠B ⋄ →0
LT: B←POP ⋄ PUSH ¯1×(POP)<B ⋄ →0
GT: B←POP ⋄ PUSH ¯1×(POP)>B ⋄ →0
FE: A←POP ⋄ PUSH M[A] ⋄ →0
ST: A←POP ⋄ M[A]←POP ⋄ →0
AD: B←POP ⋄ PUSH (POP)+B ⋄ →0
SU: B←POP ⋄ PUSH (POP)-B ⋄ →0
MU: B←POP ⋄ PUSH (POP)×B ⋄ →0
DI: B←POP ⋄ A←POP ⋄ →(0=B)⍴DIV0 ⋄ Q←(⌊|A÷B)×(1-2×((A<0)≠B<0)) ⋄ PUSH (A-B×Q) ⋄ PUSH Q ⋄ →0
DIV0: ⎕←'ilo: divide by zero' ⋄ ⎕OFF
AN: B←POP ⋄ PUSH (POP) BITAND B ⋄ →0
OR: B←POP ⋄ PUSH (POP) BITOR B ⋄ →0
XO: B←POP ⋄ PUSH (POP) BITXOR B ⋄ →0
SL: B←POP ⋄ A←POP ⋄ PUSH A×2*B ⋄ →0
SR: B←POP ⋄ A←POP ⋄ PUSH ⌊A÷2*B ⋄ →0
CP: L←POP ⋄ T←POP ⋄ S←POP ⋄ PUSH ¯1×M[S+⍳L]≡M[T+⍳L] ⋄ →0
CY: L←POP ⋄ T←POP ⋄ S←POP ⋄ C←{M[T+⍵]←M[S+⍵]}¨⍳L ⋄ →0
IO: IODEV POP ⋄ →0
END: →0
∇

∇ RUNVM;O
LOOP: →(~RUN∧0≤IP∧IP<MEM)/0
 O←256|⌊(MOD32|M[IP])÷256*⍳4
 STEP O[0] ⋄ →(~RUN)/0
 STEP O[1] ⋄ →(~RUN)/0
 STEP O[2] ⋄ →(~RUN)/0
 STEP O[3] ⋄ →(~RUN)/0
 IP←IP+1
 →LOOP
∇

∇ MAIN;A
 A←1↓(⎕ARG⍳⊂'--')↓⎕ARG
 IMAGEPATH←'ilo.rom' ⋄ BLOCKPATH←'ilo.blocks'
 →(0=≢A)⍴DEFAULT
 IMAGEPATH←⊃A
 →(1=≢A)⍴DEFAULT
 BLOCKPATH←⊃1↓A
DEFAULT: D←R←⍬ ⋄ IP←0 ⋄ RUN←1
 LOADIMAGE IMAGEPATH
 RUNVM
∇

MAIN
)OFF