100H:
BDOS: PROCEDURE (FN,ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; GO TO 0; END EXIT;
PRINT: PROCEDURE (STR); DECLARE STR ADDRESS; CALL BDOS(9, STR); END PRINT;

PRINT$NUM: PROCEDURE (N);
    DECLARE N ADDRESS, I BYTE;
    DECLARE S (6) BYTE INITIAL ('.....$');
    I = 5;
    DIGIT: DO;
        S(I := I-1) = '0' + N MOD 10;
        IF (N := N/10) > 0 THEN GO TO DIGIT;
    END;
    CALL PRINT(.S(I));
END PRINT$NUM;

FIND: PROCEDURE (STR, CHR) ADDRESS;
    DECLARE STR ADDRESS, CHR BYTE;
    DECLARE S BASED STR BYTE, I ADDRESS;
    I = 0;
    DO WHILE S(I) <> CHR; I = I+1; END;
    RETURN I;
END FIND;

MOVE$TO$FRONT: PROCEDURE (SYMTAB, SYM);
    DECLARE SYMTAB ADDRESS, SYM BYTE, TMP BYTE;
    DECLARE S BASED SYMTAB BYTE, I ADDRESS;
    I = FIND(SYMTAB, SYM);
    DO WHILE I>0; S(I) = S(I := I-1); END;
    S(0) = SYM;
END MOVE$TO$FRONT;

COPY$STRING: PROCEDURE (INSTR, OUTSTR);
    DECLARE (INSTR, OUTSTR) ADDRESS;
    DECLARE (I BASED INSTR, O BASED OUTSTR) BYTE;
    DO WHILE I <> '$';
        O = I;
        INSTR = INSTR + 1;
        OUTSTR = OUTSTR + 1;
    END;
    O = '$';
END COPY$STRING;

STR$LEN: PROCEDURE (STR) ADDRESS;
    DECLARE STR ADDRESS;
    RETURN FIND(STR, '$');
END STR$LEN;

STR$EQ: PROCEDURE (STR1, STR2) BYTE;
    DECLARE (STR1, STR2) ADDRESS;
    DECLARE (S1 BASED STR1, S2 BASED STR2) BYTE;
    DECLARE I ADDRESS;
    I = 0;
    DO WHILE S1(I) = S2(I) AND S1(I) <> '$'; I=I+1; END;
    RETURN S1(I) = S2(I);
END STR$EQ;

ENCODE: PROCEDURE (STR, SYMTAB, RESULT);
    DECLARE (STR, SYMTAB, RESULT) ADDRESS;
    DECLARE S BASED STR BYTE, R BASED RESULT BYTE, I ADDRESS;
    DECLARE TEMP$SYMTAB (256) BYTE;

    CALL COPY$STRING(SYMTAB, .TEMP$SYMTAB);
    DO I=0 TO STR$LEN(STR) - 1;
        R(I) = FIND(.TEMP$SYMTAB, S(I));
        CALL MOVE$TO$FRONT(.TEMP$SYMTAB, S(I));
    END;
END ENCODE;

DECODE: PROCEDURE (ARR, SZ, SYMTAB, RESULT);
    DECLARE (ARR, SZ, SYMTAB, RESULT) ADDRESS;
    DECLARE N BASED ARR BYTE, R BASED RESULT BYTE, I ADDRESS;
    DECLARE TEMP$SYMTAB (256) BYTE;

    CALL COPY$STRING(SYMTAB, .TEMP$SYMTAB);
    DO I=0 TO SZ-1;
        R(I) = TEMP$SYMTAB(N(I));
        CALL MOVE$TO$FRONT(.TEMP$SYMTAB, R(I));
    END;
    R(SZ) = '$';
END DECODE;

PRINT$ARR: PROCEDURE (ARR, SZ);
    DECLARE (ARR, SZ) ADDRESS;
    DECLARE N BASED ARR BYTE, I ADDRESS;
    DO I=0 TO SZ-1;
        CALL PRINT$NUM(N(I));
        CALL PRINT(.' $');
    END;
END PRINT$ARR;

TEST: PROCEDURE (STR);
    DECLARE STR ADDRESS, SZ ADDRESS;
    DECLARE ENC$ARR (256) BYTE;
    DECLARE SYMTAB (27) BYTE INITIAL ('ABCDEFGHIJKLMNOPQRSTUVWYXZ$');
    DECLARE DEC$STR (256) BYTE;

    SZ = STR$LEN(STR);

    CALL PRINT(STR);
    CALL PRINT(.' -> $');
    CALL ENCODE(STR, .SYMTAB, .ENC$ARR);
    CALL PRINT$ARR(.ENC$ARR, SZ);
    CALL PRINT(.'-> $');
    CALL DECODE(.ENC$ARR, SZ, .SYMTAB, .DEC$STR);
    CALL PRINT(.DEC$STR);

    IF STR$EQ(STR, .DEC$STR)
        THEN CALL PRINT(.' (OK)$');
        ELSE CALL PRINT(.' (FAIL)$');

    CALL PRINT(.(13,10,'$'));
END TEST;

CALL TEST(.'BROOOD$');
CALL TEST(.'BANANAAA$');
CALL TEST(.'HIPHOPHIPHOP$');
CALL EXIT;
EOF