119 lines
3 KiB
Text
119 lines
3 KiB
Text
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
|