( FORPS2                                3/01/87 )                    The following screens are based on the article and code       "THE INTERNALS OF FORPS: A FORTH BASED PRODUCTION SYSTEM"      by CHRISTOPHER MATHEUS in The Journal of Forth Application      and Research, vol 4, num. 1.                                                                                                       Modifications to allow operation under masterFORTH for the APPLE II mostly concern the threading scheme used and are given on screen 1.                                                                                                                         Changes to the algorithm were made to allow run-time       calculation of priority.  The word *PRIORITY is followed by     code which is executed at run-time.  The FIRE-CELL contains the priority of any fired rules.  If *PRIORITY is omitted, the      priority is assumed to be 1.  Debug words are triggered by the  value of DEBFLAG and may be useful while testing.               ( FORPS LOAD SCREEN                          02/28/87 )         : FORPL ;                                                       : IS-TRUE ( A -- ) TRUE SWAP ! ;                                : IS-FALSE ( A -- ) FALSE SWAP ! ;                                                                                              : @EXECUTE  @ EXECUTE ;                                         HEX                                                             ( PUT DOWN JSR FOR SUBROUTINE CALL TO : )                       : DOCOLON 20 C, 21 C, 09 C, ;                                                                                                   : HERE@ HERE 1 AND 0= IF 0 C, THEN HERE ;                       ( make sure of odd boundary  )                                  DECIMAL                                                         2 9 THRU                                                                                                                                                                                        ( FORPS  - CONSTANTS                           02/27/87 )                                                                       10 CONSTANT MAX-#RULES         8 CONSTANT RULE-LEN                 VARIABLE NO-ACTIVITY          VARIABLE 'SP-IF                   VARIABLE 'NOOP                VARIABLE >RULE-TABLE                                                                              VARIABLE >LAST-RULE           VARIABLE CYCLE                    VARIABLE HIGH-PRI                                               VARIABLE BEST-ACTIVE-RULE                                       VARIABLE '1PRI                VARIABLE PRIFLAG                  VARIABLE DEBFLAG                                                                                                             CREATE RULE-TABLE                                                MAX-#RULES RULE-LEN * ALLOT                                                                                                                                                                    ( FORPS                                   02/27/87 )                                                                            : >ACTION      ( A -- A )   2 + ;                               : >PRIORITY    ( A -- A )   4 + ;                               : >FIRE-CELL   ( A -- A )   6 + ;                                                                                               : HALT     NO-ACTIVITY IS-TRUE ;                                : *ERROR*  1 ABORT" NO RULES LOADED" ;                                                                                          : *RESET-FORPS*  RULE-TABLE DUP >RULE-TABLE !                         MAX-#RULES RULE-LEN * ERASE                                    ['] *ERROR*  RULE-TABLE ! ;                                  *RESET-FORPS*                                                 : NOOP ;   ' NOOP 'NOOP !                                       : 1PRI 1 ;   ' 1PRI '1PRI !                                                 ' NOOP >BODY @ CONSTANT SEMI                        ( FORPS   RULE DEFINING WORDS             02/27/87 )            : COND-PFA!      HERE@ >RULE-TABLE @ ! ;                                                                                        : ACTION-PFA!    HERE@ >RULE-TABLE @ >ACTION ! ;                                                                                : RULE:      >RULE-TABLE @ RULE-TABLE - RULE-LEN / MAX-#RULES =          ABORT" NO ROOM "                                                CURRENT @ CONTEXT  !  HEADER  COND-PFA!                         '1PRI @ >RULE-TABLE @ >PRIORITY !  PRIFLAG IS-FALSE             DOCOLON  HIDE DEF  ;                                                                                                   : *PRIORITY PRIFLAG IS-TRUE                                             >RULE-TABLE @ @ >RULE-TABLE @ >PRIORITY ! ; IMMEDIATE                                                                                                                                                                                                   ( FORPS   RULE DEFINING WORDS - 2        02/27/87 )             : (IF)   -1 DEPTH  'SP-IF ! ;                                   : *IF*   PRIFLAG @ IF SEMI , COND-PFA! DOCOLON THEN                      COMPILE (IF) ;  IMMEDIATE                                                                                              : (THEN) ( *N ) -1 'SP-IF @ DEPTH  1 - SWAP                               DO AND LOOP  ;                                                                                                        : *THEN* COMPILE (THEN) SEMI ,         ACTION-PFA!                       DOCOLON  ; IMMEDIATE                                                                                                   : *END* RULE-LEN >RULE-TABLE +!                                                  >RULE-TABLE @ >LAST-RULE !                              SEMI ,       REVEAL                                            [COMPILE] [ ;   IMMEDIATE                                                                                               ( FORPS    INFERENCE ENGINE                 02/27/87 )          : SET-DEFAULT     0 HIGH-PRI !   'NOOP BEST-ACTIVE-RULE ! ;                                                                     : RT-LIMITS    (  -- N N ) >LAST-RULE @ RULE-TABLE ;                                                                            : CLEAR-FIRES  RT-LIMITS DO 0 I >FIRE-CELL ! RULE-LEN +LOOP ;   : FIRE-RULE     DEBFLAG @ 2 =   IF                                          ." FIRING RULE AT " BEST-ACTIVE-RULE @ U. CR THEN          BEST-ACTIVE-RULE @ @EXECUTE ;                            : TEST-RULE-CONDS   RT-LIMITS                                              DO  I @EXECUTE                                                  IF I >PRIORITY @EXECUTE  ELSE 0 THEN                                  DEBFLAG @ 2 = IF   I . SPACE   DUP . CR THEN                    I >FIRE-CELL !                                         RULE-LEN +LOOP ;                                                                                                        ( FORPS   SELECT-BEST-RULE               02/27/87 )                                                                             : SELECT-BEST-RULE    NO-ACTIVITY IS-TRUE    SET-DEFAULT               RT-LIMITS  DO I >FIRE-CELL @ DUP                                               HIGH-PRI @ >                                                    IF HIGH-PRI !                                                      I >ACTION BEST-ACTIVE-RULE !                                    NO-ACTIVITY IS-FALSE                                         ELSE DROP                                                       THEN                                                        RULE-LEN                                                        +LOOP ;                                                                                                                                                                                                                                                                                                       ( FORPS     FORPS                      02/05/87 )                                                                               : FORPS   >RULE-TABLE @ 4 - >LAST-RULE !   0 CYCLE !                  BEGIN                                                              1 CYCLE +!                                                      CLEAR-FIRES                                                     TEST-RULE-CONDS                                                 SELECT-BEST-RULE                                                FIRE-RULE                                                   DEBFLAG @ 2 = IF ." NEXT CYCLE " CR                                              KEY 3 =                                                      ELSE 0                                                          THEN                                               NO-ACTIVITY @    OR                                             UNTIL ;                                                                                                                   ( RULEDUMP                  )                                                                                                   : R.   0 5 D.R 3 SPACES ;                                       : RULE-DUMP                                                       CR                                                              ."  #     TEST    ACTION   PRIORITY  FIRE "                     CR                                                            RT-LIMITS DO                                                                I R.                                                            I @ R.                                                          I >ACTION @ R.                                                  I >PRIORITY @ R.                                                I >FIRE-CELL @ R.                                             CR                                                              RULE-LEN                                                        +LOOP ;