81 lines
2 KiB
Text
81 lines
2 KiB
Text
100H:
|
|
|
|
/* CHECK EXACT PALINDROME ASSUMING $-TERMINATED STRING */
|
|
PALINDROME: PROCEDURE(PTR) BYTE;
|
|
DECLARE (PTR, FRONT, BACK) ADDRESS, STR BASED PTR BYTE;
|
|
|
|
/* FIND END */
|
|
FRONT, BACK = 0;
|
|
DO WHILE STR(BACK) <> '$';
|
|
BACK = BACK + 1;
|
|
END;
|
|
BACK = BACK - 1;
|
|
|
|
/* CHECK MATCH */
|
|
DO WHILE (FRONT < BACK) AND (STR(FRONT) = STR(BACK));
|
|
FRONT = FRONT + 1;
|
|
BACK = BACK - 1;
|
|
END;
|
|
|
|
RETURN FRONT >= BACK;
|
|
END PALINDROME;
|
|
|
|
/* CHECK INEXACT PALINDROME: FILTER OUT NON-LETTERS AND NUMBERS */
|
|
INEXACT$PALINDROME: PROCEDURE(PTR) BYTE;
|
|
/* 256 BYTES OUGHT TO BE ENOUGH FOR EVERYONE */
|
|
DECLARE (PTR, OPTR) ADDRESS;
|
|
DECLARE FILTER (256) BYTE;
|
|
DECLARE (IN BASED PTR, OUT BASED OPTR) BYTE;
|
|
OPTR = .FILTER;
|
|
|
|
DO WHILE IN <> '$';
|
|
OUT = IN OR 32;
|
|
/* LOWERCASE CHARACTERS ARE NOT IN THE PL/M CHARSET,
|
|
BUT WE CAN JUST WRITE THE ASCII VALUES AS NUMBERS */
|
|
IF (OUT >= '0' AND OUT <= '9')
|
|
OR (OUT >= 97 AND OUT <= 122) THEN
|
|
OPTR = OPTR + 1;
|
|
PTR = PTR + 1;
|
|
END;
|
|
OUT = '$';
|
|
|
|
RETURN PALINDROME(.FILTER);
|
|
END INEXACT$PALINDROME;
|
|
|
|
/* CP/M BDOS CALLS */
|
|
BDOS: PROCEDURE(FUNC, ARG);
|
|
DECLARE FUNC BYTE, ARG ADDRESS;
|
|
GO TO 5;
|
|
END BDOS;
|
|
|
|
PRINT: PROCEDURE(STRING);
|
|
DECLARE STRING ADDRESS;
|
|
CALL BDOS(9, STRING);
|
|
END PRINT;
|
|
|
|
/* TEST SOME STRINGS */
|
|
DECLARE STRINGS (8) ADDRESS;
|
|
STRINGS(0) = .'ROTOR$';
|
|
STRINGS(1) = .'RACECAR$';
|
|
STRINGS(2) = .'LEVEL$';
|
|
STRINGS(3) = .'REDDER$';
|
|
STRINGS(4) = .'RACECAR$';
|
|
STRINGS(5) = .'A MAN, A PLAN, A CANAL: PANAMA$';
|
|
STRINGS(6) = .'EGAD, A BASE TONE DENOTES A BAD AGE.$';
|
|
STRINGS(7) = .'ROSETTA$';
|
|
|
|
DECLARE N BYTE;
|
|
DO N = 0 TO LAST(STRINGS);
|
|
CALL PRINT(STRINGS(N));
|
|
CALL PRINT(.': $');
|
|
IF PALINDROME(STRINGS(N)) THEN
|
|
CALL PRINT(.'EXACT$');
|
|
ELSE IF INEXACT$PALINDROME(STRINGS(N)) THEN
|
|
CALL PRINT(.'INEXACT$');
|
|
ELSE
|
|
CALL PRINT(.'NOT A PALINDROME$');
|
|
CALL PRINT(.(13,10,'$'));
|
|
END;
|
|
|
|
CALL BDOS(0,0);
|
|
EOF
|