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.
<lang algol68># 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 )
END</lang>
Output:
Hello World!