Source code in the xpl0 programming language

def  NOP=0, LDA=1, STA=2, ADD=3, SUB=4, BRZ=5, JMP=6, STP=7;
char Mem(32);
string 0;

proc Load(Prog);                \Load program into memory
char Prog;
int  PC, I, Ch, Hash;

    func GetNum;                \Return value of number
    int  Num;
    [while Ch <= $20 do
        [Ch:= Prog(I);  I:= I+1];
    Num:= 0;
    while Ch>=^0 and Ch<=^9 do
        [Num:= Num*10 + Ch - ^0;
        Ch:= Prog(I);  I:= I+1;
        ];
    return Num;
    ];
        
[PC:= 0;  I:= 0;
repeat  repeat Ch:= Prog(I);  I:= I+1;  until Ch > $20;
        if Ch>=^0 and Ch<=^9 then
                Mem(PC):= GetNum
        else    [Hash:= 0;
                while Ch >= ^A do
                    [Hash:= Hash + Ch;
                    Ch:= Prog(I);  I:= I+1;
                    ];
                case Hash of
                    ^N+^O+^P: Mem(PC):= NOP<<5;
                    ^L+^D+^A: Mem(PC):= LDA<<5 + GetNum;
                    ^S+^T+^A: Mem(PC):= STA<<5 + GetNum;
                    ^A+^D+^D: Mem(PC):= ADD<<5 + GetNum;
                    ^S+^U+^B: Mem(PC):= SUB<<5 + GetNum;
                    ^B+^R+^Z: Mem(PC):= BRZ<<5 + GetNum;
                    ^J+^M+^P: Mem(PC):= JMP<<5 + GetNum;
                    ^S+^T+^P: Mem(PC):= STP<<5
                other [Text(0, "Bad opcode at ");  IntOut(0, PC);  exit];
                ];
        PC:= PC+1;
until   Ch = 0;
];

proc Run(Prog);                 \Load and run a program
int  Prog, PC, Acc, Instr, Addr;
[Load(Prog);
PC:= 0;  Acc:= 0;
loop    [Instr:= Mem(PC) >> 5;
        Addr:= Mem(PC) & $1F;
        PC:= PC+1;
        case Instr of
          LDA:  Acc:= Mem(Addr);
          STA:  Mem(Addr):= Acc;
          ADD:  Acc:= Acc + Mem(Addr) & $FF;
          SUB:  Acc:= Acc - Mem(Addr) & $FF;
          BRZ:  if Acc = 0 then PC:= Addr;
          JMP:  PC:= Addr;
          STP:  quit
        other   [];     \NOP
        if PC > 31 then quit;
        ];
IntOut(0, Acc);  CrLf(0);
];

int Progs, N;
[Progs:= [
    "LDA 3 ADD 4 STP 2 2",
    "LDA 12 ADD 10 STA 12 LDA 11 SUB 13 STA 11 BRZ 8 JMP 0 LDA 12 STP 8 7 0 1",
    "LDA 14 STA 15 ADD 13 STA 14 LDA 15 STA 13 LDA 16 SUB 17 BRZ 11 STA 16 JMP 0
     LDA 14 STP 1 1 0 8 1",
    "LDA 13 ADD 15 STA 5 ADD 16 STA 7 NOP STA 14 NOP BRZ 11 STA 15 JMP 0 LDA 14
     STP LDA 0 0 28 1 0 0 0 6 0 2 26 5 20 3 30 1 22 4 24",
    "0 0 STP NOP LDA 3 SUB 29 BRZ 18 LDA 3 STA 29 BRZ 14 LDA 1 ADD 31 STA 1
     JMP 2 LDA 0 ADD 31 STA 0 JMP 2 LDA 3 STA 29 LDA 0 ADD 30 ADD 3 STA 0 LDA 1
     ADD 30 ADD 3 STA 1 JMP 2 0 1 3"];
for N:= 0 to 4 do Run(Progs(N));
]