junkbox/SCR40.431

   1 \rSCR # 40 \r  0 ( CS431 TESTPARAMS FACTORIAL )\r  1                 ( JMR-93MAR24 )\r  2  DECIMAL 33 LOAD ( ARRAYS )\r  3  DECIMAL 34 LOAD ( ^ LABEL )\r  4 BIF DEFINITIONS LOCVOC CS431\r  5  CS431 DEFINITIONS DECIMAL\r  6 6805 VARIABLE X 6800 VARIABLE Y\r  7  LOCVOC     PARAMSLOCAL\r  8  PARAMSLOCAL DEFINITIONS\r  9 0 VARIABLE A    0 VARIABLE B\r 10 0 VARIABLE C    0 VARIABLE X\r 11 0 2 2 1ARRAY D\r 12  CS431 DEFINITIONS PARAMSLOCAL\r 13 : TESTPARAMS ( N ADR --- )\r 14   1 A !  2 B !  3 C !  4 X !\r 15   4 0 D !  5 1 D !  6 2 D !\r 16   SWAP ." BY-VAL WAS" .\r 17   DUP @ 0 D @ * 2 D @ C @ / -\r 18     1 D @ A @ * B @ * + SWAP\r 19   OVER 0 D @ / B @ * 2 D @ *\r 20     OVER !\r 21   ." BY-VAL PARAMETER=" SWAP .\r 22   ." BY-ADR PARAMETER=" @ .\r 23   ." LOCAL X=" X @ . ; CS431\r 24 : FACTORIAL ( ADR --- )\r 25   [ SMUDGE ] ( RECURSIVE )\r 26   DUP @ 12 > IF ." TOO BIG "\r 27   ELSE ." FACTOR" DUP ?\r 28     DUP @ 2 > IF\r 29       DUP @ 1- SP@ FACTORIAL\r 30       OVER @ * OVER ! ENDIF\r 31   ENDIF ." N!=" ? ; SMUDGE   -->\r\rSCR # 41 \r  0 ( CS431 RECORDS )\r  1                 ( JMR-93MAR24 )\r  2  CS431 DEFINITIONS\r  3 LOCVOC     RECLOC\r  4  RECLOC DEFINITIONS\r  5 LOCVOC     US\r  6  US DEFINITIONS\r  7 0 VARIABLE ME   0 VARIABLE YOU\r  8 0 2 2 1ARRAY THEM\r  9  RECLOC DEFINITIONS\r 10 0 VARIABLE X\r 11  CS431 DEFINITIONS RECLOC\r 12 : TESTRECORDS ( --- )\r 13   1 X !   US 3 ME !   6 YOU !\r 14   2 0 THEM !   4 1 THEM !\r 15   6 2 THEM !\r 16   2 THEM @ 10 * YOU @ /\r 17     1 THEM @ - 0 THEM @ +  ME !\r 18   ." BEFORE CALL, US.ME=" ME ?\r 19   ."   US.THEM[2]=" 2 THEM ?\r 20   ME @ 2 THEM TESTPARAMS\r 21   ." AFTER CALL, LOCAL X=" X ?\r 22   ." GLOBAL X=" CS431 X ?\r 23   RECLOC US\r 24   ." US.ME=" ME ?\r 25   ." US.THEM[2]=" 2 THEM ? ;\r 26   CS431 DEFINITIONS\r 27   -->\r 28 \r 29 \r 30 \r 31 \r\rSCR # 42 \r  0 ( CS431 MAIN )\r  1                 ( JMR-93MAR24 )\r  2  CS431 DEFINITIONS DECIMAL\r  3 LOCVOC     MAINLOC\r  4  MAINLOC DEFINITIONS\r  5  LABEL LOOPTO\r  6 0 VARIABLE A   0 VARIABLE B\r  7 0 VARIABLE C   0 VARIABLE D\r  8 0 VARIABLE E   0 VARIABLE F\r  9 0 VARIABLE G\r 10 0 VARIABLE I   0 VARIABLE J\r 11 0 VARIABLE K   0 VARIABLE X\r 12 0 VARIABLE CHOICE\r 13 0 VARIABLE RESULT\r 14 [& -1 1 ,& 5 7 ,& 10 11\r 15  2 ]& ARRAY\r 16 0 79 1 1ARRAY STR\r 17 0 VARIABLE AA   0 VARIABLE BB\r 18 0 VARIABLE CC   0 VARIABLE DRES\r 19  CS431 DEFINITIONS MAINLOC\r 20 ( MIGHT AS WELL START HERE! )\r 21 : MAIN ( --- ) ( WE HOPE )\r 22   LOOPTO ." CHOICE (1 - 9): "\r 23  0 STR 80 GETNUMBER\r 24   DUP CHOICE ! 0= IF\r 25     ." I BE DONE!" QUIT\r 26   ELSE CHOICE @ 1 = IF\r 27     1 A !  2 B !  3 C !  4 D !\r 28     5 E !  6 F !  7 G !\r 29     A @ B @ * $ C @ D @ * $\r 30     F @ B @ / $ D @ B @ / $\r 31     G @ 100 * $           -->\r\rSCR # 43 \r  0 ( CS431 CONTINUE MAIN )\r  1 \r  2   E @ E @ * E @ * $ 23 C @ - $\r  3   B @ G @ B @ - * C @ * $\r  4   C @ A @ B @ D @ * + * E @ / $\r  5   A @ B @ + C @ + G @ F @ -\r  6     D @ - * $\r  7   E @ F @ + G @ + A @ B @ + / $\r  8   G @ MINUS G @ - $\r  9   A @ MINUS B @ MINUS *\r 10     G @ MINUS +   $\r 11   F @ D @ * MINUS\r 12     B @ C @ * MINUS / $\r 13     + + + + + + + +\r 14     - + - + +\r 15     RESULT !\r 16     ." RESULT=" RESULT ?\r 17   ELSE CHOICE @ 2 = IF\r 18     2 AA ! 3 BB ! 4 CC !\r 19     AA @ AA @ ^ AA @ BB @ ^ +\r 20       AA @ ^ AA @ CC @ ^ /\r 21       DRES ! DRES @ RESULT !\r 22     ." RESULT=" RESULT ?\r 23   ELSE CHOICE @ 3 = IF\r 24     2 -1 DO\r 25 BIF I MAINLOC I !\r 26       8 5 DO\r 27 BIF I MAINLOC J !\r 28         12 10 DO\r 29 BIF I MAINLOC K !\r 30           ." ARRAY AT"\r 31           I ? J ? K ?     -->\r\rSCR # 44 \r  0 ( CS431 MAIN CONTINUED )\r  1 \r  2           0 STR 80\r  3           GETNUMBER\r  4           I @ J @ K @ ARRAY !\r  5         LOOP LOOP LOOP\r  6     0 RESULT !\r  7     2 -1 DO\r  8 BIF I MAINLOC I !\r  9       8 5 DO\r 10 BIF I MAINLOC J !\r 11         12 10 DO\r 12 BIF I MAINLOC K !\r 13           I @ J @ K @ ARRAY @\r 14           RESULT +!\r 15     LOOP LOOP LOOP\r 16     ." RESULT=" RESULT ?\r 17   ELSE CHOICE @ 4 = IF\r 18     21 0 DO\r 19 BIF I MAINLOC I !\r 20       I @ 0= IF ." ZERO"\r 21       ELSE I @ 10 < IF\r 22         ." I=" I ?\r 23       ELSE I @ 10 = IF\r 24         16 I ! R> DROP 16 >R\r 25       ELSE ." NEAT-O"\r 26       ENDIF ENDIF ENDIF\r 27     2 +LOOP\r 28   ELSE CHOICE @ 5 = IF\r 29     2 A ! 4 B ! 0 X !\r 30     ." A BEFORE CALL=" A ?\r 31     ." B BEFORE CALL=" B ? -->\r\rSCR # 45 \r  0 ( CS431 MAIN CONTINUED )\r  1 \r  2     A @ B TESTPARAMS\r  3     ." AFTER A=" A ?\r  4     ." AFTER B=" B ?\r  5     ." GLOBAL X=" CS431 X ?\r  6     ." MAIN X=" MAINLOC X ?\r  7   ELSE CHOICE @ 6 = IF\r  8     0 STR 80\r  9     GETNUMBER\r 10     SP@ FACTORIAL ." ^:" 0 D.\r 11   ELSE CHOICE @ 7 = IF\r 12     TESTRECORDS\r 13   ELSE CHOICE @ 8 = IF\r 14     ." NO CASE "\r 15   ENDIF ENDIF ENDIF ENDIF\r 16   ENDIF ENDIF ENDIF ENDIF\r 17   ENDIF\r 18   CHOICE @ 9 < IF LOOPTO ENDIF\r 19 \r 20   ." THE WRONG END TO PRINT" ;\r 21  ;S\r 22 \r 23 \r 24 \r 25 \r 26 \r 27 \r 28 \r 29 \r 30 \r 31 \r