61 lines
1.4 KiB
Plaintext
61 lines
1.4 KiB
Plaintext
100H:
|
|
|
|
/* ABC PROBLEM ON $-TERMINATED STRING */
|
|
CAN$MAKE$WORD: PROCEDURE (STRING) BYTE;
|
|
DECLARE STRING ADDRESS, CHAR BASED STRING BYTE;
|
|
DECLARE CONST$BLOCKS DATA
|
|
('BOKXDQCPNAGTRETGQDFSJWHUVIANOBERFSLYPCZM');
|
|
DECLARE I BYTE, BLOCKS (40) BYTE;
|
|
|
|
DO I=0 TO 39; /* MAKE COPY OF BLOCKS */
|
|
BLOCKS(I) = CONST$BLOCKS(I);
|
|
END;
|
|
|
|
STEP: DO WHILE CHAR <> '$';
|
|
DO I=0 TO 39; /* FIND BLOCK WITH CURRENT CHAR */
|
|
IF BLOCKS(I) = CHAR THEN DO; /* FOUND IT */
|
|
BLOCKS(I) = 0; /* CLEAR OUT BOTH LETTERS ON BLOCK */
|
|
BLOCKS(I XOR 1) = 0;
|
|
STRING = STRING + 1;
|
|
GO TO STEP; /* NEXT CHARACTER */
|
|
END;
|
|
END;
|
|
RETURN 0; /* NO BLOCK WITH LETTER */
|
|
END;
|
|
|
|
RETURN 1; /* WE FOUND THEM ALL */
|
|
END CAN$MAKE$WORD;
|
|
|
|
/* CP/M BDOS CALL */
|
|
BDOS: PROCEDURE (FN, ARG);
|
|
DECLARE FN BYTE, ARG ADDRESS;
|
|
GO TO 5;
|
|
END BDOS;
|
|
|
|
PRINT: PROCEDURE (STRING);
|
|
DECLARE STRING ADDRESS;
|
|
CALL BDOS(9, STRING);
|
|
END PRINT;
|
|
|
|
/* TEST SEVERAL STRINGS */
|
|
DECLARE TEST (7) ADDRESS, I BYTE;
|
|
TEST(0) = .'A$';
|
|
TEST(1) = .'BARK$';
|
|
TEST(2) = .'BOOK$';
|
|
TEST(3) = .'TREAT$';
|
|
TEST(4) = .'COMMON$';
|
|
TEST(5) = .'SQUAD$';
|
|
TEST(6) = .'CONFUSE$';
|
|
|
|
DO I = 0 TO LAST(TEST);
|
|
CALL PRINT(TEST(I));
|
|
CALL PRINT(.': $');
|
|
IF CAN$MAKE$WORD(TEST(I))
|
|
THEN CALL PRINT(.'YES$');
|
|
ELSE CALL PRINT(.'NO$');
|
|
CALL PRINT(.(13,10,'$'));
|
|
END;
|
|
|
|
CALL BDOS(0,0);
|
|
EOF
|