: DOWN-COUNTER
   2VARIABLE  ( ++ )
   DOES>  ( -- ADR )
      JIFFY@ DROP           \ Only need low cell of jiffy clock
      OVER 2@ SWAP 2PICK -  \ new.time value -delta.time
      0 MIN                 \ Compensate for reset at midnight.
      +  2PICK 2! ;         \ add negative time difference to
                            \ old value and store new time
                            \ and new value to down-counter
                            \ variable and leave address.

CODE 2PICK  ( N1 N2 N3 -- N1 N2 N3 N1 )
   4 ,X LDA  5 ,X LDY
   AYPUSH JMP  END-CODE

DOWN-COUNTER DELAY

     .
     .
     .
   DOWN-COUNTER @ 0<          \
   IF                         \ If this code fragment is run often enough
      #3600 DOWN-COUNTER !    \ <DO.SOMETHING> only runs
      <DO.SOMETHING>          \ once a minute.
   THEN                       \
     .
     .
     .

ENTRY  -- Points to next task's user area or itself if no other tasks.
READY  -- Flag. TRUE - task is awake. FALSE - task is asleep.
TOS    -- Holds the return stack pointer when a task is switched out.
RP0    -- Base of return stack.
SP0    -- Base of data stack.
AP0    -- Base of auxiliary stack.
DP     -- Dictionary Pointer.

BASE   -- Base for numeric conversion to or from text.
DPL    -- Decimal place.
HLD    -- Holds the address for the next character during conversion
          from text to a double number.

<USER.AREA.OFFSET> USER <NAME.OF.USER.VARIABLE>

#20 USER STOOGES

: USER  ( N -- )
   DUP 2+ #USER UMAX (IS) #USER
   CREATE C,
   ;CODE  ( -- N )
      2 # LDY  CLC
      W )Y LDA  UP ADC
      UP 1+ LDY  CS IF  INY  THEN
      AYPUSH JMP  END-CODE

#USER USER LARRY
#USER USER CURLY
#USER USER MOE

#USER USER LAUREL
#USER 8 + USER HARDY

// DJIFFIES JIFFIES
// TAKES POSITIVE DOUBLE NUMBER
// AND DELAYS THAT MANY JIFFIES
: DJIFFIES  ( D+ -- )
   JIFFY@ DROP 1-
   BEGIN
      PAUSE
      JIFFY@ DROP  DUP>R -
      // COMPENSATE FOR DAILY RESET
      0 MIN
      S>D D+  R> OVER 0<
   UNTIL
   DROP 2DROP ;
: JIFFIES  ( U -- )
   0 DJIFFIES ;

0 USER ENTRY   2 USER READY
4 USER TOS

: USER  ( N ++ )
   CREATE
      C,
   ;CODE  ( -- ADR )
      2 # LDY  CLC
      W )Y LDA  UP ADC
      UP 1+ LDY  CS IF  INY  THEN
      AYPUSH JMP  END-CODE

// TASK CREATION AND ACTIVATION
: TASK  ( U AP0 SP0 RP0 -- )
   CREATE
        ( -- TADR )
      HERE RP0 LOCAL !
      HERE SP0 LOCAL !
      HERE AP0 LOCAL !
      [ ' STOP >BODY ] LITERAL
      HERE ACTIVATE
      // OPTIONAL
      #10 HERE BASE LOCAL !
      [ 0 HLD LOCAL 2+ ] LITERAL
      HERE +  HERE DP LOCAL !
      #12 UMAX ALLOT ;

      [ 0 HLD LOCAL 2+ ] LITERAL

FR HEX^DECIMAL

FR

: FR
   >FBUF  >IBUF
   BEGIN  F R  AGAIN -;

   HERE COUNT + 2+  VIEW @ TUCK
   IF  2+  THEN

   1+ SPLIT DROP
   0= ABS ALLOT

   HERE COUNT + 2+  VIEW @ TUCK
   IF  2+  THEN

   DUP 9 + SPLIT DROP
   9 U< AND  2 MOD ALLOT

HEX
// BUG FIX
" SYSIRQ" C@ HERE + 1+
2+ 2+         // SIZE OF LINK
              // & CODE FIELDS
SPLIT DROP 0FF = // WILL PFA BE ON
              // PAGE BOUNDARY?
ABS ALLOT     // IF SO BUMP IT PAST
VARIABLE SYSIRQ

CONT ]

TRACE <SOMEWORD>

ADDRESS WATCH

VARIABLE <IP
VARIABLE IP>
CODE >NEXT ( ADR -- )
   // POINTS NEXT TO ADR
   $4C # LDA  NEXT 2+ STA
   0 ,X LDA  NEXT 3 + STA
   1 ,X LDA  NEXT 4 + STA
   POP JMP  END-CODE
: +PAD
   $FF ?MEM
   [ ' PAD >BODY 4 + ] LITERAL C! ;
: -PAD
   $55
   BRANCH [ ' +PAD >BODY 5 + , ] -;

VARIABLE CON
: CONT   CON ON ;
: NOTRACE
   NEXT>  -PAD
   ." TRACING OFF"  QUIT -;
DEFER .STEP
: (.ST1)  ( IP -- )
   @ .NAME TAB .S ;
' (.ST1) IS .STEP
: (.ST2)  ( IP -- )
   (.ST1)  CR TAB .AS ;
: (.ST3)  ( IP -- )
   (.ST2)  RP0 @ RP@ 2+ 2+
   BRANCH [ ' .RS >BODY 6 + , ] -;

SUBR STEP
   <IP LDA  IP CMP
   <IP 1+ LDA  IP 1+ SBC
   CS NOT IF
      IP> LDA  IP CMP
      IP> 1+ LDA  IP 1+ SBC
      CS IF
         >FORTH
         NEXT>
         R@ HLD @ STATE @ 2>R +PAD
         CR .STEP
         KEY DUP ASCII" {RUN/STOP}" =
         IF  DROP NOTRACE  THEN
         ASCII" {COMMODORE P}" =
         IF
            CON OFF  [COMPILE] [
            BEGIN
               QUERY INTERPRET
               STATE @ 0=
               IF  ."  OKAY" THEN
               CON @
            UNTIL
         THEN
         -PAD  2R> STATE ! HLD !
         RECURSE >NEXT
         >ASSEM
         INY
      THEN
   THEN
   HERE >A         \ Save this address on the Aux stack.
   IP )Y LDA  W 1+ STA
   NEXT 6 + JMP
END-CODE

: TRACE  ( ++ )
   NEXT>
   ' AFIND NIP  IP> ! <IP !
   STEP >NEXT ;

VARIABLE EYE
SUBR LOOK
   TRUE LDA EYE CMP
   0= IF
      TRUE LDA EYE 1+ CMP
      A> 0= BRAN   \ Branch to the address saved on Aux stack.
   THEN
   INY                        \ Restore NEXT.
   BEGIN                      \
      NEXT 7 + ,Y LDA         \
      NEXT 2+ ,Y STA  DEY     \
   0< UNTIL                   \
   >FORTH
   .RS  TRUE
   ABORT" WATCHED MEMORY ALTERED" -;

: WATCH ( ADR -- )
   DUP @ EYE !
   // PATCH LOOK
   DUP LOOK 1+ !
   1+ LOOK 9 + !
   LOOK >NEXT ;

   LABEL NEXT
   1 # LDY
   LABEL NEXT1
   IP )Y LDA  W 1+ STA  DEY
   LABEL NEXT2
   IP )Y LDA  W STA
   1 # LDA
   SEC  IP ADC  IP STA
   CS NOT IF
      W 1- JMP
   THEN
   IP 1+ INC
   W 1- JMP  END-CODE

CODE NEXT>  ( -- )  // RESTORE NEXT
   2 # LDY
   BEGIN
      NEXT2 ,Y LDA
      NEXT1 ,Y STA   DEY
   0< UNTIL
   NEXT JMP  END-CODE

CODE (AFIND)  ( ADR VOC -- LFA2 LFA1 )
   DEY  N 1+ STY
   BEGIN
      0 X) LDA  PHA  0 ,X INC
      0= IF  1 ,X INC  THEN
      0 X) LDA  1 ,X STA
      PLA  0 ,X STA
      2 ,X LDA  0 ,X CMP
      3 ,X LDA  1 ,X SBC
   CS NOT WHILE
      0 ,X LDA  N    STA
      1 ,X LDA  N 1+ STA
   REPEAT
   N LDA  2 ,X STA  N 1+ LDA  3 ,X STA
   NEXT JMP  END-CODE

: AFIND  ( ADR -- ADR LFA1 LFA2 )
   HERE 0 2>R  VOC-LINK @
   BEGIN
      2DUP 2- 2-
      (AFIND)
      R> UMAX SWAP R> UMIN >R >R
      @ ?DUP 0=
   UNTIL
   R> R> ;

CODE TEXT=  ( ADR1 +N ADR2 -- F )
   HERE 1+
   $BAD JSR
   0= NOT IF
      ' FALSE @ JMP
   THEN
   ' TRUE @ JMP
   HERE SWAP!
   3 # LDA  SETUP JSR
   BEGIN
      BEGIN
         N 2+ LDA  N 3 + ORA
      0= NOT WHILE
         N 4 + )Y LDA  N )Y CMP
         0= NOT IF
            RTS
         THEN
         N 2+ LDA
         0= IF  N 3 + DEC  THEN
         N 2+ DEC
         INY
      0= UNTIL  CS-SWAP
      N 5 + INC  N 1+ INC
   REPEAT
   RTS  END-CODE

CODE -TEXT  ( ADR1 +N ADR2 -- F )
   3 # LDA  SETUP JSR
   BEGIN
      BEGIN
         N 2+ LDA  N 3 + ORA
      0= NOT WHILE
         N 4 + )Y LDA  N )Y CMP
         0= NOT IF
            CS IF
               ' 1 @ JMP
            THEN
            ' TRUE @ JMP
         THEN
         N 2+ LDA
         0= IF  N 3 + DEC  THEN
         N 2+ DEC
         INY
      0= UNTIL  CS-SWAP
      N 5 + INC  N 1+ INC
   REPEAT
   ' FALSE @ JMP
   END-CODE

 -TEXT        addr1 +n1 addr2 -- n2                   "dash-text"
      Compare two strings over the length +n1 beginning at addr1
      and addr2.  Return zero if the strings are equal.  If
      unequal, return n2, the difference between the last
      characters compared:  addr1(i) - addr2(i).

: MATCH  ( ADR1 LEN1 ADR2 LEN2 -- OFFSET FLAG )
   2OVER  2PICK - 1+ 0 MAX BOUNDS  \ Limit the search range to the buffer length
   ?DO                             \ plus one minus the search string length
      2DUP I -TEXT 0=              \ test if address I holds search string
      IF                           \ if so
         I 2NIP + SWAP - TRUE      \ add address I to search string length and
                                   \ subtract buffer address to obtain offset
                                   \ discarding other parameters. Place TRUE on
                                   \ data stack.
         UNLOOP EXIT               \ discard loop parameters and exit.
      THEN
   LOOP
   2DROP NIP FALSE ;               \ Drop all parameters save the buffer length
                                   \ and place FALSE on data stack.

: MATCH  ( ADR1 LEN1 ADR2 LEN2 -- OFFSET FLAG )
   2PICK OVER U< 0=                \ If buffer is big enough to contain     
   IF                              \ the search string
      2OVER  2PICK - 1+ BOUNDS     \ Limit the search range to the buffer length
      ?DO                          \ plus one minus the search string length
         2DUP I -TEXT 0=           \ test if address I holds search string
         IF                        \ if so
            I 2NIP + SWAP - TRUE   \ add address I to search string length and
                                   \ subtract buffer address to obtain offset
                                   \ discarding other parameters. Place TRUE on
                                   \ data stack.
            UNLOOP EXIT            \ discard loop parameters and exit.
         THEN
      LOOP
   THEN
   2DROP NIP FALSE ;               \ Drop all parameters save the buffer length
                                   \ and place FALSE on data stack.

2DUP I -TEXT 0= ?BRANCH LOOP

: MATCH  ( ADR1 LEN1 ADR2 LEN2 -- OFFSET FLAG )
   2OVER                      \ Preserve copy of original buffer length
   BEGIN
      2PICK OVER SWAP U<      \ Is remaining buffer too small to hold string?
      IF                      \ If so
         D= ROT DROP  EXIT    \ convert top four numbers to FALSE, discard
      THEN                    \ buffer address and exit.
      2OVER 2OVER DROP -TEXT  \ Test for a match. FALSE = match.
   WHILE                      \ While no match
      1 /STRING               \ reduce buffer size by one
      3 PICK C@ SCAN          \ Scan for first character of search string
   REPEAT
   ROT 2NIP - - NIP TRUE ;    \ subtract search string length from remaining
                              \ buffer size then subtract that from original
                              \ buffer size to obtain offset. Discard the
                              \ three addresses.

100 BLOCK B/BUF ASCII L FILL
100 BLOCK " LOOP" COUNT MATCH