110 lines
2.9 KiB
Text
110 lines
2.9 KiB
Text
100H:
|
|
|
|
/* CP/M BDOS CALLS */
|
|
BDOS: PROCEDURE (FN, ARG) BYTE;
|
|
DECLARE FN BYTE, ARG ADDRESS;
|
|
GO TO 5;
|
|
END BDOS;
|
|
|
|
READ$CHAR: PROCEDURE BYTE; RETURN BDOS(1, 0); END READ$CHAR;
|
|
WRITE$CHAR: PROCEDURE (CHAR); DECLARE CHAR BYTE;
|
|
CHAR = BDOS(2, CHAR); END WRITE$CHAR;
|
|
PRINT: PROCEDURE (STRING); DECLARE STRING ADDRESS;
|
|
STRING = BDOS(9, STRING); END PRINT;
|
|
OPEN$FILE: PROCEDURE (FCB) BYTE; DECLARE FCB ADDRESS;
|
|
RETURN BDOS(15, FCB); END OPEN$FILE;
|
|
READ$FILE: PROCEDURE (FCB, ADDR) BYTE;
|
|
DECLARE (FCB, ADDR) ADDRESS, FOO BYTE;
|
|
FOO = BDOS(26, ADDR);
|
|
RETURN BDOS(20, FCB);
|
|
END READ$FILE;
|
|
EXIT: PROCEDURE; MEMORY(0) = BDOS(0,0); END EXIT;
|
|
|
|
/* TOP OF AVAILABLE MEMORY IN CP/M */
|
|
DECLARE MTPTR ADDRESS INITIAL (6), MEM$TOP BASED MTPTR ADDRESS;
|
|
|
|
/* FILE GIVEN ON COMMAND LINE */
|
|
DECLARE FCB1 LITERALLY '5CH';
|
|
|
|
/* PRINT ERROR AND EXIT */
|
|
ERROR: PROCEDURE (STRING);
|
|
DECLARE STRING ADDRESS;
|
|
CALL PRINT(STRING);
|
|
CALL EXIT;
|
|
END ERROR;
|
|
|
|
/* OPEN FILE */
|
|
IF OPEN$FILE(FCB1) = 0FFH THEN
|
|
CALL ERROR(.'CANNOT OPEN INPUT FILE$');
|
|
|
|
/* READ FILE BLOCK BY BLOCK */
|
|
DECLARE MP ADDRESS, M BASED MP BYTE;
|
|
MEMORY(0) = 26;
|
|
MP = .MEMORY + 1;
|
|
DO WHILE READ$FILE(FCB1, MP) <> 1;
|
|
MP = MP + 128;
|
|
END;
|
|
M = 26; /* TERMINATE WITH EOF */
|
|
MP = MP + 1;
|
|
|
|
/* CLEAR THE REST OF MEMORY */
|
|
DECLARE X ADDRESS;
|
|
DO X = 0 TO MEM$TOP-MP-1;
|
|
M(X) = 0;
|
|
END;
|
|
|
|
/* BRAINF*** I/O WITH CR/LF TRANSLATION */
|
|
BF$WRITE: PROCEDURE (CHAR);
|
|
DECLARE CHAR BYTE;
|
|
IF CHAR = 10 THEN CALL WRITE$CHAR(13);
|
|
CALL WRITE$CHAR(CHAR);
|
|
END BF$WRITE;
|
|
|
|
BF$READ: PROCEDURE BYTE;
|
|
DECLARE EOF$REACHED BYTE INITIAL (0), CH BYTE;
|
|
IF EOF$REACHED THEN RETURN 0;
|
|
CH = READ$CHAR;
|
|
IF CH = 13 THEN RETURN 10;
|
|
ELSE IF CH = 26 THEN DO;
|
|
EOF$REACHED = 1;
|
|
RETURN 0;
|
|
END;
|
|
ELSE RETURN CH;
|
|
END BF$READ;
|
|
|
|
/* EXECUTE COMMANDS */
|
|
DECLARE IP ADDRESS, I BASED IP BYTE;
|
|
DECLARE EOF$REACHED BYTE INITIAL (0), DEPTH ADDRESS;
|
|
DECLARE BRACKET$ERR DATA ('MISMATCHED BRACKETS$');
|
|
DECLARE B$OPEN LITERALLY '91', B$CLOSE LITERALLY '93';
|
|
IP = .MEMORY + 1;
|
|
DO WHILE I <> 26;
|
|
IF I = '+' THEN M = M + 1;
|
|
ELSE IF I = '-' THEN M = M - 1;
|
|
ELSE IF I = '>' THEN MP = MP + 1;
|
|
ELSE IF I = '<' THEN MP = MP - 1;
|
|
ELSE IF I = '.' THEN CALL BF$WRITE(M);
|
|
ELSE IF I = ',' THEN M = BF$READ;
|
|
ELSE IF I = B$OPEN AND M = 0 THEN DO;
|
|
DEPTH = 1;
|
|
DO WHILE DEPTH > 0;
|
|
IP = IP + 1;
|
|
IF I = B$OPEN THEN DEPTH = DEPTH + 1;
|
|
ELSE IF I = B$CLOSE THEN DEPTH = DEPTH - 1;
|
|
ELSE IF I = 26 THEN CALL ERROR(.BRACKET$ERR);
|
|
END;
|
|
END;
|
|
ELSE IF I = B$CLOSE AND M <> 0 THEN DO;
|
|
DEPTH = 1;
|
|
DO WHILE DEPTH > 0;
|
|
IP = IP - 1;
|
|
IF I = B$OPEN THEN DEPTH = DEPTH - 1;
|
|
ELSE IF I = B$CLOSE THEN DEPTH = DEPTH + 1;
|
|
ELSE IF I = 26 THEN CALL ERROR(.BRACKET$ERR);
|
|
END;
|
|
END;
|
|
IP = IP + 1;
|
|
END;
|
|
|
|
CALL EXIT;
|
|
EOF
|