comment switch on the RULE TYPE of control card read;
switch CARDKIND := QCARD, TAPE, TEND, SKIP, HERE, DEBUG, LIST, END, STOP, TIME, DISC;
comment switch on the RULE TYPE of Turing machine rule being obeyed;
switch RULE TYPE := type 1 rule, type 2 rule, type 3 rule;
comment switch on the debugging mode;
switch DEBUG MODE := rule found, debug mode 1, debug mode 2, debug mode 3;
integer incnt, hereq, debug mode;
boolean tape input mode, found;
integer current state, current symbol, next state, next symbol, rule type;
A := 33;
B := A + 1;
C := B + 1;
D := C + 1;
E := D + 1;
F := E + 1;
G := F + 1;
H := G + 1;
I := H + 1;
J := I + 1;
K := J + 1;
L := K + 1;
M := L + 1;
N := M + 1;
O := N + 1;
P := O + 1;
Q := P + 1;
R := Q + 1;
S := R + 1;
T := S + 1;
U := T + 1;
V := U + 1;
W := V + 1;
X := W + 1;
Y := X + 1;
Z := Y + 1;
SP := 0;
LS := 2;
SLASH := 15;
ZERO := 20;
NINE := 29;
comment set up the input scheme;
nextch := 0;
comment set up the heap in the array LAV;
set up the heap(LAV(1), LAV(LSL), LAV(LSL+1), LAV(LAL), IDP);
clear list stack;
comment create a dynamic scope in the heap;
begin list scope;
comment declare ILF as an array of pointers into the heap;
declare list array(ILF, LIL);
comment set up the output buffering;
comment the EGDON routine DEFIOP(IDP, 0) is not supported;
begin
comment the following appalling code sets up the control card matching tree in the heap;
integer length, node c, node d, node e;
integer array name [1:10]; comment upper bound set generously;
integer procedure make name branch (name length, switching code);
value name length, switching code;
integer name length, switching code;
comment enter a word, held in name(1..name length), and its switching code,
into the name-matching tree and return a pointer to its root;
begin
integer cell, i;
cell := switching code;
for i := 1 step 1 until name length do
cell := IJK(cell, name(i), 0);
make name branch := cell;
end of make name branch;
procedure add letter to name (letter); value letter; integer letter;
comment add a letter of a word to name, IN REVERSE ORDER;
begin
name(length) := -letter;
length := length - 1;
end of add letter to name;
comment declare heap pointers;
declare list(name tree);
begin list scope;
declare list(node c);
declare list(node d);
declare list(node e);
comment set heap pointers to NIL;
name tree := node d := node e := node c := 0;
comment build the control-card matching tree in the heap;
comment insert LIST;
length := 5; for char := L, I, S, T, SP, do add letter to name(char);
node e := make name branch(5, 7);
comment insert HERE;
length := 5; for char := H, E, R, E, SP, do add letter to name(char);
node d := make name branch(5, 5);
setK(node d, node e);
node e := node d;
comment insert END;
length := 4; for char := E, N, D, SP, do add letter to name(char);
node d := make name branch(4, 8);
setK(node d, node e);
node e := node d;
comment insert ISC, the D of DISC goes in via DEBUG;
length := 4; for char := I, S, C, SP do add letter to name(char);
node c := make name branch(4, 11);
comment insert DEBUG;
length := 6; for char := D, E, B, U, G, SP do add letter to name(char);
node d := make name branch(6, 6);
setK(node d, node e);
node e := node d;
setK(iP(node d), node c);
comment insert TOP, the S of STOP goes in via SKIP;
length := 4; for char := T, O, P, SP, do add letter to name(char);
node c := make name branch(4, 9);
comment insert SKIP;
length := 5; for char := S, K, I, P, SP, do add letter to name(char);
node d := make name branch(5, 4);
setK(node d, node e);
node e := node d;
node d := iP(node d);
setK(node d, node c);
comment insert END, the T of TEND goes in via TAPE;
length := 4; for char := E, N, D, SP do add letter to name(char);
node c := make name branch(4, 3);
comment insert IME, the T of TIME goes in via TAPE;
length := 4; for char := I, M, E, SP do add letter to name(char);
node d := make name branch(4, 10);
setK(node c, node d);
comment insert /TAPE;
length := 6; for char := SLASH, T, A, P, E, SP do add letter to name(char);
node d := make name branch(6, 2);
comment finalize the name tree;
setK(iP(node d), node e);
setK(iP(iP(node d)), node c);
node e := node d;
setK(node e, IJK(IJK(1, 0, 0), Q, 0));
name tree := node e;
comment close the dynamic scope;
end list scope;
end of setting up name tree with the control card matches;
SETUP:
clear the tape;
for a := 0 step 1 until LIL do ILF(a) := 0;
incnt := hereq := debug mode := 0;
tape input mode := found := false
herep := 1;
right limit := 32;
left limit := 72;
time limit := CPU time in seconds + 10;
skip past the end of the line:
if nextch != LS then goto skip past the end of the line;
get a new line:
inpch;
MAIN: comment switching on input RULE TYPE;
goto CARDKIND(treesw);
FAIL: comment The nature of the line is not recognised.
If we are in tape input mode
then the line is added to the TM tape
else it is ignored;
if tape input mode then add to the tape else goto skip past the end of the line;
QCARD:
begin
integer this state, this symbol, action, next state;
this state := inint; this symbol := inpch; action := inpch;
if action != 50 and action != 44 then
nextch
else
if action = 50 then action := 62 else action := 63;
next state := inpch;
next state := inint;
begin list scope;
ILF(this state) := insert rule(next state, action, this symbol, ILF(this state));
end list scope;
if this state != current state or this symbol != current symbol then
goto get a new line;
comment The Q card matches the current configuration of the Turing machine,
so resume simulation;
end
TICK:
if CPU time in seconds > time limit then
begin
comment print /TIME UP;
for char := SLASH, 52, 41, 45, 37, SP, 53, 48, 64 do outch(char);
comment the EGDON FDUMP is not supported;
end
else
begin
split(find(current symbol, ILF(current state)), next state, next symbol);
rule type := if next symbol < 62 then 1 else next symbol-60
end
comment Check for debugging modes and act accordingly;
goto DEBUG MODE(debug mode+1);
debug mode 3:
print the tape expression;
debug mode 2:
print state;
if found then goto RULE TYPE(rule type) else goto no rule found;
debug mode 1:
print the tape expression;
if found then goto RULE TYPE(rule type) else goto no rule found;
rule found:
if found then goto RULE TYPE(rule type);
no rule found:
if debug mode = 2 then print the tape expression;
goto get a new line;
type 1 rule:
write to tape(next symbol); current symbol := next symbol; current state := next state; goto TICK;
type 2 rule:
move the tape left; current symbol := read from tape; current state := next state; goto TICK;
type 3 rule:
move the tape right; current symbol := read from tape; current state := next state; goto TICK;
TAPE:
if tape input mode then add to the tape;
incnt := herep := hereq := 0;
tape input mode := true
clear the tape;
goto skip past the end of the line;
TEND:
if not tape input mode or incnt = 0 then goto skip past the end of the line;
for a := incnt step -1 until herep do move the tape right;
herep := 1;
tape input mode := false
read from tape(current symbol);
current state := hereq;
DNET:
if inpch != LS then goto DNET;
goto TICK;
SKIP:
if tape input mode then
begin
integer amount, i;
amount := inint;
for i := 1 step - until amount do
begin
write to tape(SP);
move the tape left;
end;
incnt := incnt + amount;
goto get a new line
end
goto skip past the end of the line;
HERE:
if tape input mode then
begin
next non blank;
herep := incnt + 1;
hereq := inint;
goto get a new line
end
goto skip past the end of the line;
DEBUG:
if tape input mode then add to the tape;
debug mode := inint;
goto get a new line;
LIST:
if tape input mode then add to the tape;
left limit := inint;
right limit := inint;
goto get a new line;
END:
if tape input mode then add to the tape;
end list scope;
print the tape expression;
goto SETUP;
TIME:
if tape input mode then add to the tape;
time limit := CPU time in seconds + inint;
goto get a new line;
DISC:
if tape input mode then add to the tape;
comment is no longer relevant;
goto skip past the end of the line;
STOP:
if tape input mode then add to the tape;
for char := LS, SLASH, S, T, O, P, S, LS do outch(char);
end of inner block
end of AMTSIM
|