OSDN Git Service

The sieve example programs in testsource run, such as they are.
[bif-6809/bif-6809.git] / junkbox / SCR34.LOC
1 \rSCR # 34 \r  0 ( ^ LABEL LOCVOC )\r  1                 ( JMR-93MAR21 )\r  2  BIF DEFINITIONS DECIMAL\r  3 \r  4 : ^ ( EXPONENT WITH ?ERROR )\r  5   -DUP 0= IF DROP 1 ( N 0 ^ )\r  6   ELSE OVER DUP 0= ( 0 N ^ )\r  7     SWAP 1 = OR ( 1 N ^ )\r  8     OVER 1 = OR ( N 1 ^ )\r  9     IF DROP\r 10     ELSE 1 SWAP\r 11       0 DO\r 12         OVER M* 54 ?ERROR\r 13       LOOP SWAP DROP\r 14     ENDIF ENDIF ;\r 15 \r 16 : LABEL ( --- ) ( BUILD GOTO )\r 17   <BUILDS IMMEDIATE COMPILE-ONLY\r 18   0 , DOES>\r 19   DUP @ IF COMPILE BRANCH\r 20     @ HERE - 2- ,\r 21   ELSE HERE SWAP !\r 22   ENDIF ;\r 23 \r 24 : LOCVOC VOCABULARY IMMEDIATE ;\r 25 \r 26 : GETNUMBER ( ADR N --- )\r 27   1- OVER 1+ SWAP EXPECT\r 28   BL ENCLOSE OVER + 0 SWAP C!\r 29   NUMBER DROP ;\r 30 \r 31 : $ DUP . ;\r