Execute SNUSP/Algol68
Execute SNUSP/Algol68 is part of RCSNUSP. You may find other members of RCSNUSP at Category:RCSNUSP.
Algol 68 SNUSP Interpreter
Interpreter for Core SNUSP. Based on the Algol 68 BrainF*** sample.
Uses the same SNUSP program as the 11|, Go, etc. samples.
# Algol 68 SNUSP interpreter #
MODE BYTE = SHORT SHORT SHORT INT;
INT max byte = 255;
INT min byte = -255;
MODE PC = STRUCT( BYTE x, BYTE y, BYTE direction ); # code address and direction #
BYTE move up = 1; # directions #
BYTE move right = 2;
BYTE move down = 3;
BYTE move left = 4;
STRING directions = "^>v<";
# up right down left #
[]BYTE reflect forward = ( move right, move up, move left, move down );
[]BYTE reflect back = ( move left, move down, move right, move up );
# up right down left #
MODE OPCODE = BYTE;
OPCODE nop = 0;
MODE DADDR = BYTE; # data address #
MODE DATA = BYTE;
DATA zero = 0;
PROC run = ([,] OPCODE code area, BYTE start y, start x, BOOL trace)VOID:(
# initialise data #
[ min byte : max byte ]DATA data area; # finite data space #
FOR i FROM LWB data area TO UPB data area DO data area[i] := zero OD;
# data position and program address #
DADDR data addr := ( UPB data area + LWB data area ) OVER 2;
PC code addr := ( 1 LWB code area, 2 LWB code area, move right );
# starting position #
IF start y >= 1 LWB code area THEN y OF code addr := start y FI;
IF start x >= 2 LWB code area THEN x OF code addr := start x FI;
# op codes #
[0:max abs char]OPCODE assembler;
STRING op code area="!?><+-.,/\";
[]PROC VOID op list= []PROC VOID(
# 0: nop # VOID: SKIP,
# 1: ! # VOID: move,
# 2: ? # VOID: IF data area[ data addr ] = 0 THEN move FI,
# 3: > # VOID: data addr +:= 1,
# 4: < # VOID: data addr -:= 1,
# 5: + # VOID: data area[data addr] +:= 1,
# 6: - # VOID: data area[data addr] -:= 1,
# 7: . # VOID: print(REPR data area[data addr]),
# 8: , # VOID: data area[data addr]:=ABS read char,
# 9: / # VOID: direction OF code addr := reflect forward[ direction OF code addr ],
# 10: \ # VOID: direction OF code addr := reflect back[ direction OF code addr ]
)[:@0];
FOR op FROM LWB assembler TO UPB assembler DO assembler[op] := nop OD; # initially, all op codes are nop #
FOR op TO UPB op code area DO assembler[ABS op code area[op]] := op OD; # set known op codes #
# selects the next code address #
PROC move = VOID:
IF direction OF code addr = move left THEN x OF code addr -:= 1
ELIF direction OF code addr = move right THEN x OF code addr +:= 1
ELIF direction OF code addr = move up THEN y OF code addr -:= 1
ELSE # direction OF code addr = move down # y OF code addr +:= 1
FI;
# execute the code #
WHILE x OF code addr <= 1 UPB code area AND y OF code addr < 2 UPB code area DO
IF trace
THEN
print( ( ( "c: ("
+ whole( y OF code addr, 0 )
+ ","
+ whole( x OF code addr, 0 )
+ "), d: "
+ whole( data addr, 0 )
+ "("
+ directions[ direction OF code addr ]
+ whole( data area[ data addr ], 0 )
+ "/"
+ IF data area[ data addr ] < ABS " "
THEN
"."
ELSE
REPR data area[ data addr ]
FI
+ "), op: "
+ REPR code area[ y OF code addr, x OF code addr ]
+ "("
+ whole( code area[ y OF code addr, x OF code addr ], 0 )
+ ")"
+ whole( assembler[ code area[ y OF code addr, x OF code addr ] ], 0 )
)
, newline
)
)
FI;
op list[ABS assembler[ABS code area[ y OF code addr, x OF code addr ]]];
move
OD
);
BEGIN # test the interpreter #
# SNUSP program - prints Hello World! - as in Go etc. samples #
[]STRING snusp code = ( "/++++!/===========?\>++.>+.+++++++..+++\"
, "\+++\ | /+>+++++++>/ /++++++++++<<.++>./"
, "$+++/ | \+++++++++>\ \+++++.>.+++.-----\"
, " \==-<<<<+>+++/ /=.>.+>.--------.-/"
);
# convert the code to bytes #
[max byte, max byte]BYTE byte code area;
BYTE start x := -1;
BYTE start y := -1;
FOR i TO UPB snusp code DO
STRING code line = snusp code[i];
FOR j TO UPB code line DO
byte code area[i, j] := ABS code line[j];
IF code line[j] = "$" THEN # have the starting address #
start y := i;
start x := j
FI
OD;
FOR j FROM UPB code line + 1 TO 2 UPB byte code area DO
byte code area[i,j] := ABS "_"
OD
OD;
FOR i FROM UPB snusp code + 1 TO 1 UPB byte code area DO
FOR j TO 2 UPB byte code area DO
byte code area[i, j] := ABS "_"
OD
OD;
# execute the byte code #
run( byte code area, start y, start x, FALSE )
ENDOutput:
Hello World!