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