61 lines
1.7 KiB
Text
61 lines
1.7 KiB
Text
100H:
|
|
/* CP/M CALLS */
|
|
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
|
|
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
|
|
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
|
|
|
|
/* CP/M COMMAND LINE ARGUMENT */
|
|
DECLARE ARG$LPTR ADDRESS INITIAL (80H), ARG$LEN BASED ARG$LPTR BYTE;
|
|
DECLARE ARG$PTR ADDRESS INITIAL (81H), ARG BASED ARG$PTR BYTE;
|
|
|
|
/* CONVERT ROMAN NUMERAL TO BINARY */
|
|
READ$ROMAN: PROCEDURE (RP) ADDRESS;
|
|
DECLARE DIGITS (7) BYTE INITIAL ('MDCLXVI');
|
|
DECLARE VALUES (7) ADDRESS INITIAL (1000,500,100,50,10,5,1);
|
|
DECLARE (RP, V, DVAL) ADDRESS, R BASED RP BYTE;
|
|
V = 0;
|
|
|
|
GET$DIGIT: PROCEDURE (D) ADDRESS;
|
|
DECLARE (D, I) BYTE;
|
|
DO I = 0 TO LAST(DIGITS);
|
|
IF DIGITS(I) = D THEN RETURN VALUES(I);
|
|
END;
|
|
RETURN 0; /* NOT FOUND */
|
|
END GET$DIGIT;
|
|
|
|
DO WHILE R <> '$';
|
|
DVAL = GET$DIGIT(R);
|
|
IF DVAL = 0 THEN RETURN 0; /* ERROR */
|
|
RP = RP + 1;
|
|
IF GET$DIGIT(R) > DVAL THEN
|
|
V = V - DVAL; /* SUBTRACTIVE PRINCIPLE */
|
|
ELSE
|
|
V = V + DVAL;
|
|
END;
|
|
RETURN V;
|
|
END READ$ROMAN;
|
|
|
|
/* PRINT BINARY NUMBER AS DECIMAL */
|
|
PRINT$NUMBER: PROCEDURE (N);
|
|
DECLARE S (6) BYTE INITIAL ('.....$');
|
|
DECLARE (N, P) ADDRESS, C BASED P BYTE;
|
|
P = .S(5);
|
|
DIGIT:
|
|
P = P - 1;
|
|
C = N MOD 10 + '0';
|
|
N = N / 10;
|
|
IF N > 0 THEN GO TO DIGIT;
|
|
CALL PRINT(P);
|
|
END PRINT$NUMBER;
|
|
|
|
IF ARG$LEN = 0 THEN DO;
|
|
CALL PRINT(.'NO INPUT$');
|
|
CALL EXIT;
|
|
END;
|
|
|
|
ARG(ARG$LEN) = '$'; /* TERMINATE ARGUMENT STRING */
|
|
CALL PRINT(.ARG(1)); /* PRINT ROMAN NUMERAL */
|
|
CALL PRINT(.': $');
|
|
CALL PRINT$NUMBER(READ$ROMAN(.ARG(1))); /* CONVERT AND PRINT VALUE */
|
|
CALL EXIT;
|
|
EOF
|