6502.org

Code: Select all

// 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 ;

Code: Select all

0 USER ENTRY   2 USER READY
4 USER TOS

Code: Select all

: 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

Code: Select all

// 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 ;

Code: Select all

      [ 0 HLD LOCAL 2+ ] LITERAL

Code: Select all

FR HEX^DECIMAL

Code: Select all

FR

Code: Select all

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

Code: Select all

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

Code: Select all

   1+ SPLIT DROP
   0= ABS ALLOT

Code: Select all

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

Code: Select all

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

Code: Select all

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

Code: Select all

CONT ]

Code: Select all

TRACE <SOMEWORD>

Code: Select all

ADDRESS WATCH

Code: Select all

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 ;

Code: Select all

   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: Select all

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: Select all

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: Select all

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

Code: Select all

 -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).

Code: Select all

: 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.

Code: Select all

: 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.

Code: Select all

2DUP I -TEXT 0= ?BRANCH LOOP

Code: Select all

: 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.

Code: Select all

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

Code: Select all

( I/O EXTENSIONS PADDLE PADDLE BUTTON                SDBJUN85 )
HEX
CODE PADDLE   SEI, DC02 LDA, PHA, 0C0 # LDA, DC02 STA,
     BOT LDA, .A LSR, 80 # LDA, TAY, CS IF, .A LSR, THEN,
     DC00 STA, BEGIN, NOP, DEY, 0< UNTIL,
     BOT LDA, 1 # EOR, TAY, D419 ,Y LDA,
     BOT STA, PLA, DC02 STA, CLI, NEXT JMP, END-CODE
CODE PADDLEBUTTON  BOT LDA, 2 # CMP, CS
     IF, DC01 LDA, ELSE, DC00 LDA, THEN, PHA,
     BOT LDA, .A LSR, PLA, CS IF, 8 # AND, ELSE, 4 # AND, THEN,
     0= IF, DEY, THEN, TYA, PHA, PUT JMP, END-CODE
DECIMAL

Code: Select all

: TIMEIT
   ' 0 0 JIFFY!  EXECUTE  JIFFY@ CR D. ;
DEFER TESTWORD
: TESTIT
   0
   DO
      TESTWORD
   LOOP ;

Code: Select all

: TEST
   2OVER 2OVER
   2DROP
   2DROP ;
' TEST IS TESTWORD
17 BLOCK B/BUF " DECIMAL" COUNT
1000 TIMEIT TESTIT
2DROP 2DROP

Code: Select all

: MATCHTEST
   2OVER 2OVER MATCH 2DROP ;
' MATCHTEST IS TESTWORD
17 BLOCK B/BUF " DECIMAL" COUNT
1000 TIMEIT TESTIT
2DROP 2DROP

Code: Select all

NH CODE WKEY  ( -- )
   BLINK.ENABLE STY
   >FORTH
      BEGIN  PAUSE #KBD C@  UNTIL
   >ASSEM   // LEAVES Y-REG=0
   INY  BLINK.TIMER STY
   BEGIN
      BLINK.ON? LDA
   0= UNTIL
   BLINK.ENABLE STY
   NEXT JMP  END-CODE

CODE ?KEY  ( -- C )
   XSAVE STX
   $FFE4 JSR  // GETIN
   XSAVE LDX
   APUSH JMP  END-CODE

: (KEY)  ( -- C )
   WKEY  ?KEY ;

' (KEY) IS KEY

Code: Select all

NH CODE WKEY  ( -- )
   #KBD LDA
   0= IF
      BLINK.ENABLE STY
      >FORTH
         BEGIN  PAUSE #KBD C@  UNTIL
      >ASSEM   // LEAVES Y-REG=0
      INY  BLINK.TIMER STY
      BEGIN
         BLINK.ON? LDA
      0= UNTIL
      BLINK.ENABLE STY
   THEN
   NEXT JMP  END-CODE

Code: Select all

: FKEY  ( -- CHAR )
   BEGIN
      (KEY)
      7 OVER #133 - U< ?EXIT
      #63 +  4 /MOD SWAP 2* +
      " F0KEY" TUCK 2+ C!
      FIND
      IF  DUP EXECUTE  THEN
      DROP
   AGAIN ;

' FKEY IS KEY

Code: Select all

CODE BORDER?  ( -- CHAR )
   $D020 LDA  $F # AND
   AYPUSH JMP
   END-CODE

: F1KEY  ( -- )  BORDER? 1+ BORDER ;
: F2KEY  ( -- )  BORDER? 1- BORDER ;