Execute SNUSP/Algol68

Algol 68 SNUSP Interpreter

Works with: ALGOL 68G version Any - tested with release 2.8.3.win32

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 )
END

Output:

Hello World!