Data commit

Task/Stern-Brocot-sequence/PL-M/stern-brocot-sequence.plm

@@ -0,0 +1,88 @@
+100H:
+/* FIND LOCATION OF FIRST ELEMENT IN ARRAY */
+FIND$FIRST: PROCEDURE (ARR, EL) ADDRESS;
+    DECLARE (ARR, N) ADDRESS, (EL, A BASED ARR) BYTE;
+    N = 0;
+LOOP:
+    IF A(N) = EL THEN RETURN N;
+    ELSE N = N + 1;
+    GO TO LOOP;
+END FIND$FIRST;
+
+/* CP/M 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;
+
+/* PRINT NUMBER */
+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';
+    IF (N := N / 10) > 0 THEN GO TO DIGIT;
+    CALL PRINT(P);
+END PRINT$NUMBER;
+
+/* GENERATE FIRST 1200 ELEMENTS OF STERN-BROCOT SEQUENCE */
+DECLARE S (1201) BYTE, I ADDRESS;
+S(1) = 1;
+S(2) = 1;
+DO I = 2 TO 600;
+    S(I*2-1) = S(I) + S(I-1);
+    S(I*2) = S(I);
+END;
+
+/* PRINT FIRST 15 ELEMENTS */
+CALL PRINT(.'FIRST 15 ELEMENTS: $');
+DO I = 1 TO 15;
+    CALL PRINT$NUMBER(S(I));
+    CALL PRINT(.' $');
+END;
+CALL PRINT(.(13,10,'$'));
+
+/* PRINT FIRST OCCURRENCE OF N */
+PRINT$FIRST: PROCEDURE (N);
+    DECLARE N BYTE;
+    CALL PRINT(.'FIRST $');
+    CALL PRINT$NUMBER(N);
+    CALL PRINT(.' AT $');
+    CALL PRINT$NUMBER(FIND$FIRST(.S, N));
+    CALL PRINT(.(13,10,'$'));
+END PRINT$FIRST;
+
+DO I = 1 TO 10;
+    CALL PRINT$FIRST(I);
+END;
+CALL PRINT$FIRST(100);
+
+/* CHECK GCDS */
+GCD: PROCEDURE (A, B) BYTE;
+    DECLARE (A, B, C) BYTE;
+LOOP:
+    C = A;
+    A = B;
+    B = C MOD A;
+    IF B <> 0 THEN GO TO LOOP;
+    RETURN A;
+END GCD;
+
+DO I = 2 TO 1000;
+    IF GCD(S(I-1),S(I)) <> 1 THEN DO;
+        CALL PRINT(.'GCD NOT 1 AT: $');
+        CALL PRINT$NUMBER(I);
+        CALL BDOS(0,0);
+    END;
+END;
+
+CALL PRINT(.'ALL GCDS ARE 1$');
+CALL BDOS(0,0);
+EOF