RosettaCodeData/Task/Subleq/Pascal/subleq.pas

62 lines
1.1 KiB
ObjectPascal

PROGRAM OISC;
CONST
MAXADDRESS = 1255;
TYPE
MEMORY = PACKED ARRAY [0 .. MAXADDRESS] OF INTEGER;
VAR
MEM : MEMORY;
FILENAME : STRING;
PROCEDURE LOADTEXT (FILENAME : STRING; VAR MEM : MEMORY);
VAR
NUMBERS : TEXT;
ADDRESS : INTEGER;
BEGIN
ASSIGN (NUMBERS, FILENAME);
ADDRESS := 0;
RESET (NUMBERS);
WHILE (ADDRESS <= MAXADDRESS) AND NOT EOF (NUMBERS) DO BEGIN
READ (NUMBERS, MEM [ADDRESS]);
ADDRESS := ADDRESS + 1
END;
CLOSE (NUMBERS);
FOR ADDRESS := ADDRESS TO MAXADDRESS DO
MEM [ADDRESS] := 0
END;
PROCEDURE SUBLEQ (VAR MEM : MEMORY);
VAR
ADDRESS, A, B, C : INTEGER;
IO : CHAR;
BEGIN
ADDRESS := 0;
WHILE ADDRESS >= 0 DO BEGIN
A := MEM [ADDRESS];
B := MEM [ADDRESS + 1];
C := MEM [ADDRESS + 2];
ADDRESS := ADDRESS + 3;
IF A = -1 THEN BEGIN
READ (IO);
MEM [B] := ORD (IO)
END
ELSE IF B = -1 THEN BEGIN
IO := CHR (MEM [A]);
WRITE (IO)
END
ELSE BEGIN
MEM [B] := MEM [B] - MEM [A];
IF MEM [B] <= 0 THEN ADDRESS := C
END
END
END;
BEGIN
WRITE ('Filename>');
READLN (FILENAME);
LOADTEXT (FILENAME, MEM);
SUBLEQ (MEM);
END.